diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index f8e2b398c0..ad8507476f 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -39,9 +39,9 @@ jobs: with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -115,9 +115,9 @@ jobs: with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -157,9 +157,9 @@ jobs: with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -207,9 +207,9 @@ jobs: path: ${{runner.workspace}} key: build-postlib-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -238,9 +238,9 @@ jobs: path: ${{runner.workspace}} key: build-postlib-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -269,9 +269,9 @@ jobs: path: ${{runner.workspace}} key: build-postlib-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -302,9 +302,9 @@ jobs: with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -361,9 +361,9 @@ jobs: path: ${{runner.workspace}} key: build-drivers-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -410,9 +410,9 @@ jobs: path: ${{runner.workspace}} key: build-all-debug-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -469,9 +469,9 @@ jobs: path: ${{runner.workspace}} key: build-interfaces-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -508,9 +508,9 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -555,9 +555,9 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -599,9 +599,9 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -643,9 +643,9 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -687,9 +687,9 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -731,9 +731,9 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -775,9 +775,9 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -819,9 +819,9 @@ jobs: path: ${{runner.workspace}} key: build-fastfarm-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index 837c4048f9..cb9cab5c0a 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -36,27 +36,27 @@ MODULE FASTWrapper_Types IMPLICIT NONE ! ========= FWrap_InitInputType ======= TYPE, PUBLIC :: FWrap_InitInputType - INTEGER(IntKi) :: nr !< Number of radii in the radial finite-difference grid [-] + INTEGER(IntKi) :: nr = 0_IntKi !< Number of radii in the radial finite-difference grid [-] CHARACTER(1024) :: FASTInFile !< Filename of primary FAST input file of this turbine [-] - REAL(ReKi) :: dr !< Radial increment of radial finite-difference grid [m] - REAL(DbKi) :: tmax !< Simulation length [s] - REAL(ReKi) , DIMENSION(1:3) :: p_ref_Turbine !< Undisplaced global coordinates of this turbine [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) :: n_high_low !< Number of high-resolution time steps per low-resolution time step [-] - REAL(DbKi) :: dt_high !< High-resolution time step [s] - REAL(ReKi) , DIMENSION(1:3) :: p_ref_high !< Position of the origin of the high-resolution spatial domain for this turbine [m] - INTEGER(IntKi) :: nX_high !< Number of high-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_high !< Number of high-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_high !< Number of high-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: dX_high !< X-component of the spatial increment of the high-resolution spatial domain for this turbine [m] - REAL(ReKi) :: dY_high !< Y-component of the spatial increment of the high-resolution spatial domain for this turbine [m] - REAL(ReKi) :: dZ_high !< Z-component of the spatial increment of the high-resolution spatial domain for this turbine [m] - INTEGER(IntKi) :: TurbNum !< Turbine ID number (start with 1; end with number of turbines) [-] + REAL(ReKi) :: dr = 0.0_ReKi !< Radial increment of radial finite-difference grid [m] + REAL(DbKi) :: tmax = 0.0_R8Ki !< Simulation length [s] + REAL(ReKi) , DIMENSION(1:3) :: p_ref_Turbine = 0.0_ReKi !< Undisplaced global coordinates of this turbine [m] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + INTEGER(IntKi) :: n_high_low = 0_IntKi !< Number of high-resolution time steps per low-resolution time step [-] + REAL(DbKi) :: dt_high = 0.0_R8Ki !< High-resolution time step [s] + REAL(ReKi) , DIMENSION(1:3) :: p_ref_high = 0.0_ReKi !< Position of the origin of the high-resolution spatial domain for this turbine [m] + INTEGER(IntKi) :: nX_high = 0_IntKi !< Number of high-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_high = 0_IntKi !< Number of high-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_high = 0_IntKi !< Number of high-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: dX_high = 0.0_ReKi !< X-component of the spatial increment of the high-resolution spatial domain for this turbine [m] + REAL(ReKi) :: dY_high = 0.0_ReKi !< Y-component of the spatial increment of the high-resolution spatial domain for this turbine [m] + REAL(ReKi) :: dZ_high = 0.0_ReKi !< Z-component of the spatial increment of the high-resolution spatial domain for this turbine [m] + INTEGER(IntKi) :: TurbNum = 0_IntKi !< Turbine ID number (start with 1; end with number of turbines) [-] CHARACTER(1024) :: RootName !< The root name derived from the primary FAST.Farm input file [For output reporting in this module we need to have Rootname include the turbine number] [-] - INTEGER(IntKi) :: NumSC2Ctrl !< Number of turbine-specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2CtrlGlob !< Number of global controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumCtrl2SC !< Number of turbine-specific controller outputs [to supercontroller] [-] - LOGICAL :: UseSC !< Use the SuperController? (flag) [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< Number of turbine-specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< Number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< Number of turbine-specific controller outputs [to supercontroller] [-] + LOGICAL :: UseSC = .false. !< Use the SuperController? (flag) [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSCGlob !< Global outputs from SuperController [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSC !< Turbine-specific outputs from SuperController [-] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: Vdist_High => NULL() !< Pointer to UVW components of disturbed wind [nx^high, ny^high, nz^high, n^high/low] (ambient + deficits) across the high-resolution domain around the turbine for each high-resolution time step within a low-resolution time step [(m/s)] @@ -64,28 +64,28 @@ MODULE FASTWrapper_Types ! ======================= ! ========= FWrap_InitOutputType ======= TYPE, PUBLIC :: FWrap_InitOutputType - REAL(DbKi) , DIMENSION(1:6) :: PtfmInit !< Initial platform position/rotation vector - surge,sway,heave,roll,pitch,yaw - needed for mooring module initInp [-] + REAL(DbKi) , DIMENSION(1:6) :: PtfmInit = 0.0_R8Ki !< Initial platform position/rotation vector - surge,sway,heave,roll,pitch,yaw - needed for mooring module initInp [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] END TYPE FWrap_InitOutputType ! ======================= ! ========= FWrap_ContinuousStateType ======= TYPE, PUBLIC :: FWrap_ContinuousStateType - REAL(ReKi) :: dummy !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< Remove this variable if you have continuous states [-] END TYPE FWrap_ContinuousStateType ! ======================= ! ========= FWrap_DiscreteStateType ======= TYPE, PUBLIC :: FWrap_DiscreteStateType - REAL(ReKi) :: dummy !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< Remove this variable if you have continuous states [-] END TYPE FWrap_DiscreteStateType ! ======================= ! ========= FWrap_ConstraintStateType ======= TYPE, PUBLIC :: FWrap_ConstraintStateType - REAL(ReKi) :: dummy !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE FWrap_ConstraintStateType ! ======================= ! ========= FWrap_OtherStateType ======= TYPE, PUBLIC :: FWrap_OtherStateType - INTEGER(IntKi) :: dummy !< Remove this variable if you have other states [-] + INTEGER(IntKi) :: dummy = 0_IntKi !< Remove this variable if you have other states [-] END TYPE FWrap_OtherStateType ! ======================= ! ========= FWrap_MiscVarType ======= @@ -99,10 +99,10 @@ MODULE FASTWrapper_Types ! ======================= ! ========= FWrap_ParameterType ======= TYPE, PUBLIC :: FWrap_ParameterType - INTEGER(IntKi) :: nr !< Number of radii in the radial finite-difference grid [-] + INTEGER(IntKi) :: nr = 0_IntKi !< Number of radii in the radial finite-difference grid [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: r !< Discretization of radial finite-difference grid [m] - INTEGER(IntKi) :: n_FAST_low !< Number of FAST time steps per low-resolution time step [-] - REAL(ReKi) , DIMENSION(1:3) :: p_ref_Turbine !< Undisplaced global position of this turbine [m] + INTEGER(IntKi) :: n_FAST_low = 0_IntKi !< Number of FAST time steps per low-resolution time step [-] + REAL(ReKi) , DIMENSION(1:3) :: p_ref_Turbine = 0.0_ReKi !< Undisplaced global position of this turbine [m] END TYPE FWrap_ParameterType ! ======================= ! ========= FWrap_InputType ======= @@ -114,2708 +114,1068 @@ MODULE FASTWrapper_Types ! ========= FWrap_OutputType ======= TYPE, PUBLIC :: FWrap_OutputType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: toSC !< Turbine-dependent commands to the super controller [(various units)] - REAL(ReKi) , DIMENSION(1:3) :: xHat_Disk !< Orientation of rotor centerline, normal to disk [-] - REAL(ReKi) :: YawErr !< Nacelle-yaw error i.e. the angle about positive Z^ from the rotor centerline to the rotor-disk-averaged relative wind velocity (ambients + deficits + motion), both projected onto the horizontal plane [rad] - REAL(ReKi) :: psi_skew !< Azimuth angle from the nominally vertical axis in the disk plane to the vector about which the inflow skew angle is defined [rad] - REAL(ReKi) :: chi_skew !< Inflow skew angle [rad] - REAL(ReKi) , DIMENSION(1:3) :: p_hub !< Center position of hub [m] - REAL(ReKi) :: D_rotor !< Rotor diameter [m] - REAL(ReKi) :: DiskAvg_Vx_Rel !< Rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] + REAL(ReKi) , DIMENSION(1:3) :: xHat_Disk = 0.0_ReKi !< Orientation of rotor centerline, normal to disk [-] + REAL(ReKi) :: YawErr = 0.0_ReKi !< Nacelle-yaw error i.e. the angle about positive Z^ from the rotor centerline to the rotor-disk-averaged relative wind velocity (ambients + deficits + motion), both projected onto the horizontal plane [rad] + REAL(ReKi) :: psi_skew = 0.0_ReKi !< Azimuth angle from the nominally vertical axis in the disk plane to the vector about which the inflow skew angle is defined [rad] + REAL(ReKi) :: chi_skew = 0.0_ReKi !< Inflow skew angle [rad] + REAL(ReKi) , DIMENSION(1:3) :: p_hub = 0.0_ReKi !< Center position of hub [m] + REAL(ReKi) :: D_rotor = 0.0_ReKi !< Rotor diameter [m] + REAL(ReKi) :: DiskAvg_Vx_Rel = 0.0_ReKi !< Rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AzimAvg_Ct !< Azimuthally averaged thrust force coefficient (normal to disk), distributed radially [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AzimAvg_Cq !< Azimuthally averaged torque coefficient (normal to disk), distributed radially [-] END TYPE FWrap_OutputType ! ======================= CONTAINS - SUBROUTINE FWrap_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(FWrap_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) :: 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' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%nr = SrcInitInputData%nr - DstInitInputData%FASTInFile = SrcInitInputData%FASTInFile - DstInitInputData%dr = SrcInitInputData%dr - DstInitInputData%tmax = SrcInitInputData%tmax - DstInitInputData%p_ref_Turbine = SrcInitInputData%p_ref_Turbine - DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod - DstInitInputData%n_high_low = SrcInitInputData%n_high_low - DstInitInputData%dt_high = SrcInitInputData%dt_high - DstInitInputData%p_ref_high = SrcInitInputData%p_ref_high - DstInitInputData%nX_high = SrcInitInputData%nX_high - DstInitInputData%nY_high = SrcInitInputData%nY_high - DstInitInputData%nZ_high = SrcInitInputData%nZ_high - DstInitInputData%dX_high = SrcInitInputData%dX_high - DstInitInputData%dY_high = SrcInitInputData%dY_high - DstInitInputData%dZ_high = SrcInitInputData%dZ_high - DstInitInputData%TurbNum = SrcInitInputData%TurbNum - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl - DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob - DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC - DstInitInputData%UseSC = SrcInitInputData%UseSC -IF (ALLOCATED(SrcInitInputData%fromSCGlob)) THEN - i1_l = LBOUND(SrcInitInputData%fromSCGlob,1) - i1_u = UBOUND(SrcInitInputData%fromSCGlob,1) - IF (.NOT. ALLOCATED(DstInitInputData%fromSCGlob)) THEN - ALLOCATE(DstInitInputData%fromSCGlob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSCGlob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob -ENDIF -IF (ALLOCATED(SrcInitInputData%fromSC)) THEN - i1_l = LBOUND(SrcInitInputData%fromSC,1) - i1_u = UBOUND(SrcInitInputData%fromSC,1) - IF (.NOT. ALLOCATED(DstInitInputData%fromSC)) THEN - ALLOCATE(DstInitInputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%fromSC = SrcInitInputData%fromSC -ENDIF - DstInitInputData%Vdist_High => SrcInitInputData%Vdist_High - END SUBROUTINE FWrap_CopyInitInput - - SUBROUTINE FWrap_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(FWrap_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 = 'FWrap_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%fromSCGlob)) THEN - DEALLOCATE(InitInputData%fromSCGlob) -ENDIF -IF (ALLOCATED(InitInputData%fromSC)) THEN - DEALLOCATE(InitInputData%fromSC) -ENDIF -NULLIFY(InitInputData%Vdist_High) - END SUBROUTINE FWrap_DestroyInitInput - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 ! nr - Int_BufSz = Int_BufSz + 1*LEN(InData%FASTInFile) ! FASTInFile - Re_BufSz = Re_BufSz + 1 ! dr - Db_BufSz = Db_BufSz + 1 ! tmax - Re_BufSz = Re_BufSz + SIZE(InData%p_ref_Turbine) ! p_ref_Turbine - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Int_BufSz = Int_BufSz + 1 ! n_high_low - Db_BufSz = Db_BufSz + 1 ! dt_high - Re_BufSz = Re_BufSz + SIZE(InData%p_ref_high) ! p_ref_high - Int_BufSz = Int_BufSz + 1 ! nX_high - Int_BufSz = Int_BufSz + 1 ! nY_high - Int_BufSz = Int_BufSz + 1 ! nZ_high - Re_BufSz = Re_BufSz + 1 ! dX_high - Re_BufSz = Re_BufSz + 1 ! dY_high - Re_BufSz = Re_BufSz + 1 ! dZ_high - Int_BufSz = Int_BufSz + 1 ! TurbNum - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! UseSC - Int_BufSz = Int_BufSz + 1 ! fromSCGlob allocated yes/no - IF ( ALLOCATED(InData%fromSCGlob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCGlob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCGlob) ! fromSCGlob - END IF - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ALLOCATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - 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 - - IntKiBuf(Int_Xferred) = InData%nr - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%FASTInFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%FASTInFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%dr - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tmax - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%p_ref_Turbine,1), UBOUND(InData%p_ref_Turbine,1) - ReKiBuf(Re_Xferred) = InData%p_ref_Turbine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_high_low - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dt_high - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%p_ref_high,1), UBOUND(InData%p_ref_high,1) - ReKiBuf(Re_Xferred) = InData%p_ref_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nX_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_high - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dX_high - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dY_high - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dZ_high - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TurbNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseSC, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%fromSCGlob) ) 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%fromSCGlob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCGlob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCGlob,1), UBOUND(InData%fromSCGlob,1) - ReKiBuf(Re_Xferred) = InData%fromSCGlob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fromSC) ) 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%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FWrap_PackInitInput - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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%nr = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%FASTInFile) - OutData%FASTInFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%dr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tmax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%p_ref_Turbine,1) - i1_u = UBOUND(OutData%p_ref_Turbine,1) - DO i1 = LBOUND(OutData%p_ref_Turbine,1), UBOUND(OutData%p_ref_Turbine,1) - OutData%p_ref_Turbine(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_high_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dt_high = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%p_ref_high,1) - i1_u = UBOUND(OutData%p_ref_high,1) - DO i1 = LBOUND(OutData%p_ref_high,1), UBOUND(OutData%p_ref_high,1) - OutData%p_ref_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%nX_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dX_high = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dY_high = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dZ_high = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TurbNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UseSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseSC) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCGlob 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%fromSCGlob)) DEALLOCATE(OutData%fromSCGlob) - ALLOCATE(OutData%fromSCGlob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCGlob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSCGlob,1), UBOUND(OutData%fromSCGlob,1) - OutData%fromSCGlob(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC 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%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - NULLIFY(OutData%Vdist_High) - END SUBROUTINE FWrap_UnPackInitInput - - SUBROUTINE FWrap_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(FWrap_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 = 'FWrap_CopyInitOutput' -! +subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_InitInputType), intent(in) :: SrcInitInputData + type(FWrap_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FWrap_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%PtfmInit = SrcInitOutputData%PtfmInit - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FWrap_CopyInitOutput - - SUBROUTINE FWrap_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(FWrap_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 = 'FWrap_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FWrap_DestroyInitOutput - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - 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 i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) - 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 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 FWrap_PackInitOutput - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 - i1_l = LBOUND(OutData%PtfmInit,1) - i1_u = UBOUND(OutData%PtfmInit,1) - DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) - OutData%PtfmInit(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - 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) - END SUBROUTINE FWrap_UnPackInitOutput - - SUBROUTINE FWrap_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(FWrap_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 = 'FWrap_CopyContState' -! + ErrMsg = '' + DstInitInputData%nr = SrcInitInputData%nr + DstInitInputData%FASTInFile = SrcInitInputData%FASTInFile + DstInitInputData%dr = SrcInitInputData%dr + DstInitInputData%tmax = SrcInitInputData%tmax + DstInitInputData%p_ref_Turbine = SrcInitInputData%p_ref_Turbine + DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod + DstInitInputData%n_high_low = SrcInitInputData%n_high_low + DstInitInputData%dt_high = SrcInitInputData%dt_high + DstInitInputData%p_ref_high = SrcInitInputData%p_ref_high + DstInitInputData%nX_high = SrcInitInputData%nX_high + DstInitInputData%nY_high = SrcInitInputData%nY_high + DstInitInputData%nZ_high = SrcInitInputData%nZ_high + DstInitInputData%dX_high = SrcInitInputData%dX_high + DstInitInputData%dY_high = SrcInitInputData%dY_high + DstInitInputData%dZ_high = SrcInitInputData%dZ_high + DstInitInputData%TurbNum = SrcInitInputData%TurbNum + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl + DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob + DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC + DstInitInputData%UseSC = SrcInitInputData%UseSC + if (allocated(SrcInitInputData%fromSCGlob)) then + LB(1:1) = lbound(SrcInitInputData%fromSCGlob) + UB(1:1) = ubound(SrcInitInputData%fromSCGlob) + if (.not. allocated(DstInitInputData%fromSCGlob)) then + allocate(DstInitInputData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSCGlob.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob + end if + if (allocated(SrcInitInputData%fromSC)) then + LB(1:1) = lbound(SrcInitInputData%fromSC) + UB(1:1) = ubound(SrcInitInputData%fromSC) + if (.not. allocated(DstInitInputData%fromSC)) then + allocate(DstInitInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%fromSC = SrcInitInputData%fromSC + end if + DstInitInputData%Vdist_High => SrcInitInputData%Vdist_High +end subroutine + +subroutine FWrap_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(FWrap_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%dummy = SrcContStateData%dummy - END SUBROUTINE FWrap_CopyContState - - SUBROUTINE FWrap_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(FWrap_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 = 'FWrap_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE FWrap_DestroyContState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 ! dummy - 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%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FWrap_PackContState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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%dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FWrap_UnPackContState - - SUBROUTINE FWrap_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(FWrap_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 = 'FWrap_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitInputData%fromSCGlob)) then + deallocate(InitInputData%fromSCGlob) + end if + if (allocated(InitInputData%fromSC)) then + deallocate(InitInputData%fromSC) + end if + nullify(InitInputData%Vdist_High) +end subroutine + +subroutine FWrap_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackInitInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%nr) + call RegPack(Buf, InData%FASTInFile) + call RegPack(Buf, InData%dr) + call RegPack(Buf, InData%tmax) + call RegPack(Buf, InData%p_ref_Turbine) + call RegPack(Buf, InData%WaveFieldMod) + call RegPack(Buf, InData%n_high_low) + call RegPack(Buf, InData%dt_high) + call RegPack(Buf, InData%p_ref_high) + call RegPack(Buf, InData%nX_high) + call RegPack(Buf, InData%nY_high) + call RegPack(Buf, InData%nZ_high) + call RegPack(Buf, InData%dX_high) + call RegPack(Buf, InData%dY_high) + call RegPack(Buf, InData%dZ_high) + call RegPack(Buf, InData%TurbNum) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%NumSC2Ctrl) + call RegPack(Buf, InData%NumSC2CtrlGlob) + call RegPack(Buf, InData%NumCtrl2SC) + call RegPack(Buf, InData%UseSC) + call RegPack(Buf, allocated(InData%fromSCGlob)) + if (allocated(InData%fromSCGlob)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob), ubound(InData%fromSCGlob)) + call RegPack(Buf, InData%fromSCGlob) + end if + call RegPack(Buf, allocated(InData%fromSC)) + if (allocated(InData%fromSC)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPack(Buf, InData%fromSC) + end if + call RegPack(Buf, associated(InData%Vdist_High)) + if (associated(InData%Vdist_High)) then + call RegPackBounds(Buf, 5, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) + call RegPackPointer(Buf, c_loc(InData%Vdist_High), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Vdist_High) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackInitInput' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%nr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FASTInFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tmax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%p_ref_Turbine) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_high_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dt_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%p_ref_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nX_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nY_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nZ_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dX_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dY_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dZ_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TurbNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UseSC) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%fromSCGlob)) deallocate(OutData%fromSCGlob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSCGlob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCGlob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSCGlob) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (associated(OutData%Vdist_High)) deallocate(OutData%Vdist_High) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vdist_High, UB(1:5)-LB(1:5)) + OutData%Vdist_High(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%Vdist_High + else + allocate(OutData%Vdist_High(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vdist_High) + call RegUnpack(Buf, OutData%Vdist_High) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Vdist_High => null() + end if +end subroutine + +subroutine FWrap_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_InitOutputType), intent(in) :: SrcInitOutputData + type(FWrap_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FWrap_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%dummy = SrcDiscStateData%dummy - END SUBROUTINE FWrap_CopyDiscState - - SUBROUTINE FWrap_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(FWrap_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 = 'FWrap_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE FWrap_DestroyDiscState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 ! dummy - 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%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FWrap_PackDiscState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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%dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FWrap_UnPackDiscState - - SUBROUTINE FWrap_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(FWrap_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 = 'FWrap_CopyConstrState' -! + ErrMsg = '' + DstInitOutputData%PtfmInit = SrcInitOutputData%PtfmInit + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FWrap_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(FWrap_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FWrap_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%dummy = SrcConstrStateData%dummy - END SUBROUTINE FWrap_CopyConstrState - - SUBROUTINE FWrap_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(FWrap_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 = 'FWrap_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE FWrap_DestroyConstrState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 ! dummy - 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%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FWrap_PackConstrState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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%dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FWrap_UnPackConstrState - - SUBROUTINE FWrap_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(FWrap_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 = 'FWrap_CopyOtherState' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FWrap_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%PtfmInit) + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%PtfmInit) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine + +subroutine FWrap_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_ContinuousStateType), intent(in) :: SrcContStateData + type(FWrap_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%dummy = SrcOtherStateData%dummy - END SUBROUTINE FWrap_CopyOtherState - - SUBROUTINE FWrap_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(FWrap_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 = 'FWrap_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE FWrap_DestroyOtherState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 ! dummy - 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%dummy - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FWrap_PackOtherState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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%dummy = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FWrap_UnPackOtherState - - SUBROUTINE FWrap_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(FWrap_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyMisc' -! + ErrMsg = '' + DstContStateData%dummy = SrcContStateData%dummy +end subroutine + +subroutine FWrap_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(FWrap_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL FAST_Copyturbinetype( SrcMiscData%Turbine, DstMiscData%Turbine, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%TempDisp)) THEN - i1_l = LBOUND(SrcMiscData%TempDisp,1) - i1_u = UBOUND(SrcMiscData%TempDisp,1) - IF (.NOT. ALLOCATED(DstMiscData%TempDisp)) THEN - ALLOCATE(DstMiscData%TempDisp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TempDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%TempDisp,1), UBOUND(SrcMiscData%TempDisp,1) - CALL MeshCopy( SrcMiscData%TempDisp(i1), DstMiscData%TempDisp(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%TempLoads)) THEN - i1_l = LBOUND(SrcMiscData%TempLoads,1) - i1_u = UBOUND(SrcMiscData%TempLoads,1) - IF (.NOT. ALLOCATED(DstMiscData%TempLoads)) THEN - ALLOCATE(DstMiscData%TempLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TempLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%TempLoads,1), UBOUND(SrcMiscData%TempLoads,1) - CALL MeshCopy( SrcMiscData%TempLoads(i1), DstMiscData%TempLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%ADRotorDisk)) THEN - i1_l = LBOUND(SrcMiscData%ADRotorDisk,1) - i1_u = UBOUND(SrcMiscData%ADRotorDisk,1) - IF (.NOT. ALLOCATED(DstMiscData%ADRotorDisk)) THEN - ALLOCATE(DstMiscData%ADRotorDisk(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ADRotorDisk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%ADRotorDisk,1), UBOUND(SrcMiscData%ADRotorDisk,1) - CALL MeshCopy( SrcMiscData%ADRotorDisk(i1), DstMiscData%ADRotorDisk(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%AD_L2L)) THEN - i1_l = LBOUND(SrcMiscData%AD_L2L,1) - i1_u = UBOUND(SrcMiscData%AD_L2L,1) - IF (.NOT. ALLOCATED(DstMiscData%AD_L2L)) THEN - ALLOCATE(DstMiscData%AD_L2L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AD_L2L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%AD_L2L,1), UBOUND(SrcMiscData%AD_L2L,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%AD_L2L(i1), DstMiscData%AD_L2L(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FWrap_CopyMisc - - SUBROUTINE FWrap_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(FWrap_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 = 'FWrap_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - 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) - CALL MeshDestroy( MiscData%TempDisp(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%TempDisp) -ENDIF -IF (ALLOCATED(MiscData%TempLoads)) THEN -DO i1 = LBOUND(MiscData%TempLoads,1), UBOUND(MiscData%TempLoads,1) - CALL MeshDestroy( MiscData%TempLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%TempLoads) -ENDIF -IF (ALLOCATED(MiscData%ADRotorDisk)) THEN -DO i1 = LBOUND(MiscData%ADRotorDisk,1), UBOUND(MiscData%ADRotorDisk,1) - CALL MeshDestroy( MiscData%ADRotorDisk(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%ADRotorDisk) -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%AD_L2L) -ENDIF - END SUBROUTINE FWrap_DestroyMisc - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Turbine - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Turbine - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Turbine - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! TempDisp allocated yes/no - IF ( ALLOCATED(InData%TempDisp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TempDisp upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TempDisp,1), UBOUND(InData%TempDisp,1) - Int_BufSz = Int_BufSz + 3 ! TempDisp: size of buffers for each call to pack subtype - CALL MeshPack( InData%TempDisp(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TempDisp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TempDisp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TempDisp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TempDisp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TempLoads allocated yes/no - IF ( ALLOCATED(InData%TempLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TempLoads upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TempLoads,1), UBOUND(InData%TempLoads,1) - Int_BufSz = Int_BufSz + 3 ! TempLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%TempLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TempLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TempLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TempLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TempLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ADRotorDisk allocated yes/no - IF ( ALLOCATED(InData%ADRotorDisk) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ADRotorDisk upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ADRotorDisk,1), UBOUND(InData%ADRotorDisk,1) - Int_BufSz = Int_BufSz + 3 ! ADRotorDisk: size of buffers for each call to pack subtype - CALL MeshPack( InData%ADRotorDisk(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ADRotorDisk - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ADRotorDisk - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ADRotorDisk - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ADRotorDisk - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! AD_L2L allocated yes/no - IF ( ALLOCATED(InData%AD_L2L) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_L2L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_L2L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_L2L - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%TempDisp) ) 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%TempDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TempDisp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TempDisp,1), UBOUND(InData%TempDisp,1) - CALL MeshPack( InData%TempDisp(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TempDisp - 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 - IF ( .NOT. ALLOCATED(InData%TempLoads) ) 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%TempLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TempLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TempLoads,1), UBOUND(InData%TempLoads,1) - CALL MeshPack( InData%TempLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TempLoads - 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 - IF ( .NOT. ALLOCATED(InData%ADRotorDisk) ) 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%ADRotorDisk,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADRotorDisk,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ADRotorDisk,1), UBOUND(InData%ADRotorDisk,1) - CALL MeshPack( InData%ADRotorDisk(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ADRotorDisk - 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 - IF ( .NOT. ALLOCATED(InData%AD_L2L) ) 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%AD_L2L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_L2L,1) - 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 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 - END SUBROUTINE FWrap_PackMisc - - SUBROUTINE FWrap_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(FWrap_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_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 - 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 FAST_UnpackTurbineType( Re_Buf, Db_Buf, Int_Buf, OutData%Turbine, ErrStat2, ErrMsg2 ) ! Turbine - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TempDisp 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%TempDisp)) DEALLOCATE(OutData%TempDisp) - ALLOCATE(OutData%TempDisp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TempDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TempDisp,1), UBOUND(OutData%TempDisp,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 MeshUnpack( OutData%TempDisp(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TempDisp - 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 ! TempLoads 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%TempLoads)) DEALLOCATE(OutData%TempLoads) - ALLOCATE(OutData%TempLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TempLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TempLoads,1), UBOUND(OutData%TempLoads,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 MeshUnpack( OutData%TempLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TempLoads - 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 ! ADRotorDisk 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%ADRotorDisk)) DEALLOCATE(OutData%ADRotorDisk) - ALLOCATE(OutData%ADRotorDisk(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADRotorDisk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ADRotorDisk,1), UBOUND(OutData%ADRotorDisk,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 MeshUnpack( OutData%ADRotorDisk(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ADRotorDisk - 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 ! AD_L2L 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%AD_L2L)) DEALLOCATE(OutData%AD_L2L) - ALLOCATE(OutData%AD_L2L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L2L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AD_L2L,1), UBOUND(OutData%AD_L2L,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_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 - - 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 - END SUBROUTINE FWrap_UnPackMisc - - SUBROUTINE FWrap_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_ParameterType), INTENT(IN) :: SrcParamData - TYPE(FWrap_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyParam' -! + ErrMsg = '' +end subroutine + +subroutine FWrap_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_DiscreteStateType), intent(in) :: SrcDiscStateData + type(FWrap_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%nr = SrcParamData%nr -IF (ALLOCATED(SrcParamData%r)) THEN - i1_l = LBOUND(SrcParamData%r,1) - i1_u = UBOUND(SrcParamData%r,1) - IF (.NOT. ALLOCATED(DstParamData%r)) THEN - ALLOCATE(DstParamData%r(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%r = SrcParamData%r -ENDIF - DstParamData%n_FAST_low = SrcParamData%n_FAST_low - DstParamData%p_ref_Turbine = SrcParamData%p_ref_Turbine - END SUBROUTINE FWrap_CopyParam - - SUBROUTINE FWrap_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(FWrap_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 = 'FWrap_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%r)) THEN - DEALLOCATE(ParamData%r) -ENDIF - END SUBROUTINE FWrap_DestroyParam - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 - Int_BufSz = Int_BufSz + 1 ! nr - Int_BufSz = Int_BufSz + 1 ! r allocated yes/no - IF ( ALLOCATED(InData%r) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! r upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r) ! r - END IF - Int_BufSz = Int_BufSz + 1 ! n_FAST_low - Re_BufSz = Re_BufSz + SIZE(InData%p_ref_Turbine) ! p_ref_Turbine - 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%nr - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%r) ) 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%r,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - ReKiBuf(Re_Xferred) = InData%r(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n_FAST_low - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%p_ref_Turbine,1), UBOUND(InData%p_ref_Turbine,1) - ReKiBuf(Re_Xferred) = InData%p_ref_Turbine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FWrap_PackParam - - SUBROUTINE FWrap_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(FWrap_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_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%nr = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r 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%r)) DEALLOCATE(OutData%r) - ALLOCATE(OutData%r(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%n_FAST_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%p_ref_Turbine,1) - i1_u = UBOUND(OutData%p_ref_Turbine,1) - DO i1 = LBOUND(OutData%p_ref_Turbine,1), UBOUND(OutData%p_ref_Turbine,1) - OutData%p_ref_Turbine(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FWrap_UnPackParam - - SUBROUTINE FWrap_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_InputType), INTENT(IN) :: SrcInputData - TYPE(FWrap_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyInput' -! + ErrMsg = '' + DstDiscStateData%dummy = SrcDiscStateData%dummy +end subroutine + +subroutine FWrap_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(FWrap_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%fromSCglob)) THEN - i1_l = LBOUND(SrcInputData%fromSCglob,1) - i1_u = UBOUND(SrcInputData%fromSCglob,1) - IF (.NOT. ALLOCATED(DstInputData%fromSCglob)) THEN - ALLOCATE(DstInputData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%fromSCglob = SrcInputData%fromSCglob -ENDIF -IF (ALLOCATED(SrcInputData%fromSC)) THEN - i1_l = LBOUND(SrcInputData%fromSC,1) - i1_u = UBOUND(SrcInputData%fromSC,1) - IF (.NOT. ALLOCATED(DstInputData%fromSC)) THEN - ALLOCATE(DstInputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%fromSC = SrcInputData%fromSC -ENDIF - END SUBROUTINE FWrap_CopyInput - - SUBROUTINE FWrap_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(FWrap_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 = 'FWrap_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%fromSCglob)) THEN - DEALLOCATE(InputData%fromSCglob) -ENDIF -IF (ALLOCATED(InputData%fromSC)) THEN - DEALLOCATE(InputData%fromSC) -ENDIF - END SUBROUTINE FWrap_DestroyInput - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 - Int_BufSz = Int_BufSz + 1 ! fromSCglob allocated yes/no - IF ( ALLOCATED(InData%fromSCglob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCglob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCglob) ! fromSCglob - END IF - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ALLOCATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - 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%fromSCglob) ) 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%fromSCglob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCglob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCglob,1), UBOUND(InData%fromSCglob,1) - ReKiBuf(Re_Xferred) = InData%fromSCglob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fromSC) ) 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%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FWrap_PackInput - - SUBROUTINE FWrap_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(FWrap_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCglob 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%fromSCglob)) DEALLOCATE(OutData%fromSCglob) - ALLOCATE(OutData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSCglob,1), UBOUND(OutData%fromSCglob,1) - OutData%fromSCglob(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC 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%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FWrap_UnPackInput - - SUBROUTINE FWrap_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_OutputType), INTENT(IN) :: SrcOutputData - TYPE(FWrap_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 = 'FWrap_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine FWrap_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_ConstraintStateType), intent(in) :: SrcConstrStateData + type(FWrap_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%toSC)) THEN - i1_l = LBOUND(SrcOutputData%toSC,1) - i1_u = UBOUND(SrcOutputData%toSC,1) - IF (.NOT. ALLOCATED(DstOutputData%toSC)) THEN - ALLOCATE(DstOutputData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%toSC = SrcOutputData%toSC -ENDIF - DstOutputData%xHat_Disk = SrcOutputData%xHat_Disk - DstOutputData%YawErr = SrcOutputData%YawErr - DstOutputData%psi_skew = SrcOutputData%psi_skew - DstOutputData%chi_skew = SrcOutputData%chi_skew - DstOutputData%p_hub = SrcOutputData%p_hub - DstOutputData%D_rotor = SrcOutputData%D_rotor - DstOutputData%DiskAvg_Vx_Rel = SrcOutputData%DiskAvg_Vx_Rel -IF (ALLOCATED(SrcOutputData%AzimAvg_Ct)) THEN - i1_l = LBOUND(SrcOutputData%AzimAvg_Ct,1) - i1_u = UBOUND(SrcOutputData%AzimAvg_Ct,1) - IF (.NOT. ALLOCATED(DstOutputData%AzimAvg_Ct)) THEN - ALLOCATE(DstOutputData%AzimAvg_Ct(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AzimAvg_Ct.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%AzimAvg_Ct = SrcOutputData%AzimAvg_Ct -ENDIF -IF (ALLOCATED(SrcOutputData%AzimAvg_Cq)) THEN - i1_l = LBOUND(SrcOutputData%AzimAvg_Cq,1) - i1_u = UBOUND(SrcOutputData%AzimAvg_Cq,1) - IF (.NOT. ALLOCATED(DstOutputData%AzimAvg_Cq)) THEN - ALLOCATE(DstOutputData%AzimAvg_Cq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AzimAvg_Cq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%AzimAvg_Cq = SrcOutputData%AzimAvg_Cq -ENDIF - END SUBROUTINE FWrap_CopyOutput - - SUBROUTINE FWrap_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(FWrap_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 = 'FWrap_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%toSC)) THEN - DEALLOCATE(OutputData%toSC) -ENDIF -IF (ALLOCATED(OutputData%AzimAvg_Ct)) THEN - DEALLOCATE(OutputData%AzimAvg_Ct) -ENDIF -IF (ALLOCATED(OutputData%AzimAvg_Cq)) THEN - DEALLOCATE(OutputData%AzimAvg_Cq) -ENDIF - END SUBROUTINE FWrap_DestroyOutput - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 ! toSC allocated yes/no - IF ( ALLOCATED(InData%toSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSC) ! toSC - END IF - Re_BufSz = Re_BufSz + SIZE(InData%xHat_Disk) ! xHat_Disk - Re_BufSz = Re_BufSz + 1 ! YawErr - Re_BufSz = Re_BufSz + 1 ! psi_skew - Re_BufSz = Re_BufSz + 1 ! chi_skew - Re_BufSz = Re_BufSz + SIZE(InData%p_hub) ! p_hub - Re_BufSz = Re_BufSz + 1 ! D_rotor - Re_BufSz = Re_BufSz + 1 ! DiskAvg_Vx_Rel - Int_BufSz = Int_BufSz + 1 ! AzimAvg_Ct allocated yes/no - IF ( ALLOCATED(InData%AzimAvg_Ct) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AzimAvg_Ct upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AzimAvg_Ct) ! AzimAvg_Ct - END IF - Int_BufSz = Int_BufSz + 1 ! AzimAvg_Cq allocated yes/no - IF ( ALLOCATED(InData%AzimAvg_Cq) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AzimAvg_Cq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AzimAvg_Cq) ! AzimAvg_Cq - 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%toSC) ) 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%toSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) - ReKiBuf(Re_Xferred) = InData%toSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%xHat_Disk,1), UBOUND(InData%xHat_Disk,1) - ReKiBuf(Re_Xferred) = InData%xHat_Disk(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%psi_skew - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%chi_skew - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%p_hub,1), UBOUND(InData%p_hub,1) - ReKiBuf(Re_Xferred) = InData%p_hub(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%D_rotor - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DiskAvg_Vx_Rel - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AzimAvg_Ct) ) 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%AzimAvg_Ct,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AzimAvg_Ct,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AzimAvg_Ct,1), UBOUND(InData%AzimAvg_Ct,1) - ReKiBuf(Re_Xferred) = InData%AzimAvg_Ct(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AzimAvg_Cq) ) 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%AzimAvg_Cq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AzimAvg_Cq,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AzimAvg_Cq,1), UBOUND(InData%AzimAvg_Cq,1) - ReKiBuf(Re_Xferred) = InData%AzimAvg_Cq(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FWrap_PackOutput - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 ! toSC 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%toSC)) DEALLOCATE(OutData%toSC) - ALLOCATE(OutData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) - OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%xHat_Disk,1) - i1_u = UBOUND(OutData%xHat_Disk,1) - DO i1 = LBOUND(OutData%xHat_Disk,1), UBOUND(OutData%xHat_Disk,1) - OutData%xHat_Disk(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%YawErr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%psi_skew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%chi_skew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%p_hub,1) - i1_u = UBOUND(OutData%p_hub,1) - DO i1 = LBOUND(OutData%p_hub,1), UBOUND(OutData%p_hub,1) - OutData%p_hub(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%D_rotor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DiskAvg_Vx_Rel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AzimAvg_Ct 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%AzimAvg_Ct)) DEALLOCATE(OutData%AzimAvg_Ct) - ALLOCATE(OutData%AzimAvg_Ct(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimAvg_Ct.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AzimAvg_Ct,1), UBOUND(OutData%AzimAvg_Ct,1) - OutData%AzimAvg_Ct(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AzimAvg_Cq 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%AzimAvg_Cq)) DEALLOCATE(OutData%AzimAvg_Cq) - ALLOCATE(OutData%AzimAvg_Cq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimAvg_Cq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AzimAvg_Cq,1), UBOUND(OutData%AzimAvg_Cq,1) - OutData%AzimAvg_Cq(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FWrap_UnPackOutput - + ErrMsg = '' + DstConstrStateData%dummy = SrcConstrStateData%dummy +end subroutine + +subroutine FWrap_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(FWrap_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FWrap_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_OtherStateType), intent(in) :: SrcOtherStateData + type(FWrap_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%dummy = SrcOtherStateData%dummy +end subroutine + +subroutine FWrap_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(FWrap_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FWrap_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_MiscVarType), intent(inout) :: SrcMiscData + type(FWrap_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FWrap_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call FAST_CopyTurbineType(SrcMiscData%Turbine, DstMiscData%Turbine, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%TempDisp)) then + LB(1:1) = lbound(SrcMiscData%TempDisp) + UB(1:1) = ubound(SrcMiscData%TempDisp) + if (.not. allocated(DstMiscData%TempDisp)) then + allocate(DstMiscData%TempDisp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TempDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMiscData%TempDisp(i1), DstMiscData%TempDisp(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%TempLoads)) then + LB(1:1) = lbound(SrcMiscData%TempLoads) + UB(1:1) = ubound(SrcMiscData%TempLoads) + if (.not. allocated(DstMiscData%TempLoads)) then + allocate(DstMiscData%TempLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TempLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMiscData%TempLoads(i1), DstMiscData%TempLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%ADRotorDisk)) then + LB(1:1) = lbound(SrcMiscData%ADRotorDisk) + UB(1:1) = ubound(SrcMiscData%ADRotorDisk) + if (.not. allocated(DstMiscData%ADRotorDisk)) then + allocate(DstMiscData%ADRotorDisk(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ADRotorDisk.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMiscData%ADRotorDisk(i1), DstMiscData%ADRotorDisk(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%AD_L2L)) then + LB(1:1) = lbound(SrcMiscData%AD_L2L) + UB(1:1) = ubound(SrcMiscData%AD_L2L) + if (.not. allocated(DstMiscData%AD_L2L)) then + allocate(DstMiscData%AD_L2L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AD_L2L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMiscData%AD_L2L(i1), DstMiscData%AD_L2L(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(FWrap_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FWrap_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call FAST_DestroyTurbineType(MiscData%Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%TempDisp)) then + LB(1:1) = lbound(MiscData%TempDisp) + UB(1:1) = ubound(MiscData%TempDisp) + do i1 = LB(1), UB(1) + call MeshDestroy( MiscData%TempDisp(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%TempDisp) + end if + if (allocated(MiscData%TempLoads)) then + LB(1:1) = lbound(MiscData%TempLoads) + UB(1:1) = ubound(MiscData%TempLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( MiscData%TempLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%TempLoads) + end if + if (allocated(MiscData%ADRotorDisk)) then + LB(1:1) = lbound(MiscData%ADRotorDisk) + UB(1:1) = ubound(MiscData%ADRotorDisk) + do i1 = LB(1), UB(1) + call MeshDestroy( MiscData%ADRotorDisk(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%ADRotorDisk) + end if + if (allocated(MiscData%AD_L2L)) then + LB(1:1) = lbound(MiscData%AD_L2L) + UB(1:1) = ubound(MiscData%AD_L2L) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%AD_L2L(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%AD_L2L) + end if +end subroutine + +subroutine FWrap_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call FAST_PackTurbineType(Buf, InData%Turbine) + call RegPack(Buf, allocated(InData%TempDisp)) + if (allocated(InData%TempDisp)) then + call RegPackBounds(Buf, 1, lbound(InData%TempDisp), ubound(InData%TempDisp)) + LB(1:1) = lbound(InData%TempDisp) + UB(1:1) = ubound(InData%TempDisp) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%TempDisp(i1)) + end do + end if + call RegPack(Buf, allocated(InData%TempLoads)) + if (allocated(InData%TempLoads)) then + call RegPackBounds(Buf, 1, lbound(InData%TempLoads), ubound(InData%TempLoads)) + LB(1:1) = lbound(InData%TempLoads) + UB(1:1) = ubound(InData%TempLoads) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%TempLoads(i1)) + end do + end if + call RegPack(Buf, allocated(InData%ADRotorDisk)) + if (allocated(InData%ADRotorDisk)) then + call RegPackBounds(Buf, 1, lbound(InData%ADRotorDisk), ubound(InData%ADRotorDisk)) + LB(1:1) = lbound(InData%ADRotorDisk) + UB(1:1) = ubound(InData%ADRotorDisk) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%ADRotorDisk(i1)) + end do + end if + call RegPack(Buf, allocated(InData%AD_L2L)) + if (allocated(InData%AD_L2L)) then + call RegPackBounds(Buf, 1, lbound(InData%AD_L2L), ubound(InData%AD_L2L)) + LB(1:1) = lbound(InData%AD_L2L) + UB(1:1) = ubound(InData%AD_L2L) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%AD_L2L(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call FAST_UnpackTurbineType(Buf, OutData%Turbine) ! Turbine + if (allocated(OutData%TempDisp)) deallocate(OutData%TempDisp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TempDisp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TempDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%TempDisp(i1)) ! TempDisp + end do + end if + if (allocated(OutData%TempLoads)) deallocate(OutData%TempLoads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TempLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TempLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%TempLoads(i1)) ! TempLoads + end do + end if + if (allocated(OutData%ADRotorDisk)) deallocate(OutData%ADRotorDisk) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ADRotorDisk(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADRotorDisk.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%ADRotorDisk(i1)) ! ADRotorDisk + end do + end if + if (allocated(OutData%AD_L2L)) deallocate(OutData%AD_L2L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AD_L2L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L2L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_L2L(i1)) ! AD_L2L + end do + end if +end subroutine + +subroutine FWrap_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_ParameterType), intent(in) :: SrcParamData + type(FWrap_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FWrap_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%nr = SrcParamData%nr + if (allocated(SrcParamData%r)) then + LB(1:1) = lbound(SrcParamData%r) + UB(1:1) = ubound(SrcParamData%r) + if (.not. allocated(DstParamData%r)) then + allocate(DstParamData%r(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%r.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%r = SrcParamData%r + end if + DstParamData%n_FAST_low = SrcParamData%n_FAST_low + DstParamData%p_ref_Turbine = SrcParamData%p_ref_Turbine +end subroutine + +subroutine FWrap_DestroyParam(ParamData, ErrStat, ErrMsg) + type(FWrap_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%r)) then + deallocate(ParamData%r) + end if +end subroutine + +subroutine FWrap_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%nr) + call RegPack(Buf, allocated(InData%r)) + if (allocated(InData%r)) then + call RegPackBounds(Buf, 1, lbound(InData%r), ubound(InData%r)) + call RegPack(Buf, InData%r) + end if + call RegPack(Buf, InData%n_FAST_low) + call RegPack(Buf, InData%p_ref_Turbine) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackParam' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%nr) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%r)) deallocate(OutData%r) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%n_FAST_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%p_ref_Turbine) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_InputType), intent(in) :: SrcInputData + type(FWrap_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FWrap_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%fromSCglob)) then + LB(1:1) = lbound(SrcInputData%fromSCglob) + UB(1:1) = ubound(SrcInputData%fromSCglob) + if (.not. allocated(DstInputData%fromSCglob)) then + allocate(DstInputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSCglob.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%fromSCglob = SrcInputData%fromSCglob + end if + if (allocated(SrcInputData%fromSC)) then + LB(1:1) = lbound(SrcInputData%fromSC) + UB(1:1) = ubound(SrcInputData%fromSC) + if (.not. allocated(DstInputData%fromSC)) then + allocate(DstInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%fromSC = SrcInputData%fromSC + end if +end subroutine + +subroutine FWrap_DestroyInput(InputData, ErrStat, ErrMsg) + type(FWrap_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%fromSCglob)) then + deallocate(InputData%fromSCglob) + end if + if (allocated(InputData%fromSC)) then + deallocate(InputData%fromSC) + end if +end subroutine + +subroutine FWrap_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%fromSCglob)) + if (allocated(InData%fromSCglob)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) + call RegPack(Buf, InData%fromSCglob) + end if + call RegPack(Buf, allocated(InData%fromSC)) + if (allocated(InData%fromSC)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPack(Buf, InData%fromSC) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSCglob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSCglob) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSC) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FWrap_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_OutputType), intent(in) :: SrcOutputData + type(FWrap_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FWrap_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%toSC)) then + LB(1:1) = lbound(SrcOutputData%toSC) + UB(1:1) = ubound(SrcOutputData%toSC) + if (.not. allocated(DstOutputData%toSC)) then + allocate(DstOutputData%toSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%toSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%toSC = SrcOutputData%toSC + end if + DstOutputData%xHat_Disk = SrcOutputData%xHat_Disk + DstOutputData%YawErr = SrcOutputData%YawErr + DstOutputData%psi_skew = SrcOutputData%psi_skew + DstOutputData%chi_skew = SrcOutputData%chi_skew + DstOutputData%p_hub = SrcOutputData%p_hub + DstOutputData%D_rotor = SrcOutputData%D_rotor + DstOutputData%DiskAvg_Vx_Rel = SrcOutputData%DiskAvg_Vx_Rel + if (allocated(SrcOutputData%AzimAvg_Ct)) then + LB(1:1) = lbound(SrcOutputData%AzimAvg_Ct) + UB(1:1) = ubound(SrcOutputData%AzimAvg_Ct) + if (.not. allocated(DstOutputData%AzimAvg_Ct)) then + allocate(DstOutputData%AzimAvg_Ct(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AzimAvg_Ct.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%AzimAvg_Ct = SrcOutputData%AzimAvg_Ct + end if + if (allocated(SrcOutputData%AzimAvg_Cq)) then + LB(1:1) = lbound(SrcOutputData%AzimAvg_Cq) + UB(1:1) = ubound(SrcOutputData%AzimAvg_Cq) + if (.not. allocated(DstOutputData%AzimAvg_Cq)) then + allocate(DstOutputData%AzimAvg_Cq(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AzimAvg_Cq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%AzimAvg_Cq = SrcOutputData%AzimAvg_Cq + end if +end subroutine + +subroutine FWrap_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(FWrap_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%toSC)) then + deallocate(OutputData%toSC) + end if + if (allocated(OutputData%AzimAvg_Ct)) then + deallocate(OutputData%AzimAvg_Ct) + end if + if (allocated(OutputData%AzimAvg_Cq)) then + deallocate(OutputData%AzimAvg_Cq) + end if +end subroutine + +subroutine FWrap_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%toSC)) + if (allocated(InData%toSC)) then + call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) + call RegPack(Buf, InData%toSC) + end if + call RegPack(Buf, InData%xHat_Disk) + call RegPack(Buf, InData%YawErr) + call RegPack(Buf, InData%psi_skew) + call RegPack(Buf, InData%chi_skew) + call RegPack(Buf, InData%p_hub) + call RegPack(Buf, InData%D_rotor) + call RegPack(Buf, InData%DiskAvg_Vx_Rel) + call RegPack(Buf, allocated(InData%AzimAvg_Ct)) + if (allocated(InData%AzimAvg_Ct)) then + call RegPackBounds(Buf, 1, lbound(InData%AzimAvg_Ct), ubound(InData%AzimAvg_Ct)) + call RegPack(Buf, InData%AzimAvg_Ct) + end if + call RegPack(Buf, allocated(InData%AzimAvg_Cq)) + if (allocated(InData%AzimAvg_Cq)) then + call RegPackBounds(Buf, 1, lbound(InData%AzimAvg_Cq), ubound(InData%AzimAvg_Cq)) + call RegPack(Buf, InData%AzimAvg_Cq) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%toSC)) deallocate(OutData%toSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%toSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%toSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%xHat_Disk) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawErr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%psi_skew) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%chi_skew) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%p_hub) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%D_rotor) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DiskAvg_Vx_Rel) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AzimAvg_Ct)) deallocate(OutData%AzimAvg_Ct) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AzimAvg_Ct(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimAvg_Ct.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AzimAvg_Ct) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AzimAvg_Cq)) deallocate(OutData%AzimAvg_Cq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AzimAvg_Cq(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimAvg_Cq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AzimAvg_Cq) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine END MODULE FASTWrapper_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index 51203da76d..c4582b0b6e 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -46,58 +46,58 @@ MODULE FAST_Farm_Types INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_MD = 5 ! Farm-level MoorDyn [-] ! ========= Farm_ParameterType ======= TYPE, PUBLIC :: Farm_ParameterType - REAL(DbKi) :: DT_low !< Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step [seconds] - REAL(DbKi) :: DT_high !< High-resolution time step [seconds] - REAL(DbKi) :: TMax !< Total run time [seconds] - INTEGER(IntKi) :: n_high_low !< Number of high-resolution time steps per low-resolution time step [-] - INTEGER(IntKi) :: NumTurbines !< Number of turbines in the simulation [-] + REAL(DbKi) :: DT_low = 0.0_R8Ki !< Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step [seconds] + REAL(DbKi) :: DT_high = 0.0_R8Ki !< High-resolution time step [seconds] + REAL(DbKi) :: TMax = 0.0_R8Ki !< Total run time [seconds] + INTEGER(IntKi) :: n_high_low = 0_IntKi !< Number of high-resolution time steps per low-resolution time step [-] + INTEGER(IntKi) :: NumTurbines = 0_IntKi !< Number of turbines in the simulation [-] CHARACTER(1024) :: WindFilePath !< Path name of wind data files from ABLSolver precursor [-] CHARACTER(1024) :: SC_FileName !< Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms [-] - LOGICAL :: UseSC !< Use a super controller? [-] + LOGICAL :: UseSC = .false. !< Use a super controller? [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WT_Position !< X-Y-Z position of each wind turbine; index 1 = XYZ; index 2 = turbine number [meters] - 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) :: MooringMod !< Mod_SharedMooring is a flag for array-level mooring. (switch) {0: none, 3: yes/MoorDyn} [-] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) {0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin} [-] + INTEGER(IntKi) :: MooringMod = 0_IntKi !< Mod_SharedMooring is a flag for array-level mooring. (switch) {0: none, 3: yes/MoorDyn} [-] CHARACTER(1024) :: MD_FileName !< Name/location of the farm-level MoorDyn input file [-] - REAL(DbKi) :: DT_mooring !< Time step for farm-levem mooring coupling with each turbine [used only when Mod_SharedMooring > 0] [seconds] - INTEGER(IntKi) :: n_mooring !< Number of FAST and MoorDyn time steps per FAST.Farm timestep when mooring > 0 [-] + REAL(DbKi) :: DT_mooring = 0.0_R8Ki !< Time step for farm-levem mooring coupling with each turbine [used only when Mod_SharedMooring > 0] [seconds] + INTEGER(IntKi) :: n_mooring = 0_IntKi !< Number of FAST and MoorDyn time steps per FAST.Farm timestep when mooring > 0 [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: WT_FASTInFile !< Name of input file for each turbine [-] CHARACTER(1024) :: FTitle !< The description line from the primary FAST.Farm input file [-] CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] - INTEGER(IntKi) :: n_ChkptTime !< Number of time steps between writing checkpoint files [-] - REAL(DbKi) :: TStart !< Time to begin tabular output [s] - INTEGER(IntKi) :: n_TMax !< Number of the time step of TMax (the end time of the simulation) [-] - LOGICAL :: SumPrint !< Print summary data to file? (.sum) [-] - LOGICAL :: WrBinOutFile !< Write a binary output file? (.outb) [-] - LOGICAL :: WrTxtOutFile !< Write a text (formatted) output file? (.out) [-] + INTEGER(IntKi) :: n_ChkptTime = 0_IntKi !< Number of time steps between writing checkpoint files [-] + REAL(DbKi) :: TStart = 0.0_R8Ki !< Time to begin tabular output [s] + INTEGER(IntKi) :: n_TMax = 0_IntKi !< Number of the time step of TMax (the end time of the simulation) [-] + LOGICAL :: SumPrint = .false. !< Print summary data to file? (.sum) [-] + LOGICAL :: WrBinOutFile = .false. !< Write a binary output file? (.outb) [-] + LOGICAL :: WrTxtOutFile = .false. !< Write a text (formatted) output file? (.out) [-] CHARACTER(1) :: Delim !< Delimiter between columns of text output file (.out): space or tab [-] CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time); resulting field should be 10 characters [-] CHARACTER(20) :: OutFmt_t !< Format used for time channel in text tabular output; resulting field should be 10 characters [-] - INTEGER(IntKi) :: FmtWidth !< width of the time OutFmt specifier [-] - INTEGER(IntKi) :: TChanLen !< width of the time channel [-] - INTEGER(IntKi) :: NOutTurb !< Number of turbines for write output [1 to 9] [-] - INTEGER(IntKi) :: NOutRadii !< Number of radial nodes for wake output for an individual rotor [0 to 20] [-] + INTEGER(IntKi) :: FmtWidth = 0_IntKi !< width of the time OutFmt specifier [-] + INTEGER(IntKi) :: TChanLen = 0_IntKi !< width of the time channel [-] + INTEGER(IntKi) :: NOutTurb = 0_IntKi !< Number of turbines for write output [1 to 9] [-] + INTEGER(IntKi) :: NOutRadii = 0_IntKi !< Number of radial nodes for wake output for an individual rotor [0 to 20] [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: OutRadii !< List of radial nodes for wake output for an individual rotor [1 to NOutRadii] [-] - INTEGER(IntKi) :: NOutDist !< Number of downstream distances for wake output for an individual rotor [0 to 9] [-] + INTEGER(IntKi) :: NOutDist = 0_IntKi !< Number of downstream distances for wake output for an individual rotor [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDist !< List of downstream distances for wake output for an individual rotor [1 to NOutDist] [meters] - INTEGER(IntKi) :: NWindVel !< Number of points for wind output [0 to 9] [-] + INTEGER(IntKi) :: NWindVel = 0_IntKi !< Number of points for wind output [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVelX !< List of coordinates in the X direction for wind output [1 to NWindVel] [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVelY !< List of coordinates in the Y direction for wind output [1 to NWindVel] [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVelZ !< List of coordinates in the Z direction for wind output [1 to NWindVel] [meters] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - INTEGER(IntKi) :: NumOuts !< Number of user-requested outputs [-] - INTEGER(IntKi) :: NOutSteps !< Maximum number of output steps [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of user-requested outputs [-] + INTEGER(IntKi) :: NOutSteps = 0_IntKi !< Maximum number of output steps [-] CHARACTER(1024) , DIMENSION(1:3) :: FileDescLines !< File Description lines [-] 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] - REAL(ReKi) :: dZ_low !< The spacing of the low-resolution nodes in Z direction [m] - INTEGER(IntKi) :: nX_low !< Number of low-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_low !< Number of low-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_low !< Number of low-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: X0_low !< X-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Y0_low !< Y-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Z0_low !< Z-component of the origin of the low-resolution spatial domain [m] + INTEGER(IntKi) :: UnOu = 0_IntKi !< File unit for Fast.Farm output data [-] + REAL(ReKi) :: dX_low = 0.0_ReKi !< The spacing of the low-resolution nodes in X direction [m] + REAL(ReKi) :: dY_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Y direction [m] + REAL(ReKi) :: dZ_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Z direction [m] + INTEGER(IntKi) :: nX_low = 0_IntKi !< Number of low-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_low = 0_IntKi !< Number of low-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_low = 0_IntKi !< Number of low-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: X0_low = 0.0_ReKi !< X-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Y0_low = 0.0_ReKi !< Y-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Z0_low = 0.0_ReKi !< Z-component of the origin of the low-resolution spatial domain [m] END TYPE Farm_ParameterType ! ======================= ! ========= Farm_MiscVarType ======= @@ -105,7 +105,7 @@ MODULE FAST_Farm_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TimeData !< Array to contain the time output data for the binary file (first output time and a time [fixed] increment) [-] 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) :: n_Out = 0_IntKi !< Time index into the AllOutData array [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: FWrap_2_MD !< Map platform kinematics from each FAST instance to MD [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: MD_2_FWrap !< Map MD loads at the array level to each FAST instance [-] END TYPE Farm_MiscVarType @@ -157,7 +157,7 @@ MODULE FAST_Farm_Types TYPE(SC_OtherStateType) :: OtherState !< Other states [-] TYPE(SC_ParameterType) :: p !< Parameters [-] TYPE(SC_InputType) :: uInputs !< System inputs [-] - REAL(DbKi) , DIMENSION(1:1) :: utimes !< Current time [s] + REAL(DbKi) , DIMENSION(1:1) :: utimes = 0.0_R8Ki !< Current time [s] TYPE(SC_OutputType) :: y !< System outputs [-] TYPE(SC_MiscVarType) :: m !< Misc/optimization variables [-] LOGICAL :: IsInitialized = .FALSE. !< Has SC_Init been called [-] @@ -190,6980 +190,1563 @@ MODULE FAST_Farm_Types END TYPE All_FastFarm_Data ! ======================= CONTAINS - SUBROUTINE Farm_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Farm_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Farm_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 = 'Farm_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT_low = SrcParamData%DT_low - DstParamData%DT_high = SrcParamData%DT_high - DstParamData%TMax = SrcParamData%TMax - DstParamData%n_high_low = SrcParamData%n_high_low - DstParamData%NumTurbines = SrcParamData%NumTurbines - DstParamData%WindFilePath = SrcParamData%WindFilePath - DstParamData%SC_FileName = SrcParamData%SC_FileName - DstParamData%UseSC = SrcParamData%UseSC -IF (ALLOCATED(SrcParamData%WT_Position)) THEN - i1_l = LBOUND(SrcParamData%WT_Position,1) - i1_u = UBOUND(SrcParamData%WT_Position,1) - i2_l = LBOUND(SrcParamData%WT_Position,2) - i2_u = UBOUND(SrcParamData%WT_Position,2) - IF (.NOT. ALLOCATED(DstParamData%WT_Position)) THEN - ALLOCATE(DstParamData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WT_Position = SrcParamData%WT_Position -ENDIF - DstParamData%WaveFieldMod = SrcParamData%WaveFieldMod - DstParamData%MooringMod = SrcParamData%MooringMod - DstParamData%MD_FileName = SrcParamData%MD_FileName - DstParamData%DT_mooring = SrcParamData%DT_mooring - DstParamData%n_mooring = SrcParamData%n_mooring -IF (ALLOCATED(SrcParamData%WT_FASTInFile)) THEN - i1_l = LBOUND(SrcParamData%WT_FASTInFile,1) - i1_u = UBOUND(SrcParamData%WT_FASTInFile,1) - IF (.NOT. ALLOCATED(DstParamData%WT_FASTInFile)) THEN - ALLOCATE(DstParamData%WT_FASTInFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_FASTInFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WT_FASTInFile = SrcParamData%WT_FASTInFile -ENDIF - DstParamData%FTitle = SrcParamData%FTitle - DstParamData%OutFileRoot = SrcParamData%OutFileRoot - DstParamData%n_ChkptTime = SrcParamData%n_ChkptTime - DstParamData%TStart = SrcParamData%TStart - DstParamData%n_TMax = SrcParamData%n_TMax - DstParamData%SumPrint = SrcParamData%SumPrint - DstParamData%WrBinOutFile = SrcParamData%WrBinOutFile - DstParamData%WrTxtOutFile = SrcParamData%WrTxtOutFile - DstParamData%Delim = SrcParamData%Delim - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutFmt_t = SrcParamData%OutFmt_t - DstParamData%FmtWidth = SrcParamData%FmtWidth - DstParamData%TChanLen = SrcParamData%TChanLen - DstParamData%NOutTurb = SrcParamData%NOutTurb - DstParamData%NOutRadii = SrcParamData%NOutRadii -IF (ALLOCATED(SrcParamData%OutRadii)) THEN - i1_l = LBOUND(SrcParamData%OutRadii,1) - i1_u = UBOUND(SrcParamData%OutRadii,1) - IF (.NOT. ALLOCATED(DstParamData%OutRadii)) THEN - ALLOCATE(DstParamData%OutRadii(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutRadii.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutRadii = SrcParamData%OutRadii -ENDIF - DstParamData%NOutDist = SrcParamData%NOutDist -IF (ALLOCATED(SrcParamData%OutDist)) THEN - i1_l = LBOUND(SrcParamData%OutDist,1) - i1_u = UBOUND(SrcParamData%OutDist,1) - IF (.NOT. ALLOCATED(DstParamData%OutDist)) THEN - ALLOCATE(DstParamData%OutDist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutDist = SrcParamData%OutDist -ENDIF - DstParamData%NWindVel = SrcParamData%NWindVel -IF (ALLOCATED(SrcParamData%WindVelX)) THEN - i1_l = LBOUND(SrcParamData%WindVelX,1) - i1_u = UBOUND(SrcParamData%WindVelX,1) - IF (.NOT. ALLOCATED(DstParamData%WindVelX)) THEN - ALLOCATE(DstParamData%WindVelX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WindVelX = SrcParamData%WindVelX -ENDIF -IF (ALLOCATED(SrcParamData%WindVelY)) THEN - i1_l = LBOUND(SrcParamData%WindVelY,1) - i1_u = UBOUND(SrcParamData%WindVelY,1) - IF (.NOT. ALLOCATED(DstParamData%WindVelY)) THEN - ALLOCATE(DstParamData%WindVelY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WindVelY = SrcParamData%WindVelY -ENDIF -IF (ALLOCATED(SrcParamData%WindVelZ)) THEN - i1_l = LBOUND(SrcParamData%WindVelZ,1) - i1_u = UBOUND(SrcParamData%WindVelZ,1) - IF (.NOT. ALLOCATED(DstParamData%WindVelZ)) THEN - ALLOCATE(DstParamData%WindVelZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WindVelZ = SrcParamData%WindVelZ -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%NOutSteps = SrcParamData%NOutSteps - DstParamData%FileDescLines = SrcParamData%FileDescLines - DO i1 = LBOUND(SrcParamData%Module_Ver,1), UBOUND(SrcParamData%Module_Ver,1) - CALL NWTC_Library_Copyprogdesc( SrcParamData%Module_Ver(i1), DstParamData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DstParamData%UnOu = SrcParamData%UnOu - DstParamData%dX_low = SrcParamData%dX_low - DstParamData%dY_low = SrcParamData%dY_low - DstParamData%dZ_low = SrcParamData%dZ_low - DstParamData%nX_low = SrcParamData%nX_low - DstParamData%nY_low = SrcParamData%nY_low - DstParamData%nZ_low = SrcParamData%nZ_low - DstParamData%X0_low = SrcParamData%X0_low - DstParamData%Y0_low = SrcParamData%Y0_low - DstParamData%Z0_low = SrcParamData%Z0_low - END SUBROUTINE Farm_CopyParam - - SUBROUTINE Farm_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(Farm_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 = 'Farm_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%WT_Position)) THEN - DEALLOCATE(ParamData%WT_Position) -ENDIF -IF (ALLOCATED(ParamData%WT_FASTInFile)) THEN - DEALLOCATE(ParamData%WT_FASTInFile) -ENDIF -IF (ALLOCATED(ParamData%OutRadii)) THEN - DEALLOCATE(ParamData%OutRadii) -ENDIF -IF (ALLOCATED(ParamData%OutDist)) THEN - DEALLOCATE(ParamData%OutDist) -ENDIF -IF (ALLOCATED(ParamData%WindVelX)) THEN - DEALLOCATE(ParamData%WindVelX) -ENDIF -IF (ALLOCATED(ParamData%WindVelY)) THEN - DEALLOCATE(ParamData%WindVelY) -ENDIF -IF (ALLOCATED(ParamData%WindVelZ)) THEN - DEALLOCATE(ParamData%WindVelZ) -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 -DO i1 = LBOUND(ParamData%Module_Ver,1), UBOUND(ParamData%Module_Ver,1) - CALL NWTC_Library_DestroyProgDesc( ParamData%Module_Ver(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - END SUBROUTINE Farm_DestroyParam - - SUBROUTINE Farm_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(Farm_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 = 'Farm_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_low - Db_BufSz = Db_BufSz + 1 ! DT_high - Db_BufSz = Db_BufSz + 1 ! TMax - Int_BufSz = Int_BufSz + 1 ! n_high_low - Int_BufSz = Int_BufSz + 1 ! NumTurbines - Int_BufSz = Int_BufSz + 1*LEN(InData%WindFilePath) ! WindFilePath - Int_BufSz = Int_BufSz + 1*LEN(InData%SC_FileName) ! SC_FileName - Int_BufSz = Int_BufSz + 1 ! UseSC - Int_BufSz = Int_BufSz + 1 ! WT_Position allocated yes/no - IF ( ALLOCATED(InData%WT_Position) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WT_Position upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WT_Position) ! WT_Position - END IF - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Int_BufSz = Int_BufSz + 1 ! MooringMod - Int_BufSz = Int_BufSz + 1*LEN(InData%MD_FileName) ! MD_FileName - Db_BufSz = Db_BufSz + 1 ! DT_mooring - Int_BufSz = Int_BufSz + 1 ! n_mooring - Int_BufSz = Int_BufSz + 1 ! WT_FASTInFile allocated yes/no - IF ( ALLOCATED(InData%WT_FASTInFile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WT_FASTInFile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WT_FASTInFile)*LEN(InData%WT_FASTInFile) ! WT_FASTInFile - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - Int_BufSz = Int_BufSz + 1 ! n_ChkptTime - Db_BufSz = Db_BufSz + 1 ! TStart - Int_BufSz = Int_BufSz + 1 ! n_TMax - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! WrBinOutFile - Int_BufSz = Int_BufSz + 1 ! WrTxtOutFile - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt_t) ! OutFmt_t - Int_BufSz = Int_BufSz + 1 ! FmtWidth - Int_BufSz = Int_BufSz + 1 ! TChanLen - Int_BufSz = Int_BufSz + 1 ! NOutTurb - Int_BufSz = Int_BufSz + 1 ! NOutRadii - Int_BufSz = Int_BufSz + 1 ! OutRadii allocated yes/no - IF ( ALLOCATED(InData%OutRadii) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutRadii upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutRadii) ! OutRadii - END IF - Int_BufSz = Int_BufSz + 1 ! NOutDist - Int_BufSz = Int_BufSz + 1 ! OutDist allocated yes/no - IF ( ALLOCATED(InData%OutDist) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDist upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDist) ! OutDist - END IF - Int_BufSz = Int_BufSz + 1 ! NWindVel - Int_BufSz = Int_BufSz + 1 ! WindVelX allocated yes/no - IF ( ALLOCATED(InData%WindVelX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVelX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVelX) ! WindVelX - END IF - Int_BufSz = Int_BufSz + 1 ! WindVelY allocated yes/no - IF ( ALLOCATED(InData%WindVelY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVelY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVelY) ! WindVelY - END IF - Int_BufSz = Int_BufSz + 1 ! WindVelZ allocated yes/no - IF ( ALLOCATED(InData%WindVelZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVelZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVelZ) ! WindVelZ - 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 ! NOutSteps - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Module_Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Module_Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Module_Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 1 ! UnOu - Re_BufSz = Re_BufSz + 1 ! dX_low - Re_BufSz = Re_BufSz + 1 ! dY_low - Re_BufSz = Re_BufSz + 1 ! dZ_low - Int_BufSz = Int_BufSz + 1 ! nX_low - Int_BufSz = Int_BufSz + 1 ! nY_low - Int_BufSz = Int_BufSz + 1 ! nZ_low - Re_BufSz = Re_BufSz + 1 ! X0_low - Re_BufSz = Re_BufSz + 1 ! Y0_low - Re_BufSz = Re_BufSz + 1 ! Z0_low - 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_low - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT_high - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_high_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTurbines - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WindFilePath) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFilePath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%SC_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%SC_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseSC, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WT_Position) ) 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%WT_Position,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_Position,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WT_Position,2), UBOUND(InData%WT_Position,2) - DO i1 = LBOUND(InData%WT_Position,1), UBOUND(InData%WT_Position,1) - ReKiBuf(Re_Xferred) = InData%WT_Position(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MooringMod - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%MD_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%MD_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%DT_mooring - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_mooring - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WT_FASTInFile) ) 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%WT_FASTInFile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_FASTInFile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WT_FASTInFile,1), UBOUND(InData%WT_FASTInFile,1) - DO I = 1, LEN(InData%WT_FASTInFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WT_FASTInFile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%FTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%n_ChkptTime - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TStart - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_TMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrBinOutFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrTxtOutFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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%OutFmt_t) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_t(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%FmtWidth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TChanLen - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutTurb - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutRadii - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutRadii) ) 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%OutRadii,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutRadii,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutRadii,1), UBOUND(InData%OutRadii,1) - IntKiBuf(Int_Xferred) = InData%OutRadii(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NOutDist - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDist) ) 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%OutDist,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDist,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDist,1), UBOUND(InData%OutDist,1) - ReKiBuf(Re_Xferred) = InData%OutDist(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NWindVel - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WindVelX) ) 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%WindVelX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVelX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WindVelX,1), UBOUND(InData%WindVelX,1) - ReKiBuf(Re_Xferred) = InData%WindVelX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindVelY) ) 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%WindVelY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVelY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WindVelY,1), UBOUND(InData%WindVelY,1) - ReKiBuf(Re_Xferred) = InData%WindVelY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindVelZ) ) 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%WindVelZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVelZ,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WindVelZ,1), UBOUND(InData%WindVelZ,1) - ReKiBuf(Re_Xferred) = InData%WindVelZ(i1) - Re_Xferred = Re_Xferred + 1 - 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%NOutSteps - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%FileDescLines,1), UBOUND(InData%FileDescLines,1) - DO I = 1, LEN(InData%FileDescLines) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileDescLines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - 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 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 - IntKiBuf(Int_Xferred) = InData%UnOu - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dX_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dY_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dZ_low - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nX_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_low - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0_low - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Farm_PackParam - - SUBROUTINE Farm_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(Farm_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 = 'Farm_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_low = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DT_high = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%n_high_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WindFilePath) - OutData%WindFilePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%SC_FileName) - OutData%SC_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UseSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseSC) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT_Position 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%WT_Position)) DEALLOCATE(OutData%WT_Position) - ALLOCATE(OutData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WT_Position,2), UBOUND(OutData%WT_Position,2) - DO i1 = LBOUND(OutData%WT_Position,1), UBOUND(OutData%WT_Position,1) - OutData%WT_Position(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MooringMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%MD_FileName) - OutData%MD_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%DT_mooring = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%n_mooring = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT_FASTInFile 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%WT_FASTInFile)) DEALLOCATE(OutData%WT_FASTInFile) - ALLOCATE(OutData%WT_FASTInFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_FASTInFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WT_FASTInFile,1), UBOUND(OutData%WT_FASTInFile,1) - DO I = 1, LEN(OutData%WT_FASTInFile) - OutData%WT_FASTInFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%FTitle) - OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%n_ChkptTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TStart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%n_TMax = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%WrBinOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrBinOutFile) - Int_Xferred = Int_Xferred + 1 - OutData%WrTxtOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrTxtOutFile) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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%OutFmt_t) - OutData%OutFmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%FmtWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TChanLen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutTurb = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutRadii = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutRadii 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%OutRadii)) DEALLOCATE(OutData%OutRadii) - ALLOCATE(OutData%OutRadii(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutRadii.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutRadii,1), UBOUND(OutData%OutRadii,1) - OutData%OutRadii(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NOutDist = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDist 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%OutDist)) DEALLOCATE(OutData%OutDist) - ALLOCATE(OutData%OutDist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDist,1), UBOUND(OutData%OutDist,1) - OutData%OutDist(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NWindVel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVelX 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%WindVelX)) DEALLOCATE(OutData%WindVelX) - ALLOCATE(OutData%WindVelX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVelX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVelX,1), UBOUND(OutData%WindVelX,1) - OutData%WindVelX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVelY 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%WindVelY)) DEALLOCATE(OutData%WindVelY) - ALLOCATE(OutData%WindVelY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVelY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVelY,1), UBOUND(OutData%WindVelY,1) - OutData%WindVelY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVelZ 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%WindVelZ)) DEALLOCATE(OutData%WindVelZ) - ALLOCATE(OutData%WindVelZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVelZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVelZ,1), UBOUND(OutData%WindVelZ,1) - OutData%WindVelZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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%NOutSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%FileDescLines,1) - i1_u = UBOUND(OutData%FileDescLines,1) - DO i1 = LBOUND(OutData%FileDescLines,1), UBOUND(OutData%FileDescLines,1) - DO I = 1, LEN(OutData%FileDescLines) - OutData%FileDescLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - i1_l = LBOUND(OutData%Module_Ver,1) - i1_u = UBOUND(OutData%Module_Ver,1) - DO i1 = LBOUND(OutData%Module_Ver,1), UBOUND(OutData%Module_Ver,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_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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - OutData%UnOu = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dX_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dY_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dZ_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nX_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Farm_UnPackParam - - SUBROUTINE Farm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Farm_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(Farm_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) :: 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 = 'Farm_CopyMisc' -! +subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Farm_ParameterType), intent(in) :: SrcParamData + type(Farm_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyParam' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF -IF (ALLOCATED(SrcMiscData%TimeData)) THEN - i1_l = LBOUND(SrcMiscData%TimeData,1) - i1_u = UBOUND(SrcMiscData%TimeData,1) - IF (.NOT. ALLOCATED(DstMiscData%TimeData)) THEN - ALLOCATE(DstMiscData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%TimeData = SrcMiscData%TimeData -ENDIF -IF (ALLOCATED(SrcMiscData%AllOutData)) THEN - i1_l = LBOUND(SrcMiscData%AllOutData,1) - i1_u = UBOUND(SrcMiscData%AllOutData,1) - i2_l = LBOUND(SrcMiscData%AllOutData,2) - i2_u = UBOUND(SrcMiscData%AllOutData,2) - IF (.NOT. ALLOCATED(DstMiscData%AllOutData)) THEN - ALLOCATE(DstMiscData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOutData = SrcMiscData%AllOutData -ENDIF - DstMiscData%n_Out = SrcMiscData%n_Out -IF (ALLOCATED(SrcMiscData%FWrap_2_MD)) THEN - i1_l = LBOUND(SrcMiscData%FWrap_2_MD,1) - i1_u = UBOUND(SrcMiscData%FWrap_2_MD,1) - IF (.NOT. ALLOCATED(DstMiscData%FWrap_2_MD)) THEN - ALLOCATE(DstMiscData%FWrap_2_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FWrap_2_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%FWrap_2_MD,1), UBOUND(SrcMiscData%FWrap_2_MD,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%FWrap_2_MD(i1), DstMiscData%FWrap_2_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%MD_2_FWrap)) THEN - i1_l = LBOUND(SrcMiscData%MD_2_FWrap,1) - i1_u = UBOUND(SrcMiscData%MD_2_FWrap,1) - IF (.NOT. ALLOCATED(DstMiscData%MD_2_FWrap)) THEN - ALLOCATE(DstMiscData%MD_2_FWrap(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MD_2_FWrap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%MD_2_FWrap,1), UBOUND(SrcMiscData%MD_2_FWrap,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%MD_2_FWrap(i1), DstMiscData%MD_2_FWrap(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE Farm_CopyMisc - - SUBROUTINE Farm_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(Farm_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 = 'Farm_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%TimeData)) THEN - DEALLOCATE(MiscData%TimeData) -ENDIF -IF (ALLOCATED(MiscData%AllOutData)) THEN - DEALLOCATE(MiscData%AllOutData) -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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%MD_2_FWrap) -ENDIF - END SUBROUTINE Farm_DestroyMisc - - SUBROUTINE Farm_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(Farm_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 = 'Farm_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 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Int_BufSz = Int_BufSz + 1 ! TimeData allocated yes/no - IF ( ALLOCATED(InData%TimeData) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TimeData upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TimeData) ! TimeData - END IF - Int_BufSz = Int_BufSz + 1 ! AllOutData allocated yes/no - IF ( ALLOCATED(InData%AllOutData) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AllOutData upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOutData) ! AllOutData - END IF - Int_BufSz = Int_BufSz + 1 ! n_Out - Int_BufSz = Int_BufSz + 1 ! FWrap_2_MD allocated yes/no - IF ( ALLOCATED(InData%FWrap_2_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FWrap_2_MD upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FWrap_2_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FWrap_2_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FWrap_2_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MD_2_FWrap allocated yes/no - IF ( ALLOCATED(InData%MD_2_FWrap) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MD_2_FWrap - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MD_2_FWrap - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MD_2_FWrap - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%AllOuts) ) 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%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TimeData) ) 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%TimeData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TimeData,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TimeData,1), UBOUND(InData%TimeData,1) - DbKiBuf(Db_Xferred) = InData%TimeData(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AllOutData) ) 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%AllOutData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AllOutData,2), UBOUND(InData%AllOutData,2) - DO i1 = LBOUND(InData%AllOutData,1), UBOUND(InData%AllOutData,1) - ReKiBuf(Re_Xferred) = InData%AllOutData(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n_Out - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FWrap_2_MD) ) 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%FWrap_2_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FWrap_2_MD,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%MD_2_FWrap) ) 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%MD_2_FWrap,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MD_2_FWrap,1) - 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 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 - END SUBROUTINE Farm_PackMisc - - SUBROUTINE Farm_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(Farm_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) :: 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 = 'Farm_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts 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%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TimeData 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%TimeData)) DEALLOCATE(OutData%TimeData) - ALLOCATE(OutData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TimeData,1), UBOUND(OutData%TimeData,1) - OutData%TimeData(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOutData 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%AllOutData)) DEALLOCATE(OutData%AllOutData) - ALLOCATE(OutData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AllOutData,2), UBOUND(OutData%AllOutData,2) - DO i1 = LBOUND(OutData%AllOutData,1), UBOUND(OutData%AllOutData,1) - OutData%AllOutData(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%n_Out = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FWrap_2_MD 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%FWrap_2_MD)) DEALLOCATE(OutData%FWrap_2_MD) - ALLOCATE(OutData%FWrap_2_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FWrap_2_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FWrap_2_MD,1), UBOUND(OutData%FWrap_2_MD,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_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 - - 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 ! MD_2_FWrap 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%MD_2_FWrap)) DEALLOCATE(OutData%MD_2_FWrap) - ALLOCATE(OutData%MD_2_FWrap(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MD_2_FWrap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MD_2_FWrap,1), UBOUND(OutData%MD_2_FWrap,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_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 - - 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 - END SUBROUTINE Farm_UnPackMisc - - SUBROUTINE Farm_CopyFASTWrapper_Data( SrcFASTWrapper_DataData, DstFASTWrapper_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FASTWrapper_Data), INTENT(INOUT) :: SrcFASTWrapper_DataData - TYPE(FASTWrapper_Data), INTENT(INOUT) :: DstFASTWrapper_DataData - 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 = 'Farm_CopyFASTWrapper_Data' -! + ErrMsg = '' + DstParamData%DT_low = SrcParamData%DT_low + DstParamData%DT_high = SrcParamData%DT_high + DstParamData%TMax = SrcParamData%TMax + DstParamData%n_high_low = SrcParamData%n_high_low + DstParamData%NumTurbines = SrcParamData%NumTurbines + DstParamData%WindFilePath = SrcParamData%WindFilePath + DstParamData%SC_FileName = SrcParamData%SC_FileName + DstParamData%UseSC = SrcParamData%UseSC + if (allocated(SrcParamData%WT_Position)) then + LB(1:2) = lbound(SrcParamData%WT_Position) + UB(1:2) = ubound(SrcParamData%WT_Position) + if (.not. allocated(DstParamData%WT_Position)) then + allocate(DstParamData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_Position.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WT_Position = SrcParamData%WT_Position + end if + DstParamData%WaveFieldMod = SrcParamData%WaveFieldMod + DstParamData%MooringMod = SrcParamData%MooringMod + DstParamData%MD_FileName = SrcParamData%MD_FileName + DstParamData%DT_mooring = SrcParamData%DT_mooring + DstParamData%n_mooring = SrcParamData%n_mooring + if (allocated(SrcParamData%WT_FASTInFile)) then + LB(1:1) = lbound(SrcParamData%WT_FASTInFile) + UB(1:1) = ubound(SrcParamData%WT_FASTInFile) + if (.not. allocated(DstParamData%WT_FASTInFile)) then + allocate(DstParamData%WT_FASTInFile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_FASTInFile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WT_FASTInFile = SrcParamData%WT_FASTInFile + end if + DstParamData%FTitle = SrcParamData%FTitle + DstParamData%OutFileRoot = SrcParamData%OutFileRoot + DstParamData%n_ChkptTime = SrcParamData%n_ChkptTime + DstParamData%TStart = SrcParamData%TStart + DstParamData%n_TMax = SrcParamData%n_TMax + DstParamData%SumPrint = SrcParamData%SumPrint + DstParamData%WrBinOutFile = SrcParamData%WrBinOutFile + DstParamData%WrTxtOutFile = SrcParamData%WrTxtOutFile + DstParamData%Delim = SrcParamData%Delim + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutFmt_t = SrcParamData%OutFmt_t + DstParamData%FmtWidth = SrcParamData%FmtWidth + DstParamData%TChanLen = SrcParamData%TChanLen + DstParamData%NOutTurb = SrcParamData%NOutTurb + DstParamData%NOutRadii = SrcParamData%NOutRadii + if (allocated(SrcParamData%OutRadii)) then + LB(1:1) = lbound(SrcParamData%OutRadii) + UB(1:1) = ubound(SrcParamData%OutRadii) + if (.not. allocated(DstParamData%OutRadii)) then + allocate(DstParamData%OutRadii(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutRadii.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutRadii = SrcParamData%OutRadii + end if + DstParamData%NOutDist = SrcParamData%NOutDist + if (allocated(SrcParamData%OutDist)) then + LB(1:1) = lbound(SrcParamData%OutDist) + UB(1:1) = ubound(SrcParamData%OutDist) + if (.not. allocated(DstParamData%OutDist)) then + allocate(DstParamData%OutDist(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDist.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutDist = SrcParamData%OutDist + end if + DstParamData%NWindVel = SrcParamData%NWindVel + if (allocated(SrcParamData%WindVelX)) then + LB(1:1) = lbound(SrcParamData%WindVelX) + UB(1:1) = ubound(SrcParamData%WindVelX) + if (.not. allocated(DstParamData%WindVelX)) then + allocate(DstParamData%WindVelX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WindVelX = SrcParamData%WindVelX + end if + if (allocated(SrcParamData%WindVelY)) then + LB(1:1) = lbound(SrcParamData%WindVelY) + UB(1:1) = ubound(SrcParamData%WindVelY) + if (.not. allocated(DstParamData%WindVelY)) then + allocate(DstParamData%WindVelY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WindVelY = SrcParamData%WindVelY + end if + if (allocated(SrcParamData%WindVelZ)) then + LB(1:1) = lbound(SrcParamData%WindVelZ) + UB(1:1) = ubound(SrcParamData%WindVelZ) + if (.not. allocated(DstParamData%WindVelZ)) then + allocate(DstParamData%WindVelZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WindVelZ = SrcParamData%WindVelZ + end if + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NOutSteps = SrcParamData%NOutSteps + DstParamData%FileDescLines = SrcParamData%FileDescLines + LB(1:1) = lbound(SrcParamData%Module_Ver) + UB(1:1) = ubound(SrcParamData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyProgDesc(SrcParamData%Module_Ver(i1), DstParamData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + DstParamData%UnOu = SrcParamData%UnOu + DstParamData%dX_low = SrcParamData%dX_low + DstParamData%dY_low = SrcParamData%dY_low + DstParamData%dZ_low = SrcParamData%dZ_low + DstParamData%nX_low = SrcParamData%nX_low + DstParamData%nY_low = SrcParamData%nY_low + DstParamData%nZ_low = SrcParamData%nZ_low + DstParamData%X0_low = SrcParamData%X0_low + DstParamData%Y0_low = SrcParamData%Y0_low + DstParamData%Z0_low = SrcParamData%Z0_low +end subroutine + +subroutine Farm_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Farm_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyParam' ErrStat = ErrID_None - ErrMsg = "" - CALL FWrap_CopyContState( SrcFASTWrapper_DataData%x, DstFASTWrapper_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyDiscState( SrcFASTWrapper_DataData%xd, DstFASTWrapper_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyConstrState( SrcFASTWrapper_DataData%z, DstFASTWrapper_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyOtherState( SrcFASTWrapper_DataData%OtherSt, DstFASTWrapper_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyParam( SrcFASTWrapper_DataData%p, DstFASTWrapper_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyInput( SrcFASTWrapper_DataData%u, DstFASTWrapper_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyOutput( SrcFASTWrapper_DataData%y, DstFASTWrapper_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyMisc( SrcFASTWrapper_DataData%m, DstFASTWrapper_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstFASTWrapper_DataData%IsInitialized = SrcFASTWrapper_DataData%IsInitialized - END SUBROUTINE Farm_CopyFASTWrapper_Data - - SUBROUTINE Farm_DestroyFASTWrapper_Data( FASTWrapper_DataData, ErrStat, ErrMsg ) - TYPE(FASTWrapper_Data), INTENT(INOUT) :: FASTWrapper_DataData - 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 = 'Farm_DestroyFASTWrapper_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL FWrap_DestroyContState( FASTWrapper_DataData%x, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyDiscState( FASTWrapper_DataData%xd, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyConstrState( FASTWrapper_DataData%z, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyOtherState( FASTWrapper_DataData%OtherSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyParam( FASTWrapper_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyInput( FASTWrapper_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyOutput( FASTWrapper_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyMisc( FASTWrapper_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroyFASTWrapper_Data - - SUBROUTINE Farm_PackFASTWrapper_Data( 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(FASTWrapper_Data), 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 = 'Farm_PackFASTWrapper_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL FWrap_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL FWrap_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL FWrap_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL FWrap_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL FWrap_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL FWrap_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL FWrap_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL FWrap_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IsInitialized - 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 - - CALL FWrap_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - CALL FWrap_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - CALL FWrap_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - CALL FWrap_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL FWrap_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL FWrap_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL FWrap_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL FWrap_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_PackFASTWrapper_Data - - SUBROUTINE Farm_UnPackFASTWrapper_Data( 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(FASTWrapper_Data), 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 = 'Farm_UnPackFASTWrapper_Data' - ! 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 - 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 FWrap_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - 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) - 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 FWrap_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - 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) - 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 FWrap_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - 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) - 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 FWrap_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - 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) - 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 FWrap_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 FWrap_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 FWrap_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 FWrap_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - OutData%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_UnPackFASTWrapper_Data - - SUBROUTINE Farm_CopyWakeDynamics_Data( SrcWakeDynamics_DataData, DstWakeDynamics_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WakeDynamics_Data), INTENT(IN) :: SrcWakeDynamics_DataData - TYPE(WakeDynamics_Data), INTENT(INOUT) :: DstWakeDynamics_DataData - 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 = 'Farm_CopyWakeDynamics_Data' -! + ErrMsg = '' + if (allocated(ParamData%WT_Position)) then + deallocate(ParamData%WT_Position) + end if + if (allocated(ParamData%WT_FASTInFile)) then + deallocate(ParamData%WT_FASTInFile) + end if + if (allocated(ParamData%OutRadii)) then + deallocate(ParamData%OutRadii) + end if + if (allocated(ParamData%OutDist)) then + deallocate(ParamData%OutDist) + end if + if (allocated(ParamData%WindVelX)) then + deallocate(ParamData%WindVelX) + end if + if (allocated(ParamData%WindVelY)) then + deallocate(ParamData%WindVelY) + end if + if (allocated(ParamData%WindVelZ)) then + deallocate(ParamData%WindVelZ) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + LB(1:1) = lbound(ParamData%Module_Ver) + UB(1:1) = ubound(ParamData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyProgDesc(ParamData%Module_Ver(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do +end subroutine + +subroutine Farm_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Farm_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT_low) + call RegPack(Buf, InData%DT_high) + call RegPack(Buf, InData%TMax) + call RegPack(Buf, InData%n_high_low) + call RegPack(Buf, InData%NumTurbines) + call RegPack(Buf, InData%WindFilePath) + call RegPack(Buf, InData%SC_FileName) + call RegPack(Buf, InData%UseSC) + call RegPack(Buf, allocated(InData%WT_Position)) + if (allocated(InData%WT_Position)) then + call RegPackBounds(Buf, 2, lbound(InData%WT_Position), ubound(InData%WT_Position)) + call RegPack(Buf, InData%WT_Position) + end if + call RegPack(Buf, InData%WaveFieldMod) + call RegPack(Buf, InData%MooringMod) + call RegPack(Buf, InData%MD_FileName) + call RegPack(Buf, InData%DT_mooring) + call RegPack(Buf, InData%n_mooring) + call RegPack(Buf, allocated(InData%WT_FASTInFile)) + if (allocated(InData%WT_FASTInFile)) then + call RegPackBounds(Buf, 1, lbound(InData%WT_FASTInFile), ubound(InData%WT_FASTInFile)) + call RegPack(Buf, InData%WT_FASTInFile) + end if + call RegPack(Buf, InData%FTitle) + call RegPack(Buf, InData%OutFileRoot) + call RegPack(Buf, InData%n_ChkptTime) + call RegPack(Buf, InData%TStart) + call RegPack(Buf, InData%n_TMax) + call RegPack(Buf, InData%SumPrint) + call RegPack(Buf, InData%WrBinOutFile) + call RegPack(Buf, InData%WrTxtOutFile) + call RegPack(Buf, InData%Delim) + call RegPack(Buf, InData%OutFmt) + call RegPack(Buf, InData%OutFmt_t) + call RegPack(Buf, InData%FmtWidth) + call RegPack(Buf, InData%TChanLen) + call RegPack(Buf, InData%NOutTurb) + call RegPack(Buf, InData%NOutRadii) + call RegPack(Buf, allocated(InData%OutRadii)) + if (allocated(InData%OutRadii)) then + call RegPackBounds(Buf, 1, lbound(InData%OutRadii), ubound(InData%OutRadii)) + call RegPack(Buf, InData%OutRadii) + end if + call RegPack(Buf, InData%NOutDist) + call RegPack(Buf, allocated(InData%OutDist)) + if (allocated(InData%OutDist)) then + call RegPackBounds(Buf, 1, lbound(InData%OutDist), ubound(InData%OutDist)) + call RegPack(Buf, InData%OutDist) + end if + call RegPack(Buf, InData%NWindVel) + call RegPack(Buf, allocated(InData%WindVelX)) + if (allocated(InData%WindVelX)) then + call RegPackBounds(Buf, 1, lbound(InData%WindVelX), ubound(InData%WindVelX)) + call RegPack(Buf, InData%WindVelX) + end if + call RegPack(Buf, allocated(InData%WindVelY)) + if (allocated(InData%WindVelY)) then + call RegPackBounds(Buf, 1, lbound(InData%WindVelY), ubound(InData%WindVelY)) + call RegPack(Buf, InData%WindVelY) + end if + call RegPack(Buf, allocated(InData%WindVelZ)) + if (allocated(InData%WindVelZ)) then + call RegPackBounds(Buf, 1, lbound(InData%WindVelZ), ubound(InData%WindVelZ)) + call RegPack(Buf, InData%WindVelZ) + end if + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%NOutSteps) + call RegPack(Buf, InData%FileDescLines) + LB(1:1) = lbound(InData%Module_Ver) + UB(1:1) = ubound(InData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_PackProgDesc(Buf, InData%Module_Ver(i1)) + end do + call RegPack(Buf, InData%UnOu) + call RegPack(Buf, InData%dX_low) + call RegPack(Buf, InData%dY_low) + call RegPack(Buf, InData%dZ_low) + call RegPack(Buf, InData%nX_low) + call RegPack(Buf, InData%nY_low) + call RegPack(Buf, InData%nZ_low) + call RegPack(Buf, InData%X0_low) + call RegPack(Buf, InData%Y0_low) + call RegPack(Buf, InData%Z0_low) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Farm_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DT_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_high_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumTurbines) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WindFilePath) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SC_FileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UseSC) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WT_Position)) deallocate(OutData%WT_Position) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WT_Position(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WT_Position) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MooringMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MD_FileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DT_mooring) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_mooring) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WT_FASTInFile)) deallocate(OutData%WT_FASTInFile) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WT_FASTInFile(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_FASTInFile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WT_FASTInFile) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%FTitle) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_ChkptTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TStart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_TMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrBinOutFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrTxtOutFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt_t) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FmtWidth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TChanLen) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NOutTurb) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NOutRadii) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutRadii)) deallocate(OutData%OutRadii) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutRadii(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutRadii.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutRadii) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NOutDist) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutDist)) deallocate(OutData%OutDist) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutDist(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDist.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutDist) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NWindVel) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WindVelX)) deallocate(OutData%WindVelX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindVelX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVelX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindVelX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WindVelY)) deallocate(OutData%WindVelY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindVelY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVelY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindVelY) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WindVelZ)) deallocate(OutData%WindVelZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindVelZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVelZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindVelZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NOutSteps) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FileDescLines) + if (RegCheckErr(Buf, RoutineName)) return + LB(1:1) = lbound(OutData%Module_Ver) + UB(1:1) = ubound(OutData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackProgDesc(Buf, OutData%Module_Ver(i1)) ! Module_Ver + end do + call RegUnpack(Buf, OutData%UnOu) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dX_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dY_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dZ_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nX_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nY_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nZ_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%X0_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Y0_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Z0_low) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Farm_MiscVarType), intent(inout) :: SrcMiscData + type(Farm_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" - CALL WD_CopyContState( SrcWakeDynamics_DataData%x, DstWakeDynamics_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyDiscState( SrcWakeDynamics_DataData%xd, DstWakeDynamics_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyConstrState( SrcWakeDynamics_DataData%z, DstWakeDynamics_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyOtherState( SrcWakeDynamics_DataData%OtherSt, DstWakeDynamics_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyParam( SrcWakeDynamics_DataData%p, DstWakeDynamics_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyInput( SrcWakeDynamics_DataData%u, DstWakeDynamics_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyOutput( SrcWakeDynamics_DataData%y, DstWakeDynamics_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyMisc( SrcWakeDynamics_DataData%m, DstWakeDynamics_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstWakeDynamics_DataData%IsInitialized = SrcWakeDynamics_DataData%IsInitialized - END SUBROUTINE Farm_CopyWakeDynamics_Data - - SUBROUTINE Farm_DestroyWakeDynamics_Data( WakeDynamics_DataData, ErrStat, ErrMsg ) - TYPE(WakeDynamics_Data), INTENT(INOUT) :: WakeDynamics_DataData - 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 = 'Farm_DestroyWakeDynamics_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL WD_DestroyContState( WakeDynamics_DataData%x, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyDiscState( WakeDynamics_DataData%xd, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyConstrState( WakeDynamics_DataData%z, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyOtherState( WakeDynamics_DataData%OtherSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyParam( WakeDynamics_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyInput( WakeDynamics_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyOutput( WakeDynamics_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyMisc( WakeDynamics_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroyWakeDynamics_Data - - SUBROUTINE Farm_PackWakeDynamics_Data( 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(WakeDynamics_Data), 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 = 'Farm_PackWakeDynamics_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL WD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL WD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL WD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL WD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL WD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL WD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL WD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL WD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IsInitialized - 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 - - CALL WD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - CALL WD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - CALL WD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - CALL WD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL WD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL WD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL WD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL WD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_PackWakeDynamics_Data - - SUBROUTINE Farm_UnPackWakeDynamics_Data( 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(WakeDynamics_Data), 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 = 'Farm_UnPackWakeDynamics_Data' - ! 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 - 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 WD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - 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) - 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 WD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - 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) - 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 WD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - 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) - 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 WD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - 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) - 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 WD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 WD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 WD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 WD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - OutData%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_UnPackWakeDynamics_Data - - SUBROUTINE Farm_CopyAWAE_Data( SrcAWAE_DataData, DstAWAE_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_Data), INTENT(IN) :: SrcAWAE_DataData - TYPE(AWAE_Data), INTENT(INOUT) :: DstAWAE_DataData - 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 = 'Farm_CopyAWAE_Data' -! + ErrMsg = '' + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + end if + if (allocated(SrcMiscData%TimeData)) then + LB(1:1) = lbound(SrcMiscData%TimeData) + UB(1:1) = ubound(SrcMiscData%TimeData) + if (.not. allocated(DstMiscData%TimeData)) then + allocate(DstMiscData%TimeData(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TimeData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%TimeData = SrcMiscData%TimeData + end if + if (allocated(SrcMiscData%AllOutData)) then + LB(1:2) = lbound(SrcMiscData%AllOutData) + UB(1:2) = ubound(SrcMiscData%AllOutData) + if (.not. allocated(DstMiscData%AllOutData)) then + allocate(DstMiscData%AllOutData(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOutData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOutData = SrcMiscData%AllOutData + end if + DstMiscData%n_Out = SrcMiscData%n_Out + if (allocated(SrcMiscData%FWrap_2_MD)) then + LB(1:1) = lbound(SrcMiscData%FWrap_2_MD) + UB(1:1) = ubound(SrcMiscData%FWrap_2_MD) + if (.not. allocated(DstMiscData%FWrap_2_MD)) then + allocate(DstMiscData%FWrap_2_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FWrap_2_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMiscData%FWrap_2_MD(i1), DstMiscData%FWrap_2_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%MD_2_FWrap)) then + LB(1:1) = lbound(SrcMiscData%MD_2_FWrap) + UB(1:1) = ubound(SrcMiscData%MD_2_FWrap) + if (.not. allocated(DstMiscData%MD_2_FWrap)) then + allocate(DstMiscData%MD_2_FWrap(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MD_2_FWrap.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMiscData%MD_2_FWrap(i1), DstMiscData%MD_2_FWrap(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine Farm_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Farm_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyMisc' ErrStat = ErrID_None - ErrMsg = "" - CALL AWAE_CopyContState( SrcAWAE_DataData%x, DstAWAE_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyDiscState( SrcAWAE_DataData%xd, DstAWAE_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyConstrState( SrcAWAE_DataData%z, DstAWAE_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyOtherState( SrcAWAE_DataData%OtherSt, DstAWAE_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyParam( SrcAWAE_DataData%p, DstAWAE_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyInput( SrcAWAE_DataData%u, DstAWAE_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyOutput( SrcAWAE_DataData%y, DstAWAE_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyMisc( SrcAWAE_DataData%m, DstAWAE_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstAWAE_DataData%IsInitialized = SrcAWAE_DataData%IsInitialized - END SUBROUTINE Farm_CopyAWAE_Data - - SUBROUTINE Farm_DestroyAWAE_Data( AWAE_DataData, ErrStat, ErrMsg ) - TYPE(AWAE_Data), INTENT(INOUT) :: AWAE_DataData - 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 = 'Farm_DestroyAWAE_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AWAE_DestroyContState( AWAE_DataData%x, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyDiscState( AWAE_DataData%xd, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyConstrState( AWAE_DataData%z, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyOtherState( AWAE_DataData%OtherSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyParam( AWAE_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyInput( AWAE_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyOutput( AWAE_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyMisc( AWAE_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroyAWAE_Data - - SUBROUTINE Farm_PackAWAE_Data( 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(AWAE_Data), 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 = 'Farm_PackAWAE_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL AWAE_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL AWAE_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL AWAE_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL AWAE_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL AWAE_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL AWAE_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL AWAE_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL AWAE_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IsInitialized - 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 - - CALL AWAE_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - CALL AWAE_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - CALL AWAE_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - CALL AWAE_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL AWAE_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL AWAE_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL AWAE_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL AWAE_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_PackAWAE_Data - - SUBROUTINE Farm_UnPackAWAE_Data( 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(AWAE_Data), 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 = 'Farm_UnPackAWAE_Data' - ! 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 - 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 AWAE_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - 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) - 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 AWAE_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - 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) - 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 AWAE_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - 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) - 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 AWAE_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - 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) - 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 AWAE_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 AWAE_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 AWAE_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 AWAE_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - OutData%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_UnPackAWAE_Data - - SUBROUTINE Farm_CopySC_Data( SrcSC_DataData, DstSC_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_Data), INTENT(IN) :: SrcSC_DataData - TYPE(SC_Data), INTENT(INOUT) :: DstSC_DataData - 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 = 'Farm_CopySC_Data' -! + ErrMsg = '' + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%TimeData)) then + deallocate(MiscData%TimeData) + end if + if (allocated(MiscData%AllOutData)) then + deallocate(MiscData%AllOutData) + end if + if (allocated(MiscData%FWrap_2_MD)) then + LB(1:1) = lbound(MiscData%FWrap_2_MD) + UB(1:1) = ubound(MiscData%FWrap_2_MD) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%FWrap_2_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%FWrap_2_MD) + end if + if (allocated(MiscData%MD_2_FWrap)) then + LB(1:1) = lbound(MiscData%MD_2_FWrap) + UB(1:1) = ubound(MiscData%MD_2_FWrap) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%MD_2_FWrap(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%MD_2_FWrap) + end if +end subroutine + +subroutine Farm_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Farm_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + call RegPack(Buf, allocated(InData%TimeData)) + if (allocated(InData%TimeData)) then + call RegPackBounds(Buf, 1, lbound(InData%TimeData), ubound(InData%TimeData)) + call RegPack(Buf, InData%TimeData) + end if + call RegPack(Buf, allocated(InData%AllOutData)) + if (allocated(InData%AllOutData)) then + call RegPackBounds(Buf, 2, lbound(InData%AllOutData), ubound(InData%AllOutData)) + call RegPack(Buf, InData%AllOutData) + end if + call RegPack(Buf, InData%n_Out) + call RegPack(Buf, allocated(InData%FWrap_2_MD)) + if (allocated(InData%FWrap_2_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%FWrap_2_MD), ubound(InData%FWrap_2_MD)) + LB(1:1) = lbound(InData%FWrap_2_MD) + UB(1:1) = ubound(InData%FWrap_2_MD) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%FWrap_2_MD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%MD_2_FWrap)) + if (allocated(InData%MD_2_FWrap)) then + call RegPackBounds(Buf, 1, lbound(InData%MD_2_FWrap), ubound(InData%MD_2_FWrap)) + LB(1:1) = lbound(InData%MD_2_FWrap) + UB(1:1) = ubound(InData%MD_2_FWrap) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%MD_2_FWrap(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Farm_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TimeData)) deallocate(OutData%TimeData) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TimeData(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TimeData) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AllOutData)) deallocate(OutData%AllOutData) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOutData(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOutData) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%n_Out) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%FWrap_2_MD)) deallocate(OutData%FWrap_2_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FWrap_2_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FWrap_2_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%FWrap_2_MD(i1)) ! FWrap_2_MD + end do + end if + if (allocated(OutData%MD_2_FWrap)) deallocate(OutData%MD_2_FWrap) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MD_2_FWrap(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MD_2_FWrap.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%MD_2_FWrap(i1)) ! MD_2_FWrap + end do + end if +end subroutine + +subroutine Farm_CopyFASTWrapper_Data(SrcFASTWrapper_DataData, DstFASTWrapper_DataData, CtrlCode, ErrStat, ErrMsg) + type(FASTWrapper_Data), intent(inout) :: SrcFASTWrapper_DataData + type(FASTWrapper_Data), intent(inout) :: DstFASTWrapper_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyFASTWrapper_Data' ErrStat = ErrID_None - ErrMsg = "" - CALL SC_CopyContState( SrcSC_DataData%x, DstSC_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyDiscState( SrcSC_DataData%xd, DstSC_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyConstrState( SrcSC_DataData%z, DstSC_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyOtherState( SrcSC_DataData%OtherState, DstSC_DataData%OtherState, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyParam( SrcSC_DataData%p, DstSC_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyInput( SrcSC_DataData%uInputs, DstSC_DataData%uInputs, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstSC_DataData%utimes = SrcSC_DataData%utimes - CALL SC_CopyOutput( SrcSC_DataData%y, DstSC_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyMisc( SrcSC_DataData%m, DstSC_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstSC_DataData%IsInitialized = SrcSC_DataData%IsInitialized - END SUBROUTINE Farm_CopySC_Data - - SUBROUTINE Farm_DestroySC_Data( SC_DataData, ErrStat, ErrMsg ) - TYPE(SC_Data), INTENT(INOUT) :: SC_DataData - 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 = 'Farm_DestroySC_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL SC_DestroyContState( SC_DataData%x, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyDiscState( SC_DataData%xd, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyConstrState( SC_DataData%z, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyOtherState( SC_DataData%OtherState, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyParam( SC_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyInput( SC_DataData%uInputs, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyOutput( SC_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyMisc( SC_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroySC_Data - - SUBROUTINE Farm_PackSC_Data( 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(SC_Data), 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 = 'Farm_PackSC_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL SC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherState: size of buffers for each call to pack subtype - CALL SC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState, ErrStat2, ErrMsg2, .TRUE. ) ! OtherState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherState - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherState - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherState - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! uInputs: size of buffers for each call to pack subtype - CALL SC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%uInputs, ErrStat2, ErrMsg2, .TRUE. ) ! uInputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! uInputs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! uInputs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! uInputs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + SIZE(InData%utimes) ! utimes - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IsInitialized - 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 - - CALL SC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - CALL SC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - CALL SC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - CALL SC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState, ErrStat2, ErrMsg2, OnlySize ) ! OtherState - 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 - CALL SC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL SC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%uInputs, ErrStat2, ErrMsg2, OnlySize ) ! uInputs - 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 - DO i1 = LBOUND(InData%utimes,1), UBOUND(InData%utimes,1) - DbKiBuf(Db_Xferred) = InData%utimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - CALL SC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL SC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_PackSC_Data - - SUBROUTINE Farm_UnPackSC_Data( 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(SC_Data), 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 = 'Farm_UnPackSC_Data' - ! 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 - 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 SC_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - 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) - 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 SC_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - 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) - 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 SC_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - 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) - 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 SC_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherState, ErrStat2, ErrMsg2 ) ! OtherState - 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) - 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 SC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 SC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%uInputs, ErrStat2, ErrMsg2 ) ! uInputs - 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) - i1_l = LBOUND(OutData%utimes,1) - i1_u = UBOUND(OutData%utimes,1) - DO i1 = LBOUND(OutData%utimes,1), UBOUND(OutData%utimes,1) - OutData%utimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - 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 SC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 SC_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - OutData%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_UnPackSC_Data - - SUBROUTINE Farm_CopyMD_Data( SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Data), INTENT(INOUT) :: SrcMD_DataData - TYPE(MD_Data), INTENT(INOUT) :: DstMD_DataData - 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 = 'Farm_CopyMD_Data' -! + ErrMsg = '' + call FWrap_CopyContState(SrcFASTWrapper_DataData%x, DstFASTWrapper_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyDiscState(SrcFASTWrapper_DataData%xd, DstFASTWrapper_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyConstrState(SrcFASTWrapper_DataData%z, DstFASTWrapper_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyOtherState(SrcFASTWrapper_DataData%OtherSt, DstFASTWrapper_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyParam(SrcFASTWrapper_DataData%p, DstFASTWrapper_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyInput(SrcFASTWrapper_DataData%u, DstFASTWrapper_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyOutput(SrcFASTWrapper_DataData%y, DstFASTWrapper_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyMisc(SrcFASTWrapper_DataData%m, DstFASTWrapper_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstFASTWrapper_DataData%IsInitialized = SrcFASTWrapper_DataData%IsInitialized +end subroutine + +subroutine Farm_DestroyFASTWrapper_Data(FASTWrapper_DataData, ErrStat, ErrMsg) + type(FASTWrapper_Data), intent(inout) :: FASTWrapper_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyFASTWrapper_Data' ErrStat = ErrID_None - ErrMsg = "" - CALL MD_CopyContState( SrcMD_DataData%x, DstMD_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyDiscState( SrcMD_DataData%xd, DstMD_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyConstrState( SrcMD_DataData%z, DstMD_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyOtherState( SrcMD_DataData%OtherSt, DstMD_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyParam( SrcMD_DataData%p, DstMD_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyInput( SrcMD_DataData%u, DstMD_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMD_DataData%Input)) THEN - i1_l = LBOUND(SrcMD_DataData%Input,1) - i1_u = UBOUND(SrcMD_DataData%Input,1) - IF (.NOT. ALLOCATED(DstMD_DataData%Input)) THEN - ALLOCATE(DstMD_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMD_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMD_DataData%Input,1), UBOUND(SrcMD_DataData%Input,1) - CALL MD_CopyInput( SrcMD_DataData%Input(i1), DstMD_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMD_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcMD_DataData%InputTimes,1) - i1_u = UBOUND(SrcMD_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstMD_DataData%InputTimes)) THEN - ALLOCATE(DstMD_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMD_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMD_DataData%InputTimes = SrcMD_DataData%InputTimes -ENDIF - CALL MD_CopyOutput( SrcMD_DataData%y, DstMD_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyMisc( SrcMD_DataData%m, DstMD_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMD_DataData%IsInitialized = SrcMD_DataData%IsInitialized - END SUBROUTINE Farm_CopyMD_Data - - SUBROUTINE Farm_DestroyMD_Data( MD_DataData, ErrStat, ErrMsg ) - TYPE(MD_Data), INTENT(INOUT) :: MD_DataData - 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 = 'Farm_DestroyMD_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MD_DestroyContState( MD_DataData%x, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyDiscState( MD_DataData%xd, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyConstrState( MD_DataData%z, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyOtherState( MD_DataData%OtherSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyParam( MD_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MD_DataData%Input) -ENDIF -IF (ALLOCATED(MD_DataData%InputTimes)) THEN - DEALLOCATE(MD_DataData%InputTimes) -ENDIF - CALL MD_DestroyOutput( MD_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyMisc( MD_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroyMD_Data - - SUBROUTINE Farm_PackMD_Data( 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(MD_Data), 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 = 'Farm_PackMD_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IsInitialized - 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 - - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_PackMD_Data - - SUBROUTINE Farm_UnPackMD_Data( 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(MD_Data), 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 = 'Farm_UnPackMD_Data' - ! 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 - 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 MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - 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) - 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 MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - 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) - 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 MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - 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) - 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 MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - 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) - 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 MD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - 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 MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 MD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - OutData%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_UnPackMD_Data - - SUBROUTINE Farm_CopyAll_FastFarm_Data( SrcAll_FastFarm_DataData, DstAll_FastFarm_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(All_FastFarm_Data), INTENT(INOUT) :: SrcAll_FastFarm_DataData - TYPE(All_FastFarm_Data), INTENT(INOUT) :: DstAll_FastFarm_DataData - 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 = 'Farm_CopyAll_FastFarm_Data' -! + ErrMsg = '' + call FWrap_DestroyContState(FASTWrapper_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyDiscState(FASTWrapper_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyConstrState(FASTWrapper_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyOtherState(FASTWrapper_DataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyParam(FASTWrapper_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyInput(FASTWrapper_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyOutput(FASTWrapper_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyMisc(FASTWrapper_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Farm_PackFASTWrapper_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FASTWrapper_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackFASTWrapper_Data' + if (Buf%ErrStat >= AbortErrLev) return + call FWrap_PackContState(Buf, InData%x) + call FWrap_PackDiscState(Buf, InData%xd) + call FWrap_PackConstrState(Buf, InData%z) + call FWrap_PackOtherState(Buf, InData%OtherSt) + call FWrap_PackParam(Buf, InData%p) + call FWrap_PackInput(Buf, InData%u) + call FWrap_PackOutput(Buf, InData%y) + call FWrap_PackMisc(Buf, InData%m) + call RegPack(Buf, InData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackFASTWrapper_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FASTWrapper_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackFASTWrapper_Data' + if (Buf%ErrStat /= ErrID_None) return + call FWrap_UnpackContState(Buf, OutData%x) ! x + call FWrap_UnpackDiscState(Buf, OutData%xd) ! xd + call FWrap_UnpackConstrState(Buf, OutData%z) ! z + call FWrap_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt + call FWrap_UnpackParam(Buf, OutData%p) ! p + call FWrap_UnpackInput(Buf, OutData%u) ! u + call FWrap_UnpackOutput(Buf, OutData%y) ! y + call FWrap_UnpackMisc(Buf, OutData%m) ! m + call RegUnpack(Buf, OutData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_CopyWakeDynamics_Data(SrcWakeDynamics_DataData, DstWakeDynamics_DataData, CtrlCode, ErrStat, ErrMsg) + type(WakeDynamics_Data), intent(in) :: SrcWakeDynamics_DataData + type(WakeDynamics_Data), intent(inout) :: DstWakeDynamics_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyWakeDynamics_Data' ErrStat = ErrID_None - ErrMsg = "" - CALL Farm_CopyParam( SrcAll_FastFarm_DataData%p, DstAll_FastFarm_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Farm_CopyMisc( SrcAll_FastFarm_DataData%m, DstAll_FastFarm_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAll_FastFarm_DataData%FWrap)) THEN - i1_l = LBOUND(SrcAll_FastFarm_DataData%FWrap,1) - i1_u = UBOUND(SrcAll_FastFarm_DataData%FWrap,1) - IF (.NOT. ALLOCATED(DstAll_FastFarm_DataData%FWrap)) THEN - ALLOCATE(DstAll_FastFarm_DataData%FWrap(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAll_FastFarm_DataData%FWrap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAll_FastFarm_DataData%FWrap,1), UBOUND(SrcAll_FastFarm_DataData%FWrap,1) - CALL Farm_Copyfastwrapper_data( SrcAll_FastFarm_DataData%FWrap(i1), DstAll_FastFarm_DataData%FWrap(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcAll_FastFarm_DataData%WD)) THEN - i1_l = LBOUND(SrcAll_FastFarm_DataData%WD,1) - i1_u = UBOUND(SrcAll_FastFarm_DataData%WD,1) - IF (.NOT. ALLOCATED(DstAll_FastFarm_DataData%WD)) THEN - ALLOCATE(DstAll_FastFarm_DataData%WD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAll_FastFarm_DataData%WD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAll_FastFarm_DataData%WD,1), UBOUND(SrcAll_FastFarm_DataData%WD,1) - CALL Farm_Copywakedynamics_data( SrcAll_FastFarm_DataData%WD(i1), DstAll_FastFarm_DataData%WD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Farm_Copyawae_data( SrcAll_FastFarm_DataData%AWAE, DstAll_FastFarm_DataData%AWAE, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Farm_Copysc_data( SrcAll_FastFarm_DataData%SC, DstAll_FastFarm_DataData%SC, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Farm_Copymd_data( SrcAll_FastFarm_DataData%MD, DstAll_FastFarm_DataData%MD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE Farm_CopyAll_FastFarm_Data - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyAll_FastFarm_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(All_FastFarm_DataData%WD) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Farm_DestroyMD_Data( All_FastFarm_DataData%MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroyAll_FastFarm_Data - - SUBROUTINE Farm_PackAll_FastFarm_Data( 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(All_FastFarm_Data), 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 = 'Farm_PackAll_FastFarm_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL Farm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL Farm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! FWrap allocated yes/no - IF ( ALLOCATED(InData%FWrap) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FWrap - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FWrap - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FWrap - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WD allocated yes/no - IF ( ALLOCATED(InData%WD) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AWAE - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AWAE - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AWAE - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MD - 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 - - CALL Farm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL Farm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IF ( .NOT. ALLOCATED(InData%FWrap) ) 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%FWrap,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FWrap,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%WD) ) 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%WD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WD,1) - 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 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 Farm_PackAll_FastFarm_Data - - SUBROUTINE Farm_UnPackAll_FastFarm_Data( 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(All_FastFarm_Data), 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 = 'Farm_UnPackAll_FastFarm_Data' - ! 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 - 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 Farm_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 Farm_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FWrap 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%FWrap)) DEALLOCATE(OutData%FWrap) - ALLOCATE(OutData%FWrap(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FWrap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FWrap,1), UBOUND(OutData%FWrap,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 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 - - 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 ! WD 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%WD)) DEALLOCATE(OutData%WD) - ALLOCATE(OutData%WD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WD,1), UBOUND(OutData%WD,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 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 - - 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 - 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 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 - - 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 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 - - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE Farm_UnPackAll_FastFarm_Data - + ErrMsg = '' + call WD_CopyContState(SrcWakeDynamics_DataData%x, DstWakeDynamics_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyDiscState(SrcWakeDynamics_DataData%xd, DstWakeDynamics_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyConstrState(SrcWakeDynamics_DataData%z, DstWakeDynamics_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyOtherState(SrcWakeDynamics_DataData%OtherSt, DstWakeDynamics_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyParam(SrcWakeDynamics_DataData%p, DstWakeDynamics_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyInput(SrcWakeDynamics_DataData%u, DstWakeDynamics_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyOutput(SrcWakeDynamics_DataData%y, DstWakeDynamics_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyMisc(SrcWakeDynamics_DataData%m, DstWakeDynamics_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstWakeDynamics_DataData%IsInitialized = SrcWakeDynamics_DataData%IsInitialized +end subroutine + +subroutine Farm_DestroyWakeDynamics_Data(WakeDynamics_DataData, ErrStat, ErrMsg) + type(WakeDynamics_Data), intent(inout) :: WakeDynamics_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyWakeDynamics_Data' + ErrStat = ErrID_None + ErrMsg = '' + call WD_DestroyContState(WakeDynamics_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyDiscState(WakeDynamics_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyConstrState(WakeDynamics_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyOtherState(WakeDynamics_DataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyParam(WakeDynamics_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyInput(WakeDynamics_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyOutput(WakeDynamics_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyMisc(WakeDynamics_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Farm_PackWakeDynamics_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WakeDynamics_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackWakeDynamics_Data' + if (Buf%ErrStat >= AbortErrLev) return + call WD_PackContState(Buf, InData%x) + call WD_PackDiscState(Buf, InData%xd) + call WD_PackConstrState(Buf, InData%z) + call WD_PackOtherState(Buf, InData%OtherSt) + call WD_PackParam(Buf, InData%p) + call WD_PackInput(Buf, InData%u) + call WD_PackOutput(Buf, InData%y) + call WD_PackMisc(Buf, InData%m) + call RegPack(Buf, InData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackWakeDynamics_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WakeDynamics_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackWakeDynamics_Data' + if (Buf%ErrStat /= ErrID_None) return + call WD_UnpackContState(Buf, OutData%x) ! x + call WD_UnpackDiscState(Buf, OutData%xd) ! xd + call WD_UnpackConstrState(Buf, OutData%z) ! z + call WD_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt + call WD_UnpackParam(Buf, OutData%p) ! p + call WD_UnpackInput(Buf, OutData%u) ! u + call WD_UnpackOutput(Buf, OutData%y) ! y + call WD_UnpackMisc(Buf, OutData%m) ! m + call RegUnpack(Buf, OutData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_CopyAWAE_Data(SrcAWAE_DataData, DstAWAE_DataData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_Data), intent(in) :: SrcAWAE_DataData + type(AWAE_Data), intent(inout) :: DstAWAE_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyAWAE_Data' + ErrStat = ErrID_None + ErrMsg = '' + call AWAE_CopyContState(SrcAWAE_DataData%x, DstAWAE_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyDiscState(SrcAWAE_DataData%xd, DstAWAE_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyConstrState(SrcAWAE_DataData%z, DstAWAE_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyOtherState(SrcAWAE_DataData%OtherSt, DstAWAE_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyParam(SrcAWAE_DataData%p, DstAWAE_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyInput(SrcAWAE_DataData%u, DstAWAE_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyOutput(SrcAWAE_DataData%y, DstAWAE_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyMisc(SrcAWAE_DataData%m, DstAWAE_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstAWAE_DataData%IsInitialized = SrcAWAE_DataData%IsInitialized +end subroutine + +subroutine Farm_DestroyAWAE_Data(AWAE_DataData, ErrStat, ErrMsg) + type(AWAE_Data), intent(inout) :: AWAE_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyAWAE_Data' + ErrStat = ErrID_None + ErrMsg = '' + call AWAE_DestroyContState(AWAE_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyDiscState(AWAE_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyConstrState(AWAE_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyOtherState(AWAE_DataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyParam(AWAE_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyInput(AWAE_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyOutput(AWAE_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyMisc(AWAE_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Farm_PackAWAE_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackAWAE_Data' + if (Buf%ErrStat >= AbortErrLev) return + call AWAE_PackContState(Buf, InData%x) + call AWAE_PackDiscState(Buf, InData%xd) + call AWAE_PackConstrState(Buf, InData%z) + call AWAE_PackOtherState(Buf, InData%OtherSt) + call AWAE_PackParam(Buf, InData%p) + call AWAE_PackInput(Buf, InData%u) + call AWAE_PackOutput(Buf, InData%y) + call AWAE_PackMisc(Buf, InData%m) + call RegPack(Buf, InData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackAWAE_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackAWAE_Data' + if (Buf%ErrStat /= ErrID_None) return + call AWAE_UnpackContState(Buf, OutData%x) ! x + call AWAE_UnpackDiscState(Buf, OutData%xd) ! xd + call AWAE_UnpackConstrState(Buf, OutData%z) ! z + call AWAE_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt + call AWAE_UnpackParam(Buf, OutData%p) ! p + call AWAE_UnpackInput(Buf, OutData%u) ! u + call AWAE_UnpackOutput(Buf, OutData%y) ! y + call AWAE_UnpackMisc(Buf, OutData%m) ! m + call RegUnpack(Buf, OutData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_CopySC_Data(SrcSC_DataData, DstSC_DataData, CtrlCode, ErrStat, ErrMsg) + type(SC_Data), intent(in) :: SrcSC_DataData + type(SC_Data), intent(inout) :: DstSC_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopySC_Data' + ErrStat = ErrID_None + ErrMsg = '' + call SC_CopyContState(SrcSC_DataData%x, DstSC_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyDiscState(SrcSC_DataData%xd, DstSC_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyConstrState(SrcSC_DataData%z, DstSC_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyOtherState(SrcSC_DataData%OtherState, DstSC_DataData%OtherState, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyParam(SrcSC_DataData%p, DstSC_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyInput(SrcSC_DataData%uInputs, DstSC_DataData%uInputs, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstSC_DataData%utimes = SrcSC_DataData%utimes + call SC_CopyOutput(SrcSC_DataData%y, DstSC_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyMisc(SrcSC_DataData%m, DstSC_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstSC_DataData%IsInitialized = SrcSC_DataData%IsInitialized +end subroutine + +subroutine Farm_DestroySC_Data(SC_DataData, ErrStat, ErrMsg) + type(SC_Data), intent(inout) :: SC_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroySC_Data' + ErrStat = ErrID_None + ErrMsg = '' + call SC_DestroyContState(SC_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyDiscState(SC_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyConstrState(SC_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyOtherState(SC_DataData%OtherState, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyParam(SC_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyInput(SC_DataData%uInputs, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyOutput(SC_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyMisc(SC_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Farm_PackSC_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackSC_Data' + if (Buf%ErrStat >= AbortErrLev) return + call SC_PackContState(Buf, InData%x) + call SC_PackDiscState(Buf, InData%xd) + call SC_PackConstrState(Buf, InData%z) + call SC_PackOtherState(Buf, InData%OtherState) + call SC_PackParam(Buf, InData%p) + call SC_PackInput(Buf, InData%uInputs) + call RegPack(Buf, InData%utimes) + call SC_PackOutput(Buf, InData%y) + call SC_PackMisc(Buf, InData%m) + call RegPack(Buf, InData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackSC_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackSC_Data' + if (Buf%ErrStat /= ErrID_None) return + call SC_UnpackContState(Buf, OutData%x) ! x + call SC_UnpackDiscState(Buf, OutData%xd) ! xd + call SC_UnpackConstrState(Buf, OutData%z) ! z + call SC_UnpackOtherState(Buf, OutData%OtherState) ! OtherState + call SC_UnpackParam(Buf, OutData%p) ! p + call SC_UnpackInput(Buf, OutData%uInputs) ! uInputs + call RegUnpack(Buf, OutData%utimes) + if (RegCheckErr(Buf, RoutineName)) return + call SC_UnpackOutput(Buf, OutData%y) ! y + call SC_UnpackMisc(Buf, OutData%m) ! m + call RegUnpack(Buf, OutData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_CopyMD_Data(SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, ErrMsg) + type(MD_Data), intent(inout) :: SrcMD_DataData + type(MD_Data), intent(inout) :: DstMD_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyMD_Data' + ErrStat = ErrID_None + ErrMsg = '' + call MD_CopyContState(SrcMD_DataData%x, DstMD_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyDiscState(SrcMD_DataData%xd, DstMD_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyConstrState(SrcMD_DataData%z, DstMD_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyOtherState(SrcMD_DataData%OtherSt, DstMD_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyParam(SrcMD_DataData%p, DstMD_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyInput(SrcMD_DataData%u, DstMD_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMD_DataData%Input)) then + LB(1:1) = lbound(SrcMD_DataData%Input) + UB(1:1) = ubound(SrcMD_DataData%Input) + if (.not. allocated(DstMD_DataData%Input)) then + allocate(DstMD_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMD_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyInput(SrcMD_DataData%Input(i1), DstMD_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMD_DataData%InputTimes)) then + LB(1:1) = lbound(SrcMD_DataData%InputTimes) + UB(1:1) = ubound(SrcMD_DataData%InputTimes) + if (.not. allocated(DstMD_DataData%InputTimes)) then + allocate(DstMD_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMD_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMD_DataData%InputTimes = SrcMD_DataData%InputTimes + end if + call MD_CopyOutput(SrcMD_DataData%y, DstMD_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyMisc(SrcMD_DataData%m, DstMD_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMD_DataData%IsInitialized = SrcMD_DataData%IsInitialized +end subroutine + +subroutine Farm_DestroyMD_Data(MD_DataData, ErrStat, ErrMsg) + type(MD_Data), intent(inout) :: MD_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyMD_Data' + ErrStat = ErrID_None + ErrMsg = '' + call MD_DestroyContState(MD_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyDiscState(MD_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyConstrState(MD_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyOtherState(MD_DataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyParam(MD_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyInput(MD_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MD_DataData%Input)) then + LB(1:1) = lbound(MD_DataData%Input) + UB(1:1) = ubound(MD_DataData%Input) + do i1 = LB(1), UB(1) + call MD_DestroyInput(MD_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MD_DataData%Input) + end if + if (allocated(MD_DataData%InputTimes)) then + deallocate(MD_DataData%InputTimes) + end if + call MD_DestroyOutput(MD_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyMisc(MD_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Farm_PackMD_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackMD_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call MD_PackContState(Buf, InData%x) + call MD_PackDiscState(Buf, InData%xd) + call MD_PackConstrState(Buf, InData%z) + call MD_PackOtherState(Buf, InData%OtherSt) + call MD_PackParam(Buf, InData%p) + call MD_PackInput(Buf, InData%u) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call MD_PackInput(Buf, InData%Input(i1)) + end do + end if + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + call MD_PackOutput(Buf, InData%y) + call MD_PackMisc(Buf, InData%m) + call RegPack(Buf, InData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackMD_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackMD_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call MD_UnpackContState(Buf, OutData%x) ! x + call MD_UnpackDiscState(Buf, OutData%xd) ! xd + call MD_UnpackConstrState(Buf, OutData%z) ! z + call MD_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt + call MD_UnpackParam(Buf, OutData%p) ! p + call MD_UnpackInput(Buf, OutData%u) ! u + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if + call MD_UnpackOutput(Buf, OutData%y) ! y + call MD_UnpackMisc(Buf, OutData%m) ! m + call RegUnpack(Buf, OutData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_CopyAll_FastFarm_Data(SrcAll_FastFarm_DataData, DstAll_FastFarm_DataData, CtrlCode, ErrStat, ErrMsg) + type(All_FastFarm_Data), intent(inout) :: SrcAll_FastFarm_DataData + type(All_FastFarm_Data), intent(inout) :: DstAll_FastFarm_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyAll_FastFarm_Data' + ErrStat = ErrID_None + ErrMsg = '' + call Farm_CopyParam(SrcAll_FastFarm_DataData%p, DstAll_FastFarm_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Farm_CopyMisc(SrcAll_FastFarm_DataData%m, DstAll_FastFarm_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcAll_FastFarm_DataData%FWrap)) then + LB(1:1) = lbound(SrcAll_FastFarm_DataData%FWrap) + UB(1:1) = ubound(SrcAll_FastFarm_DataData%FWrap) + if (.not. allocated(DstAll_FastFarm_DataData%FWrap)) then + allocate(DstAll_FastFarm_DataData%FWrap(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAll_FastFarm_DataData%FWrap.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Farm_CopyFASTWrapper_Data(SrcAll_FastFarm_DataData%FWrap(i1), DstAll_FastFarm_DataData%FWrap(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAll_FastFarm_DataData%WD)) then + LB(1:1) = lbound(SrcAll_FastFarm_DataData%WD) + UB(1:1) = ubound(SrcAll_FastFarm_DataData%WD) + if (.not. allocated(DstAll_FastFarm_DataData%WD)) then + allocate(DstAll_FastFarm_DataData%WD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAll_FastFarm_DataData%WD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Farm_CopyWakeDynamics_Data(SrcAll_FastFarm_DataData%WD(i1), DstAll_FastFarm_DataData%WD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Farm_CopyAWAE_Data(SrcAll_FastFarm_DataData%AWAE, DstAll_FastFarm_DataData%AWAE, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Farm_CopySC_Data(SrcAll_FastFarm_DataData%SC, DstAll_FastFarm_DataData%SC, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Farm_CopyMD_Data(SrcAll_FastFarm_DataData%MD, DstAll_FastFarm_DataData%MD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +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 + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyAll_FastFarm_Data' + ErrStat = ErrID_None + ErrMsg = '' + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(All_FastFarm_DataData%FWrap)) then + LB(1:1) = lbound(All_FastFarm_DataData%FWrap) + UB(1:1) = ubound(All_FastFarm_DataData%FWrap) + do i1 = LB(1), UB(1) + call Farm_DestroyFASTWrapper_Data(All_FastFarm_DataData%FWrap(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(All_FastFarm_DataData%FWrap) + end if + if (allocated(All_FastFarm_DataData%WD)) then + LB(1:1) = lbound(All_FastFarm_DataData%WD) + UB(1:1) = ubound(All_FastFarm_DataData%WD) + do i1 = LB(1), UB(1) + call Farm_DestroyWakeDynamics_Data(All_FastFarm_DataData%WD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(All_FastFarm_DataData%WD) + end if + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Farm_DestroyMD_Data(All_FastFarm_DataData%MD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Farm_PackAll_FastFarm_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(All_FastFarm_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackAll_FastFarm_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call Farm_PackParam(Buf, InData%p) + call Farm_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%FWrap)) + if (allocated(InData%FWrap)) then + call RegPackBounds(Buf, 1, lbound(InData%FWrap), ubound(InData%FWrap)) + LB(1:1) = lbound(InData%FWrap) + UB(1:1) = ubound(InData%FWrap) + do i1 = LB(1), UB(1) + call Farm_PackFASTWrapper_Data(Buf, InData%FWrap(i1)) + end do + end if + call RegPack(Buf, allocated(InData%WD)) + if (allocated(InData%WD)) then + call RegPackBounds(Buf, 1, lbound(InData%WD), ubound(InData%WD)) + LB(1:1) = lbound(InData%WD) + UB(1:1) = ubound(InData%WD) + do i1 = LB(1), UB(1) + call Farm_PackWakeDynamics_Data(Buf, InData%WD(i1)) + end do + end if + call Farm_PackAWAE_Data(Buf, InData%AWAE) + call Farm_PackSC_Data(Buf, InData%SC) + call Farm_PackMD_Data(Buf, InData%MD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackAll_FastFarm_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(All_FastFarm_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackAll_FastFarm_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call Farm_UnpackParam(Buf, OutData%p) ! p + call Farm_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%FWrap)) deallocate(OutData%FWrap) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FWrap(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FWrap.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Farm_UnpackFASTWrapper_Data(Buf, OutData%FWrap(i1)) ! FWrap + end do + end if + if (allocated(OutData%WD)) deallocate(OutData%WD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Farm_UnpackWakeDynamics_Data(Buf, OutData%WD(i1)) ! WD + end do + end if + call Farm_UnpackAWAE_Data(Buf, OutData%AWAE) ! AWAE + call Farm_UnpackSC_Data(Buf, OutData%SC) ! SC + call Farm_UnpackMD_Data(Buf, OutData%MD) ! MD +end subroutine END MODULE FAST_Farm_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 88494c69b5..ce44f2d6cd 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -36,22 +36,22 @@ MODULE AeroAcoustics_Types IMPLICIT NONE ! ========= AA_BladePropsType ======= TYPE, PUBLIC :: AA_BladePropsType - REAL(ReKi) :: TEThick !< [-] - REAL(ReKi) :: TEAngle !< [-] + REAL(ReKi) :: TEThick = 0.0_ReKi !< [-] + REAL(ReKi) :: TEAngle = 0.0_ReKi !< [-] END TYPE AA_BladePropsType ! ======================= ! ========= AA_InitInputType ======= TYPE, PUBLIC :: AA_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumBlNds !< Number of blade nodes [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of blade nodes [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlSpn !< Span at blade node [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlChord !< Chord at blade node [m] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound [m/s] - REAL(ReKi) :: HubHeight !< Hub Height [m] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] + REAL(ReKi) :: HubHeight = 0.0_ReKi !< Hub Height [m] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: BlAFID !< Index of airfoil data file for blade node location [array of numBladeNodes by numBlades] [-] TYPE(AFI_ParameterType) , DIMENSION(:), ALLOCATABLE :: AFInfo !< Airfoil information structure containing the aerodynamic center and airfoil shape coordinates [-] END TYPE AA_InitInputType @@ -68,37 +68,37 @@ MODULE AeroAcoustics_Types CHARACTER(25) , DIMENSION(:), ALLOCATABLE :: WriteOutputUntNodes !< Units of the output-to-file channels [-] character(1) :: delim !< column delimiter [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] END TYPE AA_InitOutputType ! ======================= ! ========= AA_InputFile ======= TYPE, PUBLIC :: AA_InputFile - REAL(DbKi) :: DT_AA !< Time interval for aerodynamic calculations {or "default"} [s] - 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} [-] - INTEGER(IntKi) :: ITRIP !< FLAG TO TRIP BOUNDARY LAYER {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: ITURB !< FLAG TO COMPUTE TBLTE NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: IInflow !< FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: X_BLMethod !< Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated [-] - INTEGER(IntKi) :: TICalcMeth !< TICalcMeth [-] - INTEGER(IntKi) :: NReListBL !< Number of values of ReListBL [-] - LOGICAL :: aweightflag !< Integer a weighting call [-] - LOGICAL :: ROUND !< LOGICAL INDICATING ROUNDED TIP [-] - REAL(ReKi) :: ALPRAT !< TIP LIFT CURVE SLOPE [-] - INTEGER(IntKi) :: AA_Bl_Prcntge !< see the AeroAcoustics input file for description [-] - INTEGER(IntKi) :: NrObsLoc !< Number of observer locations [-] + REAL(DbKi) :: DT_AA = 0.0_R8Ki !< Time interval for aerodynamic calculations {or "default"} [s] + INTEGER(IntKi) :: IBLUNT = 0_IntKi !< FLAG TO COMPUTE BLUNTNESS NOISE [-] + INTEGER(IntKi) :: ILAM = 0_IntKi !< FLAG TO COMPUTE LBL NOISE {1=steady model, 2=Beddoes-Leishman unsteady model} [-] + INTEGER(IntKi) :: ITIP = 0_IntKi !< FLAG TO COMPUTE TIP NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: ITRIP = 0_IntKi !< FLAG TO TRIP BOUNDARY LAYER {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: ITURB = 0_IntKi !< FLAG TO COMPUTE TBLTE NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: IInflow = 0_IntKi !< FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: X_BLMethod = 0_IntKi !< Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated [-] + INTEGER(IntKi) :: TICalcMeth = 0_IntKi !< TICalcMeth [-] + INTEGER(IntKi) :: NReListBL = 0_IntKi !< Number of values of ReListBL [-] + LOGICAL :: aweightflag = .false. !< Integer a weighting call [-] + LOGICAL :: ROUND = .false. !< LOGICAL INDICATING ROUNDED TIP [-] + REAL(ReKi) :: ALPRAT = 0.0_ReKi !< TIP LIFT CURVE SLOPE [-] + INTEGER(IntKi) :: AA_Bl_Prcntge = 0_IntKi !< see the AeroAcoustics input file for description [-] + INTEGER(IntKi) :: NrObsLoc = 0_IntKi !< Number of observer locations [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsX !< Observer location in tower-base coordinate X horizontal [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsY !< Observer location in tower-base coordinate Y lateral [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsZ !< Observer location in tower-base coordinate Z vertical [m] TYPE(AA_BladePropsType) , DIMENSION(:), ALLOCATABLE :: BladeProps !< blade property information from blade input files [-] - INTEGER(IntKi) :: NrOutFile !< Nr of output files [-] + INTEGER(IntKi) :: NrOutFile = 0_IntKi !< Nr of output files [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: AAoutfile !< AAoutfile for writing output files [-] CHARACTER(1024) :: TICalcTabFile !< Name of the file containing the table for incident turbulence intensity [-] CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] - REAL(DbKi) :: AAStart !< Time after which to calculate AA [s] - REAL(ReKi) :: Lturb !< Turbulent lengthscale in Amiet model [-] - REAL(ReKi) :: AvgV !< Average wind speed to compute incident turbulence intensity [m] + REAL(DbKi) :: AAStart = 0.0_R8Ki !< Time after which to calculate AA [s] + REAL(ReKi) :: Lturb = 0.0_ReKi !< Turbulent lengthscale in Amiet model [-] + REAL(ReKi) :: AvgV = 0.0_ReKi !< Average wind speed to compute incident turbulence intensity [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ReListBL !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AoAListBL !< [deg] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Pres_DispThick !< [-] @@ -110,13 +110,13 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Pres_EdgeVelRat !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Suct_EdgeVelRat !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_Grid_In !< [-] - REAL(ReKi) :: dz_turb_in !< [m] - REAL(ReKi) :: dy_turb_in !< [m] + REAL(ReKi) :: dz_turb_in = 0.0_ReKi !< [m] + REAL(ReKi) :: dy_turb_in = 0.0_ReKi !< [m] END TYPE AA_InputFile ! ======================= ! ========= AA_ContinuousStateType ======= TYPE, PUBLIC :: AA_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(SiKi) :: DummyContState = 0.0_R4Ki !< Remove this variable if you have continuous states [-] END TYPE AA_ContinuousStateType ! ======================= ! ========= AA_DiscreteStateType ======= @@ -136,12 +136,12 @@ MODULE AeroAcoustics_Types ! ======================= ! ========= AA_ConstraintStateType ======= TYPE, PUBLIC :: AA_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have states [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< Remove this variable if you have states [-] END TYPE AA_ConstraintStateType ! ======================= ! ========= AA_OtherStateType ======= TYPE, PUBLIC :: AA_OtherStateType - REAL(SiKi) :: DummyOtherState !< Remove this variable if you have states [-] + REAL(SiKi) :: DummyOtherState = 0.0_R4Ki !< Remove this variable if you have states [-] END TYPE AA_OtherStateType ! ======================= ! ========= AA_MiscVarType ======= @@ -154,7 +154,7 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: rTEtoObserve !< C [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: rLEtoObserve !< C [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: LE_Location !< Height of Leading Edge for calculation of TI and Scales if needed [-] - REAL(ReKi) :: RotSpeedAoA !< C [-] + REAL(ReKi) :: RotSpeedAoA = 0.0_ReKi !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLLBL !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLP !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLS !< C [-] @@ -168,66 +168,66 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: d99Var !< BL Output [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dStarVar !< BL Output [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: EdgeVelVar !< BL Output [-] - INTEGER(IntKi) :: speccou !< Secptrum counter every XX seconds new spectrum [-] - INTEGER(IntKi) :: filesopen !< check if file is open [-] + INTEGER(IntKi) :: speccou = 0_IntKi !< Secptrum counter every XX seconds new spectrum [-] + INTEGER(IntKi) :: filesopen = 0_IntKi !< check if file is open [-] END TYPE AA_MiscVarType ! ======================= ! ========= AA_ParameterType ======= TYPE, PUBLIC :: AA_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - INTEGER(IntKi) :: IBLUNT !< Bluntness noise model [-] - INTEGER(IntKi) :: ILAM !< LBL noise model [-] - INTEGER(IntKi) :: ITIP !< Tip noise model [-] - INTEGER(IntKi) :: ITRIP !< Trip boundary layer [-] - INTEGER(IntKi) :: ITURB !< Tblte noise model [-] - INTEGER(IntKi) :: IInflow !< Turbulent inflow noise model [-] - INTEGER(IntKi) :: X_BLMethod !< Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated [-] - INTEGER(IntKi) :: TICalcMeth !< [-] - LOGICAL :: ROUND !< Logical indicating rounded tip [-] - REAL(ReKi) :: ALPRAT !< TIP LIFT CURVE SLOPE [-] - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumBlNds !< Number of nodes on each blade [-] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound [m/s] - REAL(ReKi) :: HubHeight !< Hub height [m] - REAL(ReKi) :: toptip !< Top Tip Height = Hub height plus radius [m] - REAL(ReKi) :: bottip !< Bottom Tip Height = Hub height minus radius [m] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] + INTEGER(IntKi) :: IBLUNT = 0_IntKi !< Bluntness noise model [-] + INTEGER(IntKi) :: ILAM = 0_IntKi !< LBL noise model [-] + INTEGER(IntKi) :: ITIP = 0_IntKi !< Tip noise model [-] + INTEGER(IntKi) :: ITRIP = 0_IntKi !< Trip boundary layer [-] + INTEGER(IntKi) :: ITURB = 0_IntKi !< Tblte noise model [-] + INTEGER(IntKi) :: IInflow = 0_IntKi !< Turbulent inflow noise model [-] + INTEGER(IntKi) :: X_BLMethod = 0_IntKi !< Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated [-] + INTEGER(IntKi) :: TICalcMeth = 0_IntKi !< [-] + LOGICAL :: ROUND = .false. !< Logical indicating rounded tip [-] + REAL(ReKi) :: ALPRAT = 0.0_ReKi !< TIP LIFT CURVE SLOPE [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of nodes on each blade [-] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] + REAL(ReKi) :: HubHeight = 0.0_ReKi !< Hub height [m] + REAL(ReKi) :: toptip = 0.0_ReKi !< Top Tip Height = Hub height plus radius [m] + REAL(ReKi) :: bottip = 0.0_ReKi !< Bottom Tip Height = Hub height minus radius [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsVert !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsHorz !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsalph !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsrad !< [-] - INTEGER(IntKi) :: NrObsLoc !< Number of observer locations [-] - LOGICAL :: aweightflag !< [-] - LOGICAL :: TxtFileOutput !< [-] - REAL(DbKi) :: AAStart !< Time after which to calculate AA [s] + INTEGER(IntKi) :: NrObsLoc = 0_IntKi !< Number of observer locations [-] + LOGICAL :: aweightflag = .false. !< [-] + LOGICAL :: TxtFileOutput = .false. !< [-] + REAL(DbKi) :: AAStart = 0.0_R8Ki !< Time after which to calculate AA [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsX !< Observer location in tower-base coordinate X horizontal [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsY !< Observer location in tower-base coordinate Y lateral [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsZ !< Observer location in tower-base coordinate Z vertical [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FreqList !< List of Acoustic Frequencies to Calculate [Hz] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Aweight !< List of Acoustic Frequencies a weighting [dB] - REAL(ReKi) :: Fsample !< Sampling Frequency 1/delta(t) - 1/(simulation time step) [Hz] - INTEGER(IntKi) :: total_sample !< Total FFT Sample amount for dissipation calculation [-] - INTEGER(IntKi) :: total_sampleTI !< Total FFT Sample amount for dissipation calculation [-] - INTEGER(IntKi) :: AA_Bl_Prcntge !< The Percentage of the Blade which the noise is calculated [%] - INTEGER(IntKi) :: startnode !< Corersponding node to the noise calculation percentage of the blade [-] - REAL(ReKi) :: Lturb !< Turbulent lengthscale in Amiet model [m] - REAL(ReKi) :: AvgV !< Average wind speed to compute incident turbulence intensity [m] - REAL(ReKi) :: dz_turb_in !< [m] - REAL(ReKi) :: dy_turb_in !< [m] + REAL(ReKi) :: Fsample = 0.0_ReKi !< Sampling Frequency 1/delta(t) - 1/(simulation time step) [Hz] + INTEGER(IntKi) :: total_sample = 0_IntKi !< Total FFT Sample amount for dissipation calculation [-] + INTEGER(IntKi) :: total_sampleTI = 0_IntKi !< Total FFT Sample amount for dissipation calculation [-] + INTEGER(IntKi) :: AA_Bl_Prcntge = 0_IntKi !< The Percentage of the Blade which the noise is calculated [%] + INTEGER(IntKi) :: startnode = 0_IntKi !< Corersponding node to the noise calculation percentage of the blade [-] + REAL(ReKi) :: Lturb = 0.0_ReKi !< Turbulent lengthscale in Amiet model [m] + REAL(ReKi) :: AvgV = 0.0_ReKi !< Average wind speed to compute incident turbulence intensity [m] + REAL(ReKi) :: dz_turb_in = 0.0_ReKi !< [m] + REAL(ReKi) :: dy_turb_in = 0.0_ReKi !< [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_Grid_In !< [-] CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] character(20) :: outFmt !< Format specifier [-] - INTEGER(IntKi) :: NrOutFile !< Nr of output files [-] + INTEGER(IntKi) :: NrOutFile = 0_IntKi !< Nr of output files [-] character(1) :: delim !< column delimiter [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: NumOutsForPE !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: NumOutsForSep !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: NumOutsForNodes !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: unOutFile !< unit number for writing output file [-] - INTEGER(IntKi) :: unOutFile2 !< unit number for writing output file [-] - INTEGER(IntKi) :: unOutFile3 !< unit number for writing output file [-] - INTEGER(IntKi) :: unOutFile4 !< unit number for writing output file [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOutsForPE = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOutsForSep = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOutsForNodes = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: unOutFile = 0_IntKi !< unit number for writing output file [-] + INTEGER(IntKi) :: unOutFile2 = 0_IntKi !< unit number for writing output file [-] + INTEGER(IntKi) :: unOutFile3 = 0_IntKi !< unit number for writing output file [-] + INTEGER(IntKi) :: unOutFile4 = 0_IntKi !< unit number for writing output file [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StallStart !< ation [-] @@ -278,9481 +278,4578 @@ MODULE AeroAcoustics_Types END TYPE AA_OutputType ! ======================= CONTAINS - SUBROUTINE AA_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_BladePropsType), INTENT(IN) :: SrcBladePropsTypeData - TYPE(AA_BladePropsType), INTENT(INOUT) :: DstBladePropsTypeData - 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 = 'AA_CopyBladePropsType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBladePropsTypeData%TEThick = SrcBladePropsTypeData%TEThick - DstBladePropsTypeData%TEAngle = SrcBladePropsTypeData%TEAngle - END SUBROUTINE AA_CopyBladePropsType - - SUBROUTINE AA_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg ) - TYPE(AA_BladePropsType), INTENT(INOUT) :: BladePropsTypeData - 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 = 'AA_DestroyBladePropsType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AA_DestroyBladePropsType - - SUBROUTINE AA_PackBladePropsType( 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(AA_BladePropsType), 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 = 'AA_PackBladePropsType' - ! 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 ! TEThick - Re_BufSz = Re_BufSz + 1 ! TEAngle - 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%TEThick - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEAngle - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackBladePropsType - SUBROUTINE AA_UnPackBladePropsType( 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(AA_BladePropsType), 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 = 'AA_UnPackBladePropsType' - ! 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%TEThick = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackBladePropsType - - SUBROUTINE AA_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AA_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 = 'AA_CopyInitInput' -! +subroutine AA_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg) + type(AA_BladePropsType), intent(in) :: SrcBladePropsTypeData + type(AA_BladePropsType), intent(inout) :: DstBladePropsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_CopyBladePropsType' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%NumBlades = SrcInitInputData%NumBlades - DstInitInputData%NumBlNds = SrcInitInputData%NumBlNds - DstInitInputData%RootName = SrcInitInputData%RootName -IF (ALLOCATED(SrcInitInputData%BlSpn)) THEN - i1_l = LBOUND(SrcInitInputData%BlSpn,1) - i1_u = UBOUND(SrcInitInputData%BlSpn,1) - i2_l = LBOUND(SrcInitInputData%BlSpn,2) - i2_u = UBOUND(SrcInitInputData%BlSpn,2) - IF (.NOT. ALLOCATED(DstInitInputData%BlSpn)) THEN - ALLOCATE(DstInitInputData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BlSpn = SrcInitInputData%BlSpn -ENDIF -IF (ALLOCATED(SrcInitInputData%BlChord)) THEN - i1_l = LBOUND(SrcInitInputData%BlChord,1) - i1_u = UBOUND(SrcInitInputData%BlChord,1) - i2_l = LBOUND(SrcInitInputData%BlChord,2) - i2_u = UBOUND(SrcInitInputData%BlChord,2) - IF (.NOT. ALLOCATED(DstInitInputData%BlChord)) THEN - ALLOCATE(DstInitInputData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BlChord = SrcInitInputData%BlChord -ENDIF - DstInitInputData%AirDens = SrcInitInputData%AirDens - DstInitInputData%KinVisc = SrcInitInputData%KinVisc - DstInitInputData%SpdSound = SrcInitInputData%SpdSound - DstInitInputData%HubHeight = SrcInitInputData%HubHeight -IF (ALLOCATED(SrcInitInputData%BlAFID)) THEN - i1_l = LBOUND(SrcInitInputData%BlAFID,1) - i1_u = UBOUND(SrcInitInputData%BlAFID,1) - i2_l = LBOUND(SrcInitInputData%BlAFID,2) - i2_u = UBOUND(SrcInitInputData%BlAFID,2) - IF (.NOT. ALLOCATED(DstInitInputData%BlAFID)) THEN - ALLOCATE(DstInitInputData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BlAFID = SrcInitInputData%BlAFID -ENDIF -IF (ALLOCATED(SrcInitInputData%AFInfo)) THEN - i1_l = LBOUND(SrcInitInputData%AFInfo,1) - i1_u = UBOUND(SrcInitInputData%AFInfo,1) - IF (.NOT. ALLOCATED(DstInitInputData%AFInfo)) THEN - ALLOCATE(DstInitInputData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%AFInfo,1), UBOUND(SrcInitInputData%AFInfo,1) - CALL AFI_CopyParam( SrcInitInputData%AFInfo(i1), DstInitInputData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AA_CopyInitInput - - SUBROUTINE AA_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(AA_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 = 'AA_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%BlSpn)) THEN - DEALLOCATE(InitInputData%BlSpn) -ENDIF -IF (ALLOCATED(InitInputData%BlChord)) THEN - DEALLOCATE(InitInputData%BlChord) -ENDIF -IF (ALLOCATED(InitInputData%BlAFID)) THEN - DEALLOCATE(InitInputData%BlAFID) -ENDIF -IF (ALLOCATED(InitInputData%AFInfo)) THEN -DO i1 = LBOUND(InitInputData%AFInfo,1), UBOUND(InitInputData%AFInfo,1) - CALL AFI_DestroyParam( InitInputData%AFInfo(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%AFInfo) -ENDIF - END SUBROUTINE AA_DestroyInitInput - - SUBROUTINE AA_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(AA_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 = 'AA_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 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumBlNds - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! BlSpn allocated yes/no - IF ( ALLOCATED(InData%BlSpn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlSpn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlSpn) ! BlSpn - END IF - Int_BufSz = Int_BufSz + 1 ! BlChord allocated yes/no - IF ( ALLOCATED(InData%BlChord) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlChord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlChord) ! BlChord - END IF - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Re_BufSz = Re_BufSz + 1 ! HubHeight - Int_BufSz = Int_BufSz + 1 ! BlAFID allocated yes/no - IF ( ALLOCATED(InData%BlAFID) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlAFID upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BlAFID) ! BlAFID - END IF - Int_BufSz = Int_BufSz + 1 ! AFInfo allocated yes/no - IF ( ALLOCATED(InData%AFInfo) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AFInfo upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - Int_BufSz = Int_BufSz + 3 ! AFInfo: size of buffers for each call to pack subtype - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AFInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AFInfo - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AFInfo - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AFInfo - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - IntKiBuf(Int_Xferred) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%BlSpn) ) 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%BlSpn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlSpn,2), UBOUND(InData%BlSpn,2) - DO i1 = LBOUND(InData%BlSpn,1), UBOUND(InData%BlSpn,1) - ReKiBuf(Re_Xferred) = InData%BlSpn(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlChord) ) 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%BlChord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlChord,2), UBOUND(InData%BlChord,2) - DO i1 = LBOUND(InData%BlChord,1), UBOUND(InData%BlChord,1) - ReKiBuf(Re_Xferred) = InData%BlChord(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubHeight - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlAFID) ) 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%BlAFID,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlAFID,2), UBOUND(InData%BlAFID,2) - DO i1 = LBOUND(InData%BlAFID,1), UBOUND(InData%BlAFID,1) - IntKiBuf(Int_Xferred) = InData%BlAFID(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFInfo) ) 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%AFInfo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFInfo,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, OnlySize ) ! AFInfo - 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 - END SUBROUTINE AA_PackInitInput - - SUBROUTINE AA_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(AA_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 = 'AA_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%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSpn 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%BlSpn)) DEALLOCATE(OutData%BlSpn) - ALLOCATE(OutData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlSpn,2), UBOUND(OutData%BlSpn,2) - DO i1 = LBOUND(OutData%BlSpn,1), UBOUND(OutData%BlSpn,1) - OutData%BlSpn(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord 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%BlChord)) DEALLOCATE(OutData%BlChord) - ALLOCATE(OutData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlChord,2), UBOUND(OutData%BlChord,2) - DO i1 = LBOUND(OutData%BlChord,1), UBOUND(OutData%BlChord,1) - OutData%BlChord(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAFID 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%BlAFID)) DEALLOCATE(OutData%BlAFID) - ALLOCATE(OutData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlAFID,2), UBOUND(OutData%BlAFID,2) - DO i1 = LBOUND(OutData%BlAFID,1), UBOUND(OutData%BlAFID,1) - OutData%BlAFID(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFInfo 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%AFInfo)) DEALLOCATE(OutData%AFInfo) - ALLOCATE(OutData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AFInfo,1), UBOUND(OutData%AFInfo,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 AFI_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AFInfo(i1), ErrStat2, ErrMsg2 ) ! AFInfo - 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 - END SUBROUTINE AA_UnPackInitInput - - SUBROUTINE AA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AA_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 = 'AA_CopyInitOutput' -! + ErrMsg = '' + DstBladePropsTypeData%TEThick = SrcBladePropsTypeData%TEThick + DstBladePropsTypeData%TEAngle = SrcBladePropsTypeData%TEAngle +end subroutine + +subroutine AA_DestroyBladePropsType(BladePropsTypeData, ErrStat, ErrMsg) + type(AA_BladePropsType), intent(inout) :: BladePropsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyBladePropsType' 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%WriteOutputHdrforPE)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdrforPE,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdrforPE,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdrforPE)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdrforPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrforPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdrforPE = SrcInitOutputData%WriteOutputHdrforPE -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUntforPE)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUntforPE,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUntforPE,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUntforPE)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUntforPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntforPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUntforPE = SrcInitOutputData%WriteOutputUntforPE -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdrSep)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdrSep,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdrSep,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdrSep)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdrSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdrSep = SrcInitOutputData%WriteOutputHdrSep -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUntSep)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUntSep,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUntSep,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUntSep)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUntSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUntSep = SrcInitOutputData%WriteOutputUntSep -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdrNodes)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdrNodes,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdrNodes,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdrNodes)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdrNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdrNodes = SrcInitOutputData%WriteOutputHdrNodes -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUntNodes)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUntNodes,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUntNodes,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUntNodes)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUntNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUntNodes = SrcInitOutputData%WriteOutputUntNodes -ENDIF - DstInitOutputData%delim = SrcInitOutputData%delim - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%AirDens = SrcInitOutputData%AirDens - END SUBROUTINE AA_CopyInitOutput - - SUBROUTINE AA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(AA_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 = 'AA_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%WriteOutputHdrforPE)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdrforPE) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUntforPE)) THEN - DEALLOCATE(InitOutputData%WriteOutputUntforPE) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputHdrSep)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdrSep) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUntSep)) THEN - DEALLOCATE(InitOutputData%WriteOutputUntSep) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputHdrNodes)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdrNodes) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUntNodes)) THEN - DEALLOCATE(InitOutputData%WriteOutputUntNodes) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AA_DestroyInitOutput - - SUBROUTINE AA_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(AA_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 = 'AA_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 ! WriteOutputHdrforPE allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdrforPE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdrforPE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdrforPE)*LEN(InData%WriteOutputHdrforPE) ! WriteOutputHdrforPE - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUntforPE allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUntforPE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUntforPE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUntforPE)*LEN(InData%WriteOutputUntforPE) ! WriteOutputUntforPE - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdrSep allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdrSep) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdrSep upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdrSep)*LEN(InData%WriteOutputHdrSep) ! WriteOutputHdrSep - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUntSep allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUntSep) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUntSep upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUntSep)*LEN(InData%WriteOutputUntSep) ! WriteOutputUntSep - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdrNodes allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdrNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdrNodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdrNodes)*LEN(InData%WriteOutputHdrNodes) ! WriteOutputHdrNodes - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUntNodes allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUntNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUntNodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUntNodes)*LEN(InData%WriteOutputUntNodes) ! WriteOutputUntNodes - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! AirDens - 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%WriteOutputHdrforPE) ) 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%WriteOutputHdrforPE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdrforPE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdrforPE,1), UBOUND(InData%WriteOutputHdrforPE,1) - DO I = 1, LEN(InData%WriteOutputHdrforPE) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdrforPE(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUntforPE) ) 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%WriteOutputUntforPE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUntforPE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUntforPE,1), UBOUND(InData%WriteOutputUntforPE,1) - DO I = 1, LEN(InData%WriteOutputUntforPE) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUntforPE(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputHdrSep) ) 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%WriteOutputHdrSep,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdrSep,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdrSep,1), UBOUND(InData%WriteOutputHdrSep,1) - DO I = 1, LEN(InData%WriteOutputHdrSep) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdrSep(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUntSep) ) 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%WriteOutputUntSep,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUntSep,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUntSep,1), UBOUND(InData%WriteOutputUntSep,1) - DO I = 1, LEN(InData%WriteOutputUntSep) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUntSep(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputHdrNodes) ) 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%WriteOutputHdrNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdrNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdrNodes,1), UBOUND(InData%WriteOutputHdrNodes,1) - DO I = 1, LEN(InData%WriteOutputHdrNodes) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdrNodes(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUntNodes) ) 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%WriteOutputUntNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUntNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUntNodes,1), UBOUND(InData%WriteOutputUntNodes,1) - DO I = 1, LEN(InData%WriteOutputUntNodes) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUntNodes(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%delim) - 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 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%AirDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackInitOutput - - SUBROUTINE AA_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(AA_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 = 'AA_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 ! WriteOutputHdrforPE 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%WriteOutputHdrforPE)) DEALLOCATE(OutData%WriteOutputHdrforPE) - ALLOCATE(OutData%WriteOutputHdrforPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrforPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdrforPE,1), UBOUND(OutData%WriteOutputHdrforPE,1) - DO I = 1, LEN(OutData%WriteOutputHdrforPE) - OutData%WriteOutputHdrforPE(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 ! WriteOutputUntforPE 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%WriteOutputUntforPE)) DEALLOCATE(OutData%WriteOutputUntforPE) - ALLOCATE(OutData%WriteOutputUntforPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntforPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUntforPE,1), UBOUND(OutData%WriteOutputUntforPE,1) - DO I = 1, LEN(OutData%WriteOutputUntforPE) - OutData%WriteOutputUntforPE(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 ! WriteOutputHdrSep 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%WriteOutputHdrSep)) DEALLOCATE(OutData%WriteOutputHdrSep) - ALLOCATE(OutData%WriteOutputHdrSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdrSep,1), UBOUND(OutData%WriteOutputHdrSep,1) - DO I = 1, LEN(OutData%WriteOutputHdrSep) - OutData%WriteOutputHdrSep(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 ! WriteOutputUntSep 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%WriteOutputUntSep)) DEALLOCATE(OutData%WriteOutputUntSep) - ALLOCATE(OutData%WriteOutputUntSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUntSep,1), UBOUND(OutData%WriteOutputUntSep,1) - DO I = 1, LEN(OutData%WriteOutputUntSep) - OutData%WriteOutputUntSep(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 ! WriteOutputHdrNodes 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%WriteOutputHdrNodes)) DEALLOCATE(OutData%WriteOutputHdrNodes) - ALLOCATE(OutData%WriteOutputHdrNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdrNodes,1), UBOUND(OutData%WriteOutputHdrNodes,1) - DO I = 1, LEN(OutData%WriteOutputHdrNodes) - OutData%WriteOutputHdrNodes(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 ! WriteOutputUntNodes 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%WriteOutputUntNodes)) DEALLOCATE(OutData%WriteOutputUntNodes) - ALLOCATE(OutData%WriteOutputUntNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUntNodes,1), UBOUND(OutData%WriteOutputUntNodes,1) - DO I = 1, LEN(OutData%WriteOutputUntNodes) - OutData%WriteOutputUntNodes(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%delim) - OutData%delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackInitOutput - - SUBROUTINE AA_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(AA_InputFile), INTENT(INOUT) :: DstInputFileData - 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 = 'AA_CopyInputFile' -! + ErrMsg = '' +end subroutine + +subroutine AA_PackBladePropsType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_BladePropsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackBladePropsType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%TEThick) + call RegPack(Buf, InData%TEAngle) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackBladePropsType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_BladePropsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackBladePropsType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%TEThick) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEAngle) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(AA_InitInputType), intent(in) :: SrcInitInputData + type(AA_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DT_AA = SrcInputFileData%DT_AA - DstInputFileData%IBLUNT = SrcInputFileData%IBLUNT - DstInputFileData%ILAM = SrcInputFileData%ILAM - DstInputFileData%ITIP = SrcInputFileData%ITIP - DstInputFileData%ITRIP = SrcInputFileData%ITRIP - DstInputFileData%ITURB = SrcInputFileData%ITURB - DstInputFileData%IInflow = SrcInputFileData%IInflow - DstInputFileData%X_BLMethod = SrcInputFileData%X_BLMethod - DstInputFileData%TICalcMeth = SrcInputFileData%TICalcMeth - DstInputFileData%NReListBL = SrcInputFileData%NReListBL - DstInputFileData%aweightflag = SrcInputFileData%aweightflag - DstInputFileData%ROUND = SrcInputFileData%ROUND - DstInputFileData%ALPRAT = SrcInputFileData%ALPRAT - DstInputFileData%AA_Bl_Prcntge = SrcInputFileData%AA_Bl_Prcntge - DstInputFileData%NrObsLoc = SrcInputFileData%NrObsLoc -IF (ALLOCATED(SrcInputFileData%ObsX)) THEN - i1_l = LBOUND(SrcInputFileData%ObsX,1) - i1_u = UBOUND(SrcInputFileData%ObsX,1) - IF (.NOT. ALLOCATED(DstInputFileData%ObsX)) THEN - ALLOCATE(DstInputFileData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ObsX = SrcInputFileData%ObsX -ENDIF -IF (ALLOCATED(SrcInputFileData%ObsY)) THEN - i1_l = LBOUND(SrcInputFileData%ObsY,1) - i1_u = UBOUND(SrcInputFileData%ObsY,1) - IF (.NOT. ALLOCATED(DstInputFileData%ObsY)) THEN - ALLOCATE(DstInputFileData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ObsY = SrcInputFileData%ObsY -ENDIF -IF (ALLOCATED(SrcInputFileData%ObsZ)) THEN - i1_l = LBOUND(SrcInputFileData%ObsZ,1) - i1_u = UBOUND(SrcInputFileData%ObsZ,1) - IF (.NOT. ALLOCATED(DstInputFileData%ObsZ)) THEN - ALLOCATE(DstInputFileData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ObsZ = SrcInputFileData%ObsZ -ENDIF -IF (ALLOCATED(SrcInputFileData%BladeProps)) THEN - i1_l = LBOUND(SrcInputFileData%BladeProps,1) - i1_u = UBOUND(SrcInputFileData%BladeProps,1) - IF (.NOT. ALLOCATED(DstInputFileData%BladeProps)) THEN - ALLOCATE(DstInputFileData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputFileData%BladeProps,1), UBOUND(SrcInputFileData%BladeProps,1) - CALL AA_Copybladepropstype( SrcInputFileData%BladeProps(i1), DstInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInputFileData%NrOutFile = SrcInputFileData%NrOutFile -IF (ALLOCATED(SrcInputFileData%AAoutfile)) THEN - i1_l = LBOUND(SrcInputFileData%AAoutfile,1) - i1_u = UBOUND(SrcInputFileData%AAoutfile,1) - IF (.NOT. ALLOCATED(DstInputFileData%AAoutfile)) THEN - ALLOCATE(DstInputFileData%AAoutfile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AAoutfile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AAoutfile = SrcInputFileData%AAoutfile -ENDIF - DstInputFileData%TICalcTabFile = SrcInputFileData%TICalcTabFile - DstInputFileData%FTitle = SrcInputFileData%FTitle - DstInputFileData%AAStart = SrcInputFileData%AAStart - DstInputFileData%Lturb = SrcInputFileData%Lturb - DstInputFileData%AvgV = SrcInputFileData%AvgV -IF (ALLOCATED(SrcInputFileData%ReListBL)) THEN - i1_l = LBOUND(SrcInputFileData%ReListBL,1) - i1_u = UBOUND(SrcInputFileData%ReListBL,1) - IF (.NOT. ALLOCATED(DstInputFileData%ReListBL)) THEN - ALLOCATE(DstInputFileData%ReListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ReListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ReListBL = SrcInputFileData%ReListBL -ENDIF -IF (ALLOCATED(SrcInputFileData%AoAListBL)) THEN - i1_l = LBOUND(SrcInputFileData%AoAListBL,1) - i1_u = UBOUND(SrcInputFileData%AoAListBL,1) - IF (.NOT. ALLOCATED(DstInputFileData%AoAListBL)) THEN - ALLOCATE(DstInputFileData%AoAListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AoAListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AoAListBL = SrcInputFileData%AoAListBL -ENDIF -IF (ALLOCATED(SrcInputFileData%Pres_DispThick)) THEN - i1_l = LBOUND(SrcInputFileData%Pres_DispThick,1) - i1_u = UBOUND(SrcInputFileData%Pres_DispThick,1) - i2_l = LBOUND(SrcInputFileData%Pres_DispThick,2) - i2_u = UBOUND(SrcInputFileData%Pres_DispThick,2) - i3_l = LBOUND(SrcInputFileData%Pres_DispThick,3) - i3_u = UBOUND(SrcInputFileData%Pres_DispThick,3) - IF (.NOT. ALLOCATED(DstInputFileData%Pres_DispThick)) THEN - ALLOCATE(DstInputFileData%Pres_DispThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_DispThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Pres_DispThick = SrcInputFileData%Pres_DispThick -ENDIF -IF (ALLOCATED(SrcInputFileData%Suct_DispThick)) THEN - i1_l = LBOUND(SrcInputFileData%Suct_DispThick,1) - i1_u = UBOUND(SrcInputFileData%Suct_DispThick,1) - i2_l = LBOUND(SrcInputFileData%Suct_DispThick,2) - i2_u = UBOUND(SrcInputFileData%Suct_DispThick,2) - i3_l = LBOUND(SrcInputFileData%Suct_DispThick,3) - i3_u = UBOUND(SrcInputFileData%Suct_DispThick,3) - IF (.NOT. ALLOCATED(DstInputFileData%Suct_DispThick)) THEN - ALLOCATE(DstInputFileData%Suct_DispThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_DispThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Suct_DispThick = SrcInputFileData%Suct_DispThick -ENDIF -IF (ALLOCATED(SrcInputFileData%Pres_BLThick)) THEN - i1_l = LBOUND(SrcInputFileData%Pres_BLThick,1) - i1_u = UBOUND(SrcInputFileData%Pres_BLThick,1) - i2_l = LBOUND(SrcInputFileData%Pres_BLThick,2) - i2_u = UBOUND(SrcInputFileData%Pres_BLThick,2) - i3_l = LBOUND(SrcInputFileData%Pres_BLThick,3) - i3_u = UBOUND(SrcInputFileData%Pres_BLThick,3) - IF (.NOT. ALLOCATED(DstInputFileData%Pres_BLThick)) THEN - ALLOCATE(DstInputFileData%Pres_BLThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_BLThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Pres_BLThick = SrcInputFileData%Pres_BLThick -ENDIF -IF (ALLOCATED(SrcInputFileData%Suct_BLThick)) THEN - i1_l = LBOUND(SrcInputFileData%Suct_BLThick,1) - i1_u = UBOUND(SrcInputFileData%Suct_BLThick,1) - i2_l = LBOUND(SrcInputFileData%Suct_BLThick,2) - i2_u = UBOUND(SrcInputFileData%Suct_BLThick,2) - i3_l = LBOUND(SrcInputFileData%Suct_BLThick,3) - i3_u = UBOUND(SrcInputFileData%Suct_BLThick,3) - IF (.NOT. ALLOCATED(DstInputFileData%Suct_BLThick)) THEN - ALLOCATE(DstInputFileData%Suct_BLThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_BLThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Suct_BLThick = SrcInputFileData%Suct_BLThick -ENDIF -IF (ALLOCATED(SrcInputFileData%Pres_Cf)) THEN - i1_l = LBOUND(SrcInputFileData%Pres_Cf,1) - i1_u = UBOUND(SrcInputFileData%Pres_Cf,1) - i2_l = LBOUND(SrcInputFileData%Pres_Cf,2) - i2_u = UBOUND(SrcInputFileData%Pres_Cf,2) - i3_l = LBOUND(SrcInputFileData%Pres_Cf,3) - i3_u = UBOUND(SrcInputFileData%Pres_Cf,3) - IF (.NOT. ALLOCATED(DstInputFileData%Pres_Cf)) THEN - ALLOCATE(DstInputFileData%Pres_Cf(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_Cf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Pres_Cf = SrcInputFileData%Pres_Cf -ENDIF -IF (ALLOCATED(SrcInputFileData%Suct_Cf)) THEN - i1_l = LBOUND(SrcInputFileData%Suct_Cf,1) - i1_u = UBOUND(SrcInputFileData%Suct_Cf,1) - i2_l = LBOUND(SrcInputFileData%Suct_Cf,2) - i2_u = UBOUND(SrcInputFileData%Suct_Cf,2) - i3_l = LBOUND(SrcInputFileData%Suct_Cf,3) - i3_u = UBOUND(SrcInputFileData%Suct_Cf,3) - IF (.NOT. ALLOCATED(DstInputFileData%Suct_Cf)) THEN - ALLOCATE(DstInputFileData%Suct_Cf(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_Cf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Suct_Cf = SrcInputFileData%Suct_Cf -ENDIF -IF (ALLOCATED(SrcInputFileData%Pres_EdgeVelRat)) THEN - i1_l = LBOUND(SrcInputFileData%Pres_EdgeVelRat,1) - i1_u = UBOUND(SrcInputFileData%Pres_EdgeVelRat,1) - i2_l = LBOUND(SrcInputFileData%Pres_EdgeVelRat,2) - i2_u = UBOUND(SrcInputFileData%Pres_EdgeVelRat,2) - i3_l = LBOUND(SrcInputFileData%Pres_EdgeVelRat,3) - i3_u = UBOUND(SrcInputFileData%Pres_EdgeVelRat,3) - IF (.NOT. ALLOCATED(DstInputFileData%Pres_EdgeVelRat)) THEN - ALLOCATE(DstInputFileData%Pres_EdgeVelRat(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Pres_EdgeVelRat = SrcInputFileData%Pres_EdgeVelRat -ENDIF -IF (ALLOCATED(SrcInputFileData%Suct_EdgeVelRat)) THEN - i1_l = LBOUND(SrcInputFileData%Suct_EdgeVelRat,1) - i1_u = UBOUND(SrcInputFileData%Suct_EdgeVelRat,1) - i2_l = LBOUND(SrcInputFileData%Suct_EdgeVelRat,2) - i2_u = UBOUND(SrcInputFileData%Suct_EdgeVelRat,2) - i3_l = LBOUND(SrcInputFileData%Suct_EdgeVelRat,3) - i3_u = UBOUND(SrcInputFileData%Suct_EdgeVelRat,3) - IF (.NOT. ALLOCATED(DstInputFileData%Suct_EdgeVelRat)) THEN - ALLOCATE(DstInputFileData%Suct_EdgeVelRat(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Suct_EdgeVelRat = SrcInputFileData%Suct_EdgeVelRat -ENDIF -IF (ALLOCATED(SrcInputFileData%TI_Grid_In)) THEN - i1_l = LBOUND(SrcInputFileData%TI_Grid_In,1) - i1_u = UBOUND(SrcInputFileData%TI_Grid_In,1) - i2_l = LBOUND(SrcInputFileData%TI_Grid_In,2) - i2_u = UBOUND(SrcInputFileData%TI_Grid_In,2) - IF (.NOT. ALLOCATED(DstInputFileData%TI_Grid_In)) THEN - ALLOCATE(DstInputFileData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TI_Grid_In = SrcInputFileData%TI_Grid_In -ENDIF - DstInputFileData%dz_turb_in = SrcInputFileData%dz_turb_in - DstInputFileData%dy_turb_in = SrcInputFileData%dy_turb_in - END SUBROUTINE AA_CopyInputFile - - SUBROUTINE AA_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(AA_InputFile), INTENT(INOUT) :: InputFileData - 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 = 'AA_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%ObsX)) THEN - DEALLOCATE(InputFileData%ObsX) -ENDIF -IF (ALLOCATED(InputFileData%ObsY)) THEN - DEALLOCATE(InputFileData%ObsY) -ENDIF -IF (ALLOCATED(InputFileData%ObsZ)) THEN - DEALLOCATE(InputFileData%ObsZ) -ENDIF -IF (ALLOCATED(InputFileData%BladeProps)) THEN -DO i1 = LBOUND(InputFileData%BladeProps,1), UBOUND(InputFileData%BladeProps,1) - CALL AA_DestroyBladePropsType( InputFileData%BladeProps(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputFileData%BladeProps) -ENDIF -IF (ALLOCATED(InputFileData%AAoutfile)) THEN - DEALLOCATE(InputFileData%AAoutfile) -ENDIF -IF (ALLOCATED(InputFileData%ReListBL)) THEN - DEALLOCATE(InputFileData%ReListBL) -ENDIF -IF (ALLOCATED(InputFileData%AoAListBL)) THEN - DEALLOCATE(InputFileData%AoAListBL) -ENDIF -IF (ALLOCATED(InputFileData%Pres_DispThick)) THEN - DEALLOCATE(InputFileData%Pres_DispThick) -ENDIF -IF (ALLOCATED(InputFileData%Suct_DispThick)) THEN - DEALLOCATE(InputFileData%Suct_DispThick) -ENDIF -IF (ALLOCATED(InputFileData%Pres_BLThick)) THEN - DEALLOCATE(InputFileData%Pres_BLThick) -ENDIF -IF (ALLOCATED(InputFileData%Suct_BLThick)) THEN - DEALLOCATE(InputFileData%Suct_BLThick) -ENDIF -IF (ALLOCATED(InputFileData%Pres_Cf)) THEN - DEALLOCATE(InputFileData%Pres_Cf) -ENDIF -IF (ALLOCATED(InputFileData%Suct_Cf)) THEN - DEALLOCATE(InputFileData%Suct_Cf) -ENDIF -IF (ALLOCATED(InputFileData%Pres_EdgeVelRat)) THEN - DEALLOCATE(InputFileData%Pres_EdgeVelRat) -ENDIF -IF (ALLOCATED(InputFileData%Suct_EdgeVelRat)) THEN - DEALLOCATE(InputFileData%Suct_EdgeVelRat) -ENDIF -IF (ALLOCATED(InputFileData%TI_Grid_In)) THEN - DEALLOCATE(InputFileData%TI_Grid_In) -ENDIF - END SUBROUTINE AA_DestroyInputFile - - SUBROUTINE AA_PackInputFile( 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(AA_InputFile), 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 = 'AA_PackInputFile' - ! 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_AA - Int_BufSz = Int_BufSz + 1 ! IBLUNT - Int_BufSz = Int_BufSz + 1 ! ILAM - Int_BufSz = Int_BufSz + 1 ! ITIP - Int_BufSz = Int_BufSz + 1 ! ITRIP - Int_BufSz = Int_BufSz + 1 ! ITURB - Int_BufSz = Int_BufSz + 1 ! IInflow - Int_BufSz = Int_BufSz + 1 ! X_BLMethod - Int_BufSz = Int_BufSz + 1 ! TICalcMeth - Int_BufSz = Int_BufSz + 1 ! NReListBL - Int_BufSz = Int_BufSz + 1 ! aweightflag - Int_BufSz = Int_BufSz + 1 ! ROUND - Re_BufSz = Re_BufSz + 1 ! ALPRAT - Int_BufSz = Int_BufSz + 1 ! AA_Bl_Prcntge - Int_BufSz = Int_BufSz + 1 ! NrObsLoc - Int_BufSz = Int_BufSz + 1 ! ObsX allocated yes/no - IF ( ALLOCATED(InData%ObsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsX) ! ObsX - END IF - Int_BufSz = Int_BufSz + 1 ! ObsY allocated yes/no - IF ( ALLOCATED(InData%ObsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsY) ! ObsY - END IF - Int_BufSz = Int_BufSz + 1 ! ObsZ allocated yes/no - IF ( ALLOCATED(InData%ObsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsZ) ! ObsZ - END IF - Int_BufSz = Int_BufSz + 1 ! BladeProps allocated yes/no - IF ( ALLOCATED(InData%BladeProps) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeProps upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NrOutFile - Int_BufSz = Int_BufSz + 1 ! AAoutfile allocated yes/no - IF ( ALLOCATED(InData%AAoutfile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AAoutfile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AAoutfile)*LEN(InData%AAoutfile) ! AAoutfile - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%TICalcTabFile) ! TICalcTabFile - Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle - Db_BufSz = Db_BufSz + 1 ! AAStart - Re_BufSz = Re_BufSz + 1 ! Lturb - Re_BufSz = Re_BufSz + 1 ! AvgV - Int_BufSz = Int_BufSz + 1 ! ReListBL allocated yes/no - IF ( ALLOCATED(InData%ReListBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ReListBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ReListBL) ! ReListBL - END IF - Int_BufSz = Int_BufSz + 1 ! AoAListBL allocated yes/no - IF ( ALLOCATED(InData%AoAListBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AoAListBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AoAListBL) ! AoAListBL - END IF - Int_BufSz = Int_BufSz + 1 ! Pres_DispThick allocated yes/no - IF ( ALLOCATED(InData%Pres_DispThick) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Pres_DispThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Pres_DispThick) ! Pres_DispThick - END IF - Int_BufSz = Int_BufSz + 1 ! Suct_DispThick allocated yes/no - IF ( ALLOCATED(InData%Suct_DispThick) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Suct_DispThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Suct_DispThick) ! Suct_DispThick - END IF - Int_BufSz = Int_BufSz + 1 ! Pres_BLThick allocated yes/no - IF ( ALLOCATED(InData%Pres_BLThick) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Pres_BLThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Pres_BLThick) ! Pres_BLThick - END IF - Int_BufSz = Int_BufSz + 1 ! Suct_BLThick allocated yes/no - IF ( ALLOCATED(InData%Suct_BLThick) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Suct_BLThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Suct_BLThick) ! Suct_BLThick - END IF - Int_BufSz = Int_BufSz + 1 ! Pres_Cf allocated yes/no - IF ( ALLOCATED(InData%Pres_Cf) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Pres_Cf upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Pres_Cf) ! Pres_Cf - END IF - Int_BufSz = Int_BufSz + 1 ! Suct_Cf allocated yes/no - IF ( ALLOCATED(InData%Suct_Cf) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Suct_Cf upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Suct_Cf) ! Suct_Cf - END IF - Int_BufSz = Int_BufSz + 1 ! Pres_EdgeVelRat allocated yes/no - IF ( ALLOCATED(InData%Pres_EdgeVelRat) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Pres_EdgeVelRat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Pres_EdgeVelRat) ! Pres_EdgeVelRat - END IF - Int_BufSz = Int_BufSz + 1 ! Suct_EdgeVelRat allocated yes/no - IF ( ALLOCATED(InData%Suct_EdgeVelRat) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Suct_EdgeVelRat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Suct_EdgeVelRat) ! Suct_EdgeVelRat - END IF - Int_BufSz = Int_BufSz + 1 ! TI_Grid_In allocated yes/no - IF ( ALLOCATED(InData%TI_Grid_In) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TI_Grid_In upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_Grid_In) ! TI_Grid_In - END IF - Re_BufSz = Re_BufSz + 1 ! dz_turb_in - Re_BufSz = Re_BufSz + 1 ! dy_turb_in - 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_AA - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IBLUNT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ILAM - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITRIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITURB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IInflow - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%X_BLMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TICalcMeth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NReListBL - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%aweightflag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ROUND, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ALPRAT - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AA_Bl_Prcntge - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NrObsLoc - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ObsX) ) 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%ObsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsX,1), UBOUND(InData%ObsX,1) - ReKiBuf(Re_Xferred) = InData%ObsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ObsY) ) 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%ObsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsY,1), UBOUND(InData%ObsY,1) - ReKiBuf(Re_Xferred) = InData%ObsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ObsZ) ) 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%ObsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsZ,1), UBOUND(InData%ObsZ,1) - ReKiBuf(Re_Xferred) = InData%ObsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeProps) ) 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%BladeProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeProps,1) - 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 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%NrOutFile - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AAoutfile) ) 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%AAoutfile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAoutfile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AAoutfile,1), UBOUND(InData%AAoutfile,1) - DO I = 1, LEN(InData%AAoutfile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AAoutfile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%TICalcTabFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%TICalcTabFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%FTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%AAStart - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Lturb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AvgV - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ReListBL) ) 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%ReListBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ReListBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ReListBL,1), UBOUND(InData%ReListBL,1) - ReKiBuf(Re_Xferred) = InData%ReListBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AoAListBL) ) 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%AoAListBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AoAListBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AoAListBL,1), UBOUND(InData%AoAListBL,1) - ReKiBuf(Re_Xferred) = InData%AoAListBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pres_DispThick) ) 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%Pres_DispThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_DispThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_DispThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_DispThick,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_DispThick,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_DispThick,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Pres_DispThick,3), UBOUND(InData%Pres_DispThick,3) - DO i2 = LBOUND(InData%Pres_DispThick,2), UBOUND(InData%Pres_DispThick,2) - DO i1 = LBOUND(InData%Pres_DispThick,1), UBOUND(InData%Pres_DispThick,1) - ReKiBuf(Re_Xferred) = InData%Pres_DispThick(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Suct_DispThick) ) 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%Suct_DispThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_DispThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_DispThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_DispThick,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_DispThick,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_DispThick,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Suct_DispThick,3), UBOUND(InData%Suct_DispThick,3) - DO i2 = LBOUND(InData%Suct_DispThick,2), UBOUND(InData%Suct_DispThick,2) - DO i1 = LBOUND(InData%Suct_DispThick,1), UBOUND(InData%Suct_DispThick,1) - ReKiBuf(Re_Xferred) = InData%Suct_DispThick(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pres_BLThick) ) 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%Pres_BLThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_BLThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_BLThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_BLThick,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_BLThick,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_BLThick,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Pres_BLThick,3), UBOUND(InData%Pres_BLThick,3) - DO i2 = LBOUND(InData%Pres_BLThick,2), UBOUND(InData%Pres_BLThick,2) - DO i1 = LBOUND(InData%Pres_BLThick,1), UBOUND(InData%Pres_BLThick,1) - ReKiBuf(Re_Xferred) = InData%Pres_BLThick(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Suct_BLThick) ) 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%Suct_BLThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_BLThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_BLThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_BLThick,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_BLThick,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_BLThick,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Suct_BLThick,3), UBOUND(InData%Suct_BLThick,3) - DO i2 = LBOUND(InData%Suct_BLThick,2), UBOUND(InData%Suct_BLThick,2) - DO i1 = LBOUND(InData%Suct_BLThick,1), UBOUND(InData%Suct_BLThick,1) - ReKiBuf(Re_Xferred) = InData%Suct_BLThick(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pres_Cf) ) 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%Pres_Cf,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_Cf,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_Cf,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_Cf,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_Cf,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_Cf,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Pres_Cf,3), UBOUND(InData%Pres_Cf,3) - DO i2 = LBOUND(InData%Pres_Cf,2), UBOUND(InData%Pres_Cf,2) - DO i1 = LBOUND(InData%Pres_Cf,1), UBOUND(InData%Pres_Cf,1) - ReKiBuf(Re_Xferred) = InData%Pres_Cf(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Suct_Cf) ) 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%Suct_Cf,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_Cf,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_Cf,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_Cf,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_Cf,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_Cf,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Suct_Cf,3), UBOUND(InData%Suct_Cf,3) - DO i2 = LBOUND(InData%Suct_Cf,2), UBOUND(InData%Suct_Cf,2) - DO i1 = LBOUND(InData%Suct_Cf,1), UBOUND(InData%Suct_Cf,1) - ReKiBuf(Re_Xferred) = InData%Suct_Cf(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pres_EdgeVelRat) ) 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%Pres_EdgeVelRat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_EdgeVelRat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_EdgeVelRat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_EdgeVelRat,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_EdgeVelRat,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_EdgeVelRat,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Pres_EdgeVelRat,3), UBOUND(InData%Pres_EdgeVelRat,3) - DO i2 = LBOUND(InData%Pres_EdgeVelRat,2), UBOUND(InData%Pres_EdgeVelRat,2) - DO i1 = LBOUND(InData%Pres_EdgeVelRat,1), UBOUND(InData%Pres_EdgeVelRat,1) - ReKiBuf(Re_Xferred) = InData%Pres_EdgeVelRat(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Suct_EdgeVelRat) ) 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%Suct_EdgeVelRat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_EdgeVelRat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_EdgeVelRat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_EdgeVelRat,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_EdgeVelRat,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_EdgeVelRat,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Suct_EdgeVelRat,3), UBOUND(InData%Suct_EdgeVelRat,3) - DO i2 = LBOUND(InData%Suct_EdgeVelRat,2), UBOUND(InData%Suct_EdgeVelRat,2) - DO i1 = LBOUND(InData%Suct_EdgeVelRat,1), UBOUND(InData%Suct_EdgeVelRat,1) - ReKiBuf(Re_Xferred) = InData%Suct_EdgeVelRat(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI_Grid_In) ) 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%TI_Grid_In,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_Grid_In,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TI_Grid_In,2), UBOUND(InData%TI_Grid_In,2) - DO i1 = LBOUND(InData%TI_Grid_In,1), UBOUND(InData%TI_Grid_In,1) - ReKiBuf(Re_Xferred) = InData%TI_Grid_In(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%dz_turb_in - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dy_turb_in - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackInputFile - - SUBROUTINE AA_UnPackInputFile( 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(AA_InputFile), 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 = 'AA_UnPackInputFile' - ! 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_AA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%IBLUNT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ILAM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITIP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITRIP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITURB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%IInflow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X_BLMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TICalcMeth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NReListBL = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%aweightflag = TRANSFER(IntKiBuf(Int_Xferred), OutData%aweightflag) - Int_Xferred = Int_Xferred + 1 - OutData%ROUND = TRANSFER(IntKiBuf(Int_Xferred), OutData%ROUND) - Int_Xferred = Int_Xferred + 1 - OutData%ALPRAT = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AA_Bl_Prcntge = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NrObsLoc = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsX 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%ObsX)) DEALLOCATE(OutData%ObsX) - ALLOCATE(OutData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsX,1), UBOUND(OutData%ObsX,1) - OutData%ObsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsY 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%ObsY)) DEALLOCATE(OutData%ObsY) - ALLOCATE(OutData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsY,1), UBOUND(OutData%ObsY,1) - OutData%ObsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsZ 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%ObsZ)) DEALLOCATE(OutData%ObsZ) - ALLOCATE(OutData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsZ,1), UBOUND(OutData%ObsZ,1) - OutData%ObsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeProps 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%BladeProps)) DEALLOCATE(OutData%BladeProps) - ALLOCATE(OutData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeProps,1), UBOUND(OutData%BladeProps,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 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 - - 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%NrOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AAoutfile 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%AAoutfile)) DEALLOCATE(OutData%AAoutfile) - ALLOCATE(OutData%AAoutfile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAoutfile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AAoutfile,1), UBOUND(OutData%AAoutfile,1) - DO I = 1, LEN(OutData%AAoutfile) - OutData%AAoutfile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%TICalcTabFile) - OutData%TICalcTabFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%FTitle) - OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%AAStart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Lturb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AvgV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ReListBL 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%ReListBL)) DEALLOCATE(OutData%ReListBL) - ALLOCATE(OutData%ReListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ReListBL,1), UBOUND(OutData%ReListBL,1) - OutData%ReListBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AoAListBL 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%AoAListBL)) DEALLOCATE(OutData%AoAListBL) - ALLOCATE(OutData%AoAListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AoAListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AoAListBL,1), UBOUND(OutData%AoAListBL,1) - OutData%AoAListBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pres_DispThick 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%Pres_DispThick)) DEALLOCATE(OutData%Pres_DispThick) - ALLOCATE(OutData%Pres_DispThick(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%Pres_DispThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Pres_DispThick,3), UBOUND(OutData%Pres_DispThick,3) - DO i2 = LBOUND(OutData%Pres_DispThick,2), UBOUND(OutData%Pres_DispThick,2) - DO i1 = LBOUND(OutData%Pres_DispThick,1), UBOUND(OutData%Pres_DispThick,1) - OutData%Pres_DispThick(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Suct_DispThick 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%Suct_DispThick)) DEALLOCATE(OutData%Suct_DispThick) - ALLOCATE(OutData%Suct_DispThick(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%Suct_DispThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Suct_DispThick,3), UBOUND(OutData%Suct_DispThick,3) - DO i2 = LBOUND(OutData%Suct_DispThick,2), UBOUND(OutData%Suct_DispThick,2) - DO i1 = LBOUND(OutData%Suct_DispThick,1), UBOUND(OutData%Suct_DispThick,1) - OutData%Suct_DispThick(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pres_BLThick 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%Pres_BLThick)) DEALLOCATE(OutData%Pres_BLThick) - ALLOCATE(OutData%Pres_BLThick(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%Pres_BLThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Pres_BLThick,3), UBOUND(OutData%Pres_BLThick,3) - DO i2 = LBOUND(OutData%Pres_BLThick,2), UBOUND(OutData%Pres_BLThick,2) - DO i1 = LBOUND(OutData%Pres_BLThick,1), UBOUND(OutData%Pres_BLThick,1) - OutData%Pres_BLThick(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Suct_BLThick 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%Suct_BLThick)) DEALLOCATE(OutData%Suct_BLThick) - ALLOCATE(OutData%Suct_BLThick(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%Suct_BLThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Suct_BLThick,3), UBOUND(OutData%Suct_BLThick,3) - DO i2 = LBOUND(OutData%Suct_BLThick,2), UBOUND(OutData%Suct_BLThick,2) - DO i1 = LBOUND(OutData%Suct_BLThick,1), UBOUND(OutData%Suct_BLThick,1) - OutData%Suct_BLThick(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pres_Cf 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%Pres_Cf)) DEALLOCATE(OutData%Pres_Cf) - ALLOCATE(OutData%Pres_Cf(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%Pres_Cf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Pres_Cf,3), UBOUND(OutData%Pres_Cf,3) - DO i2 = LBOUND(OutData%Pres_Cf,2), UBOUND(OutData%Pres_Cf,2) - DO i1 = LBOUND(OutData%Pres_Cf,1), UBOUND(OutData%Pres_Cf,1) - OutData%Pres_Cf(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Suct_Cf 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%Suct_Cf)) DEALLOCATE(OutData%Suct_Cf) - ALLOCATE(OutData%Suct_Cf(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%Suct_Cf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Suct_Cf,3), UBOUND(OutData%Suct_Cf,3) - DO i2 = LBOUND(OutData%Suct_Cf,2), UBOUND(OutData%Suct_Cf,2) - DO i1 = LBOUND(OutData%Suct_Cf,1), UBOUND(OutData%Suct_Cf,1) - OutData%Suct_Cf(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pres_EdgeVelRat 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%Pres_EdgeVelRat)) DEALLOCATE(OutData%Pres_EdgeVelRat) - ALLOCATE(OutData%Pres_EdgeVelRat(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%Pres_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Pres_EdgeVelRat,3), UBOUND(OutData%Pres_EdgeVelRat,3) - DO i2 = LBOUND(OutData%Pres_EdgeVelRat,2), UBOUND(OutData%Pres_EdgeVelRat,2) - DO i1 = LBOUND(OutData%Pres_EdgeVelRat,1), UBOUND(OutData%Pres_EdgeVelRat,1) - OutData%Pres_EdgeVelRat(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Suct_EdgeVelRat 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%Suct_EdgeVelRat)) DEALLOCATE(OutData%Suct_EdgeVelRat) - ALLOCATE(OutData%Suct_EdgeVelRat(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%Suct_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Suct_EdgeVelRat,3), UBOUND(OutData%Suct_EdgeVelRat,3) - DO i2 = LBOUND(OutData%Suct_EdgeVelRat,2), UBOUND(OutData%Suct_EdgeVelRat,2) - DO i1 = LBOUND(OutData%Suct_EdgeVelRat,1), UBOUND(OutData%Suct_EdgeVelRat,1) - OutData%Suct_EdgeVelRat(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_Grid_In 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%TI_Grid_In)) DEALLOCATE(OutData%TI_Grid_In) - ALLOCATE(OutData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TI_Grid_In,2), UBOUND(OutData%TI_Grid_In,2) - DO i1 = LBOUND(OutData%TI_Grid_In,1), UBOUND(OutData%TI_Grid_In,1) - OutData%TI_Grid_In(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%dz_turb_in = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dy_turb_in = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackInputFile - - SUBROUTINE AA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(AA_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 = 'AA_CopyContState' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%NumBlades = SrcInitInputData%NumBlades + DstInitInputData%NumBlNds = SrcInitInputData%NumBlNds + DstInitInputData%RootName = SrcInitInputData%RootName + if (allocated(SrcInitInputData%BlSpn)) then + LB(1:2) = lbound(SrcInitInputData%BlSpn) + UB(1:2) = ubound(SrcInitInputData%BlSpn) + if (.not. allocated(DstInitInputData%BlSpn)) then + allocate(DstInitInputData%BlSpn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlSpn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BlSpn = SrcInitInputData%BlSpn + end if + if (allocated(SrcInitInputData%BlChord)) then + LB(1:2) = lbound(SrcInitInputData%BlChord) + UB(1:2) = ubound(SrcInitInputData%BlChord) + if (.not. allocated(DstInitInputData%BlChord)) then + allocate(DstInitInputData%BlChord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlChord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BlChord = SrcInitInputData%BlChord + end if + DstInitInputData%AirDens = SrcInitInputData%AirDens + DstInitInputData%KinVisc = SrcInitInputData%KinVisc + DstInitInputData%SpdSound = SrcInitInputData%SpdSound + DstInitInputData%HubHeight = SrcInitInputData%HubHeight + if (allocated(SrcInitInputData%BlAFID)) then + LB(1:2) = lbound(SrcInitInputData%BlAFID) + UB(1:2) = ubound(SrcInitInputData%BlAFID) + if (.not. allocated(DstInitInputData%BlAFID)) then + allocate(DstInitInputData%BlAFID(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlAFID.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BlAFID = SrcInitInputData%BlAFID + end if + if (allocated(SrcInitInputData%AFInfo)) then + LB(1:1) = lbound(SrcInitInputData%AFInfo) + UB(1:1) = ubound(SrcInitInputData%AFInfo) + if (.not. allocated(DstInitInputData%AFInfo)) then + allocate(DstInitInputData%AFInfo(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFInfo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AFI_CopyParam(SrcInitInputData%AFInfo(i1), DstInitInputData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(AA_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE AA_CopyContState - - SUBROUTINE AA_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(AA_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 = 'AA_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AA_DestroyContState - - SUBROUTINE AA_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(AA_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 = 'AA_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 AA_PackContState - - SUBROUTINE AA_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(AA_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 = 'AA_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 AA_UnPackContState - - SUBROUTINE AA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(AA_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) :: 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 = 'AA_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitInputData%BlSpn)) then + deallocate(InitInputData%BlSpn) + end if + if (allocated(InitInputData%BlChord)) then + deallocate(InitInputData%BlChord) + end if + if (allocated(InitInputData%BlAFID)) then + deallocate(InitInputData%BlAFID) + end if + if (allocated(InitInputData%AFInfo)) then + LB(1:1) = lbound(InitInputData%AFInfo) + UB(1:1) = ubound(InitInputData%AFInfo) + do i1 = LB(1), UB(1) + call AFI_DestroyParam(InitInputData%AFInfo(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%AFInfo) + end if +end subroutine + +subroutine AA_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackInitInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%NumBlades) + call RegPack(Buf, InData%NumBlNds) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, allocated(InData%BlSpn)) + if (allocated(InData%BlSpn)) then + call RegPackBounds(Buf, 2, lbound(InData%BlSpn), ubound(InData%BlSpn)) + call RegPack(Buf, InData%BlSpn) + end if + call RegPack(Buf, allocated(InData%BlChord)) + if (allocated(InData%BlChord)) then + call RegPackBounds(Buf, 2, lbound(InData%BlChord), ubound(InData%BlChord)) + call RegPack(Buf, InData%BlChord) + end if + call RegPack(Buf, InData%AirDens) + call RegPack(Buf, InData%KinVisc) + call RegPack(Buf, InData%SpdSound) + call RegPack(Buf, InData%HubHeight) + call RegPack(Buf, allocated(InData%BlAFID)) + if (allocated(InData%BlAFID)) then + call RegPackBounds(Buf, 2, lbound(InData%BlAFID), ubound(InData%BlAFID)) + call RegPack(Buf, InData%BlAFID) + end if + call RegPack(Buf, allocated(InData%AFInfo)) + if (allocated(InData%AFInfo)) then + call RegPackBounds(Buf, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) + LB(1:1) = lbound(InData%AFInfo) + UB(1:1) = ubound(InData%AFInfo) + do i1 = LB(1), UB(1) + call AFI_PackParam(Buf, InData%AFInfo(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackInitInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBlNds) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BlSpn)) deallocate(OutData%BlSpn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlSpn(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlSpn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlChord)) deallocate(OutData%BlChord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlChord(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlChord) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubHeight) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BlAFID)) deallocate(OutData%BlAFID) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlAFID(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlAFID) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AFInfo)) deallocate(OutData%AFInfo) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFInfo(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AFI_UnpackParam(Buf, OutData%AFInfo(i1)) ! AFInfo + end do + end if +end subroutine + +subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(AA_InitOutputType), intent(in) :: SrcInitOutputData + type(AA_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%MeanVrel)) THEN - i1_l = LBOUND(SrcDiscStateData%MeanVrel,1) - i1_u = UBOUND(SrcDiscStateData%MeanVrel,1) - i2_l = LBOUND(SrcDiscStateData%MeanVrel,2) - i2_u = UBOUND(SrcDiscStateData%MeanVrel,2) - IF (.NOT. ALLOCATED(DstDiscStateData%MeanVrel)) THEN - ALLOCATE(DstDiscStateData%MeanVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%MeanVrel = SrcDiscStateData%MeanVrel -ENDIF -IF (ALLOCATED(SrcDiscStateData%VrelSq)) THEN - i1_l = LBOUND(SrcDiscStateData%VrelSq,1) - i1_u = UBOUND(SrcDiscStateData%VrelSq,1) - i2_l = LBOUND(SrcDiscStateData%VrelSq,2) - i2_u = UBOUND(SrcDiscStateData%VrelSq,2) - IF (.NOT. ALLOCATED(DstDiscStateData%VrelSq)) THEN - ALLOCATE(DstDiscStateData%VrelSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelSq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%VrelSq = SrcDiscStateData%VrelSq -ENDIF -IF (ALLOCATED(SrcDiscStateData%TIVrel)) THEN - i1_l = LBOUND(SrcDiscStateData%TIVrel,1) - i1_u = UBOUND(SrcDiscStateData%TIVrel,1) - i2_l = LBOUND(SrcDiscStateData%TIVrel,2) - i2_u = UBOUND(SrcDiscStateData%TIVrel,2) - IF (.NOT. ALLOCATED(DstDiscStateData%TIVrel)) THEN - ALLOCATE(DstDiscStateData%TIVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%TIVrel = SrcDiscStateData%TIVrel -ENDIF -IF (ALLOCATED(SrcDiscStateData%VrelStore)) THEN - i1_l = LBOUND(SrcDiscStateData%VrelStore,1) - i1_u = UBOUND(SrcDiscStateData%VrelStore,1) - i2_l = LBOUND(SrcDiscStateData%VrelStore,2) - i2_u = UBOUND(SrcDiscStateData%VrelStore,2) - i3_l = LBOUND(SrcDiscStateData%VrelStore,3) - i3_u = UBOUND(SrcDiscStateData%VrelStore,3) - IF (.NOT. ALLOCATED(DstDiscStateData%VrelStore)) THEN - ALLOCATE(DstDiscStateData%VrelStore(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelStore.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%VrelStore = SrcDiscStateData%VrelStore -ENDIF -IF (ALLOCATED(SrcDiscStateData%TIVx)) THEN - i1_l = LBOUND(SrcDiscStateData%TIVx,1) - i1_u = UBOUND(SrcDiscStateData%TIVx,1) - i2_l = LBOUND(SrcDiscStateData%TIVx,2) - i2_u = UBOUND(SrcDiscStateData%TIVx,2) - IF (.NOT. ALLOCATED(DstDiscStateData%TIVx)) THEN - ALLOCATE(DstDiscStateData%TIVx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%TIVx = SrcDiscStateData%TIVx -ENDIF -IF (ALLOCATED(SrcDiscStateData%MeanVxVyVz)) THEN - i1_l = LBOUND(SrcDiscStateData%MeanVxVyVz,1) - i1_u = UBOUND(SrcDiscStateData%MeanVxVyVz,1) - i2_l = LBOUND(SrcDiscStateData%MeanVxVyVz,2) - i2_u = UBOUND(SrcDiscStateData%MeanVxVyVz,2) - IF (.NOT. ALLOCATED(DstDiscStateData%MeanVxVyVz)) THEN - ALLOCATE(DstDiscStateData%MeanVxVyVz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVxVyVz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%MeanVxVyVz = SrcDiscStateData%MeanVxVyVz -ENDIF -IF (ALLOCATED(SrcDiscStateData%VxSq)) THEN - i1_l = LBOUND(SrcDiscStateData%VxSq,1) - i1_u = UBOUND(SrcDiscStateData%VxSq,1) - i2_l = LBOUND(SrcDiscStateData%VxSq,2) - i2_u = UBOUND(SrcDiscStateData%VxSq,2) - IF (.NOT. ALLOCATED(DstDiscStateData%VxSq)) THEN - ALLOCATE(DstDiscStateData%VxSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%VxSq = SrcDiscStateData%VxSq -ENDIF -IF (ALLOCATED(SrcDiscStateData%allregcounter)) THEN - i1_l = LBOUND(SrcDiscStateData%allregcounter,1) - i1_u = UBOUND(SrcDiscStateData%allregcounter,1) - i2_l = LBOUND(SrcDiscStateData%allregcounter,2) - i2_u = UBOUND(SrcDiscStateData%allregcounter,2) - IF (.NOT. ALLOCATED(DstDiscStateData%allregcounter)) THEN - ALLOCATE(DstDiscStateData%allregcounter(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%allregcounter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%allregcounter = SrcDiscStateData%allregcounter -ENDIF -IF (ALLOCATED(SrcDiscStateData%VxSqRegion)) THEN - i1_l = LBOUND(SrcDiscStateData%VxSqRegion,1) - i1_u = UBOUND(SrcDiscStateData%VxSqRegion,1) - i2_l = LBOUND(SrcDiscStateData%VxSqRegion,2) - i2_u = UBOUND(SrcDiscStateData%VxSqRegion,2) - IF (.NOT. ALLOCATED(DstDiscStateData%VxSqRegion)) THEN - ALLOCATE(DstDiscStateData%VxSqRegion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSqRegion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%VxSqRegion = SrcDiscStateData%VxSqRegion -ENDIF -IF (ALLOCATED(SrcDiscStateData%RegVxStor)) THEN - i1_l = LBOUND(SrcDiscStateData%RegVxStor,1) - i1_u = UBOUND(SrcDiscStateData%RegVxStor,1) - i2_l = LBOUND(SrcDiscStateData%RegVxStor,2) - i2_u = UBOUND(SrcDiscStateData%RegVxStor,2) - i3_l = LBOUND(SrcDiscStateData%RegVxStor,3) - i3_u = UBOUND(SrcDiscStateData%RegVxStor,3) - IF (.NOT. ALLOCATED(DstDiscStateData%RegVxStor)) THEN - ALLOCATE(DstDiscStateData%RegVxStor(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegVxStor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%RegVxStor = SrcDiscStateData%RegVxStor -ENDIF -IF (ALLOCATED(SrcDiscStateData%RegionTIDelete)) THEN - i1_l = LBOUND(SrcDiscStateData%RegionTIDelete,1) - i1_u = UBOUND(SrcDiscStateData%RegionTIDelete,1) - i2_l = LBOUND(SrcDiscStateData%RegionTIDelete,2) - i2_u = UBOUND(SrcDiscStateData%RegionTIDelete,2) - IF (.NOT. ALLOCATED(DstDiscStateData%RegionTIDelete)) THEN - ALLOCATE(DstDiscStateData%RegionTIDelete(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegionTIDelete.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%RegionTIDelete = SrcDiscStateData%RegionTIDelete -ENDIF - END SUBROUTINE AA_CopyDiscState - - SUBROUTINE AA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(AA_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 = 'AA_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%MeanVrel)) THEN - DEALLOCATE(DiscStateData%MeanVrel) -ENDIF -IF (ALLOCATED(DiscStateData%VrelSq)) THEN - DEALLOCATE(DiscStateData%VrelSq) -ENDIF -IF (ALLOCATED(DiscStateData%TIVrel)) THEN - DEALLOCATE(DiscStateData%TIVrel) -ENDIF -IF (ALLOCATED(DiscStateData%VrelStore)) THEN - DEALLOCATE(DiscStateData%VrelStore) -ENDIF -IF (ALLOCATED(DiscStateData%TIVx)) THEN - DEALLOCATE(DiscStateData%TIVx) -ENDIF -IF (ALLOCATED(DiscStateData%MeanVxVyVz)) THEN - DEALLOCATE(DiscStateData%MeanVxVyVz) -ENDIF -IF (ALLOCATED(DiscStateData%VxSq)) THEN - DEALLOCATE(DiscStateData%VxSq) -ENDIF -IF (ALLOCATED(DiscStateData%allregcounter)) THEN - DEALLOCATE(DiscStateData%allregcounter) -ENDIF -IF (ALLOCATED(DiscStateData%VxSqRegion)) THEN - DEALLOCATE(DiscStateData%VxSqRegion) -ENDIF -IF (ALLOCATED(DiscStateData%RegVxStor)) THEN - DEALLOCATE(DiscStateData%RegVxStor) -ENDIF -IF (ALLOCATED(DiscStateData%RegionTIDelete)) THEN - DEALLOCATE(DiscStateData%RegionTIDelete) -ENDIF - END SUBROUTINE AA_DestroyDiscState - - SUBROUTINE AA_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(AA_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 = 'AA_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 - Int_BufSz = Int_BufSz + 1 ! MeanVrel allocated yes/no - IF ( ALLOCATED(InData%MeanVrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MeanVrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MeanVrel) ! MeanVrel - END IF - Int_BufSz = Int_BufSz + 1 ! VrelSq allocated yes/no - IF ( ALLOCATED(InData%VrelSq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VrelSq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VrelSq) ! VrelSq - END IF - Int_BufSz = Int_BufSz + 1 ! TIVrel allocated yes/no - IF ( ALLOCATED(InData%TIVrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TIVrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TIVrel) ! TIVrel - END IF - Int_BufSz = Int_BufSz + 1 ! VrelStore allocated yes/no - IF ( ALLOCATED(InData%VrelStore) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! VrelStore upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VrelStore) ! VrelStore - END IF - Int_BufSz = Int_BufSz + 1 ! TIVx allocated yes/no - IF ( ALLOCATED(InData%TIVx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TIVx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TIVx) ! TIVx - END IF - Int_BufSz = Int_BufSz + 1 ! MeanVxVyVz allocated yes/no - IF ( ALLOCATED(InData%MeanVxVyVz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MeanVxVyVz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MeanVxVyVz) ! MeanVxVyVz - END IF - Int_BufSz = Int_BufSz + 1 ! VxSq allocated yes/no - IF ( ALLOCATED(InData%VxSq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VxSq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VxSq) ! VxSq - END IF - Int_BufSz = Int_BufSz + 1 ! allregcounter allocated yes/no - IF ( ALLOCATED(InData%allregcounter) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! allregcounter upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%allregcounter) ! allregcounter - END IF - Int_BufSz = Int_BufSz + 1 ! VxSqRegion allocated yes/no - IF ( ALLOCATED(InData%VxSqRegion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VxSqRegion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VxSqRegion) ! VxSqRegion - END IF - Int_BufSz = Int_BufSz + 1 ! RegVxStor allocated yes/no - IF ( ALLOCATED(InData%RegVxStor) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! RegVxStor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RegVxStor) ! RegVxStor - END IF - Int_BufSz = Int_BufSz + 1 ! RegionTIDelete allocated yes/no - IF ( ALLOCATED(InData%RegionTIDelete) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! RegionTIDelete upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RegionTIDelete) ! RegionTIDelete - 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%MeanVrel) ) 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%MeanVrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeanVrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MeanVrel,2), UBOUND(InData%MeanVrel,2) - DO i1 = LBOUND(InData%MeanVrel,1), UBOUND(InData%MeanVrel,1) - ReKiBuf(Re_Xferred) = InData%MeanVrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VrelSq) ) 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%VrelSq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelSq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelSq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelSq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%VrelSq,2), UBOUND(InData%VrelSq,2) - DO i1 = LBOUND(InData%VrelSq,1), UBOUND(InData%VrelSq,1) - ReKiBuf(Re_Xferred) = InData%VrelSq(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TIVrel) ) 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%TIVrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIVrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TIVrel,2), UBOUND(InData%TIVrel,2) - DO i1 = LBOUND(InData%TIVrel,1), UBOUND(InData%TIVrel,1) - ReKiBuf(Re_Xferred) = InData%TIVrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VrelStore) ) 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%VrelStore,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelStore,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelStore,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelStore,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelStore,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelStore,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%VrelStore,3), UBOUND(InData%VrelStore,3) - DO i2 = LBOUND(InData%VrelStore,2), UBOUND(InData%VrelStore,2) - DO i1 = LBOUND(InData%VrelStore,1), UBOUND(InData%VrelStore,1) - ReKiBuf(Re_Xferred) = InData%VrelStore(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TIVx) ) 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%TIVx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIVx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TIVx,2), UBOUND(InData%TIVx,2) - DO i1 = LBOUND(InData%TIVx,1), UBOUND(InData%TIVx,1) - ReKiBuf(Re_Xferred) = InData%TIVx(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MeanVxVyVz) ) 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%MeanVxVyVz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVxVyVz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeanVxVyVz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVxVyVz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MeanVxVyVz,2), UBOUND(InData%MeanVxVyVz,2) - DO i1 = LBOUND(InData%MeanVxVyVz,1), UBOUND(InData%MeanVxVyVz,1) - ReKiBuf(Re_Xferred) = InData%MeanVxVyVz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VxSq) ) 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%VxSq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VxSq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%VxSq,2), UBOUND(InData%VxSq,2) - DO i1 = LBOUND(InData%VxSq,1), UBOUND(InData%VxSq,1) - ReKiBuf(Re_Xferred) = InData%VxSq(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%allregcounter) ) 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%allregcounter,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%allregcounter,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%allregcounter,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%allregcounter,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%allregcounter,2), UBOUND(InData%allregcounter,2) - DO i1 = LBOUND(InData%allregcounter,1), UBOUND(InData%allregcounter,1) - ReKiBuf(Re_Xferred) = InData%allregcounter(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VxSqRegion) ) 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%VxSqRegion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSqRegion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VxSqRegion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSqRegion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%VxSqRegion,2), UBOUND(InData%VxSqRegion,2) - DO i1 = LBOUND(InData%VxSqRegion,1), UBOUND(InData%VxSqRegion,1) - ReKiBuf(Re_Xferred) = InData%VxSqRegion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RegVxStor) ) 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%RegVxStor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegVxStor,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RegVxStor,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegVxStor,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RegVxStor,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegVxStor,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%RegVxStor,3), UBOUND(InData%RegVxStor,3) - DO i2 = LBOUND(InData%RegVxStor,2), UBOUND(InData%RegVxStor,2) - DO i1 = LBOUND(InData%RegVxStor,1), UBOUND(InData%RegVxStor,1) - ReKiBuf(Re_Xferred) = InData%RegVxStor(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RegionTIDelete) ) 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%RegionTIDelete,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegionTIDelete,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RegionTIDelete,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegionTIDelete,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%RegionTIDelete,2), UBOUND(InData%RegionTIDelete,2) - DO i1 = LBOUND(InData%RegionTIDelete,1), UBOUND(InData%RegionTIDelete,1) - ReKiBuf(Re_Xferred) = InData%RegionTIDelete(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AA_PackDiscState - - SUBROUTINE AA_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(AA_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) :: 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 = 'AA_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeanVrel 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%MeanVrel)) DEALLOCATE(OutData%MeanVrel) - ALLOCATE(OutData%MeanVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeanVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MeanVrel,2), UBOUND(OutData%MeanVrel,2) - DO i1 = LBOUND(OutData%MeanVrel,1), UBOUND(OutData%MeanVrel,1) - OutData%MeanVrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VrelSq 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%VrelSq)) DEALLOCATE(OutData%VrelSq) - ALLOCATE(OutData%VrelSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VrelSq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%VrelSq,2), UBOUND(OutData%VrelSq,2) - DO i1 = LBOUND(OutData%VrelSq,1), UBOUND(OutData%VrelSq,1) - OutData%VrelSq(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIVrel 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%TIVrel)) DEALLOCATE(OutData%TIVrel) - ALLOCATE(OutData%TIVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TIVrel,2), UBOUND(OutData%TIVrel,2) - DO i1 = LBOUND(OutData%TIVrel,1), UBOUND(OutData%TIVrel,1) - OutData%TIVrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VrelStore 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%VrelStore)) DEALLOCATE(OutData%VrelStore) - ALLOCATE(OutData%VrelStore(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%VrelStore.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%VrelStore,3), UBOUND(OutData%VrelStore,3) - DO i2 = LBOUND(OutData%VrelStore,2), UBOUND(OutData%VrelStore,2) - DO i1 = LBOUND(OutData%VrelStore,1), UBOUND(OutData%VrelStore,1) - OutData%VrelStore(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIVx 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%TIVx)) DEALLOCATE(OutData%TIVx) - ALLOCATE(OutData%TIVx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIVx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TIVx,2), UBOUND(OutData%TIVx,2) - DO i1 = LBOUND(OutData%TIVx,1), UBOUND(OutData%TIVx,1) - OutData%TIVx(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeanVxVyVz 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%MeanVxVyVz)) DEALLOCATE(OutData%MeanVxVyVz) - ALLOCATE(OutData%MeanVxVyVz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeanVxVyVz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MeanVxVyVz,2), UBOUND(OutData%MeanVxVyVz,2) - DO i1 = LBOUND(OutData%MeanVxVyVz,1), UBOUND(OutData%MeanVxVyVz,1) - OutData%MeanVxVyVz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VxSq 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%VxSq)) DEALLOCATE(OutData%VxSq) - ALLOCATE(OutData%VxSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VxSq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%VxSq,2), UBOUND(OutData%VxSq,2) - DO i1 = LBOUND(OutData%VxSq,1), UBOUND(OutData%VxSq,1) - OutData%VxSq(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! allregcounter 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%allregcounter)) DEALLOCATE(OutData%allregcounter) - ALLOCATE(OutData%allregcounter(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%allregcounter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%allregcounter,2), UBOUND(OutData%allregcounter,2) - DO i1 = LBOUND(OutData%allregcounter,1), UBOUND(OutData%allregcounter,1) - OutData%allregcounter(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VxSqRegion 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%VxSqRegion)) DEALLOCATE(OutData%VxSqRegion) - ALLOCATE(OutData%VxSqRegion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VxSqRegion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%VxSqRegion,2), UBOUND(OutData%VxSqRegion,2) - DO i1 = LBOUND(OutData%VxSqRegion,1), UBOUND(OutData%VxSqRegion,1) - OutData%VxSqRegion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RegVxStor 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%RegVxStor)) DEALLOCATE(OutData%RegVxStor) - ALLOCATE(OutData%RegVxStor(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%RegVxStor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%RegVxStor,3), UBOUND(OutData%RegVxStor,3) - DO i2 = LBOUND(OutData%RegVxStor,2), UBOUND(OutData%RegVxStor,2) - DO i1 = LBOUND(OutData%RegVxStor,1), UBOUND(OutData%RegVxStor,1) - OutData%RegVxStor(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RegionTIDelete 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%RegionTIDelete)) DEALLOCATE(OutData%RegionTIDelete) - ALLOCATE(OutData%RegionTIDelete(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegionTIDelete.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%RegionTIDelete,2), UBOUND(OutData%RegionTIDelete,2) - DO i1 = LBOUND(OutData%RegionTIDelete,1), UBOUND(OutData%RegionTIDelete,1) - OutData%RegionTIDelete(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AA_UnPackDiscState - - SUBROUTINE AA_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(AA_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 = 'AA_CopyConstrState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputHdrforPE)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrforPE) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrforPE) + if (.not. allocated(DstInitOutputData%WriteOutputHdrforPE)) then + allocate(DstInitOutputData%WriteOutputHdrforPE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrforPE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdrforPE = SrcInitOutputData%WriteOutputHdrforPE + end if + if (allocated(SrcInitOutputData%WriteOutputUntforPE)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntforPE) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntforPE) + if (.not. allocated(DstInitOutputData%WriteOutputUntforPE)) then + allocate(DstInitOutputData%WriteOutputUntforPE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntforPE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUntforPE = SrcInitOutputData%WriteOutputUntforPE + end if + if (allocated(SrcInitOutputData%WriteOutputHdrSep)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrSep) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrSep) + if (.not. allocated(DstInitOutputData%WriteOutputHdrSep)) then + allocate(DstInitOutputData%WriteOutputHdrSep(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrSep.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdrSep = SrcInitOutputData%WriteOutputHdrSep + end if + if (allocated(SrcInitOutputData%WriteOutputUntSep)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntSep) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntSep) + if (.not. allocated(DstInitOutputData%WriteOutputUntSep)) then + allocate(DstInitOutputData%WriteOutputUntSep(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntSep.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUntSep = SrcInitOutputData%WriteOutputUntSep + end if + if (allocated(SrcInitOutputData%WriteOutputHdrNodes)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrNodes) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrNodes) + if (.not. allocated(DstInitOutputData%WriteOutputHdrNodes)) then + allocate(DstInitOutputData%WriteOutputHdrNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdrNodes = SrcInitOutputData%WriteOutputHdrNodes + end if + if (allocated(SrcInitOutputData%WriteOutputUntNodes)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntNodes) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntNodes) + if (.not. allocated(DstInitOutputData%WriteOutputUntNodes)) then + allocate(DstInitOutputData%WriteOutputUntNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUntNodes = SrcInitOutputData%WriteOutputUntNodes + end if + DstInitOutputData%delim = SrcInitOutputData%delim + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%AirDens = SrcInitOutputData%AirDens +end subroutine + +subroutine AA_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(AA_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE AA_CopyConstrState - - SUBROUTINE AA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(AA_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 = 'AA_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AA_DestroyConstrState - - SUBROUTINE AA_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(AA_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 = 'AA_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 AA_PackConstrState - - SUBROUTINE AA_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(AA_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 = 'AA_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 AA_UnPackConstrState - - SUBROUTINE AA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(AA_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 = 'AA_CopyOtherState' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + if (allocated(InitOutputData%WriteOutputHdrforPE)) then + deallocate(InitOutputData%WriteOutputHdrforPE) + end if + if (allocated(InitOutputData%WriteOutputUntforPE)) then + deallocate(InitOutputData%WriteOutputUntforPE) + end if + if (allocated(InitOutputData%WriteOutputHdrSep)) then + deallocate(InitOutputData%WriteOutputHdrSep) + end if + if (allocated(InitOutputData%WriteOutputUntSep)) then + deallocate(InitOutputData%WriteOutputUntSep) + end if + if (allocated(InitOutputData%WriteOutputHdrNodes)) then + deallocate(InitOutputData%WriteOutputHdrNodes) + end if + if (allocated(InitOutputData%WriteOutputUntNodes)) then + deallocate(InitOutputData%WriteOutputUntNodes) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AA_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call RegPack(Buf, allocated(InData%WriteOutputHdrforPE)) + if (allocated(InData%WriteOutputHdrforPE)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrforPE), ubound(InData%WriteOutputHdrforPE)) + call RegPack(Buf, InData%WriteOutputHdrforPE) + end if + call RegPack(Buf, allocated(InData%WriteOutputUntforPE)) + if (allocated(InData%WriteOutputUntforPE)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntforPE), ubound(InData%WriteOutputUntforPE)) + call RegPack(Buf, InData%WriteOutputUntforPE) + end if + call RegPack(Buf, allocated(InData%WriteOutputHdrSep)) + if (allocated(InData%WriteOutputHdrSep)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrSep), ubound(InData%WriteOutputHdrSep)) + call RegPack(Buf, InData%WriteOutputHdrSep) + end if + call RegPack(Buf, allocated(InData%WriteOutputUntSep)) + if (allocated(InData%WriteOutputUntSep)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntSep), ubound(InData%WriteOutputUntSep)) + call RegPack(Buf, InData%WriteOutputUntSep) + end if + call RegPack(Buf, allocated(InData%WriteOutputHdrNodes)) + if (allocated(InData%WriteOutputHdrNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrNodes), ubound(InData%WriteOutputHdrNodes)) + call RegPack(Buf, InData%WriteOutputHdrNodes) + end if + call RegPack(Buf, allocated(InData%WriteOutputUntNodes)) + if (allocated(InData%WriteOutputUntNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntNodes), ubound(InData%WriteOutputUntNodes)) + call RegPack(Buf, InData%WriteOutputUntNodes) + end if + call RegPack(Buf, InData%delim) + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, InData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputHdrforPE)) deallocate(OutData%WriteOutputHdrforPE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdrforPE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrforPE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdrforPE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUntforPE)) deallocate(OutData%WriteOutputUntforPE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUntforPE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntforPE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUntforPE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputHdrSep)) deallocate(OutData%WriteOutputHdrSep) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdrSep(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrSep.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdrSep) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUntSep)) deallocate(OutData%WriteOutputUntSep) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUntSep(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntSep.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUntSep) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputHdrNodes)) deallocate(OutData%WriteOutputHdrNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdrNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdrNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUntNodes)) deallocate(OutData%WriteOutputUntNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUntNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUntNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%delim) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(AA_InputFile), intent(in) :: SrcInputFileData + type(AA_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE AA_CopyOtherState - - SUBROUTINE AA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(AA_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 = 'AA_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AA_DestroyOtherState - - SUBROUTINE AA_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(AA_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 = 'AA_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 - Re_BufSz = Re_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 - - ReKiBuf(Re_Xferred) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackOtherState - - SUBROUTINE AA_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(AA_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 = 'AA_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackOtherState - - SUBROUTINE AA_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(AA_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) :: 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 = 'AA_CopyMisc' -! + ErrMsg = '' + DstInputFileData%DT_AA = SrcInputFileData%DT_AA + DstInputFileData%IBLUNT = SrcInputFileData%IBLUNT + DstInputFileData%ILAM = SrcInputFileData%ILAM + DstInputFileData%ITIP = SrcInputFileData%ITIP + DstInputFileData%ITRIP = SrcInputFileData%ITRIP + DstInputFileData%ITURB = SrcInputFileData%ITURB + DstInputFileData%IInflow = SrcInputFileData%IInflow + DstInputFileData%X_BLMethod = SrcInputFileData%X_BLMethod + DstInputFileData%TICalcMeth = SrcInputFileData%TICalcMeth + DstInputFileData%NReListBL = SrcInputFileData%NReListBL + DstInputFileData%aweightflag = SrcInputFileData%aweightflag + DstInputFileData%ROUND = SrcInputFileData%ROUND + DstInputFileData%ALPRAT = SrcInputFileData%ALPRAT + DstInputFileData%AA_Bl_Prcntge = SrcInputFileData%AA_Bl_Prcntge + DstInputFileData%NrObsLoc = SrcInputFileData%NrObsLoc + if (allocated(SrcInputFileData%ObsX)) then + LB(1:1) = lbound(SrcInputFileData%ObsX) + UB(1:1) = ubound(SrcInputFileData%ObsX) + if (.not. allocated(DstInputFileData%ObsX)) then + allocate(DstInputFileData%ObsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ObsX = SrcInputFileData%ObsX + end if + if (allocated(SrcInputFileData%ObsY)) then + LB(1:1) = lbound(SrcInputFileData%ObsY) + UB(1:1) = ubound(SrcInputFileData%ObsY) + if (.not. allocated(DstInputFileData%ObsY)) then + allocate(DstInputFileData%ObsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ObsY = SrcInputFileData%ObsY + end if + if (allocated(SrcInputFileData%ObsZ)) then + LB(1:1) = lbound(SrcInputFileData%ObsZ) + UB(1:1) = ubound(SrcInputFileData%ObsZ) + if (.not. allocated(DstInputFileData%ObsZ)) then + allocate(DstInputFileData%ObsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ObsZ = SrcInputFileData%ObsZ + end if + if (allocated(SrcInputFileData%BladeProps)) then + LB(1:1) = lbound(SrcInputFileData%BladeProps) + UB(1:1) = ubound(SrcInputFileData%BladeProps) + if (.not. allocated(DstInputFileData%BladeProps)) then + allocate(DstInputFileData%BladeProps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BladeProps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AA_CopyBladePropsType(SrcInputFileData%BladeProps(i1), DstInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInputFileData%NrOutFile = SrcInputFileData%NrOutFile + if (allocated(SrcInputFileData%AAoutfile)) then + LB(1:1) = lbound(SrcInputFileData%AAoutfile) + UB(1:1) = ubound(SrcInputFileData%AAoutfile) + if (.not. allocated(DstInputFileData%AAoutfile)) then + allocate(DstInputFileData%AAoutfile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AAoutfile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AAoutfile = SrcInputFileData%AAoutfile + end if + DstInputFileData%TICalcTabFile = SrcInputFileData%TICalcTabFile + DstInputFileData%FTitle = SrcInputFileData%FTitle + DstInputFileData%AAStart = SrcInputFileData%AAStart + DstInputFileData%Lturb = SrcInputFileData%Lturb + DstInputFileData%AvgV = SrcInputFileData%AvgV + if (allocated(SrcInputFileData%ReListBL)) then + LB(1:1) = lbound(SrcInputFileData%ReListBL) + UB(1:1) = ubound(SrcInputFileData%ReListBL) + if (.not. allocated(DstInputFileData%ReListBL)) then + allocate(DstInputFileData%ReListBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ReListBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ReListBL = SrcInputFileData%ReListBL + end if + if (allocated(SrcInputFileData%AoAListBL)) then + LB(1:1) = lbound(SrcInputFileData%AoAListBL) + UB(1:1) = ubound(SrcInputFileData%AoAListBL) + if (.not. allocated(DstInputFileData%AoAListBL)) then + allocate(DstInputFileData%AoAListBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AoAListBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AoAListBL = SrcInputFileData%AoAListBL + end if + if (allocated(SrcInputFileData%Pres_DispThick)) then + LB(1:3) = lbound(SrcInputFileData%Pres_DispThick) + UB(1:3) = ubound(SrcInputFileData%Pres_DispThick) + if (.not. allocated(DstInputFileData%Pres_DispThick)) then + allocate(DstInputFileData%Pres_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_DispThick.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Pres_DispThick = SrcInputFileData%Pres_DispThick + end if + if (allocated(SrcInputFileData%Suct_DispThick)) then + LB(1:3) = lbound(SrcInputFileData%Suct_DispThick) + UB(1:3) = ubound(SrcInputFileData%Suct_DispThick) + if (.not. allocated(DstInputFileData%Suct_DispThick)) then + allocate(DstInputFileData%Suct_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_DispThick.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Suct_DispThick = SrcInputFileData%Suct_DispThick + end if + if (allocated(SrcInputFileData%Pres_BLThick)) then + LB(1:3) = lbound(SrcInputFileData%Pres_BLThick) + UB(1:3) = ubound(SrcInputFileData%Pres_BLThick) + if (.not. allocated(DstInputFileData%Pres_BLThick)) then + allocate(DstInputFileData%Pres_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_BLThick.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Pres_BLThick = SrcInputFileData%Pres_BLThick + end if + if (allocated(SrcInputFileData%Suct_BLThick)) then + LB(1:3) = lbound(SrcInputFileData%Suct_BLThick) + UB(1:3) = ubound(SrcInputFileData%Suct_BLThick) + if (.not. allocated(DstInputFileData%Suct_BLThick)) then + allocate(DstInputFileData%Suct_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_BLThick.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Suct_BLThick = SrcInputFileData%Suct_BLThick + end if + if (allocated(SrcInputFileData%Pres_Cf)) then + LB(1:3) = lbound(SrcInputFileData%Pres_Cf) + UB(1:3) = ubound(SrcInputFileData%Pres_Cf) + if (.not. allocated(DstInputFileData%Pres_Cf)) then + allocate(DstInputFileData%Pres_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_Cf.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Pres_Cf = SrcInputFileData%Pres_Cf + end if + if (allocated(SrcInputFileData%Suct_Cf)) then + LB(1:3) = lbound(SrcInputFileData%Suct_Cf) + UB(1:3) = ubound(SrcInputFileData%Suct_Cf) + if (.not. allocated(DstInputFileData%Suct_Cf)) then + allocate(DstInputFileData%Suct_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_Cf.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Suct_Cf = SrcInputFileData%Suct_Cf + end if + if (allocated(SrcInputFileData%Pres_EdgeVelRat)) then + LB(1:3) = lbound(SrcInputFileData%Pres_EdgeVelRat) + UB(1:3) = ubound(SrcInputFileData%Pres_EdgeVelRat) + if (.not. allocated(DstInputFileData%Pres_EdgeVelRat)) then + allocate(DstInputFileData%Pres_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_EdgeVelRat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Pres_EdgeVelRat = SrcInputFileData%Pres_EdgeVelRat + end if + if (allocated(SrcInputFileData%Suct_EdgeVelRat)) then + LB(1:3) = lbound(SrcInputFileData%Suct_EdgeVelRat) + UB(1:3) = ubound(SrcInputFileData%Suct_EdgeVelRat) + if (.not. allocated(DstInputFileData%Suct_EdgeVelRat)) then + allocate(DstInputFileData%Suct_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_EdgeVelRat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Suct_EdgeVelRat = SrcInputFileData%Suct_EdgeVelRat + end if + if (allocated(SrcInputFileData%TI_Grid_In)) then + LB(1:2) = lbound(SrcInputFileData%TI_Grid_In) + UB(1:2) = ubound(SrcInputFileData%TI_Grid_In) + if (.not. allocated(DstInputFileData%TI_Grid_In)) then + allocate(DstInputFileData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TI_Grid_In.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TI_Grid_In = SrcInputFileData%TI_Grid_In + end if + DstInputFileData%dz_turb_in = SrcInputFileData%dz_turb_in + DstInputFileData%dy_turb_in = SrcInputFileData%dy_turb_in +end subroutine + +subroutine AA_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(AA_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_DestroyInputFile' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF -IF (ALLOCATED(SrcMiscData%ChordAngleTE)) THEN - i1_l = LBOUND(SrcMiscData%ChordAngleTE,1) - i1_u = UBOUND(SrcMiscData%ChordAngleTE,1) - i2_l = LBOUND(SrcMiscData%ChordAngleTE,2) - i2_u = UBOUND(SrcMiscData%ChordAngleTE,2) - i3_l = LBOUND(SrcMiscData%ChordAngleTE,3) - i3_u = UBOUND(SrcMiscData%ChordAngleTE,3) - IF (.NOT. ALLOCATED(DstMiscData%ChordAngleTE)) THEN - ALLOCATE(DstMiscData%ChordAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ChordAngleTE = SrcMiscData%ChordAngleTE -ENDIF -IF (ALLOCATED(SrcMiscData%SpanAngleTE)) THEN - i1_l = LBOUND(SrcMiscData%SpanAngleTE,1) - i1_u = UBOUND(SrcMiscData%SpanAngleTE,1) - i2_l = LBOUND(SrcMiscData%SpanAngleTE,2) - i2_u = UBOUND(SrcMiscData%SpanAngleTE,2) - i3_l = LBOUND(SrcMiscData%SpanAngleTE,3) - i3_u = UBOUND(SrcMiscData%SpanAngleTE,3) - IF (.NOT. ALLOCATED(DstMiscData%SpanAngleTE)) THEN - ALLOCATE(DstMiscData%SpanAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SpanAngleTE = SrcMiscData%SpanAngleTE -ENDIF -IF (ALLOCATED(SrcMiscData%ChordAngleLE)) THEN - i1_l = LBOUND(SrcMiscData%ChordAngleLE,1) - i1_u = UBOUND(SrcMiscData%ChordAngleLE,1) - i2_l = LBOUND(SrcMiscData%ChordAngleLE,2) - i2_u = UBOUND(SrcMiscData%ChordAngleLE,2) - i3_l = LBOUND(SrcMiscData%ChordAngleLE,3) - i3_u = UBOUND(SrcMiscData%ChordAngleLE,3) - IF (.NOT. ALLOCATED(DstMiscData%ChordAngleLE)) THEN - ALLOCATE(DstMiscData%ChordAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ChordAngleLE = SrcMiscData%ChordAngleLE -ENDIF -IF (ALLOCATED(SrcMiscData%SpanAngleLE)) THEN - i1_l = LBOUND(SrcMiscData%SpanAngleLE,1) - i1_u = UBOUND(SrcMiscData%SpanAngleLE,1) - i2_l = LBOUND(SrcMiscData%SpanAngleLE,2) - i2_u = UBOUND(SrcMiscData%SpanAngleLE,2) - i3_l = LBOUND(SrcMiscData%SpanAngleLE,3) - i3_u = UBOUND(SrcMiscData%SpanAngleLE,3) - IF (.NOT. ALLOCATED(DstMiscData%SpanAngleLE)) THEN - ALLOCATE(DstMiscData%SpanAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SpanAngleLE = SrcMiscData%SpanAngleLE -ENDIF -IF (ALLOCATED(SrcMiscData%rTEtoObserve)) THEN - i1_l = LBOUND(SrcMiscData%rTEtoObserve,1) - i1_u = UBOUND(SrcMiscData%rTEtoObserve,1) - i2_l = LBOUND(SrcMiscData%rTEtoObserve,2) - i2_u = UBOUND(SrcMiscData%rTEtoObserve,2) - i3_l = LBOUND(SrcMiscData%rTEtoObserve,3) - i3_u = UBOUND(SrcMiscData%rTEtoObserve,3) - IF (.NOT. ALLOCATED(DstMiscData%rTEtoObserve)) THEN - ALLOCATE(DstMiscData%rTEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rTEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rTEtoObserve = SrcMiscData%rTEtoObserve -ENDIF -IF (ALLOCATED(SrcMiscData%rLEtoObserve)) THEN - i1_l = LBOUND(SrcMiscData%rLEtoObserve,1) - i1_u = UBOUND(SrcMiscData%rLEtoObserve,1) - i2_l = LBOUND(SrcMiscData%rLEtoObserve,2) - i2_u = UBOUND(SrcMiscData%rLEtoObserve,2) - i3_l = LBOUND(SrcMiscData%rLEtoObserve,3) - i3_u = UBOUND(SrcMiscData%rLEtoObserve,3) - IF (.NOT. ALLOCATED(DstMiscData%rLEtoObserve)) THEN - ALLOCATE(DstMiscData%rLEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rLEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rLEtoObserve = SrcMiscData%rLEtoObserve -ENDIF -IF (ALLOCATED(SrcMiscData%LE_Location)) THEN - i1_l = LBOUND(SrcMiscData%LE_Location,1) - i1_u = UBOUND(SrcMiscData%LE_Location,1) - i2_l = LBOUND(SrcMiscData%LE_Location,2) - i2_u = UBOUND(SrcMiscData%LE_Location,2) - i3_l = LBOUND(SrcMiscData%LE_Location,3) - i3_u = UBOUND(SrcMiscData%LE_Location,3) - IF (.NOT. ALLOCATED(DstMiscData%LE_Location)) THEN - ALLOCATE(DstMiscData%LE_Location(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LE_Location.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LE_Location = SrcMiscData%LE_Location -ENDIF - DstMiscData%RotSpeedAoA = SrcMiscData%RotSpeedAoA -IF (ALLOCATED(SrcMiscData%SPLLBL)) THEN - i1_l = LBOUND(SrcMiscData%SPLLBL,1) - i1_u = UBOUND(SrcMiscData%SPLLBL,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLLBL)) THEN - ALLOCATE(DstMiscData%SPLLBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLLBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLLBL = SrcMiscData%SPLLBL -ENDIF -IF (ALLOCATED(SrcMiscData%SPLP)) THEN - i1_l = LBOUND(SrcMiscData%SPLP,1) - i1_u = UBOUND(SrcMiscData%SPLP,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLP)) THEN - ALLOCATE(DstMiscData%SPLP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLP = SrcMiscData%SPLP -ENDIF -IF (ALLOCATED(SrcMiscData%SPLS)) THEN - i1_l = LBOUND(SrcMiscData%SPLS,1) - i1_u = UBOUND(SrcMiscData%SPLS,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLS)) THEN - ALLOCATE(DstMiscData%SPLS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLS = SrcMiscData%SPLS -ENDIF -IF (ALLOCATED(SrcMiscData%SPLALPH)) THEN - i1_l = LBOUND(SrcMiscData%SPLALPH,1) - i1_u = UBOUND(SrcMiscData%SPLALPH,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLALPH)) THEN - ALLOCATE(DstMiscData%SPLALPH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLALPH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLALPH = SrcMiscData%SPLALPH -ENDIF -IF (ALLOCATED(SrcMiscData%SPLTBL)) THEN - i1_l = LBOUND(SrcMiscData%SPLTBL,1) - i1_u = UBOUND(SrcMiscData%SPLTBL,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLTBL)) THEN - ALLOCATE(DstMiscData%SPLTBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLTBL = SrcMiscData%SPLTBL -ENDIF -IF (ALLOCATED(SrcMiscData%SPLTIP)) THEN - i1_l = LBOUND(SrcMiscData%SPLTIP,1) - i1_u = UBOUND(SrcMiscData%SPLTIP,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLTIP)) THEN - ALLOCATE(DstMiscData%SPLTIP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTIP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLTIP = SrcMiscData%SPLTIP -ENDIF -IF (ALLOCATED(SrcMiscData%SPLTI)) THEN - i1_l = LBOUND(SrcMiscData%SPLTI,1) - i1_u = UBOUND(SrcMiscData%SPLTI,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLTI)) THEN - ALLOCATE(DstMiscData%SPLTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLTI = SrcMiscData%SPLTI -ENDIF -IF (ALLOCATED(SrcMiscData%SPLTIGui)) THEN - i1_l = LBOUND(SrcMiscData%SPLTIGui,1) - i1_u = UBOUND(SrcMiscData%SPLTIGui,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLTIGui)) THEN - ALLOCATE(DstMiscData%SPLTIGui(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTIGui.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLTIGui = SrcMiscData%SPLTIGui -ENDIF -IF (ALLOCATED(SrcMiscData%SPLBLUNT)) THEN - i1_l = LBOUND(SrcMiscData%SPLBLUNT,1) - i1_u = UBOUND(SrcMiscData%SPLBLUNT,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLBLUNT)) THEN - ALLOCATE(DstMiscData%SPLBLUNT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLBLUNT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLBLUNT = SrcMiscData%SPLBLUNT -ENDIF -IF (ALLOCATED(SrcMiscData%CfVar)) THEN - i1_l = LBOUND(SrcMiscData%CfVar,1) - i1_u = UBOUND(SrcMiscData%CfVar,1) - IF (.NOT. ALLOCATED(DstMiscData%CfVar)) THEN - ALLOCATE(DstMiscData%CfVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CfVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CfVar = SrcMiscData%CfVar -ENDIF -IF (ALLOCATED(SrcMiscData%d99Var)) THEN - i1_l = LBOUND(SrcMiscData%d99Var,1) - i1_u = UBOUND(SrcMiscData%d99Var,1) - IF (.NOT. ALLOCATED(DstMiscData%d99Var)) THEN - ALLOCATE(DstMiscData%d99Var(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%d99Var.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%d99Var = SrcMiscData%d99Var -ENDIF -IF (ALLOCATED(SrcMiscData%dStarVar)) THEN - i1_l = LBOUND(SrcMiscData%dStarVar,1) - i1_u = UBOUND(SrcMiscData%dStarVar,1) - IF (.NOT. ALLOCATED(DstMiscData%dStarVar)) THEN - ALLOCATE(DstMiscData%dStarVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dStarVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dStarVar = SrcMiscData%dStarVar -ENDIF -IF (ALLOCATED(SrcMiscData%EdgeVelVar)) THEN - i1_l = LBOUND(SrcMiscData%EdgeVelVar,1) - i1_u = UBOUND(SrcMiscData%EdgeVelVar,1) - IF (.NOT. ALLOCATED(DstMiscData%EdgeVelVar)) THEN - ALLOCATE(DstMiscData%EdgeVelVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%EdgeVelVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%EdgeVelVar = SrcMiscData%EdgeVelVar -ENDIF - DstMiscData%speccou = SrcMiscData%speccou - DstMiscData%filesopen = SrcMiscData%filesopen - END SUBROUTINE AA_CopyMisc - - SUBROUTINE AA_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(AA_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 = 'AA_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%ChordAngleTE)) THEN - DEALLOCATE(MiscData%ChordAngleTE) -ENDIF -IF (ALLOCATED(MiscData%SpanAngleTE)) THEN - DEALLOCATE(MiscData%SpanAngleTE) -ENDIF -IF (ALLOCATED(MiscData%ChordAngleLE)) THEN - DEALLOCATE(MiscData%ChordAngleLE) -ENDIF -IF (ALLOCATED(MiscData%SpanAngleLE)) THEN - DEALLOCATE(MiscData%SpanAngleLE) -ENDIF -IF (ALLOCATED(MiscData%rTEtoObserve)) THEN - DEALLOCATE(MiscData%rTEtoObserve) -ENDIF -IF (ALLOCATED(MiscData%rLEtoObserve)) THEN - DEALLOCATE(MiscData%rLEtoObserve) -ENDIF -IF (ALLOCATED(MiscData%LE_Location)) THEN - DEALLOCATE(MiscData%LE_Location) -ENDIF -IF (ALLOCATED(MiscData%SPLLBL)) THEN - DEALLOCATE(MiscData%SPLLBL) -ENDIF -IF (ALLOCATED(MiscData%SPLP)) THEN - DEALLOCATE(MiscData%SPLP) -ENDIF -IF (ALLOCATED(MiscData%SPLS)) THEN - DEALLOCATE(MiscData%SPLS) -ENDIF -IF (ALLOCATED(MiscData%SPLALPH)) THEN - DEALLOCATE(MiscData%SPLALPH) -ENDIF -IF (ALLOCATED(MiscData%SPLTBL)) THEN - DEALLOCATE(MiscData%SPLTBL) -ENDIF -IF (ALLOCATED(MiscData%SPLTIP)) THEN - DEALLOCATE(MiscData%SPLTIP) -ENDIF -IF (ALLOCATED(MiscData%SPLTI)) THEN - DEALLOCATE(MiscData%SPLTI) -ENDIF -IF (ALLOCATED(MiscData%SPLTIGui)) THEN - DEALLOCATE(MiscData%SPLTIGui) -ENDIF -IF (ALLOCATED(MiscData%SPLBLUNT)) THEN - DEALLOCATE(MiscData%SPLBLUNT) -ENDIF -IF (ALLOCATED(MiscData%CfVar)) THEN - DEALLOCATE(MiscData%CfVar) -ENDIF -IF (ALLOCATED(MiscData%d99Var)) THEN - DEALLOCATE(MiscData%d99Var) -ENDIF -IF (ALLOCATED(MiscData%dStarVar)) THEN - DEALLOCATE(MiscData%dStarVar) -ENDIF -IF (ALLOCATED(MiscData%EdgeVelVar)) THEN - DEALLOCATE(MiscData%EdgeVelVar) -ENDIF - END SUBROUTINE AA_DestroyMisc - - SUBROUTINE AA_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(AA_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 = 'AA_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 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Int_BufSz = Int_BufSz + 1 ! ChordAngleTE allocated yes/no - IF ( ALLOCATED(InData%ChordAngleTE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! ChordAngleTE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ChordAngleTE) ! ChordAngleTE - END IF - Int_BufSz = Int_BufSz + 1 ! SpanAngleTE allocated yes/no - IF ( ALLOCATED(InData%SpanAngleTE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SpanAngleTE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SpanAngleTE) ! SpanAngleTE - END IF - Int_BufSz = Int_BufSz + 1 ! ChordAngleLE allocated yes/no - IF ( ALLOCATED(InData%ChordAngleLE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! ChordAngleLE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ChordAngleLE) ! ChordAngleLE - END IF - Int_BufSz = Int_BufSz + 1 ! SpanAngleLE allocated yes/no - IF ( ALLOCATED(InData%SpanAngleLE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SpanAngleLE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SpanAngleLE) ! SpanAngleLE - END IF - Int_BufSz = Int_BufSz + 1 ! rTEtoObserve allocated yes/no - IF ( ALLOCATED(InData%rTEtoObserve) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rTEtoObserve upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rTEtoObserve) ! rTEtoObserve - END IF - Int_BufSz = Int_BufSz + 1 ! rLEtoObserve allocated yes/no - IF ( ALLOCATED(InData%rLEtoObserve) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rLEtoObserve upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rLEtoObserve) ! rLEtoObserve - END IF - Int_BufSz = Int_BufSz + 1 ! LE_Location allocated yes/no - IF ( ALLOCATED(InData%LE_Location) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! LE_Location upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LE_Location) ! LE_Location - END IF - Re_BufSz = Re_BufSz + 1 ! RotSpeedAoA - Int_BufSz = Int_BufSz + 1 ! SPLLBL allocated yes/no - IF ( ALLOCATED(InData%SPLLBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLLBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLLBL) ! SPLLBL - END IF - Int_BufSz = Int_BufSz + 1 ! SPLP allocated yes/no - IF ( ALLOCATED(InData%SPLP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLP) ! SPLP - END IF - Int_BufSz = Int_BufSz + 1 ! SPLS allocated yes/no - IF ( ALLOCATED(InData%SPLS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLS) ! SPLS - END IF - Int_BufSz = Int_BufSz + 1 ! SPLALPH allocated yes/no - IF ( ALLOCATED(InData%SPLALPH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLALPH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLALPH) ! SPLALPH - END IF - Int_BufSz = Int_BufSz + 1 ! SPLTBL allocated yes/no - IF ( ALLOCATED(InData%SPLTBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLTBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLTBL) ! SPLTBL - END IF - Int_BufSz = Int_BufSz + 1 ! SPLTIP allocated yes/no - IF ( ALLOCATED(InData%SPLTIP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLTIP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLTIP) ! SPLTIP - END IF - Int_BufSz = Int_BufSz + 1 ! SPLTI allocated yes/no - IF ( ALLOCATED(InData%SPLTI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLTI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLTI) ! SPLTI - END IF - Int_BufSz = Int_BufSz + 1 ! SPLTIGui allocated yes/no - IF ( ALLOCATED(InData%SPLTIGui) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLTIGui upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLTIGui) ! SPLTIGui - END IF - Int_BufSz = Int_BufSz + 1 ! SPLBLUNT allocated yes/no - IF ( ALLOCATED(InData%SPLBLUNT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLBLUNT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLBLUNT) ! SPLBLUNT - END IF - Int_BufSz = Int_BufSz + 1 ! CfVar allocated yes/no - IF ( ALLOCATED(InData%CfVar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CfVar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CfVar) ! CfVar - END IF - Int_BufSz = Int_BufSz + 1 ! d99Var allocated yes/no - IF ( ALLOCATED(InData%d99Var) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! d99Var upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%d99Var) ! d99Var - END IF - Int_BufSz = Int_BufSz + 1 ! dStarVar allocated yes/no - IF ( ALLOCATED(InData%dStarVar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dStarVar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dStarVar) ! dStarVar - END IF - Int_BufSz = Int_BufSz + 1 ! EdgeVelVar allocated yes/no - IF ( ALLOCATED(InData%EdgeVelVar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! EdgeVelVar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%EdgeVelVar) ! EdgeVelVar - END IF - Int_BufSz = Int_BufSz + 1 ! speccou - Int_BufSz = Int_BufSz + 1 ! filesopen - 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%AllOuts) ) 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%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ChordAngleTE) ) 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%ChordAngleTE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleTE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleTE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleTE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleTE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleTE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%ChordAngleTE,3), UBOUND(InData%ChordAngleTE,3) - DO i2 = LBOUND(InData%ChordAngleTE,2), UBOUND(InData%ChordAngleTE,2) - DO i1 = LBOUND(InData%ChordAngleTE,1), UBOUND(InData%ChordAngleTE,1) - ReKiBuf(Re_Xferred) = InData%ChordAngleTE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SpanAngleTE) ) 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%SpanAngleTE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleTE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleTE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleTE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleTE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleTE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SpanAngleTE,3), UBOUND(InData%SpanAngleTE,3) - DO i2 = LBOUND(InData%SpanAngleTE,2), UBOUND(InData%SpanAngleTE,2) - DO i1 = LBOUND(InData%SpanAngleTE,1), UBOUND(InData%SpanAngleTE,1) - ReKiBuf(Re_Xferred) = InData%SpanAngleTE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ChordAngleLE) ) 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%ChordAngleLE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleLE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleLE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleLE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleLE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleLE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%ChordAngleLE,3), UBOUND(InData%ChordAngleLE,3) - DO i2 = LBOUND(InData%ChordAngleLE,2), UBOUND(InData%ChordAngleLE,2) - DO i1 = LBOUND(InData%ChordAngleLE,1), UBOUND(InData%ChordAngleLE,1) - ReKiBuf(Re_Xferred) = InData%ChordAngleLE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SpanAngleLE) ) 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%SpanAngleLE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleLE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleLE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleLE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleLE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleLE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SpanAngleLE,3), UBOUND(InData%SpanAngleLE,3) - DO i2 = LBOUND(InData%SpanAngleLE,2), UBOUND(InData%SpanAngleLE,2) - DO i1 = LBOUND(InData%SpanAngleLE,1), UBOUND(InData%SpanAngleLE,1) - ReKiBuf(Re_Xferred) = InData%SpanAngleLE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rTEtoObserve) ) 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%rTEtoObserve,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTEtoObserve,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rTEtoObserve,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTEtoObserve,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rTEtoObserve,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTEtoObserve,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rTEtoObserve,3), UBOUND(InData%rTEtoObserve,3) - DO i2 = LBOUND(InData%rTEtoObserve,2), UBOUND(InData%rTEtoObserve,2) - DO i1 = LBOUND(InData%rTEtoObserve,1), UBOUND(InData%rTEtoObserve,1) - ReKiBuf(Re_Xferred) = InData%rTEtoObserve(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rLEtoObserve) ) 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%rLEtoObserve,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLEtoObserve,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLEtoObserve,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLEtoObserve,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLEtoObserve,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLEtoObserve,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rLEtoObserve,3), UBOUND(InData%rLEtoObserve,3) - DO i2 = LBOUND(InData%rLEtoObserve,2), UBOUND(InData%rLEtoObserve,2) - DO i1 = LBOUND(InData%rLEtoObserve,1), UBOUND(InData%rLEtoObserve,1) - ReKiBuf(Re_Xferred) = InData%rLEtoObserve(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LE_Location) ) 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%LE_Location,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE_Location,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LE_Location,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE_Location,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LE_Location,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE_Location,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%LE_Location,3), UBOUND(InData%LE_Location,3) - DO i2 = LBOUND(InData%LE_Location,2), UBOUND(InData%LE_Location,2) - DO i1 = LBOUND(InData%LE_Location,1), UBOUND(InData%LE_Location,1) - ReKiBuf(Re_Xferred) = InData%LE_Location(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%RotSpeedAoA - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SPLLBL) ) 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%SPLLBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLLBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLLBL,1), UBOUND(InData%SPLLBL,1) - ReKiBuf(Re_Xferred) = InData%SPLLBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLP) ) 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%SPLP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLP,1), UBOUND(InData%SPLP,1) - ReKiBuf(Re_Xferred) = InData%SPLP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLS) ) 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%SPLS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLS,1), UBOUND(InData%SPLS,1) - ReKiBuf(Re_Xferred) = InData%SPLS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLALPH) ) 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%SPLALPH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLALPH,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLALPH,1), UBOUND(InData%SPLALPH,1) - ReKiBuf(Re_Xferred) = InData%SPLALPH(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLTBL) ) 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%SPLTBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLTBL,1), UBOUND(InData%SPLTBL,1) - ReKiBuf(Re_Xferred) = InData%SPLTBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLTIP) ) 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%SPLTIP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTIP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLTIP,1), UBOUND(InData%SPLTIP,1) - ReKiBuf(Re_Xferred) = InData%SPLTIP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLTI) ) 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%SPLTI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLTI,1), UBOUND(InData%SPLTI,1) - ReKiBuf(Re_Xferred) = InData%SPLTI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLTIGui) ) 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%SPLTIGui,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTIGui,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLTIGui,1), UBOUND(InData%SPLTIGui,1) - ReKiBuf(Re_Xferred) = InData%SPLTIGui(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLBLUNT) ) 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%SPLBLUNT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLBLUNT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLBLUNT,1), UBOUND(InData%SPLBLUNT,1) - ReKiBuf(Re_Xferred) = InData%SPLBLUNT(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CfVar) ) 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%CfVar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfVar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CfVar,1), UBOUND(InData%CfVar,1) - ReKiBuf(Re_Xferred) = InData%CfVar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%d99Var) ) 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%d99Var,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99Var,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%d99Var,1), UBOUND(InData%d99Var,1) - ReKiBuf(Re_Xferred) = InData%d99Var(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dStarVar) ) 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%dStarVar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarVar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dStarVar,1), UBOUND(InData%dStarVar,1) - ReKiBuf(Re_Xferred) = InData%dStarVar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%EdgeVelVar) ) 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%EdgeVelVar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelVar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%EdgeVelVar,1), UBOUND(InData%EdgeVelVar,1) - ReKiBuf(Re_Xferred) = InData%EdgeVelVar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%speccou - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%filesopen - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AA_PackMisc - - SUBROUTINE AA_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(AA_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) :: 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 = 'AA_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts 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%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChordAngleTE 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%ChordAngleTE)) DEALLOCATE(OutData%ChordAngleTE) - ALLOCATE(OutData%ChordAngleTE(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%ChordAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%ChordAngleTE,3), UBOUND(OutData%ChordAngleTE,3) - DO i2 = LBOUND(OutData%ChordAngleTE,2), UBOUND(OutData%ChordAngleTE,2) - DO i1 = LBOUND(OutData%ChordAngleTE,1), UBOUND(OutData%ChordAngleTE,1) - OutData%ChordAngleTE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SpanAngleTE 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%SpanAngleTE)) DEALLOCATE(OutData%SpanAngleTE) - ALLOCATE(OutData%SpanAngleTE(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%SpanAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SpanAngleTE,3), UBOUND(OutData%SpanAngleTE,3) - DO i2 = LBOUND(OutData%SpanAngleTE,2), UBOUND(OutData%SpanAngleTE,2) - DO i1 = LBOUND(OutData%SpanAngleTE,1), UBOUND(OutData%SpanAngleTE,1) - OutData%SpanAngleTE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChordAngleLE 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%ChordAngleLE)) DEALLOCATE(OutData%ChordAngleLE) - ALLOCATE(OutData%ChordAngleLE(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%ChordAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%ChordAngleLE,3), UBOUND(OutData%ChordAngleLE,3) - DO i2 = LBOUND(OutData%ChordAngleLE,2), UBOUND(OutData%ChordAngleLE,2) - DO i1 = LBOUND(OutData%ChordAngleLE,1), UBOUND(OutData%ChordAngleLE,1) - OutData%ChordAngleLE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SpanAngleLE 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%SpanAngleLE)) DEALLOCATE(OutData%SpanAngleLE) - ALLOCATE(OutData%SpanAngleLE(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%SpanAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SpanAngleLE,3), UBOUND(OutData%SpanAngleLE,3) - DO i2 = LBOUND(OutData%SpanAngleLE,2), UBOUND(OutData%SpanAngleLE,2) - DO i1 = LBOUND(OutData%SpanAngleLE,1), UBOUND(OutData%SpanAngleLE,1) - OutData%SpanAngleLE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rTEtoObserve 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%rTEtoObserve)) DEALLOCATE(OutData%rTEtoObserve) - ALLOCATE(OutData%rTEtoObserve(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%rTEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rTEtoObserve,3), UBOUND(OutData%rTEtoObserve,3) - DO i2 = LBOUND(OutData%rTEtoObserve,2), UBOUND(OutData%rTEtoObserve,2) - DO i1 = LBOUND(OutData%rTEtoObserve,1), UBOUND(OutData%rTEtoObserve,1) - OutData%rTEtoObserve(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLEtoObserve 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%rLEtoObserve)) DEALLOCATE(OutData%rLEtoObserve) - ALLOCATE(OutData%rLEtoObserve(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%rLEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rLEtoObserve,3), UBOUND(OutData%rLEtoObserve,3) - DO i2 = LBOUND(OutData%rLEtoObserve,2), UBOUND(OutData%rLEtoObserve,2) - DO i1 = LBOUND(OutData%rLEtoObserve,1), UBOUND(OutData%rLEtoObserve,1) - OutData%rLEtoObserve(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LE_Location 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%LE_Location)) DEALLOCATE(OutData%LE_Location) - ALLOCATE(OutData%LE_Location(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%LE_Location.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%LE_Location,3), UBOUND(OutData%LE_Location,3) - DO i2 = LBOUND(OutData%LE_Location,2), UBOUND(OutData%LE_Location,2) - DO i1 = LBOUND(OutData%LE_Location,1), UBOUND(OutData%LE_Location,1) - OutData%LE_Location(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%RotSpeedAoA = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLLBL 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%SPLLBL)) DEALLOCATE(OutData%SPLLBL) - ALLOCATE(OutData%SPLLBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLLBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLLBL,1), UBOUND(OutData%SPLLBL,1) - OutData%SPLLBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLP 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%SPLP)) DEALLOCATE(OutData%SPLP) - ALLOCATE(OutData%SPLP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLP,1), UBOUND(OutData%SPLP,1) - OutData%SPLP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLS 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%SPLS)) DEALLOCATE(OutData%SPLS) - ALLOCATE(OutData%SPLS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLS,1), UBOUND(OutData%SPLS,1) - OutData%SPLS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLALPH 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%SPLALPH)) DEALLOCATE(OutData%SPLALPH) - ALLOCATE(OutData%SPLALPH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLALPH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLALPH,1), UBOUND(OutData%SPLALPH,1) - OutData%SPLALPH(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTBL 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%SPLTBL)) DEALLOCATE(OutData%SPLTBL) - ALLOCATE(OutData%SPLTBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLTBL,1), UBOUND(OutData%SPLTBL,1) - OutData%SPLTBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTIP 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%SPLTIP)) DEALLOCATE(OutData%SPLTIP) - ALLOCATE(OutData%SPLTIP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTIP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLTIP,1), UBOUND(OutData%SPLTIP,1) - OutData%SPLTIP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTI 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%SPLTI)) DEALLOCATE(OutData%SPLTI) - ALLOCATE(OutData%SPLTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLTI,1), UBOUND(OutData%SPLTI,1) - OutData%SPLTI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTIGui 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%SPLTIGui)) DEALLOCATE(OutData%SPLTIGui) - ALLOCATE(OutData%SPLTIGui(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTIGui.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLTIGui,1), UBOUND(OutData%SPLTIGui,1) - OutData%SPLTIGui(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLBLUNT 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%SPLBLUNT)) DEALLOCATE(OutData%SPLBLUNT) - ALLOCATE(OutData%SPLBLUNT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLBLUNT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLBLUNT,1), UBOUND(OutData%SPLBLUNT,1) - OutData%SPLBLUNT(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CfVar 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%CfVar)) DEALLOCATE(OutData%CfVar) - ALLOCATE(OutData%CfVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CfVar,1), UBOUND(OutData%CfVar,1) - OutData%CfVar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! d99Var 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%d99Var)) DEALLOCATE(OutData%d99Var) - ALLOCATE(OutData%d99Var(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99Var.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%d99Var,1), UBOUND(OutData%d99Var,1) - OutData%d99Var(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dStarVar 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%dStarVar)) DEALLOCATE(OutData%dStarVar) - ALLOCATE(OutData%dStarVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dStarVar,1), UBOUND(OutData%dStarVar,1) - OutData%dStarVar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgeVelVar 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%EdgeVelVar)) DEALLOCATE(OutData%EdgeVelVar) - ALLOCATE(OutData%EdgeVelVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%EdgeVelVar,1), UBOUND(OutData%EdgeVelVar,1) - OutData%EdgeVelVar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%speccou = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%filesopen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AA_UnPackMisc - - SUBROUTINE AA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AA_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyParam' -! + ErrMsg = '' + if (allocated(InputFileData%ObsX)) then + deallocate(InputFileData%ObsX) + end if + if (allocated(InputFileData%ObsY)) then + deallocate(InputFileData%ObsY) + end if + if (allocated(InputFileData%ObsZ)) then + deallocate(InputFileData%ObsZ) + end if + if (allocated(InputFileData%BladeProps)) then + LB(1:1) = lbound(InputFileData%BladeProps) + UB(1:1) = ubound(InputFileData%BladeProps) + do i1 = LB(1), UB(1) + call AA_DestroyBladePropsType(InputFileData%BladeProps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputFileData%BladeProps) + end if + if (allocated(InputFileData%AAoutfile)) then + deallocate(InputFileData%AAoutfile) + end if + if (allocated(InputFileData%ReListBL)) then + deallocate(InputFileData%ReListBL) + end if + if (allocated(InputFileData%AoAListBL)) then + deallocate(InputFileData%AoAListBL) + end if + if (allocated(InputFileData%Pres_DispThick)) then + deallocate(InputFileData%Pres_DispThick) + end if + if (allocated(InputFileData%Suct_DispThick)) then + deallocate(InputFileData%Suct_DispThick) + end if + if (allocated(InputFileData%Pres_BLThick)) then + deallocate(InputFileData%Pres_BLThick) + end if + if (allocated(InputFileData%Suct_BLThick)) then + deallocate(InputFileData%Suct_BLThick) + end if + if (allocated(InputFileData%Pres_Cf)) then + deallocate(InputFileData%Pres_Cf) + end if + if (allocated(InputFileData%Suct_Cf)) then + deallocate(InputFileData%Suct_Cf) + end if + if (allocated(InputFileData%Pres_EdgeVelRat)) then + deallocate(InputFileData%Pres_EdgeVelRat) + end if + if (allocated(InputFileData%Suct_EdgeVelRat)) then + deallocate(InputFileData%Suct_EdgeVelRat) + end if + if (allocated(InputFileData%TI_Grid_In)) then + deallocate(InputFileData%TI_Grid_In) + end if +end subroutine + +subroutine AA_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackInputFile' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT_AA) + call RegPack(Buf, InData%IBLUNT) + call RegPack(Buf, InData%ILAM) + call RegPack(Buf, InData%ITIP) + call RegPack(Buf, InData%ITRIP) + call RegPack(Buf, InData%ITURB) + call RegPack(Buf, InData%IInflow) + call RegPack(Buf, InData%X_BLMethod) + call RegPack(Buf, InData%TICalcMeth) + call RegPack(Buf, InData%NReListBL) + call RegPack(Buf, InData%aweightflag) + call RegPack(Buf, InData%ROUND) + call RegPack(Buf, InData%ALPRAT) + call RegPack(Buf, InData%AA_Bl_Prcntge) + call RegPack(Buf, InData%NrObsLoc) + call RegPack(Buf, allocated(InData%ObsX)) + if (allocated(InData%ObsX)) then + call RegPackBounds(Buf, 1, lbound(InData%ObsX), ubound(InData%ObsX)) + call RegPack(Buf, InData%ObsX) + end if + call RegPack(Buf, allocated(InData%ObsY)) + if (allocated(InData%ObsY)) then + call RegPackBounds(Buf, 1, lbound(InData%ObsY), ubound(InData%ObsY)) + call RegPack(Buf, InData%ObsY) + end if + call RegPack(Buf, allocated(InData%ObsZ)) + if (allocated(InData%ObsZ)) then + call RegPackBounds(Buf, 1, lbound(InData%ObsZ), ubound(InData%ObsZ)) + call RegPack(Buf, InData%ObsZ) + end if + call RegPack(Buf, allocated(InData%BladeProps)) + if (allocated(InData%BladeProps)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) + LB(1:1) = lbound(InData%BladeProps) + UB(1:1) = ubound(InData%BladeProps) + do i1 = LB(1), UB(1) + call AA_PackBladePropsType(Buf, InData%BladeProps(i1)) + end do + end if + call RegPack(Buf, InData%NrOutFile) + call RegPack(Buf, allocated(InData%AAoutfile)) + if (allocated(InData%AAoutfile)) then + call RegPackBounds(Buf, 1, lbound(InData%AAoutfile), ubound(InData%AAoutfile)) + call RegPack(Buf, InData%AAoutfile) + end if + call RegPack(Buf, InData%TICalcTabFile) + call RegPack(Buf, InData%FTitle) + call RegPack(Buf, InData%AAStart) + call RegPack(Buf, InData%Lturb) + call RegPack(Buf, InData%AvgV) + call RegPack(Buf, allocated(InData%ReListBL)) + if (allocated(InData%ReListBL)) then + call RegPackBounds(Buf, 1, lbound(InData%ReListBL), ubound(InData%ReListBL)) + call RegPack(Buf, InData%ReListBL) + end if + call RegPack(Buf, allocated(InData%AoAListBL)) + if (allocated(InData%AoAListBL)) then + call RegPackBounds(Buf, 1, lbound(InData%AoAListBL), ubound(InData%AoAListBL)) + call RegPack(Buf, InData%AoAListBL) + end if + call RegPack(Buf, allocated(InData%Pres_DispThick)) + if (allocated(InData%Pres_DispThick)) then + call RegPackBounds(Buf, 3, lbound(InData%Pres_DispThick), ubound(InData%Pres_DispThick)) + call RegPack(Buf, InData%Pres_DispThick) + end if + call RegPack(Buf, allocated(InData%Suct_DispThick)) + if (allocated(InData%Suct_DispThick)) then + call RegPackBounds(Buf, 3, lbound(InData%Suct_DispThick), ubound(InData%Suct_DispThick)) + call RegPack(Buf, InData%Suct_DispThick) + end if + call RegPack(Buf, allocated(InData%Pres_BLThick)) + if (allocated(InData%Pres_BLThick)) then + call RegPackBounds(Buf, 3, lbound(InData%Pres_BLThick), ubound(InData%Pres_BLThick)) + call RegPack(Buf, InData%Pres_BLThick) + end if + call RegPack(Buf, allocated(InData%Suct_BLThick)) + if (allocated(InData%Suct_BLThick)) then + call RegPackBounds(Buf, 3, lbound(InData%Suct_BLThick), ubound(InData%Suct_BLThick)) + call RegPack(Buf, InData%Suct_BLThick) + end if + call RegPack(Buf, allocated(InData%Pres_Cf)) + if (allocated(InData%Pres_Cf)) then + call RegPackBounds(Buf, 3, lbound(InData%Pres_Cf), ubound(InData%Pres_Cf)) + call RegPack(Buf, InData%Pres_Cf) + end if + call RegPack(Buf, allocated(InData%Suct_Cf)) + if (allocated(InData%Suct_Cf)) then + call RegPackBounds(Buf, 3, lbound(InData%Suct_Cf), ubound(InData%Suct_Cf)) + call RegPack(Buf, InData%Suct_Cf) + end if + call RegPack(Buf, allocated(InData%Pres_EdgeVelRat)) + if (allocated(InData%Pres_EdgeVelRat)) then + call RegPackBounds(Buf, 3, lbound(InData%Pres_EdgeVelRat), ubound(InData%Pres_EdgeVelRat)) + call RegPack(Buf, InData%Pres_EdgeVelRat) + end if + call RegPack(Buf, allocated(InData%Suct_EdgeVelRat)) + if (allocated(InData%Suct_EdgeVelRat)) then + call RegPackBounds(Buf, 3, lbound(InData%Suct_EdgeVelRat), ubound(InData%Suct_EdgeVelRat)) + call RegPack(Buf, InData%Suct_EdgeVelRat) + end if + call RegPack(Buf, allocated(InData%TI_Grid_In)) + if (allocated(InData%TI_Grid_In)) then + call RegPackBounds(Buf, 2, lbound(InData%TI_Grid_In), ubound(InData%TI_Grid_In)) + call RegPack(Buf, InData%TI_Grid_In) + end if + call RegPack(Buf, InData%dz_turb_in) + call RegPack(Buf, InData%dy_turb_in) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackInputFile' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT_AA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IBLUNT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ILAM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ITIP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ITRIP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ITURB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IInflow) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%X_BLMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TICalcMeth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NReListBL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%aweightflag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ROUND) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ALPRAT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AA_Bl_Prcntge) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NrObsLoc) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ObsX)) deallocate(OutData%ObsX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ObsX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ObsX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ObsY)) deallocate(OutData%ObsY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ObsY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ObsY) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ObsZ)) deallocate(OutData%ObsZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ObsZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ObsZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeProps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AA_UnpackBladePropsType(Buf, OutData%BladeProps(i1)) ! BladeProps + end do + end if + call RegUnpack(Buf, OutData%NrOutFile) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AAoutfile)) deallocate(OutData%AAoutfile) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AAoutfile(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAoutfile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AAoutfile) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%TICalcTabFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FTitle) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AAStart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Lturb) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AvgV) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ReListBL)) deallocate(OutData%ReListBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ReListBL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReListBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ReListBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AoAListBL)) deallocate(OutData%AoAListBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AoAListBL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AoAListBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AoAListBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Pres_DispThick)) deallocate(OutData%Pres_DispThick) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Pres_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_DispThick.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Pres_DispThick) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Suct_DispThick)) deallocate(OutData%Suct_DispThick) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Suct_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_DispThick.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Suct_DispThick) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Pres_BLThick)) deallocate(OutData%Pres_BLThick) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Pres_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_BLThick.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Pres_BLThick) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Suct_BLThick)) deallocate(OutData%Suct_BLThick) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Suct_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_BLThick.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Suct_BLThick) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Pres_Cf)) deallocate(OutData%Pres_Cf) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Pres_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_Cf.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Pres_Cf) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Suct_Cf)) deallocate(OutData%Suct_Cf) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Suct_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_Cf.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Suct_Cf) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Pres_EdgeVelRat)) deallocate(OutData%Pres_EdgeVelRat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Pres_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_EdgeVelRat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Pres_EdgeVelRat) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Suct_EdgeVelRat)) deallocate(OutData%Suct_EdgeVelRat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Suct_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_EdgeVelRat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Suct_EdgeVelRat) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TI_Grid_In)) deallocate(OutData%TI_Grid_In) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_Grid_In.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TI_Grid_In) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%dz_turb_in) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dy_turb_in) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(AA_ContinuousStateType), intent(in) :: SrcContStateData + type(AA_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%IBLUNT = SrcParamData%IBLUNT - DstParamData%ILAM = SrcParamData%ILAM - DstParamData%ITIP = SrcParamData%ITIP - DstParamData%ITRIP = SrcParamData%ITRIP - DstParamData%ITURB = SrcParamData%ITURB - DstParamData%IInflow = SrcParamData%IInflow - DstParamData%X_BLMethod = SrcParamData%X_BLMethod - DstParamData%TICalcMeth = SrcParamData%TICalcMeth - DstParamData%ROUND = SrcParamData%ROUND - DstParamData%ALPRAT = SrcParamData%ALPRAT - DstParamData%NumBlades = SrcParamData%NumBlades - DstParamData%NumBlNds = SrcParamData%NumBlNds - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%KinVisc = SrcParamData%KinVisc - DstParamData%SpdSound = SrcParamData%SpdSound - DstParamData%HubHeight = SrcParamData%HubHeight - DstParamData%toptip = SrcParamData%toptip - DstParamData%bottip = SrcParamData%bottip -IF (ALLOCATED(SrcParamData%rotorregionlimitsVert)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsVert,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsVert,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsVert)) THEN - ALLOCATE(DstParamData%rotorregionlimitsVert(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsVert.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert -ENDIF -IF (ALLOCATED(SrcParamData%rotorregionlimitsHorz)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsHorz,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsHorz,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsHorz)) THEN - ALLOCATE(DstParamData%rotorregionlimitsHorz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsHorz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz -ENDIF -IF (ALLOCATED(SrcParamData%rotorregionlimitsalph)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsalph,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsalph,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsalph)) THEN - ALLOCATE(DstParamData%rotorregionlimitsalph(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsalph.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph -ENDIF -IF (ALLOCATED(SrcParamData%rotorregionlimitsrad)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsrad,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsrad,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsrad)) THEN - ALLOCATE(DstParamData%rotorregionlimitsrad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsrad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsrad = SrcParamData%rotorregionlimitsrad -ENDIF - DstParamData%NrObsLoc = SrcParamData%NrObsLoc - DstParamData%aweightflag = SrcParamData%aweightflag - DstParamData%TxtFileOutput = SrcParamData%TxtFileOutput - DstParamData%AAStart = SrcParamData%AAStart -IF (ALLOCATED(SrcParamData%ObsX)) THEN - i1_l = LBOUND(SrcParamData%ObsX,1) - i1_u = UBOUND(SrcParamData%ObsX,1) - IF (.NOT. ALLOCATED(DstParamData%ObsX)) THEN - ALLOCATE(DstParamData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ObsX = SrcParamData%ObsX -ENDIF -IF (ALLOCATED(SrcParamData%ObsY)) THEN - i1_l = LBOUND(SrcParamData%ObsY,1) - i1_u = UBOUND(SrcParamData%ObsY,1) - IF (.NOT. ALLOCATED(DstParamData%ObsY)) THEN - ALLOCATE(DstParamData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ObsY = SrcParamData%ObsY -ENDIF -IF (ALLOCATED(SrcParamData%ObsZ)) THEN - i1_l = LBOUND(SrcParamData%ObsZ,1) - i1_u = UBOUND(SrcParamData%ObsZ,1) - IF (.NOT. ALLOCATED(DstParamData%ObsZ)) THEN - ALLOCATE(DstParamData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ObsZ = SrcParamData%ObsZ -ENDIF -IF (ALLOCATED(SrcParamData%FreqList)) THEN - i1_l = LBOUND(SrcParamData%FreqList,1) - i1_u = UBOUND(SrcParamData%FreqList,1) - IF (.NOT. ALLOCATED(DstParamData%FreqList)) THEN - ALLOCATE(DstParamData%FreqList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FreqList = SrcParamData%FreqList -ENDIF -IF (ALLOCATED(SrcParamData%Aweight)) THEN - i1_l = LBOUND(SrcParamData%Aweight,1) - i1_u = UBOUND(SrcParamData%Aweight,1) - IF (.NOT. ALLOCATED(DstParamData%Aweight)) THEN - ALLOCATE(DstParamData%Aweight(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Aweight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Aweight = SrcParamData%Aweight -ENDIF - DstParamData%Fsample = SrcParamData%Fsample - DstParamData%total_sample = SrcParamData%total_sample - DstParamData%total_sampleTI = SrcParamData%total_sampleTI - DstParamData%AA_Bl_Prcntge = SrcParamData%AA_Bl_Prcntge - DstParamData%startnode = SrcParamData%startnode - DstParamData%Lturb = SrcParamData%Lturb - DstParamData%AvgV = SrcParamData%AvgV - DstParamData%dz_turb_in = SrcParamData%dz_turb_in - DstParamData%dy_turb_in = SrcParamData%dy_turb_in -IF (ALLOCATED(SrcParamData%TI_Grid_In)) THEN - i1_l = LBOUND(SrcParamData%TI_Grid_In,1) - i1_u = UBOUND(SrcParamData%TI_Grid_In,1) - i2_l = LBOUND(SrcParamData%TI_Grid_In,2) - i2_u = UBOUND(SrcParamData%TI_Grid_In,2) - IF (.NOT. ALLOCATED(DstParamData%TI_Grid_In)) THEN - ALLOCATE(DstParamData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TI_Grid_In = SrcParamData%TI_Grid_In -ENDIF - DstParamData%FTitle = SrcParamData%FTitle - DstParamData%outFmt = SrcParamData%outFmt - DstParamData%NrOutFile = SrcParamData%NrOutFile - DstParamData%delim = SrcParamData%delim - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%NumOutsForPE = SrcParamData%NumOutsForPE - DstParamData%NumOutsForSep = SrcParamData%NumOutsForSep - DstParamData%NumOutsForNodes = SrcParamData%NumOutsForNodes - DstParamData%unOutFile = SrcParamData%unOutFile - DstParamData%unOutFile2 = SrcParamData%unOutFile2 - DstParamData%unOutFile3 = SrcParamData%unOutFile3 - DstParamData%unOutFile4 = SrcParamData%unOutFile4 - DstParamData%RootName = SrcParamData%RootName -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 -IF (ALLOCATED(SrcParamData%StallStart)) THEN - i1_l = LBOUND(SrcParamData%StallStart,1) - i1_u = UBOUND(SrcParamData%StallStart,1) - i2_l = LBOUND(SrcParamData%StallStart,2) - i2_u = UBOUND(SrcParamData%StallStart,2) - IF (.NOT. ALLOCATED(DstParamData%StallStart)) THEN - ALLOCATE(DstParamData%StallStart(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StallStart.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StallStart = SrcParamData%StallStart -ENDIF -IF (ALLOCATED(SrcParamData%TEThick)) THEN - i1_l = LBOUND(SrcParamData%TEThick,1) - i1_u = UBOUND(SrcParamData%TEThick,1) - i2_l = LBOUND(SrcParamData%TEThick,2) - i2_u = UBOUND(SrcParamData%TEThick,2) - IF (.NOT. ALLOCATED(DstParamData%TEThick)) THEN - ALLOCATE(DstParamData%TEThick(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TEThick = SrcParamData%TEThick -ENDIF -IF (ALLOCATED(SrcParamData%TEAngle)) THEN - i1_l = LBOUND(SrcParamData%TEAngle,1) - i1_u = UBOUND(SrcParamData%TEAngle,1) - i2_l = LBOUND(SrcParamData%TEAngle,2) - i2_u = UBOUND(SrcParamData%TEAngle,2) - IF (.NOT. ALLOCATED(DstParamData%TEAngle)) THEN - ALLOCATE(DstParamData%TEAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TEAngle = SrcParamData%TEAngle -ENDIF -IF (ALLOCATED(SrcParamData%AerCent)) THEN - i1_l = LBOUND(SrcParamData%AerCent,1) - i1_u = UBOUND(SrcParamData%AerCent,1) - i2_l = LBOUND(SrcParamData%AerCent,2) - i2_u = UBOUND(SrcParamData%AerCent,2) - i3_l = LBOUND(SrcParamData%AerCent,3) - i3_u = UBOUND(SrcParamData%AerCent,3) - IF (.NOT. ALLOCATED(DstParamData%AerCent)) THEN - ALLOCATE(DstParamData%AerCent(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%AerCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AerCent = SrcParamData%AerCent -ENDIF -IF (ALLOCATED(SrcParamData%BlAFID)) THEN - i1_l = LBOUND(SrcParamData%BlAFID,1) - i1_u = UBOUND(SrcParamData%BlAFID,1) - i2_l = LBOUND(SrcParamData%BlAFID,2) - i2_u = UBOUND(SrcParamData%BlAFID,2) - IF (.NOT. ALLOCATED(DstParamData%BlAFID)) THEN - ALLOCATE(DstParamData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlAFID = SrcParamData%BlAFID -ENDIF -IF (ALLOCATED(SrcParamData%AFInfo)) THEN - i1_l = LBOUND(SrcParamData%AFInfo,1) - i1_u = UBOUND(SrcParamData%AFInfo,1) - IF (.NOT. ALLOCATED(DstParamData%AFInfo)) THEN - ALLOCATE(DstParamData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%AFInfo,1), UBOUND(SrcParamData%AFInfo,1) - CALL AFI_CopyParam( SrcParamData%AFInfo(i1), DstParamData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%AFLECo)) THEN - i1_l = LBOUND(SrcParamData%AFLECo,1) - i1_u = UBOUND(SrcParamData%AFLECo,1) - i2_l = LBOUND(SrcParamData%AFLECo,2) - i2_u = UBOUND(SrcParamData%AFLECo,2) - i3_l = LBOUND(SrcParamData%AFLECo,3) - i3_u = UBOUND(SrcParamData%AFLECo,3) - IF (.NOT. ALLOCATED(DstParamData%AFLECo)) THEN - ALLOCATE(DstParamData%AFLECo(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%AFLECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFLECo = SrcParamData%AFLECo -ENDIF -IF (ALLOCATED(SrcParamData%AFTECo)) THEN - i1_l = LBOUND(SrcParamData%AFTECo,1) - i1_u = UBOUND(SrcParamData%AFTECo,1) - i2_l = LBOUND(SrcParamData%AFTECo,2) - i2_u = UBOUND(SrcParamData%AFTECo,2) - i3_l = LBOUND(SrcParamData%AFTECo,3) - i3_u = UBOUND(SrcParamData%AFTECo,3) - IF (.NOT. ALLOCATED(DstParamData%AFTECo)) THEN - ALLOCATE(DstParamData%AFTECo(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%AFTECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFTECo = SrcParamData%AFTECo -ENDIF -IF (ALLOCATED(SrcParamData%BlSpn)) THEN - i1_l = LBOUND(SrcParamData%BlSpn,1) - i1_u = UBOUND(SrcParamData%BlSpn,1) - i2_l = LBOUND(SrcParamData%BlSpn,2) - i2_u = UBOUND(SrcParamData%BlSpn,2) - IF (.NOT. ALLOCATED(DstParamData%BlSpn)) THEN - ALLOCATE(DstParamData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlSpn = SrcParamData%BlSpn -ENDIF -IF (ALLOCATED(SrcParamData%BlChord)) THEN - i1_l = LBOUND(SrcParamData%BlChord,1) - i1_u = UBOUND(SrcParamData%BlChord,1) - i2_l = LBOUND(SrcParamData%BlChord,2) - i2_u = UBOUND(SrcParamData%BlChord,2) - IF (.NOT. ALLOCATED(DstParamData%BlChord)) THEN - ALLOCATE(DstParamData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlChord = SrcParamData%BlChord -ENDIF -IF (ALLOCATED(SrcParamData%ReListBL)) THEN - i1_l = LBOUND(SrcParamData%ReListBL,1) - i1_u = UBOUND(SrcParamData%ReListBL,1) - IF (.NOT. ALLOCATED(DstParamData%ReListBL)) THEN - ALLOCATE(DstParamData%ReListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ReListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ReListBL = SrcParamData%ReListBL -ENDIF -IF (ALLOCATED(SrcParamData%AOAListBL)) THEN - i1_l = LBOUND(SrcParamData%AOAListBL,1) - i1_u = UBOUND(SrcParamData%AOAListBL,1) - IF (.NOT. ALLOCATED(DstParamData%AOAListBL)) THEN - ALLOCATE(DstParamData%AOAListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AOAListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AOAListBL = SrcParamData%AOAListBL -ENDIF -IF (ALLOCATED(SrcParamData%dStarAll1)) THEN - i1_l = LBOUND(SrcParamData%dStarAll1,1) - i1_u = UBOUND(SrcParamData%dStarAll1,1) - i2_l = LBOUND(SrcParamData%dStarAll1,2) - i2_u = UBOUND(SrcParamData%dStarAll1,2) - i3_l = LBOUND(SrcParamData%dStarAll1,3) - i3_u = UBOUND(SrcParamData%dStarAll1,3) - IF (.NOT. ALLOCATED(DstParamData%dStarAll1)) THEN - ALLOCATE(DstParamData%dStarAll1(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%dStarAll1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dStarAll1 = SrcParamData%dStarAll1 -ENDIF -IF (ALLOCATED(SrcParamData%dStarAll2)) THEN - i1_l = LBOUND(SrcParamData%dStarAll2,1) - i1_u = UBOUND(SrcParamData%dStarAll2,1) - i2_l = LBOUND(SrcParamData%dStarAll2,2) - i2_u = UBOUND(SrcParamData%dStarAll2,2) - i3_l = LBOUND(SrcParamData%dStarAll2,3) - i3_u = UBOUND(SrcParamData%dStarAll2,3) - IF (.NOT. ALLOCATED(DstParamData%dStarAll2)) THEN - ALLOCATE(DstParamData%dStarAll2(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%dStarAll2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dStarAll2 = SrcParamData%dStarAll2 -ENDIF -IF (ALLOCATED(SrcParamData%d99All1)) THEN - i1_l = LBOUND(SrcParamData%d99All1,1) - i1_u = UBOUND(SrcParamData%d99All1,1) - i2_l = LBOUND(SrcParamData%d99All1,2) - i2_u = UBOUND(SrcParamData%d99All1,2) - i3_l = LBOUND(SrcParamData%d99All1,3) - i3_u = UBOUND(SrcParamData%d99All1,3) - IF (.NOT. ALLOCATED(DstParamData%d99All1)) THEN - ALLOCATE(DstParamData%d99All1(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%d99All1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%d99All1 = SrcParamData%d99All1 -ENDIF -IF (ALLOCATED(SrcParamData%d99All2)) THEN - i1_l = LBOUND(SrcParamData%d99All2,1) - i1_u = UBOUND(SrcParamData%d99All2,1) - i2_l = LBOUND(SrcParamData%d99All2,2) - i2_u = UBOUND(SrcParamData%d99All2,2) - i3_l = LBOUND(SrcParamData%d99All2,3) - i3_u = UBOUND(SrcParamData%d99All2,3) - IF (.NOT. ALLOCATED(DstParamData%d99All2)) THEN - ALLOCATE(DstParamData%d99All2(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%d99All2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%d99All2 = SrcParamData%d99All2 -ENDIF -IF (ALLOCATED(SrcParamData%CfAll1)) THEN - i1_l = LBOUND(SrcParamData%CfAll1,1) - i1_u = UBOUND(SrcParamData%CfAll1,1) - i2_l = LBOUND(SrcParamData%CfAll1,2) - i2_u = UBOUND(SrcParamData%CfAll1,2) - i3_l = LBOUND(SrcParamData%CfAll1,3) - i3_u = UBOUND(SrcParamData%CfAll1,3) - IF (.NOT. ALLOCATED(DstParamData%CfAll1)) THEN - ALLOCATE(DstParamData%CfAll1(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%CfAll1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CfAll1 = SrcParamData%CfAll1 -ENDIF -IF (ALLOCATED(SrcParamData%CfAll2)) THEN - i1_l = LBOUND(SrcParamData%CfAll2,1) - i1_u = UBOUND(SrcParamData%CfAll2,1) - i2_l = LBOUND(SrcParamData%CfAll2,2) - i2_u = UBOUND(SrcParamData%CfAll2,2) - i3_l = LBOUND(SrcParamData%CfAll2,3) - i3_u = UBOUND(SrcParamData%CfAll2,3) - IF (.NOT. ALLOCATED(DstParamData%CfAll2)) THEN - ALLOCATE(DstParamData%CfAll2(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%CfAll2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CfAll2 = SrcParamData%CfAll2 -ENDIF -IF (ALLOCATED(SrcParamData%EdgeVelRat1)) THEN - i1_l = LBOUND(SrcParamData%EdgeVelRat1,1) - i1_u = UBOUND(SrcParamData%EdgeVelRat1,1) - i2_l = LBOUND(SrcParamData%EdgeVelRat1,2) - i2_u = UBOUND(SrcParamData%EdgeVelRat1,2) - i3_l = LBOUND(SrcParamData%EdgeVelRat1,3) - i3_u = UBOUND(SrcParamData%EdgeVelRat1,3) - IF (.NOT. ALLOCATED(DstParamData%EdgeVelRat1)) THEN - ALLOCATE(DstParamData%EdgeVelRat1(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%EdgeVelRat1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%EdgeVelRat1 = SrcParamData%EdgeVelRat1 -ENDIF -IF (ALLOCATED(SrcParamData%EdgeVelRat2)) THEN - i1_l = LBOUND(SrcParamData%EdgeVelRat2,1) - i1_u = UBOUND(SrcParamData%EdgeVelRat2,1) - i2_l = LBOUND(SrcParamData%EdgeVelRat2,2) - i2_u = UBOUND(SrcParamData%EdgeVelRat2,2) - i3_l = LBOUND(SrcParamData%EdgeVelRat2,3) - i3_u = UBOUND(SrcParamData%EdgeVelRat2,3) - IF (.NOT. ALLOCATED(DstParamData%EdgeVelRat2)) THEN - ALLOCATE(DstParamData%EdgeVelRat2(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%EdgeVelRat2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%EdgeVelRat2 = SrcParamData%EdgeVelRat2 -ENDIF -IF (ALLOCATED(SrcParamData%AFThickGuida)) THEN - i1_l = LBOUND(SrcParamData%AFThickGuida,1) - i1_u = UBOUND(SrcParamData%AFThickGuida,1) - i2_l = LBOUND(SrcParamData%AFThickGuida,2) - i2_u = UBOUND(SrcParamData%AFThickGuida,2) - IF (.NOT. ALLOCATED(DstParamData%AFThickGuida)) THEN - ALLOCATE(DstParamData%AFThickGuida(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFThickGuida.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFThickGuida = SrcParamData%AFThickGuida -ENDIF - END SUBROUTINE AA_CopyParam - - SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(AA_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 = 'AA_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%rotorregionlimitsVert)) THEN - DEALLOCATE(ParamData%rotorregionlimitsVert) -ENDIF -IF (ALLOCATED(ParamData%rotorregionlimitsHorz)) THEN - DEALLOCATE(ParamData%rotorregionlimitsHorz) -ENDIF -IF (ALLOCATED(ParamData%rotorregionlimitsalph)) THEN - DEALLOCATE(ParamData%rotorregionlimitsalph) -ENDIF -IF (ALLOCATED(ParamData%rotorregionlimitsrad)) THEN - DEALLOCATE(ParamData%rotorregionlimitsrad) -ENDIF -IF (ALLOCATED(ParamData%ObsX)) THEN - DEALLOCATE(ParamData%ObsX) -ENDIF -IF (ALLOCATED(ParamData%ObsY)) THEN - DEALLOCATE(ParamData%ObsY) -ENDIF -IF (ALLOCATED(ParamData%ObsZ)) THEN - DEALLOCATE(ParamData%ObsZ) -ENDIF -IF (ALLOCATED(ParamData%FreqList)) THEN - DEALLOCATE(ParamData%FreqList) -ENDIF -IF (ALLOCATED(ParamData%Aweight)) THEN - DEALLOCATE(ParamData%Aweight) -ENDIF -IF (ALLOCATED(ParamData%TI_Grid_In)) THEN - DEALLOCATE(ParamData%TI_Grid_In) -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 -IF (ALLOCATED(ParamData%StallStart)) THEN - DEALLOCATE(ParamData%StallStart) -ENDIF -IF (ALLOCATED(ParamData%TEThick)) THEN - DEALLOCATE(ParamData%TEThick) -ENDIF -IF (ALLOCATED(ParamData%TEAngle)) THEN - DEALLOCATE(ParamData%TEAngle) -ENDIF -IF (ALLOCATED(ParamData%AerCent)) THEN - DEALLOCATE(ParamData%AerCent) -ENDIF -IF (ALLOCATED(ParamData%BlAFID)) THEN - DEALLOCATE(ParamData%BlAFID) -ENDIF -IF (ALLOCATED(ParamData%AFInfo)) THEN -DO i1 = LBOUND(ParamData%AFInfo,1), UBOUND(ParamData%AFInfo,1) - CALL AFI_DestroyParam( ParamData%AFInfo(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%AFInfo) -ENDIF -IF (ALLOCATED(ParamData%AFLECo)) THEN - DEALLOCATE(ParamData%AFLECo) -ENDIF -IF (ALLOCATED(ParamData%AFTECo)) THEN - DEALLOCATE(ParamData%AFTECo) -ENDIF -IF (ALLOCATED(ParamData%BlSpn)) THEN - DEALLOCATE(ParamData%BlSpn) -ENDIF -IF (ALLOCATED(ParamData%BlChord)) THEN - DEALLOCATE(ParamData%BlChord) -ENDIF -IF (ALLOCATED(ParamData%ReListBL)) THEN - DEALLOCATE(ParamData%ReListBL) -ENDIF -IF (ALLOCATED(ParamData%AOAListBL)) THEN - DEALLOCATE(ParamData%AOAListBL) -ENDIF -IF (ALLOCATED(ParamData%dStarAll1)) THEN - DEALLOCATE(ParamData%dStarAll1) -ENDIF -IF (ALLOCATED(ParamData%dStarAll2)) THEN - DEALLOCATE(ParamData%dStarAll2) -ENDIF -IF (ALLOCATED(ParamData%d99All1)) THEN - DEALLOCATE(ParamData%d99All1) -ENDIF -IF (ALLOCATED(ParamData%d99All2)) THEN - DEALLOCATE(ParamData%d99All2) -ENDIF -IF (ALLOCATED(ParamData%CfAll1)) THEN - DEALLOCATE(ParamData%CfAll1) -ENDIF -IF (ALLOCATED(ParamData%CfAll2)) THEN - DEALLOCATE(ParamData%CfAll2) -ENDIF -IF (ALLOCATED(ParamData%EdgeVelRat1)) THEN - DEALLOCATE(ParamData%EdgeVelRat1) -ENDIF -IF (ALLOCATED(ParamData%EdgeVelRat2)) THEN - DEALLOCATE(ParamData%EdgeVelRat2) -ENDIF -IF (ALLOCATED(ParamData%AFThickGuida)) THEN - DEALLOCATE(ParamData%AFThickGuida) -ENDIF - END SUBROUTINE AA_DestroyParam - - SUBROUTINE AA_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(AA_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 = 'AA_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 ! IBLUNT - Int_BufSz = Int_BufSz + 1 ! ILAM - Int_BufSz = Int_BufSz + 1 ! ITIP - Int_BufSz = Int_BufSz + 1 ! ITRIP - Int_BufSz = Int_BufSz + 1 ! ITURB - Int_BufSz = Int_BufSz + 1 ! IInflow - Int_BufSz = Int_BufSz + 1 ! X_BLMethod - Int_BufSz = Int_BufSz + 1 ! TICalcMeth - Int_BufSz = Int_BufSz + 1 ! ROUND - Re_BufSz = Re_BufSz + 1 ! ALPRAT - Int_BufSz = Int_BufSz + 1 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumBlNds - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Re_BufSz = Re_BufSz + 1 ! HubHeight - Re_BufSz = Re_BufSz + 1 ! toptip - Re_BufSz = Re_BufSz + 1 ! bottip - Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsVert allocated yes/no - IF ( ALLOCATED(InData%rotorregionlimitsVert) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsVert upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsVert) ! rotorregionlimitsVert - END IF - Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsHorz allocated yes/no - IF ( ALLOCATED(InData%rotorregionlimitsHorz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsHorz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsHorz) ! rotorregionlimitsHorz - END IF - Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsalph allocated yes/no - IF ( ALLOCATED(InData%rotorregionlimitsalph) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsalph upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsalph) ! rotorregionlimitsalph - END IF - Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsrad allocated yes/no - IF ( ALLOCATED(InData%rotorregionlimitsrad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsrad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsrad) ! rotorregionlimitsrad - END IF - Int_BufSz = Int_BufSz + 1 ! NrObsLoc - Int_BufSz = Int_BufSz + 1 ! aweightflag - Int_BufSz = Int_BufSz + 1 ! TxtFileOutput - Db_BufSz = Db_BufSz + 1 ! AAStart - Int_BufSz = Int_BufSz + 1 ! ObsX allocated yes/no - IF ( ALLOCATED(InData%ObsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsX) ! ObsX - END IF - Int_BufSz = Int_BufSz + 1 ! ObsY allocated yes/no - IF ( ALLOCATED(InData%ObsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsY) ! ObsY - END IF - Int_BufSz = Int_BufSz + 1 ! ObsZ allocated yes/no - IF ( ALLOCATED(InData%ObsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsZ) ! ObsZ - END IF - Int_BufSz = Int_BufSz + 1 ! FreqList allocated yes/no - IF ( ALLOCATED(InData%FreqList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreqList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FreqList) ! FreqList - END IF - Int_BufSz = Int_BufSz + 1 ! Aweight allocated yes/no - IF ( ALLOCATED(InData%Aweight) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Aweight upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Aweight) ! Aweight - END IF - Re_BufSz = Re_BufSz + 1 ! Fsample - Int_BufSz = Int_BufSz + 1 ! total_sample - Int_BufSz = Int_BufSz + 1 ! total_sampleTI - Int_BufSz = Int_BufSz + 1 ! AA_Bl_Prcntge - Int_BufSz = Int_BufSz + 1 ! startnode - Re_BufSz = Re_BufSz + 1 ! Lturb - Re_BufSz = Re_BufSz + 1 ! AvgV - Re_BufSz = Re_BufSz + 1 ! dz_turb_in - Re_BufSz = Re_BufSz + 1 ! dy_turb_in - Int_BufSz = Int_BufSz + 1 ! TI_Grid_In allocated yes/no - IF ( ALLOCATED(InData%TI_Grid_In) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TI_Grid_In upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_Grid_In) ! TI_Grid_In - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle - Int_BufSz = Int_BufSz + 1*LEN(InData%outFmt) ! outFmt - Int_BufSz = Int_BufSz + 1 ! NrOutFile - Int_BufSz = Int_BufSz + 1*LEN(InData%delim) ! delim - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NumOutsForPE - Int_BufSz = Int_BufSz + 1 ! NumOutsForSep - Int_BufSz = Int_BufSz + 1 ! NumOutsForNodes - Int_BufSz = Int_BufSz + 1 ! unOutFile - Int_BufSz = Int_BufSz + 1 ! unOutFile2 - Int_BufSz = Int_BufSz + 1 ! unOutFile3 - Int_BufSz = Int_BufSz + 1 ! unOutFile4 - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - 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 ! StallStart allocated yes/no - IF ( ALLOCATED(InData%StallStart) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StallStart upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StallStart) ! StallStart - END IF - Int_BufSz = Int_BufSz + 1 ! TEThick allocated yes/no - IF ( ALLOCATED(InData%TEThick) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TEThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TEThick) ! TEThick - END IF - Int_BufSz = Int_BufSz + 1 ! TEAngle allocated yes/no - IF ( ALLOCATED(InData%TEAngle) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TEAngle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TEAngle) ! TEAngle - END IF - Int_BufSz = Int_BufSz + 1 ! AerCent allocated yes/no - IF ( ALLOCATED(InData%AerCent) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AerCent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AerCent) ! AerCent - END IF - Int_BufSz = Int_BufSz + 1 ! BlAFID allocated yes/no - IF ( ALLOCATED(InData%BlAFID) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlAFID upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BlAFID) ! BlAFID - END IF - Int_BufSz = Int_BufSz + 1 ! AFInfo allocated yes/no - IF ( ALLOCATED(InData%AFInfo) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AFInfo upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - Int_BufSz = Int_BufSz + 3 ! AFInfo: size of buffers for each call to pack subtype - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AFInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AFInfo - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AFInfo - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AFInfo - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! AFLECo allocated yes/no - IF ( ALLOCATED(InData%AFLECo) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AFLECo upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFLECo) ! AFLECo - END IF - Int_BufSz = Int_BufSz + 1 ! AFTECo allocated yes/no - IF ( ALLOCATED(InData%AFTECo) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AFTECo upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFTECo) ! AFTECo - END IF - Int_BufSz = Int_BufSz + 1 ! BlSpn allocated yes/no - IF ( ALLOCATED(InData%BlSpn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlSpn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlSpn) ! BlSpn - END IF - Int_BufSz = Int_BufSz + 1 ! BlChord allocated yes/no - IF ( ALLOCATED(InData%BlChord) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlChord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlChord) ! BlChord - END IF - Int_BufSz = Int_BufSz + 1 ! ReListBL allocated yes/no - IF ( ALLOCATED(InData%ReListBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ReListBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ReListBL) ! ReListBL - END IF - Int_BufSz = Int_BufSz + 1 ! AOAListBL allocated yes/no - IF ( ALLOCATED(InData%AOAListBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AOAListBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AOAListBL) ! AOAListBL - END IF - Int_BufSz = Int_BufSz + 1 ! dStarAll1 allocated yes/no - IF ( ALLOCATED(InData%dStarAll1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! dStarAll1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dStarAll1) ! dStarAll1 - END IF - Int_BufSz = Int_BufSz + 1 ! dStarAll2 allocated yes/no - IF ( ALLOCATED(InData%dStarAll2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! dStarAll2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dStarAll2) ! dStarAll2 - END IF - Int_BufSz = Int_BufSz + 1 ! d99All1 allocated yes/no - IF ( ALLOCATED(InData%d99All1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! d99All1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%d99All1) ! d99All1 - END IF - Int_BufSz = Int_BufSz + 1 ! d99All2 allocated yes/no - IF ( ALLOCATED(InData%d99All2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! d99All2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%d99All2) ! d99All2 - END IF - Int_BufSz = Int_BufSz + 1 ! CfAll1 allocated yes/no - IF ( ALLOCATED(InData%CfAll1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CfAll1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CfAll1) ! CfAll1 - END IF - Int_BufSz = Int_BufSz + 1 ! CfAll2 allocated yes/no - IF ( ALLOCATED(InData%CfAll2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CfAll2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CfAll2) ! CfAll2 - END IF - Int_BufSz = Int_BufSz + 1 ! EdgeVelRat1 allocated yes/no - IF ( ALLOCATED(InData%EdgeVelRat1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! EdgeVelRat1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%EdgeVelRat1) ! EdgeVelRat1 - END IF - Int_BufSz = Int_BufSz + 1 ! EdgeVelRat2 allocated yes/no - IF ( ALLOCATED(InData%EdgeVelRat2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! EdgeVelRat2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%EdgeVelRat2) ! EdgeVelRat2 - END IF - Int_BufSz = Int_BufSz + 1 ! AFThickGuida allocated yes/no - IF ( ALLOCATED(InData%AFThickGuida) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFThickGuida upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFThickGuida) ! AFThickGuida - 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 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IBLUNT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ILAM - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITRIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITURB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IInflow - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%X_BLMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TICalcMeth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ROUND, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ALPRAT - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%toptip - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%bottip - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%rotorregionlimitsVert) ) 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%rotorregionlimitsVert,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsVert,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotorregionlimitsVert,1), UBOUND(InData%rotorregionlimitsVert,1) - ReKiBuf(Re_Xferred) = InData%rotorregionlimitsVert(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rotorregionlimitsHorz) ) 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%rotorregionlimitsHorz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsHorz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotorregionlimitsHorz,1), UBOUND(InData%rotorregionlimitsHorz,1) - ReKiBuf(Re_Xferred) = InData%rotorregionlimitsHorz(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rotorregionlimitsalph) ) 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%rotorregionlimitsalph,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsalph,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotorregionlimitsalph,1), UBOUND(InData%rotorregionlimitsalph,1) - ReKiBuf(Re_Xferred) = InData%rotorregionlimitsalph(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rotorregionlimitsrad) ) 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%rotorregionlimitsrad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsrad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotorregionlimitsrad,1), UBOUND(InData%rotorregionlimitsrad,1) - ReKiBuf(Re_Xferred) = InData%rotorregionlimitsrad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NrObsLoc - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%aweightflag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TxtFileOutput, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%AAStart - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ObsX) ) 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%ObsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsX,1), UBOUND(InData%ObsX,1) - ReKiBuf(Re_Xferred) = InData%ObsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ObsY) ) 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%ObsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsY,1), UBOUND(InData%ObsY,1) - ReKiBuf(Re_Xferred) = InData%ObsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ObsZ) ) 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%ObsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsZ,1), UBOUND(InData%ObsZ,1) - ReKiBuf(Re_Xferred) = InData%ObsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreqList) ) 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%FreqList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FreqList,1), UBOUND(InData%FreqList,1) - ReKiBuf(Re_Xferred) = InData%FreqList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Aweight) ) 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%Aweight,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aweight,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Aweight,1), UBOUND(InData%Aweight,1) - ReKiBuf(Re_Xferred) = InData%Aweight(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Fsample - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%total_sample - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%total_sampleTI - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AA_Bl_Prcntge - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%startnode - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Lturb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AvgV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dz_turb_in - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dy_turb_in - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TI_Grid_In) ) 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%TI_Grid_In,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_Grid_In,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TI_Grid_In,2), UBOUND(InData%TI_Grid_In,2) - DO i1 = LBOUND(InData%TI_Grid_In,1), UBOUND(InData%TI_Grid_In,1) - ReKiBuf(Re_Xferred) = InData%TI_Grid_In(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(InData%FTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%outFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%outFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NrOutFile - Int_Xferred = Int_Xferred + 1 - 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%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutsForPE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutsForSep - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutsForNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%unOutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%unOutFile2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%unOutFile3 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%unOutFile4 - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - IF ( .NOT. ALLOCATED(InData%StallStart) ) 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%StallStart,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StallStart,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StallStart,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StallStart,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StallStart,2), UBOUND(InData%StallStart,2) - DO i1 = LBOUND(InData%StallStart,1), UBOUND(InData%StallStart,1) - ReKiBuf(Re_Xferred) = InData%StallStart(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TEThick) ) 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%TEThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEThick,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TEThick,2), UBOUND(InData%TEThick,2) - DO i1 = LBOUND(InData%TEThick,1), UBOUND(InData%TEThick,1) - ReKiBuf(Re_Xferred) = InData%TEThick(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TEAngle) ) 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%TEAngle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEAngle,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEAngle,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEAngle,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TEAngle,2), UBOUND(InData%TEAngle,2) - DO i1 = LBOUND(InData%TEAngle,1), UBOUND(InData%TEAngle,1) - ReKiBuf(Re_Xferred) = InData%TEAngle(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AerCent) ) 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%AerCent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AerCent,3), UBOUND(InData%AerCent,3) - DO i2 = LBOUND(InData%AerCent,2), UBOUND(InData%AerCent,2) - DO i1 = LBOUND(InData%AerCent,1), UBOUND(InData%AerCent,1) - ReKiBuf(Re_Xferred) = InData%AerCent(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlAFID) ) 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%BlAFID,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlAFID,2), UBOUND(InData%BlAFID,2) - DO i1 = LBOUND(InData%BlAFID,1), UBOUND(InData%BlAFID,1) - IntKiBuf(Int_Xferred) = InData%BlAFID(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFInfo) ) 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%AFInfo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFInfo,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, OnlySize ) ! AFInfo - 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 - IF ( .NOT. ALLOCATED(InData%AFLECo) ) 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%AFLECo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFLECo,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFLECo,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFLECo,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFLECo,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFLECo,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AFLECo,3), UBOUND(InData%AFLECo,3) - DO i2 = LBOUND(InData%AFLECo,2), UBOUND(InData%AFLECo,2) - DO i1 = LBOUND(InData%AFLECo,1), UBOUND(InData%AFLECo,1) - ReKiBuf(Re_Xferred) = InData%AFLECo(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFTECo) ) 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%AFTECo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFTECo,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFTECo,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFTECo,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFTECo,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFTECo,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AFTECo,3), UBOUND(InData%AFTECo,3) - DO i2 = LBOUND(InData%AFTECo,2), UBOUND(InData%AFTECo,2) - DO i1 = LBOUND(InData%AFTECo,1), UBOUND(InData%AFTECo,1) - ReKiBuf(Re_Xferred) = InData%AFTECo(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlSpn) ) 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%BlSpn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlSpn,2), UBOUND(InData%BlSpn,2) - DO i1 = LBOUND(InData%BlSpn,1), UBOUND(InData%BlSpn,1) - ReKiBuf(Re_Xferred) = InData%BlSpn(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlChord) ) 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%BlChord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlChord,2), UBOUND(InData%BlChord,2) - DO i1 = LBOUND(InData%BlChord,1), UBOUND(InData%BlChord,1) - ReKiBuf(Re_Xferred) = InData%BlChord(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ReListBL) ) 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%ReListBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ReListBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ReListBL,1), UBOUND(InData%ReListBL,1) - ReKiBuf(Re_Xferred) = InData%ReListBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AOAListBL) ) 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%AOAListBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOAListBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AOAListBL,1), UBOUND(InData%AOAListBL,1) - ReKiBuf(Re_Xferred) = InData%AOAListBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dStarAll1) ) 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%dStarAll1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%dStarAll1,3), UBOUND(InData%dStarAll1,3) - DO i2 = LBOUND(InData%dStarAll1,2), UBOUND(InData%dStarAll1,2) - DO i1 = LBOUND(InData%dStarAll1,1), UBOUND(InData%dStarAll1,1) - ReKiBuf(Re_Xferred) = InData%dStarAll1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dStarAll2) ) 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%dStarAll2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%dStarAll2,3), UBOUND(InData%dStarAll2,3) - DO i2 = LBOUND(InData%dStarAll2,2), UBOUND(InData%dStarAll2,2) - DO i1 = LBOUND(InData%dStarAll2,1), UBOUND(InData%dStarAll2,1) - ReKiBuf(Re_Xferred) = InData%dStarAll2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%d99All1) ) 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%d99All1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%d99All1,3), UBOUND(InData%d99All1,3) - DO i2 = LBOUND(InData%d99All1,2), UBOUND(InData%d99All1,2) - DO i1 = LBOUND(InData%d99All1,1), UBOUND(InData%d99All1,1) - ReKiBuf(Re_Xferred) = InData%d99All1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%d99All2) ) 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%d99All2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%d99All2,3), UBOUND(InData%d99All2,3) - DO i2 = LBOUND(InData%d99All2,2), UBOUND(InData%d99All2,2) - DO i1 = LBOUND(InData%d99All2,1), UBOUND(InData%d99All2,1) - ReKiBuf(Re_Xferred) = InData%d99All2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CfAll1) ) 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%CfAll1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CfAll1,3), UBOUND(InData%CfAll1,3) - DO i2 = LBOUND(InData%CfAll1,2), UBOUND(InData%CfAll1,2) - DO i1 = LBOUND(InData%CfAll1,1), UBOUND(InData%CfAll1,1) - ReKiBuf(Re_Xferred) = InData%CfAll1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CfAll2) ) 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%CfAll2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CfAll2,3), UBOUND(InData%CfAll2,3) - DO i2 = LBOUND(InData%CfAll2,2), UBOUND(InData%CfAll2,2) - DO i1 = LBOUND(InData%CfAll2,1), UBOUND(InData%CfAll2,1) - ReKiBuf(Re_Xferred) = InData%CfAll2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%EdgeVelRat1) ) 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%EdgeVelRat1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%EdgeVelRat1,3), UBOUND(InData%EdgeVelRat1,3) - DO i2 = LBOUND(InData%EdgeVelRat1,2), UBOUND(InData%EdgeVelRat1,2) - DO i1 = LBOUND(InData%EdgeVelRat1,1), UBOUND(InData%EdgeVelRat1,1) - ReKiBuf(Re_Xferred) = InData%EdgeVelRat1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%EdgeVelRat2) ) 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%EdgeVelRat2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%EdgeVelRat2,3), UBOUND(InData%EdgeVelRat2,3) - DO i2 = LBOUND(InData%EdgeVelRat2,2), UBOUND(InData%EdgeVelRat2,2) - DO i1 = LBOUND(InData%EdgeVelRat2,1), UBOUND(InData%EdgeVelRat2,1) - ReKiBuf(Re_Xferred) = InData%EdgeVelRat2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFThickGuida) ) 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%AFThickGuida,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFThickGuida,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFThickGuida,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFThickGuida,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFThickGuida,2), UBOUND(InData%AFThickGuida,2) - DO i1 = LBOUND(InData%AFThickGuida,1), UBOUND(InData%AFThickGuida,1) - ReKiBuf(Re_Xferred) = InData%AFThickGuida(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AA_PackParam - - SUBROUTINE AA_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(AA_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_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%IBLUNT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ILAM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITIP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITRIP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITURB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%IInflow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X_BLMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TICalcMeth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ROUND = TRANSFER(IntKiBuf(Int_Xferred), OutData%ROUND) - Int_Xferred = Int_Xferred + 1 - OutData%ALPRAT = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%toptip = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%bottip = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsVert 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%rotorregionlimitsVert)) DEALLOCATE(OutData%rotorregionlimitsVert) - ALLOCATE(OutData%rotorregionlimitsVert(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsVert.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotorregionlimitsVert,1), UBOUND(OutData%rotorregionlimitsVert,1) - OutData%rotorregionlimitsVert(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsHorz 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%rotorregionlimitsHorz)) DEALLOCATE(OutData%rotorregionlimitsHorz) - ALLOCATE(OutData%rotorregionlimitsHorz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsHorz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotorregionlimitsHorz,1), UBOUND(OutData%rotorregionlimitsHorz,1) - OutData%rotorregionlimitsHorz(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsalph 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%rotorregionlimitsalph)) DEALLOCATE(OutData%rotorregionlimitsalph) - ALLOCATE(OutData%rotorregionlimitsalph(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsalph.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotorregionlimitsalph,1), UBOUND(OutData%rotorregionlimitsalph,1) - OutData%rotorregionlimitsalph(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsrad 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%rotorregionlimitsrad)) DEALLOCATE(OutData%rotorregionlimitsrad) - ALLOCATE(OutData%rotorregionlimitsrad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsrad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotorregionlimitsrad,1), UBOUND(OutData%rotorregionlimitsrad,1) - OutData%rotorregionlimitsrad(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NrObsLoc = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%aweightflag = TRANSFER(IntKiBuf(Int_Xferred), OutData%aweightflag) - Int_Xferred = Int_Xferred + 1 - OutData%TxtFileOutput = TRANSFER(IntKiBuf(Int_Xferred), OutData%TxtFileOutput) - Int_Xferred = Int_Xferred + 1 - OutData%AAStart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsX 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%ObsX)) DEALLOCATE(OutData%ObsX) - ALLOCATE(OutData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsX,1), UBOUND(OutData%ObsX,1) - OutData%ObsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsY 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%ObsY)) DEALLOCATE(OutData%ObsY) - ALLOCATE(OutData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsY,1), UBOUND(OutData%ObsY,1) - OutData%ObsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsZ 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%ObsZ)) DEALLOCATE(OutData%ObsZ) - ALLOCATE(OutData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsZ,1), UBOUND(OutData%ObsZ,1) - OutData%ObsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreqList 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%FreqList)) DEALLOCATE(OutData%FreqList) - ALLOCATE(OutData%FreqList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FreqList,1), UBOUND(OutData%FreqList,1) - OutData%FreqList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Aweight 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%Aweight)) DEALLOCATE(OutData%Aweight) - ALLOCATE(OutData%Aweight(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aweight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Aweight,1), UBOUND(OutData%Aweight,1) - OutData%Aweight(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Fsample = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%total_sample = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%total_sampleTI = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AA_Bl_Prcntge = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%startnode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Lturb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AvgV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dz_turb_in = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dy_turb_in = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_Grid_In 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%TI_Grid_In)) DEALLOCATE(OutData%TI_Grid_In) - ALLOCATE(OutData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TI_Grid_In,2), UBOUND(OutData%TI_Grid_In,2) - DO i1 = LBOUND(OutData%TI_Grid_In,1), UBOUND(OutData%TI_Grid_In,1) - OutData%TI_Grid_In(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(OutData%FTitle) - OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%outFmt) - OutData%outFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NrOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%delim) - OutData%delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutsForPE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutsForSep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutsForNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%unOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%unOutFile2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%unOutFile3 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%unOutFile4 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StallStart 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%StallStart)) DEALLOCATE(OutData%StallStart) - ALLOCATE(OutData%StallStart(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StallStart.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StallStart,2), UBOUND(OutData%StallStart,2) - DO i1 = LBOUND(OutData%StallStart,1), UBOUND(OutData%StallStart,1) - OutData%StallStart(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEThick 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%TEThick)) DEALLOCATE(OutData%TEThick) - ALLOCATE(OutData%TEThick(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TEThick,2), UBOUND(OutData%TEThick,2) - DO i1 = LBOUND(OutData%TEThick,1), UBOUND(OutData%TEThick,1) - OutData%TEThick(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEAngle 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%TEAngle)) DEALLOCATE(OutData%TEAngle) - ALLOCATE(OutData%TEAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TEAngle,2), UBOUND(OutData%TEAngle,2) - DO i1 = LBOUND(OutData%TEAngle,1), UBOUND(OutData%TEAngle,1) - OutData%TEAngle(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AerCent 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%AerCent)) DEALLOCATE(OutData%AerCent) - ALLOCATE(OutData%AerCent(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%AerCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AerCent,3), UBOUND(OutData%AerCent,3) - DO i2 = LBOUND(OutData%AerCent,2), UBOUND(OutData%AerCent,2) - DO i1 = LBOUND(OutData%AerCent,1), UBOUND(OutData%AerCent,1) - OutData%AerCent(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAFID 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%BlAFID)) DEALLOCATE(OutData%BlAFID) - ALLOCATE(OutData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlAFID,2), UBOUND(OutData%BlAFID,2) - DO i1 = LBOUND(OutData%BlAFID,1), UBOUND(OutData%BlAFID,1) - OutData%BlAFID(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFInfo 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%AFInfo)) DEALLOCATE(OutData%AFInfo) - ALLOCATE(OutData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AFInfo,1), UBOUND(OutData%AFInfo,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 AFI_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AFInfo(i1), ErrStat2, ErrMsg2 ) ! AFInfo - 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 ! AFLECo 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%AFLECo)) DEALLOCATE(OutData%AFLECo) - ALLOCATE(OutData%AFLECo(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%AFLECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AFLECo,3), UBOUND(OutData%AFLECo,3) - DO i2 = LBOUND(OutData%AFLECo,2), UBOUND(OutData%AFLECo,2) - DO i1 = LBOUND(OutData%AFLECo,1), UBOUND(OutData%AFLECo,1) - OutData%AFLECo(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFTECo 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%AFTECo)) DEALLOCATE(OutData%AFTECo) - ALLOCATE(OutData%AFTECo(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%AFTECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AFTECo,3), UBOUND(OutData%AFTECo,3) - DO i2 = LBOUND(OutData%AFTECo,2), UBOUND(OutData%AFTECo,2) - DO i1 = LBOUND(OutData%AFTECo,1), UBOUND(OutData%AFTECo,1) - OutData%AFTECo(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSpn 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%BlSpn)) DEALLOCATE(OutData%BlSpn) - ALLOCATE(OutData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlSpn,2), UBOUND(OutData%BlSpn,2) - DO i1 = LBOUND(OutData%BlSpn,1), UBOUND(OutData%BlSpn,1) - OutData%BlSpn(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord 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%BlChord)) DEALLOCATE(OutData%BlChord) - ALLOCATE(OutData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlChord,2), UBOUND(OutData%BlChord,2) - DO i1 = LBOUND(OutData%BlChord,1), UBOUND(OutData%BlChord,1) - OutData%BlChord(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ReListBL 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%ReListBL)) DEALLOCATE(OutData%ReListBL) - ALLOCATE(OutData%ReListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ReListBL,1), UBOUND(OutData%ReListBL,1) - OutData%ReListBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOAListBL 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%AOAListBL)) DEALLOCATE(OutData%AOAListBL) - ALLOCATE(OutData%AOAListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOAListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AOAListBL,1), UBOUND(OutData%AOAListBL,1) - OutData%AOAListBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dStarAll1 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%dStarAll1)) DEALLOCATE(OutData%dStarAll1) - ALLOCATE(OutData%dStarAll1(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%dStarAll1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%dStarAll1,3), UBOUND(OutData%dStarAll1,3) - DO i2 = LBOUND(OutData%dStarAll1,2), UBOUND(OutData%dStarAll1,2) - DO i1 = LBOUND(OutData%dStarAll1,1), UBOUND(OutData%dStarAll1,1) - OutData%dStarAll1(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dStarAll2 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%dStarAll2)) DEALLOCATE(OutData%dStarAll2) - ALLOCATE(OutData%dStarAll2(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%dStarAll2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%dStarAll2,3), UBOUND(OutData%dStarAll2,3) - DO i2 = LBOUND(OutData%dStarAll2,2), UBOUND(OutData%dStarAll2,2) - DO i1 = LBOUND(OutData%dStarAll2,1), UBOUND(OutData%dStarAll2,1) - OutData%dStarAll2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! d99All1 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%d99All1)) DEALLOCATE(OutData%d99All1) - ALLOCATE(OutData%d99All1(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%d99All1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%d99All1,3), UBOUND(OutData%d99All1,3) - DO i2 = LBOUND(OutData%d99All1,2), UBOUND(OutData%d99All1,2) - DO i1 = LBOUND(OutData%d99All1,1), UBOUND(OutData%d99All1,1) - OutData%d99All1(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! d99All2 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%d99All2)) DEALLOCATE(OutData%d99All2) - ALLOCATE(OutData%d99All2(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%d99All2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%d99All2,3), UBOUND(OutData%d99All2,3) - DO i2 = LBOUND(OutData%d99All2,2), UBOUND(OutData%d99All2,2) - DO i1 = LBOUND(OutData%d99All2,1), UBOUND(OutData%d99All2,1) - OutData%d99All2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CfAll1 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%CfAll1)) DEALLOCATE(OutData%CfAll1) - ALLOCATE(OutData%CfAll1(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%CfAll1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CfAll1,3), UBOUND(OutData%CfAll1,3) - DO i2 = LBOUND(OutData%CfAll1,2), UBOUND(OutData%CfAll1,2) - DO i1 = LBOUND(OutData%CfAll1,1), UBOUND(OutData%CfAll1,1) - OutData%CfAll1(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CfAll2 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%CfAll2)) DEALLOCATE(OutData%CfAll2) - ALLOCATE(OutData%CfAll2(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%CfAll2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CfAll2,3), UBOUND(OutData%CfAll2,3) - DO i2 = LBOUND(OutData%CfAll2,2), UBOUND(OutData%CfAll2,2) - DO i1 = LBOUND(OutData%CfAll2,1), UBOUND(OutData%CfAll2,1) - OutData%CfAll2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgeVelRat1 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%EdgeVelRat1)) DEALLOCATE(OutData%EdgeVelRat1) - ALLOCATE(OutData%EdgeVelRat1(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%EdgeVelRat1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%EdgeVelRat1,3), UBOUND(OutData%EdgeVelRat1,3) - DO i2 = LBOUND(OutData%EdgeVelRat1,2), UBOUND(OutData%EdgeVelRat1,2) - DO i1 = LBOUND(OutData%EdgeVelRat1,1), UBOUND(OutData%EdgeVelRat1,1) - OutData%EdgeVelRat1(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgeVelRat2 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%EdgeVelRat2)) DEALLOCATE(OutData%EdgeVelRat2) - ALLOCATE(OutData%EdgeVelRat2(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%EdgeVelRat2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%EdgeVelRat2,3), UBOUND(OutData%EdgeVelRat2,3) - DO i2 = LBOUND(OutData%EdgeVelRat2,2), UBOUND(OutData%EdgeVelRat2,2) - DO i1 = LBOUND(OutData%EdgeVelRat2,1), UBOUND(OutData%EdgeVelRat2,1) - OutData%EdgeVelRat2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFThickGuida 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%AFThickGuida)) DEALLOCATE(OutData%AFThickGuida) - ALLOCATE(OutData%AFThickGuida(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFThickGuida.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFThickGuida,2), UBOUND(OutData%AFThickGuida,2) - DO i1 = LBOUND(OutData%AFThickGuida,1), UBOUND(OutData%AFThickGuida,1) - OutData%AFThickGuida(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AA_UnPackParam - - SUBROUTINE AA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InputType), INTENT(IN) :: SrcInputData - TYPE(AA_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) :: 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_CopyInput' -! + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine + +subroutine AA_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(AA_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%RotGtoL)) THEN - i1_l = LBOUND(SrcInputData%RotGtoL,1) - i1_u = UBOUND(SrcInputData%RotGtoL,1) - i2_l = LBOUND(SrcInputData%RotGtoL,2) - i2_u = UBOUND(SrcInputData%RotGtoL,2) - i3_l = LBOUND(SrcInputData%RotGtoL,3) - i3_u = UBOUND(SrcInputData%RotGtoL,3) - i4_l = LBOUND(SrcInputData%RotGtoL,4) - i4_u = UBOUND(SrcInputData%RotGtoL,4) - IF (.NOT. ALLOCATED(DstInputData%RotGtoL)) THEN - ALLOCATE(DstInputData%RotGtoL(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 DstInputData%RotGtoL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%RotGtoL = SrcInputData%RotGtoL -ENDIF -IF (ALLOCATED(SrcInputData%AeroCent_G)) THEN - i1_l = LBOUND(SrcInputData%AeroCent_G,1) - i1_u = UBOUND(SrcInputData%AeroCent_G,1) - i2_l = LBOUND(SrcInputData%AeroCent_G,2) - i2_u = UBOUND(SrcInputData%AeroCent_G,2) - i3_l = LBOUND(SrcInputData%AeroCent_G,3) - i3_u = UBOUND(SrcInputData%AeroCent_G,3) - IF (.NOT. ALLOCATED(DstInputData%AeroCent_G)) THEN - ALLOCATE(DstInputData%AeroCent_G(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AeroCent_G.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%AeroCent_G = SrcInputData%AeroCent_G -ENDIF -IF (ALLOCATED(SrcInputData%Vrel)) THEN - i1_l = LBOUND(SrcInputData%Vrel,1) - i1_u = UBOUND(SrcInputData%Vrel,1) - i2_l = LBOUND(SrcInputData%Vrel,2) - i2_u = UBOUND(SrcInputData%Vrel,2) - IF (.NOT. ALLOCATED(DstInputData%Vrel)) THEN - ALLOCATE(DstInputData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vrel = SrcInputData%Vrel -ENDIF -IF (ALLOCATED(SrcInputData%AoANoise)) THEN - i1_l = LBOUND(SrcInputData%AoANoise,1) - i1_u = UBOUND(SrcInputData%AoANoise,1) - i2_l = LBOUND(SrcInputData%AoANoise,2) - i2_u = UBOUND(SrcInputData%AoANoise,2) - IF (.NOT. ALLOCATED(DstInputData%AoANoise)) THEN - ALLOCATE(DstInputData%AoANoise(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AoANoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%AoANoise = SrcInputData%AoANoise -ENDIF -IF (ALLOCATED(SrcInputData%Inflow)) THEN - i1_l = LBOUND(SrcInputData%Inflow,1) - i1_u = UBOUND(SrcInputData%Inflow,1) - i2_l = LBOUND(SrcInputData%Inflow,2) - i2_u = UBOUND(SrcInputData%Inflow,2) - i3_l = LBOUND(SrcInputData%Inflow,3) - i3_u = UBOUND(SrcInputData%Inflow,3) - IF (.NOT. ALLOCATED(DstInputData%Inflow)) THEN - ALLOCATE(DstInputData%Inflow(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Inflow.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Inflow = SrcInputData%Inflow -ENDIF - END SUBROUTINE AA_CopyInput - - SUBROUTINE AA_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(AA_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 = 'AA_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%RotGtoL)) THEN - DEALLOCATE(InputData%RotGtoL) -ENDIF -IF (ALLOCATED(InputData%AeroCent_G)) THEN - DEALLOCATE(InputData%AeroCent_G) -ENDIF -IF (ALLOCATED(InputData%Vrel)) THEN - DEALLOCATE(InputData%Vrel) -ENDIF -IF (ALLOCATED(InputData%AoANoise)) THEN - DEALLOCATE(InputData%AoANoise) -ENDIF -IF (ALLOCATED(InputData%Inflow)) THEN - DEALLOCATE(InputData%Inflow) -ENDIF - END SUBROUTINE AA_DestroyInput - - SUBROUTINE AA_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(AA_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 = 'AA_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 - Int_BufSz = Int_BufSz + 1 ! RotGtoL allocated yes/no - IF ( ALLOCATED(InData%RotGtoL) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! RotGtoL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RotGtoL) ! RotGtoL - END IF - Int_BufSz = Int_BufSz + 1 ! AeroCent_G allocated yes/no - IF ( ALLOCATED(InData%AeroCent_G) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AeroCent_G upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AeroCent_G) ! AeroCent_G - END IF - Int_BufSz = Int_BufSz + 1 ! Vrel allocated yes/no - IF ( ALLOCATED(InData%Vrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vrel) ! Vrel - END IF - Int_BufSz = Int_BufSz + 1 ! AoANoise allocated yes/no - IF ( ALLOCATED(InData%AoANoise) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AoANoise upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AoANoise) ! AoANoise - END IF - Int_BufSz = Int_BufSz + 1 ! Inflow allocated yes/no - IF ( ALLOCATED(InData%Inflow) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Inflow upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Inflow) ! Inflow - 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%RotGtoL) ) 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%RotGtoL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotGtoL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotGtoL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotGtoL,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%RotGtoL,4), UBOUND(InData%RotGtoL,4) - DO i3 = LBOUND(InData%RotGtoL,3), UBOUND(InData%RotGtoL,3) - DO i2 = LBOUND(InData%RotGtoL,2), UBOUND(InData%RotGtoL,2) - DO i1 = LBOUND(InData%RotGtoL,1), UBOUND(InData%RotGtoL,1) - ReKiBuf(Re_Xferred) = InData%RotGtoL(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AeroCent_G) ) 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%AeroCent_G,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroCent_G,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroCent_G,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroCent_G,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroCent_G,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroCent_G,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AeroCent_G,3), UBOUND(InData%AeroCent_G,3) - DO i2 = LBOUND(InData%AeroCent_G,2), UBOUND(InData%AeroCent_G,2) - DO i1 = LBOUND(InData%AeroCent_G,1), UBOUND(InData%AeroCent_G,1) - ReKiBuf(Re_Xferred) = InData%AeroCent_G(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vrel) ) 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%Vrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vrel,2), UBOUND(InData%Vrel,2) - DO i1 = LBOUND(InData%Vrel,1), UBOUND(InData%Vrel,1) - ReKiBuf(Re_Xferred) = InData%Vrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AoANoise) ) 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%AoANoise,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AoANoise,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AoANoise,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AoANoise,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AoANoise,2), UBOUND(InData%AoANoise,2) - DO i1 = LBOUND(InData%AoANoise,1), UBOUND(InData%AoANoise,1) - ReKiBuf(Re_Xferred) = InData%AoANoise(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Inflow) ) 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%Inflow,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Inflow,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Inflow,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Inflow,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Inflow,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Inflow,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Inflow,3), UBOUND(InData%Inflow,3) - DO i2 = LBOUND(InData%Inflow,2), UBOUND(InData%Inflow,2) - DO i1 = LBOUND(InData%Inflow,1), UBOUND(InData%Inflow,1) - ReKiBuf(Re_Xferred) = InData%Inflow(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AA_PackInput - - SUBROUTINE AA_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(AA_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) :: 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_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotGtoL 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%RotGtoL)) DEALLOCATE(OutData%RotGtoL) - ALLOCATE(OutData%RotGtoL(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%RotGtoL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%RotGtoL,4), UBOUND(OutData%RotGtoL,4) - DO i3 = LBOUND(OutData%RotGtoL,3), UBOUND(OutData%RotGtoL,3) - DO i2 = LBOUND(OutData%RotGtoL,2), UBOUND(OutData%RotGtoL,2) - DO i1 = LBOUND(OutData%RotGtoL,1), UBOUND(OutData%RotGtoL,1) - OutData%RotGtoL(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroCent_G 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%AeroCent_G)) DEALLOCATE(OutData%AeroCent_G) - ALLOCATE(OutData%AeroCent_G(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%AeroCent_G.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AeroCent_G,3), UBOUND(OutData%AeroCent_G,3) - DO i2 = LBOUND(OutData%AeroCent_G,2), UBOUND(OutData%AeroCent_G,2) - DO i1 = LBOUND(OutData%AeroCent_G,1), UBOUND(OutData%AeroCent_G,1) - OutData%AeroCent_G(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vrel 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%Vrel)) DEALLOCATE(OutData%Vrel) - ALLOCATE(OutData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vrel,2), UBOUND(OutData%Vrel,2) - DO i1 = LBOUND(OutData%Vrel,1), UBOUND(OutData%Vrel,1) - OutData%Vrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AoANoise 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%AoANoise)) DEALLOCATE(OutData%AoANoise) - ALLOCATE(OutData%AoANoise(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AoANoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AoANoise,2), UBOUND(OutData%AoANoise,2) - DO i1 = LBOUND(OutData%AoANoise,1), UBOUND(OutData%AoANoise,1) - OutData%AoANoise(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Inflow 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%Inflow)) DEALLOCATE(OutData%Inflow) - ALLOCATE(OutData%Inflow(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%Inflow.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Inflow,3), UBOUND(OutData%Inflow,3) - DO i2 = LBOUND(OutData%Inflow,2), UBOUND(OutData%Inflow,2) - DO i1 = LBOUND(OutData%Inflow,1), UBOUND(OutData%Inflow,1) - OutData%Inflow(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AA_UnPackInput - - SUBROUTINE AA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_OutputType), INTENT(IN) :: SrcOutputData - TYPE(AA_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) :: 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_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine AA_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(AA_DiscreteStateType), intent(in) :: SrcDiscStateData + type(AA_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AA_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%SumSpecNoise)) THEN - i1_l = LBOUND(SrcOutputData%SumSpecNoise,1) - i1_u = UBOUND(SrcOutputData%SumSpecNoise,1) - i2_l = LBOUND(SrcOutputData%SumSpecNoise,2) - i2_u = UBOUND(SrcOutputData%SumSpecNoise,2) - i3_l = LBOUND(SrcOutputData%SumSpecNoise,3) - i3_u = UBOUND(SrcOutputData%SumSpecNoise,3) - IF (.NOT. ALLOCATED(DstOutputData%SumSpecNoise)) THEN - ALLOCATE(DstOutputData%SumSpecNoise(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%SumSpecNoise = SrcOutputData%SumSpecNoise -ENDIF -IF (ALLOCATED(SrcOutputData%SumSpecNoiseSep)) THEN - i1_l = LBOUND(SrcOutputData%SumSpecNoiseSep,1) - i1_u = UBOUND(SrcOutputData%SumSpecNoiseSep,1) - i2_l = LBOUND(SrcOutputData%SumSpecNoiseSep,2) - i2_u = UBOUND(SrcOutputData%SumSpecNoiseSep,2) - i3_l = LBOUND(SrcOutputData%SumSpecNoiseSep,3) - i3_u = UBOUND(SrcOutputData%SumSpecNoiseSep,3) - IF (.NOT. ALLOCATED(DstOutputData%SumSpecNoiseSep)) THEN - ALLOCATE(DstOutputData%SumSpecNoiseSep(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoiseSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%SumSpecNoiseSep = SrcOutputData%SumSpecNoiseSep -ENDIF -IF (ALLOCATED(SrcOutputData%OASPL)) THEN - i1_l = LBOUND(SrcOutputData%OASPL,1) - i1_u = UBOUND(SrcOutputData%OASPL,1) - i2_l = LBOUND(SrcOutputData%OASPL,2) - i2_u = UBOUND(SrcOutputData%OASPL,2) - i3_l = LBOUND(SrcOutputData%OASPL,3) - i3_u = UBOUND(SrcOutputData%OASPL,3) - IF (.NOT. ALLOCATED(DstOutputData%OASPL)) THEN - ALLOCATE(DstOutputData%OASPL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OASPL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%OASPL = SrcOutputData%OASPL -ENDIF -IF (ALLOCATED(SrcOutputData%OASPL_Mech)) THEN - i1_l = LBOUND(SrcOutputData%OASPL_Mech,1) - i1_u = UBOUND(SrcOutputData%OASPL_Mech,1) - i2_l = LBOUND(SrcOutputData%OASPL_Mech,2) - i2_u = UBOUND(SrcOutputData%OASPL_Mech,2) - i3_l = LBOUND(SrcOutputData%OASPL_Mech,3) - i3_u = UBOUND(SrcOutputData%OASPL_Mech,3) - i4_l = LBOUND(SrcOutputData%OASPL_Mech,4) - i4_u = UBOUND(SrcOutputData%OASPL_Mech,4) - IF (.NOT. ALLOCATED(DstOutputData%OASPL_Mech)) THEN - ALLOCATE(DstOutputData%OASPL_Mech(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 DstOutputData%OASPL_Mech.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%OASPL_Mech = SrcOutputData%OASPL_Mech -ENDIF -IF (ALLOCATED(SrcOutputData%DirectiviOutput)) THEN - i1_l = LBOUND(SrcOutputData%DirectiviOutput,1) - i1_u = UBOUND(SrcOutputData%DirectiviOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%DirectiviOutput)) THEN - ALLOCATE(DstOutputData%DirectiviOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%DirectiviOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%DirectiviOutput = SrcOutputData%DirectiviOutput -ENDIF -IF (ALLOCATED(SrcOutputData%OutLECoords)) THEN - i1_l = LBOUND(SrcOutputData%OutLECoords,1) - i1_u = UBOUND(SrcOutputData%OutLECoords,1) - i2_l = LBOUND(SrcOutputData%OutLECoords,2) - i2_u = UBOUND(SrcOutputData%OutLECoords,2) - i3_l = LBOUND(SrcOutputData%OutLECoords,3) - i3_u = UBOUND(SrcOutputData%OutLECoords,3) - i4_l = LBOUND(SrcOutputData%OutLECoords,4) - i4_u = UBOUND(SrcOutputData%OutLECoords,4) - IF (.NOT. ALLOCATED(DstOutputData%OutLECoords)) THEN - ALLOCATE(DstOutputData%OutLECoords(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 DstOutputData%OutLECoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%OutLECoords = SrcOutputData%OutLECoords -ENDIF -IF (ALLOCATED(SrcOutputData%PtotalFreq)) THEN - i1_l = LBOUND(SrcOutputData%PtotalFreq,1) - i1_u = UBOUND(SrcOutputData%PtotalFreq,1) - i2_l = LBOUND(SrcOutputData%PtotalFreq,2) - i2_u = UBOUND(SrcOutputData%PtotalFreq,2) - IF (.NOT. ALLOCATED(DstOutputData%PtotalFreq)) THEN - ALLOCATE(DstOutputData%PtotalFreq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%PtotalFreq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%PtotalFreq = SrcOutputData%PtotalFreq -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutputForPE)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutputForPE,1) - i1_u = UBOUND(SrcOutputData%WriteOutputForPE,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutputForPE)) THEN - ALLOCATE(DstOutputData%WriteOutputForPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputForPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutputForPE = SrcOutputData%WriteOutputForPE -ENDIF -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 -IF (ALLOCATED(SrcOutputData%WriteOutputSep)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutputSep,1) - i1_u = UBOUND(SrcOutputData%WriteOutputSep,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutputSep)) THEN - ALLOCATE(DstOutputData%WriteOutputSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutputSep = SrcOutputData%WriteOutputSep -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutputNode)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutputNode,1) - i1_u = UBOUND(SrcOutputData%WriteOutputNode,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutputNode)) THEN - ALLOCATE(DstOutputData%WriteOutputNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutputNode = SrcOutputData%WriteOutputNode -ENDIF - END SUBROUTINE AA_CopyOutput - - SUBROUTINE AA_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(AA_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 = 'AA_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%SumSpecNoise)) THEN - DEALLOCATE(OutputData%SumSpecNoise) -ENDIF -IF (ALLOCATED(OutputData%SumSpecNoiseSep)) THEN - DEALLOCATE(OutputData%SumSpecNoiseSep) -ENDIF -IF (ALLOCATED(OutputData%OASPL)) THEN - DEALLOCATE(OutputData%OASPL) -ENDIF -IF (ALLOCATED(OutputData%OASPL_Mech)) THEN - DEALLOCATE(OutputData%OASPL_Mech) -ENDIF -IF (ALLOCATED(OutputData%DirectiviOutput)) THEN - DEALLOCATE(OutputData%DirectiviOutput) -ENDIF -IF (ALLOCATED(OutputData%OutLECoords)) THEN - DEALLOCATE(OutputData%OutLECoords) -ENDIF -IF (ALLOCATED(OutputData%PtotalFreq)) THEN - DEALLOCATE(OutputData%PtotalFreq) -ENDIF -IF (ALLOCATED(OutputData%WriteOutputForPE)) THEN - DEALLOCATE(OutputData%WriteOutputForPE) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF -IF (ALLOCATED(OutputData%WriteOutputSep)) THEN - DEALLOCATE(OutputData%WriteOutputSep) -ENDIF -IF (ALLOCATED(OutputData%WriteOutputNode)) THEN - DEALLOCATE(OutputData%WriteOutputNode) -ENDIF - END SUBROUTINE AA_DestroyOutput - - SUBROUTINE AA_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(AA_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 = 'AA_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 ! SumSpecNoise allocated yes/no - IF ( ALLOCATED(InData%SumSpecNoise) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SumSpecNoise upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SumSpecNoise) ! SumSpecNoise - END IF - Int_BufSz = Int_BufSz + 1 ! SumSpecNoiseSep allocated yes/no - IF ( ALLOCATED(InData%SumSpecNoiseSep) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SumSpecNoiseSep upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SumSpecNoiseSep) ! SumSpecNoiseSep - END IF - Int_BufSz = Int_BufSz + 1 ! OASPL allocated yes/no - IF ( ALLOCATED(InData%OASPL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! OASPL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OASPL) ! OASPL - END IF - Int_BufSz = Int_BufSz + 1 ! OASPL_Mech allocated yes/no - IF ( ALLOCATED(InData%OASPL_Mech) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! OASPL_Mech upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OASPL_Mech) ! OASPL_Mech - END IF - Int_BufSz = Int_BufSz + 1 ! DirectiviOutput allocated yes/no - IF ( ALLOCATED(InData%DirectiviOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DirectiviOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DirectiviOutput) ! DirectiviOutput - END IF - Int_BufSz = Int_BufSz + 1 ! OutLECoords allocated yes/no - IF ( ALLOCATED(InData%OutLECoords) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! OutLECoords upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutLECoords) ! OutLECoords - END IF - Int_BufSz = Int_BufSz + 1 ! PtotalFreq allocated yes/no - IF ( ALLOCATED(InData%PtotalFreq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PtotalFreq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtotalFreq) ! PtotalFreq - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputForPE allocated yes/no - IF ( ALLOCATED(InData%WriteOutputForPE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputForPE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutputForPE) ! WriteOutputForPE - END IF - 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 - Int_BufSz = Int_BufSz + 1 ! WriteOutputSep allocated yes/no - IF ( ALLOCATED(InData%WriteOutputSep) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputSep upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutputSep) ! WriteOutputSep - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputNode allocated yes/no - IF ( ALLOCATED(InData%WriteOutputNode) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputNode upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutputNode) ! WriteOutputNode - 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%SumSpecNoise) ) 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%SumSpecNoise,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoise,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoise,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoise,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoise,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoise,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SumSpecNoise,3), UBOUND(InData%SumSpecNoise,3) - DO i2 = LBOUND(InData%SumSpecNoise,2), UBOUND(InData%SumSpecNoise,2) - DO i1 = LBOUND(InData%SumSpecNoise,1), UBOUND(InData%SumSpecNoise,1) - ReKiBuf(Re_Xferred) = InData%SumSpecNoise(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SumSpecNoiseSep) ) 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%SumSpecNoiseSep,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoiseSep,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoiseSep,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoiseSep,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoiseSep,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoiseSep,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SumSpecNoiseSep,3), UBOUND(InData%SumSpecNoiseSep,3) - DO i2 = LBOUND(InData%SumSpecNoiseSep,2), UBOUND(InData%SumSpecNoiseSep,2) - DO i1 = LBOUND(InData%SumSpecNoiseSep,1), UBOUND(InData%SumSpecNoiseSep,1) - ReKiBuf(Re_Xferred) = InData%SumSpecNoiseSep(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OASPL) ) 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%OASPL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%OASPL,3), UBOUND(InData%OASPL,3) - DO i2 = LBOUND(InData%OASPL,2), UBOUND(InData%OASPL,2) - DO i1 = LBOUND(InData%OASPL,1), UBOUND(InData%OASPL,1) - ReKiBuf(Re_Xferred) = InData%OASPL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OASPL_Mech) ) 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%OASPL_Mech,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL_Mech,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL_Mech,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL_Mech,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%OASPL_Mech,4), UBOUND(InData%OASPL_Mech,4) - DO i3 = LBOUND(InData%OASPL_Mech,3), UBOUND(InData%OASPL_Mech,3) - DO i2 = LBOUND(InData%OASPL_Mech,2), UBOUND(InData%OASPL_Mech,2) - DO i1 = LBOUND(InData%OASPL_Mech,1), UBOUND(InData%OASPL_Mech,1) - ReKiBuf(Re_Xferred) = InData%OASPL_Mech(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DirectiviOutput) ) 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%DirectiviOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DirectiviOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DirectiviOutput,1), UBOUND(InData%DirectiviOutput,1) - ReKiBuf(Re_Xferred) = InData%DirectiviOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutLECoords) ) 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%OutLECoords,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutLECoords,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutLECoords,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutLECoords,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%OutLECoords,4), UBOUND(InData%OutLECoords,4) - DO i3 = LBOUND(InData%OutLECoords,3), UBOUND(InData%OutLECoords,3) - DO i2 = LBOUND(InData%OutLECoords,2), UBOUND(InData%OutLECoords,2) - DO i1 = LBOUND(InData%OutLECoords,1), UBOUND(InData%OutLECoords,1) - ReKiBuf(Re_Xferred) = InData%OutLECoords(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtotalFreq) ) 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%PtotalFreq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtotalFreq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtotalFreq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtotalFreq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PtotalFreq,2), UBOUND(InData%PtotalFreq,2) - DO i1 = LBOUND(InData%PtotalFreq,1), UBOUND(InData%PtotalFreq,1) - ReKiBuf(Re_Xferred) = InData%PtotalFreq(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputForPE) ) 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%WriteOutputForPE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputForPE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputForPE,1), UBOUND(InData%WriteOutputForPE,1) - ReKiBuf(Re_Xferred) = InData%WriteOutputForPE(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 - IF ( .NOT. ALLOCATED(InData%WriteOutputSep) ) 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%WriteOutputSep,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputSep,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputSep,1), UBOUND(InData%WriteOutputSep,1) - ReKiBuf(Re_Xferred) = InData%WriteOutputSep(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputNode) ) 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%WriteOutputNode,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputNode,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputNode,1), UBOUND(InData%WriteOutputNode,1) - ReKiBuf(Re_Xferred) = InData%WriteOutputNode(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AA_PackOutput - - SUBROUTINE AA_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(AA_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) :: 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_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 ! SumSpecNoise 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%SumSpecNoise)) DEALLOCATE(OutData%SumSpecNoise) - ALLOCATE(OutData%SumSpecNoise(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%SumSpecNoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SumSpecNoise,3), UBOUND(OutData%SumSpecNoise,3) - DO i2 = LBOUND(OutData%SumSpecNoise,2), UBOUND(OutData%SumSpecNoise,2) - DO i1 = LBOUND(OutData%SumSpecNoise,1), UBOUND(OutData%SumSpecNoise,1) - OutData%SumSpecNoise(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SumSpecNoiseSep 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%SumSpecNoiseSep)) DEALLOCATE(OutData%SumSpecNoiseSep) - ALLOCATE(OutData%SumSpecNoiseSep(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%SumSpecNoiseSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SumSpecNoiseSep,3), UBOUND(OutData%SumSpecNoiseSep,3) - DO i2 = LBOUND(OutData%SumSpecNoiseSep,2), UBOUND(OutData%SumSpecNoiseSep,2) - DO i1 = LBOUND(OutData%SumSpecNoiseSep,1), UBOUND(OutData%SumSpecNoiseSep,1) - OutData%SumSpecNoiseSep(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OASPL 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%OASPL)) DEALLOCATE(OutData%OASPL) - ALLOCATE(OutData%OASPL(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%OASPL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%OASPL,3), UBOUND(OutData%OASPL,3) - DO i2 = LBOUND(OutData%OASPL,2), UBOUND(OutData%OASPL,2) - DO i1 = LBOUND(OutData%OASPL,1), UBOUND(OutData%OASPL,1) - OutData%OASPL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OASPL_Mech 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%OASPL_Mech)) DEALLOCATE(OutData%OASPL_Mech) - ALLOCATE(OutData%OASPL_Mech(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%OASPL_Mech.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%OASPL_Mech,4), UBOUND(OutData%OASPL_Mech,4) - DO i3 = LBOUND(OutData%OASPL_Mech,3), UBOUND(OutData%OASPL_Mech,3) - DO i2 = LBOUND(OutData%OASPL_Mech,2), UBOUND(OutData%OASPL_Mech,2) - DO i1 = LBOUND(OutData%OASPL_Mech,1), UBOUND(OutData%OASPL_Mech,1) - OutData%OASPL_Mech(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DirectiviOutput 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%DirectiviOutput)) DEALLOCATE(OutData%DirectiviOutput) - ALLOCATE(OutData%DirectiviOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DirectiviOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DirectiviOutput,1), UBOUND(OutData%DirectiviOutput,1) - OutData%DirectiviOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutLECoords 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%OutLECoords)) DEALLOCATE(OutData%OutLECoords) - ALLOCATE(OutData%OutLECoords(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%OutLECoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%OutLECoords,4), UBOUND(OutData%OutLECoords,4) - DO i3 = LBOUND(OutData%OutLECoords,3), UBOUND(OutData%OutLECoords,3) - DO i2 = LBOUND(OutData%OutLECoords,2), UBOUND(OutData%OutLECoords,2) - DO i1 = LBOUND(OutData%OutLECoords,1), UBOUND(OutData%OutLECoords,1) - OutData%OutLECoords(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtotalFreq 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%PtotalFreq)) DEALLOCATE(OutData%PtotalFreq) - ALLOCATE(OutData%PtotalFreq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtotalFreq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PtotalFreq,2), UBOUND(OutData%PtotalFreq,2) - DO i1 = LBOUND(OutData%PtotalFreq,1), UBOUND(OutData%PtotalFreq,1) - OutData%PtotalFreq(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputForPE 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%WriteOutputForPE)) DEALLOCATE(OutData%WriteOutputForPE) - ALLOCATE(OutData%WriteOutputForPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputForPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputForPE,1), UBOUND(OutData%WriteOutputForPE,1) - OutData%WriteOutputForPE(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputSep 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%WriteOutputSep)) DEALLOCATE(OutData%WriteOutputSep) - ALLOCATE(OutData%WriteOutputSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputSep,1), UBOUND(OutData%WriteOutputSep,1) - OutData%WriteOutputSep(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputNode 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%WriteOutputNode)) DEALLOCATE(OutData%WriteOutputNode) - ALLOCATE(OutData%WriteOutputNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputNode,1), UBOUND(OutData%WriteOutputNode,1) - OutData%WriteOutputNode(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AA_UnPackOutput - + ErrMsg = '' + if (allocated(SrcDiscStateData%MeanVrel)) then + LB(1:2) = lbound(SrcDiscStateData%MeanVrel) + UB(1:2) = ubound(SrcDiscStateData%MeanVrel) + if (.not. allocated(DstDiscStateData%MeanVrel)) then + allocate(DstDiscStateData%MeanVrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%MeanVrel = SrcDiscStateData%MeanVrel + end if + if (allocated(SrcDiscStateData%VrelSq)) then + LB(1:2) = lbound(SrcDiscStateData%VrelSq) + UB(1:2) = ubound(SrcDiscStateData%VrelSq) + if (.not. allocated(DstDiscStateData%VrelSq)) then + allocate(DstDiscStateData%VrelSq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelSq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%VrelSq = SrcDiscStateData%VrelSq + end if + if (allocated(SrcDiscStateData%TIVrel)) then + LB(1:2) = lbound(SrcDiscStateData%TIVrel) + UB(1:2) = ubound(SrcDiscStateData%TIVrel) + if (.not. allocated(DstDiscStateData%TIVrel)) then + allocate(DstDiscStateData%TIVrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%TIVrel = SrcDiscStateData%TIVrel + end if + if (allocated(SrcDiscStateData%VrelStore)) then + LB(1:3) = lbound(SrcDiscStateData%VrelStore) + UB(1:3) = ubound(SrcDiscStateData%VrelStore) + if (.not. allocated(DstDiscStateData%VrelStore)) then + allocate(DstDiscStateData%VrelStore(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelStore.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%VrelStore = SrcDiscStateData%VrelStore + end if + if (allocated(SrcDiscStateData%TIVx)) then + LB(1:2) = lbound(SrcDiscStateData%TIVx) + UB(1:2) = ubound(SrcDiscStateData%TIVx) + if (.not. allocated(DstDiscStateData%TIVx)) then + allocate(DstDiscStateData%TIVx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%TIVx = SrcDiscStateData%TIVx + end if + if (allocated(SrcDiscStateData%MeanVxVyVz)) then + LB(1:2) = lbound(SrcDiscStateData%MeanVxVyVz) + UB(1:2) = ubound(SrcDiscStateData%MeanVxVyVz) + if (.not. allocated(DstDiscStateData%MeanVxVyVz)) then + allocate(DstDiscStateData%MeanVxVyVz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVxVyVz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%MeanVxVyVz = SrcDiscStateData%MeanVxVyVz + end if + if (allocated(SrcDiscStateData%VxSq)) then + LB(1:2) = lbound(SrcDiscStateData%VxSq) + UB(1:2) = ubound(SrcDiscStateData%VxSq) + if (.not. allocated(DstDiscStateData%VxSq)) then + allocate(DstDiscStateData%VxSq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%VxSq = SrcDiscStateData%VxSq + end if + if (allocated(SrcDiscStateData%allregcounter)) then + LB(1:2) = lbound(SrcDiscStateData%allregcounter) + UB(1:2) = ubound(SrcDiscStateData%allregcounter) + if (.not. allocated(DstDiscStateData%allregcounter)) then + allocate(DstDiscStateData%allregcounter(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%allregcounter.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%allregcounter = SrcDiscStateData%allregcounter + end if + if (allocated(SrcDiscStateData%VxSqRegion)) then + LB(1:2) = lbound(SrcDiscStateData%VxSqRegion) + UB(1:2) = ubound(SrcDiscStateData%VxSqRegion) + if (.not. allocated(DstDiscStateData%VxSqRegion)) then + allocate(DstDiscStateData%VxSqRegion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSqRegion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%VxSqRegion = SrcDiscStateData%VxSqRegion + end if + if (allocated(SrcDiscStateData%RegVxStor)) then + LB(1:3) = lbound(SrcDiscStateData%RegVxStor) + UB(1:3) = ubound(SrcDiscStateData%RegVxStor) + if (.not. allocated(DstDiscStateData%RegVxStor)) then + allocate(DstDiscStateData%RegVxStor(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegVxStor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%RegVxStor = SrcDiscStateData%RegVxStor + end if + if (allocated(SrcDiscStateData%RegionTIDelete)) then + LB(1:2) = lbound(SrcDiscStateData%RegionTIDelete) + UB(1:2) = ubound(SrcDiscStateData%RegionTIDelete) + if (.not. allocated(DstDiscStateData%RegionTIDelete)) then + allocate(DstDiscStateData%RegionTIDelete(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegionTIDelete.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%RegionTIDelete = SrcDiscStateData%RegionTIDelete + end if +end subroutine + +subroutine AA_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(AA_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%MeanVrel)) then + deallocate(DiscStateData%MeanVrel) + end if + if (allocated(DiscStateData%VrelSq)) then + deallocate(DiscStateData%VrelSq) + end if + if (allocated(DiscStateData%TIVrel)) then + deallocate(DiscStateData%TIVrel) + end if + if (allocated(DiscStateData%VrelStore)) then + deallocate(DiscStateData%VrelStore) + end if + if (allocated(DiscStateData%TIVx)) then + deallocate(DiscStateData%TIVx) + end if + if (allocated(DiscStateData%MeanVxVyVz)) then + deallocate(DiscStateData%MeanVxVyVz) + end if + if (allocated(DiscStateData%VxSq)) then + deallocate(DiscStateData%VxSq) + end if + if (allocated(DiscStateData%allregcounter)) then + deallocate(DiscStateData%allregcounter) + end if + if (allocated(DiscStateData%VxSqRegion)) then + deallocate(DiscStateData%VxSqRegion) + end if + if (allocated(DiscStateData%RegVxStor)) then + deallocate(DiscStateData%RegVxStor) + end if + if (allocated(DiscStateData%RegionTIDelete)) then + deallocate(DiscStateData%RegionTIDelete) + end if +end subroutine + +subroutine AA_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%MeanVrel)) + if (allocated(InData%MeanVrel)) then + call RegPackBounds(Buf, 2, lbound(InData%MeanVrel), ubound(InData%MeanVrel)) + call RegPack(Buf, InData%MeanVrel) + end if + call RegPack(Buf, allocated(InData%VrelSq)) + if (allocated(InData%VrelSq)) then + call RegPackBounds(Buf, 2, lbound(InData%VrelSq), ubound(InData%VrelSq)) + call RegPack(Buf, InData%VrelSq) + end if + call RegPack(Buf, allocated(InData%TIVrel)) + if (allocated(InData%TIVrel)) then + call RegPackBounds(Buf, 2, lbound(InData%TIVrel), ubound(InData%TIVrel)) + call RegPack(Buf, InData%TIVrel) + end if + call RegPack(Buf, allocated(InData%VrelStore)) + if (allocated(InData%VrelStore)) then + call RegPackBounds(Buf, 3, lbound(InData%VrelStore), ubound(InData%VrelStore)) + call RegPack(Buf, InData%VrelStore) + end if + call RegPack(Buf, allocated(InData%TIVx)) + if (allocated(InData%TIVx)) then + call RegPackBounds(Buf, 2, lbound(InData%TIVx), ubound(InData%TIVx)) + call RegPack(Buf, InData%TIVx) + end if + call RegPack(Buf, allocated(InData%MeanVxVyVz)) + if (allocated(InData%MeanVxVyVz)) then + call RegPackBounds(Buf, 2, lbound(InData%MeanVxVyVz), ubound(InData%MeanVxVyVz)) + call RegPack(Buf, InData%MeanVxVyVz) + end if + call RegPack(Buf, allocated(InData%VxSq)) + if (allocated(InData%VxSq)) then + call RegPackBounds(Buf, 2, lbound(InData%VxSq), ubound(InData%VxSq)) + call RegPack(Buf, InData%VxSq) + end if + call RegPack(Buf, allocated(InData%allregcounter)) + if (allocated(InData%allregcounter)) then + call RegPackBounds(Buf, 2, lbound(InData%allregcounter), ubound(InData%allregcounter)) + call RegPack(Buf, InData%allregcounter) + end if + call RegPack(Buf, allocated(InData%VxSqRegion)) + if (allocated(InData%VxSqRegion)) then + call RegPackBounds(Buf, 2, lbound(InData%VxSqRegion), ubound(InData%VxSqRegion)) + call RegPack(Buf, InData%VxSqRegion) + end if + call RegPack(Buf, allocated(InData%RegVxStor)) + if (allocated(InData%RegVxStor)) then + call RegPackBounds(Buf, 3, lbound(InData%RegVxStor), ubound(InData%RegVxStor)) + call RegPack(Buf, InData%RegVxStor) + end if + call RegPack(Buf, allocated(InData%RegionTIDelete)) + if (allocated(InData%RegionTIDelete)) then + call RegPackBounds(Buf, 2, lbound(InData%RegionTIDelete), ubound(InData%RegionTIDelete)) + call RegPack(Buf, InData%RegionTIDelete) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackDiscState' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%MeanVrel)) deallocate(OutData%MeanVrel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MeanVrel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeanVrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MeanVrel) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%VrelSq)) deallocate(OutData%VrelSq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VrelSq(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VrelSq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VrelSq) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TIVrel)) deallocate(OutData%TIVrel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TIVrel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIVrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TIVrel) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%VrelStore)) deallocate(OutData%VrelStore) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VrelStore(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VrelStore.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VrelStore) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TIVx)) deallocate(OutData%TIVx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TIVx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIVx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TIVx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MeanVxVyVz)) deallocate(OutData%MeanVxVyVz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MeanVxVyVz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeanVxVyVz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MeanVxVyVz) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%VxSq)) deallocate(OutData%VxSq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VxSq(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VxSq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VxSq) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%allregcounter)) deallocate(OutData%allregcounter) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%allregcounter(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%allregcounter.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%allregcounter) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%VxSqRegion)) deallocate(OutData%VxSqRegion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VxSqRegion(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VxSqRegion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VxSqRegion) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RegVxStor)) deallocate(OutData%RegVxStor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RegVxStor(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegVxStor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RegVxStor) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RegionTIDelete)) deallocate(OutData%RegionTIDelete) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RegionTIDelete(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegionTIDelete.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RegionTIDelete) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AA_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(AA_ConstraintStateType), intent(in) :: SrcConstrStateData + type(AA_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine AA_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(AA_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AA_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(AA_OtherStateType), intent(in) :: SrcOtherStateData + type(AA_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +subroutine AA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(AA_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AA_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(AA_MiscVarType), intent(in) :: SrcMiscData + type(AA_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AA_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + end if + if (allocated(SrcMiscData%ChordAngleTE)) then + LB(1:3) = lbound(SrcMiscData%ChordAngleTE) + UB(1:3) = ubound(SrcMiscData%ChordAngleTE) + if (.not. allocated(DstMiscData%ChordAngleTE)) then + allocate(DstMiscData%ChordAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleTE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ChordAngleTE = SrcMiscData%ChordAngleTE + end if + if (allocated(SrcMiscData%SpanAngleTE)) then + LB(1:3) = lbound(SrcMiscData%SpanAngleTE) + UB(1:3) = ubound(SrcMiscData%SpanAngleTE) + if (.not. allocated(DstMiscData%SpanAngleTE)) then + allocate(DstMiscData%SpanAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleTE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SpanAngleTE = SrcMiscData%SpanAngleTE + end if + if (allocated(SrcMiscData%ChordAngleLE)) then + LB(1:3) = lbound(SrcMiscData%ChordAngleLE) + UB(1:3) = ubound(SrcMiscData%ChordAngleLE) + if (.not. allocated(DstMiscData%ChordAngleLE)) then + allocate(DstMiscData%ChordAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleLE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ChordAngleLE = SrcMiscData%ChordAngleLE + end if + if (allocated(SrcMiscData%SpanAngleLE)) then + LB(1:3) = lbound(SrcMiscData%SpanAngleLE) + UB(1:3) = ubound(SrcMiscData%SpanAngleLE) + if (.not. allocated(DstMiscData%SpanAngleLE)) then + allocate(DstMiscData%SpanAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleLE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SpanAngleLE = SrcMiscData%SpanAngleLE + end if + if (allocated(SrcMiscData%rTEtoObserve)) then + LB(1:3) = lbound(SrcMiscData%rTEtoObserve) + UB(1:3) = ubound(SrcMiscData%rTEtoObserve) + if (.not. allocated(DstMiscData%rTEtoObserve)) then + allocate(DstMiscData%rTEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rTEtoObserve.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rTEtoObserve = SrcMiscData%rTEtoObserve + end if + if (allocated(SrcMiscData%rLEtoObserve)) then + LB(1:3) = lbound(SrcMiscData%rLEtoObserve) + UB(1:3) = ubound(SrcMiscData%rLEtoObserve) + if (.not. allocated(DstMiscData%rLEtoObserve)) then + allocate(DstMiscData%rLEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rLEtoObserve.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rLEtoObserve = SrcMiscData%rLEtoObserve + end if + if (allocated(SrcMiscData%LE_Location)) then + LB(1:3) = lbound(SrcMiscData%LE_Location) + UB(1:3) = ubound(SrcMiscData%LE_Location) + if (.not. allocated(DstMiscData%LE_Location)) then + allocate(DstMiscData%LE_Location(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LE_Location.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LE_Location = SrcMiscData%LE_Location + end if + DstMiscData%RotSpeedAoA = SrcMiscData%RotSpeedAoA + if (allocated(SrcMiscData%SPLLBL)) then + LB(1:1) = lbound(SrcMiscData%SPLLBL) + UB(1:1) = ubound(SrcMiscData%SPLLBL) + if (.not. allocated(DstMiscData%SPLLBL)) then + allocate(DstMiscData%SPLLBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLLBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLLBL = SrcMiscData%SPLLBL + end if + if (allocated(SrcMiscData%SPLP)) then + LB(1:1) = lbound(SrcMiscData%SPLP) + UB(1:1) = ubound(SrcMiscData%SPLP) + if (.not. allocated(DstMiscData%SPLP)) then + allocate(DstMiscData%SPLP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLP = SrcMiscData%SPLP + end if + if (allocated(SrcMiscData%SPLS)) then + LB(1:1) = lbound(SrcMiscData%SPLS) + UB(1:1) = ubound(SrcMiscData%SPLS) + if (.not. allocated(DstMiscData%SPLS)) then + allocate(DstMiscData%SPLS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLS = SrcMiscData%SPLS + end if + if (allocated(SrcMiscData%SPLALPH)) then + LB(1:1) = lbound(SrcMiscData%SPLALPH) + UB(1:1) = ubound(SrcMiscData%SPLALPH) + if (.not. allocated(DstMiscData%SPLALPH)) then + allocate(DstMiscData%SPLALPH(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLALPH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLALPH = SrcMiscData%SPLALPH + end if + if (allocated(SrcMiscData%SPLTBL)) then + LB(1:1) = lbound(SrcMiscData%SPLTBL) + UB(1:1) = ubound(SrcMiscData%SPLTBL) + if (.not. allocated(DstMiscData%SPLTBL)) then + allocate(DstMiscData%SPLTBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLTBL = SrcMiscData%SPLTBL + end if + if (allocated(SrcMiscData%SPLTIP)) then + LB(1:1) = lbound(SrcMiscData%SPLTIP) + UB(1:1) = ubound(SrcMiscData%SPLTIP) + if (.not. allocated(DstMiscData%SPLTIP)) then + allocate(DstMiscData%SPLTIP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTIP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLTIP = SrcMiscData%SPLTIP + end if + if (allocated(SrcMiscData%SPLTI)) then + LB(1:1) = lbound(SrcMiscData%SPLTI) + UB(1:1) = ubound(SrcMiscData%SPLTI) + if (.not. allocated(DstMiscData%SPLTI)) then + allocate(DstMiscData%SPLTI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLTI = SrcMiscData%SPLTI + end if + if (allocated(SrcMiscData%SPLTIGui)) then + LB(1:1) = lbound(SrcMiscData%SPLTIGui) + UB(1:1) = ubound(SrcMiscData%SPLTIGui) + if (.not. allocated(DstMiscData%SPLTIGui)) then + allocate(DstMiscData%SPLTIGui(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTIGui.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLTIGui = SrcMiscData%SPLTIGui + end if + if (allocated(SrcMiscData%SPLBLUNT)) then + LB(1:1) = lbound(SrcMiscData%SPLBLUNT) + UB(1:1) = ubound(SrcMiscData%SPLBLUNT) + if (.not. allocated(DstMiscData%SPLBLUNT)) then + allocate(DstMiscData%SPLBLUNT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLBLUNT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLBLUNT = SrcMiscData%SPLBLUNT + end if + if (allocated(SrcMiscData%CfVar)) then + LB(1:1) = lbound(SrcMiscData%CfVar) + UB(1:1) = ubound(SrcMiscData%CfVar) + if (.not. allocated(DstMiscData%CfVar)) then + allocate(DstMiscData%CfVar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CfVar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CfVar = SrcMiscData%CfVar + end if + if (allocated(SrcMiscData%d99Var)) then + LB(1:1) = lbound(SrcMiscData%d99Var) + UB(1:1) = ubound(SrcMiscData%d99Var) + if (.not. allocated(DstMiscData%d99Var)) then + allocate(DstMiscData%d99Var(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%d99Var.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%d99Var = SrcMiscData%d99Var + end if + if (allocated(SrcMiscData%dStarVar)) then + LB(1:1) = lbound(SrcMiscData%dStarVar) + UB(1:1) = ubound(SrcMiscData%dStarVar) + if (.not. allocated(DstMiscData%dStarVar)) then + allocate(DstMiscData%dStarVar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dStarVar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dStarVar = SrcMiscData%dStarVar + end if + if (allocated(SrcMiscData%EdgeVelVar)) then + LB(1:1) = lbound(SrcMiscData%EdgeVelVar) + UB(1:1) = ubound(SrcMiscData%EdgeVelVar) + if (.not. allocated(DstMiscData%EdgeVelVar)) then + allocate(DstMiscData%EdgeVelVar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%EdgeVelVar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%EdgeVelVar = SrcMiscData%EdgeVelVar + end if + DstMiscData%speccou = SrcMiscData%speccou + DstMiscData%filesopen = SrcMiscData%filesopen +end subroutine + +subroutine AA_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(AA_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%ChordAngleTE)) then + deallocate(MiscData%ChordAngleTE) + end if + if (allocated(MiscData%SpanAngleTE)) then + deallocate(MiscData%SpanAngleTE) + end if + if (allocated(MiscData%ChordAngleLE)) then + deallocate(MiscData%ChordAngleLE) + end if + if (allocated(MiscData%SpanAngleLE)) then + deallocate(MiscData%SpanAngleLE) + end if + if (allocated(MiscData%rTEtoObserve)) then + deallocate(MiscData%rTEtoObserve) + end if + if (allocated(MiscData%rLEtoObserve)) then + deallocate(MiscData%rLEtoObserve) + end if + if (allocated(MiscData%LE_Location)) then + deallocate(MiscData%LE_Location) + end if + if (allocated(MiscData%SPLLBL)) then + deallocate(MiscData%SPLLBL) + end if + if (allocated(MiscData%SPLP)) then + deallocate(MiscData%SPLP) + end if + if (allocated(MiscData%SPLS)) then + deallocate(MiscData%SPLS) + end if + if (allocated(MiscData%SPLALPH)) then + deallocate(MiscData%SPLALPH) + end if + if (allocated(MiscData%SPLTBL)) then + deallocate(MiscData%SPLTBL) + end if + if (allocated(MiscData%SPLTIP)) then + deallocate(MiscData%SPLTIP) + end if + if (allocated(MiscData%SPLTI)) then + deallocate(MiscData%SPLTI) + end if + if (allocated(MiscData%SPLTIGui)) then + deallocate(MiscData%SPLTIGui) + end if + if (allocated(MiscData%SPLBLUNT)) then + deallocate(MiscData%SPLBLUNT) + end if + if (allocated(MiscData%CfVar)) then + deallocate(MiscData%CfVar) + end if + if (allocated(MiscData%d99Var)) then + deallocate(MiscData%d99Var) + end if + if (allocated(MiscData%dStarVar)) then + deallocate(MiscData%dStarVar) + end if + if (allocated(MiscData%EdgeVelVar)) then + deallocate(MiscData%EdgeVelVar) + end if +end subroutine + +subroutine AA_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + call RegPack(Buf, allocated(InData%ChordAngleTE)) + if (allocated(InData%ChordAngleTE)) then + call RegPackBounds(Buf, 3, lbound(InData%ChordAngleTE), ubound(InData%ChordAngleTE)) + call RegPack(Buf, InData%ChordAngleTE) + end if + call RegPack(Buf, allocated(InData%SpanAngleTE)) + if (allocated(InData%SpanAngleTE)) then + call RegPackBounds(Buf, 3, lbound(InData%SpanAngleTE), ubound(InData%SpanAngleTE)) + call RegPack(Buf, InData%SpanAngleTE) + end if + call RegPack(Buf, allocated(InData%ChordAngleLE)) + if (allocated(InData%ChordAngleLE)) then + call RegPackBounds(Buf, 3, lbound(InData%ChordAngleLE), ubound(InData%ChordAngleLE)) + call RegPack(Buf, InData%ChordAngleLE) + end if + call RegPack(Buf, allocated(InData%SpanAngleLE)) + if (allocated(InData%SpanAngleLE)) then + call RegPackBounds(Buf, 3, lbound(InData%SpanAngleLE), ubound(InData%SpanAngleLE)) + call RegPack(Buf, InData%SpanAngleLE) + end if + call RegPack(Buf, allocated(InData%rTEtoObserve)) + if (allocated(InData%rTEtoObserve)) then + call RegPackBounds(Buf, 3, lbound(InData%rTEtoObserve), ubound(InData%rTEtoObserve)) + call RegPack(Buf, InData%rTEtoObserve) + end if + call RegPack(Buf, allocated(InData%rLEtoObserve)) + if (allocated(InData%rLEtoObserve)) then + call RegPackBounds(Buf, 3, lbound(InData%rLEtoObserve), ubound(InData%rLEtoObserve)) + call RegPack(Buf, InData%rLEtoObserve) + end if + call RegPack(Buf, allocated(InData%LE_Location)) + if (allocated(InData%LE_Location)) then + call RegPackBounds(Buf, 3, lbound(InData%LE_Location), ubound(InData%LE_Location)) + call RegPack(Buf, InData%LE_Location) + end if + call RegPack(Buf, InData%RotSpeedAoA) + call RegPack(Buf, allocated(InData%SPLLBL)) + if (allocated(InData%SPLLBL)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLLBL), ubound(InData%SPLLBL)) + call RegPack(Buf, InData%SPLLBL) + end if + call RegPack(Buf, allocated(InData%SPLP)) + if (allocated(InData%SPLP)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLP), ubound(InData%SPLP)) + call RegPack(Buf, InData%SPLP) + end if + call RegPack(Buf, allocated(InData%SPLS)) + if (allocated(InData%SPLS)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLS), ubound(InData%SPLS)) + call RegPack(Buf, InData%SPLS) + end if + call RegPack(Buf, allocated(InData%SPLALPH)) + if (allocated(InData%SPLALPH)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLALPH), ubound(InData%SPLALPH)) + call RegPack(Buf, InData%SPLALPH) + end if + call RegPack(Buf, allocated(InData%SPLTBL)) + if (allocated(InData%SPLTBL)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLTBL), ubound(InData%SPLTBL)) + call RegPack(Buf, InData%SPLTBL) + end if + call RegPack(Buf, allocated(InData%SPLTIP)) + if (allocated(InData%SPLTIP)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLTIP), ubound(InData%SPLTIP)) + call RegPack(Buf, InData%SPLTIP) + end if + call RegPack(Buf, allocated(InData%SPLTI)) + if (allocated(InData%SPLTI)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLTI), ubound(InData%SPLTI)) + call RegPack(Buf, InData%SPLTI) + end if + call RegPack(Buf, allocated(InData%SPLTIGui)) + if (allocated(InData%SPLTIGui)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLTIGui), ubound(InData%SPLTIGui)) + call RegPack(Buf, InData%SPLTIGui) + end if + call RegPack(Buf, allocated(InData%SPLBLUNT)) + if (allocated(InData%SPLBLUNT)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLBLUNT), ubound(InData%SPLBLUNT)) + call RegPack(Buf, InData%SPLBLUNT) + end if + call RegPack(Buf, allocated(InData%CfVar)) + if (allocated(InData%CfVar)) then + call RegPackBounds(Buf, 1, lbound(InData%CfVar), ubound(InData%CfVar)) + call RegPack(Buf, InData%CfVar) + end if + call RegPack(Buf, allocated(InData%d99Var)) + if (allocated(InData%d99Var)) then + call RegPackBounds(Buf, 1, lbound(InData%d99Var), ubound(InData%d99Var)) + call RegPack(Buf, InData%d99Var) + end if + call RegPack(Buf, allocated(InData%dStarVar)) + if (allocated(InData%dStarVar)) then + call RegPackBounds(Buf, 1, lbound(InData%dStarVar), ubound(InData%dStarVar)) + call RegPack(Buf, InData%dStarVar) + end if + call RegPack(Buf, allocated(InData%EdgeVelVar)) + if (allocated(InData%EdgeVelVar)) then + call RegPackBounds(Buf, 1, lbound(InData%EdgeVelVar), ubound(InData%EdgeVelVar)) + call RegPack(Buf, InData%EdgeVelVar) + end if + call RegPack(Buf, InData%speccou) + call RegPack(Buf, InData%filesopen) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackMisc' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ChordAngleTE)) deallocate(OutData%ChordAngleTE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ChordAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChordAngleTE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ChordAngleTE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SpanAngleTE)) deallocate(OutData%SpanAngleTE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SpanAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SpanAngleTE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SpanAngleTE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ChordAngleLE)) deallocate(OutData%ChordAngleLE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ChordAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChordAngleLE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ChordAngleLE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SpanAngleLE)) deallocate(OutData%SpanAngleLE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SpanAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SpanAngleLE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SpanAngleLE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rTEtoObserve)) deallocate(OutData%rTEtoObserve) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rTEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rTEtoObserve.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rTEtoObserve) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rLEtoObserve)) deallocate(OutData%rLEtoObserve) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rLEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLEtoObserve.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rLEtoObserve) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LE_Location)) deallocate(OutData%LE_Location) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LE_Location(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LE_Location.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LE_Location) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%RotSpeedAoA) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%SPLLBL)) deallocate(OutData%SPLLBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLLBL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLLBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLLBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SPLP)) deallocate(OutData%SPLP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SPLS)) deallocate(OutData%SPLS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SPLALPH)) deallocate(OutData%SPLALPH) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLALPH(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLALPH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLALPH) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SPLTBL)) deallocate(OutData%SPLTBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLTBL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLTBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SPLTIP)) deallocate(OutData%SPLTIP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLTIP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTIP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLTIP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SPLTI)) deallocate(OutData%SPLTI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLTI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLTI) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SPLTIGui)) deallocate(OutData%SPLTIGui) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLTIGui(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTIGui.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLTIGui) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SPLBLUNT)) deallocate(OutData%SPLBLUNT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLBLUNT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLBLUNT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLBLUNT) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CfVar)) deallocate(OutData%CfVar) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CfVar(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfVar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CfVar) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%d99Var)) deallocate(OutData%d99Var) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%d99Var(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99Var.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%d99Var) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dStarVar)) deallocate(OutData%dStarVar) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dStarVar(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarVar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dStarVar) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%EdgeVelVar)) deallocate(OutData%EdgeVelVar) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%EdgeVelVar(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelVar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%EdgeVelVar) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%speccou) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%filesopen) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AA_ParameterType), intent(in) :: SrcParamData + type(AA_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%IBLUNT = SrcParamData%IBLUNT + DstParamData%ILAM = SrcParamData%ILAM + DstParamData%ITIP = SrcParamData%ITIP + DstParamData%ITRIP = SrcParamData%ITRIP + DstParamData%ITURB = SrcParamData%ITURB + DstParamData%IInflow = SrcParamData%IInflow + DstParamData%X_BLMethod = SrcParamData%X_BLMethod + DstParamData%TICalcMeth = SrcParamData%TICalcMeth + DstParamData%ROUND = SrcParamData%ROUND + DstParamData%ALPRAT = SrcParamData%ALPRAT + DstParamData%NumBlades = SrcParamData%NumBlades + DstParamData%NumBlNds = SrcParamData%NumBlNds + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%KinVisc = SrcParamData%KinVisc + DstParamData%SpdSound = SrcParamData%SpdSound + DstParamData%HubHeight = SrcParamData%HubHeight + DstParamData%toptip = SrcParamData%toptip + DstParamData%bottip = SrcParamData%bottip + if (allocated(SrcParamData%rotorregionlimitsVert)) then + LB(1:1) = lbound(SrcParamData%rotorregionlimitsVert) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsVert) + if (.not. allocated(DstParamData%rotorregionlimitsVert)) then + allocate(DstParamData%rotorregionlimitsVert(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsVert.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert + end if + if (allocated(SrcParamData%rotorregionlimitsHorz)) then + LB(1:1) = lbound(SrcParamData%rotorregionlimitsHorz) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsHorz) + if (.not. allocated(DstParamData%rotorregionlimitsHorz)) then + allocate(DstParamData%rotorregionlimitsHorz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsHorz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz + end if + if (allocated(SrcParamData%rotorregionlimitsalph)) then + LB(1:1) = lbound(SrcParamData%rotorregionlimitsalph) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsalph) + if (.not. allocated(DstParamData%rotorregionlimitsalph)) then + allocate(DstParamData%rotorregionlimitsalph(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsalph.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph + end if + if (allocated(SrcParamData%rotorregionlimitsrad)) then + LB(1:1) = lbound(SrcParamData%rotorregionlimitsrad) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsrad) + if (.not. allocated(DstParamData%rotorregionlimitsrad)) then + allocate(DstParamData%rotorregionlimitsrad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsrad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rotorregionlimitsrad = SrcParamData%rotorregionlimitsrad + end if + DstParamData%NrObsLoc = SrcParamData%NrObsLoc + DstParamData%aweightflag = SrcParamData%aweightflag + DstParamData%TxtFileOutput = SrcParamData%TxtFileOutput + DstParamData%AAStart = SrcParamData%AAStart + if (allocated(SrcParamData%ObsX)) then + LB(1:1) = lbound(SrcParamData%ObsX) + UB(1:1) = ubound(SrcParamData%ObsX) + if (.not. allocated(DstParamData%ObsX)) then + allocate(DstParamData%ObsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ObsX = SrcParamData%ObsX + end if + if (allocated(SrcParamData%ObsY)) then + LB(1:1) = lbound(SrcParamData%ObsY) + UB(1:1) = ubound(SrcParamData%ObsY) + if (.not. allocated(DstParamData%ObsY)) then + allocate(DstParamData%ObsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ObsY = SrcParamData%ObsY + end if + if (allocated(SrcParamData%ObsZ)) then + LB(1:1) = lbound(SrcParamData%ObsZ) + UB(1:1) = ubound(SrcParamData%ObsZ) + if (.not. allocated(DstParamData%ObsZ)) then + allocate(DstParamData%ObsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ObsZ = SrcParamData%ObsZ + end if + if (allocated(SrcParamData%FreqList)) then + LB(1:1) = lbound(SrcParamData%FreqList) + UB(1:1) = ubound(SrcParamData%FreqList) + if (.not. allocated(DstParamData%FreqList)) then + allocate(DstParamData%FreqList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FreqList = SrcParamData%FreqList + end if + if (allocated(SrcParamData%Aweight)) then + LB(1:1) = lbound(SrcParamData%Aweight) + UB(1:1) = ubound(SrcParamData%Aweight) + if (.not. allocated(DstParamData%Aweight)) then + allocate(DstParamData%Aweight(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Aweight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Aweight = SrcParamData%Aweight + end if + DstParamData%Fsample = SrcParamData%Fsample + DstParamData%total_sample = SrcParamData%total_sample + DstParamData%total_sampleTI = SrcParamData%total_sampleTI + DstParamData%AA_Bl_Prcntge = SrcParamData%AA_Bl_Prcntge + DstParamData%startnode = SrcParamData%startnode + DstParamData%Lturb = SrcParamData%Lturb + DstParamData%AvgV = SrcParamData%AvgV + DstParamData%dz_turb_in = SrcParamData%dz_turb_in + DstParamData%dy_turb_in = SrcParamData%dy_turb_in + if (allocated(SrcParamData%TI_Grid_In)) then + LB(1:2) = lbound(SrcParamData%TI_Grid_In) + UB(1:2) = ubound(SrcParamData%TI_Grid_In) + if (.not. allocated(DstParamData%TI_Grid_In)) then + allocate(DstParamData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI_Grid_In.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TI_Grid_In = SrcParamData%TI_Grid_In + end if + DstParamData%FTitle = SrcParamData%FTitle + DstParamData%outFmt = SrcParamData%outFmt + DstParamData%NrOutFile = SrcParamData%NrOutFile + DstParamData%delim = SrcParamData%delim + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumOutsForPE = SrcParamData%NumOutsForPE + DstParamData%NumOutsForSep = SrcParamData%NumOutsForSep + DstParamData%NumOutsForNodes = SrcParamData%NumOutsForNodes + DstParamData%unOutFile = SrcParamData%unOutFile + DstParamData%unOutFile2 = SrcParamData%unOutFile2 + DstParamData%unOutFile3 = SrcParamData%unOutFile3 + DstParamData%unOutFile4 = SrcParamData%unOutFile4 + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + if (allocated(SrcParamData%StallStart)) then + LB(1:2) = lbound(SrcParamData%StallStart) + UB(1:2) = ubound(SrcParamData%StallStart) + if (.not. allocated(DstParamData%StallStart)) then + allocate(DstParamData%StallStart(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StallStart.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StallStart = SrcParamData%StallStart + end if + if (allocated(SrcParamData%TEThick)) then + LB(1:2) = lbound(SrcParamData%TEThick) + UB(1:2) = ubound(SrcParamData%TEThick) + if (.not. allocated(DstParamData%TEThick)) then + allocate(DstParamData%TEThick(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEThick.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TEThick = SrcParamData%TEThick + end if + if (allocated(SrcParamData%TEAngle)) then + LB(1:2) = lbound(SrcParamData%TEAngle) + UB(1:2) = ubound(SrcParamData%TEAngle) + if (.not. allocated(DstParamData%TEAngle)) then + allocate(DstParamData%TEAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEAngle.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TEAngle = SrcParamData%TEAngle + end if + if (allocated(SrcParamData%AerCent)) then + LB(1:3) = lbound(SrcParamData%AerCent) + UB(1:3) = ubound(SrcParamData%AerCent) + if (.not. allocated(DstParamData%AerCent)) then + allocate(DstParamData%AerCent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AerCent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AerCent = SrcParamData%AerCent + end if + if (allocated(SrcParamData%BlAFID)) then + LB(1:2) = lbound(SrcParamData%BlAFID) + UB(1:2) = ubound(SrcParamData%BlAFID) + if (.not. allocated(DstParamData%BlAFID)) then + allocate(DstParamData%BlAFID(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlAFID.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BlAFID = SrcParamData%BlAFID + end if + if (allocated(SrcParamData%AFInfo)) then + LB(1:1) = lbound(SrcParamData%AFInfo) + UB(1:1) = ubound(SrcParamData%AFInfo) + if (.not. allocated(DstParamData%AFInfo)) then + allocate(DstParamData%AFInfo(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFInfo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AFI_CopyParam(SrcParamData%AFInfo(i1), DstParamData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%AFLECo)) then + LB(1:3) = lbound(SrcParamData%AFLECo) + UB(1:3) = ubound(SrcParamData%AFLECo) + if (.not. allocated(DstParamData%AFLECo)) then + allocate(DstParamData%AFLECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFLECo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AFLECo = SrcParamData%AFLECo + end if + if (allocated(SrcParamData%AFTECo)) then + LB(1:3) = lbound(SrcParamData%AFTECo) + UB(1:3) = ubound(SrcParamData%AFTECo) + if (.not. allocated(DstParamData%AFTECo)) then + allocate(DstParamData%AFTECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFTECo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AFTECo = SrcParamData%AFTECo + end if + if (allocated(SrcParamData%BlSpn)) then + LB(1:2) = lbound(SrcParamData%BlSpn) + UB(1:2) = ubound(SrcParamData%BlSpn) + if (.not. allocated(DstParamData%BlSpn)) then + allocate(DstParamData%BlSpn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlSpn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BlSpn = SrcParamData%BlSpn + end if + if (allocated(SrcParamData%BlChord)) then + LB(1:2) = lbound(SrcParamData%BlChord) + UB(1:2) = ubound(SrcParamData%BlChord) + if (.not. allocated(DstParamData%BlChord)) then + allocate(DstParamData%BlChord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlChord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BlChord = SrcParamData%BlChord + end if + if (allocated(SrcParamData%ReListBL)) then + LB(1:1) = lbound(SrcParamData%ReListBL) + UB(1:1) = ubound(SrcParamData%ReListBL) + if (.not. allocated(DstParamData%ReListBL)) then + allocate(DstParamData%ReListBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ReListBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ReListBL = SrcParamData%ReListBL + end if + if (allocated(SrcParamData%AOAListBL)) then + LB(1:1) = lbound(SrcParamData%AOAListBL) + UB(1:1) = ubound(SrcParamData%AOAListBL) + if (.not. allocated(DstParamData%AOAListBL)) then + allocate(DstParamData%AOAListBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AOAListBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AOAListBL = SrcParamData%AOAListBL + end if + if (allocated(SrcParamData%dStarAll1)) then + LB(1:3) = lbound(SrcParamData%dStarAll1) + UB(1:3) = ubound(SrcParamData%dStarAll1) + if (.not. allocated(DstParamData%dStarAll1)) then + allocate(DstParamData%dStarAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dStarAll1 = SrcParamData%dStarAll1 + end if + if (allocated(SrcParamData%dStarAll2)) then + LB(1:3) = lbound(SrcParamData%dStarAll2) + UB(1:3) = ubound(SrcParamData%dStarAll2) + if (.not. allocated(DstParamData%dStarAll2)) then + allocate(DstParamData%dStarAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dStarAll2 = SrcParamData%dStarAll2 + end if + if (allocated(SrcParamData%d99All1)) then + LB(1:3) = lbound(SrcParamData%d99All1) + UB(1:3) = ubound(SrcParamData%d99All1) + if (.not. allocated(DstParamData%d99All1)) then + allocate(DstParamData%d99All1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%d99All1 = SrcParamData%d99All1 + end if + if (allocated(SrcParamData%d99All2)) then + LB(1:3) = lbound(SrcParamData%d99All2) + UB(1:3) = ubound(SrcParamData%d99All2) + if (.not. allocated(DstParamData%d99All2)) then + allocate(DstParamData%d99All2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%d99All2 = SrcParamData%d99All2 + end if + if (allocated(SrcParamData%CfAll1)) then + LB(1:3) = lbound(SrcParamData%CfAll1) + UB(1:3) = ubound(SrcParamData%CfAll1) + if (.not. allocated(DstParamData%CfAll1)) then + allocate(DstParamData%CfAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CfAll1 = SrcParamData%CfAll1 + end if + if (allocated(SrcParamData%CfAll2)) then + LB(1:3) = lbound(SrcParamData%CfAll2) + UB(1:3) = ubound(SrcParamData%CfAll2) + if (.not. allocated(DstParamData%CfAll2)) then + allocate(DstParamData%CfAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CfAll2 = SrcParamData%CfAll2 + end if + if (allocated(SrcParamData%EdgeVelRat1)) then + LB(1:3) = lbound(SrcParamData%EdgeVelRat1) + UB(1:3) = ubound(SrcParamData%EdgeVelRat1) + if (.not. allocated(DstParamData%EdgeVelRat1)) then + allocate(DstParamData%EdgeVelRat1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%EdgeVelRat1 = SrcParamData%EdgeVelRat1 + end if + if (allocated(SrcParamData%EdgeVelRat2)) then + LB(1:3) = lbound(SrcParamData%EdgeVelRat2) + UB(1:3) = ubound(SrcParamData%EdgeVelRat2) + if (.not. allocated(DstParamData%EdgeVelRat2)) then + allocate(DstParamData%EdgeVelRat2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%EdgeVelRat2 = SrcParamData%EdgeVelRat2 + end if + if (allocated(SrcParamData%AFThickGuida)) then + LB(1:2) = lbound(SrcParamData%AFThickGuida) + UB(1:2) = ubound(SrcParamData%AFThickGuida) + if (.not. allocated(DstParamData%AFThickGuida)) then + allocate(DstParamData%AFThickGuida(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFThickGuida.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AFThickGuida = SrcParamData%AFThickGuida + end if +end subroutine + +subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AA_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%rotorregionlimitsVert)) then + deallocate(ParamData%rotorregionlimitsVert) + end if + if (allocated(ParamData%rotorregionlimitsHorz)) then + deallocate(ParamData%rotorregionlimitsHorz) + end if + if (allocated(ParamData%rotorregionlimitsalph)) then + deallocate(ParamData%rotorregionlimitsalph) + end if + if (allocated(ParamData%rotorregionlimitsrad)) then + deallocate(ParamData%rotorregionlimitsrad) + end if + if (allocated(ParamData%ObsX)) then + deallocate(ParamData%ObsX) + end if + if (allocated(ParamData%ObsY)) then + deallocate(ParamData%ObsY) + end if + if (allocated(ParamData%ObsZ)) then + deallocate(ParamData%ObsZ) + end if + if (allocated(ParamData%FreqList)) then + deallocate(ParamData%FreqList) + end if + if (allocated(ParamData%Aweight)) then + deallocate(ParamData%Aweight) + end if + if (allocated(ParamData%TI_Grid_In)) then + deallocate(ParamData%TI_Grid_In) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%StallStart)) then + deallocate(ParamData%StallStart) + end if + if (allocated(ParamData%TEThick)) then + deallocate(ParamData%TEThick) + end if + if (allocated(ParamData%TEAngle)) then + deallocate(ParamData%TEAngle) + end if + if (allocated(ParamData%AerCent)) then + deallocate(ParamData%AerCent) + end if + if (allocated(ParamData%BlAFID)) then + deallocate(ParamData%BlAFID) + end if + if (allocated(ParamData%AFInfo)) then + LB(1:1) = lbound(ParamData%AFInfo) + UB(1:1) = ubound(ParamData%AFInfo) + do i1 = LB(1), UB(1) + call AFI_DestroyParam(ParamData%AFInfo(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%AFInfo) + end if + if (allocated(ParamData%AFLECo)) then + deallocate(ParamData%AFLECo) + end if + if (allocated(ParamData%AFTECo)) then + deallocate(ParamData%AFTECo) + end if + if (allocated(ParamData%BlSpn)) then + deallocate(ParamData%BlSpn) + end if + if (allocated(ParamData%BlChord)) then + deallocate(ParamData%BlChord) + end if + if (allocated(ParamData%ReListBL)) then + deallocate(ParamData%ReListBL) + end if + if (allocated(ParamData%AOAListBL)) then + deallocate(ParamData%AOAListBL) + end if + if (allocated(ParamData%dStarAll1)) then + deallocate(ParamData%dStarAll1) + end if + if (allocated(ParamData%dStarAll2)) then + deallocate(ParamData%dStarAll2) + end if + if (allocated(ParamData%d99All1)) then + deallocate(ParamData%d99All1) + end if + if (allocated(ParamData%d99All2)) then + deallocate(ParamData%d99All2) + end if + if (allocated(ParamData%CfAll1)) then + deallocate(ParamData%CfAll1) + end if + if (allocated(ParamData%CfAll2)) then + deallocate(ParamData%CfAll2) + end if + if (allocated(ParamData%EdgeVelRat1)) then + deallocate(ParamData%EdgeVelRat1) + end if + if (allocated(ParamData%EdgeVelRat2)) then + deallocate(ParamData%EdgeVelRat2) + end if + if (allocated(ParamData%AFThickGuida)) then + deallocate(ParamData%AFThickGuida) + end if +end subroutine + +subroutine AA_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%IBLUNT) + call RegPack(Buf, InData%ILAM) + call RegPack(Buf, InData%ITIP) + call RegPack(Buf, InData%ITRIP) + call RegPack(Buf, InData%ITURB) + call RegPack(Buf, InData%IInflow) + call RegPack(Buf, InData%X_BLMethod) + call RegPack(Buf, InData%TICalcMeth) + call RegPack(Buf, InData%ROUND) + call RegPack(Buf, InData%ALPRAT) + call RegPack(Buf, InData%NumBlades) + call RegPack(Buf, InData%NumBlNds) + call RegPack(Buf, InData%AirDens) + call RegPack(Buf, InData%KinVisc) + call RegPack(Buf, InData%SpdSound) + call RegPack(Buf, InData%HubHeight) + call RegPack(Buf, InData%toptip) + call RegPack(Buf, InData%bottip) + call RegPack(Buf, allocated(InData%rotorregionlimitsVert)) + if (allocated(InData%rotorregionlimitsVert)) then + call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsVert), ubound(InData%rotorregionlimitsVert)) + call RegPack(Buf, InData%rotorregionlimitsVert) + end if + call RegPack(Buf, allocated(InData%rotorregionlimitsHorz)) + if (allocated(InData%rotorregionlimitsHorz)) then + call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsHorz), ubound(InData%rotorregionlimitsHorz)) + call RegPack(Buf, InData%rotorregionlimitsHorz) + end if + call RegPack(Buf, allocated(InData%rotorregionlimitsalph)) + if (allocated(InData%rotorregionlimitsalph)) then + call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsalph), ubound(InData%rotorregionlimitsalph)) + call RegPack(Buf, InData%rotorregionlimitsalph) + end if + call RegPack(Buf, allocated(InData%rotorregionlimitsrad)) + if (allocated(InData%rotorregionlimitsrad)) then + call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsrad), ubound(InData%rotorregionlimitsrad)) + call RegPack(Buf, InData%rotorregionlimitsrad) + end if + call RegPack(Buf, InData%NrObsLoc) + call RegPack(Buf, InData%aweightflag) + call RegPack(Buf, InData%TxtFileOutput) + call RegPack(Buf, InData%AAStart) + call RegPack(Buf, allocated(InData%ObsX)) + if (allocated(InData%ObsX)) then + call RegPackBounds(Buf, 1, lbound(InData%ObsX), ubound(InData%ObsX)) + call RegPack(Buf, InData%ObsX) + end if + call RegPack(Buf, allocated(InData%ObsY)) + if (allocated(InData%ObsY)) then + call RegPackBounds(Buf, 1, lbound(InData%ObsY), ubound(InData%ObsY)) + call RegPack(Buf, InData%ObsY) + end if + call RegPack(Buf, allocated(InData%ObsZ)) + if (allocated(InData%ObsZ)) then + call RegPackBounds(Buf, 1, lbound(InData%ObsZ), ubound(InData%ObsZ)) + call RegPack(Buf, InData%ObsZ) + end if + call RegPack(Buf, allocated(InData%FreqList)) + if (allocated(InData%FreqList)) then + call RegPackBounds(Buf, 1, lbound(InData%FreqList), ubound(InData%FreqList)) + call RegPack(Buf, InData%FreqList) + end if + call RegPack(Buf, allocated(InData%Aweight)) + if (allocated(InData%Aweight)) then + call RegPackBounds(Buf, 1, lbound(InData%Aweight), ubound(InData%Aweight)) + call RegPack(Buf, InData%Aweight) + end if + call RegPack(Buf, InData%Fsample) + call RegPack(Buf, InData%total_sample) + call RegPack(Buf, InData%total_sampleTI) + call RegPack(Buf, InData%AA_Bl_Prcntge) + call RegPack(Buf, InData%startnode) + call RegPack(Buf, InData%Lturb) + call RegPack(Buf, InData%AvgV) + call RegPack(Buf, InData%dz_turb_in) + call RegPack(Buf, InData%dy_turb_in) + call RegPack(Buf, allocated(InData%TI_Grid_In)) + if (allocated(InData%TI_Grid_In)) then + call RegPackBounds(Buf, 2, lbound(InData%TI_Grid_In), ubound(InData%TI_Grid_In)) + call RegPack(Buf, InData%TI_Grid_In) + end if + call RegPack(Buf, InData%FTitle) + call RegPack(Buf, InData%outFmt) + call RegPack(Buf, InData%NrOutFile) + call RegPack(Buf, InData%delim) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%NumOutsForPE) + call RegPack(Buf, InData%NumOutsForSep) + call RegPack(Buf, InData%NumOutsForNodes) + call RegPack(Buf, InData%unOutFile) + call RegPack(Buf, InData%unOutFile2) + call RegPack(Buf, InData%unOutFile3) + call RegPack(Buf, InData%unOutFile4) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + call RegPack(Buf, allocated(InData%StallStart)) + if (allocated(InData%StallStart)) then + call RegPackBounds(Buf, 2, lbound(InData%StallStart), ubound(InData%StallStart)) + call RegPack(Buf, InData%StallStart) + end if + call RegPack(Buf, allocated(InData%TEThick)) + if (allocated(InData%TEThick)) then + call RegPackBounds(Buf, 2, lbound(InData%TEThick), ubound(InData%TEThick)) + call RegPack(Buf, InData%TEThick) + end if + call RegPack(Buf, allocated(InData%TEAngle)) + if (allocated(InData%TEAngle)) then + call RegPackBounds(Buf, 2, lbound(InData%TEAngle), ubound(InData%TEAngle)) + call RegPack(Buf, InData%TEAngle) + end if + call RegPack(Buf, allocated(InData%AerCent)) + if (allocated(InData%AerCent)) then + call RegPackBounds(Buf, 3, lbound(InData%AerCent), ubound(InData%AerCent)) + call RegPack(Buf, InData%AerCent) + end if + call RegPack(Buf, allocated(InData%BlAFID)) + if (allocated(InData%BlAFID)) then + call RegPackBounds(Buf, 2, lbound(InData%BlAFID), ubound(InData%BlAFID)) + call RegPack(Buf, InData%BlAFID) + end if + call RegPack(Buf, allocated(InData%AFInfo)) + if (allocated(InData%AFInfo)) then + call RegPackBounds(Buf, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) + LB(1:1) = lbound(InData%AFInfo) + UB(1:1) = ubound(InData%AFInfo) + do i1 = LB(1), UB(1) + call AFI_PackParam(Buf, InData%AFInfo(i1)) + end do + end if + call RegPack(Buf, allocated(InData%AFLECo)) + if (allocated(InData%AFLECo)) then + call RegPackBounds(Buf, 3, lbound(InData%AFLECo), ubound(InData%AFLECo)) + call RegPack(Buf, InData%AFLECo) + end if + call RegPack(Buf, allocated(InData%AFTECo)) + if (allocated(InData%AFTECo)) then + call RegPackBounds(Buf, 3, lbound(InData%AFTECo), ubound(InData%AFTECo)) + call RegPack(Buf, InData%AFTECo) + end if + call RegPack(Buf, allocated(InData%BlSpn)) + if (allocated(InData%BlSpn)) then + call RegPackBounds(Buf, 2, lbound(InData%BlSpn), ubound(InData%BlSpn)) + call RegPack(Buf, InData%BlSpn) + end if + call RegPack(Buf, allocated(InData%BlChord)) + if (allocated(InData%BlChord)) then + call RegPackBounds(Buf, 2, lbound(InData%BlChord), ubound(InData%BlChord)) + call RegPack(Buf, InData%BlChord) + end if + call RegPack(Buf, allocated(InData%ReListBL)) + if (allocated(InData%ReListBL)) then + call RegPackBounds(Buf, 1, lbound(InData%ReListBL), ubound(InData%ReListBL)) + call RegPack(Buf, InData%ReListBL) + end if + call RegPack(Buf, allocated(InData%AOAListBL)) + if (allocated(InData%AOAListBL)) then + call RegPackBounds(Buf, 1, lbound(InData%AOAListBL), ubound(InData%AOAListBL)) + call RegPack(Buf, InData%AOAListBL) + end if + call RegPack(Buf, allocated(InData%dStarAll1)) + if (allocated(InData%dStarAll1)) then + call RegPackBounds(Buf, 3, lbound(InData%dStarAll1), ubound(InData%dStarAll1)) + call RegPack(Buf, InData%dStarAll1) + end if + call RegPack(Buf, allocated(InData%dStarAll2)) + if (allocated(InData%dStarAll2)) then + call RegPackBounds(Buf, 3, lbound(InData%dStarAll2), ubound(InData%dStarAll2)) + call RegPack(Buf, InData%dStarAll2) + end if + call RegPack(Buf, allocated(InData%d99All1)) + if (allocated(InData%d99All1)) then + call RegPackBounds(Buf, 3, lbound(InData%d99All1), ubound(InData%d99All1)) + call RegPack(Buf, InData%d99All1) + end if + call RegPack(Buf, allocated(InData%d99All2)) + if (allocated(InData%d99All2)) then + call RegPackBounds(Buf, 3, lbound(InData%d99All2), ubound(InData%d99All2)) + call RegPack(Buf, InData%d99All2) + end if + call RegPack(Buf, allocated(InData%CfAll1)) + if (allocated(InData%CfAll1)) then + call RegPackBounds(Buf, 3, lbound(InData%CfAll1), ubound(InData%CfAll1)) + call RegPack(Buf, InData%CfAll1) + end if + call RegPack(Buf, allocated(InData%CfAll2)) + if (allocated(InData%CfAll2)) then + call RegPackBounds(Buf, 3, lbound(InData%CfAll2), ubound(InData%CfAll2)) + call RegPack(Buf, InData%CfAll2) + end if + call RegPack(Buf, allocated(InData%EdgeVelRat1)) + if (allocated(InData%EdgeVelRat1)) then + call RegPackBounds(Buf, 3, lbound(InData%EdgeVelRat1), ubound(InData%EdgeVelRat1)) + call RegPack(Buf, InData%EdgeVelRat1) + end if + call RegPack(Buf, allocated(InData%EdgeVelRat2)) + if (allocated(InData%EdgeVelRat2)) then + call RegPackBounds(Buf, 3, lbound(InData%EdgeVelRat2), ubound(InData%EdgeVelRat2)) + call RegPack(Buf, InData%EdgeVelRat2) + end if + call RegPack(Buf, allocated(InData%AFThickGuida)) + if (allocated(InData%AFThickGuida)) then + call RegPackBounds(Buf, 2, lbound(InData%AFThickGuida), ubound(InData%AFThickGuida)) + call RegPack(Buf, InData%AFThickGuida) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IBLUNT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ILAM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ITIP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ITRIP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ITURB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IInflow) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%X_BLMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TICalcMeth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ROUND) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ALPRAT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBlNds) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubHeight) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%toptip) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%bottip) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%rotorregionlimitsVert)) deallocate(OutData%rotorregionlimitsVert) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotorregionlimitsVert(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsVert.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rotorregionlimitsVert) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rotorregionlimitsHorz)) deallocate(OutData%rotorregionlimitsHorz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotorregionlimitsHorz(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsHorz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rotorregionlimitsHorz) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rotorregionlimitsalph)) deallocate(OutData%rotorregionlimitsalph) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotorregionlimitsalph(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsalph.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rotorregionlimitsalph) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rotorregionlimitsrad)) deallocate(OutData%rotorregionlimitsrad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotorregionlimitsrad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsrad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rotorregionlimitsrad) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NrObsLoc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%aweightflag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TxtFileOutput) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AAStart) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ObsX)) deallocate(OutData%ObsX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ObsX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ObsX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ObsY)) deallocate(OutData%ObsY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ObsY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ObsY) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ObsZ)) deallocate(OutData%ObsZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ObsZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ObsZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FreqList)) deallocate(OutData%FreqList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FreqList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FreqList) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Aweight)) deallocate(OutData%Aweight) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Aweight(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aweight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Aweight) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Fsample) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%total_sample) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%total_sampleTI) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AA_Bl_Prcntge) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%startnode) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Lturb) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AvgV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dz_turb_in) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dy_turb_in) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TI_Grid_In)) deallocate(OutData%TI_Grid_In) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_Grid_In.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TI_Grid_In) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%FTitle) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%outFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NrOutFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%delim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOutsForPE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOutsForSep) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOutsForNodes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%unOutFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%unOutFile2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%unOutFile3) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%unOutFile4) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + if (allocated(OutData%StallStart)) deallocate(OutData%StallStart) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StallStart(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StallStart.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StallStart) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TEThick)) deallocate(OutData%TEThick) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TEThick(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEThick.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TEThick) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TEAngle)) deallocate(OutData%TEAngle) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TEAngle(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEAngle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TEAngle) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AerCent)) deallocate(OutData%AerCent) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AerCent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AerCent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AerCent) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlAFID)) deallocate(OutData%BlAFID) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlAFID(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlAFID) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AFInfo)) deallocate(OutData%AFInfo) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFInfo(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AFI_UnpackParam(Buf, OutData%AFInfo(i1)) ! AFInfo + end do + end if + if (allocated(OutData%AFLECo)) deallocate(OutData%AFLECo) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFLECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFLECo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFLECo) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AFTECo)) deallocate(OutData%AFTECo) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFTECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFTECo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFTECo) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlSpn)) deallocate(OutData%BlSpn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlSpn(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlSpn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlChord)) deallocate(OutData%BlChord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlChord(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlChord) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ReListBL)) deallocate(OutData%ReListBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ReListBL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReListBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ReListBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AOAListBL)) deallocate(OutData%AOAListBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AOAListBL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOAListBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AOAListBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dStarAll1)) deallocate(OutData%dStarAll1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dStarAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarAll1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dStarAll1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dStarAll2)) deallocate(OutData%dStarAll2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dStarAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarAll2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dStarAll2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%d99All1)) deallocate(OutData%d99All1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%d99All1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99All1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%d99All1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%d99All2)) deallocate(OutData%d99All2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%d99All2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99All2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%d99All2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CfAll1)) deallocate(OutData%CfAll1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CfAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfAll1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CfAll1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CfAll2)) deallocate(OutData%CfAll2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CfAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfAll2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CfAll2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%EdgeVelRat1)) deallocate(OutData%EdgeVelRat1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%EdgeVelRat1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelRat1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%EdgeVelRat1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%EdgeVelRat2)) deallocate(OutData%EdgeVelRat2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%EdgeVelRat2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelRat2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%EdgeVelRat2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AFThickGuida)) deallocate(OutData%AFThickGuida) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFThickGuida(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFThickGuida.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFThickGuida) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AA_InputType), intent(in) :: SrcInputData + type(AA_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AA_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%RotGtoL)) then + LB(1:4) = lbound(SrcInputData%RotGtoL) + UB(1:4) = ubound(SrcInputData%RotGtoL) + if (.not. allocated(DstInputData%RotGtoL)) then + allocate(DstInputData%RotGtoL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%RotGtoL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%RotGtoL = SrcInputData%RotGtoL + end if + if (allocated(SrcInputData%AeroCent_G)) then + LB(1:3) = lbound(SrcInputData%AeroCent_G) + UB(1:3) = ubound(SrcInputData%AeroCent_G) + if (.not. allocated(DstInputData%AeroCent_G)) then + allocate(DstInputData%AeroCent_G(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AeroCent_G.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%AeroCent_G = SrcInputData%AeroCent_G + end if + if (allocated(SrcInputData%Vrel)) then + LB(1:2) = lbound(SrcInputData%Vrel) + UB(1:2) = ubound(SrcInputData%Vrel) + if (.not. allocated(DstInputData%Vrel)) then + allocate(DstInputData%Vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vrel = SrcInputData%Vrel + end if + if (allocated(SrcInputData%AoANoise)) then + LB(1:2) = lbound(SrcInputData%AoANoise) + UB(1:2) = ubound(SrcInputData%AoANoise) + if (.not. allocated(DstInputData%AoANoise)) then + allocate(DstInputData%AoANoise(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AoANoise.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%AoANoise = SrcInputData%AoANoise + end if + if (allocated(SrcInputData%Inflow)) then + LB(1:3) = lbound(SrcInputData%Inflow) + UB(1:3) = ubound(SrcInputData%Inflow) + if (.not. allocated(DstInputData%Inflow)) then + allocate(DstInputData%Inflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Inflow.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Inflow = SrcInputData%Inflow + end if +end subroutine + +subroutine AA_DestroyInput(InputData, ErrStat, ErrMsg) + type(AA_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%RotGtoL)) then + deallocate(InputData%RotGtoL) + end if + if (allocated(InputData%AeroCent_G)) then + deallocate(InputData%AeroCent_G) + end if + if (allocated(InputData%Vrel)) then + deallocate(InputData%Vrel) + end if + if (allocated(InputData%AoANoise)) then + deallocate(InputData%AoANoise) + end if + if (allocated(InputData%Inflow)) then + deallocate(InputData%Inflow) + end if +end subroutine + +subroutine AA_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%RotGtoL)) + if (allocated(InData%RotGtoL)) then + call RegPackBounds(Buf, 4, lbound(InData%RotGtoL), ubound(InData%RotGtoL)) + call RegPack(Buf, InData%RotGtoL) + end if + call RegPack(Buf, allocated(InData%AeroCent_G)) + if (allocated(InData%AeroCent_G)) then + call RegPackBounds(Buf, 3, lbound(InData%AeroCent_G), ubound(InData%AeroCent_G)) + call RegPack(Buf, InData%AeroCent_G) + end if + call RegPack(Buf, allocated(InData%Vrel)) + if (allocated(InData%Vrel)) then + call RegPackBounds(Buf, 2, lbound(InData%Vrel), ubound(InData%Vrel)) + call RegPack(Buf, InData%Vrel) + end if + call RegPack(Buf, allocated(InData%AoANoise)) + if (allocated(InData%AoANoise)) then + call RegPackBounds(Buf, 2, lbound(InData%AoANoise), ubound(InData%AoANoise)) + call RegPack(Buf, InData%AoANoise) + end if + call RegPack(Buf, allocated(InData%Inflow)) + if (allocated(InData%Inflow)) then + call RegPackBounds(Buf, 3, lbound(InData%Inflow), ubound(InData%Inflow)) + call RegPack(Buf, InData%Inflow) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackInput' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%RotGtoL)) deallocate(OutData%RotGtoL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotGtoL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotGtoL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotGtoL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AeroCent_G)) deallocate(OutData%AeroCent_G) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AeroCent_G(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroCent_G.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AeroCent_G) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vrel)) deallocate(OutData%Vrel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vrel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vrel) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AoANoise)) deallocate(OutData%AoANoise) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AoANoise(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AoANoise.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AoANoise) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Inflow)) deallocate(OutData%Inflow) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Inflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Inflow.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Inflow) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AA_OutputType), intent(in) :: SrcOutputData + type(AA_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AA_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%SumSpecNoise)) then + LB(1:3) = lbound(SrcOutputData%SumSpecNoise) + UB(1:3) = ubound(SrcOutputData%SumSpecNoise) + if (.not. allocated(DstOutputData%SumSpecNoise)) then + allocate(DstOutputData%SumSpecNoise(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoise.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%SumSpecNoise = SrcOutputData%SumSpecNoise + end if + if (allocated(SrcOutputData%SumSpecNoiseSep)) then + LB(1:3) = lbound(SrcOutputData%SumSpecNoiseSep) + UB(1:3) = ubound(SrcOutputData%SumSpecNoiseSep) + if (.not. allocated(DstOutputData%SumSpecNoiseSep)) then + allocate(DstOutputData%SumSpecNoiseSep(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoiseSep.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%SumSpecNoiseSep = SrcOutputData%SumSpecNoiseSep + end if + if (allocated(SrcOutputData%OASPL)) then + LB(1:3) = lbound(SrcOutputData%OASPL) + UB(1:3) = ubound(SrcOutputData%OASPL) + if (.not. allocated(DstOutputData%OASPL)) then + allocate(DstOutputData%OASPL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OASPL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%OASPL = SrcOutputData%OASPL + end if + if (allocated(SrcOutputData%OASPL_Mech)) then + LB(1:4) = lbound(SrcOutputData%OASPL_Mech) + UB(1:4) = ubound(SrcOutputData%OASPL_Mech) + if (.not. allocated(DstOutputData%OASPL_Mech)) then + allocate(DstOutputData%OASPL_Mech(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OASPL_Mech.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%OASPL_Mech = SrcOutputData%OASPL_Mech + end if + if (allocated(SrcOutputData%DirectiviOutput)) then + LB(1:1) = lbound(SrcOutputData%DirectiviOutput) + UB(1:1) = ubound(SrcOutputData%DirectiviOutput) + if (.not. allocated(DstOutputData%DirectiviOutput)) then + allocate(DstOutputData%DirectiviOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%DirectiviOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%DirectiviOutput = SrcOutputData%DirectiviOutput + end if + if (allocated(SrcOutputData%OutLECoords)) then + LB(1:4) = lbound(SrcOutputData%OutLECoords) + UB(1:4) = ubound(SrcOutputData%OutLECoords) + if (.not. allocated(DstOutputData%OutLECoords)) then + allocate(DstOutputData%OutLECoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OutLECoords.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%OutLECoords = SrcOutputData%OutLECoords + end if + if (allocated(SrcOutputData%PtotalFreq)) then + LB(1:2) = lbound(SrcOutputData%PtotalFreq) + UB(1:2) = ubound(SrcOutputData%PtotalFreq) + if (.not. allocated(DstOutputData%PtotalFreq)) then + allocate(DstOutputData%PtotalFreq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%PtotalFreq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%PtotalFreq = SrcOutputData%PtotalFreq + end if + if (allocated(SrcOutputData%WriteOutputForPE)) then + LB(1:1) = lbound(SrcOutputData%WriteOutputForPE) + UB(1:1) = ubound(SrcOutputData%WriteOutputForPE) + if (.not. allocated(DstOutputData%WriteOutputForPE)) then + allocate(DstOutputData%WriteOutputForPE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputForPE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutputForPE = SrcOutputData%WriteOutputForPE + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if + if (allocated(SrcOutputData%WriteOutputSep)) then + LB(1:1) = lbound(SrcOutputData%WriteOutputSep) + UB(1:1) = ubound(SrcOutputData%WriteOutputSep) + if (.not. allocated(DstOutputData%WriteOutputSep)) then + allocate(DstOutputData%WriteOutputSep(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputSep.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutputSep = SrcOutputData%WriteOutputSep + end if + if (allocated(SrcOutputData%WriteOutputNode)) then + LB(1:1) = lbound(SrcOutputData%WriteOutputNode) + UB(1:1) = ubound(SrcOutputData%WriteOutputNode) + if (.not. allocated(DstOutputData%WriteOutputNode)) then + allocate(DstOutputData%WriteOutputNode(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputNode.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutputNode = SrcOutputData%WriteOutputNode + end if +end subroutine + +subroutine AA_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AA_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%SumSpecNoise)) then + deallocate(OutputData%SumSpecNoise) + end if + if (allocated(OutputData%SumSpecNoiseSep)) then + deallocate(OutputData%SumSpecNoiseSep) + end if + if (allocated(OutputData%OASPL)) then + deallocate(OutputData%OASPL) + end if + if (allocated(OutputData%OASPL_Mech)) then + deallocate(OutputData%OASPL_Mech) + end if + if (allocated(OutputData%DirectiviOutput)) then + deallocate(OutputData%DirectiviOutput) + end if + if (allocated(OutputData%OutLECoords)) then + deallocate(OutputData%OutLECoords) + end if + if (allocated(OutputData%PtotalFreq)) then + deallocate(OutputData%PtotalFreq) + end if + if (allocated(OutputData%WriteOutputForPE)) then + deallocate(OutputData%WriteOutputForPE) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + if (allocated(OutputData%WriteOutputSep)) then + deallocate(OutputData%WriteOutputSep) + end if + if (allocated(OutputData%WriteOutputNode)) then + deallocate(OutputData%WriteOutputNode) + end if +end subroutine + +subroutine AA_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%SumSpecNoise)) + if (allocated(InData%SumSpecNoise)) then + call RegPackBounds(Buf, 3, lbound(InData%SumSpecNoise), ubound(InData%SumSpecNoise)) + call RegPack(Buf, InData%SumSpecNoise) + end if + call RegPack(Buf, allocated(InData%SumSpecNoiseSep)) + if (allocated(InData%SumSpecNoiseSep)) then + call RegPackBounds(Buf, 3, lbound(InData%SumSpecNoiseSep), ubound(InData%SumSpecNoiseSep)) + call RegPack(Buf, InData%SumSpecNoiseSep) + end if + call RegPack(Buf, allocated(InData%OASPL)) + if (allocated(InData%OASPL)) then + call RegPackBounds(Buf, 3, lbound(InData%OASPL), ubound(InData%OASPL)) + call RegPack(Buf, InData%OASPL) + end if + call RegPack(Buf, allocated(InData%OASPL_Mech)) + if (allocated(InData%OASPL_Mech)) then + call RegPackBounds(Buf, 4, lbound(InData%OASPL_Mech), ubound(InData%OASPL_Mech)) + call RegPack(Buf, InData%OASPL_Mech) + end if + call RegPack(Buf, allocated(InData%DirectiviOutput)) + if (allocated(InData%DirectiviOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%DirectiviOutput), ubound(InData%DirectiviOutput)) + call RegPack(Buf, InData%DirectiviOutput) + end if + call RegPack(Buf, allocated(InData%OutLECoords)) + if (allocated(InData%OutLECoords)) then + call RegPackBounds(Buf, 4, lbound(InData%OutLECoords), ubound(InData%OutLECoords)) + call RegPack(Buf, InData%OutLECoords) + end if + call RegPack(Buf, allocated(InData%PtotalFreq)) + if (allocated(InData%PtotalFreq)) then + call RegPackBounds(Buf, 2, lbound(InData%PtotalFreq), ubound(InData%PtotalFreq)) + call RegPack(Buf, InData%PtotalFreq) + end if + call RegPack(Buf, allocated(InData%WriteOutputForPE)) + if (allocated(InData%WriteOutputForPE)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputForPE), ubound(InData%WriteOutputForPE)) + call RegPack(Buf, InData%WriteOutputForPE) + end if + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + call RegPack(Buf, allocated(InData%WriteOutputSep)) + if (allocated(InData%WriteOutputSep)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputSep), ubound(InData%WriteOutputSep)) + call RegPack(Buf, InData%WriteOutputSep) + end if + call RegPack(Buf, allocated(InData%WriteOutputNode)) + if (allocated(InData%WriteOutputNode)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputNode), ubound(InData%WriteOutputNode)) + call RegPack(Buf, InData%WriteOutputNode) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackOutput' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%SumSpecNoise)) deallocate(OutData%SumSpecNoise) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SumSpecNoise(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SumSpecNoise.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SumSpecNoise) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SumSpecNoiseSep)) deallocate(OutData%SumSpecNoiseSep) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SumSpecNoiseSep(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SumSpecNoiseSep.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SumSpecNoiseSep) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OASPL)) deallocate(OutData%OASPL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OASPL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OASPL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OASPL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OASPL_Mech)) deallocate(OutData%OASPL_Mech) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OASPL_Mech(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OASPL_Mech.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OASPL_Mech) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DirectiviOutput)) deallocate(OutData%DirectiviOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DirectiviOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DirectiviOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DirectiviOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OutLECoords)) deallocate(OutData%OutLECoords) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutLECoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutLECoords.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutLECoords) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PtotalFreq)) deallocate(OutData%PtotalFreq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtotalFreq(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtotalFreq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtotalFreq) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputForPE)) deallocate(OutData%WriteOutputForPE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputForPE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputForPE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputForPE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputSep)) deallocate(OutData%WriteOutputSep) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputSep(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputSep.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputSep) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputNode)) deallocate(OutData%WriteOutputNode) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputNode(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputNode.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputNode) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine END MODULE AeroAcoustics_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 2982bfff30..5cfa46275a 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -37,39 +37,39 @@ MODULE AeroDyn_Driver_Types IMPLICIT NONE ! ========= Dvr_Case ======= TYPE, PUBLIC :: Dvr_Case - REAL(ReKi) :: HWindSpeed !< Hub wind speed [m/s] - REAL(ReKi) :: PLExp !< Power law wind-shear exponent [-] - REAL(ReKi) :: rotSpeed !< Rotor speed [rad/s] - REAL(ReKi) :: bldPitch !< Pitch angle [rad] - REAL(ReKi) :: nacYaw !< Yaw angle [rad] - REAL(DbKi) :: tMax !< Max time [s] - REAL(DbKi) :: dT !< time increment [s] - INTEGER(IntKi) :: numSteps !< number of steps in this case [-] - INTEGER(IntKi) :: DOF !< Degree of freedom for sinusoidal motion [-] - REAL(ReKi) :: amplitude !< Amplitude for sinusoidal motion (when DOF>0) [-] - REAL(ReKi) :: frequency !< Frequency for sinusoidal motion (when DOF>0) [-] + REAL(ReKi) :: HWindSpeed = 0.0_ReKi !< Hub wind speed [m/s] + REAL(ReKi) :: PLExp = 0.0_ReKi !< Power law wind-shear exponent [-] + REAL(ReKi) :: rotSpeed = 0.0_ReKi !< Rotor speed [rad/s] + REAL(ReKi) :: bldPitch = 0.0_ReKi !< Pitch angle [rad] + REAL(ReKi) :: nacYaw = 0.0_ReKi !< Yaw angle [rad] + REAL(DbKi) :: tMax = 0.0_R8Ki !< Max time [s] + REAL(DbKi) :: dT = 0.0_R8Ki !< time increment [s] + INTEGER(IntKi) :: numSteps = 0_IntKi !< number of steps in this case [-] + INTEGER(IntKi) :: DOF = 0_IntKi !< Degree of freedom for sinusoidal motion [-] + REAL(ReKi) :: amplitude = 0.0_ReKi !< Amplitude for sinusoidal motion (when DOF>0) [-] + REAL(ReKi) :: frequency = 0.0_ReKi !< Frequency for sinusoidal motion (when DOF>0) [-] END TYPE Dvr_Case ! ======================= ! ========= DvrVTK_SurfaceType ======= TYPE, PUBLIC :: DvrVTK_SurfaceType - INTEGER(IntKi) :: NumSectors !< number of sectors in which to split circles (higher number gives smoother surface) [-] - REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] - REAL(SiKi) , DIMENSION(1:3,1:8) :: BaseBox !< X-Y-Z locations of 8 points that define the base box [m] + INTEGER(IntKi) :: NumSectors = 0_IntKi !< number of sectors in which to split circles (higher number gives smoother surface) [-] + REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox = 0.0_R4Ki !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] + REAL(SiKi) , DIMENSION(1:3,1:8) :: BaseBox = 0.0_R4Ki !< X-Y-Z locations of 8 points that define the base box [m] END TYPE DvrVTK_SurfaceType ! ======================= ! ========= Dvr_Outputs ======= TYPE, PUBLIC :: Dvr_Outputs TYPE(ProgDesc) :: AD_ver !< AeroDyn version information [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: unOutFile !< unit number for writing output file for each rotor [-] - INTEGER(IntKi) :: ActualChanLen !< Actual length of channels written to text file (less than or equal to ChanLen) [-] - INTEGER(IntKi) :: nDvrOutputs !< Number of outputs for the driver (without AD and IW) [-] + INTEGER(IntKi) :: ActualChanLen = 0_IntKi !< Actual length of channels written to text file (less than or equal to ChanLen) [-] + INTEGER(IntKi) :: nDvrOutputs = 0_IntKi !< Number of outputs for the driver (without AD and IW) [-] character(20) :: Fmt_t !< Format specifier for time channel [-] character(25) :: Fmt_a !< Format specifier for each column (including delimiter) [-] character(1) :: delim !< column delimiter [-] character(20) :: outFmt !< Format specifier [-] - INTEGER(IntKi) :: fileFmt !< Output format 1=Text, 2=Binary, 3=Both [-] - INTEGER(IntKi) :: wrVTK !< 0= no vtk, 1=init only, 2=animation [-] - INTEGER(IntKi) :: WrVTK_Type !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] + INTEGER(IntKi) :: fileFmt = 0_IntKi !< Output format 1=Text, 2=Binary, 3=Both [-] + INTEGER(IntKi) :: wrVTK = 0_IntKi !< 0= no vtk, 1=init only, 2=animation [-] + INTEGER(IntKi) :: WrVTK_Type = 0_IntKi !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] character(1024) :: Root !< Output file rootname [-] character(1024) :: VTK_OutFileRoot !< Output file rootname for vtk [-] character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Channel headers [-] @@ -77,64 +77,64 @@ MODULE AeroDyn_Driver_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: storage !< nTurbines x nChannel x nTime [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: outLine !< Output line to be written to disk [-] TYPE(DvrVTK_SurfaceType) , DIMENSION(:), ALLOCATABLE :: VTK_surface !< Data for VTK surface visualization [-] - INTEGER(IntKi) :: VTK_tWidth !< Width of number of files for leading zeros in file name format [-] - INTEGER(IntKi) :: n_VTKTime !< Number of time steps between writing VTK files [-] - REAL(SiKi) :: VTKHubRad !< Hub radius for visualization [m] - REAL(ReKi) , DIMENSION(1:6) :: VTKNacDim !< Nacelle dimensions for visualization [m] - REAL(SiKi) , DIMENSION(1:3) :: VTKRefPoint !< RefPoint for VTK outputs [-] - REAL(DbKi) :: DT_Outs !< Output time resolution [s] - INTEGER(IntKi) :: n_DT_Out !< Number of time steps between writing a line in the time-marching output files [-] + INTEGER(IntKi) :: VTK_tWidth = 0_IntKi !< Width of number of files for leading zeros in file name format [-] + INTEGER(IntKi) :: n_VTKTime = 0_IntKi !< Number of time steps between writing VTK files [-] + REAL(SiKi) :: VTKHubRad = 0.0_R4Ki !< Hub radius for visualization [m] + REAL(ReKi) , DIMENSION(1:6) :: VTKNacDim = 0.0_ReKi !< Nacelle dimensions for visualization [m] + REAL(SiKi) , DIMENSION(1:3) :: VTKRefPoint = 0.0_R4Ki !< RefPoint for VTK outputs [-] + REAL(DbKi) :: DT_Outs = 0.0_R8Ki !< Output time resolution [s] + INTEGER(IntKi) :: n_DT_Out = 0_IntKi !< Number of time steps between writing a line in the time-marching output files [-] END TYPE Dvr_Outputs ! ======================= ! ========= BladeData ======= TYPE, PUBLIC :: BladeData - REAL(ReKi) :: pitch !< rad [-] - REAL(ReKi) :: pitchSpeed !< rad/s [-] - REAL(ReKi) :: pitchAcc !< rad/s/s [-] - REAL(ReKi) , DIMENSION(1:3) :: origin_h !< [-] - REAL(ReKi) , DIMENSION(1:3) :: orientation_h !< [-] - REAL(ReKi) :: hubRad_bl !< [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: Rh2bl0 !< Rotation matrix blade 2 hub [-] - INTEGER(IntKi) :: motionType !< [-] - INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] + REAL(ReKi) :: pitch = 0.0_ReKi !< rad [-] + REAL(ReKi) :: pitchSpeed = 0.0_ReKi !< rad/s [-] + REAL(ReKi) :: pitchAcc = 0.0_ReKi !< rad/s/s [-] + REAL(ReKi) , DIMENSION(1:3) :: origin_h = 0.0_ReKi !< [-] + REAL(ReKi) , DIMENSION(1:3) :: orientation_h = 0.0_ReKi !< [-] + REAL(ReKi) :: hubRad_bl = 0.0_ReKi !< [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: Rh2bl0 = 0.0_R8Ki !< Rotation matrix blade 2 hub [-] + INTEGER(IntKi) :: motionType = 0_IntKi !< [-] + INTEGER(IntKi) :: iMotion = 0_IntKi !< Stored index to optimize time interpolation [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] character(1024) :: motionFileName !< [-] END TYPE BladeData ! ======================= ! ========= HubData ======= TYPE, PUBLIC :: HubData - REAL(ReKi) , DIMENSION(1:3) :: origin_n !< [-] - REAL(ReKi) , DIMENSION(1:3) :: orientation_n !< [-] - INTEGER(IntKi) :: motionType !< [-] - INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] - REAL(ReKi) :: azimuth !< rotor position [rad] - REAL(ReKi) :: rotSpeed !< rotor speed [rad/s] - REAL(ReKi) :: rotAcc !< rotor acceleration [rad/s/s] + REAL(ReKi) , DIMENSION(1:3) :: origin_n = 0.0_ReKi !< [-] + REAL(ReKi) , DIMENSION(1:3) :: orientation_n = 0.0_ReKi !< [-] + INTEGER(IntKi) :: motionType = 0_IntKi !< [-] + INTEGER(IntKi) :: iMotion = 0_IntKi !< Stored index to optimize time interpolation [-] + REAL(ReKi) :: azimuth = 0.0_ReKi !< rotor position [rad] + REAL(ReKi) :: rotSpeed = 0.0_ReKi !< rotor speed [rad/s] + REAL(ReKi) :: rotAcc = 0.0_ReKi !< rotor acceleration [rad/s/s] character(1024) :: motionFileName !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] END TYPE HubData ! ======================= ! ========= NacData ======= TYPE, PUBLIC :: NacData - REAL(ReKi) , DIMENSION(1:3) :: origin_t !< [-] - INTEGER(IntKi) :: motionType !< [-] - INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] - REAL(ReKi) :: yaw !< rad [rad] - REAL(ReKi) :: yawSpeed !< yawspeed [rad/s] - REAL(ReKi) :: yawAcc !< yawAcceleration [rad/s^2] + REAL(ReKi) , DIMENSION(1:3) :: origin_t = 0.0_ReKi !< [-] + INTEGER(IntKi) :: motionType = 0_IntKi !< [-] + INTEGER(IntKi) :: iMotion = 0_IntKi !< Stored index to optimize time interpolation [-] + REAL(ReKi) :: yaw = 0.0_ReKi !< rad [rad] + REAL(ReKi) :: yawSpeed = 0.0_ReKi !< yawspeed [rad/s] + REAL(ReKi) :: yawAcc = 0.0_ReKi !< yawAcceleration [rad/s^2] character(1024) :: motionFileName !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] END TYPE NacData ! ======================= ! ========= TwrData ======= TYPE, PUBLIC :: TwrData - REAL(ReKi) , DIMENSION(1:3) :: origin_t !< [-] + REAL(ReKi) , DIMENSION(1:3) :: origin_t = 0.0_ReKi !< [-] END TYPE TwrData ! ======================= ! ========= WTData ======= TYPE, PUBLIC :: WTData - REAL(ReKi) , DIMENSION(1:3) :: originInit !< [-] - REAL(ReKi) , DIMENSION(1:3) :: orientationInit !< [-] + REAL(ReKi) , DIMENSION(1:3) :: originInit = 0.0_ReKi !< [-] + REAL(ReKi) , DIMENSION(1:3) :: orientationInit = 0.0_ReKi !< [-] TYPE(MeshMapType) :: map2twrPt !< Mesh mapping from base to tower [-] TYPE(MeshMapType) :: map2nacPt !< Mesh mapping from base to nacelle [-] TYPE(MeshMapType) :: map2hubPt !< Mesh mapping from Nacelle to hub [-] @@ -143,18 +143,18 @@ MODULE AeroDyn_Driver_Types TYPE(HubData) :: hub !< [-] TYPE(NacData) :: nac !< [-] TYPE(TwrData) :: twr !< [-] - INTEGER(IntKi) :: numBlades !< [-] - LOGICAL :: basicHAWTFormat !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] - LOGICAL :: hasTower !< [-] - INTEGER(IntKi) :: projMod !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] - INTEGER(IntKi) :: BEM_Mod !< Switch for different BEM implementations [-] - LOGICAL :: HAWTprojection !< [-] - INTEGER(IntKi) :: motionType !< [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< [-] + LOGICAL :: basicHAWTFormat = .false. !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] + LOGICAL :: hasTower = .false. !< [-] + INTEGER(IntKi) :: projMod = 0_IntKi !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] + INTEGER(IntKi) :: BEM_Mod = 0_IntKi !< Switch for different BEM implementations [-] + LOGICAL :: HAWTprojection = .false. !< [-] + INTEGER(IntKi) :: motionType = 0_IntKi !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] - INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] - INTEGER(IntKi) :: degreeOfFreedom !< [-] - REAL(ReKi) :: amplitude !< [-] - REAL(ReKi) :: frequency !< [-] + INTEGER(IntKi) :: iMotion = 0_IntKi !< Stored index to optimize time interpolation [-] + INTEGER(IntKi) :: degreeOfFreedom = 0_IntKi !< [-] + REAL(ReKi) :: amplitude = 0.0_ReKi !< [-] + REAL(ReKi) :: frequency = 0.0_ReKi !< [-] character(1024) :: motionFileName !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< WriteOutputs of the driver only [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: userSwapArray !< Array to store user data for user-defined functions [-] @@ -163,25 +163,25 @@ MODULE AeroDyn_Driver_Types ! ========= Dvr_SimData ======= TYPE, PUBLIC :: Dvr_SimData character(1024) :: AD_InputFile !< Name of AeroDyn input file [-] - INTEGER(IntKi) :: MHK !< MHK turbine type (switch) {0: not an MHK turbine, 1: fixed MHK turbine, 2: floating MHK turbine} [-] - INTEGER(IntKi) :: AnalysisType !< 0=Steady Wind, 1=InflowWind [-] - REAL(ReKi) :: FldDens !< Density of working fluid [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic viscosity of working fluid [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound in working fluid [m/s] - REAL(ReKi) :: Patm !< Atmospheric pressure [Pa] - REAL(ReKi) :: Pvap !< Vapour pressure of working fluid [Pa] - REAL(ReKi) :: WtrDpth !< Water depth [m] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] - INTEGER(IntKi) :: numTurbines !< number of blades on turbine [-] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type (switch) {0: not an MHK turbine, 1: fixed MHK turbine, 2: floating MHK turbine} [-] + INTEGER(IntKi) :: AnalysisType = 0_IntKi !< 0=Steady Wind, 1=InflowWind [-] + REAL(ReKi) :: FldDens = 0.0_ReKi !< Density of working fluid [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic viscosity of working fluid [m^2/s] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound in working fluid [m/s] + REAL(ReKi) :: Patm = 0.0_ReKi !< Atmospheric pressure [Pa] + REAL(ReKi) :: Pvap = 0.0_ReKi !< Vapour pressure of working fluid [Pa] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] + INTEGER(IntKi) :: numTurbines = 0_IntKi !< number of blades on turbine [-] TYPE(WTData) , DIMENSION(:), ALLOCATABLE :: WT !< Wind turbine data for driver [-] - REAL(DbKi) :: dT !< time increment [s] - REAL(DbKi) :: tMax !< time increment [s] - INTEGER(IntKi) :: numSteps !< number of steps in this case [-] - INTEGER(IntKi) :: numCases !< number of steps in this case [-] + REAL(DbKi) :: dT = 0.0_R8Ki !< time increment [s] + REAL(DbKi) :: tMax = 0.0_R8Ki !< time increment [s] + INTEGER(IntKi) :: numSteps = 0_IntKi !< number of steps in this case [-] + INTEGER(IntKi) :: numCases = 0_IntKi !< number of steps in this case [-] TYPE(Dvr_Case) , DIMENSION(:), ALLOCATABLE :: Cases !< table of cases to run when AnalysisType=2 [-] - INTEGER(IntKi) :: iCase !< Current Case being run [-] + INTEGER(IntKi) :: iCase = 0_IntKi !< Current Case being run [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: timeSeries !< Times series inputs when AnalysisType=1, 6 columns, Time, WndSpeed, ShearExp, RotSpd, Pitch, Yaw [-] - INTEGER(IntKi) :: iTimeSeries !< Stored index to optimize time interpolation [-] + INTEGER(IntKi) :: iTimeSeries = 0_IntKi !< Stored index to optimize time interpolation [-] character(1024) :: root !< Output file rootname [-] TYPE(Dvr_Outputs) :: out !< data for driver output file [-] TYPE(ADI_IW_InputData) :: IW_InitInp !< [-] @@ -192,4506 +192,1531 @@ MODULE AeroDyn_Driver_Types TYPE(Dvr_SimData) :: dvr !< Driver data [-] TYPE(ADI_Data) :: ADI !< AeroDyn InflowWind Data [-] TYPE(FED_Data) :: FED !< Elastic wind turbine data (Fake ElastoDyn) [-] - INTEGER(IntKi) :: errStat !< [-] + INTEGER(IntKi) :: errStat = 0_IntKi !< [-] character(ErrMsgLen) :: errMsg !< [-] - LOGICAL :: initialized !< [-] + LOGICAL :: initialized = .false. !< [-] END TYPE AllData ! ======================= CONTAINS - SUBROUTINE AD_Dvr_CopyDvr_Case( SrcDvr_CaseData, DstDvr_CaseData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Dvr_Case), INTENT(IN) :: SrcDvr_CaseData - TYPE(Dvr_Case), INTENT(INOUT) :: DstDvr_CaseData - 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 = 'AD_Dvr_CopyDvr_Case' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDvr_CaseData%HWindSpeed = SrcDvr_CaseData%HWindSpeed - DstDvr_CaseData%PLExp = SrcDvr_CaseData%PLExp - DstDvr_CaseData%rotSpeed = SrcDvr_CaseData%rotSpeed - DstDvr_CaseData%bldPitch = SrcDvr_CaseData%bldPitch - DstDvr_CaseData%nacYaw = SrcDvr_CaseData%nacYaw - DstDvr_CaseData%tMax = SrcDvr_CaseData%tMax - DstDvr_CaseData%dT = SrcDvr_CaseData%dT - DstDvr_CaseData%numSteps = SrcDvr_CaseData%numSteps - DstDvr_CaseData%DOF = SrcDvr_CaseData%DOF - DstDvr_CaseData%amplitude = SrcDvr_CaseData%amplitude - DstDvr_CaseData%frequency = SrcDvr_CaseData%frequency - END SUBROUTINE AD_Dvr_CopyDvr_Case - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_Case' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD_Dvr_DestroyDvr_Case - - SUBROUTINE AD_Dvr_PackDvr_Case( 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(Dvr_Case), 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 = 'AD_Dvr_PackDvr_Case' - ! 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 ! HWindSpeed - Re_BufSz = Re_BufSz + 1 ! PLExp - Re_BufSz = Re_BufSz + 1 ! rotSpeed - Re_BufSz = Re_BufSz + 1 ! bldPitch - Re_BufSz = Re_BufSz + 1 ! nacYaw - Db_BufSz = Db_BufSz + 1 ! tMax - Db_BufSz = Db_BufSz + 1 ! dT - Int_BufSz = Int_BufSz + 1 ! numSteps - Int_BufSz = Int_BufSz + 1 ! DOF - Re_BufSz = Re_BufSz + 1 ! amplitude - Re_BufSz = Re_BufSz + 1 ! frequency - 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%HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%bldPitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%nacYaw - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tMax - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DOF - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%amplitude - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%frequency - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD_Dvr_PackDvr_Case - - SUBROUTINE AD_Dvr_UnPackDvr_Case( 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(Dvr_Case), 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 = 'AD_Dvr_UnPackDvr_Case' - ! 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%HWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%bldPitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nacYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%dT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%numSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DOF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%amplitude = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%frequency = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD_Dvr_UnPackDvr_Case - - SUBROUTINE AD_Dvr_CopyDvrVTK_SurfaceType( SrcDvrVTK_SurfaceTypeData, DstDvrVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DvrVTK_SurfaceType), INTENT(IN) :: SrcDvrVTK_SurfaceTypeData - TYPE(DvrVTK_SurfaceType), INTENT(INOUT) :: DstDvrVTK_SurfaceTypeData - 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 = 'AD_Dvr_CopyDvrVTK_SurfaceType' -! +subroutine AD_Dvr_CopyDvr_Case(SrcDvr_CaseData, DstDvr_CaseData, CtrlCode, ErrStat, ErrMsg) + type(Dvr_Case), intent(in) :: SrcDvr_CaseData + type(Dvr_Case), intent(inout) :: DstDvr_CaseData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvr_Case' ErrStat = ErrID_None - ErrMsg = "" - DstDvrVTK_SurfaceTypeData%NumSectors = SrcDvrVTK_SurfaceTypeData%NumSectors - DstDvrVTK_SurfaceTypeData%NacelleBox = SrcDvrVTK_SurfaceTypeData%NacelleBox - DstDvrVTK_SurfaceTypeData%BaseBox = SrcDvrVTK_SurfaceTypeData%BaseBox - END SUBROUTINE AD_Dvr_CopyDvrVTK_SurfaceType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvrVTK_SurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD_Dvr_DestroyDvrVTK_SurfaceType - - SUBROUTINE AD_Dvr_PackDvrVTK_SurfaceType( 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(DvrVTK_SurfaceType), 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 = 'AD_Dvr_PackDvrVTK_SurfaceType' - ! 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 ! NumSectors - Re_BufSz = Re_BufSz + SIZE(InData%NacelleBox) ! NacelleBox - Re_BufSz = Re_BufSz + SIZE(InData%BaseBox) ! BaseBox - 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%NumSectors - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%NacelleBox,2), UBOUND(InData%NacelleBox,2) - DO i1 = LBOUND(InData%NacelleBox,1), UBOUND(InData%NacelleBox,1) - ReKiBuf(Re_Xferred) = InData%NacelleBox(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%BaseBox,2), UBOUND(InData%BaseBox,2) - DO i1 = LBOUND(InData%BaseBox,1), UBOUND(InData%BaseBox,1) - ReKiBuf(Re_Xferred) = InData%BaseBox(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD_Dvr_PackDvrVTK_SurfaceType - - SUBROUTINE AD_Dvr_UnPackDvrVTK_SurfaceType( 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(DvrVTK_SurfaceType), 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 = 'AD_Dvr_UnPackDvrVTK_SurfaceType' - ! 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%NumSectors = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%NacelleBox,1) - i1_u = UBOUND(OutData%NacelleBox,1) - i2_l = LBOUND(OutData%NacelleBox,2) - i2_u = UBOUND(OutData%NacelleBox,2) - DO i2 = LBOUND(OutData%NacelleBox,2), UBOUND(OutData%NacelleBox,2) - DO i1 = LBOUND(OutData%NacelleBox,1), UBOUND(OutData%NacelleBox,1) - OutData%NacelleBox(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%BaseBox,1) - i1_u = UBOUND(OutData%BaseBox,1) - i2_l = LBOUND(OutData%BaseBox,2) - i2_u = UBOUND(OutData%BaseBox,2) - DO i2 = LBOUND(OutData%BaseBox,2), UBOUND(OutData%BaseBox,2) - DO i1 = LBOUND(OutData%BaseBox,1), UBOUND(OutData%BaseBox,1) - OutData%BaseBox(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD_Dvr_UnPackDvrVTK_SurfaceType - - SUBROUTINE AD_Dvr_CopyDvr_Outputs( SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Dvr_Outputs), INTENT(IN) :: SrcDvr_OutputsData - TYPE(Dvr_Outputs), INTENT(INOUT) :: DstDvr_OutputsData - 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 = 'AD_Dvr_CopyDvr_Outputs' -! + ErrMsg = '' + DstDvr_CaseData%HWindSpeed = SrcDvr_CaseData%HWindSpeed + DstDvr_CaseData%PLExp = SrcDvr_CaseData%PLExp + DstDvr_CaseData%rotSpeed = SrcDvr_CaseData%rotSpeed + DstDvr_CaseData%bldPitch = SrcDvr_CaseData%bldPitch + DstDvr_CaseData%nacYaw = SrcDvr_CaseData%nacYaw + DstDvr_CaseData%tMax = SrcDvr_CaseData%tMax + DstDvr_CaseData%dT = SrcDvr_CaseData%dT + DstDvr_CaseData%numSteps = SrcDvr_CaseData%numSteps + DstDvr_CaseData%DOF = SrcDvr_CaseData%DOF + DstDvr_CaseData%amplitude = SrcDvr_CaseData%amplitude + DstDvr_CaseData%frequency = SrcDvr_CaseData%frequency +end subroutine + +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 + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_Case' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcDvr_OutputsData%AD_ver, DstDvr_OutputsData%AD_ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcDvr_OutputsData%unOutFile)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%unOutFile,1) - i1_u = UBOUND(SrcDvr_OutputsData%unOutFile,1) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%unOutFile)) THEN - ALLOCATE(DstDvr_OutputsData%unOutFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%unOutFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_OutputsData%unOutFile = SrcDvr_OutputsData%unOutFile -ENDIF - DstDvr_OutputsData%ActualChanLen = SrcDvr_OutputsData%ActualChanLen - DstDvr_OutputsData%nDvrOutputs = SrcDvr_OutputsData%nDvrOutputs - DstDvr_OutputsData%Fmt_t = SrcDvr_OutputsData%Fmt_t - DstDvr_OutputsData%Fmt_a = SrcDvr_OutputsData%Fmt_a - DstDvr_OutputsData%delim = SrcDvr_OutputsData%delim - DstDvr_OutputsData%outFmt = SrcDvr_OutputsData%outFmt - DstDvr_OutputsData%fileFmt = SrcDvr_OutputsData%fileFmt - DstDvr_OutputsData%wrVTK = SrcDvr_OutputsData%wrVTK - DstDvr_OutputsData%WrVTK_Type = SrcDvr_OutputsData%WrVTK_Type - DstDvr_OutputsData%Root = SrcDvr_OutputsData%Root - DstDvr_OutputsData%VTK_OutFileRoot = SrcDvr_OutputsData%VTK_OutFileRoot -IF (ALLOCATED(SrcDvr_OutputsData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%WriteOutputHdr,1) - i1_u = UBOUND(SrcDvr_OutputsData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%WriteOutputHdr)) THEN - ALLOCATE(DstDvr_OutputsData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_OutputsData%WriteOutputHdr = SrcDvr_OutputsData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcDvr_OutputsData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%WriteOutputUnt,1) - i1_u = UBOUND(SrcDvr_OutputsData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%WriteOutputUnt)) THEN - ALLOCATE(DstDvr_OutputsData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_OutputsData%WriteOutputUnt = SrcDvr_OutputsData%WriteOutputUnt -ENDIF -IF (ALLOCATED(SrcDvr_OutputsData%storage)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%storage,1) - i1_u = UBOUND(SrcDvr_OutputsData%storage,1) - i2_l = LBOUND(SrcDvr_OutputsData%storage,2) - i2_u = UBOUND(SrcDvr_OutputsData%storage,2) - i3_l = LBOUND(SrcDvr_OutputsData%storage,3) - i3_u = UBOUND(SrcDvr_OutputsData%storage,3) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%storage)) THEN - ALLOCATE(DstDvr_OutputsData%storage(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%storage.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_OutputsData%storage = SrcDvr_OutputsData%storage -ENDIF -IF (ALLOCATED(SrcDvr_OutputsData%outLine)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%outLine,1) - i1_u = UBOUND(SrcDvr_OutputsData%outLine,1) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%outLine)) THEN - ALLOCATE(DstDvr_OutputsData%outLine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%outLine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_OutputsData%outLine = SrcDvr_OutputsData%outLine -ENDIF -IF (ALLOCATED(SrcDvr_OutputsData%VTK_surface)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%VTK_surface,1) - i1_u = UBOUND(SrcDvr_OutputsData%VTK_surface,1) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%VTK_surface)) THEN - ALLOCATE(DstDvr_OutputsData%VTK_surface(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%VTK_surface.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDvr_OutputsData%VTK_surface,1), UBOUND(SrcDvr_OutputsData%VTK_surface,1) - CALL AD_Dvr_Copydvrvtk_surfacetype( SrcDvr_OutputsData%VTK_surface(i1), DstDvr_OutputsData%VTK_surface(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstDvr_OutputsData%VTK_tWidth = SrcDvr_OutputsData%VTK_tWidth - DstDvr_OutputsData%n_VTKTime = SrcDvr_OutputsData%n_VTKTime - DstDvr_OutputsData%VTKHubRad = SrcDvr_OutputsData%VTKHubRad - DstDvr_OutputsData%VTKNacDim = SrcDvr_OutputsData%VTKNacDim - DstDvr_OutputsData%VTKRefPoint = SrcDvr_OutputsData%VTKRefPoint - DstDvr_OutputsData%DT_Outs = SrcDvr_OutputsData%DT_Outs - 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 ) - TYPE(Dvr_Outputs), INTENT(INOUT) :: Dvr_OutputsData - 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 = 'AD_Dvr_DestroyDvr_Outputs' - - ErrStat = ErrID_None - ErrMsg = "" - - 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) -ENDIF -IF (ALLOCATED(Dvr_OutputsData%WriteOutputHdr)) THEN - DEALLOCATE(Dvr_OutputsData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(Dvr_OutputsData%WriteOutputUnt)) THEN - DEALLOCATE(Dvr_OutputsData%WriteOutputUnt) -ENDIF -IF (ALLOCATED(Dvr_OutputsData%storage)) THEN - DEALLOCATE(Dvr_OutputsData%storage) -ENDIF -IF (ALLOCATED(Dvr_OutputsData%outLine)) THEN - DEALLOCATE(Dvr_OutputsData%outLine) -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(Dvr_OutputsData%VTK_surface) -ENDIF - END SUBROUTINE AD_Dvr_DestroyDvr_Outputs - - SUBROUTINE AD_Dvr_PackDvr_Outputs( 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(Dvr_Outputs), 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 = 'AD_Dvr_PackDvr_Outputs' - ! 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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! unOutFile allocated yes/no - IF ( ALLOCATED(InData%unOutFile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! unOutFile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%unOutFile) ! unOutFile - END IF - Int_BufSz = Int_BufSz + 1 ! ActualChanLen - Int_BufSz = Int_BufSz + 1 ! nDvrOutputs - Int_BufSz = Int_BufSz + 1*LEN(InData%Fmt_t) ! Fmt_t - Int_BufSz = Int_BufSz + 1*LEN(InData%Fmt_a) ! Fmt_a - Int_BufSz = Int_BufSz + 1*LEN(InData%delim) ! delim - Int_BufSz = Int_BufSz + 1*LEN(InData%outFmt) ! outFmt - Int_BufSz = Int_BufSz + 1 ! fileFmt - Int_BufSz = Int_BufSz + 1 ! wrVTK - Int_BufSz = Int_BufSz + 1 ! WrVTK_Type - Int_BufSz = Int_BufSz + 1*LEN(InData%Root) ! Root - Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileRoot) ! VTK_OutFileRoot - 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 ! storage allocated yes/no - IF ( ALLOCATED(InData%storage) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! storage upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%storage) ! storage - END IF - Int_BufSz = Int_BufSz + 1 ! outLine allocated yes/no - IF ( ALLOCATED(InData%outLine) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! outLine upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%outLine) ! outLine - END IF - Int_BufSz = Int_BufSz + 1 ! VTK_surface allocated yes/no - IF ( ALLOCATED(InData%VTK_surface) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VTK_surface - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VTK_surface - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VTK_surface - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! VTK_tWidth - Int_BufSz = Int_BufSz + 1 ! n_VTKTime - Re_BufSz = Re_BufSz + 1 ! VTKHubRad - Re_BufSz = Re_BufSz + SIZE(InData%VTKNacDim) ! VTKNacDim - Re_BufSz = Re_BufSz + SIZE(InData%VTKRefPoint) ! VTKRefPoint - Db_BufSz = Db_BufSz + 1 ! DT_Outs - Int_BufSz = Int_BufSz + 1 ! n_DT_Out - 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 - - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%unOutFile) ) 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%unOutFile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%unOutFile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%unOutFile,1), UBOUND(InData%unOutFile,1) - IntKiBuf(Int_Xferred) = InData%unOutFile(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%ActualChanLen - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDvrOutputs - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Fmt_t) - IntKiBuf(Int_Xferred) = ICHAR(InData%Fmt_t(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Fmt_a) - IntKiBuf(Int_Xferred) = ICHAR(InData%Fmt_a(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 - DO I = 1, LEN(InData%outFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%outFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%fileFmt - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%wrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK_Type - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Root) - IntKiBuf(Int_Xferred) = ICHAR(InData%Root(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%VTK_OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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%storage) ) 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%storage,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%storage,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%storage,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%storage,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%storage,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%storage,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%storage,3), UBOUND(InData%storage,3) - DO i2 = LBOUND(InData%storage,2), UBOUND(InData%storage,2) - DO i1 = LBOUND(InData%storage,1), UBOUND(InData%storage,1) - ReKiBuf(Re_Xferred) = InData%storage(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%outLine) ) 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%outLine,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outLine,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%outLine,1), UBOUND(InData%outLine,1) - ReKiBuf(Re_Xferred) = InData%outLine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VTK_surface) ) 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%VTK_surface,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VTK_surface,1) - 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 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%VTK_tWidth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_VTKTime - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VTKHubRad - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%VTKNacDim,1), UBOUND(InData%VTKNacDim,1) - ReKiBuf(Re_Xferred) = InData%VTKNacDim(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%VTKRefPoint,1), UBOUND(InData%VTKRefPoint,1) - ReKiBuf(Re_Xferred) = InData%VTKRefPoint(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%DT_Outs - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_DT_Out - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_Dvr_PackDvr_Outputs - - SUBROUTINE AD_Dvr_UnPackDvr_Outputs( 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(Dvr_Outputs), 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 = 'AD_Dvr_UnPackDvr_Outputs' - ! 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 - 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%AD_ver, ErrStat2, ErrMsg2 ) ! AD_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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! unOutFile 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%unOutFile)) DEALLOCATE(OutData%unOutFile) - ALLOCATE(OutData%unOutFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%unOutFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%unOutFile,1), UBOUND(OutData%unOutFile,1) - OutData%unOutFile(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%ActualChanLen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDvrOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Fmt_t) - OutData%Fmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Fmt_a) - OutData%Fmt_a(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 - DO I = 1, LEN(OutData%outFmt) - OutData%outFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%fileFmt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%wrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK_Type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Root) - OutData%Root(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%VTK_OutFileRoot) - OutData%VTK_OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 ! storage 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%storage)) DEALLOCATE(OutData%storage) - ALLOCATE(OutData%storage(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%storage.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%storage,3), UBOUND(OutData%storage,3) - DO i2 = LBOUND(OutData%storage,2), UBOUND(OutData%storage,2) - DO i1 = LBOUND(OutData%storage,1), UBOUND(OutData%storage,1) - OutData%storage(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! outLine 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%outLine)) DEALLOCATE(OutData%outLine) - ALLOCATE(OutData%outLine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%outLine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%outLine,1), UBOUND(OutData%outLine,1) - OutData%outLine(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VTK_surface 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%VTK_surface)) DEALLOCATE(OutData%VTK_surface) - ALLOCATE(OutData%VTK_surface(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surface.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VTK_surface,1), UBOUND(OutData%VTK_surface,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 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 - - 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%VTK_tWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_VTKTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKHubRad = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%VTKNacDim,1) - i1_u = UBOUND(OutData%VTKNacDim,1) - DO i1 = LBOUND(OutData%VTKNacDim,1), UBOUND(OutData%VTKNacDim,1) - OutData%VTKNacDim(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%VTKRefPoint,1) - i1_u = UBOUND(OutData%VTKRefPoint,1) - DO i1 = LBOUND(OutData%VTKRefPoint,1), UBOUND(OutData%VTKRefPoint,1) - OutData%VTKRefPoint(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%DT_Outs = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%n_DT_Out = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_Dvr_UnPackDvr_Outputs - - SUBROUTINE AD_Dvr_CopyBladeData( SrcBladeDataData, DstBladeDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladeData), INTENT(IN) :: SrcBladeDataData - TYPE(BladeData), INTENT(INOUT) :: DstBladeDataData - 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 = 'AD_Dvr_CopyBladeData' -! + ErrMsg = '' +end subroutine + +subroutine AD_Dvr_PackDvr_Case(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Dvr_Case), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_Case' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%HWindSpeed) + call RegPack(Buf, InData%PLExp) + call RegPack(Buf, InData%rotSpeed) + call RegPack(Buf, InData%bldPitch) + call RegPack(Buf, InData%nacYaw) + call RegPack(Buf, InData%tMax) + call RegPack(Buf, InData%dT) + call RegPack(Buf, InData%numSteps) + call RegPack(Buf, InData%DOF) + call RegPack(Buf, InData%amplitude) + call RegPack(Buf, InData%frequency) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackDvr_Case(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Dvr_Case), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_Case' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%HWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%bldPitch) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nacYaw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%numSteps) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%amplitude) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%frequency) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_CopyDvrVTK_SurfaceType(SrcDvrVTK_SurfaceTypeData, DstDvrVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg) + type(DvrVTK_SurfaceType), intent(in) :: SrcDvrVTK_SurfaceTypeData + type(DvrVTK_SurfaceType), intent(inout) :: DstDvrVTK_SurfaceTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvrVTK_SurfaceType' ErrStat = ErrID_None - ErrMsg = "" - DstBladeDataData%pitch = SrcBladeDataData%pitch - DstBladeDataData%pitchSpeed = SrcBladeDataData%pitchSpeed - DstBladeDataData%pitchAcc = SrcBladeDataData%pitchAcc - DstBladeDataData%origin_h = SrcBladeDataData%origin_h - DstBladeDataData%orientation_h = SrcBladeDataData%orientation_h - DstBladeDataData%hubRad_bl = SrcBladeDataData%hubRad_bl - DstBladeDataData%Rh2bl0 = SrcBladeDataData%Rh2bl0 - DstBladeDataData%motionType = SrcBladeDataData%motionType - DstBladeDataData%iMotion = SrcBladeDataData%iMotion -IF (ALLOCATED(SrcBladeDataData%motion)) THEN - i1_l = LBOUND(SrcBladeDataData%motion,1) - i1_u = UBOUND(SrcBladeDataData%motion,1) - i2_l = LBOUND(SrcBladeDataData%motion,2) - i2_u = UBOUND(SrcBladeDataData%motion,2) - IF (.NOT. ALLOCATED(DstBladeDataData%motion)) THEN - ALLOCATE(DstBladeDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeDataData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeDataData%motion = SrcBladeDataData%motion -ENDIF - DstBladeDataData%motionFileName = SrcBladeDataData%motionFileName - END SUBROUTINE AD_Dvr_CopyBladeData - - SUBROUTINE AD_Dvr_DestroyBladeData( BladeDataData, ErrStat, ErrMsg ) - TYPE(BladeData), INTENT(INOUT) :: BladeDataData - 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 = 'AD_Dvr_DestroyBladeData' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladeDataData%motion)) THEN - DEALLOCATE(BladeDataData%motion) -ENDIF - END SUBROUTINE AD_Dvr_DestroyBladeData - - SUBROUTINE AD_Dvr_PackBladeData( 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(BladeData), 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 = 'AD_Dvr_PackBladeData' - ! 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 ! pitch - Re_BufSz = Re_BufSz + 1 ! pitchSpeed - Re_BufSz = Re_BufSz + 1 ! pitchAcc - Re_BufSz = Re_BufSz + SIZE(InData%origin_h) ! origin_h - Re_BufSz = Re_BufSz + SIZE(InData%orientation_h) ! orientation_h - Re_BufSz = Re_BufSz + 1 ! hubRad_bl - Db_BufSz = Db_BufSz + SIZE(InData%Rh2bl0) ! Rh2bl0 - Int_BufSz = Int_BufSz + 1 ! motionType - Int_BufSz = Int_BufSz + 1 ! iMotion - Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no - IF ( ALLOCATED(InData%motion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName - 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%pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%pitchSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%pitchAcc - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%origin_h,1), UBOUND(InData%origin_h,1) - ReKiBuf(Re_Xferred) = InData%origin_h(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%orientation_h,1), UBOUND(InData%orientation_h,1) - ReKiBuf(Re_Xferred) = InData%orientation_h(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%hubRad_bl - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%Rh2bl0,2), UBOUND(InData%Rh2bl0,2) - DO i1 = LBOUND(InData%Rh2bl0,1), UBOUND(InData%Rh2bl0,1) - DbKiBuf(Db_Xferred) = InData%Rh2bl0(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - IntKiBuf(Int_Xferred) = InData%motionType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iMotion - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%motion) ) 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%motion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) - DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) - ReKiBuf(Re_Xferred) = InData%motion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(InData%motionFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AD_Dvr_PackBladeData - - SUBROUTINE AD_Dvr_UnPackBladeData( 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(BladeData), 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 = 'AD_Dvr_UnPackBladeData' - ! 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%pitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%pitchSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%pitchAcc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%origin_h,1) - i1_u = UBOUND(OutData%origin_h,1) - DO i1 = LBOUND(OutData%origin_h,1), UBOUND(OutData%origin_h,1) - OutData%origin_h(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%orientation_h,1) - i1_u = UBOUND(OutData%orientation_h,1) - DO i1 = LBOUND(OutData%orientation_h,1), UBOUND(OutData%orientation_h,1) - OutData%orientation_h(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%hubRad_bl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%Rh2bl0,1) - i1_u = UBOUND(OutData%Rh2bl0,1) - i2_l = LBOUND(OutData%Rh2bl0,2) - i2_u = UBOUND(OutData%Rh2bl0,2) - DO i2 = LBOUND(OutData%Rh2bl0,2), UBOUND(OutData%Rh2bl0,2) - DO i1 = LBOUND(OutData%Rh2bl0,1), UBOUND(OutData%Rh2bl0,1) - OutData%Rh2bl0(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%motionType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion 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%motion)) DEALLOCATE(OutData%motion) - ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) - DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) - OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(OutData%motionFileName) - OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AD_Dvr_UnPackBladeData - - SUBROUTINE AD_Dvr_CopyHubData( SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HubData), INTENT(IN) :: SrcHubDataData - TYPE(HubData), INTENT(INOUT) :: DstHubDataData - 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 = 'AD_Dvr_CopyHubData' -! + ErrMsg = '' + DstDvrVTK_SurfaceTypeData%NumSectors = SrcDvrVTK_SurfaceTypeData%NumSectors + DstDvrVTK_SurfaceTypeData%NacelleBox = SrcDvrVTK_SurfaceTypeData%NacelleBox + DstDvrVTK_SurfaceTypeData%BaseBox = SrcDvrVTK_SurfaceTypeData%BaseBox +end subroutine + +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 + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvrVTK_SurfaceType' ErrStat = ErrID_None - ErrMsg = "" - DstHubDataData%origin_n = SrcHubDataData%origin_n - DstHubDataData%orientation_n = SrcHubDataData%orientation_n - DstHubDataData%motionType = SrcHubDataData%motionType - DstHubDataData%iMotion = SrcHubDataData%iMotion - DstHubDataData%azimuth = SrcHubDataData%azimuth - DstHubDataData%rotSpeed = SrcHubDataData%rotSpeed - DstHubDataData%rotAcc = SrcHubDataData%rotAcc - DstHubDataData%motionFileName = SrcHubDataData%motionFileName -IF (ALLOCATED(SrcHubDataData%motion)) THEN - i1_l = LBOUND(SrcHubDataData%motion,1) - i1_u = UBOUND(SrcHubDataData%motion,1) - i2_l = LBOUND(SrcHubDataData%motion,2) - i2_u = UBOUND(SrcHubDataData%motion,2) - IF (.NOT. ALLOCATED(DstHubDataData%motion)) THEN - ALLOCATE(DstHubDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHubDataData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstHubDataData%motion = SrcHubDataData%motion -ENDIF - END SUBROUTINE AD_Dvr_CopyHubData - - SUBROUTINE AD_Dvr_DestroyHubData( HubDataData, ErrStat, ErrMsg ) - TYPE(HubData), INTENT(INOUT) :: HubDataData - 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 = 'AD_Dvr_DestroyHubData' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(HubDataData%motion)) THEN - DEALLOCATE(HubDataData%motion) -ENDIF - END SUBROUTINE AD_Dvr_DestroyHubData - - SUBROUTINE AD_Dvr_PackHubData( 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(HubData), 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 = 'AD_Dvr_PackHubData' - ! 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 + SIZE(InData%origin_n) ! origin_n - Re_BufSz = Re_BufSz + SIZE(InData%orientation_n) ! orientation_n - Int_BufSz = Int_BufSz + 1 ! motionType - Int_BufSz = Int_BufSz + 1 ! iMotion - Re_BufSz = Re_BufSz + 1 ! azimuth - Re_BufSz = Re_BufSz + 1 ! rotSpeed - Re_BufSz = Re_BufSz + 1 ! rotAcc - Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName - Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no - IF ( ALLOCATED(InData%motion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion - 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 i1 = LBOUND(InData%origin_n,1), UBOUND(InData%origin_n,1) - ReKiBuf(Re_Xferred) = InData%origin_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%orientation_n,1), UBOUND(InData%orientation_n,1) - ReKiBuf(Re_Xferred) = InData%orientation_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%motionType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iMotion - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%azimuth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rotAcc - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%motionFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%motion) ) 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%motion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) - DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) - ReKiBuf(Re_Xferred) = InData%motion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_Dvr_PackHubData - - SUBROUTINE AD_Dvr_UnPackHubData( 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(HubData), 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 = 'AD_Dvr_UnPackHubData' - ! 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 - i1_l = LBOUND(OutData%origin_n,1) - i1_u = UBOUND(OutData%origin_n,1) - DO i1 = LBOUND(OutData%origin_n,1), UBOUND(OutData%origin_n,1) - OutData%origin_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%orientation_n,1) - i1_u = UBOUND(OutData%orientation_n,1) - DO i1 = LBOUND(OutData%orientation_n,1), UBOUND(OutData%orientation_n,1) - OutData%orientation_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%motionType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%azimuth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rotAcc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%motionFileName) - OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion 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%motion)) DEALLOCATE(OutData%motion) - ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) - DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) - OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_Dvr_UnPackHubData - - SUBROUTINE AD_Dvr_CopyNacData( SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(NacData), INTENT(IN) :: SrcNacDataData - TYPE(NacData), INTENT(INOUT) :: DstNacDataData - 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 = 'AD_Dvr_CopyNacData' -! + ErrMsg = '' +end subroutine + +subroutine AD_Dvr_PackDvrVTK_SurfaceType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DvrVTK_SurfaceType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackDvrVTK_SurfaceType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%NumSectors) + call RegPack(Buf, InData%NacelleBox) + call RegPack(Buf, InData%BaseBox) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackDvrVTK_SurfaceType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DvrVTK_SurfaceType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvrVTK_SurfaceType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NumSectors) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacelleBox) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BaseBox) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCode, ErrStat, ErrMsg) + type(Dvr_Outputs), intent(in) :: SrcDvr_OutputsData + type(Dvr_Outputs), intent(inout) :: DstDvr_OutputsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvr_Outputs' ErrStat = ErrID_None - ErrMsg = "" - DstNacDataData%origin_t = SrcNacDataData%origin_t - DstNacDataData%motionType = SrcNacDataData%motionType - DstNacDataData%iMotion = SrcNacDataData%iMotion - DstNacDataData%yaw = SrcNacDataData%yaw - DstNacDataData%yawSpeed = SrcNacDataData%yawSpeed - DstNacDataData%yawAcc = SrcNacDataData%yawAcc - DstNacDataData%motionFileName = SrcNacDataData%motionFileName -IF (ALLOCATED(SrcNacDataData%motion)) THEN - i1_l = LBOUND(SrcNacDataData%motion,1) - i1_u = UBOUND(SrcNacDataData%motion,1) - i2_l = LBOUND(SrcNacDataData%motion,2) - i2_u = UBOUND(SrcNacDataData%motion,2) - IF (.NOT. ALLOCATED(DstNacDataData%motion)) THEN - ALLOCATE(DstNacDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstNacDataData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstNacDataData%motion = SrcNacDataData%motion -ENDIF - END SUBROUTINE AD_Dvr_CopyNacData - - SUBROUTINE AD_Dvr_DestroyNacData( NacDataData, ErrStat, ErrMsg ) - TYPE(NacData), INTENT(INOUT) :: NacDataData - 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 = 'AD_Dvr_DestroyNacData' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(NacDataData%motion)) THEN - DEALLOCATE(NacDataData%motion) -ENDIF - END SUBROUTINE AD_Dvr_DestroyNacData - - SUBROUTINE AD_Dvr_PackNacData( 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(NacData), 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 = 'AD_Dvr_PackNacData' - ! 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 + SIZE(InData%origin_t) ! origin_t - Int_BufSz = Int_BufSz + 1 ! motionType - Int_BufSz = Int_BufSz + 1 ! iMotion - Re_BufSz = Re_BufSz + 1 ! yaw - Re_BufSz = Re_BufSz + 1 ! yawSpeed - Re_BufSz = Re_BufSz + 1 ! yawAcc - Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName - Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no - IF ( ALLOCATED(InData%motion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion - 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 i1 = LBOUND(InData%origin_t,1), UBOUND(InData%origin_t,1) - ReKiBuf(Re_Xferred) = InData%origin_t(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%motionType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iMotion - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yawSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yawAcc - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%motionFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%motion) ) 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%motion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) - DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) - ReKiBuf(Re_Xferred) = InData%motion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_Dvr_PackNacData - - SUBROUTINE AD_Dvr_UnPackNacData( 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(NacData), 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 = 'AD_Dvr_UnPackNacData' - ! 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 - i1_l = LBOUND(OutData%origin_t,1) - i1_u = UBOUND(OutData%origin_t,1) - DO i1 = LBOUND(OutData%origin_t,1), UBOUND(OutData%origin_t,1) - OutData%origin_t(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%motionType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%yaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%yawSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%yawAcc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%motionFileName) - OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion 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%motion)) DEALLOCATE(OutData%motion) - ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) - DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) - OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_Dvr_UnPackNacData - - SUBROUTINE AD_Dvr_CopyTwrData( SrcTwrDataData, DstTwrDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TwrData), INTENT(IN) :: SrcTwrDataData - TYPE(TwrData), INTENT(INOUT) :: DstTwrDataData - 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 = 'AD_Dvr_CopyTwrData' -! + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcDvr_OutputsData%AD_ver, DstDvr_OutputsData%AD_ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcDvr_OutputsData%unOutFile)) then + LB(1:1) = lbound(SrcDvr_OutputsData%unOutFile) + UB(1:1) = ubound(SrcDvr_OutputsData%unOutFile) + if (.not. allocated(DstDvr_OutputsData%unOutFile)) then + allocate(DstDvr_OutputsData%unOutFile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%unOutFile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_OutputsData%unOutFile = SrcDvr_OutputsData%unOutFile + end if + DstDvr_OutputsData%ActualChanLen = SrcDvr_OutputsData%ActualChanLen + DstDvr_OutputsData%nDvrOutputs = SrcDvr_OutputsData%nDvrOutputs + DstDvr_OutputsData%Fmt_t = SrcDvr_OutputsData%Fmt_t + DstDvr_OutputsData%Fmt_a = SrcDvr_OutputsData%Fmt_a + DstDvr_OutputsData%delim = SrcDvr_OutputsData%delim + DstDvr_OutputsData%outFmt = SrcDvr_OutputsData%outFmt + DstDvr_OutputsData%fileFmt = SrcDvr_OutputsData%fileFmt + DstDvr_OutputsData%wrVTK = SrcDvr_OutputsData%wrVTK + DstDvr_OutputsData%WrVTK_Type = SrcDvr_OutputsData%WrVTK_Type + DstDvr_OutputsData%Root = SrcDvr_OutputsData%Root + DstDvr_OutputsData%VTK_OutFileRoot = SrcDvr_OutputsData%VTK_OutFileRoot + if (allocated(SrcDvr_OutputsData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputHdr) + UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputHdr) + if (.not. allocated(DstDvr_OutputsData%WriteOutputHdr)) then + allocate(DstDvr_OutputsData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_OutputsData%WriteOutputHdr = SrcDvr_OutputsData%WriteOutputHdr + end if + if (allocated(SrcDvr_OutputsData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputUnt) + UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputUnt) + if (.not. allocated(DstDvr_OutputsData%WriteOutputUnt)) then + allocate(DstDvr_OutputsData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_OutputsData%WriteOutputUnt = SrcDvr_OutputsData%WriteOutputUnt + end if + if (allocated(SrcDvr_OutputsData%storage)) then + LB(1:3) = lbound(SrcDvr_OutputsData%storage) + UB(1:3) = ubound(SrcDvr_OutputsData%storage) + if (.not. allocated(DstDvr_OutputsData%storage)) then + allocate(DstDvr_OutputsData%storage(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%storage.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_OutputsData%storage = SrcDvr_OutputsData%storage + end if + if (allocated(SrcDvr_OutputsData%outLine)) then + LB(1:1) = lbound(SrcDvr_OutputsData%outLine) + UB(1:1) = ubound(SrcDvr_OutputsData%outLine) + if (.not. allocated(DstDvr_OutputsData%outLine)) then + allocate(DstDvr_OutputsData%outLine(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%outLine.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_OutputsData%outLine = SrcDvr_OutputsData%outLine + end if + if (allocated(SrcDvr_OutputsData%VTK_surface)) then + LB(1:1) = lbound(SrcDvr_OutputsData%VTK_surface) + UB(1:1) = ubound(SrcDvr_OutputsData%VTK_surface) + if (.not. allocated(DstDvr_OutputsData%VTK_surface)) then + allocate(DstDvr_OutputsData%VTK_surface(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%VTK_surface.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_Dvr_CopyDvrVTK_SurfaceType(SrcDvr_OutputsData%VTK_surface(i1), DstDvr_OutputsData%VTK_surface(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstDvr_OutputsData%VTK_tWidth = SrcDvr_OutputsData%VTK_tWidth + DstDvr_OutputsData%n_VTKTime = SrcDvr_OutputsData%n_VTKTime + DstDvr_OutputsData%VTKHubRad = SrcDvr_OutputsData%VTKHubRad + DstDvr_OutputsData%VTKNacDim = SrcDvr_OutputsData%VTKNacDim + DstDvr_OutputsData%VTKRefPoint = SrcDvr_OutputsData%VTKRefPoint + DstDvr_OutputsData%DT_Outs = SrcDvr_OutputsData%DT_Outs + DstDvr_OutputsData%n_DT_Out = SrcDvr_OutputsData%n_DT_Out +end subroutine + +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 + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_Outputs' ErrStat = ErrID_None - ErrMsg = "" - DstTwrDataData%origin_t = SrcTwrDataData%origin_t - END SUBROUTINE AD_Dvr_CopyTwrData - - SUBROUTINE AD_Dvr_DestroyTwrData( TwrDataData, ErrStat, ErrMsg ) - TYPE(TwrData), INTENT(INOUT) :: TwrDataData - 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 = 'AD_Dvr_DestroyTwrData' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD_Dvr_DestroyTwrData - - SUBROUTINE AD_Dvr_PackTwrData( 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(TwrData), 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 = 'AD_Dvr_PackTwrData' - ! 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 + SIZE(InData%origin_t) ! origin_t - 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 i1 = LBOUND(InData%origin_t,1), UBOUND(InData%origin_t,1) - ReKiBuf(Re_Xferred) = InData%origin_t(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD_Dvr_PackTwrData - - SUBROUTINE AD_Dvr_UnPackTwrData( 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(TwrData), 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 = 'AD_Dvr_UnPackTwrData' - ! 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 - i1_l = LBOUND(OutData%origin_t,1) - i1_u = UBOUND(OutData%origin_t,1) - DO i1 = LBOUND(OutData%origin_t,1), UBOUND(OutData%origin_t,1) - OutData%origin_t(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD_Dvr_UnPackTwrData - - SUBROUTINE AD_Dvr_CopyWTData( SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WTData), INTENT(INOUT) :: SrcWTDataData - TYPE(WTData), INTENT(INOUT) :: DstWTDataData - 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 = 'AD_Dvr_CopyWTData' -! + ErrMsg = '' + 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) + end if + if (allocated(Dvr_OutputsData%WriteOutputHdr)) then + deallocate(Dvr_OutputsData%WriteOutputHdr) + end if + if (allocated(Dvr_OutputsData%WriteOutputUnt)) then + deallocate(Dvr_OutputsData%WriteOutputUnt) + end if + if (allocated(Dvr_OutputsData%storage)) then + deallocate(Dvr_OutputsData%storage) + end if + if (allocated(Dvr_OutputsData%outLine)) then + deallocate(Dvr_OutputsData%outLine) + end if + if (allocated(Dvr_OutputsData%VTK_surface)) then + LB(1:1) = lbound(Dvr_OutputsData%VTK_surface) + UB(1:1) = ubound(Dvr_OutputsData%VTK_surface) + do i1 = LB(1), UB(1) + call AD_Dvr_DestroyDvrVTK_SurfaceType(Dvr_OutputsData%VTK_surface(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(Dvr_OutputsData%VTK_surface) + end if +end subroutine + +subroutine AD_Dvr_PackDvr_Outputs(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Dvr_Outputs), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_Outputs' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(Buf, InData%AD_ver) + call RegPack(Buf, allocated(InData%unOutFile)) + if (allocated(InData%unOutFile)) then + call RegPackBounds(Buf, 1, lbound(InData%unOutFile), ubound(InData%unOutFile)) + call RegPack(Buf, InData%unOutFile) + end if + call RegPack(Buf, InData%ActualChanLen) + call RegPack(Buf, InData%nDvrOutputs) + call RegPack(Buf, InData%Fmt_t) + call RegPack(Buf, InData%Fmt_a) + call RegPack(Buf, InData%delim) + call RegPack(Buf, InData%outFmt) + call RegPack(Buf, InData%fileFmt) + call RegPack(Buf, InData%wrVTK) + call RegPack(Buf, InData%WrVTK_Type) + call RegPack(Buf, InData%Root) + call RegPack(Buf, InData%VTK_OutFileRoot) + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call RegPack(Buf, allocated(InData%storage)) + if (allocated(InData%storage)) then + call RegPackBounds(Buf, 3, lbound(InData%storage), ubound(InData%storage)) + call RegPack(Buf, InData%storage) + end if + call RegPack(Buf, allocated(InData%outLine)) + if (allocated(InData%outLine)) then + call RegPackBounds(Buf, 1, lbound(InData%outLine), ubound(InData%outLine)) + call RegPack(Buf, InData%outLine) + end if + call RegPack(Buf, allocated(InData%VTK_surface)) + if (allocated(InData%VTK_surface)) then + call RegPackBounds(Buf, 1, lbound(InData%VTK_surface), ubound(InData%VTK_surface)) + LB(1:1) = lbound(InData%VTK_surface) + UB(1:1) = ubound(InData%VTK_surface) + do i1 = LB(1), UB(1) + call AD_Dvr_PackDvrVTK_SurfaceType(Buf, InData%VTK_surface(i1)) + end do + end if + call RegPack(Buf, InData%VTK_tWidth) + call RegPack(Buf, InData%n_VTKTime) + call RegPack(Buf, InData%VTKHubRad) + call RegPack(Buf, InData%VTKNacDim) + call RegPack(Buf, InData%VTKRefPoint) + call RegPack(Buf, InData%DT_Outs) + call RegPack(Buf, InData%n_DT_Out) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackDvr_Outputs(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Dvr_Outputs), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_Outputs' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%AD_ver) ! AD_ver + if (allocated(OutData%unOutFile)) deallocate(OutData%unOutFile) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%unOutFile(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%unOutFile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%unOutFile) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%ActualChanLen) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nDvrOutputs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Fmt_t) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Fmt_a) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%delim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%outFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%fileFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%wrVTK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrVTK_Type) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Root) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTK_OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%storage)) deallocate(OutData%storage) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%storage(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%storage.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%storage) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%outLine)) deallocate(OutData%outLine) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%outLine(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%outLine.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%outLine) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%VTK_surface)) deallocate(OutData%VTK_surface) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VTK_surface(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surface.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_Dvr_UnpackDvrVTK_SurfaceType(Buf, OutData%VTK_surface(i1)) ! VTK_surface + end do + end if + call RegUnpack(Buf, OutData%VTK_tWidth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_VTKTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKHubRad) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKNacDim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKRefPoint) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DT_Outs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_DT_Out) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_CopyBladeData(SrcBladeDataData, DstBladeDataData, CtrlCode, ErrStat, ErrMsg) + type(BladeData), intent(in) :: SrcBladeDataData + type(BladeData), intent(inout) :: DstBladeDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyBladeData' ErrStat = ErrID_None - ErrMsg = "" - DstWTDataData%originInit = SrcWTDataData%originInit - DstWTDataData%orientationInit = SrcWTDataData%orientationInit - CALL NWTC_Library_Copymeshmaptype( SrcWTDataData%map2twrPt, DstWTDataData%map2twrPt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcWTDataData%map2nacPt, DstWTDataData%map2nacPt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcWTDataData%map2hubPt, DstWTDataData%map2hubPt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcWTDataData%map2BldPt)) THEN - i1_l = LBOUND(SrcWTDataData%map2BldPt,1) - i1_u = UBOUND(SrcWTDataData%map2BldPt,1) - IF (.NOT. ALLOCATED(DstWTDataData%map2BldPt)) THEN - ALLOCATE(DstWTDataData%map2BldPt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%map2BldPt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcWTDataData%map2BldPt,1), UBOUND(SrcWTDataData%map2BldPt,1) - CALL NWTC_Library_Copymeshmaptype( SrcWTDataData%map2BldPt(i1), DstWTDataData%map2BldPt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcWTDataData%bld)) THEN - i1_l = LBOUND(SrcWTDataData%bld,1) - i1_u = UBOUND(SrcWTDataData%bld,1) - IF (.NOT. ALLOCATED(DstWTDataData%bld)) THEN - ALLOCATE(DstWTDataData%bld(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%bld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcWTDataData%bld,1), UBOUND(SrcWTDataData%bld,1) - CALL AD_Dvr_Copybladedata( SrcWTDataData%bld(i1), DstWTDataData%bld(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL AD_Dvr_Copyhubdata( SrcWTDataData%hub, DstWTDataData%hub, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_Dvr_Copynacdata( SrcWTDataData%nac, DstWTDataData%nac, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_Dvr_Copytwrdata( SrcWTDataData%twr, DstWTDataData%twr, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstWTDataData%numBlades = SrcWTDataData%numBlades - DstWTDataData%basicHAWTFormat = SrcWTDataData%basicHAWTFormat - DstWTDataData%hasTower = SrcWTDataData%hasTower - DstWTDataData%projMod = SrcWTDataData%projMod - DstWTDataData%BEM_Mod = SrcWTDataData%BEM_Mod - DstWTDataData%HAWTprojection = SrcWTDataData%HAWTprojection - DstWTDataData%motionType = SrcWTDataData%motionType -IF (ALLOCATED(SrcWTDataData%motion)) THEN - i1_l = LBOUND(SrcWTDataData%motion,1) - i1_u = UBOUND(SrcWTDataData%motion,1) - i2_l = LBOUND(SrcWTDataData%motion,2) - i2_u = UBOUND(SrcWTDataData%motion,2) - IF (.NOT. ALLOCATED(DstWTDataData%motion)) THEN - ALLOCATE(DstWTDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWTDataData%motion = SrcWTDataData%motion -ENDIF - DstWTDataData%iMotion = SrcWTDataData%iMotion - DstWTDataData%degreeOfFreedom = SrcWTDataData%degreeOfFreedom - DstWTDataData%amplitude = SrcWTDataData%amplitude - DstWTDataData%frequency = SrcWTDataData%frequency - DstWTDataData%motionFileName = SrcWTDataData%motionFileName -IF (ALLOCATED(SrcWTDataData%WriteOutput)) THEN - i1_l = LBOUND(SrcWTDataData%WriteOutput,1) - i1_u = UBOUND(SrcWTDataData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstWTDataData%WriteOutput)) THEN - ALLOCATE(DstWTDataData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWTDataData%WriteOutput = SrcWTDataData%WriteOutput -ENDIF -IF (ALLOCATED(SrcWTDataData%userSwapArray)) THEN - i1_l = LBOUND(SrcWTDataData%userSwapArray,1) - i1_u = UBOUND(SrcWTDataData%userSwapArray,1) - IF (.NOT. ALLOCATED(DstWTDataData%userSwapArray)) THEN - ALLOCATE(DstWTDataData%userSwapArray(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%userSwapArray.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWTDataData%userSwapArray = SrcWTDataData%userSwapArray -ENDIF - END SUBROUTINE AD_Dvr_CopyWTData - - SUBROUTINE AD_Dvr_DestroyWTData( WTDataData, ErrStat, ErrMsg ) - TYPE(WTData), INTENT(INOUT) :: WTDataData - 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 = 'AD_Dvr_DestroyWTData' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyMeshMapType( WTDataData%map2twrPt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( WTDataData%map2nacPt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(WTDataData%bld) -ENDIF - CALL AD_Dvr_DestroyHubData( WTDataData%hub, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_Dvr_DestroyNacData( WTDataData%nac, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_Dvr_DestroyTwrData( WTDataData%twr, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(WTDataData%motion)) THEN - DEALLOCATE(WTDataData%motion) -ENDIF -IF (ALLOCATED(WTDataData%WriteOutput)) THEN - DEALLOCATE(WTDataData%WriteOutput) -ENDIF -IF (ALLOCATED(WTDataData%userSwapArray)) THEN - DEALLOCATE(WTDataData%userSwapArray) -ENDIF - END SUBROUTINE AD_Dvr_DestroyWTData - - SUBROUTINE AD_Dvr_PackWTData( 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(WTData), 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 = 'AD_Dvr_PackWTData' - ! 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 + SIZE(InData%originInit) ! originInit - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2twrPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2twrPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2twrPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2nacPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2nacPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2nacPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2hubPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2hubPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2hubPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! map2BldPt allocated yes/no - IF ( ALLOCATED(InData%map2BldPt) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2BldPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2BldPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2BldPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! bld allocated yes/no - IF ( ALLOCATED(InData%bld) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! bld - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! bld - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! bld - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! nac - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! nac - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! nac - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! twr - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! twr - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! twr - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Int_BufSz = Int_BufSz + 1 ! basicHAWTFormat - Int_BufSz = Int_BufSz + 1 ! hasTower - Int_BufSz = Int_BufSz + 1 ! projMod - Int_BufSz = Int_BufSz + 1 ! BEM_Mod - Int_BufSz = Int_BufSz + 1 ! HAWTprojection - Int_BufSz = Int_BufSz + 1 ! motionType - Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no - IF ( ALLOCATED(InData%motion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion - END IF - Int_BufSz = Int_BufSz + 1 ! iMotion - Int_BufSz = Int_BufSz + 1 ! degreeOfFreedom - Re_BufSz = Re_BufSz + 1 ! amplitude - Re_BufSz = Re_BufSz + 1 ! frequency - Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName - 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 - Int_BufSz = Int_BufSz + 1 ! userSwapArray allocated yes/no - IF ( ALLOCATED(InData%userSwapArray) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! userSwapArray upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%userSwapArray) ! userSwapArray - 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 i1 = LBOUND(InData%originInit,1), UBOUND(InData%originInit,1) - ReKiBuf(Re_Xferred) = InData%originInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%orientationInit,1), UBOUND(InData%orientationInit,1) - 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 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 - 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 - - 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%map2BldPt) ) 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%map2BldPt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%map2BldPt,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%bld) ) 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%bld,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bld,1) - 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 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 - 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 - - 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 - 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 - - 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 - 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 - - 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%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%basicHAWTFormat, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%hasTower, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%projMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BEM_Mod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HAWTprojection, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%motionType - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%motion) ) 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%motion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) - DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) - ReKiBuf(Re_Xferred) = InData%motion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iMotion - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%degreeOfFreedom - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%amplitude - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%frequency - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%motionFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - IF ( .NOT. ALLOCATED(InData%userSwapArray) ) 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%userSwapArray,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%userSwapArray,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%userSwapArray,1), UBOUND(InData%userSwapArray,1) - ReKiBuf(Re_Xferred) = InData%userSwapArray(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_Dvr_PackWTData - - SUBROUTINE AD_Dvr_UnPackWTData( 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(WTData), 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 = 'AD_Dvr_UnPackWTData' - ! 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 - i1_l = LBOUND(OutData%originInit,1) - i1_u = UBOUND(OutData%originInit,1) - DO i1 = LBOUND(OutData%originInit,1), UBOUND(OutData%originInit,1) - OutData%originInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%orientationInit,1) - i1_u = UBOUND(OutData%orientationInit,1) - DO i1 = LBOUND(OutData%orientationInit,1), UBOUND(OutData%orientationInit,1) - OutData%orientationInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%map2twrPt, ErrStat2, ErrMsg2 ) ! map2twrPt - 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) - 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_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%map2nacPt, ErrStat2, ErrMsg2 ) ! map2nacPt - 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) - 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_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%map2hubPt, ErrStat2, ErrMsg2 ) ! map2hubPt - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! map2BldPt 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%map2BldPt)) DEALLOCATE(OutData%map2BldPt) - ALLOCATE(OutData%map2BldPt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%map2BldPt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%map2BldPt,1), UBOUND(OutData%map2BldPt,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_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%map2BldPt(i1), ErrStat2, ErrMsg2 ) ! map2BldPt - 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 ! bld 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%bld)) DEALLOCATE(OutData%bld) - ALLOCATE(OutData%bld(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%bld,1), UBOUND(OutData%bld,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 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 - - 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 - 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 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 - - 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 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 - - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%basicHAWTFormat = TRANSFER(IntKiBuf(Int_Xferred), OutData%basicHAWTFormat) - Int_Xferred = Int_Xferred + 1 - OutData%hasTower = TRANSFER(IntKiBuf(Int_Xferred), OutData%hasTower) - Int_Xferred = Int_Xferred + 1 - OutData%projMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BEM_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HAWTprojection = TRANSFER(IntKiBuf(Int_Xferred), OutData%HAWTprojection) - Int_Xferred = Int_Xferred + 1 - OutData%motionType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion 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%motion)) DEALLOCATE(OutData%motion) - ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) - DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) - OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%iMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%degreeOfFreedom = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%amplitude = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%frequency = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%motionFileName) - OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! userSwapArray 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%userSwapArray)) DEALLOCATE(OutData%userSwapArray) - ALLOCATE(OutData%userSwapArray(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%userSwapArray.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%userSwapArray,1), UBOUND(OutData%userSwapArray,1) - OutData%userSwapArray(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_Dvr_UnPackWTData - - SUBROUTINE AD_Dvr_CopyDvr_SimData( SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Dvr_SimData), INTENT(INOUT) :: SrcDvr_SimDataData - TYPE(Dvr_SimData), INTENT(INOUT) :: DstDvr_SimDataData - 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 = 'AD_Dvr_CopyDvr_SimData' -! + ErrMsg = '' + DstBladeDataData%pitch = SrcBladeDataData%pitch + DstBladeDataData%pitchSpeed = SrcBladeDataData%pitchSpeed + DstBladeDataData%pitchAcc = SrcBladeDataData%pitchAcc + DstBladeDataData%origin_h = SrcBladeDataData%origin_h + DstBladeDataData%orientation_h = SrcBladeDataData%orientation_h + DstBladeDataData%hubRad_bl = SrcBladeDataData%hubRad_bl + DstBladeDataData%Rh2bl0 = SrcBladeDataData%Rh2bl0 + DstBladeDataData%motionType = SrcBladeDataData%motionType + DstBladeDataData%iMotion = SrcBladeDataData%iMotion + if (allocated(SrcBladeDataData%motion)) then + LB(1:2) = lbound(SrcBladeDataData%motion) + UB(1:2) = ubound(SrcBladeDataData%motion) + if (.not. allocated(DstBladeDataData%motion)) then + allocate(DstBladeDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeDataData%motion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeDataData%motion = SrcBladeDataData%motion + end if + DstBladeDataData%motionFileName = SrcBladeDataData%motionFileName +end subroutine + +subroutine AD_Dvr_DestroyBladeData(BladeDataData, ErrStat, ErrMsg) + type(BladeData), intent(inout) :: BladeDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyBladeData' ErrStat = ErrID_None - ErrMsg = "" - DstDvr_SimDataData%AD_InputFile = SrcDvr_SimDataData%AD_InputFile - DstDvr_SimDataData%MHK = SrcDvr_SimDataData%MHK - DstDvr_SimDataData%AnalysisType = SrcDvr_SimDataData%AnalysisType - DstDvr_SimDataData%FldDens = SrcDvr_SimDataData%FldDens - DstDvr_SimDataData%KinVisc = SrcDvr_SimDataData%KinVisc - DstDvr_SimDataData%SpdSound = SrcDvr_SimDataData%SpdSound - DstDvr_SimDataData%Patm = SrcDvr_SimDataData%Patm - DstDvr_SimDataData%Pvap = SrcDvr_SimDataData%Pvap - DstDvr_SimDataData%WtrDpth = SrcDvr_SimDataData%WtrDpth - DstDvr_SimDataData%MSL2SWL = SrcDvr_SimDataData%MSL2SWL - DstDvr_SimDataData%numTurbines = SrcDvr_SimDataData%numTurbines -IF (ALLOCATED(SrcDvr_SimDataData%WT)) THEN - i1_l = LBOUND(SrcDvr_SimDataData%WT,1) - i1_u = UBOUND(SrcDvr_SimDataData%WT,1) - IF (.NOT. ALLOCATED(DstDvr_SimDataData%WT)) THEN - ALLOCATE(DstDvr_SimDataData%WT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%WT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDvr_SimDataData%WT,1), UBOUND(SrcDvr_SimDataData%WT,1) - CALL AD_Dvr_Copywtdata( SrcDvr_SimDataData%WT(i1), DstDvr_SimDataData%WT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstDvr_SimDataData%dT = SrcDvr_SimDataData%dT - DstDvr_SimDataData%tMax = SrcDvr_SimDataData%tMax - DstDvr_SimDataData%numSteps = SrcDvr_SimDataData%numSteps - DstDvr_SimDataData%numCases = SrcDvr_SimDataData%numCases -IF (ALLOCATED(SrcDvr_SimDataData%Cases)) THEN - i1_l = LBOUND(SrcDvr_SimDataData%Cases,1) - i1_u = UBOUND(SrcDvr_SimDataData%Cases,1) - IF (.NOT. ALLOCATED(DstDvr_SimDataData%Cases)) THEN - ALLOCATE(DstDvr_SimDataData%Cases(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%Cases.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDvr_SimDataData%Cases,1), UBOUND(SrcDvr_SimDataData%Cases,1) - CALL AD_Dvr_Copydvr_case( SrcDvr_SimDataData%Cases(i1), DstDvr_SimDataData%Cases(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstDvr_SimDataData%iCase = SrcDvr_SimDataData%iCase -IF (ALLOCATED(SrcDvr_SimDataData%timeSeries)) THEN - i1_l = LBOUND(SrcDvr_SimDataData%timeSeries,1) - i1_u = UBOUND(SrcDvr_SimDataData%timeSeries,1) - i2_l = LBOUND(SrcDvr_SimDataData%timeSeries,2) - i2_u = UBOUND(SrcDvr_SimDataData%timeSeries,2) - IF (.NOT. ALLOCATED(DstDvr_SimDataData%timeSeries)) THEN - ALLOCATE(DstDvr_SimDataData%timeSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%timeSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_SimDataData%timeSeries = SrcDvr_SimDataData%timeSeries -ENDIF - DstDvr_SimDataData%iTimeSeries = SrcDvr_SimDataData%iTimeSeries - DstDvr_SimDataData%root = SrcDvr_SimDataData%root - CALL AD_Dvr_Copydvr_outputs( SrcDvr_SimDataData%out, DstDvr_SimDataData%out, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ADI_Copyiw_inputdata( SrcDvr_SimDataData%IW_InitInp, DstDvr_SimDataData%IW_InitInp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_Dvr_CopyDvr_SimData - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_SimData' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(Dvr_SimDataData%Cases) -ENDIF -IF (ALLOCATED(Dvr_SimDataData%timeSeries)) THEN - DEALLOCATE(Dvr_SimDataData%timeSeries) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_Dvr_DestroyDvr_SimData - - SUBROUTINE AD_Dvr_PackDvr_SimData( 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(Dvr_SimData), 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 = 'AD_Dvr_PackDvr_SimData' - ! 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%AD_InputFile) ! AD_InputFile - Int_BufSz = Int_BufSz + 1 ! MHK - Int_BufSz = Int_BufSz + 1 ! AnalysisType - Re_BufSz = Re_BufSz + 1 ! FldDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Re_BufSz = Re_BufSz + 1 ! Patm - Re_BufSz = Re_BufSz + 1 ! Pvap - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! numTurbines - Int_BufSz = Int_BufSz + 1 ! WT allocated yes/no - IF ( ALLOCATED(InData%WT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WT upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Db_BufSz = Db_BufSz + 1 ! dT - Db_BufSz = Db_BufSz + 1 ! tMax - Int_BufSz = Int_BufSz + 1 ! numSteps - Int_BufSz = Int_BufSz + 1 ! numCases - Int_BufSz = Int_BufSz + 1 ! Cases allocated yes/no - IF ( ALLOCATED(InData%Cases) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Cases - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Cases - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Cases - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! iCase - Int_BufSz = Int_BufSz + 1 ! timeSeries allocated yes/no - IF ( ALLOCATED(InData%timeSeries) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! timeSeries upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%timeSeries) ! timeSeries - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! out - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! out - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! out - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IW_InitInp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IW_InitInp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IW_InitInp - 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%AD_InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AD_InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AnalysisType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FldDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numTurbines - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WT) ) 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%WT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT,1) - 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 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 - DbKiBuf(Db_Xferred) = InData%dT - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numCases - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Cases) ) 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%Cases,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cases,1) - 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 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%iCase - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%timeSeries) ) 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%timeSeries,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%timeSeries,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%timeSeries,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%timeSeries,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%timeSeries,2), UBOUND(InData%timeSeries,2) - DO i1 = LBOUND(InData%timeSeries,1), UBOUND(InData%timeSeries,1) - ReKiBuf(Re_Xferred) = InData%timeSeries(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iTimeSeries - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%root) - 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 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 - 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 - - 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 AD_Dvr_PackDvr_SimData - - SUBROUTINE AD_Dvr_UnPackDvr_SimData( 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(Dvr_SimData), 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 = 'AD_Dvr_UnPackDvr_SimData' - ! 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%AD_InputFile) - OutData%AD_InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AnalysisType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FldDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = 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%numTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT 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%WT)) DEALLOCATE(OutData%WT) - ALLOCATE(OutData%WT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WT,1), UBOUND(OutData%WT,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 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 - - 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%dT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%tMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%numSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%numCases = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cases 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%Cases)) DEALLOCATE(OutData%Cases) - ALLOCATE(OutData%Cases(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cases.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cases,1), UBOUND(OutData%Cases,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 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 - - 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%iCase = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! timeSeries 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%timeSeries)) DEALLOCATE(OutData%timeSeries) - ALLOCATE(OutData%timeSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%timeSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%timeSeries,2), UBOUND(OutData%timeSeries,2) - DO i1 = LBOUND(OutData%timeSeries,1), UBOUND(OutData%timeSeries,1) - OutData%timeSeries(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%iTimeSeries = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%root) - OutData%root(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 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 - - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD_Dvr_UnPackDvr_SimData - - SUBROUTINE AD_Dvr_CopyAllData( SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AllData), INTENT(INOUT) :: SrcAllDataData - TYPE(AllData), INTENT(INOUT) :: DstAllDataData - 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 = 'AD_Dvr_CopyAllData' -! + ErrMsg = '' + if (allocated(BladeDataData%motion)) then + deallocate(BladeDataData%motion) + end if +end subroutine + +subroutine AD_Dvr_PackBladeData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BladeData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackBladeData' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%pitch) + call RegPack(Buf, InData%pitchSpeed) + call RegPack(Buf, InData%pitchAcc) + call RegPack(Buf, InData%origin_h) + call RegPack(Buf, InData%orientation_h) + call RegPack(Buf, InData%hubRad_bl) + call RegPack(Buf, InData%Rh2bl0) + call RegPack(Buf, InData%motionType) + call RegPack(Buf, InData%iMotion) + call RegPack(Buf, allocated(InData%motion)) + if (allocated(InData%motion)) then + call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) + call RegPack(Buf, InData%motion) + end if + call RegPack(Buf, InData%motionFileName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackBladeData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BladeData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackBladeData' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%pitch) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%pitchSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%pitchAcc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%origin_h) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%orientation_h) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%hubRad_bl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Rh2bl0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%motionType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%iMotion) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%motion)) deallocate(OutData%motion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%motion(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%motion) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%motionFileName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_CopyHubData(SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, ErrMsg) + type(HubData), intent(in) :: SrcHubDataData + type(HubData), intent(inout) :: DstHubDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyHubData' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_Dvr_Copydvr_simdata( SrcAllDataData%dvr, DstAllDataData%dvr, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ADI_Copydata( SrcAllDataData%ADI, DstAllDataData%ADI, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ADI_Copyfed_data( SrcAllDataData%FED, DstAllDataData%FED, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstAllDataData%errStat = SrcAllDataData%errStat - DstAllDataData%errMsg = SrcAllDataData%errMsg - DstAllDataData%initialized = SrcAllDataData%initialized - END SUBROUTINE AD_Dvr_CopyAllData - - SUBROUTINE AD_Dvr_DestroyAllData( AllDataData, ErrStat, ErrMsg ) - TYPE(AllData), INTENT(INOUT) :: AllDataData - 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 = 'AD_Dvr_DestroyAllData' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_Dvr_DestroyDvr_SimData( AllDataData%dvr, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_DestroyData( AllDataData%ADI, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_DestroyFED_Data( AllDataData%FED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_Dvr_DestroyAllData - - SUBROUTINE AD_Dvr_PackAllData( 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(AllData), 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 = 'AD_Dvr_PackAllData' - ! 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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! dvr - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! dvr - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! dvr - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ADI - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ADI - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ADI - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! errStat - Int_BufSz = Int_BufSz + 1*LEN(InData%errMsg) ! errMsg - Int_BufSz = Int_BufSz + 1 ! initialized - 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 - - 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 - - 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 - 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 - - 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 - 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 - - 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%errStat - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%errMsg) - IntKiBuf(Int_Xferred) = ICHAR(InData%errMsg(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%initialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_Dvr_PackAllData - - SUBROUTINE AD_Dvr_UnPackAllData( 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(AllData), 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 = 'AD_Dvr_UnPackAllData' - ! 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 - 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 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 - - 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 ADI_UnpackData( Re_Buf, Db_Buf, Int_Buf, OutData%ADI, ErrStat2, ErrMsg2 ) ! ADI - 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) - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%errStat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%errMsg) - OutData%errMsg(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%initialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%initialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_Dvr_UnPackAllData - + ErrMsg = '' + DstHubDataData%origin_n = SrcHubDataData%origin_n + DstHubDataData%orientation_n = SrcHubDataData%orientation_n + DstHubDataData%motionType = SrcHubDataData%motionType + DstHubDataData%iMotion = SrcHubDataData%iMotion + DstHubDataData%azimuth = SrcHubDataData%azimuth + DstHubDataData%rotSpeed = SrcHubDataData%rotSpeed + DstHubDataData%rotAcc = SrcHubDataData%rotAcc + DstHubDataData%motionFileName = SrcHubDataData%motionFileName + if (allocated(SrcHubDataData%motion)) then + LB(1:2) = lbound(SrcHubDataData%motion) + UB(1:2) = ubound(SrcHubDataData%motion) + if (.not. allocated(DstHubDataData%motion)) then + allocate(DstHubDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHubDataData%motion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstHubDataData%motion = SrcHubDataData%motion + end if +end subroutine + +subroutine AD_Dvr_DestroyHubData(HubDataData, ErrStat, ErrMsg) + type(HubData), intent(inout) :: HubDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyHubData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(HubDataData%motion)) then + deallocate(HubDataData%motion) + end if +end subroutine + +subroutine AD_Dvr_PackHubData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HubData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackHubData' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%origin_n) + call RegPack(Buf, InData%orientation_n) + call RegPack(Buf, InData%motionType) + call RegPack(Buf, InData%iMotion) + call RegPack(Buf, InData%azimuth) + call RegPack(Buf, InData%rotSpeed) + call RegPack(Buf, InData%rotAcc) + call RegPack(Buf, InData%motionFileName) + call RegPack(Buf, allocated(InData%motion)) + if (allocated(InData%motion)) then + call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) + call RegPack(Buf, InData%motion) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackHubData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HubData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackHubData' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%origin_n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%orientation_n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%motionType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%iMotion) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%azimuth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rotAcc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%motionFileName) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%motion)) deallocate(OutData%motion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%motion(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%motion) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD_Dvr_CopyNacData(SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, ErrMsg) + type(NacData), intent(in) :: SrcNacDataData + type(NacData), intent(inout) :: DstNacDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyNacData' + ErrStat = ErrID_None + ErrMsg = '' + DstNacDataData%origin_t = SrcNacDataData%origin_t + DstNacDataData%motionType = SrcNacDataData%motionType + DstNacDataData%iMotion = SrcNacDataData%iMotion + DstNacDataData%yaw = SrcNacDataData%yaw + DstNacDataData%yawSpeed = SrcNacDataData%yawSpeed + DstNacDataData%yawAcc = SrcNacDataData%yawAcc + DstNacDataData%motionFileName = SrcNacDataData%motionFileName + if (allocated(SrcNacDataData%motion)) then + LB(1:2) = lbound(SrcNacDataData%motion) + UB(1:2) = ubound(SrcNacDataData%motion) + if (.not. allocated(DstNacDataData%motion)) then + allocate(DstNacDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstNacDataData%motion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstNacDataData%motion = SrcNacDataData%motion + end if +end subroutine + +subroutine AD_Dvr_DestroyNacData(NacDataData, ErrStat, ErrMsg) + type(NacData), intent(inout) :: NacDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyNacData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(NacDataData%motion)) then + deallocate(NacDataData%motion) + end if +end subroutine + +subroutine AD_Dvr_PackNacData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(NacData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackNacData' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%origin_t) + call RegPack(Buf, InData%motionType) + call RegPack(Buf, InData%iMotion) + call RegPack(Buf, InData%yaw) + call RegPack(Buf, InData%yawSpeed) + call RegPack(Buf, InData%yawAcc) + call RegPack(Buf, InData%motionFileName) + call RegPack(Buf, allocated(InData%motion)) + if (allocated(InData%motion)) then + call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) + call RegPack(Buf, InData%motion) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackNacData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(NacData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackNacData' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%origin_t) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%motionType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%iMotion) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%yaw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%yawSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%yawAcc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%motionFileName) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%motion)) deallocate(OutData%motion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%motion(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%motion) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD_Dvr_CopyTwrData(SrcTwrDataData, DstTwrDataData, CtrlCode, ErrStat, ErrMsg) + type(TwrData), intent(in) :: SrcTwrDataData + type(TwrData), intent(inout) :: DstTwrDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_CopyTwrData' + ErrStat = ErrID_None + ErrMsg = '' + DstTwrDataData%origin_t = SrcTwrDataData%origin_t +end subroutine + +subroutine AD_Dvr_DestroyTwrData(TwrDataData, ErrStat, ErrMsg) + type(TwrData), intent(inout) :: TwrDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyTwrData' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD_Dvr_PackTwrData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TwrData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackTwrData' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%origin_t) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackTwrData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TwrData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackTwrData' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%origin_t) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, ErrMsg) + type(WTData), intent(inout) :: SrcWTDataData + type(WTData), intent(inout) :: DstWTDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyWTData' + ErrStat = ErrID_None + ErrMsg = '' + DstWTDataData%originInit = SrcWTDataData%originInit + DstWTDataData%orientationInit = SrcWTDataData%orientationInit + call NWTC_Library_CopyMeshMapType(SrcWTDataData%map2twrPt, DstWTDataData%map2twrPt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcWTDataData%map2nacPt, DstWTDataData%map2nacPt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcWTDataData%map2hubPt, DstWTDataData%map2hubPt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcWTDataData%map2BldPt)) then + LB(1:1) = lbound(SrcWTDataData%map2BldPt) + UB(1:1) = ubound(SrcWTDataData%map2BldPt) + if (.not. allocated(DstWTDataData%map2BldPt)) then + allocate(DstWTDataData%map2BldPt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%map2BldPt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcWTDataData%map2BldPt(i1), DstWTDataData%map2BldPt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcWTDataData%bld)) then + LB(1:1) = lbound(SrcWTDataData%bld) + UB(1:1) = ubound(SrcWTDataData%bld) + if (.not. allocated(DstWTDataData%bld)) then + allocate(DstWTDataData%bld(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%bld.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_Dvr_CopyBladeData(SrcWTDataData%bld(i1), DstWTDataData%bld(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call AD_Dvr_CopyHubData(SrcWTDataData%hub, DstWTDataData%hub, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_Dvr_CopyNacData(SrcWTDataData%nac, DstWTDataData%nac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_Dvr_CopyTwrData(SrcWTDataData%twr, DstWTDataData%twr, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstWTDataData%numBlades = SrcWTDataData%numBlades + DstWTDataData%basicHAWTFormat = SrcWTDataData%basicHAWTFormat + DstWTDataData%hasTower = SrcWTDataData%hasTower + DstWTDataData%projMod = SrcWTDataData%projMod + DstWTDataData%BEM_Mod = SrcWTDataData%BEM_Mod + DstWTDataData%HAWTprojection = SrcWTDataData%HAWTprojection + DstWTDataData%motionType = SrcWTDataData%motionType + if (allocated(SrcWTDataData%motion)) then + LB(1:2) = lbound(SrcWTDataData%motion) + UB(1:2) = ubound(SrcWTDataData%motion) + if (.not. allocated(DstWTDataData%motion)) then + allocate(DstWTDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%motion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWTDataData%motion = SrcWTDataData%motion + end if + DstWTDataData%iMotion = SrcWTDataData%iMotion + DstWTDataData%degreeOfFreedom = SrcWTDataData%degreeOfFreedom + DstWTDataData%amplitude = SrcWTDataData%amplitude + DstWTDataData%frequency = SrcWTDataData%frequency + DstWTDataData%motionFileName = SrcWTDataData%motionFileName + if (allocated(SrcWTDataData%WriteOutput)) then + LB(1:1) = lbound(SrcWTDataData%WriteOutput) + UB(1:1) = ubound(SrcWTDataData%WriteOutput) + if (.not. allocated(DstWTDataData%WriteOutput)) then + allocate(DstWTDataData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWTDataData%WriteOutput = SrcWTDataData%WriteOutput + end if + if (allocated(SrcWTDataData%userSwapArray)) then + LB(1:1) = lbound(SrcWTDataData%userSwapArray) + UB(1:1) = ubound(SrcWTDataData%userSwapArray) + if (.not. allocated(DstWTDataData%userSwapArray)) then + allocate(DstWTDataData%userSwapArray(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%userSwapArray.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWTDataData%userSwapArray = SrcWTDataData%userSwapArray + end if +end subroutine + +subroutine AD_Dvr_DestroyWTData(WTDataData, ErrStat, ErrMsg) + type(WTData), intent(inout) :: WTDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyWTData' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyMeshMapType(WTDataData%map2twrPt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(WTDataData%map2nacPt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(WTDataData%map2hubPt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(WTDataData%map2BldPt)) then + LB(1:1) = lbound(WTDataData%map2BldPt) + UB(1:1) = ubound(WTDataData%map2BldPt) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(WTDataData%map2BldPt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(WTDataData%map2BldPt) + end if + if (allocated(WTDataData%bld)) then + LB(1:1) = lbound(WTDataData%bld) + UB(1:1) = ubound(WTDataData%bld) + do i1 = LB(1), UB(1) + call AD_Dvr_DestroyBladeData(WTDataData%bld(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(WTDataData%bld) + end if + call AD_Dvr_DestroyHubData(WTDataData%hub, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_Dvr_DestroyNacData(WTDataData%nac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_Dvr_DestroyTwrData(WTDataData%twr, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(WTDataData%motion)) then + deallocate(WTDataData%motion) + end if + if (allocated(WTDataData%WriteOutput)) then + deallocate(WTDataData%WriteOutput) + end if + if (allocated(WTDataData%userSwapArray)) then + deallocate(WTDataData%userSwapArray) + end if +end subroutine + +subroutine AD_Dvr_PackWTData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WTData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackWTData' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%originInit) + call RegPack(Buf, InData%orientationInit) + call NWTC_Library_PackMeshMapType(Buf, InData%map2twrPt) + call NWTC_Library_PackMeshMapType(Buf, InData%map2nacPt) + call NWTC_Library_PackMeshMapType(Buf, InData%map2hubPt) + call RegPack(Buf, allocated(InData%map2BldPt)) + if (allocated(InData%map2BldPt)) then + call RegPackBounds(Buf, 1, lbound(InData%map2BldPt), ubound(InData%map2BldPt)) + LB(1:1) = lbound(InData%map2BldPt) + UB(1:1) = ubound(InData%map2BldPt) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%map2BldPt(i1)) + end do + end if + call RegPack(Buf, allocated(InData%bld)) + if (allocated(InData%bld)) then + call RegPackBounds(Buf, 1, lbound(InData%bld), ubound(InData%bld)) + LB(1:1) = lbound(InData%bld) + UB(1:1) = ubound(InData%bld) + do i1 = LB(1), UB(1) + call AD_Dvr_PackBladeData(Buf, InData%bld(i1)) + end do + end if + call AD_Dvr_PackHubData(Buf, InData%hub) + call AD_Dvr_PackNacData(Buf, InData%nac) + call AD_Dvr_PackTwrData(Buf, InData%twr) + call RegPack(Buf, InData%numBlades) + call RegPack(Buf, InData%basicHAWTFormat) + call RegPack(Buf, InData%hasTower) + call RegPack(Buf, InData%projMod) + call RegPack(Buf, InData%BEM_Mod) + call RegPack(Buf, InData%HAWTprojection) + call RegPack(Buf, InData%motionType) + call RegPack(Buf, allocated(InData%motion)) + if (allocated(InData%motion)) then + call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) + call RegPack(Buf, InData%motion) + end if + call RegPack(Buf, InData%iMotion) + call RegPack(Buf, InData%degreeOfFreedom) + call RegPack(Buf, InData%amplitude) + call RegPack(Buf, InData%frequency) + call RegPack(Buf, InData%motionFileName) + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + call RegPack(Buf, allocated(InData%userSwapArray)) + if (allocated(InData%userSwapArray)) then + call RegPackBounds(Buf, 1, lbound(InData%userSwapArray), ubound(InData%userSwapArray)) + call RegPack(Buf, InData%userSwapArray) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackWTData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WTData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackWTData' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%originInit) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%orientationInit) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2twrPt) ! map2twrPt + call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2nacPt) ! map2nacPt + call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2hubPt) ! map2hubPt + if (allocated(OutData%map2BldPt)) deallocate(OutData%map2BldPt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%map2BldPt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%map2BldPt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2BldPt(i1)) ! map2BldPt + end do + end if + if (allocated(OutData%bld)) deallocate(OutData%bld) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%bld(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%bld.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_Dvr_UnpackBladeData(Buf, OutData%bld(i1)) ! bld + end do + end if + call AD_Dvr_UnpackHubData(Buf, OutData%hub) ! hub + call AD_Dvr_UnpackNacData(Buf, OutData%nac) ! nac + call AD_Dvr_UnpackTwrData(Buf, OutData%twr) ! twr + call RegUnpack(Buf, OutData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%basicHAWTFormat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%hasTower) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%projMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HAWTprojection) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%motionType) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%motion)) deallocate(OutData%motion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%motion(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%motion) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%iMotion) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%degreeOfFreedom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%amplitude) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%frequency) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%motionFileName) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%userSwapArray)) deallocate(OutData%userSwapArray) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%userSwapArray(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%userSwapArray.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%userSwapArray) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCode, ErrStat, ErrMsg) + type(Dvr_SimData), intent(inout) :: SrcDvr_SimDataData + type(Dvr_SimData), intent(inout) :: DstDvr_SimDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvr_SimData' + ErrStat = ErrID_None + ErrMsg = '' + DstDvr_SimDataData%AD_InputFile = SrcDvr_SimDataData%AD_InputFile + DstDvr_SimDataData%MHK = SrcDvr_SimDataData%MHK + DstDvr_SimDataData%AnalysisType = SrcDvr_SimDataData%AnalysisType + DstDvr_SimDataData%FldDens = SrcDvr_SimDataData%FldDens + DstDvr_SimDataData%KinVisc = SrcDvr_SimDataData%KinVisc + DstDvr_SimDataData%SpdSound = SrcDvr_SimDataData%SpdSound + DstDvr_SimDataData%Patm = SrcDvr_SimDataData%Patm + DstDvr_SimDataData%Pvap = SrcDvr_SimDataData%Pvap + DstDvr_SimDataData%WtrDpth = SrcDvr_SimDataData%WtrDpth + DstDvr_SimDataData%MSL2SWL = SrcDvr_SimDataData%MSL2SWL + DstDvr_SimDataData%numTurbines = SrcDvr_SimDataData%numTurbines + if (allocated(SrcDvr_SimDataData%WT)) then + LB(1:1) = lbound(SrcDvr_SimDataData%WT) + UB(1:1) = ubound(SrcDvr_SimDataData%WT) + if (.not. allocated(DstDvr_SimDataData%WT)) then + allocate(DstDvr_SimDataData%WT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%WT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_Dvr_CopyWTData(SrcDvr_SimDataData%WT(i1), DstDvr_SimDataData%WT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstDvr_SimDataData%dT = SrcDvr_SimDataData%dT + DstDvr_SimDataData%tMax = SrcDvr_SimDataData%tMax + DstDvr_SimDataData%numSteps = SrcDvr_SimDataData%numSteps + DstDvr_SimDataData%numCases = SrcDvr_SimDataData%numCases + if (allocated(SrcDvr_SimDataData%Cases)) then + LB(1:1) = lbound(SrcDvr_SimDataData%Cases) + UB(1:1) = ubound(SrcDvr_SimDataData%Cases) + if (.not. allocated(DstDvr_SimDataData%Cases)) then + allocate(DstDvr_SimDataData%Cases(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%Cases.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_Dvr_CopyDvr_Case(SrcDvr_SimDataData%Cases(i1), DstDvr_SimDataData%Cases(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstDvr_SimDataData%iCase = SrcDvr_SimDataData%iCase + if (allocated(SrcDvr_SimDataData%timeSeries)) then + LB(1:2) = lbound(SrcDvr_SimDataData%timeSeries) + UB(1:2) = ubound(SrcDvr_SimDataData%timeSeries) + if (.not. allocated(DstDvr_SimDataData%timeSeries)) then + allocate(DstDvr_SimDataData%timeSeries(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%timeSeries.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_SimDataData%timeSeries = SrcDvr_SimDataData%timeSeries + end if + DstDvr_SimDataData%iTimeSeries = SrcDvr_SimDataData%iTimeSeries + DstDvr_SimDataData%root = SrcDvr_SimDataData%root + call AD_Dvr_CopyDvr_Outputs(SrcDvr_SimDataData%out, DstDvr_SimDataData%out, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyIW_InputData(SrcDvr_SimDataData%IW_InitInp, DstDvr_SimDataData%IW_InitInp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +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 + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_SimData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Dvr_SimDataData%WT)) then + LB(1:1) = lbound(Dvr_SimDataData%WT) + UB(1:1) = ubound(Dvr_SimDataData%WT) + do i1 = LB(1), UB(1) + call AD_Dvr_DestroyWTData(Dvr_SimDataData%WT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(Dvr_SimDataData%WT) + end if + if (allocated(Dvr_SimDataData%Cases)) then + LB(1:1) = lbound(Dvr_SimDataData%Cases) + UB(1:1) = ubound(Dvr_SimDataData%Cases) + do i1 = LB(1), UB(1) + call AD_Dvr_DestroyDvr_Case(Dvr_SimDataData%Cases(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(Dvr_SimDataData%Cases) + end if + if (allocated(Dvr_SimDataData%timeSeries)) then + deallocate(Dvr_SimDataData%timeSeries) + end if + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Dvr_SimData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_SimData' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%AD_InputFile) + call RegPack(Buf, InData%MHK) + call RegPack(Buf, InData%AnalysisType) + call RegPack(Buf, InData%FldDens) + call RegPack(Buf, InData%KinVisc) + call RegPack(Buf, InData%SpdSound) + call RegPack(Buf, InData%Patm) + call RegPack(Buf, InData%Pvap) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%MSL2SWL) + call RegPack(Buf, InData%numTurbines) + call RegPack(Buf, allocated(InData%WT)) + if (allocated(InData%WT)) then + call RegPackBounds(Buf, 1, lbound(InData%WT), ubound(InData%WT)) + LB(1:1) = lbound(InData%WT) + UB(1:1) = ubound(InData%WT) + do i1 = LB(1), UB(1) + call AD_Dvr_PackWTData(Buf, InData%WT(i1)) + end do + end if + call RegPack(Buf, InData%dT) + call RegPack(Buf, InData%tMax) + call RegPack(Buf, InData%numSteps) + call RegPack(Buf, InData%numCases) + call RegPack(Buf, allocated(InData%Cases)) + if (allocated(InData%Cases)) then + call RegPackBounds(Buf, 1, lbound(InData%Cases), ubound(InData%Cases)) + LB(1:1) = lbound(InData%Cases) + UB(1:1) = ubound(InData%Cases) + do i1 = LB(1), UB(1) + call AD_Dvr_PackDvr_Case(Buf, InData%Cases(i1)) + end do + end if + call RegPack(Buf, InData%iCase) + call RegPack(Buf, allocated(InData%timeSeries)) + if (allocated(InData%timeSeries)) then + call RegPackBounds(Buf, 2, lbound(InData%timeSeries), ubound(InData%timeSeries)) + call RegPack(Buf, InData%timeSeries) + end if + call RegPack(Buf, InData%iTimeSeries) + call RegPack(Buf, InData%root) + call AD_Dvr_PackDvr_Outputs(Buf, InData%out) + call ADI_PackIW_InputData(Buf, InData%IW_InitInp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackDvr_SimData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Dvr_SimData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_SimData' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%AD_InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AnalysisType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FldDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Patm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Pvap) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%numTurbines) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WT)) deallocate(OutData%WT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_Dvr_UnpackWTData(Buf, OutData%WT(i1)) ! WT + end do + end if + call RegUnpack(Buf, OutData%dT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%numSteps) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%numCases) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Cases)) deallocate(OutData%Cases) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cases(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cases.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_Dvr_UnpackDvr_Case(Buf, OutData%Cases(i1)) ! Cases + end do + end if + call RegUnpack(Buf, OutData%iCase) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%timeSeries)) deallocate(OutData%timeSeries) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%timeSeries(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%timeSeries.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%timeSeries) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%iTimeSeries) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%root) + if (RegCheckErr(Buf, RoutineName)) return + call AD_Dvr_UnpackDvr_Outputs(Buf, OutData%out) ! out + call ADI_UnpackIW_InputData(Buf, OutData%IW_InitInp) ! IW_InitInp +end subroutine + +subroutine AD_Dvr_CopyAllData(SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, ErrMsg) + type(AllData), intent(inout) :: SrcAllDataData + type(AllData), intent(inout) :: DstAllDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyAllData' + ErrStat = ErrID_None + ErrMsg = '' + call AD_Dvr_CopyDvr_SimData(SrcAllDataData%dvr, DstAllDataData%dvr, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyData(SrcAllDataData%ADI, DstAllDataData%ADI, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyFED_Data(SrcAllDataData%FED, DstAllDataData%FED, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstAllDataData%errStat = SrcAllDataData%errStat + DstAllDataData%errMsg = SrcAllDataData%errMsg + DstAllDataData%initialized = SrcAllDataData%initialized +end subroutine + +subroutine AD_Dvr_DestroyAllData(AllDataData, ErrStat, ErrMsg) + type(AllData), intent(inout) :: AllDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyAllData' + ErrStat = ErrID_None + ErrMsg = '' + call AD_Dvr_DestroyDvr_SimData(AllDataData%dvr, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyData(AllDataData%ADI, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyFED_Data(AllDataData%FED, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_Dvr_PackAllData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AllData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackAllData' + if (Buf%ErrStat >= AbortErrLev) return + call AD_Dvr_PackDvr_SimData(Buf, InData%dvr) + call ADI_PackData(Buf, InData%ADI) + call ADI_PackFED_Data(Buf, InData%FED) + call RegPack(Buf, InData%errStat) + call RegPack(Buf, InData%errMsg) + call RegPack(Buf, InData%initialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackAllData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AllData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackAllData' + if (Buf%ErrStat /= ErrID_None) return + call AD_Dvr_UnpackDvr_SimData(Buf, OutData%dvr) ! dvr + call ADI_UnpackData(Buf, OutData%ADI) ! ADI + call ADI_UnpackFED_Data(Buf, OutData%FED) ! FED + call RegUnpack(Buf, OutData%errStat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%errMsg) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%initialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE AeroDyn_Driver_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index 6450bbc614..d8cf22afaa 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -2405,7 +2405,7 @@ subroutine hpsort_eps_epw (n, ra, ind, eps) implicit none !-input/output variables integer(IntKi), intent(in) :: n - real, intent(in) :: eps + real(ReKi), intent(in) :: eps integer(IntKi) :: ind (n) real(ReKi) :: ra (n) !-local variables diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index bad6784950..d0acace6f4 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -45,20 +45,20 @@ MODULE AeroDyn_Inflow_Types TYPE(InflowWind_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(InflowWind_InputType) :: u !< Array of inputs associated with InputTimes [-] TYPE(InflowWind_OutputType) :: y !< System outputs [-] - INTEGER(IntKi) :: CompInflow !< 0=Steady Wind, 1=InflowWind [-] - REAL(ReKi) :: HWindSpeed !< RefHeight Wind speed [-] - REAL(ReKi) :: RefHt !< RefHeight [-] - REAL(ReKi) :: PLExp !< PLExp [-] + INTEGER(IntKi) :: CompInflow = 0_IntKi !< 0=Steady Wind, 1=InflowWind [-] + REAL(ReKi) :: HWindSpeed = 0.0_ReKi !< RefHeight Wind speed [-] + REAL(ReKi) :: RefHt = 0.0_ReKi !< RefHeight [-] + REAL(ReKi) :: PLExp = 0.0_ReKi !< PLExp [-] END TYPE ADI_InflowWindData ! ======================= ! ========= ADI_IW_InputData ======= TYPE, PUBLIC :: ADI_IW_InputData Character(1024) :: InputFile !< Name of InfloWind input file [-] - INTEGER(IntKi) :: CompInflow !< 0=Steady Wind, 1=InflowWind [-] - REAL(ReKi) :: HWindSpeed !< RefHeight Wind speed [-] - REAL(ReKi) :: RefHt !< RefHeight [-] - REAL(ReKi) :: PLExp !< PLExp [-] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] + INTEGER(IntKi) :: CompInflow = 0_IntKi !< 0=Steady Wind, 1=InflowWind [-] + REAL(ReKi) :: HWindSpeed = 0.0_ReKi !< RefHeight Wind speed [-] + REAL(ReKi) :: RefHt = 0.0_ReKi !< RefHeight [-] + REAL(ReKi) :: PLExp = 0.0_ReKi !< PLExp [-] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] LOGICAL :: UseInputFile = .TRUE. !< Should we read everthing from an input file, or is it passed in? [-] TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] @@ -72,7 +72,7 @@ MODULE AeroDyn_Inflow_Types LOGICAL :: storeHHVel = .false. !< If True, hub height velocity will be computed by infow wind [-] INTEGER(IntKi) :: WrVTK = 0 !< 0= no vtk, 1=init only, 2=animation [-] INTEGER(IntKi) :: WrVTK_Type = 1 !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] END TYPE ADI_InitInputType ! ======================= ! ========= ADI_InitOutputType ======= @@ -112,13 +112,13 @@ MODULE AeroDyn_Inflow_Types ! ========= ADI_ParameterType ======= TYPE, PUBLIC :: ADI_ParameterType TYPE(AD_ParameterType) :: AD !< Parameters [-] - REAL(DbKi) :: dt !< time increment [s] - LOGICAL :: storeHHVel !< If True, hub height velocity will be computed by infow wind [-] - INTEGER(IntKi) :: wrVTK !< 0= no vtk, 1=init only, 2=animation [-] - INTEGER(IntKi) :: WrVTK_Type !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] + REAL(DbKi) :: dt = 0.0_R8Ki !< time increment [s] + LOGICAL :: storeHHVel = .false. !< If True, hub height velocity will be computed by infow wind [-] + INTEGER(IntKi) :: wrVTK = 0_IntKi !< 0= no vtk, 1=init only, 2=animation [-] + INTEGER(IntKi) :: WrVTK_Type = 0_IntKi !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] INTEGER(IntKi) :: NumOuts = 0 !< Total number of WriteOutput outputs [-] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] END TYPE ADI_ParameterType ! ======================= ! ========= ADI_InputType ======= @@ -130,7 +130,7 @@ MODULE AeroDyn_Inflow_Types TYPE, PUBLIC :: ADI_OutputType TYPE(AD_OutputType) :: AD !< System outputs [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: HHVel !< Hub Height velocities for each rotors [-] - REAL(ReKi) :: PLExp !< Power law exponents (for outputs only) [-] + REAL(ReKi) :: PLExp = 0.0_ReKi !< Power law exponents (for outputs only) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: IW_WriteOutput !< WriteOutputs for inflow wind [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< System outputs [-] END TYPE ADI_OutputType @@ -159,7 +159,7 @@ MODULE AeroDyn_Inflow_Types TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLn2Mesh !< (only if elastic blades) BladeLn2Mesh Line mesh along blade [-] LOGICAL :: hasTower = .true. !< True if a tower is present [-] LOGICAL :: rigidBlades = .true. !< True if blades are rigid (using BladeRootMotion) or not (Useing BldeLn2Mesh) [-] - INTEGER(IntKi) :: numBlades !< Number of blades [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< Number of blades [-] TYPE(MeshMapType) :: ED_P_2_AD_P_T !< (only if hasTower) Mesh mapping from tower base to AD tower base [-] TYPE(MeshMapType) :: AD_P_2_AD_L_T !< (only if hasTower) Mesh mapping from tower base to AD tower line [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: AD_P_2_AD_L_B !< (only for rigid blades) Mesh mapping from AD blade root to AD line mesh [-] @@ -175,7026 +175,1731 @@ MODULE AeroDyn_Inflow_Types END TYPE FED_Data ! ======================= CONTAINS - SUBROUTINE ADI_CopyInflowWindData( SrcInflowWindDataData, DstInflowWindDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_InflowWindData), INTENT(IN) :: SrcInflowWindDataData - TYPE(ADI_InflowWindData), INTENT(INOUT) :: DstInflowWindDataData - 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 = 'ADI_CopyInflowWindData' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL InflowWind_CopyContState( SrcInflowWindDataData%x, DstInflowWindDataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyDiscState( SrcInflowWindDataData%xd, DstInflowWindDataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyConstrState( SrcInflowWindDataData%z, DstInflowWindDataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOtherState( SrcInflowWindDataData%OtherSt, DstInflowWindDataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyParam( SrcInflowWindDataData%p, DstInflowWindDataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyMisc( SrcInflowWindDataData%m, DstInflowWindDataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcInflowWindDataData%u, DstInflowWindDataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcInflowWindDataData%y, DstInflowWindDataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInflowWindDataData%CompInflow = SrcInflowWindDataData%CompInflow - DstInflowWindDataData%HWindSpeed = SrcInflowWindDataData%HWindSpeed - DstInflowWindDataData%RefHt = SrcInflowWindDataData%RefHt - DstInflowWindDataData%PLExp = SrcInflowWindDataData%PLExp - END SUBROUTINE ADI_CopyInflowWindData - - SUBROUTINE ADI_DestroyInflowWindData( InflowWindDataData, ErrStat, ErrMsg ) - TYPE(ADI_InflowWindData), INTENT(INOUT) :: InflowWindDataData - 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 = 'ADI_DestroyInflowWindData' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL InflowWind_DestroyContState( InflowWindDataData%x, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyDiscState( InflowWindDataData%xd, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyConstrState( InflowWindDataData%z, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOtherState( InflowWindDataData%OtherSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyParam( InflowWindDataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyMisc( InflowWindDataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( InflowWindDataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( InflowWindDataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyInflowWindData - - SUBROUTINE ADI_PackInflowWindData( 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(ADI_InflowWindData), 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 = 'ADI_PackInflowWindData' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CompInflow - Re_BufSz = Re_BufSz + 1 ! HWindSpeed - Re_BufSz = Re_BufSz + 1 ! RefHt - Re_BufSz = Re_BufSz + 1 ! PLExp - 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 - - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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%CompInflow - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_PackInflowWindData - - SUBROUTINE ADI_UnPackInflowWindData( 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(ADI_InflowWindData), 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 = 'ADI_UnPackInflowWindData' - ! 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 - 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 InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - 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) - 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 InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - 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) - 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 InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - 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) - 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 InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - 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) - 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 InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - 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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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%CompInflow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_UnPackInflowWindData - - SUBROUTINE ADI_CopyIW_InputData( SrcIW_InputDataData, DstIW_InputDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_IW_InputData), INTENT(IN) :: SrcIW_InputDataData - TYPE(ADI_IW_InputData), INTENT(INOUT) :: DstIW_InputDataData - 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 = 'ADI_CopyIW_InputData' -! +subroutine ADI_CopyInflowWindData(SrcInflowWindDataData, DstInflowWindDataData, CtrlCode, ErrStat, ErrMsg) + type(ADI_InflowWindData), intent(in) :: SrcInflowWindDataData + type(ADI_InflowWindData), intent(inout) :: DstInflowWindDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyInflowWindData' ErrStat = ErrID_None - ErrMsg = "" - DstIW_InputDataData%InputFile = SrcIW_InputDataData%InputFile - DstIW_InputDataData%CompInflow = SrcIW_InputDataData%CompInflow - DstIW_InputDataData%HWindSpeed = SrcIW_InputDataData%HWindSpeed - DstIW_InputDataData%RefHt = SrcIW_InputDataData%RefHt - DstIW_InputDataData%PLExp = SrcIW_InputDataData%PLExp - DstIW_InputDataData%MHK = SrcIW_InputDataData%MHK - DstIW_InputDataData%UseInputFile = SrcIW_InputDataData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcIW_InputDataData%PassedFileData, DstIW_InputDataData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstIW_InputDataData%Linearize = SrcIW_InputDataData%Linearize - END SUBROUTINE ADI_CopyIW_InputData - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyIW_InputData' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyFileInfoType( IW_InputDataData%PassedFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyIW_InputData - - SUBROUTINE ADI_PackIW_InputData( 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(ADI_IW_InputData), 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 = 'ADI_PackIW_InputData' - ! 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 ! CompInflow - Re_BufSz = Re_BufSz + 1 ! HWindSpeed - Re_BufSz = Re_BufSz + 1 ! RefHt - Re_BufSz = Re_BufSz + 1 ! PLExp - Int_BufSz = Int_BufSz + 1 ! MHK - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Linearize - 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 - IntKiBuf(Int_Xferred) = InData%CompInflow - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - 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 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) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ADI_PackIW_InputData - - SUBROUTINE ADI_UnPackIW_InputData( 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(ADI_IW_InputData), 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 = 'ADI_UnPackIW_InputData' - ! 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%CompInflow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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) - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ADI_UnPackIW_InputData - - SUBROUTINE ADI_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(ADI_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyInitInput' -! + ErrMsg = '' + call InflowWind_CopyContState(SrcInflowWindDataData%x, DstInflowWindDataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyDiscState(SrcInflowWindDataData%xd, DstInflowWindDataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyConstrState(SrcInflowWindDataData%z, DstInflowWindDataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOtherState(SrcInflowWindDataData%OtherSt, DstInflowWindDataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyParam(SrcInflowWindDataData%p, DstInflowWindDataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyMisc(SrcInflowWindDataData%m, DstInflowWindDataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcInflowWindDataData%u, DstInflowWindDataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcInflowWindDataData%y, DstInflowWindDataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInflowWindDataData%CompInflow = SrcInflowWindDataData%CompInflow + DstInflowWindDataData%HWindSpeed = SrcInflowWindDataData%HWindSpeed + DstInflowWindDataData%RefHt = SrcInflowWindDataData%RefHt + DstInflowWindDataData%PLExp = SrcInflowWindDataData%PLExp +end subroutine + +subroutine ADI_DestroyInflowWindData(InflowWindDataData, ErrStat, ErrMsg) + type(ADI_InflowWindData), intent(inout) :: InflowWindDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyInflowWindData' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyInitInput( SrcInitInputData%AD, DstInitInputData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ADI_Copyiw_inputdata( SrcInitInputData%IW_InitInp, DstInitInputData%IW_InitInp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%storeHHVel = SrcInitInputData%storeHHVel - DstInitInputData%WrVTK = SrcInitInputData%WrVTK - DstInitInputData%WrVTK_Type = SrcInitInputData%WrVTK_Type - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - END SUBROUTINE ADI_CopyInitInput - - SUBROUTINE ADI_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(ADI_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 = 'ADI_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyInitInput( InitInputData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_DestroyIW_InputData( InitInputData%IW_InitInp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyInitInput - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IW_InitInp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IW_InitInp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IW_InitInp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! storeHHVel - Int_BufSz = Int_BufSz + 1 ! WrVTK - Int_BufSz = Int_BufSz + 1 ! WrVTK_Type - 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 - - CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 - 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 - - 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 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%storeHHVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK_Type - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_PackInitInput - - SUBROUTINE ADI_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(ADI_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_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 - 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 AD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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) - 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 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 - - 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%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%storeHHVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%storeHHVel) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK_Type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_UnPackInitInput - - SUBROUTINE ADI_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(ADI_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 = 'ADI_CopyInitOutput' -! + ErrMsg = '' + call InflowWind_DestroyContState(InflowWindDataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyDiscState(InflowWindDataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyConstrState(InflowWindDataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOtherState(InflowWindDataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyParam(InflowWindDataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyMisc(InflowWindDataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInput(InflowWindDataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(InflowWindDataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackInflowWindData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InflowWindData), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackInflowWindData' + if (Buf%ErrStat >= AbortErrLev) return + call InflowWind_PackContState(Buf, InData%x) + call InflowWind_PackDiscState(Buf, InData%xd) + call InflowWind_PackConstrState(Buf, InData%z) + call InflowWind_PackOtherState(Buf, InData%OtherSt) + call InflowWind_PackParam(Buf, InData%p) + call InflowWind_PackMisc(Buf, InData%m) + call InflowWind_PackInput(Buf, InData%u) + call InflowWind_PackOutput(Buf, InData%y) + call RegPack(Buf, InData%CompInflow) + call RegPack(Buf, InData%HWindSpeed) + call RegPack(Buf, InData%RefHt) + call RegPack(Buf, InData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackInflowWindData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InflowWindData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackInflowWindData' + if (Buf%ErrStat /= ErrID_None) return + call InflowWind_UnpackContState(Buf, OutData%x) ! x + call InflowWind_UnpackDiscState(Buf, OutData%xd) ! xd + call InflowWind_UnpackConstrState(Buf, OutData%z) ! z + call InflowWind_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt + call InflowWind_UnpackParam(Buf, OutData%p) ! p + call InflowWind_UnpackMisc(Buf, OutData%m) ! m + call InflowWind_UnpackInput(Buf, OutData%u) ! u + call InflowWind_UnpackOutput(Buf, OutData%y) ! y + call RegUnpack(Buf, OutData%CompInflow) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_CopyIW_InputData(SrcIW_InputDataData, DstIW_InputDataData, CtrlCode, ErrStat, ErrMsg) + type(ADI_IW_InputData), intent(in) :: SrcIW_InputDataData + type(ADI_IW_InputData), intent(inout) :: DstIW_InputDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyIW_InputData' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -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 - END SUBROUTINE ADI_CopyInitOutput - - SUBROUTINE ADI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(ADI_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 = 'ADI_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE ADI_DestroyInitOutput - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 - 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 - - 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 - - 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 - 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 - END SUBROUTINE ADI_PackInitOutput - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - 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) - 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 - END SUBROUTINE ADI_UnPackInitOutput - - SUBROUTINE ADI_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(ADI_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 = 'ADI_CopyContState' -! + ErrMsg = '' + DstIW_InputDataData%InputFile = SrcIW_InputDataData%InputFile + DstIW_InputDataData%CompInflow = SrcIW_InputDataData%CompInflow + DstIW_InputDataData%HWindSpeed = SrcIW_InputDataData%HWindSpeed + DstIW_InputDataData%RefHt = SrcIW_InputDataData%RefHt + DstIW_InputDataData%PLExp = SrcIW_InputDataData%PLExp + DstIW_InputDataData%MHK = SrcIW_InputDataData%MHK + DstIW_InputDataData%UseInputFile = SrcIW_InputDataData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcIW_InputDataData%PassedFileData, DstIW_InputDataData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstIW_InputDataData%Linearize = SrcIW_InputDataData%Linearize +end subroutine + +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 + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyIW_InputData' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyContState( SrcContStateData%AD, DstContStateData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE ADI_CopyContState - - SUBROUTINE ADI_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(ADI_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 = 'ADI_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyContState( ContStateData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyContState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - 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 - - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 ADI_PackContState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - 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 AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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 ADI_UnPackContState - - SUBROUTINE ADI_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(ADI_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 = 'ADI_CopyDiscState' -! + ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(IW_InputDataData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackIW_InputData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_IW_InputData), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackIW_InputData' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%CompInflow) + call RegPack(Buf, InData%HWindSpeed) + call RegPack(Buf, InData%RefHt) + call RegPack(Buf, InData%PLExp) + call RegPack(Buf, InData%MHK) + call RegPack(Buf, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackIW_InputData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_IW_InputData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackIW_InputData' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompInflow) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(ADI_InitInputType), intent(in) :: SrcInitInputData + type(ADI_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyDiscState( SrcDiscStateData%AD, DstDiscStateData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE ADI_CopyDiscState - - SUBROUTINE ADI_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(ADI_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 = 'ADI_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyDiscState( DiscStateData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyDiscState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - 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 - - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 ADI_PackDiscState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - 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 AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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 ADI_UnPackDiscState - - SUBROUTINE ADI_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(ADI_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 = 'ADI_CopyConstrState' -! + ErrMsg = '' + call AD_CopyInitInput(SrcInitInputData%AD, DstInitInputData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyIW_InputData(SrcInitInputData%IW_InitInp, DstInitInputData%IW_InitInp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%storeHHVel = SrcInitInputData%storeHHVel + DstInitInputData%WrVTK = SrcInitInputData%WrVTK + DstInitInputData%WrVTK_Type = SrcInitInputData%WrVTK_Type + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth +end subroutine + +subroutine ADI_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(ADI_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyConstrState( SrcConstrStateData%AD, DstConstrStateData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE ADI_CopyConstrState - - SUBROUTINE ADI_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(ADI_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 = 'ADI_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyConstrState( ConstrStateData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyConstrState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - 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 - - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 ADI_PackConstrState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - 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 AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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 ADI_UnPackConstrState - - SUBROUTINE ADI_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(ADI_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 = 'ADI_CopyOtherState' -! + ErrMsg = '' + call AD_DestroyInitInput(InitInputData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyIW_InputData(InitInputData%IW_InitInp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call AD_PackInitInput(Buf, InData%AD) + call ADI_PackIW_InputData(Buf, InData%IW_InitInp) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%storeHHVel) + call RegPack(Buf, InData%WrVTK) + call RegPack(Buf, InData%WrVTK_Type) + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call AD_UnpackInitInput(Buf, OutData%AD) ! AD + call ADI_UnpackIW_InputData(Buf, OutData%IW_InitInp) ! IW_InitInp + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%storeHHVel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrVTK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrVTK_Type) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(ADI_InitOutputType), intent(in) :: SrcInitOutputData + type(ADI_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyOtherState( SrcOtherStateData%AD, DstOtherStateData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE ADI_CopyOtherState - - SUBROUTINE ADI_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(ADI_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 = 'ADI_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyOtherState( OtherStateData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyOtherState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - 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 - - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 ADI_PackOtherState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - 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 AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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 ADI_UnPackOtherState - - SUBROUTINE ADI_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(ADI_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyMisc' -! + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine ADI_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(ADI_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyMisc( SrcMiscData%AD, DstMiscData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ADI_Copyinflowwinddata( SrcMiscData%IW, DstMiscData%IW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%VTK_surfaces)) THEN - i1_l = LBOUND(SrcMiscData%VTK_surfaces,1) - i1_u = UBOUND(SrcMiscData%VTK_surfaces,1) - IF (.NOT. ALLOCATED(DstMiscData%VTK_surfaces)) THEN - ALLOCATE(DstMiscData%VTK_surfaces(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%VTK_surfaces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%VTK_surfaces,1), UBOUND(SrcMiscData%VTK_surfaces,1) - CALL AD_Copyvtk_rotsurfacetype( SrcMiscData%VTK_surfaces(i1), DstMiscData%VTK_surfaces(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE ADI_CopyMisc - - SUBROUTINE ADI_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(ADI_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 = 'ADI_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyMisc( MiscData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%VTK_surfaces) -ENDIF - END SUBROUTINE ADI_DestroyMisc - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! VTK_surfaces allocated yes/no - IF ( ALLOCATED(InData%VTK_surfaces) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VTK_surfaces - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VTK_surfaces - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VTK_surfaces - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%VTK_surfaces) ) 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%VTK_surfaces,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VTK_surfaces,1) - 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 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 - END SUBROUTINE ADI_PackMisc - - SUBROUTINE ADI_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(ADI_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_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 - 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 AD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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) - 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 ADI_UnpackInflowWindData( Re_Buf, Db_Buf, Int_Buf, OutData%IW, ErrStat2, ErrMsg2 ) ! IW - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VTK_surfaces 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%VTK_surfaces)) DEALLOCATE(OutData%VTK_surfaces) - ALLOCATE(OutData%VTK_surfaces(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surfaces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VTK_surfaces,1), UBOUND(OutData%VTK_surfaces,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 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 - - 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 - END SUBROUTINE ADI_UnPackMisc - - SUBROUTINE ADI_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_ParameterType), INTENT(IN) :: SrcParamData - TYPE(ADI_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 = 'ADI_CopyParam' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine + +subroutine ADI_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine ADI_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(ADI_ContinuousStateType), intent(in) :: SrcContStateData + type(ADI_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyParam( SrcParamData%AD, DstParamData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%dt = SrcParamData%dt - DstParamData%storeHHVel = SrcParamData%storeHHVel - DstParamData%wrVTK = SrcParamData%wrVTK - DstParamData%WrVTK_Type = SrcParamData%WrVTK_Type - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%MHK = SrcParamData%MHK - DstParamData%WtrDpth = SrcParamData%WtrDpth - END SUBROUTINE ADI_CopyParam - - SUBROUTINE ADI_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(ADI_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 = 'ADI_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyParam( ParamData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyParam - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + 1 ! dt - Int_BufSz = Int_BufSz + 1 ! storeHHVel - Int_BufSz = Int_BufSz + 1 ! wrVTK - Int_BufSz = Int_BufSz + 1 ! WrVTK_Type - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! MHK - 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 - - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 - DbKiBuf(Db_Xferred) = InData%dt - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%storeHHVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%wrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK_Type - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_PackParam - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - 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 AD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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%dt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%storeHHVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%storeHHVel) - Int_Xferred = Int_Xferred + 1 - OutData%wrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK_Type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_UnPackParam - - SUBROUTINE ADI_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_InputType), INTENT(INOUT) :: SrcInputData - TYPE(ADI_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 = 'ADI_CopyInput' -! + ErrMsg = '' + call AD_CopyContState(SrcContStateData%AD, DstContStateData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ADI_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(ADI_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyInput( SrcInputData%AD, DstInputData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE ADI_CopyInput - - SUBROUTINE ADI_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(ADI_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 = 'ADI_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyInput( InputData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyInput - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - 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 - - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 ADI_PackInput - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - 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 AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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 ADI_UnPackInput - - SUBROUTINE ADI_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(ADI_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyOutput' -! + ErrMsg = '' + call AD_DestroyContState(ContStateData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call AD_PackContState(Buf, InData%AD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call AD_UnpackContState(Buf, OutData%AD) ! AD +end subroutine + +subroutine ADI_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(ADI_DiscreteStateType), intent(in) :: SrcDiscStateData + type(ADI_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyOutput( SrcOutputData%AD, DstOutputData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%HHVel)) THEN - i1_l = LBOUND(SrcOutputData%HHVel,1) - i1_u = UBOUND(SrcOutputData%HHVel,1) - i2_l = LBOUND(SrcOutputData%HHVel,2) - i2_u = UBOUND(SrcOutputData%HHVel,2) - IF (.NOT. ALLOCATED(DstOutputData%HHVel)) THEN - ALLOCATE(DstOutputData%HHVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%HHVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%HHVel = SrcOutputData%HHVel -ENDIF - DstOutputData%PLExp = SrcOutputData%PLExp -IF (ALLOCATED(SrcOutputData%IW_WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%IW_WriteOutput,1) - i1_u = UBOUND(SrcOutputData%IW_WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%IW_WriteOutput)) THEN - ALLOCATE(DstOutputData%IW_WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%IW_WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%IW_WriteOutput = SrcOutputData%IW_WriteOutput -ENDIF -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 ADI_CopyOutput - - SUBROUTINE ADI_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(ADI_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 = 'ADI_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyOutput( OutputData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%HHVel)) THEN - DEALLOCATE(OutputData%HHVel) -ENDIF -IF (ALLOCATED(OutputData%IW_WriteOutput)) THEN - DEALLOCATE(OutputData%IW_WriteOutput) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE ADI_DestroyOutput - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! HHVel allocated yes/no - IF ( ALLOCATED(InData%HHVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! HHVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HHVel) ! HHVel - END IF - Re_BufSz = Re_BufSz + 1 ! PLExp - Int_BufSz = Int_BufSz + 1 ! IW_WriteOutput allocated yes/no - IF ( ALLOCATED(InData%IW_WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IW_WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%IW_WriteOutput) ! IW_WriteOutput - END IF - 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 - - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 - IF ( .NOT. ALLOCATED(InData%HHVel) ) 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%HHVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HHVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HHVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HHVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%HHVel,2), UBOUND(InData%HHVel,2) - DO i1 = LBOUND(InData%HHVel,1), UBOUND(InData%HHVel,1) - ReKiBuf(Re_Xferred) = InData%HHVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%IW_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%IW_WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IW_WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IW_WriteOutput,1), UBOUND(InData%IW_WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%IW_WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 ADI_PackOutput - - SUBROUTINE ADI_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(ADI_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_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 - 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 AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HHVel 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%HHVel)) DEALLOCATE(OutData%HHVel) - ALLOCATE(OutData%HHVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HHVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%HHVel,2), UBOUND(OutData%HHVel,2) - DO i1 = LBOUND(OutData%HHVel,1), UBOUND(OutData%HHVel,1) - OutData%HHVel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IW_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%IW_WriteOutput)) DEALLOCATE(OutData%IW_WriteOutput) - ALLOCATE(OutData%IW_WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IW_WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IW_WriteOutput,1), UBOUND(OutData%IW_WriteOutput,1) - OutData%IW_WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 ADI_UnPackOutput - - SUBROUTINE ADI_CopyData( SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_Data), INTENT(INOUT) :: SrcDataData - TYPE(ADI_Data), INTENT(INOUT) :: DstDataData - 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 = 'ADI_CopyData' -! + ErrMsg = '' + call AD_CopyDiscState(SrcDiscStateData%AD, DstDiscStateData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ADI_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(ADI_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDataData%x)) THEN - i1_l = LBOUND(SrcDataData%x,1) - i1_u = UBOUND(SrcDataData%x,1) - IF (.NOT. ALLOCATED(DstDataData%x)) THEN - ALLOCATE(DstDataData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDataData%x,1), UBOUND(SrcDataData%x,1) - CALL ADI_CopyContState( SrcDataData%x(i1), DstDataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDataData%xd)) THEN - i1_l = LBOUND(SrcDataData%xd,1) - i1_u = UBOUND(SrcDataData%xd,1) - IF (.NOT. ALLOCATED(DstDataData%xd)) THEN - ALLOCATE(DstDataData%xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDataData%xd,1), UBOUND(SrcDataData%xd,1) - CALL ADI_CopyDiscState( SrcDataData%xd(i1), DstDataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDataData%z)) THEN - i1_l = LBOUND(SrcDataData%z,1) - i1_u = UBOUND(SrcDataData%z,1) - IF (.NOT. ALLOCATED(DstDataData%z)) THEN - ALLOCATE(DstDataData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDataData%z,1), UBOUND(SrcDataData%z,1) - CALL ADI_CopyConstrState( SrcDataData%z(i1), DstDataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDataData%OtherState)) THEN - i1_l = LBOUND(SrcDataData%OtherState,1) - i1_u = UBOUND(SrcDataData%OtherState,1) - IF (.NOT. ALLOCATED(DstDataData%OtherState)) THEN - ALLOCATE(DstDataData%OtherState(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%OtherState.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDataData%OtherState,1), UBOUND(SrcDataData%OtherState,1) - CALL ADI_CopyOtherState( SrcDataData%OtherState(i1), DstDataData%OtherState(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL ADI_CopyParam( SrcDataData%p, DstDataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ADI_CopyMisc( SrcDataData%m, DstDataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcDataData%u)) THEN - i1_l = LBOUND(SrcDataData%u,1) - i1_u = UBOUND(SrcDataData%u,1) - IF (.NOT. ALLOCATED(DstDataData%u)) THEN - ALLOCATE(DstDataData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDataData%u,1), UBOUND(SrcDataData%u,1) - CALL ADI_CopyInput( SrcDataData%u(i1), DstDataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL ADI_CopyOutput( SrcDataData%y, DstDataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcDataData%inputTimes)) THEN - i1_l = LBOUND(SrcDataData%inputTimes,1) - i1_u = UBOUND(SrcDataData%inputTimes,1) - IF (.NOT. ALLOCATED(DstDataData%inputTimes)) THEN - ALLOCATE(DstDataData%inputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%inputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDataData%inputTimes = SrcDataData%inputTimes -ENDIF - END SUBROUTINE ADI_CopyData - - SUBROUTINE ADI_DestroyData( DataData, ErrStat, ErrMsg ) - TYPE(ADI_Data), INTENT(INOUT) :: DataData - 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 = 'ADI_DestroyData' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DataData%x)) THEN -DO i1 = LBOUND(DataData%x,1), UBOUND(DataData%x,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DataData%OtherState) -ENDIF - CALL ADI_DestroyParam( DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DataData%u) -ENDIF - CALL ADI_DestroyOutput( DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(DataData%inputTimes)) THEN - DEALLOCATE(DataData%inputTimes) -ENDIF - END SUBROUTINE ADI_DestroyData - - SUBROUTINE ADI_PackData( 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(ADI_Data), 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 = 'ADI_PackData' - ! 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 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL ADI_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no - IF ( ALLOCATED(InData%xd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL ADI_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL ADI_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherState allocated yes/no - IF ( ALLOCATED(InData%OtherState) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherState upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherState,1), UBOUND(InData%OtherState,1) - Int_BufSz = Int_BufSz + 3 ! OtherState: size of buffers for each call to pack subtype - CALL ADI_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherState - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherState - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherState - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL ADI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL ADI_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! u allocated yes/no - IF ( ALLOCATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL ADI_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL ADI_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! inputTimes allocated yes/no - IF ( ALLOCATED(InData%inputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! inputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%inputTimes) ! inputTimes - 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%x) ) 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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL ADI_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - IF ( .NOT. ALLOCATED(InData%xd) ) 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%xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL ADI_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - IF ( .NOT. ALLOCATED(InData%z) ) 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%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL ADI_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - IF ( .NOT. ALLOCATED(InData%OtherState) ) 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%OtherState,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherState,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherState,1), UBOUND(InData%OtherState,1) - CALL ADI_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherState - 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 - CALL ADI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL ADI_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IF ( .NOT. ALLOCATED(InData%u) ) 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%u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - CALL ADI_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL ADI_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - IF ( .NOT. ALLOCATED(InData%inputTimes) ) 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%inputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%inputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%inputTimes,1), UBOUND(InData%inputTimes,1) - DbKiBuf(Db_Xferred) = InData%inputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE ADI_PackData - - SUBROUTINE ADI_UnPackData( 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(ADI_Data), 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 = 'ADI_UnPackData' - ! 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 ! x 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%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 ADI_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 ! xd 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%xd)) DEALLOCATE(OutData%xd) - ALLOCATE(OutData%xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 ADI_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 ! z 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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 ADI_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 ! OtherState 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%OtherState)) DEALLOCATE(OutData%OtherState) - ALLOCATE(OutData%OtherState(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherState.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherState,1), UBOUND(OutData%OtherState,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 ADI_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherState(i1), ErrStat2, ErrMsg2 ) ! OtherState - 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 - 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 ADI_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 ADI_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u 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%u)) DEALLOCATE(OutData%u) - ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,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 ADI_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u - 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 - 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 ADI_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! inputTimes 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%inputTimes)) DEALLOCATE(OutData%inputTimes) - ALLOCATE(OutData%inputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%inputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%inputTimes,1), UBOUND(OutData%inputTimes,1) - OutData%inputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE ADI_UnPackData - - SUBROUTINE ADI_CopyRotFED( SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotFED), INTENT(INOUT) :: SrcRotFEDData - TYPE(RotFED), INTENT(INOUT) :: DstRotFEDData - 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 = 'ADI_CopyRotFED' -! + ErrMsg = '' + call AD_DestroyDiscState(DiscStateData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call AD_PackDiscState(Buf, InData%AD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call AD_UnpackDiscState(Buf, OutData%AD) ! AD +end subroutine + +subroutine ADI_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(ADI_ConstraintStateType), intent(in) :: SrcConstrStateData + type(ADI_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcRotFEDData%PlatformPtMesh, DstRotFEDData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotFEDData%TwrPtMesh, DstRotFEDData%TwrPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotFEDData%TwrPtMeshAD, DstRotFEDData%TwrPtMeshAD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotFEDData%NacelleMotion, DstRotFEDData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotFEDData%HubPtMotion, DstRotFEDData%HubPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotFEDData%BladeRootMotion)) THEN - i1_l = LBOUND(SrcRotFEDData%BladeRootMotion,1) - i1_u = UBOUND(SrcRotFEDData%BladeRootMotion,1) - IF (.NOT. ALLOCATED(DstRotFEDData%BladeRootMotion)) THEN - ALLOCATE(DstRotFEDData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotFEDData%BladeRootMotion,1), UBOUND(SrcRotFEDData%BladeRootMotion,1) - CALL MeshCopy( SrcRotFEDData%BladeRootMotion(i1), DstRotFEDData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotFEDData%BladeLn2Mesh)) THEN - i1_l = LBOUND(SrcRotFEDData%BladeLn2Mesh,1) - i1_u = UBOUND(SrcRotFEDData%BladeLn2Mesh,1) - IF (.NOT. ALLOCATED(DstRotFEDData%BladeLn2Mesh)) THEN - ALLOCATE(DstRotFEDData%BladeLn2Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%BladeLn2Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotFEDData%BladeLn2Mesh,1), UBOUND(SrcRotFEDData%BladeLn2Mesh,1) - CALL MeshCopy( SrcRotFEDData%BladeLn2Mesh(i1), DstRotFEDData%BladeLn2Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstRotFEDData%hasTower = SrcRotFEDData%hasTower - DstRotFEDData%rigidBlades = SrcRotFEDData%rigidBlades - DstRotFEDData%numBlades = SrcRotFEDData%numBlades - CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%ED_P_2_AD_P_T, DstRotFEDData%ED_P_2_AD_P_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%AD_P_2_AD_L_T, DstRotFEDData%AD_P_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotFEDData%AD_P_2_AD_L_B)) THEN - i1_l = LBOUND(SrcRotFEDData%AD_P_2_AD_L_B,1) - i1_u = UBOUND(SrcRotFEDData%AD_P_2_AD_L_B,1) - IF (.NOT. ALLOCATED(DstRotFEDData%AD_P_2_AD_L_B)) THEN - ALLOCATE(DstRotFEDData%AD_P_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%AD_P_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotFEDData%AD_P_2_AD_L_B,1), UBOUND(SrcRotFEDData%AD_P_2_AD_L_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%AD_P_2_AD_L_B(i1), DstRotFEDData%AD_P_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%ED_P_2_AD_P_TF, DstRotFEDData%ED_P_2_AD_P_TF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotFEDData%ED_P_2_AD_P_R)) THEN - i1_l = LBOUND(SrcRotFEDData%ED_P_2_AD_P_R,1) - i1_u = UBOUND(SrcRotFEDData%ED_P_2_AD_P_R,1) - IF (.NOT. ALLOCATED(DstRotFEDData%ED_P_2_AD_P_R)) THEN - ALLOCATE(DstRotFEDData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotFEDData%ED_P_2_AD_P_R,1), UBOUND(SrcRotFEDData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%ED_P_2_AD_P_R(i1), DstRotFEDData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%ED_P_2_AD_P_H, DstRotFEDData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%ED_P_2_AD_P_N, DstRotFEDData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE ADI_CopyRotFED - - SUBROUTINE ADI_DestroyRotFED( RotFEDData, ErrStat, ErrMsg ) - TYPE(RotFED), INTENT(INOUT) :: RotFEDData - 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 = 'ADI_DestroyRotFED' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( RotFEDData%PlatformPtMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotFEDData%TwrPtMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotFEDData%TwrPtMeshAD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotFEDData%NacelleMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotFEDData%HubPtMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotFEDData%BladeRootMotion)) THEN -DO i1 = LBOUND(RotFEDData%BladeRootMotion,1), UBOUND(RotFEDData%BladeRootMotion,1) - CALL MeshDestroy( RotFEDData%BladeRootMotion(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotFEDData%BladeRootMotion) -ENDIF -IF (ALLOCATED(RotFEDData%BladeLn2Mesh)) THEN -DO i1 = LBOUND(RotFEDData%BladeLn2Mesh,1), UBOUND(RotFEDData%BladeLn2Mesh,1) - CALL MeshDestroy( RotFEDData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotFEDData%BladeLn2Mesh) -ENDIF - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( RotFEDData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyRotFED - - SUBROUTINE ADI_PackRotFED( 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(RotFED), 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 = 'ADI_PackRotFED' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PlatformPtMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PlatformPtMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PlatformPtMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PlatformPtMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PlatformPtMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TwrPtMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%TwrPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TwrPtMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TwrPtMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TwrPtMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TwrPtMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TwrPtMeshAD: size of buffers for each call to pack subtype - CALL MeshPack( InData%TwrPtMeshAD, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TwrPtMeshAD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TwrPtMeshAD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TwrPtMeshAD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TwrPtMeshAD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! NacelleMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NacelleMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NacelleMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NacelleMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubPtMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubPtMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubPtMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubPtMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubPtMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootMotion allocated yes/no - IF ( ALLOCATED(InData%BladeRootMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeRootMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - Int_BufSz = Int_BufSz + 3 ! BladeRootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeRootMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeRootMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeRootMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BladeLn2Mesh allocated yes/no - IF ( ALLOCATED(InData%BladeLn2Mesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeLn2Mesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeLn2Mesh,1), UBOUND(InData%BladeLn2Mesh,1) - Int_BufSz = Int_BufSz + 3 ! BladeLn2Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeLn2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeLn2Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeLn2Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeLn2Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! hasTower - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_AD_L_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_AD_L_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_AD_L_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! AD_P_2_AD_L_B allocated yes/no - IF ( ALLOCATED(InData%AD_P_2_AD_L_B) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_AD_L_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_AD_L_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_AD_L_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_TF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_TF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_TF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_AD_P_R allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_R - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_R - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_R - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_H - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_H - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_H - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_N - 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 - - CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PlatformPtMesh - 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 - CALL MeshPack( InData%TwrPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TwrPtMesh - 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 - CALL MeshPack( InData%TwrPtMeshAD, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TwrPtMeshAD - 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 - CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleMotion - 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 - CALL MeshPack( InData%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubPtMotion - 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 - IF ( .NOT. ALLOCATED(InData%BladeRootMotion) ) 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%BladeRootMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootMotion,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootMotion - 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 - IF ( .NOT. ALLOCATED(InData%BladeLn2Mesh) ) 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%BladeLn2Mesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeLn2Mesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeLn2Mesh,1), UBOUND(InData%BladeLn2Mesh,1) - CALL MeshPack( InData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeLn2Mesh - 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) = TRANSFER(InData%hasTower, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%rigidBlades, IntKiBuf(1)) - 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 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%AD_P_2_AD_L_B) ) 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%AD_P_2_AD_L_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_P_2_AD_L_B,1) - 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 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%ED_P_2_AD_P_R) ) 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%ED_P_2_AD_P_R,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_AD_P_R,1) - 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 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 - 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 - - 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 - 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 - - 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 ADI_PackRotFED - - SUBROUTINE ADI_UnPackRotFED( 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(RotFED), 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 = 'ADI_UnPackRotFED' - ! 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 - 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 MeshUnpack( OutData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PlatformPtMesh - 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) - 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 MeshUnpack( OutData%TwrPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TwrPtMesh - 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) - 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 MeshUnpack( OutData%TwrPtMeshAD, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TwrPtMeshAD - 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) - 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 MeshUnpack( OutData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleMotion - 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) - 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 MeshUnpack( OutData%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubPtMotion - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootMotion 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%BladeRootMotion)) DEALLOCATE(OutData%BladeRootMotion) - ALLOCATE(OutData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeRootMotion,1), UBOUND(OutData%BladeRootMotion,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 MeshUnpack( OutData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootMotion - 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 ! BladeLn2Mesh 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%BladeLn2Mesh)) DEALLOCATE(OutData%BladeLn2Mesh) - ALLOCATE(OutData%BladeLn2Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeLn2Mesh,1), UBOUND(OutData%BladeLn2Mesh,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 MeshUnpack( OutData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeLn2Mesh - 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%hasTower = TRANSFER(IntKiBuf(Int_Xferred), OutData%hasTower) - Int_Xferred = Int_Xferred + 1 - OutData%rigidBlades = TRANSFER(IntKiBuf(Int_Xferred), OutData%rigidBlades) - Int_Xferred = Int_Xferred + 1 - OutData%numBlades = 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 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 - - 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 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 - - 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 ! AD_P_2_AD_L_B 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%AD_P_2_AD_L_B)) DEALLOCATE(OutData%AD_P_2_AD_L_B) - ALLOCATE(OutData%AD_P_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_P_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AD_P_2_AD_L_B,1), UBOUND(OutData%AD_P_2_AD_L_B,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_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 - - 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 - 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_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 - - 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 ! ED_P_2_AD_P_R 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%ED_P_2_AD_P_R)) DEALLOCATE(OutData%ED_P_2_AD_P_R) - ALLOCATE(OutData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_AD_P_R,1), UBOUND(OutData%ED_P_2_AD_P_R,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_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 - - 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 - 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_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 - - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE ADI_UnPackRotFED - - SUBROUTINE ADI_CopyFED_Data( SrcFED_DataData, DstFED_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FED_Data), INTENT(INOUT) :: SrcFED_DataData - TYPE(FED_Data), INTENT(INOUT) :: DstFED_DataData - 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 = 'ADI_CopyFED_Data' -! + ErrMsg = '' + call AD_CopyConstrState(SrcConstrStateData%AD, DstConstrStateData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ADI_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(ADI_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcFED_DataData%WT)) THEN - i1_l = LBOUND(SrcFED_DataData%WT,1) - i1_u = UBOUND(SrcFED_DataData%WT,1) - IF (.NOT. ALLOCATED(DstFED_DataData%WT)) THEN - ALLOCATE(DstFED_DataData%WT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFED_DataData%WT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcFED_DataData%WT,1), UBOUND(SrcFED_DataData%WT,1) - CALL ADI_Copyrotfed( SrcFED_DataData%WT(i1), DstFED_DataData%WT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE ADI_CopyFED_Data - - SUBROUTINE ADI_DestroyFED_Data( FED_DataData, ErrStat, ErrMsg ) - TYPE(FED_Data), INTENT(INOUT) :: FED_DataData - 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 = 'ADI_DestroyFED_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(FED_DataData%WT) -ENDIF - END SUBROUTINE ADI_DestroyFED_Data - - SUBROUTINE ADI_PackFED_Data( 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(FED_Data), 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 = 'ADI_PackFED_Data' - ! 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 ! WT allocated yes/no - IF ( ALLOCATED(InData%WT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WT upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%WT) ) 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%WT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT,1) - 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 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 - END SUBROUTINE ADI_PackFED_Data - - SUBROUTINE ADI_UnPackFED_Data( 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(FED_Data), 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 = 'ADI_UnPackFED_Data' - ! 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 ! WT 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%WT)) DEALLOCATE(OutData%WT) - ALLOCATE(OutData%WT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WT,1), UBOUND(OutData%WT,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 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 - - 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 - END SUBROUTINE ADI_UnPackFED_Data - + ErrMsg = '' + call AD_DestroyConstrState(ConstrStateData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call AD_PackConstrState(Buf, InData%AD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call AD_UnpackConstrState(Buf, OutData%AD) ! AD +end subroutine + +subroutine ADI_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(ADI_OtherStateType), intent(in) :: SrcOtherStateData + type(ADI_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyOtherState(SrcOtherStateData%AD, DstOtherStateData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ADI_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(ADI_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call AD_DestroyOtherState(OtherStateData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call AD_PackOtherState(Buf, InData%AD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call AD_UnpackOtherState(Buf, OutData%AD) ! AD +end subroutine + +subroutine ADI_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ADI_MiscVarType), intent(inout) :: SrcMiscData + type(ADI_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyMisc(SrcMiscData%AD, DstMiscData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyInflowWindData(SrcMiscData%IW, DstMiscData%IW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%VTK_surfaces)) then + LB(1:1) = lbound(SrcMiscData%VTK_surfaces) + UB(1:1) = ubound(SrcMiscData%VTK_surfaces) + if (.not. allocated(DstMiscData%VTK_surfaces)) then + allocate(DstMiscData%VTK_surfaces(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%VTK_surfaces.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyVTK_RotSurfaceType(SrcMiscData%VTK_surfaces(i1), DstMiscData%VTK_surfaces(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine ADI_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ADI_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call AD_DestroyMisc(MiscData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyInflowWindData(MiscData%IW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%VTK_surfaces)) then + LB(1:1) = lbound(MiscData%VTK_surfaces) + UB(1:1) = ubound(MiscData%VTK_surfaces) + do i1 = LB(1), UB(1) + call AD_DestroyVTK_RotSurfaceType(MiscData%VTK_surfaces(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%VTK_surfaces) + end if +end subroutine + +subroutine ADI_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call AD_PackMisc(Buf, InData%AD) + call ADI_PackInflowWindData(Buf, InData%IW) + call RegPack(Buf, allocated(InData%VTK_surfaces)) + if (allocated(InData%VTK_surfaces)) then + call RegPackBounds(Buf, 1, lbound(InData%VTK_surfaces), ubound(InData%VTK_surfaces)) + LB(1:1) = lbound(InData%VTK_surfaces) + UB(1:1) = ubound(InData%VTK_surfaces) + do i1 = LB(1), UB(1) + call AD_PackVTK_RotSurfaceType(Buf, InData%VTK_surfaces(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call AD_UnpackMisc(Buf, OutData%AD) ! AD + call ADI_UnpackInflowWindData(Buf, OutData%IW) ! IW + if (allocated(OutData%VTK_surfaces)) deallocate(OutData%VTK_surfaces) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VTK_surfaces(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surfaces.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackVTK_RotSurfaceType(Buf, OutData%VTK_surfaces(i1)) ! VTK_surfaces + end do + end if +end subroutine + +subroutine ADI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(ADI_ParameterType), intent(in) :: SrcParamData + type(ADI_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyParam(SrcParamData%AD, DstParamData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%dt = SrcParamData%dt + DstParamData%storeHHVel = SrcParamData%storeHHVel + DstParamData%wrVTK = SrcParamData%wrVTK + DstParamData%WrVTK_Type = SrcParamData%WrVTK_Type + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%MHK = SrcParamData%MHK + DstParamData%WtrDpth = SrcParamData%WtrDpth +end subroutine + +subroutine ADI_DestroyParam(ParamData, ErrStat, ErrMsg) + type(ADI_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + call AD_DestroyParam(ParamData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call AD_PackParam(Buf, InData%AD) + call RegPack(Buf, InData%dt) + call RegPack(Buf, InData%storeHHVel) + call RegPack(Buf, InData%wrVTK) + call RegPack(Buf, InData%WrVTK_Type) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%MHK) + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackParam' + if (Buf%ErrStat /= ErrID_None) return + call AD_UnpackParam(Buf, OutData%AD) ! AD + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%storeHHVel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%wrVTK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrVTK_Type) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(ADI_InputType), intent(inout) :: SrcInputData + type(ADI_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyInput(SrcInputData%AD, DstInputData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ADI_DestroyInput(InputData, ErrStat, ErrMsg) + type(ADI_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call AD_DestroyInput(InputData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call AD_PackInput(Buf, InData%AD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + call AD_UnpackInput(Buf, OutData%AD) ! AD +end subroutine + +subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(ADI_OutputType), intent(inout) :: SrcOutputData + type(ADI_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyOutput(SrcOutputData%AD, DstOutputData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%HHVel)) then + LB(1:2) = lbound(SrcOutputData%HHVel) + UB(1:2) = ubound(SrcOutputData%HHVel) + if (.not. allocated(DstOutputData%HHVel)) then + allocate(DstOutputData%HHVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%HHVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%HHVel = SrcOutputData%HHVel + end if + DstOutputData%PLExp = SrcOutputData%PLExp + if (allocated(SrcOutputData%IW_WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%IW_WriteOutput) + UB(1:1) = ubound(SrcOutputData%IW_WriteOutput) + if (.not. allocated(DstOutputData%IW_WriteOutput)) then + allocate(DstOutputData%IW_WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%IW_WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%IW_WriteOutput = SrcOutputData%IW_WriteOutput + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine ADI_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(ADI_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call AD_DestroyOutput(OutputData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%HHVel)) then + deallocate(OutputData%HHVel) + end if + if (allocated(OutputData%IW_WriteOutput)) then + deallocate(OutputData%IW_WriteOutput) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine ADI_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call AD_PackOutput(Buf, InData%AD) + call RegPack(Buf, allocated(InData%HHVel)) + if (allocated(InData%HHVel)) then + call RegPackBounds(Buf, 2, lbound(InData%HHVel), ubound(InData%HHVel)) + call RegPack(Buf, InData%HHVel) + end if + call RegPack(Buf, InData%PLExp) + call RegPack(Buf, allocated(InData%IW_WriteOutput)) + if (allocated(InData%IW_WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%IW_WriteOutput), ubound(InData%IW_WriteOutput)) + call RegPack(Buf, InData%IW_WriteOutput) + end if + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackOutput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call AD_UnpackOutput(Buf, OutData%AD) ! AD + if (allocated(OutData%HHVel)) deallocate(OutData%HHVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HHVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HHVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HHVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%IW_WriteOutput)) deallocate(OutData%IW_WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IW_WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IW_WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IW_WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) + type(ADI_Data), intent(inout) :: SrcDataData + type(ADI_Data), intent(inout) :: DstDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDataData%x)) then + LB(1:1) = lbound(SrcDataData%x) + UB(1:1) = ubound(SrcDataData%x) + if (.not. allocated(DstDataData%x)) then + allocate(DstDataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyContState(SrcDataData%x(i1), DstDataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcDataData%xd)) then + LB(1:1) = lbound(SrcDataData%xd) + UB(1:1) = ubound(SrcDataData%xd) + if (.not. allocated(DstDataData%xd)) then + allocate(DstDataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyDiscState(SrcDataData%xd(i1), DstDataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcDataData%z)) then + LB(1:1) = lbound(SrcDataData%z) + UB(1:1) = ubound(SrcDataData%z) + if (.not. allocated(DstDataData%z)) then + allocate(DstDataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyConstrState(SrcDataData%z(i1), DstDataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcDataData%OtherState)) then + LB(1:1) = lbound(SrcDataData%OtherState) + UB(1:1) = ubound(SrcDataData%OtherState) + if (.not. allocated(DstDataData%OtherState)) then + allocate(DstDataData%OtherState(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%OtherState.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyOtherState(SrcDataData%OtherState(i1), DstDataData%OtherState(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call ADI_CopyParam(SrcDataData%p, DstDataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyMisc(SrcDataData%m, DstDataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcDataData%u)) then + LB(1:1) = lbound(SrcDataData%u) + UB(1:1) = ubound(SrcDataData%u) + if (.not. allocated(DstDataData%u)) then + allocate(DstDataData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyInput(SrcDataData%u(i1), DstDataData%u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call ADI_CopyOutput(SrcDataData%y, DstDataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcDataData%inputTimes)) then + LB(1:1) = lbound(SrcDataData%inputTimes) + UB(1:1) = ubound(SrcDataData%inputTimes) + if (.not. allocated(DstDataData%inputTimes)) then + allocate(DstDataData%inputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%inputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDataData%inputTimes = SrcDataData%inputTimes + end if +end subroutine + +subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) + type(ADI_Data), intent(inout) :: DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DataData%x)) then + LB(1:1) = lbound(DataData%x) + UB(1:1) = ubound(DataData%x) + do i1 = LB(1), UB(1) + call ADI_DestroyContState(DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DataData%x) + end if + if (allocated(DataData%xd)) then + LB(1:1) = lbound(DataData%xd) + UB(1:1) = ubound(DataData%xd) + do i1 = LB(1), UB(1) + call ADI_DestroyDiscState(DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DataData%xd) + end if + if (allocated(DataData%z)) then + LB(1:1) = lbound(DataData%z) + UB(1:1) = ubound(DataData%z) + do i1 = LB(1), UB(1) + call ADI_DestroyConstrState(DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DataData%z) + end if + if (allocated(DataData%OtherState)) then + LB(1:1) = lbound(DataData%OtherState) + UB(1:1) = ubound(DataData%OtherState) + do i1 = LB(1), UB(1) + call ADI_DestroyOtherState(DataData%OtherState(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DataData%OtherState) + end if + call ADI_DestroyParam(DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyMisc(DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(DataData%u)) then + LB(1:1) = lbound(DataData%u) + UB(1:1) = ubound(DataData%u) + do i1 = LB(1), UB(1) + call ADI_DestroyInput(DataData%u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DataData%u) + end if + call ADI_DestroyOutput(DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(DataData%inputTimes)) then + deallocate(DataData%inputTimes) + end if +end subroutine + +subroutine ADI_PackData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackData' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call ADI_PackContState(Buf, InData%x(i1)) + end do + end if + call RegPack(Buf, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(Buf, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call ADI_PackDiscState(Buf, InData%xd(i1)) + end do + end if + call RegPack(Buf, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call ADI_PackConstrState(Buf, InData%z(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OtherState)) + if (allocated(InData%OtherState)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherState), ubound(InData%OtherState)) + LB(1:1) = lbound(InData%OtherState) + UB(1:1) = ubound(InData%OtherState) + do i1 = LB(1), UB(1) + call ADI_PackOtherState(Buf, InData%OtherState(i1)) + end do + end if + call ADI_PackParam(Buf, InData%p) + call ADI_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) + LB(1:1) = lbound(InData%u) + UB(1:1) = ubound(InData%u) + do i1 = LB(1), UB(1) + call ADI_PackInput(Buf, InData%u(i1)) + end do + end if + call ADI_PackOutput(Buf, InData%y) + call RegPack(Buf, allocated(InData%inputTimes)) + if (allocated(InData%inputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%inputTimes), ubound(InData%inputTimes)) + call RegPack(Buf, InData%inputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackData' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackContState(Buf, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherState)) deallocate(OutData%OtherState) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherState(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherState.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackOtherState(Buf, OutData%OtherState(i1)) ! OtherState + end do + end if + call ADI_UnpackParam(Buf, OutData%p) ! p + call ADI_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%u)) deallocate(OutData%u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackInput(Buf, OutData%u(i1)) ! u + end do + end if + call ADI_UnpackOutput(Buf, OutData%y) ! y + if (allocated(OutData%inputTimes)) deallocate(OutData%inputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%inputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%inputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%inputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMsg) + type(RotFED), intent(inout) :: SrcRotFEDData + type(RotFED), intent(inout) :: DstRotFEDData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyRotFED' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcRotFEDData%PlatformPtMesh, DstRotFEDData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotFEDData%TwrPtMesh, DstRotFEDData%TwrPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotFEDData%TwrPtMeshAD, DstRotFEDData%TwrPtMeshAD, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotFEDData%NacelleMotion, DstRotFEDData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotFEDData%HubPtMotion, DstRotFEDData%HubPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotFEDData%BladeRootMotion)) then + LB(1:1) = lbound(SrcRotFEDData%BladeRootMotion) + UB(1:1) = ubound(SrcRotFEDData%BladeRootMotion) + if (.not. allocated(DstRotFEDData%BladeRootMotion)) then + allocate(DstRotFEDData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotFEDData%BladeRootMotion(i1), DstRotFEDData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotFEDData%BladeLn2Mesh)) then + LB(1:1) = lbound(SrcRotFEDData%BladeLn2Mesh) + UB(1:1) = ubound(SrcRotFEDData%BladeLn2Mesh) + if (.not. allocated(DstRotFEDData%BladeLn2Mesh)) then + allocate(DstRotFEDData%BladeLn2Mesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%BladeLn2Mesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotFEDData%BladeLn2Mesh(i1), DstRotFEDData%BladeLn2Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstRotFEDData%hasTower = SrcRotFEDData%hasTower + DstRotFEDData%rigidBlades = SrcRotFEDData%rigidBlades + DstRotFEDData%numBlades = SrcRotFEDData%numBlades + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_T, DstRotFEDData%ED_P_2_AD_P_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%AD_P_2_AD_L_T, DstRotFEDData%AD_P_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotFEDData%AD_P_2_AD_L_B)) then + LB(1:1) = lbound(SrcRotFEDData%AD_P_2_AD_L_B) + UB(1:1) = ubound(SrcRotFEDData%AD_P_2_AD_L_B) + if (.not. allocated(DstRotFEDData%AD_P_2_AD_L_B)) then + allocate(DstRotFEDData%AD_P_2_AD_L_B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%AD_P_2_AD_L_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%AD_P_2_AD_L_B(i1), DstRotFEDData%AD_P_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_TF, DstRotFEDData%ED_P_2_AD_P_TF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotFEDData%ED_P_2_AD_P_R)) then + LB(1:1) = lbound(SrcRotFEDData%ED_P_2_AD_P_R) + UB(1:1) = ubound(SrcRotFEDData%ED_P_2_AD_P_R) + if (.not. allocated(DstRotFEDData%ED_P_2_AD_P_R)) then + allocate(DstRotFEDData%ED_P_2_AD_P_R(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%ED_P_2_AD_P_R.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_R(i1), DstRotFEDData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_H, DstRotFEDData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_N, DstRotFEDData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) + type(RotFED), intent(inout) :: RotFEDData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyRotFED' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( RotFEDData%PlatformPtMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotFEDData%TwrPtMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotFEDData%TwrPtMeshAD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotFEDData%NacelleMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotFEDData%HubPtMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotFEDData%BladeRootMotion)) then + LB(1:1) = lbound(RotFEDData%BladeRootMotion) + UB(1:1) = ubound(RotFEDData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( RotFEDData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotFEDData%BladeRootMotion) + end if + if (allocated(RotFEDData%BladeLn2Mesh)) then + LB(1:1) = lbound(RotFEDData%BladeLn2Mesh) + UB(1:1) = ubound(RotFEDData%BladeLn2Mesh) + do i1 = LB(1), UB(1) + call MeshDestroy( RotFEDData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotFEDData%BladeLn2Mesh) + end if + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotFEDData%AD_P_2_AD_L_B)) then + LB(1:1) = lbound(RotFEDData%AD_P_2_AD_L_B) + UB(1:1) = ubound(RotFEDData%AD_P_2_AD_L_B) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotFEDData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotFEDData%AD_P_2_AD_L_B) + end if + 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 + LB(1:1) = lbound(RotFEDData%ED_P_2_AD_P_R) + UB(1:1) = ubound(RotFEDData%ED_P_2_AD_P_R) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotFEDData%ED_P_2_AD_P_R) + end if + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackRotFED(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotFED), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackRotFED' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%PlatformPtMesh) + call MeshPack(Buf, InData%TwrPtMesh) + call MeshPack(Buf, InData%TwrPtMeshAD) + call MeshPack(Buf, InData%NacelleMotion) + call MeshPack(Buf, InData%HubPtMotion) + call RegPack(Buf, allocated(InData%BladeRootMotion)) + if (allocated(InData%BladeRootMotion)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeRootMotion(i1)) + end do + end if + call RegPack(Buf, allocated(InData%BladeLn2Mesh)) + if (allocated(InData%BladeLn2Mesh)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeLn2Mesh), ubound(InData%BladeLn2Mesh)) + LB(1:1) = lbound(InData%BladeLn2Mesh) + UB(1:1) = ubound(InData%BladeLn2Mesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeLn2Mesh(i1)) + end do + end if + call RegPack(Buf, InData%hasTower) + call RegPack(Buf, InData%rigidBlades) + call RegPack(Buf, InData%numBlades) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_T) + call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_AD_L_T) + call RegPack(Buf, allocated(InData%AD_P_2_AD_L_B)) + if (allocated(InData%AD_P_2_AD_L_B)) then + call RegPackBounds(Buf, 1, lbound(InData%AD_P_2_AD_L_B), ubound(InData%AD_P_2_AD_L_B)) + LB(1:1) = lbound(InData%AD_P_2_AD_L_B) + UB(1:1) = ubound(InData%AD_P_2_AD_L_B) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_AD_L_B(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_TF) + call RegPack(Buf, allocated(InData%ED_P_2_AD_P_R)) + if (allocated(InData%ED_P_2_AD_P_R)) then + call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) + LB(1:1) = lbound(InData%ED_P_2_AD_P_R) + UB(1:1) = ubound(InData%ED_P_2_AD_P_R) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_R(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_H) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_N) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackRotFED(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotFED), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackRotFED' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%PlatformPtMesh) ! PlatformPtMesh + call MeshUnpack(Buf, OutData%TwrPtMesh) ! TwrPtMesh + call MeshUnpack(Buf, OutData%TwrPtMeshAD) ! TwrPtMeshAD + call MeshUnpack(Buf, OutData%NacelleMotion) ! NacelleMotion + call MeshUnpack(Buf, OutData%HubPtMotion) ! HubPtMotion + if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeRootMotion(i1)) ! BladeRootMotion + end do + end if + if (allocated(OutData%BladeLn2Mesh)) deallocate(OutData%BladeLn2Mesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeLn2Mesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeLn2Mesh(i1)) ! BladeLn2Mesh + end do + end if + call RegUnpack(Buf, OutData%hasTower) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rigidBlades) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_T) ! ED_P_2_AD_P_T + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_AD_L_T) ! AD_P_2_AD_L_T + if (allocated(OutData%AD_P_2_AD_L_B)) deallocate(OutData%AD_P_2_AD_L_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AD_P_2_AD_L_B(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_P_2_AD_L_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_AD_L_B(i1)) ! AD_P_2_AD_L_B + end do + end if + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_TF) ! ED_P_2_AD_P_TF + if (allocated(OutData%ED_P_2_AD_P_R)) deallocate(OutData%ED_P_2_AD_P_R) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ED_P_2_AD_P_R(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_R(i1)) ! ED_P_2_AD_P_R + end do + end if + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_H) ! ED_P_2_AD_P_H + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_N) ! ED_P_2_AD_P_N +end subroutine + +subroutine ADI_CopyFED_Data(SrcFED_DataData, DstFED_DataData, CtrlCode, ErrStat, ErrMsg) + type(FED_Data), intent(inout) :: SrcFED_DataData + type(FED_Data), intent(inout) :: DstFED_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyFED_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcFED_DataData%WT)) then + LB(1:1) = lbound(SrcFED_DataData%WT) + UB(1:1) = ubound(SrcFED_DataData%WT) + if (.not. allocated(DstFED_DataData%WT)) then + allocate(DstFED_DataData%WT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFED_DataData%WT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyRotFED(SrcFED_DataData%WT(i1), DstFED_DataData%WT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine ADI_DestroyFED_Data(FED_DataData, ErrStat, ErrMsg) + type(FED_Data), intent(inout) :: FED_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyFED_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(FED_DataData%WT)) then + LB(1:1) = lbound(FED_DataData%WT) + UB(1:1) = ubound(FED_DataData%WT) + do i1 = LB(1), UB(1) + call ADI_DestroyRotFED(FED_DataData%WT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(FED_DataData%WT) + end if +end subroutine + +subroutine ADI_PackFED_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FED_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackFED_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WT)) + if (allocated(InData%WT)) then + call RegPackBounds(Buf, 1, lbound(InData%WT), ubound(InData%WT)) + LB(1:1) = lbound(InData%WT) + UB(1:1) = ubound(InData%WT) + do i1 = LB(1), UB(1) + call ADI_PackRotFED(Buf, InData%WT(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackFED_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FED_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackFED_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WT)) deallocate(OutData%WT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackRotFED(Buf, OutData%WT(i1)) ! WT + end do + end if +end subroutine END MODULE AeroDyn_Inflow_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 230a66c3f4..3a13bbff99 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -62,22 +62,22 @@ MODULE AeroDyn_Types INTEGER(IntKi), PUBLIC, PARAMETER :: AD_MaxBl_Out = 3 ! Maximum number of blades for information output (or linearization) [-] ! ========= TFinParameterType ======= TYPE, PUBLIC :: TFinParameterType - INTEGER(IntKi) :: TFinMod !< Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based} [(switch)] - REAL(ReKi) :: TFinChord !< Tail fin chord [used only when TFinMod=1] [m] - REAL(ReKi) :: TFinArea !< Tail fin planform area [used only when TFinMod=1] [m^2] - INTEGER(IntKi) :: TFinIndMod !< Model for induced velocity calculation {0=none, 1=rotor-average} [(switch)] - INTEGER(IntKi) :: TFinAFID !< Index of Tail fin airfoil number [1 to NumAFfiles] [-] + INTEGER(IntKi) :: TFinMod = 0_IntKi !< Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based} [(switch)] + REAL(ReKi) :: TFinChord = 0.0_ReKi !< Tail fin chord [used only when TFinMod=1] [m] + REAL(ReKi) :: TFinArea = 0.0_ReKi !< Tail fin planform area [used only when TFinMod=1] [m^2] + INTEGER(IntKi) :: TFinIndMod = 0_IntKi !< Model for induced velocity calculation {0=none, 1=rotor-average} [(switch)] + INTEGER(IntKi) :: TFinAFID = 0_IntKi !< Index of Tail fin airfoil number [1 to NumAFfiles] [-] END TYPE TFinParameterType ! ======================= ! ========= TFinInputFileType ======= TYPE, PUBLIC :: TFinInputFileType - INTEGER(IntKi) :: TFinMod !< Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based} [(switch)] - REAL(ReKi) :: TFinChord !< Tail fin chord [used only when TFinMod=1] [m] - REAL(ReKi) :: TFinArea !< Tail fin planform area [used only when TFinMod=1] [m^2] - REAL(ReKi) , DIMENSION(1:3) :: TFinRefP_n !< Undeflected position of the tail fin reference point wrt the tower top [m] - REAL(ReKi) , DIMENSION(1:3) :: TFinAngles !< Tail fin chordline skew, tilt, and bank angles about the reference point [(deg)] - INTEGER(IntKi) :: TFinIndMod !< Model for induced velocity calculation {0=none, 1=rotor-average} [(switch)] - INTEGER(IntKi) :: TFinAFID !< Index of Tail fin airfoil number [1 to NumAFfiles] [-] + INTEGER(IntKi) :: TFinMod = 0_IntKi !< Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based} [(switch)] + REAL(ReKi) :: TFinChord = 0.0_ReKi !< Tail fin chord [used only when TFinMod=1] [m] + REAL(ReKi) :: TFinArea = 0.0_ReKi !< Tail fin planform area [used only when TFinMod=1] [m^2] + REAL(ReKi) , DIMENSION(1:3) :: TFinRefP_n = 0.0_ReKi !< Undeflected position of the tail fin reference point wrt the tower top [m] + REAL(ReKi) , DIMENSION(1:3) :: TFinAngles = 0.0_ReKi !< Tail fin chordline skew, tilt, and bank angles about the reference point [(deg)] + INTEGER(IntKi) :: TFinIndMod = 0_IntKi !< Model for induced velocity calculation {0=none, 1=rotor-average} [(switch)] + INTEGER(IntKi) :: TFinAFID = 0_IntKi !< Index of Tail fin airfoil number [1 to NumAFfiles] [-] END TYPE TFinInputFileType ! ======================= ! ========= AD_VTK_BLSurfaceType ======= @@ -93,13 +93,13 @@ MODULE AeroDyn_Types ! ======================= ! ========= RotInitInputType ======= TYPE, PUBLIC :: RotInitInputType - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - REAL(ReKi) , DIMENSION(1:3) :: HubPosition !< X-Y-Z reference position of hub [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: HubOrientation !< DCM reference orientation of hub [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + REAL(ReKi) , DIMENSION(1:3) :: HubPosition = 0.0_ReKi !< X-Y-Z reference position of hub [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: HubOrientation = 0.0_R8Ki !< DCM reference orientation of hub [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BladeRootPosition !< X-Y-Z reference position of each blade root (3 x NumBlades) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: BladeRootOrientation !< DCM reference orientation of blade roots (3x3 x NumBlades) [-] - REAL(R8Ki) , DIMENSION(1:3) :: NacellePosition !< X-Y-Z reference position of nacelle [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacelleOrientation !< DCM reference orientation of nacelle [-] + REAL(R8Ki) , DIMENSION(1:3) :: NacellePosition = 0.0_R8Ki !< X-Y-Z reference position of nacelle [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacelleOrientation = 0.0_R8Ki !< DCM reference orientation of nacelle [-] INTEGER(IntKi) :: AeroProjMod = 1 !< Flag to switch between different projection models [-] INTEGER(IntKi) :: AeroBEM_Mod = -1 !< Flag to switch between different BEM Model [-] END TYPE RotInitInputType @@ -112,20 +112,20 @@ MODULE AeroDyn_Types LOGICAL :: UsePrimaryInputFile = .TRUE. !< Read input file instead of passed data [-] TYPE(FileInfoType) :: PassedPrimaryInputData !< Primary input file as FileInfoType (set by driver/glue code) [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - REAL(ReKi) :: Gravity !< Gravity force [Nm/s^2] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] - REAL(ReKi) :: defFldDens !< Default fluid density from the driver; may be overwritten [kg/m^3] - REAL(ReKi) :: defKinVisc !< Default kinematic viscosity from the driver; may be overwritten [m^2/s] - REAL(ReKi) :: defSpdSound !< Default speed of sound from the driver; may be overwritten [m/s] - REAL(ReKi) :: defPatm !< Default atmospheric pressure from the driver; may be overwritten [Pa] - REAL(ReKi) :: defPvap !< Default vapor pressure from the driver; may be overwritten [Pa] - REAL(ReKi) :: WtrDpth !< Water depth [m] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity force [Nm/s^2] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + REAL(ReKi) :: defFldDens = 0.0_ReKi !< Default fluid density from the driver; may be overwritten [kg/m^3] + REAL(ReKi) :: defKinVisc = 0.0_ReKi !< Default kinematic viscosity from the driver; may be overwritten [m^2/s] + REAL(ReKi) :: defSpdSound = 0.0_ReKi !< Default speed of sound from the driver; may be overwritten [m/s] + REAL(ReKi) :: defPatm = 0.0_ReKi !< Default atmospheric pressure from the driver; may be overwritten [Pa] + REAL(ReKi) :: defPvap = 0.0_ReKi !< Default vapor pressure from the driver; may be overwritten [Pa] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] END TYPE AD_InitInputType ! ======================= ! ========= AD_BladePropsType ======= TYPE, PUBLIC :: AD_BladePropsType - INTEGER(IntKi) :: NumBlNds !< Number of blade nodes used in the analysis [-] + INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of blade nodes used in the analysis [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlSpn !< Span at blade node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCrvAC !< Curve at blade node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlSwpAC !< Sweep at blade node [m] @@ -145,7 +145,7 @@ MODULE AeroDyn_Types ! ======================= ! ========= RotInitOutputType ======= TYPE, PUBLIC :: RotInitOutputType - REAL(ReKi) :: AirDens !< Air density [kg/m^3] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(AD_BladeShape) , DIMENSION(:), ALLOCATABLE :: BladeShape !< airfoil coordinates for each blade [m] @@ -171,16 +171,16 @@ MODULE AeroDyn_Types ! ========= RotInputFile ======= TYPE, PUBLIC :: RotInputFile TYPE(AD_BladePropsType) , DIMENSION(:), ALLOCATABLE :: BladeProps !< blade property information from blade input files [-] - INTEGER(IntKi) :: NumTwrNds !< Number of tower nodes used in the analysis [-] + INTEGER(IntKi) :: NumTwrNds = 0_IntKi !< Number of tower nodes used in the analysis [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrElev !< Elevation at tower node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrDiam !< Diameter of tower at node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCd !< Coefficient of drag at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrTI !< Turbulence intensity for tower shadow at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCb !< Coefficient of buoyancy at tower node [-] - REAL(ReKi) :: VolHub !< Hub volume [m^3] - REAL(ReKi) :: HubCenBx !< Hub center of buoyancy x direction offset [m] - REAL(ReKi) :: VolNac !< Nacelle volume [m^3] - REAL(ReKi) , DIMENSION(1:3) :: NacCenB !< Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates [m] + REAL(ReKi) :: VolHub = 0.0_ReKi !< Hub volume [m^3] + REAL(ReKi) :: HubCenBx = 0.0_ReKi !< Hub center of buoyancy x direction offset [m] + REAL(ReKi) :: VolNac = 0.0_ReKi !< Nacelle volume [m^3] + REAL(ReKi) , DIMENSION(1:3) :: NacCenB = 0.0_ReKi !< Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates [m] LOGICAL :: TFinAero = .FALSE. !< Calculate tail fin aerodynamics model (flag) [flag] CHARACTER(1024) :: TFinFile !< Input file for tail fin aerodynamics [used only when TFinAero=True] [-] TYPE(TFinInputFileType) :: TFin !< Input file data for tail fin [-] @@ -188,60 +188,60 @@ 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] - 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} [-] - INTEGER(IntKi) :: TwrShadow !< Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model} [-] - LOGICAL :: TwrAero !< Calculate tower aerodynamic loads? [flag] - LOGICAL :: FrozenWake !< Flag that tells this module it should assume a frozen wake during linearization. [-] - LOGICAL :: CavitCheck !< Flag that tells us if we want to check for cavitation [-] - LOGICAL :: Buoyancy !< Include buoyancy effects? [flag] - LOGICAL :: CompAA !< Compute AeroAcoustic noise [flag] + LOGICAL :: Echo = .false. !< Echo input file to echo file [-] + REAL(DbKi) :: DTAero = 0.0_R8Ki !< Time interval for aerodynamic calculations {or "default"} [s] + INTEGER(IntKi) :: WakeMod = 0_IntKi !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] + INTEGER(IntKi) :: AFAeroMod = 0_IntKi !< Type of blade airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model} [-] + INTEGER(IntKi) :: TwrPotent = 0_IntKi !< 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} [-] + INTEGER(IntKi) :: TwrShadow = 0_IntKi !< Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model} [-] + LOGICAL :: TwrAero = .false. !< Calculate tower aerodynamic loads? [flag] + LOGICAL :: FrozenWake = .false. !< Flag that tells this module it should assume a frozen wake during linearization. [-] + LOGICAL :: CavitCheck = .false. !< Flag that tells us if we want to check for cavitation [-] + LOGICAL :: Buoyancy = .false. !< Include buoyancy effects? [flag] + LOGICAL :: CompAA = .false. !< Compute AeroAcoustic noise [flag] CHARACTER(1024) :: AA_InputFile !< AeroAcoustics input file name [quoted strings] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: ADBlFile !< AD blade file (NumBl filenames) [quoted strings] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - REAL(ReKi) :: Patm !< Atmospheric pressure [Pa] - REAL(ReKi) :: Pvap !< Vapour pressure [Pa] - REAL(ReKi) :: SpdSound !< Speed of sound [m/s] - INTEGER(IntKi) :: SkewMod !< Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0] [-] - REAL(ReKi) :: SkewModFactor !< Constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] - LOGICAL :: TipLoss !< Use the Prandtl tip-loss model? [unused when WakeMod=0] [flag] - LOGICAL :: HubLoss !< Use the Prandtl hub-loss model? [unused when WakeMod=0] [flag] - LOGICAL :: TanInd !< Include tangential induction in BEMT calculations? [unused when WakeMod=0] [flag] - LOGICAL :: AIDrag !< Include the drag term in the axial-induction calculation? [unused when WakeMod=0] [flag] - LOGICAL :: TIDrag !< Include the drag term in the tangential-induction calculation? [unused when WakeMod=0 or TanInd=FALSE] [flag] - REAL(ReKi) :: IndToler !< Convergence tolerance for BEM induction factors [unused when WakeMod=0] [-] - REAL(ReKi) :: MaxIter !< Maximum number of iteration steps [unused when WakeMod=0] [-] - INTEGER(IntKi) :: UAMod !< Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] [-] - LOGICAL :: FLookup !< Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAeroMod=2] [flag] - REAL(ReKi) :: InCol_Alfa !< The column in the airfoil tables that contains the angle of attack [-] - REAL(ReKi) :: InCol_Cl !< The column in the airfoil tables that contains the lift coefficient [-] - REAL(ReKi) :: InCol_Cd !< The column in the airfoil tables that contains the drag coefficient [-] - REAL(ReKi) :: InCol_Cm !< The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column [-] - REAL(ReKi) :: InCol_Cpmin !< The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column [-] - INTEGER(IntKi) :: AFTabMod !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] - INTEGER(IntKi) :: NumAFfiles !< Number of airfoil files used [-] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + REAL(ReKi) :: Patm = 0.0_ReKi !< Atmospheric pressure [Pa] + REAL(ReKi) :: Pvap = 0.0_ReKi !< Vapour pressure [Pa] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] + INTEGER(IntKi) :: SkewMod = 0_IntKi !< Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0] [-] + REAL(ReKi) :: SkewModFactor = 0.0_ReKi !< Constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] + LOGICAL :: TipLoss = .false. !< Use the Prandtl tip-loss model? [unused when WakeMod=0] [flag] + LOGICAL :: HubLoss = .false. !< Use the Prandtl hub-loss model? [unused when WakeMod=0] [flag] + LOGICAL :: TanInd = .false. !< Include tangential induction in BEMT calculations? [unused when WakeMod=0] [flag] + LOGICAL :: AIDrag = .false. !< Include the drag term in the axial-induction calculation? [unused when WakeMod=0] [flag] + LOGICAL :: TIDrag = .false. !< Include the drag term in the tangential-induction calculation? [unused when WakeMod=0 or TanInd=FALSE] [flag] + REAL(ReKi) :: IndToler = 0.0_ReKi !< Convergence tolerance for BEM induction factors [unused when WakeMod=0] [-] + REAL(ReKi) :: MaxIter = 0.0_ReKi !< Maximum number of iteration steps [unused when WakeMod=0] [-] + INTEGER(IntKi) :: UAMod = 0_IntKi !< Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] [-] + LOGICAL :: FLookup = .false. !< Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAeroMod=2] [flag] + REAL(ReKi) :: InCol_Alfa = 0.0_ReKi !< The column in the airfoil tables that contains the angle of attack [-] + REAL(ReKi) :: InCol_Cl = 0.0_ReKi !< The column in the airfoil tables that contains the lift coefficient [-] + REAL(ReKi) :: InCol_Cd = 0.0_ReKi !< The column in the airfoil tables that contains the drag coefficient [-] + REAL(ReKi) :: InCol_Cm = 0.0_ReKi !< The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column [-] + REAL(ReKi) :: InCol_Cpmin = 0.0_ReKi !< The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column [-] + INTEGER(IntKi) :: AFTabMod = 0_IntKi !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] + INTEGER(IntKi) :: NumAFfiles = 0_IntKi !< Number of airfoil files used [-] 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] - 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] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: TwOutNd !< Tower nodes whose values will be output [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + LOGICAL :: UseBlCm = .false. !< Include aerodynamic pitching moment in calculations? [flag] + LOGICAL :: SumPrint = .false. !< Generate a summary file listing input options and interpolated properties to ".AD.sum"? [flag] + INTEGER(IntKi) :: NBlOuts = 0_IntKi !< Number of blade node outputs [0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: BlOutNd = 0_IntKi !< Blade nodes whose values will be output [-] + INTEGER(IntKi) :: NTwOuts = 0_IntKi !< Number of tower node outputs [0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: TwOutNd = 0_IntKi !< Tower nodes whose values will be output [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - REAL(ReKi) :: tau1_const !< time constant for DBEMT [used only when WakeMod=2 and DBEMT_Mod/=2] [s] - INTEGER(IntKi) :: DBEMT_Mod !< Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} [-] - INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] + REAL(ReKi) :: tau1_const = 0.0_ReKi !< time constant for DBEMT [used only when WakeMod=2 and DBEMT_Mod/=2] [s] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (AD_AllBldNdOuts) [-] CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (AD_AllBldNdOuts) [-] - INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (AD_AllBldNdOuts) [-] - REAL(ReKi) :: UAStartRad !< Starting [radius] - REAL(ReKi) :: UAEndRad !< Ending [radius] + INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (AD_AllBldNdOuts) [-] + REAL(ReKi) :: UAStartRad = 0.0_ReKi !< Starting [radius] + REAL(ReKi) :: UAEndRad = 0.0_ReKi !< Ending [radius] TYPE(RotInputFile) , DIMENSION(:), ALLOCATABLE :: rotors !< Rotor (blades and tower) input file data [-] END TYPE AD_InputFile ! ======================= @@ -317,11 +317,11 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mx !< pitching moment per unit length of the jth node in the kth blade (in x direction) [Nm/m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: My !< pitching moment per unit length of the jth node in the kth blade (in y direction) [Nm/m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mz !< pitching moment per unit length of the jth node in the kth blade (in z direction) [Nm/m] - REAL(ReKi) , DIMENSION(1:3) :: V_DiskAvg !< disk-average relative wind speed [m/s] - REAL(ReKi) :: yaw !< Yaw calculated in SetInputsForBEMT [rad] - REAL(ReKi) :: tilt !< tilt calculated in SetInputsForBEMT [rad] + REAL(ReKi) , DIMENSION(1:3) :: V_DiskAvg = 0.0_ReKi !< disk-average relative wind speed [m/s] + REAL(ReKi) :: yaw = 0.0_ReKi !< Yaw calculated in SetInputsForBEMT [rad] + REAL(ReKi) :: tilt = 0.0_ReKi !< tilt calculated in SetInputsForBEMT [rad] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: hub_theta_x_root !< angles saved for FAST.Farm [rad] - REAL(ReKi) :: V_dot_x + REAL(ReKi) :: V_dot_x = 0.0_ReKi TYPE(MeshType) :: HubLoad !< mesh at hub; used to compute an integral for mapping the output blade loads to a single point (for writing to file only) [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_L_2_H_P !< mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SigmaCavitCrit !< critical cavitation number- inception value (above which cavit will occur) [-] @@ -343,18 +343,18 @@ MODULE AeroDyn_Types TYPE(MeshType) :: TwrBuoyLoadPoint !< point mesh for lumped buoyant tower loads [-] TYPE(MeshType) :: TwrBuoyLoad !< line mesh for per unit length buoyant tower loads [-] TYPE(MeshMapType) :: T_P_2_T_L !< mapping data structure to map buoyant tower point loads (m%TwrBuoyLoadPoint) to buoyant tower line loads (m%TwrBuoyLoad) [-] - LOGICAL :: FirstWarn_TowerStrike !< flag to avoid printing tower strike multiple times [-] - REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVel !< disk-averaged U,V,W (undisturbed) [m/s] - REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVelDist !< disk-averaged U,V,W (disturbed) [m/s] - REAL(ReKi) :: TFinAlpha !< Angle of attack for tailfin [-] - REAL(ReKi) :: TFinRe !< Reynolds number for tailfin [-] - REAL(ReKi) :: TFinVrel !< Orthogonal relative velocity nrom at the reference point [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinVund_i !< Undisturbed wind velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinVind_i !< Induced velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinVrel_i !< Relative velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinSTV_i !< Structural velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinF_i !< Forces at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinM_i !< Moments at the reference point of the fin in the inertial system [-] + LOGICAL :: FirstWarn_TowerStrike = .false. !< flag to avoid printing tower strike multiple times [-] + REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVel = 0.0_ReKi !< disk-averaged U,V,W (undisturbed) [m/s] + REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVelDist = 0.0_ReKi !< disk-averaged U,V,W (disturbed) [m/s] + REAL(ReKi) :: TFinAlpha = 0.0_ReKi !< Angle of attack for tailfin [-] + REAL(ReKi) :: TFinRe = 0.0_ReKi !< Reynolds number for tailfin [-] + REAL(ReKi) :: TFinVrel = 0.0_ReKi !< Orthogonal relative velocity nrom at the reference point [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinVund_i = 0.0_ReKi !< Undisturbed wind velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinVind_i = 0.0_ReKi !< Induced velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinVrel_i = 0.0_ReKi !< Relative velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinSTV_i = 0.0_ReKi !< Structural velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinF_i = 0.0_ReKi !< Forces at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinM_i = 0.0_ReKi !< Moments at the reference point of the fin in the inertial system [-] END TYPE RotMiscVarType ! ======================= ! ========= AD_MiscVarType ======= @@ -370,9 +370,9 @@ MODULE AeroDyn_Types ! ======================= ! ========= RotParameterType ======= TYPE, PUBLIC :: RotParameterType - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumBlNds !< Number of nodes on each blade [-] - INTEGER(IntKi) :: NumTwrNds !< Number of nodes on the tower [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of nodes on each blade [-] + INTEGER(IntKi) :: NumTwrNds = 0_IntKi !< Number of nodes on the tower [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrDiam !< Diameter of tower at node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCd !< Coefficient of drag at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrTI !< Turbulence intensity for tower shadow at tower node [-] @@ -380,12 +380,12 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCb !< Coefficient of buoyancy at tower node [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlCenBn !< Normal offset between aerodynamic center and center of buoyancy at blade node [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlCenBt !< Tangential offset between aerodynamic center and center of buoyancy at blade node [m] - REAL(ReKi) :: VolHub !< Hub volume [m^3] - REAL(ReKi) :: HubCenBx !< Hub center of buoyancy x direction offset [m] - REAL(ReKi) :: VolNac !< Nacelle volume [m^3] - REAL(ReKi) , DIMENSION(1:3) :: NacCenB !< Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates [m] - REAL(ReKi) :: VolBl !< Buoyancy volume of all blades [m^3] - REAL(ReKi) :: VolTwr !< Buoyancy volume of the tower [m^3] + REAL(ReKi) :: VolHub = 0.0_ReKi !< Hub volume [m^3] + REAL(ReKi) :: HubCenBx = 0.0_ReKi !< Hub center of buoyancy x direction offset [m] + REAL(ReKi) :: VolNac = 0.0_ReKi !< Nacelle volume [m^3] + REAL(ReKi) , DIMENSION(1:3) :: NacCenB = 0.0_ReKi !< Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates [m] + REAL(ReKi) :: VolBl = 0.0_ReKi !< Buoyancy volume of all blades [m^3] + REAL(ReKi) :: VolTwr = 0.0_ReKi !< Buoyancy volume of the tower [m^3] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlRad !< Matrix of equivalent blade radius at each node, used in buoyancy calculation [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlDL !< Matrix of blade element length based on CB, used in buoyancy calculation [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlTaper !< Matrix of blade element taper, used in buoyancy calculation [-] @@ -399,38 +399,38 @@ MODULE AeroDyn_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: NumBl_Lin !< number of blades in the jacobian [-] - 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} [-] - INTEGER(IntKi) :: TwrShadow !< Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model} [-] - LOGICAL :: TwrAero !< Calculate tower aerodynamic loads? [flag] - LOGICAL :: FrozenWake !< Flag that tells this module it should assume a frozen wake during linearization. [-] - LOGICAL :: CavitCheck !< Flag that tells us if we want to check for cavitation [-] - LOGICAL :: Buoyancy !< Include buoyancy effects? [flag] - INTEGER(IntKi) :: MHK !< MHK [flag] - LOGICAL :: CompAA !< Compute AeroAcoustic noise [flag] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound [m/s] - REAL(ReKi) :: Gravity !< Gravitational acceleration [m/s^2] - REAL(ReKi) :: Patm !< Atmospheric pressure [Pa] - REAL(ReKi) :: Pvap !< Vapour pressure [Pa] - REAL(ReKi) :: WtrDpth !< Water depth [m] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: NumBl_Lin = 0_IntKi !< number of blades in the jacobian [-] + INTEGER(IntKi) :: TwrPotent = 0_IntKi !< 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} [-] + INTEGER(IntKi) :: TwrShadow = 0_IntKi !< Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model} [-] + LOGICAL :: TwrAero = .false. !< Calculate tower aerodynamic loads? [flag] + LOGICAL :: FrozenWake = .false. !< Flag that tells this module it should assume a frozen wake during linearization. [-] + LOGICAL :: CavitCheck = .false. !< Flag that tells us if we want to check for cavitation [-] + LOGICAL :: Buoyancy = .false. !< Include buoyancy effects? [flag] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK [flag] + LOGICAL :: CompAA = .false. !< Compute AeroAcoustic noise [flag] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + REAL(ReKi) :: Patm = 0.0_ReKi !< Atmospheric pressure [Pa] + REAL(ReKi) :: Pvap = 0.0_ReKi !< Vapour pressure [Pa] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] INTEGER(IntKi) :: AeroProjMod = 1 !< Flag to switch between different projection models [-] INTEGER(IntKi) :: AeroBEM_Mod = -1 !< Flag to switch between different BEM Model [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - 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] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: TwOutNd !< Tower nodes whose values will be output [-] - INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] - INTEGER(IntKi) :: BldNd_TotNumOuts !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: NBlOuts = 0_IntKi !< Number of blade node outputs [0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: BlOutNd = 0_IntKi !< Blade nodes whose values will be output [-] + INTEGER(IntKi) :: NTwOuts = 0_IntKi !< Number of tower node outputs [0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: TwOutNd = 0_IntKi !< Tower nodes whose values will be output [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_TotNumOuts = 0_IntKi !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- AD_AllBldNdOuts) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< Names and units (and other characteristics) of all requested output parameters [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< The blade nodes to actually output (AD_AllBldNdOuts) [-] - INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (AD_AllBldNdOuts) [-] LOGICAL :: TFinAero = .FALSE. !< Calculate tail fin aerodynamics model (flag) [flag] TYPE(TFinParameterType) :: TFin !< Parameters for tail fin of current rotor [-] END TYPE RotParameterType @@ -438,14 +438,14 @@ MODULE AeroDyn_Types ! ========= AD_ParameterType ======= TYPE, PUBLIC :: AD_ParameterType TYPE(RotParameterType) , DIMENSION(:), ALLOCATABLE :: rotors !< Parameter types for each rotor [-] - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(AFI_ParameterType) , DIMENSION(:), ALLOCATABLE :: AFI !< AirfoilInfo parameters [-] - INTEGER(IntKi) :: SkewMod !< Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0] [-] - INTEGER(IntKi) :: WakeMod !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] + INTEGER(IntKi) :: SkewMod = 0_IntKi !< Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0] [-] + INTEGER(IntKi) :: WakeMod = 0_IntKi !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] TYPE(FVW_ParameterType) :: FVW !< Parameters for FVW module [-] LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false) [-] - LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] + LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of InflowWinds flow field data type [-] END TYPE AD_ParameterType ! ======================= @@ -459,9 +459,9 @@ MODULE AeroDyn_Types TYPE(MeshType) :: TFinMotion !< motion of tail fin (at tail fin ref point) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: InflowOnBlade !< U,V,W at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change) [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowOnTower !< U,V,W at nodes on the tower [m/s] - REAL(ReKi) , DIMENSION(1:3) :: InflowOnHub !< U,V,W at hub [m/s] - REAL(ReKi) , DIMENSION(1:3) :: InflowOnNacelle !< U,V,W at nacelle [m/s] - REAL(ReKi) , DIMENSION(1:3) :: InflowOnTailFin !< U,V,W at tailfin [m/s] + REAL(ReKi) , DIMENSION(1:3) :: InflowOnHub = 0.0_ReKi !< U,V,W at hub [m/s] + REAL(ReKi) , DIMENSION(1:3) :: InflowOnNacelle = 0.0_ReKi !< U,V,W at nacelle [m/s] + REAL(ReKi) , DIMENSION(1:3) :: InflowOnTailFin = 0.0_ReKi !< U,V,W at tailfin [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: UserProp !< Optional user property for interpolating airfoils (per element per blade) [-] END TYPE RotInputType ! ======================= @@ -487,17671 +487,6735 @@ MODULE AeroDyn_Types END TYPE AD_OutputType ! ======================= CONTAINS - SUBROUTINE AD_CopyTFinParameterType( SrcTFinParameterTypeData, DstTFinParameterTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TFinParameterType), INTENT(IN) :: SrcTFinParameterTypeData - TYPE(TFinParameterType), INTENT(INOUT) :: DstTFinParameterTypeData - 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 = 'AD_CopyTFinParameterType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstTFinParameterTypeData%TFinMod = SrcTFinParameterTypeData%TFinMod - DstTFinParameterTypeData%TFinChord = SrcTFinParameterTypeData%TFinChord - DstTFinParameterTypeData%TFinArea = SrcTFinParameterTypeData%TFinArea - DstTFinParameterTypeData%TFinIndMod = SrcTFinParameterTypeData%TFinIndMod - DstTFinParameterTypeData%TFinAFID = SrcTFinParameterTypeData%TFinAFID - END SUBROUTINE AD_CopyTFinParameterType - - SUBROUTINE AD_DestroyTFinParameterType( TFinParameterTypeData, ErrStat, ErrMsg ) - TYPE(TFinParameterType), INTENT(INOUT) :: TFinParameterTypeData - 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 = 'AD_DestroyTFinParameterType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD_DestroyTFinParameterType - - SUBROUTINE AD_PackTFinParameterType( 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(TFinParameterType), 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 = 'AD_PackTFinParameterType' - ! 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 ! TFinMod - Re_BufSz = Re_BufSz + 1 ! TFinChord - Re_BufSz = Re_BufSz + 1 ! TFinArea - Int_BufSz = Int_BufSz + 1 ! TFinIndMod - Int_BufSz = Int_BufSz + 1 ! TFinAFID - 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%TFinMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinChord - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinArea - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TFinIndMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TFinAFID - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_PackTFinParameterType - - SUBROUTINE AD_UnPackTFinParameterType( 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(TFinParameterType), 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 = 'AD_UnPackTFinParameterType' - ! 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%TFinMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFinChord = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinIndMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFinAFID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_UnPackTFinParameterType - - SUBROUTINE AD_CopyTFinInputFileType( SrcTFinInputFileTypeData, DstTFinInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TFinInputFileType), INTENT(IN) :: SrcTFinInputFileTypeData - TYPE(TFinInputFileType), INTENT(INOUT) :: DstTFinInputFileTypeData - 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 = 'AD_CopyTFinInputFileType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstTFinInputFileTypeData%TFinMod = SrcTFinInputFileTypeData%TFinMod - DstTFinInputFileTypeData%TFinChord = SrcTFinInputFileTypeData%TFinChord - DstTFinInputFileTypeData%TFinArea = SrcTFinInputFileTypeData%TFinArea - DstTFinInputFileTypeData%TFinRefP_n = SrcTFinInputFileTypeData%TFinRefP_n - DstTFinInputFileTypeData%TFinAngles = SrcTFinInputFileTypeData%TFinAngles - DstTFinInputFileTypeData%TFinIndMod = SrcTFinInputFileTypeData%TFinIndMod - DstTFinInputFileTypeData%TFinAFID = SrcTFinInputFileTypeData%TFinAFID - END SUBROUTINE AD_CopyTFinInputFileType - - SUBROUTINE AD_DestroyTFinInputFileType( TFinInputFileTypeData, ErrStat, ErrMsg ) - TYPE(TFinInputFileType), INTENT(INOUT) :: TFinInputFileTypeData - 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 = 'AD_DestroyTFinInputFileType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD_DestroyTFinInputFileType - - SUBROUTINE AD_PackTFinInputFileType( 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(TFinInputFileType), 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 = 'AD_PackTFinInputFileType' - ! 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 ! TFinMod - Re_BufSz = Re_BufSz + 1 ! TFinChord - Re_BufSz = Re_BufSz + 1 ! TFinArea - Re_BufSz = Re_BufSz + SIZE(InData%TFinRefP_n) ! TFinRefP_n - Re_BufSz = Re_BufSz + SIZE(InData%TFinAngles) ! TFinAngles - Int_BufSz = Int_BufSz + 1 ! TFinIndMod - Int_BufSz = Int_BufSz + 1 ! TFinAFID - 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%TFinMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinChord - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinArea - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%TFinRefP_n,1), UBOUND(InData%TFinRefP_n,1) - ReKiBuf(Re_Xferred) = InData%TFinRefP_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinAngles,1), UBOUND(InData%TFinAngles,1) - ReKiBuf(Re_Xferred) = InData%TFinAngles(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%TFinIndMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TFinAFID - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_PackTFinInputFileType - - SUBROUTINE AD_UnPackTFinInputFileType( 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(TFinInputFileType), 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 = 'AD_UnPackTFinInputFileType' - ! 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%TFinMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFinChord = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%TFinRefP_n,1) - i1_u = UBOUND(OutData%TFinRefP_n,1) - DO i1 = LBOUND(OutData%TFinRefP_n,1), UBOUND(OutData%TFinRefP_n,1) - OutData%TFinRefP_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinAngles,1) - i1_u = UBOUND(OutData%TFinAngles,1) - DO i1 = LBOUND(OutData%TFinAngles,1), UBOUND(OutData%TFinAngles,1) - OutData%TFinAngles(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TFinIndMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFinAFID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_UnPackTFinInputFileType - - SUBROUTINE AD_CopyVTK_BLSurfaceType( SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_VTK_BLSurfaceType), INTENT(IN) :: SrcVTK_BLSurfaceTypeData - TYPE(AD_VTK_BLSurfaceType), INTENT(INOUT) :: DstVTK_BLSurfaceTypeData - 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 = 'AD_CopyVTK_BLSurfaceType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) THEN - i1_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,1) - i1_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,1) - i2_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,2) - i2_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,2) - i3_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,3) - i3_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,3) - IF (.NOT. ALLOCATED(DstVTK_BLSurfaceTypeData%AirfoilCoords)) THEN - ALLOCATE(DstVTK_BLSurfaceTypeData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_BLSurfaceTypeData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_BLSurfaceTypeData%AirfoilCoords = SrcVTK_BLSurfaceTypeData%AirfoilCoords -ENDIF - END SUBROUTINE AD_CopyVTK_BLSurfaceType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyVTK_BLSurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(VTK_BLSurfaceTypeData%AirfoilCoords)) THEN - DEALLOCATE(VTK_BLSurfaceTypeData%AirfoilCoords) -ENDIF - END SUBROUTINE AD_DestroyVTK_BLSurfaceType - - SUBROUTINE AD_PackVTK_BLSurfaceType( 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(AD_VTK_BLSurfaceType), 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 = 'AD_PackVTK_BLSurfaceType' - ! 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 ! AirfoilCoords allocated yes/no - IF ( ALLOCATED(InData%AirfoilCoords) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AirfoilCoords upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AirfoilCoords) ! AirfoilCoords - 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%AirfoilCoords) ) 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%AirfoilCoords,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) - DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) - DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) - ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD_PackVTK_BLSurfaceType - - SUBROUTINE AD_UnPackVTK_BLSurfaceType( 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(AD_VTK_BLSurfaceType), 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 = 'AD_UnPackVTK_BLSurfaceType' - ! 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 ! AirfoilCoords 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%AirfoilCoords)) DEALLOCATE(OutData%AirfoilCoords) - ALLOCATE(OutData%AirfoilCoords(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%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) - DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) - DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) - OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD_UnPackVTK_BLSurfaceType - - SUBROUTINE AD_CopyVTK_RotSurfaceType( SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_VTK_RotSurfaceType), INTENT(IN) :: SrcVTK_RotSurfaceTypeData - TYPE(AD_VTK_RotSurfaceType), INTENT(INOUT) :: DstVTK_RotSurfaceTypeData - 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 = 'AD_CopyVTK_RotSurfaceType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcVTK_RotSurfaceTypeData%BladeShape)) THEN - i1_l = LBOUND(SrcVTK_RotSurfaceTypeData%BladeShape,1) - i1_u = UBOUND(SrcVTK_RotSurfaceTypeData%BladeShape,1) - IF (.NOT. ALLOCATED(DstVTK_RotSurfaceTypeData%BladeShape)) THEN - ALLOCATE(DstVTK_RotSurfaceTypeData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_RotSurfaceTypeData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcVTK_RotSurfaceTypeData%BladeShape,1), UBOUND(SrcVTK_RotSurfaceTypeData%BladeShape,1) - CALL AD_Copyvtk_blsurfacetype( SrcVTK_RotSurfaceTypeData%BladeShape(i1), DstVTK_RotSurfaceTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcVTK_RotSurfaceTypeData%TowerRad)) THEN - i1_l = LBOUND(SrcVTK_RotSurfaceTypeData%TowerRad,1) - i1_u = UBOUND(SrcVTK_RotSurfaceTypeData%TowerRad,1) - IF (.NOT. ALLOCATED(DstVTK_RotSurfaceTypeData%TowerRad)) THEN - ALLOCATE(DstVTK_RotSurfaceTypeData%TowerRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_RotSurfaceTypeData%TowerRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_RotSurfaceTypeData%TowerRad = SrcVTK_RotSurfaceTypeData%TowerRad -ENDIF - END SUBROUTINE AD_CopyVTK_RotSurfaceType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyVTK_RotSurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(VTK_RotSurfaceTypeData%BladeShape) -ENDIF -IF (ALLOCATED(VTK_RotSurfaceTypeData%TowerRad)) THEN - DEALLOCATE(VTK_RotSurfaceTypeData%TowerRad) -ENDIF - END SUBROUTINE AD_DestroyVTK_RotSurfaceType - - SUBROUTINE AD_PackVTK_RotSurfaceType( 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(AD_VTK_RotSurfaceType), 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 = 'AD_PackVTK_RotSurfaceType' - ! 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 ! BladeShape allocated yes/no - IF ( ALLOCATED(InData%BladeShape) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeShape upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeShape - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeShape - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeShape - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TowerRad allocated yes/no - IF ( ALLOCATED(InData%TowerRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TowerRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TowerRad) ! TowerRad - 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%BladeShape) ) 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%BladeShape,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeShape,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%TowerRad) ) 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%TowerRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TowerRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TowerRad,1), UBOUND(InData%TowerRad,1) - ReKiBuf(Re_Xferred) = InData%TowerRad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_PackVTK_RotSurfaceType - - SUBROUTINE AD_UnPackVTK_RotSurfaceType( 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(AD_VTK_RotSurfaceType), 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 = 'AD_UnPackVTK_RotSurfaceType' - ! 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 ! BladeShape 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%BladeShape)) DEALLOCATE(OutData%BladeShape) - ALLOCATE(OutData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeShape,1), UBOUND(OutData%BladeShape,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 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 - - 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 ! TowerRad 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%TowerRad)) DEALLOCATE(OutData%TowerRad) - ALLOCATE(OutData%TowerRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TowerRad,1), UBOUND(OutData%TowerRad,1) - OutData%TowerRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_UnPackVTK_RotSurfaceType - - SUBROUTINE AD_CopyRotInitInputType( SrcRotInitInputTypeData, DstRotInitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotInitInputType), INTENT(IN) :: SrcRotInitInputTypeData - TYPE(RotInitInputType), INTENT(INOUT) :: DstRotInitInputTypeData - 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 = 'AD_CopyRotInitInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRotInitInputTypeData%NumBlades = SrcRotInitInputTypeData%NumBlades - DstRotInitInputTypeData%HubPosition = SrcRotInitInputTypeData%HubPosition - DstRotInitInputTypeData%HubOrientation = SrcRotInitInputTypeData%HubOrientation -IF (ALLOCATED(SrcRotInitInputTypeData%BladeRootPosition)) THEN - i1_l = LBOUND(SrcRotInitInputTypeData%BladeRootPosition,1) - i1_u = UBOUND(SrcRotInitInputTypeData%BladeRootPosition,1) - i2_l = LBOUND(SrcRotInitInputTypeData%BladeRootPosition,2) - i2_u = UBOUND(SrcRotInitInputTypeData%BladeRootPosition,2) - IF (.NOT. ALLOCATED(DstRotInitInputTypeData%BladeRootPosition)) THEN - ALLOCATE(DstRotInitInputTypeData%BladeRootPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitInputTypeData%BladeRootPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitInputTypeData%BladeRootPosition = SrcRotInitInputTypeData%BladeRootPosition -ENDIF -IF (ALLOCATED(SrcRotInitInputTypeData%BladeRootOrientation)) THEN - i1_l = LBOUND(SrcRotInitInputTypeData%BladeRootOrientation,1) - i1_u = UBOUND(SrcRotInitInputTypeData%BladeRootOrientation,1) - i2_l = LBOUND(SrcRotInitInputTypeData%BladeRootOrientation,2) - i2_u = UBOUND(SrcRotInitInputTypeData%BladeRootOrientation,2) - i3_l = LBOUND(SrcRotInitInputTypeData%BladeRootOrientation,3) - i3_u = UBOUND(SrcRotInitInputTypeData%BladeRootOrientation,3) - IF (.NOT. ALLOCATED(DstRotInitInputTypeData%BladeRootOrientation)) THEN - ALLOCATE(DstRotInitInputTypeData%BladeRootOrientation(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitInputTypeData%BladeRootOrientation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitInputTypeData%BladeRootOrientation = SrcRotInitInputTypeData%BladeRootOrientation -ENDIF - DstRotInitInputTypeData%NacellePosition = SrcRotInitInputTypeData%NacellePosition - DstRotInitInputTypeData%NacelleOrientation = SrcRotInitInputTypeData%NacelleOrientation - DstRotInitInputTypeData%AeroProjMod = SrcRotInitInputTypeData%AeroProjMod - DstRotInitInputTypeData%AeroBEM_Mod = SrcRotInitInputTypeData%AeroBEM_Mod - END SUBROUTINE AD_CopyRotInitInputType - - SUBROUTINE AD_DestroyRotInitInputType( RotInitInputTypeData, ErrStat, ErrMsg ) - TYPE(RotInitInputType), INTENT(INOUT) :: RotInitInputTypeData - 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 = 'AD_DestroyRotInitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(RotInitInputTypeData%BladeRootPosition)) THEN - DEALLOCATE(RotInitInputTypeData%BladeRootPosition) -ENDIF -IF (ALLOCATED(RotInitInputTypeData%BladeRootOrientation)) THEN - DEALLOCATE(RotInitInputTypeData%BladeRootOrientation) -ENDIF - END SUBROUTINE AD_DestroyRotInitInputType - - SUBROUTINE AD_PackRotInitInputType( 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(RotInitInputType), 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 = 'AD_PackRotInitInputType' - ! 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 ! NumBlades - Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition - Db_BufSz = Db_BufSz + SIZE(InData%HubOrientation) ! HubOrientation - Int_BufSz = Int_BufSz + 1 ! BladeRootPosition allocated yes/no - IF ( ALLOCATED(InData%BladeRootPosition) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BladeRootPosition upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BladeRootPosition) ! BladeRootPosition - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootOrientation allocated yes/no - IF ( ALLOCATED(InData%BladeRootOrientation) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BladeRootOrientation upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BladeRootOrientation) ! BladeRootOrientation - END IF - Db_BufSz = Db_BufSz + SIZE(InData%NacellePosition) ! NacellePosition - Db_BufSz = Db_BufSz + SIZE(InData%NacelleOrientation) ! NacelleOrientation - Int_BufSz = Int_BufSz + 1 ! AeroProjMod - Int_BufSz = Int_BufSz + 1 ! AeroBEM_Mod - 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%NumBlades - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) - ReKiBuf(Re_Xferred) = InData%HubPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%HubOrientation,2), UBOUND(InData%HubOrientation,2) - DO i1 = LBOUND(InData%HubOrientation,1), UBOUND(InData%HubOrientation,1) - DbKiBuf(Db_Xferred) = InData%HubOrientation(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%BladeRootPosition) ) 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%BladeRootPosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootPosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootPosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootPosition,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BladeRootPosition,2), UBOUND(InData%BladeRootPosition,2) - DO i1 = LBOUND(InData%BladeRootPosition,1), UBOUND(InData%BladeRootPosition,1) - ReKiBuf(Re_Xferred) = InData%BladeRootPosition(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeRootOrientation) ) 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%BladeRootOrientation,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrientation,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrientation,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrientation,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrientation,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrientation,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%BladeRootOrientation,3), UBOUND(InData%BladeRootOrientation,3) - DO i2 = LBOUND(InData%BladeRootOrientation,2), UBOUND(InData%BladeRootOrientation,2) - DO i1 = LBOUND(InData%BladeRootOrientation,1), UBOUND(InData%BladeRootOrientation,1) - DbKiBuf(Db_Xferred) = InData%BladeRootOrientation(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%NacellePosition,1), UBOUND(InData%NacellePosition,1) - DbKiBuf(Db_Xferred) = InData%NacellePosition(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%NacelleOrientation,2), UBOUND(InData%NacelleOrientation,2) - DO i1 = LBOUND(InData%NacelleOrientation,1), UBOUND(InData%NacelleOrientation,1) - DbKiBuf(Db_Xferred) = InData%NacelleOrientation(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - IntKiBuf(Int_Xferred) = InData%AeroProjMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AeroBEM_Mod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_PackRotInitInputType - - SUBROUTINE AD_UnPackRotInitInputType( 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(RotInitInputType), 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 = 'AD_UnPackRotInitInputType' - ! 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%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%HubPosition,1) - i1_u = UBOUND(OutData%HubPosition,1) - DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) - OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubOrientation,1) - i1_u = UBOUND(OutData%HubOrientation,1) - i2_l = LBOUND(OutData%HubOrientation,2) - i2_u = UBOUND(OutData%HubOrientation,2) - DO i2 = LBOUND(OutData%HubOrientation,2), UBOUND(OutData%HubOrientation,2) - DO i1 = LBOUND(OutData%HubOrientation,1), UBOUND(OutData%HubOrientation,1) - OutData%HubOrientation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootPosition 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%BladeRootPosition)) DEALLOCATE(OutData%BladeRootPosition) - ALLOCATE(OutData%BladeRootPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BladeRootPosition,2), UBOUND(OutData%BladeRootPosition,2) - DO i1 = LBOUND(OutData%BladeRootPosition,1), UBOUND(OutData%BladeRootPosition,1) - OutData%BladeRootPosition(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootOrientation 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%BladeRootOrientation)) DEALLOCATE(OutData%BladeRootOrientation) - ALLOCATE(OutData%BladeRootOrientation(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%BladeRootOrientation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%BladeRootOrientation,3), UBOUND(OutData%BladeRootOrientation,3) - DO i2 = LBOUND(OutData%BladeRootOrientation,2), UBOUND(OutData%BladeRootOrientation,2) - DO i1 = LBOUND(OutData%BladeRootOrientation,1), UBOUND(OutData%BladeRootOrientation,1) - OutData%BladeRootOrientation(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%NacellePosition,1) - i1_u = UBOUND(OutData%NacellePosition,1) - DO i1 = LBOUND(OutData%NacellePosition,1), UBOUND(OutData%NacellePosition,1) - OutData%NacellePosition(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NacelleOrientation,1) - i1_u = UBOUND(OutData%NacelleOrientation,1) - i2_l = LBOUND(OutData%NacelleOrientation,2) - i2_u = UBOUND(OutData%NacelleOrientation,2) - DO i2 = LBOUND(OutData%NacelleOrientation,2), UBOUND(OutData%NacelleOrientation,2) - DO i1 = LBOUND(OutData%NacelleOrientation,1), UBOUND(OutData%NacelleOrientation,1) - OutData%NacelleOrientation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%AeroProjMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AeroBEM_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_UnPackRotInitInputType - - SUBROUTINE AD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AD_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 = 'AD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitInputData%rotors)) THEN - i1_l = LBOUND(SrcInitInputData%rotors,1) - i1_u = UBOUND(SrcInitInputData%rotors,1) - IF (.NOT. ALLOCATED(DstInitInputData%rotors)) THEN - ALLOCATE(DstInitInputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%rotors,1), UBOUND(SrcInitInputData%rotors,1) - CALL AD_Copyrotinitinputtype( SrcInitInputData%rotors(i1), DstInitInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%UsePrimaryInputFile = SrcInitInputData%UsePrimaryInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%MHK = SrcInitInputData%MHK - DstInitInputData%defFldDens = SrcInitInputData%defFldDens - DstInitInputData%defKinVisc = SrcInitInputData%defKinVisc - DstInitInputData%defSpdSound = SrcInitInputData%defSpdSound - DstInitInputData%defPatm = SrcInitInputData%defPatm - DstInitInputData%defPvap = SrcInitInputData%defPvap - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - END SUBROUTINE AD_CopyInitInput - - SUBROUTINE AD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(AD_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 = 'AD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%rotors)) THEN -DO i1 = LBOUND(InitInputData%rotors,1), UBOUND(InitInputData%rotors,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyInitInput - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedPrimaryInputData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedPrimaryInputData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedPrimaryInputData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Linearize - Re_BufSz = Re_BufSz + 1 ! Gravity - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! defFldDens - Re_BufSz = Re_BufSz + 1 ! defKinVisc - Re_BufSz = Re_BufSz + 1 ! defSpdSound - Re_BufSz = Re_BufSz + 1 ! defPatm - Re_BufSz = Re_BufSz + 1 ! defPvap - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - 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%rotors) ) 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%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - 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 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 - 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%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - 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 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) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defFldDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defKinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defSpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defPatm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defPvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD_PackInitInput - - SUBROUTINE AD_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(AD_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 = 'AD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors 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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 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 - - 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 - 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%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePrimaryInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePrimaryInputFile) - 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%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData - 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%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%defFldDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defKinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defSpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defPatm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defPvap = 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 - END SUBROUTINE AD_UnPackInitInput - - SUBROUTINE AD_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_BladePropsType), INTENT(IN) :: SrcBladePropsTypeData - TYPE(AD_BladePropsType), INTENT(INOUT) :: DstBladePropsTypeData - 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 = 'AD_CopyBladePropsType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBladePropsTypeData%NumBlNds = SrcBladePropsTypeData%NumBlNds -IF (ALLOCATED(SrcBladePropsTypeData%BlSpn)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlSpn,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlSpn,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlSpn)) THEN - ALLOCATE(DstBladePropsTypeData%BlSpn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlSpn = SrcBladePropsTypeData%BlSpn -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCrvAC)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCrvAC,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCrvAC,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCrvAC)) THEN - ALLOCATE(DstBladePropsTypeData%BlCrvAC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCrvAC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlCrvAC = SrcBladePropsTypeData%BlCrvAC -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlSwpAC)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlSwpAC,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlSwpAC,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlSwpAC)) THEN - ALLOCATE(DstBladePropsTypeData%BlSwpAC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlSwpAC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlSwpAC = SrcBladePropsTypeData%BlSwpAC -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCrvAng)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCrvAng,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCrvAng,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCrvAng)) THEN - ALLOCATE(DstBladePropsTypeData%BlCrvAng(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCrvAng.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlCrvAng = SrcBladePropsTypeData%BlCrvAng -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlTwist)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlTwist,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlTwist,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlTwist)) THEN - ALLOCATE(DstBladePropsTypeData%BlTwist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlTwist = SrcBladePropsTypeData%BlTwist -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlChord)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlChord,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlChord,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlChord)) THEN - ALLOCATE(DstBladePropsTypeData%BlChord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlChord = SrcBladePropsTypeData%BlChord -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlAFID)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlAFID,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlAFID,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlAFID)) THEN - ALLOCATE(DstBladePropsTypeData%BlAFID(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlAFID = SrcBladePropsTypeData%BlAFID -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCb)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCb,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCb,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCb)) THEN - ALLOCATE(DstBladePropsTypeData%BlCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlCb = SrcBladePropsTypeData%BlCb -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCenBn)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCenBn,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCenBn,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCenBn)) THEN - ALLOCATE(DstBladePropsTypeData%BlCenBn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCenBn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlCenBn = SrcBladePropsTypeData%BlCenBn -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCenBt)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCenBt,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCenBt,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCenBt)) THEN - ALLOCATE(DstBladePropsTypeData%BlCenBt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCenBt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlCenBt = SrcBladePropsTypeData%BlCenBt -ENDIF - END SUBROUTINE AD_CopyBladePropsType - - SUBROUTINE AD_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg ) - TYPE(AD_BladePropsType), INTENT(INOUT) :: BladePropsTypeData - 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 = 'AD_DestroyBladePropsType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladePropsTypeData%BlSpn)) THEN - DEALLOCATE(BladePropsTypeData%BlSpn) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCrvAC)) THEN - DEALLOCATE(BladePropsTypeData%BlCrvAC) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlSwpAC)) THEN - DEALLOCATE(BladePropsTypeData%BlSwpAC) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCrvAng)) THEN - DEALLOCATE(BladePropsTypeData%BlCrvAng) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlTwist)) THEN - DEALLOCATE(BladePropsTypeData%BlTwist) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlChord)) THEN - DEALLOCATE(BladePropsTypeData%BlChord) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlAFID)) THEN - DEALLOCATE(BladePropsTypeData%BlAFID) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCb)) THEN - DEALLOCATE(BladePropsTypeData%BlCb) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCenBn)) THEN - DEALLOCATE(BladePropsTypeData%BlCenBn) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCenBt)) THEN - DEALLOCATE(BladePropsTypeData%BlCenBt) -ENDIF - END SUBROUTINE AD_DestroyBladePropsType - - SUBROUTINE AD_PackBladePropsType( 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(AD_BladePropsType), 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 = 'AD_PackBladePropsType' - ! 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 ! NumBlNds - Int_BufSz = Int_BufSz + 1 ! BlSpn allocated yes/no - IF ( ALLOCATED(InData%BlSpn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlSpn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlSpn) ! BlSpn - END IF - Int_BufSz = Int_BufSz + 1 ! BlCrvAC allocated yes/no - IF ( ALLOCATED(InData%BlCrvAC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCrvAC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCrvAC) ! BlCrvAC - END IF - Int_BufSz = Int_BufSz + 1 ! BlSwpAC allocated yes/no - IF ( ALLOCATED(InData%BlSwpAC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlSwpAC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlSwpAC) ! BlSwpAC - END IF - Int_BufSz = Int_BufSz + 1 ! BlCrvAng allocated yes/no - IF ( ALLOCATED(InData%BlCrvAng) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCrvAng upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCrvAng) ! BlCrvAng - END IF - Int_BufSz = Int_BufSz + 1 ! BlTwist allocated yes/no - IF ( ALLOCATED(InData%BlTwist) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlTwist upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlTwist) ! BlTwist - END IF - Int_BufSz = Int_BufSz + 1 ! BlChord allocated yes/no - IF ( ALLOCATED(InData%BlChord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlChord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlChord) ! BlChord - END IF - Int_BufSz = Int_BufSz + 1 ! BlAFID allocated yes/no - IF ( ALLOCATED(InData%BlAFID) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlAFID upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BlAFID) ! BlAFID - END IF - Int_BufSz = Int_BufSz + 1 ! BlCb allocated yes/no - IF ( ALLOCATED(InData%BlCb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCb) ! BlCb - END IF - Int_BufSz = Int_BufSz + 1 ! BlCenBn allocated yes/no - IF ( ALLOCATED(InData%BlCenBn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCenBn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCenBn) ! BlCenBn - END IF - Int_BufSz = Int_BufSz + 1 ! BlCenBt allocated yes/no - IF ( ALLOCATED(InData%BlCenBt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCenBt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCenBt) ! BlCenBt - 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 - - IntKiBuf(Int_Xferred) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlSpn) ) 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%BlSpn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlSpn,1), UBOUND(InData%BlSpn,1) - ReKiBuf(Re_Xferred) = InData%BlSpn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCrvAC) ) 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%BlCrvAC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCrvAC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlCrvAC,1), UBOUND(InData%BlCrvAC,1) - ReKiBuf(Re_Xferred) = InData%BlCrvAC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlSwpAC) ) 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%BlSwpAC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSwpAC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlSwpAC,1), UBOUND(InData%BlSwpAC,1) - ReKiBuf(Re_Xferred) = InData%BlSwpAC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCrvAng) ) 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%BlCrvAng,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCrvAng,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlCrvAng,1), UBOUND(InData%BlCrvAng,1) - ReKiBuf(Re_Xferred) = InData%BlCrvAng(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlTwist) ) 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%BlTwist,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTwist,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlTwist,1), UBOUND(InData%BlTwist,1) - ReKiBuf(Re_Xferred) = InData%BlTwist(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlChord) ) 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%BlChord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlChord,1), UBOUND(InData%BlChord,1) - ReKiBuf(Re_Xferred) = InData%BlChord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlAFID) ) 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%BlAFID,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlAFID,1), UBOUND(InData%BlAFID,1) - IntKiBuf(Int_Xferred) = InData%BlAFID(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCb) ) 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%BlCb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlCb,1), UBOUND(InData%BlCb,1) - ReKiBuf(Re_Xferred) = InData%BlCb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCenBn) ) 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%BlCenBn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlCenBn,1), UBOUND(InData%BlCenBn,1) - ReKiBuf(Re_Xferred) = InData%BlCenBn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCenBt) ) 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%BlCenBt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlCenBt,1), UBOUND(InData%BlCenBt,1) - ReKiBuf(Re_Xferred) = InData%BlCenBt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_PackBladePropsType - - SUBROUTINE AD_UnPackBladePropsType( 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(AD_BladePropsType), 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 = 'AD_UnPackBladePropsType' - ! 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%NumBlNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSpn 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%BlSpn)) DEALLOCATE(OutData%BlSpn) - ALLOCATE(OutData%BlSpn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlSpn,1), UBOUND(OutData%BlSpn,1) - OutData%BlSpn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCrvAC 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%BlCrvAC)) DEALLOCATE(OutData%BlCrvAC) - ALLOCATE(OutData%BlCrvAC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlCrvAC,1), UBOUND(OutData%BlCrvAC,1) - OutData%BlCrvAC(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSwpAC 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%BlSwpAC)) DEALLOCATE(OutData%BlSwpAC) - ALLOCATE(OutData%BlSwpAC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSwpAC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlSwpAC,1), UBOUND(OutData%BlSwpAC,1) - OutData%BlSwpAC(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCrvAng 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%BlCrvAng)) DEALLOCATE(OutData%BlCrvAng) - ALLOCATE(OutData%BlCrvAng(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAng.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlCrvAng,1), UBOUND(OutData%BlCrvAng,1) - OutData%BlCrvAng(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlTwist 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%BlTwist)) DEALLOCATE(OutData%BlTwist) - ALLOCATE(OutData%BlTwist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlTwist,1), UBOUND(OutData%BlTwist,1) - OutData%BlTwist(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord 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%BlChord)) DEALLOCATE(OutData%BlChord) - ALLOCATE(OutData%BlChord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlChord,1), UBOUND(OutData%BlChord,1) - OutData%BlChord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAFID 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%BlAFID)) DEALLOCATE(OutData%BlAFID) - ALLOCATE(OutData%BlAFID(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlAFID,1), UBOUND(OutData%BlAFID,1) - OutData%BlAFID(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCb 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%BlCb)) DEALLOCATE(OutData%BlCb) - ALLOCATE(OutData%BlCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlCb,1), UBOUND(OutData%BlCb,1) - OutData%BlCb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCenBn 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%BlCenBn)) DEALLOCATE(OutData%BlCenBn) - ALLOCATE(OutData%BlCenBn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlCenBn,1), UBOUND(OutData%BlCenBn,1) - OutData%BlCenBn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCenBt 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%BlCenBt)) DEALLOCATE(OutData%BlCenBt) - ALLOCATE(OutData%BlCenBt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlCenBt,1), UBOUND(OutData%BlCenBt,1) - OutData%BlCenBt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_UnPackBladePropsType - - SUBROUTINE AD_CopyBladeShape( SrcBladeShapeData, DstBladeShapeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_BladeShape), INTENT(IN) :: SrcBladeShapeData - TYPE(AD_BladeShape), INTENT(INOUT) :: DstBladeShapeData - 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 = 'AD_CopyBladeShape' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBladeShapeData%AirfoilCoords)) THEN - i1_l = LBOUND(SrcBladeShapeData%AirfoilCoords,1) - i1_u = UBOUND(SrcBladeShapeData%AirfoilCoords,1) - i2_l = LBOUND(SrcBladeShapeData%AirfoilCoords,2) - i2_u = UBOUND(SrcBladeShapeData%AirfoilCoords,2) - i3_l = LBOUND(SrcBladeShapeData%AirfoilCoords,3) - i3_u = UBOUND(SrcBladeShapeData%AirfoilCoords,3) - IF (.NOT. ALLOCATED(DstBladeShapeData%AirfoilCoords)) THEN - ALLOCATE(DstBladeShapeData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeShapeData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeShapeData%AirfoilCoords = SrcBladeShapeData%AirfoilCoords -ENDIF - END SUBROUTINE AD_CopyBladeShape - - SUBROUTINE AD_DestroyBladeShape( BladeShapeData, ErrStat, ErrMsg ) - TYPE(AD_BladeShape), INTENT(INOUT) :: BladeShapeData - 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 = 'AD_DestroyBladeShape' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladeShapeData%AirfoilCoords)) THEN - DEALLOCATE(BladeShapeData%AirfoilCoords) -ENDIF - END SUBROUTINE AD_DestroyBladeShape - - SUBROUTINE AD_PackBladeShape( 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(AD_BladeShape), 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 = 'AD_PackBladeShape' - ! 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 ! AirfoilCoords allocated yes/no - IF ( ALLOCATED(InData%AirfoilCoords) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AirfoilCoords upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AirfoilCoords) ! AirfoilCoords - 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%AirfoilCoords) ) 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%AirfoilCoords,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) - DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) - DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) - ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD_PackBladeShape - - SUBROUTINE AD_UnPackBladeShape( 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(AD_BladeShape), 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 = 'AD_UnPackBladeShape' - ! 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 ! AirfoilCoords 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%AirfoilCoords)) DEALLOCATE(OutData%AirfoilCoords) - ALLOCATE(OutData%AirfoilCoords(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%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) - DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) - DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) - OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD_UnPackBladeShape - - SUBROUTINE AD_CopyRotInitOutputType( SrcRotInitOutputTypeData, DstRotInitOutputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotInitOutputType), INTENT(IN) :: SrcRotInitOutputTypeData - TYPE(RotInitOutputType), INTENT(INOUT) :: DstRotInitOutputTypeData - 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 = 'AD_CopyRotInitOutputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRotInitOutputTypeData%AirDens = SrcRotInitOutputTypeData%AirDens -IF (ALLOCATED(SrcRotInitOutputTypeData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%WriteOutputHdr,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%WriteOutputHdr)) THEN - ALLOCATE(DstRotInitOutputTypeData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%WriteOutputHdr = SrcRotInitOutputTypeData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%WriteOutputUnt,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%WriteOutputUnt)) THEN - ALLOCATE(DstRotInitOutputTypeData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%WriteOutputUnt = SrcRotInitOutputTypeData%WriteOutputUnt -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%BladeShape)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%BladeShape,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%BladeShape,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%BladeShape)) THEN - ALLOCATE(DstRotInitOutputTypeData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInitOutputTypeData%BladeShape,1), UBOUND(SrcRotInitOutputTypeData%BladeShape,1) - CALL AD_Copybladeshape( SrcRotInitOutputTypeData%BladeShape(i1), DstRotInitOutputTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%LinNames_y)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%LinNames_y,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%LinNames_y)) THEN - ALLOCATE(DstRotInitOutputTypeData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%LinNames_y = SrcRotInitOutputTypeData%LinNames_y -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%LinNames_x)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%LinNames_x,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%LinNames_x)) THEN - ALLOCATE(DstRotInitOutputTypeData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%LinNames_x = SrcRotInitOutputTypeData%LinNames_x -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%LinNames_u)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%LinNames_u,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%LinNames_u)) THEN - ALLOCATE(DstRotInitOutputTypeData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%LinNames_u = SrcRotInitOutputTypeData%LinNames_u -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%RotFrame_y)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%RotFrame_y,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%RotFrame_y)) THEN - ALLOCATE(DstRotInitOutputTypeData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%RotFrame_y = SrcRotInitOutputTypeData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%RotFrame_x)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%RotFrame_x,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%RotFrame_x)) THEN - ALLOCATE(DstRotInitOutputTypeData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%RotFrame_x = SrcRotInitOutputTypeData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%RotFrame_u)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%RotFrame_u,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%RotFrame_u)) THEN - ALLOCATE(DstRotInitOutputTypeData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%RotFrame_u = SrcRotInitOutputTypeData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%IsLoad_u)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%IsLoad_u,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%IsLoad_u)) THEN - ALLOCATE(DstRotInitOutputTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%IsLoad_u = SrcRotInitOutputTypeData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%BladeProps)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%BladeProps,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%BladeProps,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%BladeProps)) THEN - ALLOCATE(DstRotInitOutputTypeData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInitOutputTypeData%BladeProps,1), UBOUND(SrcRotInitOutputTypeData%BladeProps,1) - CALL AD_Copybladepropstype( SrcRotInitOutputTypeData%BladeProps(i1), DstRotInitOutputTypeData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%DerivOrder_x,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%DerivOrder_x)) THEN - ALLOCATE(DstRotInitOutputTypeData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%DerivOrder_x = SrcRotInitOutputTypeData%DerivOrder_x -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%TwrElev)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%TwrElev,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%TwrElev,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%TwrElev)) THEN - ALLOCATE(DstRotInitOutputTypeData%TwrElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%TwrElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%TwrElev = SrcRotInitOutputTypeData%TwrElev -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%TwrDiam)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%TwrDiam,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%TwrDiam,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%TwrDiam)) THEN - ALLOCATE(DstRotInitOutputTypeData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%TwrDiam = SrcRotInitOutputTypeData%TwrDiam -ENDIF - END SUBROUTINE AD_CopyRotInitOutputType - - SUBROUTINE AD_DestroyRotInitOutputType( RotInitOutputTypeData, ErrStat, ErrMsg ) - TYPE(RotInitOutputType), INTENT(INOUT) :: RotInitOutputTypeData - 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 = 'AD_DestroyRotInitOutputType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(RotInitOutputTypeData%WriteOutputHdr)) THEN - DEALLOCATE(RotInitOutputTypeData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%WriteOutputUnt)) THEN - DEALLOCATE(RotInitOutputTypeData%WriteOutputUnt) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%BladeShape)) THEN -DO i1 = LBOUND(RotInitOutputTypeData%BladeShape,1), UBOUND(RotInitOutputTypeData%BladeShape,1) - CALL AD_DestroyBladeShape( RotInitOutputTypeData%BladeShape(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotInitOutputTypeData%BladeShape) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%LinNames_y)) THEN - DEALLOCATE(RotInitOutputTypeData%LinNames_y) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%LinNames_x)) THEN - DEALLOCATE(RotInitOutputTypeData%LinNames_x) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%LinNames_u)) THEN - DEALLOCATE(RotInitOutputTypeData%LinNames_u) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%RotFrame_y)) THEN - DEALLOCATE(RotInitOutputTypeData%RotFrame_y) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%RotFrame_x)) THEN - DEALLOCATE(RotInitOutputTypeData%RotFrame_x) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%RotFrame_u)) THEN - DEALLOCATE(RotInitOutputTypeData%RotFrame_u) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%IsLoad_u)) THEN - DEALLOCATE(RotInitOutputTypeData%IsLoad_u) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%BladeProps)) THEN -DO i1 = LBOUND(RotInitOutputTypeData%BladeProps,1), UBOUND(RotInitOutputTypeData%BladeProps,1) - CALL AD_DestroyBladePropsType( RotInitOutputTypeData%BladeProps(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotInitOutputTypeData%BladeProps) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%DerivOrder_x)) THEN - DEALLOCATE(RotInitOutputTypeData%DerivOrder_x) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%TwrElev)) THEN - DEALLOCATE(RotInitOutputTypeData%TwrElev) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%TwrDiam)) THEN - DEALLOCATE(RotInitOutputTypeData%TwrDiam) -ENDIF - END SUBROUTINE AD_DestroyRotInitOutputType - - SUBROUTINE AD_PackRotInitOutputType( 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(RotInitOutputType), 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 = 'AD_PackRotInitOutputType' - ! 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 ! AirDens - 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 ! BladeShape allocated yes/no - IF ( ALLOCATED(InData%BladeShape) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeShape upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeShape - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeShape - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeShape - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! BladeProps allocated yes/no - IF ( ALLOCATED(InData%BladeProps) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - Int_BufSz = Int_BufSz + 1 ! TwrElev allocated yes/no - IF ( ALLOCATED(InData%TwrElev) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrElev) ! TwrElev - END IF - Int_BufSz = Int_BufSz + 1 ! TwrDiam allocated yes/no - IF ( ALLOCATED(InData%TwrDiam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrDiam upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrDiam) ! TwrDiam - 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 - - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_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%BladeShape) ) 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%BladeShape,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeShape,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) 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%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) 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%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) 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%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) 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%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) 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%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) 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%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) 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%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeProps) ) 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%BladeProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeProps,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) 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%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrElev) ) 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%TwrElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrElev,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrElev,1), UBOUND(InData%TwrElev,1) - ReKiBuf(Re_Xferred) = InData%TwrElev(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrDiam) ) 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%TwrDiam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) - ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_PackRotInitOutputType - - SUBROUTINE AD_UnPackRotInitOutputType( 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(RotInitOutputType), 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 = 'AD_UnPackRotInitOutputType' - ! 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%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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 ! BladeShape 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%BladeShape)) DEALLOCATE(OutData%BladeShape) - ALLOCATE(OutData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeShape,1), UBOUND(OutData%BladeShape,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 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 - - 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 ! LinNames_y 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%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(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 ! LinNames_x 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%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(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 ! LinNames_u 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%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(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 ! RotFrame_y 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%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x 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%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u 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%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u 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%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeProps 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%BladeProps)) DEALLOCATE(OutData%BladeProps) - ALLOCATE(OutData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeProps,1), UBOUND(OutData%BladeProps,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 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 - - 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 ! DerivOrder_x 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%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrElev 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%TwrElev)) DEALLOCATE(OutData%TwrElev) - ALLOCATE(OutData%TwrElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrElev,1), UBOUND(OutData%TwrElev,1) - OutData%TwrElev(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam 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%TwrDiam)) DEALLOCATE(OutData%TwrDiam) - ALLOCATE(OutData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) - OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_UnPackRotInitOutputType - - SUBROUTINE AD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AD_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 = 'AD_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%rotors)) THEN - i1_l = LBOUND(SrcInitOutputData%rotors,1) - i1_u = UBOUND(SrcInitOutputData%rotors,1) - IF (.NOT. ALLOCATED(DstInitOutputData%rotors)) THEN - ALLOCATE(DstInitOutputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitOutputData%rotors,1), UBOUND(SrcInitOutputData%rotors,1) - CALL AD_Copyrotinitoutputtype( SrcInitOutputData%rotors(i1), DstInitOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyInitOutput - - SUBROUTINE AD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(AD_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 = 'AD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%rotors)) THEN -DO i1 = LBOUND(InitOutputData%rotors,1), UBOUND(InitOutputData%rotors,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyInitOutput - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - 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 - - IF ( .NOT. ALLOCATED(InData%rotors) ) 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%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - 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 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 - 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 - - 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 AD_PackInitOutput - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors 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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 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 - - 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 - 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) - END SUBROUTINE AD_UnPackInitOutput - - SUBROUTINE AD_CopyRotInputFile( SrcRotInputFileData, DstRotInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotInputFile), INTENT(IN) :: SrcRotInputFileData - TYPE(RotInputFile), INTENT(INOUT) :: DstRotInputFileData - 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 = 'AD_CopyRotInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcRotInputFileData%BladeProps)) THEN - i1_l = LBOUND(SrcRotInputFileData%BladeProps,1) - i1_u = UBOUND(SrcRotInputFileData%BladeProps,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%BladeProps)) THEN - ALLOCATE(DstRotInputFileData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInputFileData%BladeProps,1), UBOUND(SrcRotInputFileData%BladeProps,1) - CALL AD_Copybladepropstype( SrcRotInputFileData%BladeProps(i1), DstRotInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstRotInputFileData%NumTwrNds = SrcRotInputFileData%NumTwrNds -IF (ALLOCATED(SrcRotInputFileData%TwrElev)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrElev,1) - i1_u = UBOUND(SrcRotInputFileData%TwrElev,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrElev)) THEN - ALLOCATE(DstRotInputFileData%TwrElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputFileData%TwrElev = SrcRotInputFileData%TwrElev -ENDIF -IF (ALLOCATED(SrcRotInputFileData%TwrDiam)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrDiam,1) - i1_u = UBOUND(SrcRotInputFileData%TwrDiam,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrDiam)) THEN - ALLOCATE(DstRotInputFileData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputFileData%TwrDiam = SrcRotInputFileData%TwrDiam -ENDIF -IF (ALLOCATED(SrcRotInputFileData%TwrCd)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrCd,1) - i1_u = UBOUND(SrcRotInputFileData%TwrCd,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrCd)) THEN - ALLOCATE(DstRotInputFileData%TwrCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputFileData%TwrCd = SrcRotInputFileData%TwrCd -ENDIF -IF (ALLOCATED(SrcRotInputFileData%TwrTI)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrTI,1) - i1_u = UBOUND(SrcRotInputFileData%TwrTI,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrTI)) THEN - ALLOCATE(DstRotInputFileData%TwrTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputFileData%TwrTI = SrcRotInputFileData%TwrTI -ENDIF -IF (ALLOCATED(SrcRotInputFileData%TwrCb)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrCb,1) - i1_u = UBOUND(SrcRotInputFileData%TwrCb,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrCb)) THEN - ALLOCATE(DstRotInputFileData%TwrCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputFileData%TwrCb = SrcRotInputFileData%TwrCb -ENDIF - DstRotInputFileData%VolHub = SrcRotInputFileData%VolHub - DstRotInputFileData%HubCenBx = SrcRotInputFileData%HubCenBx - DstRotInputFileData%VolNac = SrcRotInputFileData%VolNac - DstRotInputFileData%NacCenB = SrcRotInputFileData%NacCenB - DstRotInputFileData%TFinAero = SrcRotInputFileData%TFinAero - DstRotInputFileData%TFinFile = SrcRotInputFileData%TFinFile - CALL AD_Copytfininputfiletype( SrcRotInputFileData%TFin, DstRotInputFileData%TFin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotInputFile - - SUBROUTINE AD_DestroyRotInputFile( RotInputFileData, ErrStat, ErrMsg ) - TYPE(RotInputFile), INTENT(INOUT) :: RotInputFileData - 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 = 'AD_DestroyRotInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(RotInputFileData%BladeProps)) THEN -DO i1 = LBOUND(RotInputFileData%BladeProps,1), UBOUND(RotInputFileData%BladeProps,1) - CALL AD_DestroyBladePropsType( RotInputFileData%BladeProps(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotInputFileData%BladeProps) -ENDIF -IF (ALLOCATED(RotInputFileData%TwrElev)) THEN - DEALLOCATE(RotInputFileData%TwrElev) -ENDIF -IF (ALLOCATED(RotInputFileData%TwrDiam)) THEN - DEALLOCATE(RotInputFileData%TwrDiam) -ENDIF -IF (ALLOCATED(RotInputFileData%TwrCd)) THEN - DEALLOCATE(RotInputFileData%TwrCd) -ENDIF -IF (ALLOCATED(RotInputFileData%TwrTI)) THEN - DEALLOCATE(RotInputFileData%TwrTI) -ENDIF -IF (ALLOCATED(RotInputFileData%TwrCb)) THEN - DEALLOCATE(RotInputFileData%TwrCb) -ENDIF - CALL AD_DestroyTFinInputFileType( RotInputFileData%TFin, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotInputFile - - SUBROUTINE AD_PackRotInputFile( 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(RotInputFile), 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 = 'AD_PackRotInputFile' - ! 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 ! BladeProps allocated yes/no - IF ( ALLOCATED(InData%BladeProps) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeProps upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NumTwrNds - Int_BufSz = Int_BufSz + 1 ! TwrElev allocated yes/no - IF ( ALLOCATED(InData%TwrElev) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrElev) ! TwrElev - END IF - Int_BufSz = Int_BufSz + 1 ! TwrDiam allocated yes/no - IF ( ALLOCATED(InData%TwrDiam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrDiam upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrDiam) ! TwrDiam - END IF - Int_BufSz = Int_BufSz + 1 ! TwrCd allocated yes/no - IF ( ALLOCATED(InData%TwrCd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCd) ! TwrCd - END IF - Int_BufSz = Int_BufSz + 1 ! TwrTI allocated yes/no - IF ( ALLOCATED(InData%TwrTI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrTI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrTI) ! TwrTI - END IF - Int_BufSz = Int_BufSz + 1 ! TwrCb allocated yes/no - IF ( ALLOCATED(InData%TwrCb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCb) ! TwrCb - END IF - Re_BufSz = Re_BufSz + 1 ! VolHub - Re_BufSz = Re_BufSz + 1 ! HubCenBx - Re_BufSz = Re_BufSz + 1 ! VolNac - Re_BufSz = Re_BufSz + SIZE(InData%NacCenB) ! NacCenB - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFin - 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 - - IF ( .NOT. ALLOCATED(InData%BladeProps) ) 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%BladeProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeProps,1) - 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 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%NumTwrNds - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TwrElev) ) 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%TwrElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrElev,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrElev,1), UBOUND(InData%TwrElev,1) - ReKiBuf(Re_Xferred) = InData%TwrElev(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrDiam) ) 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%TwrDiam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) - ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrCd) ) 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%TwrCd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrCd,1), UBOUND(InData%TwrCd,1) - ReKiBuf(Re_Xferred) = InData%TwrCd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrTI) ) 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%TwrTI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrTI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrTI,1), UBOUND(InData%TwrTI,1) - ReKiBuf(Re_Xferred) = InData%TwrTI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrCb) ) 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%TwrCb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrCb,1), UBOUND(InData%TwrCb,1) - ReKiBuf(Re_Xferred) = InData%TwrCb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%VolHub - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubCenBx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VolNac - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%NacCenB,1), UBOUND(InData%NacCenB,1) - ReKiBuf(Re_Xferred) = InData%NacCenB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%TFinAero, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%TFinFile) - 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 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 AD_PackRotInputFile - - SUBROUTINE AD_UnPackRotInputFile( 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(RotInputFile), 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 = 'AD_UnPackRotInputFile' - ! 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 ! BladeProps 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%BladeProps)) DEALLOCATE(OutData%BladeProps) - ALLOCATE(OutData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeProps,1), UBOUND(OutData%BladeProps,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 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 - - 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%NumTwrNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrElev 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%TwrElev)) DEALLOCATE(OutData%TwrElev) - ALLOCATE(OutData%TwrElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrElev,1), UBOUND(OutData%TwrElev,1) - OutData%TwrElev(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam 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%TwrDiam)) DEALLOCATE(OutData%TwrDiam) - ALLOCATE(OutData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) - OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCd 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%TwrCd)) DEALLOCATE(OutData%TwrCd) - ALLOCATE(OutData%TwrCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrCd,1), UBOUND(OutData%TwrCd,1) - OutData%TwrCd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrTI 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%TwrTI)) DEALLOCATE(OutData%TwrTI) - ALLOCATE(OutData%TwrTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrTI,1), UBOUND(OutData%TwrTI,1) - OutData%TwrTI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCb 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%TwrCb)) DEALLOCATE(OutData%TwrCb) - ALLOCATE(OutData%TwrCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrCb,1), UBOUND(OutData%TwrCb,1) - OutData%TwrCb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%VolHub = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubCenBx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VolNac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%NacCenB,1) - i1_u = UBOUND(OutData%NacCenB,1) - DO i1 = LBOUND(OutData%NacCenB,1), UBOUND(OutData%NacCenB,1) - OutData%NacCenB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TFinAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TFinAero) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%TFinFile) - OutData%TFinFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 AD_UnpackTFinInputFileType( Re_Buf, Db_Buf, Int_Buf, OutData%TFin, ErrStat2, ErrMsg2 ) ! TFin - 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 AD_UnPackRotInputFile - - SUBROUTINE AD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(AD_InputFile), INTENT(INOUT) :: DstInputFileData - 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 = 'AD_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%DTAero = SrcInputFileData%DTAero - DstInputFileData%WakeMod = SrcInputFileData%WakeMod - DstInputFileData%AFAeroMod = SrcInputFileData%AFAeroMod - DstInputFileData%TwrPotent = SrcInputFileData%TwrPotent - DstInputFileData%TwrShadow = SrcInputFileData%TwrShadow - DstInputFileData%TwrAero = SrcInputFileData%TwrAero - DstInputFileData%FrozenWake = SrcInputFileData%FrozenWake - DstInputFileData%CavitCheck = SrcInputFileData%CavitCheck - DstInputFileData%Buoyancy = SrcInputFileData%Buoyancy - DstInputFileData%CompAA = SrcInputFileData%CompAA - DstInputFileData%AA_InputFile = SrcInputFileData%AA_InputFile -IF (ALLOCATED(SrcInputFileData%ADBlFile)) THEN - i1_l = LBOUND(SrcInputFileData%ADBlFile,1) - i1_u = UBOUND(SrcInputFileData%ADBlFile,1) - IF (.NOT. ALLOCATED(DstInputFileData%ADBlFile)) THEN - ALLOCATE(DstInputFileData%ADBlFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ADBlFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ADBlFile = SrcInputFileData%ADBlFile -ENDIF - DstInputFileData%AirDens = SrcInputFileData%AirDens - DstInputFileData%KinVisc = SrcInputFileData%KinVisc - DstInputFileData%Patm = SrcInputFileData%Patm - DstInputFileData%Pvap = SrcInputFileData%Pvap - DstInputFileData%SpdSound = SrcInputFileData%SpdSound - DstInputFileData%SkewMod = SrcInputFileData%SkewMod - DstInputFileData%SkewModFactor = SrcInputFileData%SkewModFactor - DstInputFileData%TipLoss = SrcInputFileData%TipLoss - DstInputFileData%HubLoss = SrcInputFileData%HubLoss - DstInputFileData%TanInd = SrcInputFileData%TanInd - DstInputFileData%AIDrag = SrcInputFileData%AIDrag - DstInputFileData%TIDrag = SrcInputFileData%TIDrag - DstInputFileData%IndToler = SrcInputFileData%IndToler - DstInputFileData%MaxIter = SrcInputFileData%MaxIter - DstInputFileData%UAMod = SrcInputFileData%UAMod - DstInputFileData%FLookup = SrcInputFileData%FLookup - DstInputFileData%InCol_Alfa = SrcInputFileData%InCol_Alfa - DstInputFileData%InCol_Cl = SrcInputFileData%InCol_Cl - DstInputFileData%InCol_Cd = SrcInputFileData%InCol_Cd - DstInputFileData%InCol_Cm = SrcInputFileData%InCol_Cm - DstInputFileData%InCol_Cpmin = SrcInputFileData%InCol_Cpmin - DstInputFileData%AFTabMod = SrcInputFileData%AFTabMod - DstInputFileData%NumAFfiles = SrcInputFileData%NumAFfiles - DstInputFileData%FVWFileName = SrcInputFileData%FVWFileName -IF (ALLOCATED(SrcInputFileData%AFNames)) THEN - i1_l = LBOUND(SrcInputFileData%AFNames,1) - i1_u = UBOUND(SrcInputFileData%AFNames,1) - IF (.NOT. ALLOCATED(DstInputFileData%AFNames)) THEN - ALLOCATE(DstInputFileData%AFNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AFNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AFNames = SrcInputFileData%AFNames -ENDIF - DstInputFileData%UseBlCm = SrcInputFileData%UseBlCm - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%NBlOuts = SrcInputFileData%NBlOuts - DstInputFileData%BlOutNd = SrcInputFileData%BlOutNd - DstInputFileData%NTwOuts = SrcInputFileData%NTwOuts - DstInputFileData%TwOutNd = SrcInputFileData%TwOutNd - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%tau1_const = SrcInputFileData%tau1_const - DstInputFileData%DBEMT_Mod = SrcInputFileData%DBEMT_Mod - DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts -IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN - i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) - i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN - ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList -ENDIF - DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str - DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut - DstInputFileData%UAStartRad = SrcInputFileData%UAStartRad - DstInputFileData%UAEndRad = SrcInputFileData%UAEndRad -IF (ALLOCATED(SrcInputFileData%rotors)) THEN - i1_l = LBOUND(SrcInputFileData%rotors,1) - i1_u = UBOUND(SrcInputFileData%rotors,1) - IF (.NOT. ALLOCATED(DstInputFileData%rotors)) THEN - ALLOCATE(DstInputFileData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputFileData%rotors,1), UBOUND(SrcInputFileData%rotors,1) - CALL AD_Copyrotinputfile( SrcInputFileData%rotors(i1), DstInputFileData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AD_CopyInputFile - - SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(AD_InputFile), INTENT(INOUT) :: InputFileData - 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 = 'AD_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%ADBlFile)) THEN - DEALLOCATE(InputFileData%ADBlFile) -ENDIF -IF (ALLOCATED(InputFileData%AFNames)) THEN - DEALLOCATE(InputFileData%AFNames) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF -IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN - DEALLOCATE(InputFileData%BldNd_OutList) -ENDIF -IF (ALLOCATED(InputFileData%rotors)) THEN -DO i1 = LBOUND(InputFileData%rotors,1), UBOUND(InputFileData%rotors,1) - CALL AD_DestroyRotInputFile( InputFileData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputFileData%rotors) -ENDIF - END SUBROUTINE AD_DestroyInputFile - - SUBROUTINE AD_PackInputFile( 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(AD_InputFile), 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 = 'AD_PackInputFile' - ! 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 ! Echo - Db_BufSz = Db_BufSz + 1 ! DTAero - Int_BufSz = Int_BufSz + 1 ! WakeMod - Int_BufSz = Int_BufSz + 1 ! AFAeroMod - Int_BufSz = Int_BufSz + 1 ! TwrPotent - Int_BufSz = Int_BufSz + 1 ! TwrShadow - Int_BufSz = Int_BufSz + 1 ! TwrAero - Int_BufSz = Int_BufSz + 1 ! FrozenWake - Int_BufSz = Int_BufSz + 1 ! CavitCheck - Int_BufSz = Int_BufSz + 1 ! Buoyancy - Int_BufSz = Int_BufSz + 1 ! CompAA - Int_BufSz = Int_BufSz + 1*LEN(InData%AA_InputFile) ! AA_InputFile - Int_BufSz = Int_BufSz + 1 ! ADBlFile allocated yes/no - IF ( ALLOCATED(InData%ADBlFile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ADBlFile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ADBlFile)*LEN(InData%ADBlFile) ! ADBlFile - END IF - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! Patm - Re_BufSz = Re_BufSz + 1 ! Pvap - Re_BufSz = Re_BufSz + 1 ! SpdSound - Int_BufSz = Int_BufSz + 1 ! SkewMod - Re_BufSz = Re_BufSz + 1 ! SkewModFactor - Int_BufSz = Int_BufSz + 1 ! TipLoss - Int_BufSz = Int_BufSz + 1 ! HubLoss - Int_BufSz = Int_BufSz + 1 ! TanInd - Int_BufSz = Int_BufSz + 1 ! AIDrag - Int_BufSz = Int_BufSz + 1 ! TIDrag - Re_BufSz = Re_BufSz + 1 ! IndToler - Re_BufSz = Re_BufSz + 1 ! MaxIter - Int_BufSz = Int_BufSz + 1 ! UAMod - Int_BufSz = Int_BufSz + 1 ! FLookup - Re_BufSz = Re_BufSz + 1 ! InCol_Alfa - Re_BufSz = Re_BufSz + 1 ! InCol_Cl - Re_BufSz = Re_BufSz + 1 ! InCol_Cd - Re_BufSz = Re_BufSz + 1 ! InCol_Cm - Re_BufSz = Re_BufSz + 1 ! InCol_Cpmin - Int_BufSz = Int_BufSz + 1 ! AFTabMod - Int_BufSz = Int_BufSz + 1 ! NumAFfiles - Int_BufSz = Int_BufSz + 1*LEN(InData%FVWFileName) ! FVWFileName - Int_BufSz = Int_BufSz + 1 ! AFNames allocated yes/no - IF ( ALLOCATED(InData%AFNames) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AFNames upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AFNames)*LEN(InData%AFNames) ! AFNames - END IF - Int_BufSz = Int_BufSz + 1 ! UseBlCm - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! NBlOuts - Int_BufSz = Int_BufSz + SIZE(InData%BlOutNd) ! BlOutNd - Int_BufSz = Int_BufSz + 1 ! NTwOuts - Int_BufSz = Int_BufSz + SIZE(InData%TwOutNd) ! TwOutNd - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Re_BufSz = Re_BufSz + 1 ! tau1_const - Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str - Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut - Re_BufSz = Re_BufSz + 1 ! UAStartRad - Re_BufSz = Re_BufSz + 1 ! UAEndRad - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTAero - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WakeMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AFAeroMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrPotent - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrShadow - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrAero, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FrozenWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitCheck, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Buoyancy, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CompAA, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%AA_InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AA_InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%ADBlFile) ) 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%ADBlFile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADBlFile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ADBlFile,1), UBOUND(InData%ADBlFile,1) - DO I = 1, LEN(InData%ADBlFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%ADBlFile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SkewMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SkewModFactor - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TipLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HubLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TanInd, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%AIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%IndToler - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MaxIter - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FLookup, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InCol_Alfa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InCol_Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InCol_Cd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InCol_Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InCol_Cpmin - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumAFfiles - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%FVWFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FVWFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%AFNames) ) 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%AFNames,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFNames,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AFNames,1), UBOUND(InData%AFNames,1) - DO I = 1, LEN(InData%AFNames) - IntKiBuf(Int_Xferred) = ICHAR(InData%AFNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseBlCm, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBlOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%BlOutNd,1), UBOUND(InData%BlOutNd,1) - IntKiBuf(Int_Xferred) = InData%BlOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NTwOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TwOutNd,1), UBOUND(InData%TwOutNd,1) - IntKiBuf(Int_Xferred) = InData%TwOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) 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%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - 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 - END IF - ReKiBuf(Re_Xferred) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_OutList) ) 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%BldNd_OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) - DO I = 1, LEN(InData%BldNd_OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%BldNd_BlOutNd_Str) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UAStartRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UAEndRad - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%rotors) ) 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%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - 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 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 - END SUBROUTINE AD_PackInputFile - - SUBROUTINE AD_UnPackInputFile( 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(AD_InputFile), 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 = 'AD_UnPackInputFile' - ! 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%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%DTAero = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WakeMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AFAeroMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrAero) - Int_Xferred = Int_Xferred + 1 - OutData%FrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FrozenWake) - Int_Xferred = Int_Xferred + 1 - OutData%CavitCheck = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitCheck) - Int_Xferred = Int_Xferred + 1 - OutData%Buoyancy = TRANSFER(IntKiBuf(Int_Xferred), OutData%Buoyancy) - Int_Xferred = Int_Xferred + 1 - OutData%CompAA = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompAA) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%AA_InputFile) - OutData%AA_InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ADBlFile 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%ADBlFile)) DEALLOCATE(OutData%ADBlFile) - ALLOCATE(OutData%ADBlFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADBlFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ADBlFile,1), UBOUND(OutData%ADBlFile,1) - DO I = 1, LEN(OutData%ADBlFile) - OutData%ADBlFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SkewMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SkewModFactor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%TipLoss) - Int_Xferred = Int_Xferred + 1 - OutData%HubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%HubLoss) - Int_Xferred = Int_Xferred + 1 - OutData%TanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%TanInd) - Int_Xferred = Int_Xferred + 1 - OutData%AIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%AIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%TIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%TIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%IndToler = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UAMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FLookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%FLookup) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Alfa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cpmin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AFTabMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumAFfiles = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%FVWFileName) - OutData%FVWFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFNames 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%AFNames)) DEALLOCATE(OutData%AFNames) - ALLOCATE(OutData%AFNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AFNames,1), UBOUND(OutData%AFNames,1) - DO I = 1, LEN(OutData%AFNames) - OutData%AFNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%UseBlCm = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseBlCm) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%NBlOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%BlOutNd,1) - i1_u = UBOUND(OutData%BlOutNd,1) - DO i1 = LBOUND(OutData%BlOutNd,1), UBOUND(OutData%BlOutNd,1) - OutData%BlOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NTwOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TwOutNd,1) - i1_u = UBOUND(OutData%TwOutNd,1) - DO i1 = LBOUND(OutData%TwOutNd,1), UBOUND(OutData%TwOutNd,1) - OutData%TwOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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%tau1_const = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_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%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) - ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) - DO I = 1, LEN(OutData%BldNd_OutList) - OutData%BldNd_OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) - OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UAStartRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UAEndRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors 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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 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 - - 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 - END SUBROUTINE AD_UnPackInputFile - - SUBROUTINE AD_CopyRotContinuousStateType( SrcRotContinuousStateTypeData, DstRotContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotContinuousStateType), INTENT(IN) :: SrcRotContinuousStateTypeData - TYPE(RotContinuousStateType), INTENT(INOUT) :: DstRotContinuousStateTypeData - 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 = 'AD_CopyRotContinuousStateType' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL BEMT_CopyContState( SrcRotContinuousStateTypeData%BEMT, DstRotContinuousStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyContState( SrcRotContinuousStateTypeData%AA, DstRotContinuousStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotContinuousStateType - - SUBROUTINE AD_DestroyRotContinuousStateType( RotContinuousStateTypeData, ErrStat, ErrMsg ) - TYPE(RotContinuousStateType), INTENT(INOUT) :: RotContinuousStateTypeData - 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 = 'AD_DestroyRotContinuousStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL BEMT_DestroyContState( RotContinuousStateTypeData%BEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyContState( RotContinuousStateTypeData%AA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotContinuousStateType - - SUBROUTINE AD_PackRotContinuousStateType( 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(RotContinuousStateType), 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 = 'AD_PackRotContinuousStateType' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - 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 - - CALL BEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - 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 - CALL AA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - 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 AD_PackRotContinuousStateType - - SUBROUTINE AD_UnPackRotContinuousStateType( 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(RotContinuousStateType), 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 = 'AD_UnPackRotContinuousStateType' - ! 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 - 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 BEMT_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - 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) - 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 AA_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - 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 AD_UnPackRotContinuousStateType - - SUBROUTINE AD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(AD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%rotors)) THEN - i1_l = LBOUND(SrcContStateData%rotors,1) - i1_u = UBOUND(SrcContStateData%rotors,1) - IF (.NOT. ALLOCATED(DstContStateData%rotors)) THEN - ALLOCATE(DstContStateData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%rotors,1), UBOUND(SrcContStateData%rotors,1) - CALL AD_Copyrotcontinuousstatetype( SrcContStateData%rotors(i1), DstContStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL FVW_CopyContState( SrcContStateData%FVW, DstContStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyContState - - SUBROUTINE AD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(AD_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 = 'AD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%rotors)) THEN -DO i1 = LBOUND(ContStateData%rotors,1), UBOUND(ContStateData%rotors,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyContState - - SUBROUTINE AD_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(AD_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 = 'AD_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 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - 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 - - IF ( .NOT. ALLOCATED(InData%rotors) ) 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%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - 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 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 - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - 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 AD_PackContState - - SUBROUTINE AD_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(AD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors 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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 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 - - 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 - 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 FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - 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 AD_UnPackContState - - SUBROUTINE AD_CopyRotDiscreteStateType( SrcRotDiscreteStateTypeData, DstRotDiscreteStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotDiscreteStateType), INTENT(IN) :: SrcRotDiscreteStateTypeData - TYPE(RotDiscreteStateType), INTENT(INOUT) :: DstRotDiscreteStateTypeData - 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 = 'AD_CopyRotDiscreteStateType' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL BEMT_CopyDiscState( SrcRotDiscreteStateTypeData%BEMT, DstRotDiscreteStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyDiscState( SrcRotDiscreteStateTypeData%AA, DstRotDiscreteStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotDiscreteStateType - - SUBROUTINE AD_DestroyRotDiscreteStateType( RotDiscreteStateTypeData, ErrStat, ErrMsg ) - TYPE(RotDiscreteStateType), INTENT(INOUT) :: RotDiscreteStateTypeData - 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 = 'AD_DestroyRotDiscreteStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL BEMT_DestroyDiscState( RotDiscreteStateTypeData%BEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyDiscState( RotDiscreteStateTypeData%AA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotDiscreteStateType - - SUBROUTINE AD_PackRotDiscreteStateType( 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(RotDiscreteStateType), 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 = 'AD_PackRotDiscreteStateType' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - 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 - - CALL BEMT_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - 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 - CALL AA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - 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 AD_PackRotDiscreteStateType - - SUBROUTINE AD_UnPackRotDiscreteStateType( 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(RotDiscreteStateType), 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 = 'AD_UnPackRotDiscreteStateType' - ! 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 - 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 BEMT_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - 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) - 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 AA_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - 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 AD_UnPackRotDiscreteStateType - - SUBROUTINE AD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(AD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%rotors)) THEN - i1_l = LBOUND(SrcDiscStateData%rotors,1) - i1_u = UBOUND(SrcDiscStateData%rotors,1) - IF (.NOT. ALLOCATED(DstDiscStateData%rotors)) THEN - ALLOCATE(DstDiscStateData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%rotors,1), UBOUND(SrcDiscStateData%rotors,1) - CALL AD_Copyrotdiscretestatetype( SrcDiscStateData%rotors(i1), DstDiscStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL FVW_CopyDiscState( SrcDiscStateData%FVW, DstDiscStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyDiscState - - SUBROUTINE AD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(AD_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 = 'AD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%rotors)) THEN -DO i1 = LBOUND(DiscStateData%rotors,1), UBOUND(DiscStateData%rotors,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyDiscState - - SUBROUTINE AD_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(AD_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 = 'AD_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 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - 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 - - IF ( .NOT. ALLOCATED(InData%rotors) ) 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%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - 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 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 - CALL FVW_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - 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 AD_PackDiscState - - SUBROUTINE AD_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(AD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors 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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 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 - - 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 - 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 FVW_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - 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 AD_UnPackDiscState - - SUBROUTINE AD_CopyRotConstraintStateType( SrcRotConstraintStateTypeData, DstRotConstraintStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotConstraintStateType), INTENT(IN) :: SrcRotConstraintStateTypeData - TYPE(RotConstraintStateType), INTENT(INOUT) :: DstRotConstraintStateTypeData - 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 = 'AD_CopyRotConstraintStateType' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL BEMT_CopyConstrState( SrcRotConstraintStateTypeData%BEMT, DstRotConstraintStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyConstrState( SrcRotConstraintStateTypeData%AA, DstRotConstraintStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotConstraintStateType - - SUBROUTINE AD_DestroyRotConstraintStateType( RotConstraintStateTypeData, ErrStat, ErrMsg ) - TYPE(RotConstraintStateType), INTENT(INOUT) :: RotConstraintStateTypeData - 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 = 'AD_DestroyRotConstraintStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL BEMT_DestroyConstrState( RotConstraintStateTypeData%BEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyConstrState( RotConstraintStateTypeData%AA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotConstraintStateType - - SUBROUTINE AD_PackRotConstraintStateType( 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(RotConstraintStateType), 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 = 'AD_PackRotConstraintStateType' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - 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 - - CALL BEMT_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - 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 - CALL AA_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - 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 AD_PackRotConstraintStateType - - SUBROUTINE AD_UnPackRotConstraintStateType( 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(RotConstraintStateType), 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 = 'AD_UnPackRotConstraintStateType' - ! 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 - 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 BEMT_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - 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) - 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 AA_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - 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 AD_UnPackRotConstraintStateType - - SUBROUTINE AD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(AD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcConstrStateData%rotors)) THEN - i1_l = LBOUND(SrcConstrStateData%rotors,1) - i1_u = UBOUND(SrcConstrStateData%rotors,1) - IF (.NOT. ALLOCATED(DstConstrStateData%rotors)) THEN - ALLOCATE(DstConstrStateData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%rotors,1), UBOUND(SrcConstrStateData%rotors,1) - CALL AD_Copyrotconstraintstatetype( SrcConstrStateData%rotors(i1), DstConstrStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL FVW_CopyConstrState( SrcConstrStateData%FVW, DstConstrStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyConstrState - - SUBROUTINE AD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(AD_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 = 'AD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ConstrStateData%rotors)) THEN -DO i1 = LBOUND(ConstrStateData%rotors,1), UBOUND(ConstrStateData%rotors,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyConstrState - - SUBROUTINE AD_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(AD_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 = 'AD_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 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - 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 - - IF ( .NOT. ALLOCATED(InData%rotors) ) 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%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - 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 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 - CALL FVW_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - 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 AD_PackConstrState - - SUBROUTINE AD_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(AD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors 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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 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 - - 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 - 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 FVW_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - 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 AD_UnPackConstrState - - SUBROUTINE AD_CopyRotOtherStateType( SrcRotOtherStateTypeData, DstRotOtherStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotOtherStateType), INTENT(IN) :: SrcRotOtherStateTypeData - TYPE(RotOtherStateType), INTENT(INOUT) :: DstRotOtherStateTypeData - 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 = 'AD_CopyRotOtherStateType' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL BEMT_CopyOtherState( SrcRotOtherStateTypeData%BEMT, DstRotOtherStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyOtherState( SrcRotOtherStateTypeData%AA, DstRotOtherStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotOtherStateType - - SUBROUTINE AD_DestroyRotOtherStateType( RotOtherStateTypeData, ErrStat, ErrMsg ) - TYPE(RotOtherStateType), INTENT(INOUT) :: RotOtherStateTypeData - 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 = 'AD_DestroyRotOtherStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL BEMT_DestroyOtherState( RotOtherStateTypeData%BEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyOtherState( RotOtherStateTypeData%AA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotOtherStateType - - SUBROUTINE AD_PackRotOtherStateType( 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(RotOtherStateType), 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 = 'AD_PackRotOtherStateType' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - 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 - - CALL BEMT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - 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 - CALL AA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - 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 AD_PackRotOtherStateType - - SUBROUTINE AD_UnPackRotOtherStateType( 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(RotOtherStateType), 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 = 'AD_UnPackRotOtherStateType' - ! 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 - 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 BEMT_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - 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) - 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 AA_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - 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 AD_UnPackRotOtherStateType - - SUBROUTINE AD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(AD_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) :: 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 = 'AD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%rotors)) THEN - i1_l = LBOUND(SrcOtherStateData%rotors,1) - i1_u = UBOUND(SrcOtherStateData%rotors,1) - IF (.NOT. ALLOCATED(DstOtherStateData%rotors)) THEN - ALLOCATE(DstOtherStateData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%rotors,1), UBOUND(SrcOtherStateData%rotors,1) - CALL AD_Copyrototherstatetype( SrcOtherStateData%rotors(i1), DstOtherStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL FVW_CopyOtherState( SrcOtherStateData%FVW, DstOtherStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOtherStateData%WakeLocationPoints)) THEN - i1_l = LBOUND(SrcOtherStateData%WakeLocationPoints,1) - i1_u = UBOUND(SrcOtherStateData%WakeLocationPoints,1) - i2_l = LBOUND(SrcOtherStateData%WakeLocationPoints,2) - i2_u = UBOUND(SrcOtherStateData%WakeLocationPoints,2) - IF (.NOT. ALLOCATED(DstOtherStateData%WakeLocationPoints)) THEN - ALLOCATE(DstOtherStateData%WakeLocationPoints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%WakeLocationPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%WakeLocationPoints = SrcOtherStateData%WakeLocationPoints -ENDIF - END SUBROUTINE AD_CopyOtherState - - SUBROUTINE AD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(AD_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 = 'AD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%rotors)) THEN -DO i1 = LBOUND(OtherStateData%rotors,1), UBOUND(OtherStateData%rotors,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OtherStateData%WakeLocationPoints)) THEN - DEALLOCATE(OtherStateData%WakeLocationPoints) -ENDIF - END SUBROUTINE AD_DestroyOtherState - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WakeLocationPoints allocated yes/no - IF ( ALLOCATED(InData%WakeLocationPoints) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WakeLocationPoints upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WakeLocationPoints) ! WakeLocationPoints - 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%rotors) ) 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%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - 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 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 - CALL FVW_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - 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 - IF ( .NOT. ALLOCATED(InData%WakeLocationPoints) ) 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%WakeLocationPoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakeLocationPoints,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WakeLocationPoints,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakeLocationPoints,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WakeLocationPoints,2), UBOUND(InData%WakeLocationPoints,2) - DO i1 = LBOUND(InData%WakeLocationPoints,1), UBOUND(InData%WakeLocationPoints,1) - ReKiBuf(Re_Xferred) = InData%WakeLocationPoints(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_PackOtherState - - SUBROUTINE AD_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(AD_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) :: 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 = 'AD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors 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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 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 - - 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 - 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 FVW_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WakeLocationPoints 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%WakeLocationPoints)) DEALLOCATE(OutData%WakeLocationPoints) - ALLOCATE(OutData%WakeLocationPoints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WakeLocationPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WakeLocationPoints,2), UBOUND(OutData%WakeLocationPoints,2) - DO i1 = LBOUND(OutData%WakeLocationPoints,1), UBOUND(OutData%WakeLocationPoints,1) - OutData%WakeLocationPoints(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_UnPackOtherState - - SUBROUTINE AD_CopyRotMiscVarType( SrcRotMiscVarTypeData, DstRotMiscVarTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotMiscVarType), INTENT(INOUT) :: SrcRotMiscVarTypeData - TYPE(RotMiscVarType), INTENT(INOUT) :: DstRotMiscVarTypeData - 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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyRotMiscVarType' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL BEMT_CopyMisc( SrcRotMiscVarTypeData%BEMT, DstRotMiscVarTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL BEMT_CopyOutput( SrcRotMiscVarTypeData%BEMT_y, DstRotMiscVarTypeData%BEMT_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DO i1 = LBOUND(SrcRotMiscVarTypeData%BEMT_u,1), UBOUND(SrcRotMiscVarTypeData%BEMT_u,1) - CALL BEMT_CopyInput( SrcRotMiscVarTypeData%BEMT_u(i1), DstRotMiscVarTypeData%BEMT_u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AA_CopyMisc( SrcRotMiscVarTypeData%AA, DstRotMiscVarTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyOutput( SrcRotMiscVarTypeData%AA_y, DstRotMiscVarTypeData%AA_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyInput( SrcRotMiscVarTypeData%AA_u, DstRotMiscVarTypeData%AA_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotMiscVarTypeData%DisturbedInflow)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%DisturbedInflow,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%DisturbedInflow,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%DisturbedInflow,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%DisturbedInflow,2) - i3_l = LBOUND(SrcRotMiscVarTypeData%DisturbedInflow,3) - i3_u = UBOUND(SrcRotMiscVarTypeData%DisturbedInflow,3) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%DisturbedInflow)) THEN - ALLOCATE(DstRotMiscVarTypeData%DisturbedInflow(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%DisturbedInflow.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%DisturbedInflow = SrcRotMiscVarTypeData%DisturbedInflow -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%orientationAnnulus)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,2) - i3_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,3) - i3_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,3) - i4_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,4) - i4_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,4) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%orientationAnnulus)) THEN - ALLOCATE(DstRotMiscVarTypeData%orientationAnnulus(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 DstRotMiscVarTypeData%orientationAnnulus.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%orientationAnnulus = SrcRotMiscVarTypeData%orientationAnnulus -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%AllOuts)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%AllOuts,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%AllOuts,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%AllOuts)) THEN - ALLOCATE(DstRotMiscVarTypeData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%AllOuts = SrcRotMiscVarTypeData%AllOuts -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%W_Twr)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%W_Twr,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%W_Twr,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%W_Twr)) THEN - ALLOCATE(DstRotMiscVarTypeData%W_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%W_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%W_Twr = SrcRotMiscVarTypeData%W_Twr -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%X_Twr)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%X_Twr,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%X_Twr,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%X_Twr)) THEN - ALLOCATE(DstRotMiscVarTypeData%X_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%X_Twr = SrcRotMiscVarTypeData%X_Twr -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Y_Twr)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Y_Twr,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Y_Twr,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Y_Twr)) THEN - ALLOCATE(DstRotMiscVarTypeData%Y_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Y_Twr = SrcRotMiscVarTypeData%Y_Twr -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Curve)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Curve,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Curve,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Curve,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Curve,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Curve)) THEN - ALLOCATE(DstRotMiscVarTypeData%Curve(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Curve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Curve = SrcRotMiscVarTypeData%Curve -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%TwrClrnc)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%TwrClrnc,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%TwrClrnc,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%TwrClrnc,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%TwrClrnc,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%TwrClrnc)) THEN - ALLOCATE(DstRotMiscVarTypeData%TwrClrnc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrClrnc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%TwrClrnc = SrcRotMiscVarTypeData%TwrClrnc -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%X)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%X,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%X,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%X,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%X,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%X)) THEN - ALLOCATE(DstRotMiscVarTypeData%X(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%X = SrcRotMiscVarTypeData%X -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Y)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Y,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Y,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Y,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Y,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Y)) THEN - ALLOCATE(DstRotMiscVarTypeData%Y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Y = SrcRotMiscVarTypeData%Y -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Z)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Z,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Z,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Z,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Z,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Z)) THEN - ALLOCATE(DstRotMiscVarTypeData%Z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Z = SrcRotMiscVarTypeData%Z -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%M)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%M,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%M,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%M,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%M,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%M)) THEN - ALLOCATE(DstRotMiscVarTypeData%M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%M = SrcRotMiscVarTypeData%M -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Mx)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Mx,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Mx,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Mx,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Mx,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Mx)) THEN - ALLOCATE(DstRotMiscVarTypeData%Mx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Mx = SrcRotMiscVarTypeData%Mx -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%My)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%My,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%My,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%My,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%My,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%My)) THEN - ALLOCATE(DstRotMiscVarTypeData%My(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%My.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%My = SrcRotMiscVarTypeData%My -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Mz)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Mz,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Mz,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Mz,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Mz,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Mz)) THEN - ALLOCATE(DstRotMiscVarTypeData%Mz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Mz = SrcRotMiscVarTypeData%Mz -ENDIF - DstRotMiscVarTypeData%V_DiskAvg = SrcRotMiscVarTypeData%V_DiskAvg - DstRotMiscVarTypeData%yaw = SrcRotMiscVarTypeData%yaw - DstRotMiscVarTypeData%tilt = SrcRotMiscVarTypeData%tilt -IF (ALLOCATED(SrcRotMiscVarTypeData%hub_theta_x_root)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%hub_theta_x_root,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%hub_theta_x_root,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%hub_theta_x_root)) THEN - ALLOCATE(DstRotMiscVarTypeData%hub_theta_x_root(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%hub_theta_x_root.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%hub_theta_x_root = SrcRotMiscVarTypeData%hub_theta_x_root -ENDIF - DstRotMiscVarTypeData%V_dot_x = SrcRotMiscVarTypeData%V_dot_x - CALL MeshCopy( SrcRotMiscVarTypeData%HubLoad, DstRotMiscVarTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotMiscVarTypeData%B_L_2_H_P)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%B_L_2_H_P,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%B_L_2_H_P,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%B_L_2_H_P)) THEN - ALLOCATE(DstRotMiscVarTypeData%B_L_2_H_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_H_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%B_L_2_H_P,1), UBOUND(SrcRotMiscVarTypeData%B_L_2_H_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcRotMiscVarTypeData%B_L_2_H_P(i1), DstRotMiscVarTypeData%B_L_2_H_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%SigmaCavitCrit)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%SigmaCavitCrit,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%SigmaCavitCrit,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%SigmaCavitCrit,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%SigmaCavitCrit,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%SigmaCavitCrit)) THEN - ALLOCATE(DstRotMiscVarTypeData%SigmaCavitCrit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavitCrit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%SigmaCavitCrit = SrcRotMiscVarTypeData%SigmaCavitCrit -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%SigmaCavit)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%SigmaCavit,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%SigmaCavit,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%SigmaCavit,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%SigmaCavit,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%SigmaCavit)) THEN - ALLOCATE(DstRotMiscVarTypeData%SigmaCavit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%SigmaCavit = SrcRotMiscVarTypeData%SigmaCavit -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%CavitWarnSet)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%CavitWarnSet,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%CavitWarnSet,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%CavitWarnSet,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%CavitWarnSet,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%CavitWarnSet)) THEN - ALLOCATE(DstRotMiscVarTypeData%CavitWarnSet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%CavitWarnSet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%CavitWarnSet = SrcRotMiscVarTypeData%CavitWarnSet -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%BlFB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%BlFB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%BlFB,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%BlFB,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%BlFB,2) - i3_l = LBOUND(SrcRotMiscVarTypeData%BlFB,3) - i3_u = UBOUND(SrcRotMiscVarTypeData%BlFB,3) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BlFB)) THEN - ALLOCATE(DstRotMiscVarTypeData%BlFB(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BlFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%BlFB = SrcRotMiscVarTypeData%BlFB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%BlMB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%BlMB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%BlMB,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%BlMB,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%BlMB,2) - i3_l = LBOUND(SrcRotMiscVarTypeData%BlMB,3) - i3_u = UBOUND(SrcRotMiscVarTypeData%BlMB,3) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BlMB)) THEN - ALLOCATE(DstRotMiscVarTypeData%BlMB(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BlMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%BlMB = SrcRotMiscVarTypeData%BlMB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%TwrFB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%TwrFB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%TwrFB,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%TwrFB,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%TwrFB,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%TwrFB)) THEN - ALLOCATE(DstRotMiscVarTypeData%TwrFB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%TwrFB = SrcRotMiscVarTypeData%TwrFB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%TwrMB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%TwrMB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%TwrMB,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%TwrMB,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%TwrMB,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%TwrMB)) THEN - ALLOCATE(DstRotMiscVarTypeData%TwrMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%TwrMB = SrcRotMiscVarTypeData%TwrMB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%HubFB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%HubFB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%HubFB,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%HubFB)) THEN - ALLOCATE(DstRotMiscVarTypeData%HubFB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%HubFB = SrcRotMiscVarTypeData%HubFB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%HubMB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%HubMB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%HubMB,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%HubMB)) THEN - ALLOCATE(DstRotMiscVarTypeData%HubMB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%HubMB = SrcRotMiscVarTypeData%HubMB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%NacFB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%NacFB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%NacFB,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%NacFB)) THEN - ALLOCATE(DstRotMiscVarTypeData%NacFB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%NacFB = SrcRotMiscVarTypeData%NacFB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%NacMB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%NacMB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%NacMB,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%NacMB)) THEN - ALLOCATE(DstRotMiscVarTypeData%NacMB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%BladeRootLoad)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BladeRootLoad)) THEN - ALLOCATE(DstRotMiscVarTypeData%BladeRootLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeRootLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1), UBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1) - CALL MeshCopy( SrcRotMiscVarTypeData%BladeRootLoad(i1), DstRotMiscVarTypeData%BladeRootLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%B_L_2_R_P)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%B_L_2_R_P,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%B_L_2_R_P,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%B_L_2_R_P)) THEN - ALLOCATE(DstRotMiscVarTypeData%B_L_2_R_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_R_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%B_L_2_R_P,1), UBOUND(SrcRotMiscVarTypeData%B_L_2_R_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcRotMiscVarTypeData%B_L_2_R_P(i1), DstRotMiscVarTypeData%B_L_2_R_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%BladeBuoyLoadPoint)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%BladeBuoyLoadPoint,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%BladeBuoyLoadPoint,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) THEN - ALLOCATE(DstRotMiscVarTypeData%BladeBuoyLoadPoint(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoadPoint.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%BladeBuoyLoadPoint,1), UBOUND(SrcRotMiscVarTypeData%BladeBuoyLoadPoint,1) - CALL MeshCopy( SrcRotMiscVarTypeData%BladeBuoyLoadPoint(i1), DstRotMiscVarTypeData%BladeBuoyLoadPoint(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%BladeBuoyLoad)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%BladeBuoyLoad,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%BladeBuoyLoad,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BladeBuoyLoad)) THEN - ALLOCATE(DstRotMiscVarTypeData%BladeBuoyLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%BladeBuoyLoad,1), UBOUND(SrcRotMiscVarTypeData%BladeBuoyLoad,1) - CALL MeshCopy( SrcRotMiscVarTypeData%BladeBuoyLoad(i1), DstRotMiscVarTypeData%BladeBuoyLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%B_P_2_B_L)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%B_P_2_B_L,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%B_P_2_B_L,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%B_P_2_B_L)) THEN - ALLOCATE(DstRotMiscVarTypeData%B_P_2_B_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_P_2_B_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%B_P_2_B_L,1), UBOUND(SrcRotMiscVarTypeData%B_P_2_B_L,1) - CALL NWTC_Library_Copymeshmaptype( SrcRotMiscVarTypeData%B_P_2_B_L(i1), DstRotMiscVarTypeData%B_P_2_B_L(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcRotMiscVarTypeData%TwrBuoyLoadPoint, DstRotMiscVarTypeData%TwrBuoyLoadPoint, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotMiscVarTypeData%TwrBuoyLoad, DstRotMiscVarTypeData%TwrBuoyLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcRotMiscVarTypeData%T_P_2_T_L, DstRotMiscVarTypeData%T_P_2_T_L, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstRotMiscVarTypeData%FirstWarn_TowerStrike = SrcRotMiscVarTypeData%FirstWarn_TowerStrike - DstRotMiscVarTypeData%AvgDiskVel = SrcRotMiscVarTypeData%AvgDiskVel - DstRotMiscVarTypeData%AvgDiskVelDist = SrcRotMiscVarTypeData%AvgDiskVelDist - DstRotMiscVarTypeData%TFinAlpha = SrcRotMiscVarTypeData%TFinAlpha - DstRotMiscVarTypeData%TFinRe = SrcRotMiscVarTypeData%TFinRe - DstRotMiscVarTypeData%TFinVrel = SrcRotMiscVarTypeData%TFinVrel - DstRotMiscVarTypeData%TFinVund_i = SrcRotMiscVarTypeData%TFinVund_i - DstRotMiscVarTypeData%TFinVind_i = SrcRotMiscVarTypeData%TFinVind_i - DstRotMiscVarTypeData%TFinVrel_i = SrcRotMiscVarTypeData%TFinVrel_i - DstRotMiscVarTypeData%TFinSTV_i = SrcRotMiscVarTypeData%TFinSTV_i - DstRotMiscVarTypeData%TFinF_i = SrcRotMiscVarTypeData%TFinF_i - DstRotMiscVarTypeData%TFinM_i = SrcRotMiscVarTypeData%TFinM_i - END SUBROUTINE AD_CopyRotMiscVarType - - SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg ) - TYPE(RotMiscVarType), INTENT(INOUT) :: RotMiscVarTypeData - 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 = 'AD_DestroyRotMiscVarType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL BEMT_DestroyMisc( RotMiscVarTypeData%BEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL AA_DestroyMisc( RotMiscVarTypeData%AA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyOutput( RotMiscVarTypeData%AA_y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyInput( RotMiscVarTypeData%AA_u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotMiscVarTypeData%DisturbedInflow)) THEN - DEALLOCATE(RotMiscVarTypeData%DisturbedInflow) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%orientationAnnulus)) THEN - DEALLOCATE(RotMiscVarTypeData%orientationAnnulus) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%AllOuts)) THEN - DEALLOCATE(RotMiscVarTypeData%AllOuts) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%W_Twr)) THEN - DEALLOCATE(RotMiscVarTypeData%W_Twr) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%X_Twr)) THEN - DEALLOCATE(RotMiscVarTypeData%X_Twr) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Y_Twr)) THEN - DEALLOCATE(RotMiscVarTypeData%Y_Twr) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Curve)) THEN - DEALLOCATE(RotMiscVarTypeData%Curve) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%TwrClrnc)) THEN - DEALLOCATE(RotMiscVarTypeData%TwrClrnc) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%X)) THEN - DEALLOCATE(RotMiscVarTypeData%X) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Y)) THEN - DEALLOCATE(RotMiscVarTypeData%Y) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Z)) THEN - DEALLOCATE(RotMiscVarTypeData%Z) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%M)) THEN - DEALLOCATE(RotMiscVarTypeData%M) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Mx)) THEN - DEALLOCATE(RotMiscVarTypeData%Mx) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%My)) THEN - DEALLOCATE(RotMiscVarTypeData%My) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Mz)) THEN - DEALLOCATE(RotMiscVarTypeData%Mz) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%hub_theta_x_root)) THEN - DEALLOCATE(RotMiscVarTypeData%hub_theta_x_root) -ENDIF - CALL MeshDestroy( RotMiscVarTypeData%HubLoad, ErrStat2, ErrMsg2 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%B_L_2_H_P) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%SigmaCavitCrit)) THEN - DEALLOCATE(RotMiscVarTypeData%SigmaCavitCrit) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%SigmaCavit)) THEN - DEALLOCATE(RotMiscVarTypeData%SigmaCavit) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%CavitWarnSet)) THEN - DEALLOCATE(RotMiscVarTypeData%CavitWarnSet) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BlFB)) THEN - DEALLOCATE(RotMiscVarTypeData%BlFB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BlMB)) THEN - DEALLOCATE(RotMiscVarTypeData%BlMB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%TwrFB)) THEN - DEALLOCATE(RotMiscVarTypeData%TwrFB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%TwrMB)) THEN - DEALLOCATE(RotMiscVarTypeData%TwrMB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%HubFB)) THEN - DEALLOCATE(RotMiscVarTypeData%HubFB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%HubMB)) THEN - DEALLOCATE(RotMiscVarTypeData%HubMB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%NacFB)) THEN - DEALLOCATE(RotMiscVarTypeData%NacFB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%NacMB)) THEN - DEALLOCATE(RotMiscVarTypeData%NacMB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BladeRootLoad)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%BladeRootLoad,1), UBOUND(RotMiscVarTypeData%BladeRootLoad,1) - CALL MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%BladeRootLoad) -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%B_L_2_R_P) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BladeBuoyLoadPoint)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%BladeBuoyLoadPoint,1), UBOUND(RotMiscVarTypeData%BladeBuoyLoadPoint,1) - CALL MeshDestroy( RotMiscVarTypeData%BladeBuoyLoadPoint(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%BladeBuoyLoadPoint) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BladeBuoyLoad)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%BladeBuoyLoad,1), UBOUND(RotMiscVarTypeData%BladeBuoyLoad,1) - CALL MeshDestroy( RotMiscVarTypeData%BladeBuoyLoad(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%BladeBuoyLoad) -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%B_P_2_B_L) -ENDIF - CALL MeshDestroy( RotMiscVarTypeData%TwrBuoyLoadPoint, ErrStat2, ErrMsg2 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotMiscVarType - - SUBROUTINE AD_PackRotMiscVarType( 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(RotMiscVarType), 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 = 'AD_PackRotMiscVarType' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! BEMT_y: size of buffers for each call to pack subtype - CALL BEMT_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%BEMT_y, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - DO i1 = LBOUND(InData%BEMT_u,1), UBOUND(InData%BEMT_u,1) - Int_BufSz = Int_BufSz + 3 ! BEMT_u: size of buffers for each call to pack subtype - CALL BEMT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%BEMT_u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BEMT_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA_y: size of buffers for each call to pack subtype - CALL AA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%AA_y, ErrStat2, ErrMsg2, .TRUE. ) ! AA_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA_u: size of buffers for each call to pack subtype - CALL AA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%AA_u, ErrStat2, ErrMsg2, .TRUE. ) ! AA_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! DisturbedInflow allocated yes/no - IF ( ALLOCATED(InData%DisturbedInflow) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! DisturbedInflow upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DisturbedInflow) ! DisturbedInflow - END IF - Int_BufSz = Int_BufSz + 1 ! orientationAnnulus allocated yes/no - IF ( ALLOCATED(InData%orientationAnnulus) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! orientationAnnulus upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%orientationAnnulus) ! orientationAnnulus - END IF - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Int_BufSz = Int_BufSz + 1 ! W_Twr allocated yes/no - IF ( ALLOCATED(InData%W_Twr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W_Twr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%W_Twr) ! W_Twr - END IF - Int_BufSz = Int_BufSz + 1 ! X_Twr allocated yes/no - IF ( ALLOCATED(InData%X_Twr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! X_Twr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X_Twr) ! X_Twr - END IF - Int_BufSz = Int_BufSz + 1 ! Y_Twr allocated yes/no - IF ( ALLOCATED(InData%Y_Twr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y_Twr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y_Twr) ! Y_Twr - END IF - Int_BufSz = Int_BufSz + 1 ! Curve allocated yes/no - IF ( ALLOCATED(InData%Curve) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Curve upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Curve) ! Curve - END IF - Int_BufSz = Int_BufSz + 1 ! TwrClrnc allocated yes/no - IF ( ALLOCATED(InData%TwrClrnc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TwrClrnc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrClrnc) ! TwrClrnc - END IF - Int_BufSz = Int_BufSz + 1 ! X allocated yes/no - IF ( ALLOCATED(InData%X) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! X upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X) ! X - END IF - Int_BufSz = Int_BufSz + 1 ! Y allocated yes/no - IF ( ALLOCATED(InData%Y) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y) ! Y - END IF - Int_BufSz = Int_BufSz + 1 ! Z allocated yes/no - IF ( ALLOCATED(InData%Z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Z) ! Z - END IF - Int_BufSz = Int_BufSz + 1 ! M allocated yes/no - IF ( ALLOCATED(InData%M) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M) ! M - END IF - Int_BufSz = Int_BufSz + 1 ! Mx allocated yes/no - IF ( ALLOCATED(InData%Mx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Mx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Mx) ! Mx - END IF - Int_BufSz = Int_BufSz + 1 ! My allocated yes/no - IF ( ALLOCATED(InData%My) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! My upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%My) ! My - END IF - Int_BufSz = Int_BufSz + 1 ! Mz allocated yes/no - IF ( ALLOCATED(InData%Mz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Mz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Mz) ! Mz - END IF - Re_BufSz = Re_BufSz + SIZE(InData%V_DiskAvg) ! V_DiskAvg - Re_BufSz = Re_BufSz + 1 ! yaw - Re_BufSz = Re_BufSz + 1 ! tilt - Int_BufSz = Int_BufSz + 1 ! hub_theta_x_root allocated yes/no - IF ( ALLOCATED(InData%hub_theta_x_root) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! hub_theta_x_root upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%hub_theta_x_root) ! hub_theta_x_root - END IF - Re_BufSz = Re_BufSz + 1 ! V_dot_x - Int_BufSz = Int_BufSz + 3 ! HubLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! B_L_2_H_P allocated yes/no - IF ( ALLOCATED(InData%B_L_2_H_P) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! B_L_2_H_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! B_L_2_H_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! B_L_2_H_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SigmaCavitCrit allocated yes/no - IF ( ALLOCATED(InData%SigmaCavitCrit) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SigmaCavitCrit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SigmaCavitCrit) ! SigmaCavitCrit - END IF - Int_BufSz = Int_BufSz + 1 ! SigmaCavit allocated yes/no - IF ( ALLOCATED(InData%SigmaCavit) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SigmaCavit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SigmaCavit) ! SigmaCavit - END IF - Int_BufSz = Int_BufSz + 1 ! CavitWarnSet allocated yes/no - IF ( ALLOCATED(InData%CavitWarnSet) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CavitWarnSet upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CavitWarnSet) ! CavitWarnSet - END IF - Int_BufSz = Int_BufSz + 1 ! BlFB allocated yes/no - IF ( ALLOCATED(InData%BlFB) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BlFB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlFB) ! BlFB - END IF - Int_BufSz = Int_BufSz + 1 ! BlMB allocated yes/no - IF ( ALLOCATED(InData%BlMB) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BlMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlMB) ! BlMB - END IF - Int_BufSz = Int_BufSz + 1 ! TwrFB allocated yes/no - IF ( ALLOCATED(InData%TwrFB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TwrFB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrFB) ! TwrFB - END IF - Int_BufSz = Int_BufSz + 1 ! TwrMB allocated yes/no - IF ( ALLOCATED(InData%TwrMB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TwrMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrMB) ! TwrMB - END IF - Int_BufSz = Int_BufSz + 1 ! HubFB allocated yes/no - IF ( ALLOCATED(InData%HubFB) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HubFB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HubFB) ! HubFB - END IF - Int_BufSz = Int_BufSz + 1 ! HubMB allocated yes/no - IF ( ALLOCATED(InData%HubMB) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HubMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HubMB) ! HubMB - END IF - Int_BufSz = Int_BufSz + 1 ! NacFB allocated yes/no - IF ( ALLOCATED(InData%NacFB) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NacFB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%NacFB) ! NacFB - END IF - Int_BufSz = Int_BufSz + 1 ! NacMB allocated yes/no - IF ( ALLOCATED(InData%NacMB) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NacMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%NacMB) ! NacMB - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootLoad allocated yes/no - IF ( ALLOCATED(InData%BladeRootLoad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeRootLoad upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeRootLoad,1), UBOUND(InData%BladeRootLoad,1) - Int_BufSz = Int_BufSz + 3 ! BladeRootLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeRootLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeRootLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeRootLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeRootLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! B_L_2_R_P allocated yes/no - IF ( ALLOCATED(InData%B_L_2_R_P) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! B_L_2_R_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! B_L_2_R_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! B_L_2_R_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BladeBuoyLoadPoint allocated yes/no - IF ( ALLOCATED(InData%BladeBuoyLoadPoint) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeBuoyLoadPoint upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeBuoyLoadPoint,1), UBOUND(InData%BladeBuoyLoadPoint,1) - Int_BufSz = Int_BufSz + 3 ! BladeBuoyLoadPoint: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeBuoyLoadPoint(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeBuoyLoadPoint - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeBuoyLoadPoint - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeBuoyLoadPoint - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeBuoyLoadPoint - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BladeBuoyLoad allocated yes/no - IF ( ALLOCATED(InData%BladeBuoyLoad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeBuoyLoad upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeBuoyLoad,1), UBOUND(InData%BladeBuoyLoad,1) - Int_BufSz = Int_BufSz + 3 ! BladeBuoyLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeBuoyLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeBuoyLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeBuoyLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeBuoyLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeBuoyLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! B_P_2_B_L allocated yes/no - IF ( ALLOCATED(InData%B_P_2_B_L) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! B_P_2_B_L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! B_P_2_B_L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! B_P_2_B_L - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! TwrBuoyLoadPoint: size of buffers for each call to pack subtype - CALL MeshPack( InData%TwrBuoyLoadPoint, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TwrBuoyLoadPoint - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TwrBuoyLoadPoint - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TwrBuoyLoadPoint - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TwrBuoyLoadPoint - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TwrBuoyLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%TwrBuoyLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TwrBuoyLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TwrBuoyLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TwrBuoyLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TwrBuoyLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! T_P_2_T_L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! T_P_2_T_L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! T_P_2_T_L - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! FirstWarn_TowerStrike - Re_BufSz = Re_BufSz + SIZE(InData%AvgDiskVel) ! AvgDiskVel - Re_BufSz = Re_BufSz + SIZE(InData%AvgDiskVelDist) ! AvgDiskVelDist - Re_BufSz = Re_BufSz + 1 ! TFinAlpha - Re_BufSz = Re_BufSz + 1 ! TFinRe - Re_BufSz = Re_BufSz + 1 ! TFinVrel - Re_BufSz = Re_BufSz + SIZE(InData%TFinVund_i) ! TFinVund_i - Re_BufSz = Re_BufSz + SIZE(InData%TFinVind_i) ! TFinVind_i - Re_BufSz = Re_BufSz + SIZE(InData%TFinVrel_i) ! TFinVrel_i - Re_BufSz = Re_BufSz + SIZE(InData%TFinSTV_i) ! TFinSTV_i - Re_BufSz = Re_BufSz + SIZE(InData%TFinF_i) ! TFinF_i - Re_BufSz = Re_BufSz + SIZE(InData%TFinM_i) ! TFinM_i - 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 - - CALL BEMT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - 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 - CALL BEMT_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%BEMT_y, ErrStat2, ErrMsg2, OnlySize ) ! BEMT_y - 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 - DO i1 = LBOUND(InData%BEMT_u,1), UBOUND(InData%BEMT_u,1) - CALL BEMT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%BEMT_u(i1), ErrStat2, ErrMsg2, OnlySize ) ! BEMT_u - 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 - CALL AA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - 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 - CALL AA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%AA_y, ErrStat2, ErrMsg2, OnlySize ) ! AA_y - 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 - CALL AA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%AA_u, ErrStat2, ErrMsg2, OnlySize ) ! AA_u - 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 - IF ( .NOT. ALLOCATED(InData%DisturbedInflow) ) 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%DisturbedInflow,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisturbedInflow,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisturbedInflow,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisturbedInflow,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisturbedInflow,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisturbedInflow,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%DisturbedInflow,3), UBOUND(InData%DisturbedInflow,3) - DO i2 = LBOUND(InData%DisturbedInflow,2), UBOUND(InData%DisturbedInflow,2) - DO i1 = LBOUND(InData%DisturbedInflow,1), UBOUND(InData%DisturbedInflow,1) - ReKiBuf(Re_Xferred) = InData%DisturbedInflow(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%orientationAnnulus) ) 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%orientationAnnulus,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%orientationAnnulus,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%orientationAnnulus,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%orientationAnnulus,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%orientationAnnulus,4), UBOUND(InData%orientationAnnulus,4) - DO i3 = LBOUND(InData%orientationAnnulus,3), UBOUND(InData%orientationAnnulus,3) - DO i2 = LBOUND(InData%orientationAnnulus,2), UBOUND(InData%orientationAnnulus,2) - DO i1 = LBOUND(InData%orientationAnnulus,1), UBOUND(InData%orientationAnnulus,1) - DbKiBuf(Db_Xferred) = InData%orientationAnnulus(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AllOuts) ) 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%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%W_Twr) ) 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%W_Twr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W_Twr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%W_Twr,1), UBOUND(InData%W_Twr,1) - ReKiBuf(Re_Xferred) = InData%W_Twr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X_Twr) ) 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%X_Twr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X_Twr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%X_Twr,1), UBOUND(InData%X_Twr,1) - ReKiBuf(Re_Xferred) = InData%X_Twr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y_Twr) ) 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%Y_Twr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_Twr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y_Twr,1), UBOUND(InData%Y_Twr,1) - ReKiBuf(Re_Xferred) = InData%Y_Twr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Curve) ) 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%Curve,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Curve,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Curve,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Curve,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Curve,2), UBOUND(InData%Curve,2) - DO i1 = LBOUND(InData%Curve,1), UBOUND(InData%Curve,1) - ReKiBuf(Re_Xferred) = InData%Curve(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrClrnc) ) 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%TwrClrnc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrClrnc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrClrnc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrClrnc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TwrClrnc,2), UBOUND(InData%TwrClrnc,2) - DO i1 = LBOUND(InData%TwrClrnc,1), UBOUND(InData%TwrClrnc,1) - ReKiBuf(Re_Xferred) = InData%TwrClrnc(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X) ) 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%X,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%X,2), UBOUND(InData%X,2) - DO i1 = LBOUND(InData%X,1), UBOUND(InData%X,1) - ReKiBuf(Re_Xferred) = InData%X(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y) ) 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%Y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Y,2), UBOUND(InData%Y,2) - DO i1 = LBOUND(InData%Y,1), UBOUND(InData%Y,1) - ReKiBuf(Re_Xferred) = InData%Y(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Z) ) 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%Z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Z,2), UBOUND(InData%Z,2) - DO i1 = LBOUND(InData%Z,1), UBOUND(InData%Z,1) - ReKiBuf(Re_Xferred) = InData%Z(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M) ) 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%M,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) - DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) - ReKiBuf(Re_Xferred) = InData%M(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mx) ) 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%Mx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Mx,2), UBOUND(InData%Mx,2) - DO i1 = LBOUND(InData%Mx,1), UBOUND(InData%Mx,1) - ReKiBuf(Re_Xferred) = InData%Mx(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%My) ) 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%My,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%My,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%My,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%My,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%My,2), UBOUND(InData%My,2) - DO i1 = LBOUND(InData%My,1), UBOUND(InData%My,1) - ReKiBuf(Re_Xferred) = InData%My(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mz) ) 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%Mz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Mz,2), UBOUND(InData%Mz,2) - DO i1 = LBOUND(InData%Mz,1), UBOUND(InData%Mz,1) - ReKiBuf(Re_Xferred) = InData%Mz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%V_DiskAvg,1), UBOUND(InData%V_DiskAvg,1) - ReKiBuf(Re_Xferred) = InData%V_DiskAvg(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tilt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%hub_theta_x_root) ) 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%hub_theta_x_root,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hub_theta_x_root,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%hub_theta_x_root,1), UBOUND(InData%hub_theta_x_root,1) - ReKiBuf(Re_Xferred) = InData%hub_theta_x_root(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%V_dot_x - Re_Xferred = Re_Xferred + 1 - CALL MeshPack( InData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubLoad - 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 - IF ( .NOT. ALLOCATED(InData%B_L_2_H_P) ) 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%B_L_2_H_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B_L_2_H_P,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%SigmaCavitCrit) ) 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%SigmaCavitCrit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavitCrit,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SigmaCavitCrit,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavitCrit,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SigmaCavitCrit,2), UBOUND(InData%SigmaCavitCrit,2) - DO i1 = LBOUND(InData%SigmaCavitCrit,1), UBOUND(InData%SigmaCavitCrit,1) - ReKiBuf(Re_Xferred) = InData%SigmaCavitCrit(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SigmaCavit) ) 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%SigmaCavit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavit,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SigmaCavit,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavit,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SigmaCavit,2), UBOUND(InData%SigmaCavit,2) - DO i1 = LBOUND(InData%SigmaCavit,1), UBOUND(InData%SigmaCavit,1) - ReKiBuf(Re_Xferred) = InData%SigmaCavit(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CavitWarnSet) ) 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%CavitWarnSet,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CavitWarnSet,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CavitWarnSet,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CavitWarnSet,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CavitWarnSet,2), UBOUND(InData%CavitWarnSet,2) - DO i1 = LBOUND(InData%CavitWarnSet,1), UBOUND(InData%CavitWarnSet,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitWarnSet(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlFB) ) 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%BlFB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlFB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFB,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlFB,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFB,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%BlFB,3), UBOUND(InData%BlFB,3) - DO i2 = LBOUND(InData%BlFB,2), UBOUND(InData%BlFB,2) - DO i1 = LBOUND(InData%BlFB,1), UBOUND(InData%BlFB,1) - ReKiBuf(Re_Xferred) = InData%BlFB(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlMB) ) 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%BlMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlMB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlMB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlMB,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlMB,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlMB,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%BlMB,3), UBOUND(InData%BlMB,3) - DO i2 = LBOUND(InData%BlMB,2), UBOUND(InData%BlMB,2) - DO i1 = LBOUND(InData%BlMB,1), UBOUND(InData%BlMB,1) - ReKiBuf(Re_Xferred) = InData%BlMB(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrFB) ) 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%TwrFB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TwrFB,2), UBOUND(InData%TwrFB,2) - DO i1 = LBOUND(InData%TwrFB,1), UBOUND(InData%TwrFB,1) - ReKiBuf(Re_Xferred) = InData%TwrFB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrMB) ) 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%TwrMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrMB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrMB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrMB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TwrMB,2), UBOUND(InData%TwrMB,2) - DO i1 = LBOUND(InData%TwrMB,1), UBOUND(InData%TwrMB,1) - ReKiBuf(Re_Xferred) = InData%TwrMB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HubFB) ) 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%HubFB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HubFB,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HubFB,1), UBOUND(InData%HubFB,1) - ReKiBuf(Re_Xferred) = InData%HubFB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HubMB) ) 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%HubMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HubMB,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HubMB,1), UBOUND(InData%HubMB,1) - ReKiBuf(Re_Xferred) = InData%HubMB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NacFB) ) 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%NacFB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NacFB,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NacFB,1), UBOUND(InData%NacFB,1) - ReKiBuf(Re_Xferred) = InData%NacFB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NacMB) ) 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%NacMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NacMB,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NacMB,1), UBOUND(InData%NacMB,1) - ReKiBuf(Re_Xferred) = InData%NacMB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeRootLoad) ) 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%BladeRootLoad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootLoad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeRootLoad,1), UBOUND(InData%BladeRootLoad,1) - CALL MeshPack( InData%BladeRootLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootLoad - 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 - IF ( .NOT. ALLOCATED(InData%B_L_2_R_P) ) 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%B_L_2_R_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B_L_2_R_P,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%BladeBuoyLoadPoint) ) 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%BladeBuoyLoadPoint,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeBuoyLoadPoint,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeBuoyLoadPoint,1), UBOUND(InData%BladeBuoyLoadPoint,1) - CALL MeshPack( InData%BladeBuoyLoadPoint(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeBuoyLoadPoint - 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 - IF ( .NOT. ALLOCATED(InData%BladeBuoyLoad) ) 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%BladeBuoyLoad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeBuoyLoad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeBuoyLoad,1), UBOUND(InData%BladeBuoyLoad,1) - CALL MeshPack( InData%BladeBuoyLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeBuoyLoad - 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 - IF ( .NOT. ALLOCATED(InData%B_P_2_B_L) ) 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%B_P_2_B_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B_P_2_B_L,1) - 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 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 - CALL MeshPack( InData%TwrBuoyLoadPoint, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TwrBuoyLoadPoint - 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 - CALL MeshPack( InData%TwrBuoyLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TwrBuoyLoad - 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 - 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 - - 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) = TRANSFER(InData%FirstWarn_TowerStrike, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%AvgDiskVel,1), UBOUND(InData%AvgDiskVel,1) - ReKiBuf(Re_Xferred) = InData%AvgDiskVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AvgDiskVelDist,1), UBOUND(InData%AvgDiskVelDist,1) - ReKiBuf(Re_Xferred) = InData%AvgDiskVelDist(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%TFinAlpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinRe - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinVrel - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%TFinVund_i,1), UBOUND(InData%TFinVund_i,1) - ReKiBuf(Re_Xferred) = InData%TFinVund_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinVind_i,1), UBOUND(InData%TFinVind_i,1) - ReKiBuf(Re_Xferred) = InData%TFinVind_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinVrel_i,1), UBOUND(InData%TFinVrel_i,1) - ReKiBuf(Re_Xferred) = InData%TFinVrel_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinSTV_i,1), UBOUND(InData%TFinSTV_i,1) - ReKiBuf(Re_Xferred) = InData%TFinSTV_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinF_i,1), UBOUND(InData%TFinF_i,1) - ReKiBuf(Re_Xferred) = InData%TFinF_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinM_i,1), UBOUND(InData%TFinM_i,1) - ReKiBuf(Re_Xferred) = InData%TFinM_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD_PackRotMiscVarType - - SUBROUTINE AD_UnPackRotMiscVarType( 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(RotMiscVarType), 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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackRotMiscVarType' - ! 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 - 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 BEMT_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - 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) - 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 BEMT_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT_y, ErrStat2, ErrMsg2 ) ! BEMT_y - 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) - i1_l = LBOUND(OutData%BEMT_u,1) - i1_u = UBOUND(OutData%BEMT_u,1) - DO i1 = LBOUND(OutData%BEMT_u,1), UBOUND(OutData%BEMT_u,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 BEMT_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT_u(i1), ErrStat2, ErrMsg2 ) ! BEMT_u - 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 - 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 AA_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - 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) - 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 AA_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%AA_y, ErrStat2, ErrMsg2 ) ! AA_y - 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) - 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 AA_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%AA_u, ErrStat2, ErrMsg2 ) ! AA_u - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DisturbedInflow 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%DisturbedInflow)) DEALLOCATE(OutData%DisturbedInflow) - ALLOCATE(OutData%DisturbedInflow(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%DisturbedInflow.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%DisturbedInflow,3), UBOUND(OutData%DisturbedInflow,3) - DO i2 = LBOUND(OutData%DisturbedInflow,2), UBOUND(OutData%DisturbedInflow,2) - DO i1 = LBOUND(OutData%DisturbedInflow,1), UBOUND(OutData%DisturbedInflow,1) - OutData%DisturbedInflow(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! orientationAnnulus 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%orientationAnnulus)) DEALLOCATE(OutData%orientationAnnulus) - ALLOCATE(OutData%orientationAnnulus(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%orientationAnnulus.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%orientationAnnulus,4), UBOUND(OutData%orientationAnnulus,4) - DO i3 = LBOUND(OutData%orientationAnnulus,3), UBOUND(OutData%orientationAnnulus,3) - DO i2 = LBOUND(OutData%orientationAnnulus,2), UBOUND(OutData%orientationAnnulus,2) - DO i1 = LBOUND(OutData%orientationAnnulus,1), UBOUND(OutData%orientationAnnulus,1) - OutData%orientationAnnulus(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts 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%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W_Twr 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%W_Twr)) DEALLOCATE(OutData%W_Twr) - ALLOCATE(OutData%W_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W_Twr,1), UBOUND(OutData%W_Twr,1) - OutData%W_Twr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X_Twr 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%X_Twr)) DEALLOCATE(OutData%X_Twr) - ALLOCATE(OutData%X_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%X_Twr,1), UBOUND(OutData%X_Twr,1) - OutData%X_Twr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_Twr 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%Y_Twr)) DEALLOCATE(OutData%Y_Twr) - ALLOCATE(OutData%Y_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y_Twr,1), UBOUND(OutData%Y_Twr,1) - OutData%Y_Twr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Curve 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%Curve)) DEALLOCATE(OutData%Curve) - ALLOCATE(OutData%Curve(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Curve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Curve,2), UBOUND(OutData%Curve,2) - DO i1 = LBOUND(OutData%Curve,1), UBOUND(OutData%Curve,1) - OutData%Curve(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrClrnc 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%TwrClrnc)) DEALLOCATE(OutData%TwrClrnc) - ALLOCATE(OutData%TwrClrnc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrClrnc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TwrClrnc,2), UBOUND(OutData%TwrClrnc,2) - DO i1 = LBOUND(OutData%TwrClrnc,1), UBOUND(OutData%TwrClrnc,1) - OutData%TwrClrnc(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X 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%X)) DEALLOCATE(OutData%X) - ALLOCATE(OutData%X(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%X,2), UBOUND(OutData%X,2) - DO i1 = LBOUND(OutData%X,1), UBOUND(OutData%X,1) - OutData%X(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y 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%Y)) DEALLOCATE(OutData%Y) - ALLOCATE(OutData%Y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Y,2), UBOUND(OutData%Y,2) - DO i1 = LBOUND(OutData%Y,1), UBOUND(OutData%Y,1) - OutData%Y(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Z 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%Z)) DEALLOCATE(OutData%Z) - ALLOCATE(OutData%Z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Z,2), UBOUND(OutData%Z,2) - DO i1 = LBOUND(OutData%Z,1), UBOUND(OutData%Z,1) - OutData%Z(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M 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%M)) DEALLOCATE(OutData%M) - ALLOCATE(OutData%M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mx 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%Mx)) DEALLOCATE(OutData%Mx) - ALLOCATE(OutData%Mx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Mx,2), UBOUND(OutData%Mx,2) - DO i1 = LBOUND(OutData%Mx,1), UBOUND(OutData%Mx,1) - OutData%Mx(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! My 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%My)) DEALLOCATE(OutData%My) - ALLOCATE(OutData%My(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%My.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%My,2), UBOUND(OutData%My,2) - DO i1 = LBOUND(OutData%My,1), UBOUND(OutData%My,1) - OutData%My(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mz 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%Mz)) DEALLOCATE(OutData%Mz) - ALLOCATE(OutData%Mz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Mz,2), UBOUND(OutData%Mz,2) - DO i1 = LBOUND(OutData%Mz,1), UBOUND(OutData%Mz,1) - OutData%Mz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%V_DiskAvg,1) - i1_u = UBOUND(OutData%V_DiskAvg,1) - DO i1 = LBOUND(OutData%V_DiskAvg,1), UBOUND(OutData%V_DiskAvg,1) - OutData%V_DiskAvg(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%yaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tilt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hub_theta_x_root 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%hub_theta_x_root)) DEALLOCATE(OutData%hub_theta_x_root) - ALLOCATE(OutData%hub_theta_x_root(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%hub_theta_x_root.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%hub_theta_x_root,1), UBOUND(OutData%hub_theta_x_root,1) - OutData%hub_theta_x_root(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%V_dot_x = ReKiBuf(Re_Xferred) - 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 MeshUnpack( OutData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubLoad - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B_L_2_H_P 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%B_L_2_H_P)) DEALLOCATE(OutData%B_L_2_H_P) - ALLOCATE(OutData%B_L_2_H_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_H_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%B_L_2_H_P,1), UBOUND(OutData%B_L_2_H_P,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_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 - - 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 ! SigmaCavitCrit 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%SigmaCavitCrit)) DEALLOCATE(OutData%SigmaCavitCrit) - ALLOCATE(OutData%SigmaCavitCrit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavitCrit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SigmaCavitCrit,2), UBOUND(OutData%SigmaCavitCrit,2) - DO i1 = LBOUND(OutData%SigmaCavitCrit,1), UBOUND(OutData%SigmaCavitCrit,1) - OutData%SigmaCavitCrit(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SigmaCavit 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%SigmaCavit)) DEALLOCATE(OutData%SigmaCavit) - ALLOCATE(OutData%SigmaCavit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SigmaCavit,2), UBOUND(OutData%SigmaCavit,2) - DO i1 = LBOUND(OutData%SigmaCavit,1), UBOUND(OutData%SigmaCavit,1) - OutData%SigmaCavit(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CavitWarnSet 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%CavitWarnSet)) DEALLOCATE(OutData%CavitWarnSet) - ALLOCATE(OutData%CavitWarnSet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CavitWarnSet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CavitWarnSet,2), UBOUND(OutData%CavitWarnSet,2) - DO i1 = LBOUND(OutData%CavitWarnSet,1), UBOUND(OutData%CavitWarnSet,1) - OutData%CavitWarnSet(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitWarnSet(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlFB 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%BlFB)) DEALLOCATE(OutData%BlFB) - ALLOCATE(OutData%BlFB(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%BlFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%BlFB,3), UBOUND(OutData%BlFB,3) - DO i2 = LBOUND(OutData%BlFB,2), UBOUND(OutData%BlFB,2) - DO i1 = LBOUND(OutData%BlFB,1), UBOUND(OutData%BlFB,1) - OutData%BlFB(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlMB 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%BlMB)) DEALLOCATE(OutData%BlMB) - ALLOCATE(OutData%BlMB(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%BlMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%BlMB,3), UBOUND(OutData%BlMB,3) - DO i2 = LBOUND(OutData%BlMB,2), UBOUND(OutData%BlMB,2) - DO i1 = LBOUND(OutData%BlMB,1), UBOUND(OutData%BlMB,1) - OutData%BlMB(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrFB 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%TwrFB)) DEALLOCATE(OutData%TwrFB) - ALLOCATE(OutData%TwrFB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TwrFB,2), UBOUND(OutData%TwrFB,2) - DO i1 = LBOUND(OutData%TwrFB,1), UBOUND(OutData%TwrFB,1) - OutData%TwrFB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrMB 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%TwrMB)) DEALLOCATE(OutData%TwrMB) - ALLOCATE(OutData%TwrMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TwrMB,2), UBOUND(OutData%TwrMB,2) - DO i1 = LBOUND(OutData%TwrMB,1), UBOUND(OutData%TwrMB,1) - OutData%TwrMB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HubFB 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%HubFB)) DEALLOCATE(OutData%HubFB) - ALLOCATE(OutData%HubFB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HubFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HubFB,1), UBOUND(OutData%HubFB,1) - OutData%HubFB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HubMB 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%HubMB)) DEALLOCATE(OutData%HubMB) - ALLOCATE(OutData%HubMB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HubMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HubMB,1), UBOUND(OutData%HubMB,1) - OutData%HubMB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NacFB 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%NacFB)) DEALLOCATE(OutData%NacFB) - ALLOCATE(OutData%NacFB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NacFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NacFB,1), UBOUND(OutData%NacFB,1) - OutData%NacFB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NacMB 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%NacMB)) DEALLOCATE(OutData%NacMB) - ALLOCATE(OutData%NacMB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NacMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NacMB,1), UBOUND(OutData%NacMB,1) - OutData%NacMB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootLoad 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%BladeRootLoad)) DEALLOCATE(OutData%BladeRootLoad) - ALLOCATE(OutData%BladeRootLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeRootLoad,1), UBOUND(OutData%BladeRootLoad,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 MeshUnpack( OutData%BladeRootLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootLoad - 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 ! B_L_2_R_P 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%B_L_2_R_P)) DEALLOCATE(OutData%B_L_2_R_P) - ALLOCATE(OutData%B_L_2_R_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_R_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%B_L_2_R_P,1), UBOUND(OutData%B_L_2_R_P,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_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 - - 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 ! BladeBuoyLoadPoint 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%BladeBuoyLoadPoint)) DEALLOCATE(OutData%BladeBuoyLoadPoint) - ALLOCATE(OutData%BladeBuoyLoadPoint(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoadPoint.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeBuoyLoadPoint,1), UBOUND(OutData%BladeBuoyLoadPoint,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 MeshUnpack( OutData%BladeBuoyLoadPoint(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeBuoyLoadPoint - 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 ! BladeBuoyLoad 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%BladeBuoyLoad)) DEALLOCATE(OutData%BladeBuoyLoad) - ALLOCATE(OutData%BladeBuoyLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeBuoyLoad,1), UBOUND(OutData%BladeBuoyLoad,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 MeshUnpack( OutData%BladeBuoyLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeBuoyLoad - 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 ! B_P_2_B_L 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%B_P_2_B_L)) DEALLOCATE(OutData%B_P_2_B_L) - ALLOCATE(OutData%B_P_2_B_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_P_2_B_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%B_P_2_B_L,1), UBOUND(OutData%B_P_2_B_L,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_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 - - 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 - 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 MeshUnpack( OutData%TwrBuoyLoadPoint, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TwrBuoyLoadPoint - 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) - 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 MeshUnpack( OutData%TwrBuoyLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TwrBuoyLoad - 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) - 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_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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%FirstWarn_TowerStrike = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_TowerStrike) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%AvgDiskVel,1) - i1_u = UBOUND(OutData%AvgDiskVel,1) - DO i1 = LBOUND(OutData%AvgDiskVel,1), UBOUND(OutData%AvgDiskVel,1) - OutData%AvgDiskVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AvgDiskVelDist,1) - i1_u = UBOUND(OutData%AvgDiskVelDist,1) - DO i1 = LBOUND(OutData%AvgDiskVelDist,1), UBOUND(OutData%AvgDiskVelDist,1) - OutData%AvgDiskVelDist(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TFinAlpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinRe = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinVrel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%TFinVund_i,1) - i1_u = UBOUND(OutData%TFinVund_i,1) - DO i1 = LBOUND(OutData%TFinVund_i,1), UBOUND(OutData%TFinVund_i,1) - OutData%TFinVund_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinVind_i,1) - i1_u = UBOUND(OutData%TFinVind_i,1) - DO i1 = LBOUND(OutData%TFinVind_i,1), UBOUND(OutData%TFinVind_i,1) - OutData%TFinVind_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinVrel_i,1) - i1_u = UBOUND(OutData%TFinVrel_i,1) - DO i1 = LBOUND(OutData%TFinVrel_i,1), UBOUND(OutData%TFinVrel_i,1) - OutData%TFinVrel_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinSTV_i,1) - i1_u = UBOUND(OutData%TFinSTV_i,1) - DO i1 = LBOUND(OutData%TFinSTV_i,1), UBOUND(OutData%TFinSTV_i,1) - OutData%TFinSTV_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinF_i,1) - i1_u = UBOUND(OutData%TFinF_i,1) - DO i1 = LBOUND(OutData%TFinF_i,1), UBOUND(OutData%TFinF_i,1) - OutData%TFinF_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinM_i,1) - i1_u = UBOUND(OutData%TFinM_i,1) - DO i1 = LBOUND(OutData%TFinM_i,1), UBOUND(OutData%TFinM_i,1) - OutData%TFinM_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD_UnPackRotMiscVarType - - SUBROUTINE AD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(AD_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) :: 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 = 'AD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%rotors)) THEN - i1_l = LBOUND(SrcMiscData%rotors,1) - i1_u = UBOUND(SrcMiscData%rotors,1) - IF (.NOT. ALLOCATED(DstMiscData%rotors)) THEN - ALLOCATE(DstMiscData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%rotors,1), UBOUND(SrcMiscData%rotors,1) - CALL AD_Copyrotmiscvartype( SrcMiscData%rotors(i1), DstMiscData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%FVW_u)) THEN - i1_l = LBOUND(SrcMiscData%FVW_u,1) - i1_u = UBOUND(SrcMiscData%FVW_u,1) - IF (.NOT. ALLOCATED(DstMiscData%FVW_u)) THEN - ALLOCATE(DstMiscData%FVW_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FVW_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%FVW_u,1), UBOUND(SrcMiscData%FVW_u,1) - CALL FVW_CopyInput( SrcMiscData%FVW_u(i1), DstMiscData%FVW_u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL FVW_CopyOutput( SrcMiscData%FVW_y, DstMiscData%FVW_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FVW_CopyMisc( SrcMiscData%FVW, DstMiscData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%WindPos)) THEN - i1_l = LBOUND(SrcMiscData%WindPos,1) - i1_u = UBOUND(SrcMiscData%WindPos,1) - i2_l = LBOUND(SrcMiscData%WindPos,2) - i2_u = UBOUND(SrcMiscData%WindPos,2) - IF (.NOT. ALLOCATED(DstMiscData%WindPos)) THEN - ALLOCATE(DstMiscData%WindPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WindPos = SrcMiscData%WindPos -ENDIF -IF (ALLOCATED(SrcMiscData%WindVel)) THEN - i1_l = LBOUND(SrcMiscData%WindVel,1) - i1_u = UBOUND(SrcMiscData%WindVel,1) - i2_l = LBOUND(SrcMiscData%WindVel,2) - i2_u = UBOUND(SrcMiscData%WindVel,2) - IF (.NOT. ALLOCATED(DstMiscData%WindVel)) THEN - ALLOCATE(DstMiscData%WindVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WindVel = SrcMiscData%WindVel -ENDIF -IF (ALLOCATED(SrcMiscData%WindAcc)) THEN - i1_l = LBOUND(SrcMiscData%WindAcc,1) - i1_u = UBOUND(SrcMiscData%WindAcc,1) - i2_l = LBOUND(SrcMiscData%WindAcc,2) - i2_u = UBOUND(SrcMiscData%WindAcc,2) - IF (.NOT. ALLOCATED(DstMiscData%WindAcc)) THEN - ALLOCATE(DstMiscData%WindAcc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WindAcc = SrcMiscData%WindAcc -ENDIF - END SUBROUTINE AD_CopyMisc - - SUBROUTINE AD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(AD_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 = 'AD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%rotors)) THEN -DO i1 = LBOUND(MiscData%rotors,1), UBOUND(MiscData%rotors,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%FVW_u) -ENDIF - CALL FVW_DestroyOutput( MiscData%FVW_y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyMisc( MiscData%FVW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%WindPos)) THEN - DEALLOCATE(MiscData%WindPos) -ENDIF -IF (ALLOCATED(MiscData%WindVel)) THEN - DEALLOCATE(MiscData%WindVel) -ENDIF -IF (ALLOCATED(MiscData%WindAcc)) THEN - DEALLOCATE(MiscData%WindAcc) -ENDIF - END SUBROUTINE AD_DestroyMisc - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FVW_u allocated yes/no - IF ( ALLOCATED(InData%FVW_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FVW_u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%FVW_u,1), UBOUND(InData%FVW_u,1) - Int_BufSz = Int_BufSz + 3 ! FVW_u: size of buffers for each call to pack subtype - CALL FVW_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FVW_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! FVW_y: size of buffers for each call to pack subtype - CALL FVW_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_y, ErrStat2, ErrMsg2, .TRUE. ) ! FVW_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WindPos allocated yes/no - IF ( ALLOCATED(InData%WindPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindPos) ! WindPos - END IF - Int_BufSz = Int_BufSz + 1 ! WindVel allocated yes/no - IF ( ALLOCATED(InData%WindVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVel) ! WindVel - END IF - Int_BufSz = Int_BufSz + 1 ! WindAcc allocated yes/no - IF ( ALLOCATED(InData%WindAcc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindAcc) ! WindAcc - 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%rotors) ) 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%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%FVW_u) ) 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%FVW_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FVW_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FVW_u,1), UBOUND(InData%FVW_u,1) - CALL FVW_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_u(i1), ErrStat2, ErrMsg2, OnlySize ) ! FVW_u - 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 - CALL FVW_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_y, ErrStat2, ErrMsg2, OnlySize ) ! FVW_y - 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 - CALL FVW_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - 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 - IF ( .NOT. ALLOCATED(InData%WindPos) ) 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%WindPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindPos,2), UBOUND(InData%WindPos,2) - DO i1 = LBOUND(InData%WindPos,1), UBOUND(InData%WindPos,1) - ReKiBuf(Re_Xferred) = InData%WindPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindVel) ) 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%WindVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindVel,2), UBOUND(InData%WindVel,2) - DO i1 = LBOUND(InData%WindVel,1), UBOUND(InData%WindVel,1) - ReKiBuf(Re_Xferred) = InData%WindVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindAcc) ) 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%WindAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindAcc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindAcc,2), UBOUND(InData%WindAcc,2) - DO i1 = LBOUND(InData%WindAcc,1), UBOUND(InData%WindAcc,1) - ReKiBuf(Re_Xferred) = InData%WindAcc(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_PackMisc - - SUBROUTINE AD_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(AD_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) :: 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 = 'AD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors 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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 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 - - 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 ! FVW_u 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%FVW_u)) DEALLOCATE(OutData%FVW_u) - ALLOCATE(OutData%FVW_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FVW_u,1), UBOUND(OutData%FVW_u,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 FVW_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%FVW_u(i1), ErrStat2, ErrMsg2 ) ! FVW_u - 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 - 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 FVW_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%FVW_y, ErrStat2, ErrMsg2 ) ! FVW_y - 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) - 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 FVW_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindPos 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%WindPos)) DEALLOCATE(OutData%WindPos) - ALLOCATE(OutData%WindPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindPos,2), UBOUND(OutData%WindPos,2) - DO i1 = LBOUND(OutData%WindPos,1), UBOUND(OutData%WindPos,1) - OutData%WindPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVel 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%WindVel)) DEALLOCATE(OutData%WindVel) - ALLOCATE(OutData%WindVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindVel,2), UBOUND(OutData%WindVel,2) - DO i1 = LBOUND(OutData%WindVel,1), UBOUND(OutData%WindVel,1) - OutData%WindVel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindAcc 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%WindAcc)) DEALLOCATE(OutData%WindAcc) - ALLOCATE(OutData%WindAcc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindAcc,2), UBOUND(OutData%WindAcc,2) - DO i1 = LBOUND(OutData%WindAcc,1), UBOUND(OutData%WindAcc,1) - OutData%WindAcc(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_UnPackMisc - - SUBROUTINE AD_CopyRotParameterType( SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotParameterType), INTENT(IN) :: SrcRotParameterTypeData - TYPE(RotParameterType), INTENT(INOUT) :: DstRotParameterTypeData - 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 = 'AD_CopyRotParameterType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRotParameterTypeData%NumBlades = SrcRotParameterTypeData%NumBlades - DstRotParameterTypeData%NumBlNds = SrcRotParameterTypeData%NumBlNds - DstRotParameterTypeData%NumTwrNds = SrcRotParameterTypeData%NumTwrNds -IF (ALLOCATED(SrcRotParameterTypeData%TwrDiam)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrDiam,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrDiam,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrDiam)) THEN - ALLOCATE(DstRotParameterTypeData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrCd)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrCd,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrCd,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrCd)) THEN - ALLOCATE(DstRotParameterTypeData%TwrCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrTI)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrTI,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrTI,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrTI)) THEN - ALLOCATE(DstRotParameterTypeData%TwrTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlTwist)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlTwist,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlTwist,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlTwist,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlTwist,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlTwist)) THEN - ALLOCATE(DstRotParameterTypeData%BlTwist(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrCb)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrCb,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrCb,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrCb)) THEN - ALLOCATE(DstRotParameterTypeData%TwrCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlCenBn)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlCenBn,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlCenBn,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlCenBn,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlCenBn,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlCenBn)) THEN - ALLOCATE(DstRotParameterTypeData%BlCenBn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlCenBt)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlCenBt,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlCenBt,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlCenBt,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlCenBt,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlCenBt)) THEN - ALLOCATE(DstRotParameterTypeData%BlCenBt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlCenBt = SrcRotParameterTypeData%BlCenBt -ENDIF - DstRotParameterTypeData%VolHub = SrcRotParameterTypeData%VolHub - DstRotParameterTypeData%HubCenBx = SrcRotParameterTypeData%HubCenBx - DstRotParameterTypeData%VolNac = SrcRotParameterTypeData%VolNac - DstRotParameterTypeData%NacCenB = SrcRotParameterTypeData%NacCenB - DstRotParameterTypeData%VolBl = SrcRotParameterTypeData%VolBl - DstRotParameterTypeData%VolTwr = SrcRotParameterTypeData%VolTwr -IF (ALLOCATED(SrcRotParameterTypeData%BlRad)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlRad,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlRad,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlRad,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlRad,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlRad)) THEN - ALLOCATE(DstRotParameterTypeData%BlRad(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlDL)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlDL,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlDL,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlDL,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlDL,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlDL)) THEN - ALLOCATE(DstRotParameterTypeData%BlDL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlDL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlDL = SrcRotParameterTypeData%BlDL -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlTaper)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlTaper,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlTaper,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlTaper,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlTaper,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlTaper)) THEN - ALLOCATE(DstRotParameterTypeData%BlTaper(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTaper.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlTaper = SrcRotParameterTypeData%BlTaper -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlAxCent)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlAxCent,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlAxCent,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlAxCent,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlAxCent,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlAxCent)) THEN - ALLOCATE(DstRotParameterTypeData%BlAxCent(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAxCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrRad)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrRad,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrRad,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrRad)) THEN - ALLOCATE(DstRotParameterTypeData%TwrRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrRad = SrcRotParameterTypeData%TwrRad -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrDL)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrDL,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrDL,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrDL)) THEN - ALLOCATE(DstRotParameterTypeData%TwrDL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrDL = SrcRotParameterTypeData%TwrDL -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrTaper)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrTaper,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrTaper,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrTaper)) THEN - ALLOCATE(DstRotParameterTypeData%TwrTaper(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTaper.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrTaper = SrcRotParameterTypeData%TwrTaper -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrAxCent)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrAxCent,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrAxCent,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrAxCent)) THEN - ALLOCATE(DstRotParameterTypeData%TwrAxCent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrAxCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrAxCent = SrcRotParameterTypeData%TwrAxCent -ENDIF - CALL BEMT_CopyParam( SrcRotParameterTypeData%BEMT, DstRotParameterTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyParam( SrcRotParameterTypeData%AA, DstRotParameterTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotParameterTypeData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%Jac_u_indx,1) - i1_u = UBOUND(SrcRotParameterTypeData%Jac_u_indx,1) - i2_l = LBOUND(SrcRotParameterTypeData%Jac_u_indx,2) - i2_u = UBOUND(SrcRotParameterTypeData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%Jac_u_indx)) THEN - ALLOCATE(DstRotParameterTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%Jac_u_indx = SrcRotParameterTypeData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%du)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%du,1) - i1_u = UBOUND(SrcRotParameterTypeData%du,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%du)) THEN - ALLOCATE(DstRotParameterTypeData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%du = SrcRotParameterTypeData%du -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%dx)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%dx,1) - i1_u = UBOUND(SrcRotParameterTypeData%dx,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%dx)) THEN - ALLOCATE(DstRotParameterTypeData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%dx = SrcRotParameterTypeData%dx -ENDIF - DstRotParameterTypeData%Jac_ny = SrcRotParameterTypeData%Jac_ny - DstRotParameterTypeData%NumBl_Lin = SrcRotParameterTypeData%NumBl_Lin - DstRotParameterTypeData%TwrPotent = SrcRotParameterTypeData%TwrPotent - DstRotParameterTypeData%TwrShadow = SrcRotParameterTypeData%TwrShadow - DstRotParameterTypeData%TwrAero = SrcRotParameterTypeData%TwrAero - DstRotParameterTypeData%FrozenWake = SrcRotParameterTypeData%FrozenWake - DstRotParameterTypeData%CavitCheck = SrcRotParameterTypeData%CavitCheck - DstRotParameterTypeData%Buoyancy = SrcRotParameterTypeData%Buoyancy - DstRotParameterTypeData%MHK = SrcRotParameterTypeData%MHK - DstRotParameterTypeData%CompAA = SrcRotParameterTypeData%CompAA - DstRotParameterTypeData%AirDens = SrcRotParameterTypeData%AirDens - DstRotParameterTypeData%KinVisc = SrcRotParameterTypeData%KinVisc - DstRotParameterTypeData%SpdSound = SrcRotParameterTypeData%SpdSound - DstRotParameterTypeData%Gravity = SrcRotParameterTypeData%Gravity - DstRotParameterTypeData%Patm = SrcRotParameterTypeData%Patm - DstRotParameterTypeData%Pvap = SrcRotParameterTypeData%Pvap - DstRotParameterTypeData%WtrDpth = SrcRotParameterTypeData%WtrDpth - DstRotParameterTypeData%MSL2SWL = SrcRotParameterTypeData%MSL2SWL - DstRotParameterTypeData%AeroProjMod = SrcRotParameterTypeData%AeroProjMod - DstRotParameterTypeData%AeroBEM_Mod = SrcRotParameterTypeData%AeroBEM_Mod - DstRotParameterTypeData%NumOuts = SrcRotParameterTypeData%NumOuts - DstRotParameterTypeData%RootName = SrcRotParameterTypeData%RootName -IF (ALLOCATED(SrcRotParameterTypeData%OutParam)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%OutParam,1) - i1_u = UBOUND(SrcRotParameterTypeData%OutParam,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%OutParam)) THEN - ALLOCATE(DstRotParameterTypeData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotParameterTypeData%OutParam,1), UBOUND(SrcRotParameterTypeData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcRotParameterTypeData%OutParam(i1), DstRotParameterTypeData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstRotParameterTypeData%NBlOuts = SrcRotParameterTypeData%NBlOuts - DstRotParameterTypeData%BlOutNd = SrcRotParameterTypeData%BlOutNd - DstRotParameterTypeData%NTwOuts = SrcRotParameterTypeData%NTwOuts - DstRotParameterTypeData%TwOutNd = SrcRotParameterTypeData%TwOutNd - DstRotParameterTypeData%BldNd_NumOuts = SrcRotParameterTypeData%BldNd_NumOuts - DstRotParameterTypeData%BldNd_TotNumOuts = SrcRotParameterTypeData%BldNd_TotNumOuts -IF (ALLOCATED(SrcRotParameterTypeData%BldNd_OutParam)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BldNd_OutParam,1) - i1_u = UBOUND(SrcRotParameterTypeData%BldNd_OutParam,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BldNd_OutParam)) THEN - ALLOCATE(DstRotParameterTypeData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotParameterTypeData%BldNd_OutParam,1), UBOUND(SrcRotParameterTypeData%BldNd_OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcRotParameterTypeData%BldNd_OutParam(i1), DstRotParameterTypeData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BldNd_BlOutNd)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BldNd_BlOutNd,1) - i1_u = UBOUND(SrcRotParameterTypeData%BldNd_BlOutNd,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BldNd_BlOutNd)) THEN - ALLOCATE(DstRotParameterTypeData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BldNd_BlOutNd = SrcRotParameterTypeData%BldNd_BlOutNd -ENDIF - DstRotParameterTypeData%BldNd_BladesOut = SrcRotParameterTypeData%BldNd_BladesOut - DstRotParameterTypeData%TFinAero = SrcRotParameterTypeData%TFinAero - CALL AD_Copytfinparametertype( SrcRotParameterTypeData%TFin, DstRotParameterTypeData%TFin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotParameterType - - SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg ) - TYPE(RotParameterType), INTENT(INOUT) :: RotParameterTypeData - 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 = 'AD_DestroyRotParameterType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(RotParameterTypeData%TwrDiam)) THEN - DEALLOCATE(RotParameterTypeData%TwrDiam) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrCd)) THEN - DEALLOCATE(RotParameterTypeData%TwrCd) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrTI)) THEN - DEALLOCATE(RotParameterTypeData%TwrTI) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlTwist)) THEN - DEALLOCATE(RotParameterTypeData%BlTwist) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrCb)) THEN - DEALLOCATE(RotParameterTypeData%TwrCb) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlCenBn)) THEN - DEALLOCATE(RotParameterTypeData%BlCenBn) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlCenBt)) THEN - DEALLOCATE(RotParameterTypeData%BlCenBt) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlRad)) THEN - DEALLOCATE(RotParameterTypeData%BlRad) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlDL)) THEN - DEALLOCATE(RotParameterTypeData%BlDL) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlTaper)) THEN - DEALLOCATE(RotParameterTypeData%BlTaper) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlAxCent)) THEN - DEALLOCATE(RotParameterTypeData%BlAxCent) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrRad)) THEN - DEALLOCATE(RotParameterTypeData%TwrRad) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrDL)) THEN - DEALLOCATE(RotParameterTypeData%TwrDL) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrTaper)) THEN - DEALLOCATE(RotParameterTypeData%TwrTaper) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrAxCent)) THEN - DEALLOCATE(RotParameterTypeData%TwrAxCent) -ENDIF - CALL BEMT_DestroyParam( RotParameterTypeData%BEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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) -ENDIF -IF (ALLOCATED(RotParameterTypeData%du)) THEN - DEALLOCATE(RotParameterTypeData%du) -ENDIF -IF (ALLOCATED(RotParameterTypeData%dx)) THEN - DEALLOCATE(RotParameterTypeData%dx) -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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotParameterTypeData%BldNd_OutParam) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BldNd_BlOutNd)) THEN - DEALLOCATE(RotParameterTypeData%BldNd_BlOutNd) -ENDIF - CALL AD_DestroyTFinParameterType( RotParameterTypeData%TFin, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotParameterType - - SUBROUTINE AD_PackRotParameterType( 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(RotParameterType), 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 = 'AD_PackRotParameterType' - ! 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 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumBlNds - Int_BufSz = Int_BufSz + 1 ! NumTwrNds - Int_BufSz = Int_BufSz + 1 ! TwrDiam allocated yes/no - IF ( ALLOCATED(InData%TwrDiam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrDiam upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrDiam) ! TwrDiam - END IF - Int_BufSz = Int_BufSz + 1 ! TwrCd allocated yes/no - IF ( ALLOCATED(InData%TwrCd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCd) ! TwrCd - END IF - Int_BufSz = Int_BufSz + 1 ! TwrTI allocated yes/no - IF ( ALLOCATED(InData%TwrTI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrTI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrTI) ! TwrTI - END IF - Int_BufSz = Int_BufSz + 1 ! BlTwist allocated yes/no - IF ( ALLOCATED(InData%BlTwist) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlTwist upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlTwist) ! BlTwist - END IF - Int_BufSz = Int_BufSz + 1 ! TwrCb allocated yes/no - IF ( ALLOCATED(InData%TwrCb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCb) ! TwrCb - END IF - Int_BufSz = Int_BufSz + 1 ! BlCenBn allocated yes/no - IF ( ALLOCATED(InData%BlCenBn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlCenBn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCenBn) ! BlCenBn - END IF - Int_BufSz = Int_BufSz + 1 ! BlCenBt allocated yes/no - IF ( ALLOCATED(InData%BlCenBt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlCenBt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCenBt) ! BlCenBt - END IF - Re_BufSz = Re_BufSz + 1 ! VolHub - Re_BufSz = Re_BufSz + 1 ! HubCenBx - Re_BufSz = Re_BufSz + 1 ! VolNac - Re_BufSz = Re_BufSz + SIZE(InData%NacCenB) ! NacCenB - Re_BufSz = Re_BufSz + 1 ! VolBl - Re_BufSz = Re_BufSz + 1 ! VolTwr - Int_BufSz = Int_BufSz + 1 ! BlRad allocated yes/no - IF ( ALLOCATED(InData%BlRad) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlRad) ! BlRad - END IF - Int_BufSz = Int_BufSz + 1 ! BlDL allocated yes/no - IF ( ALLOCATED(InData%BlDL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlDL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlDL) ! BlDL - END IF - Int_BufSz = Int_BufSz + 1 ! BlTaper allocated yes/no - IF ( ALLOCATED(InData%BlTaper) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlTaper upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlTaper) ! BlTaper - END IF - Int_BufSz = Int_BufSz + 1 ! BlAxCent allocated yes/no - IF ( ALLOCATED(InData%BlAxCent) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlAxCent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlAxCent) ! BlAxCent - END IF - Int_BufSz = Int_BufSz + 1 ! TwrRad allocated yes/no - IF ( ALLOCATED(InData%TwrRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrRad) ! TwrRad - END IF - Int_BufSz = Int_BufSz + 1 ! TwrDL allocated yes/no - IF ( ALLOCATED(InData%TwrDL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrDL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrDL) ! TwrDL - END IF - Int_BufSz = Int_BufSz + 1 ! TwrTaper allocated yes/no - IF ( ALLOCATED(InData%TwrTaper) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrTaper upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrTaper) ! TwrTaper - END IF - Int_BufSz = Int_BufSz + 1 ! TwrAxCent allocated yes/no - IF ( ALLOCATED(InData%TwrAxCent) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrAxCent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrAxCent) ! TwrAxCent - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%du) ! du - END IF - Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no - IF ( ALLOCATED(InData%dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dx) ! dx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! NumBl_Lin - Int_BufSz = Int_BufSz + 1 ! TwrPotent - Int_BufSz = Int_BufSz + 1 ! TwrShadow - Int_BufSz = Int_BufSz + 1 ! TwrAero - Int_BufSz = Int_BufSz + 1 ! FrozenWake - Int_BufSz = Int_BufSz + 1 ! CavitCheck - Int_BufSz = Int_BufSz + 1 ! Buoyancy - Int_BufSz = Int_BufSz + 1 ! MHK - Int_BufSz = Int_BufSz + 1 ! CompAA - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! Patm - Re_BufSz = Re_BufSz + 1 ! Pvap - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! AeroProjMod - Int_BufSz = Int_BufSz + 1 ! AeroBEM_Mod - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - 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 - 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 ! NBlOuts - Int_BufSz = Int_BufSz + SIZE(InData%BlOutNd) ! BlOutNd - Int_BufSz = Int_BufSz + 1 ! NTwOuts - Int_BufSz = Int_BufSz + SIZE(InData%TwOutNd) ! TwOutNd - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no - IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFin - 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 - - IntKiBuf(Int_Xferred) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTwrNds - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TwrDiam) ) 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%TwrDiam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) - ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrCd) ) 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%TwrCd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrCd,1), UBOUND(InData%TwrCd,1) - ReKiBuf(Re_Xferred) = InData%TwrCd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrTI) ) 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%TwrTI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrTI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrTI,1), UBOUND(InData%TwrTI,1) - ReKiBuf(Re_Xferred) = InData%TwrTI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlTwist) ) 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%BlTwist,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTwist,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlTwist,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTwist,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlTwist,2), UBOUND(InData%BlTwist,2) - DO i1 = LBOUND(InData%BlTwist,1), UBOUND(InData%BlTwist,1) - ReKiBuf(Re_Xferred) = InData%BlTwist(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrCb) ) 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%TwrCb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrCb,1), UBOUND(InData%TwrCb,1) - ReKiBuf(Re_Xferred) = InData%TwrCb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCenBn) ) 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%BlCenBn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCenBn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlCenBn,2), UBOUND(InData%BlCenBn,2) - DO i1 = LBOUND(InData%BlCenBn,1), UBOUND(InData%BlCenBn,1) - ReKiBuf(Re_Xferred) = InData%BlCenBn(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCenBt) ) 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%BlCenBt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCenBt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlCenBt,2), UBOUND(InData%BlCenBt,2) - DO i1 = LBOUND(InData%BlCenBt,1), UBOUND(InData%BlCenBt,1) - ReKiBuf(Re_Xferred) = InData%BlCenBt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%VolHub - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubCenBx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VolNac - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%NacCenB,1), UBOUND(InData%NacCenB,1) - ReKiBuf(Re_Xferred) = InData%NacCenB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%VolBl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VolTwr - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlRad) ) 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%BlRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlRad,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlRad,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlRad,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlRad,2), UBOUND(InData%BlRad,2) - DO i1 = LBOUND(InData%BlRad,1), UBOUND(InData%BlRad,1) - ReKiBuf(Re_Xferred) = InData%BlRad(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlDL) ) 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%BlDL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlDL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlDL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlDL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlDL,2), UBOUND(InData%BlDL,2) - DO i1 = LBOUND(InData%BlDL,1), UBOUND(InData%BlDL,1) - ReKiBuf(Re_Xferred) = InData%BlDL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlTaper) ) 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%BlTaper,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTaper,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlTaper,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTaper,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlTaper,2), UBOUND(InData%BlTaper,2) - DO i1 = LBOUND(InData%BlTaper,1), UBOUND(InData%BlTaper,1) - ReKiBuf(Re_Xferred) = InData%BlTaper(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlAxCent) ) 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%BlAxCent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAxCent,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAxCent,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAxCent,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlAxCent,2), UBOUND(InData%BlAxCent,2) - DO i1 = LBOUND(InData%BlAxCent,1), UBOUND(InData%BlAxCent,1) - ReKiBuf(Re_Xferred) = InData%BlAxCent(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrRad) ) 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%TwrRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrRad,1), UBOUND(InData%TwrRad,1) - ReKiBuf(Re_Xferred) = InData%TwrRad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrDL) ) 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%TwrDL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrDL,1), UBOUND(InData%TwrDL,1) - ReKiBuf(Re_Xferred) = InData%TwrDL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrTaper) ) 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%TwrTaper,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrTaper,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrTaper,1), UBOUND(InData%TwrTaper,1) - ReKiBuf(Re_Xferred) = InData%TwrTaper(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrAxCent) ) 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%TwrAxCent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAxCent,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrAxCent,1), UBOUND(InData%TwrAxCent,1) - ReKiBuf(Re_Xferred) = InData%TwrAxCent(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL BEMT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - 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 - CALL AA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - 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 - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) 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%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%du) ) 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%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - ReKiBuf(Re_Xferred) = InData%du(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dx) ) 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%dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - ReKiBuf(Re_Xferred) = InData%dx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl_Lin - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrPotent - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrShadow - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrAero, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FrozenWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitCheck, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Buoyancy, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CompAA, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AeroProjMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AeroBEM_Mod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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%NBlOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%BlOutNd,1), UBOUND(InData%BlOutNd,1) - IntKiBuf(Int_Xferred) = InData%BlOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NTwOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TwOutNd,1), UBOUND(InData%TwOutNd,1) - IntKiBuf(Int_Xferred) = InData%TwOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_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%BldNd_OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) 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%BldNd_BlOutNd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) - IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut - 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 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 AD_PackRotParameterType - - SUBROUTINE AD_UnPackRotParameterType( 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(RotParameterType), 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 = 'AD_UnPackRotParameterType' - ! 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%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumTwrNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam 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%TwrDiam)) DEALLOCATE(OutData%TwrDiam) - ALLOCATE(OutData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) - OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCd 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%TwrCd)) DEALLOCATE(OutData%TwrCd) - ALLOCATE(OutData%TwrCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrCd,1), UBOUND(OutData%TwrCd,1) - OutData%TwrCd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrTI 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%TwrTI)) DEALLOCATE(OutData%TwrTI) - ALLOCATE(OutData%TwrTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrTI,1), UBOUND(OutData%TwrTI,1) - OutData%TwrTI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlTwist 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%BlTwist)) DEALLOCATE(OutData%BlTwist) - ALLOCATE(OutData%BlTwist(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlTwist,2), UBOUND(OutData%BlTwist,2) - DO i1 = LBOUND(OutData%BlTwist,1), UBOUND(OutData%BlTwist,1) - OutData%BlTwist(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCb 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%TwrCb)) DEALLOCATE(OutData%TwrCb) - ALLOCATE(OutData%TwrCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrCb,1), UBOUND(OutData%TwrCb,1) - OutData%TwrCb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCenBn 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%BlCenBn)) DEALLOCATE(OutData%BlCenBn) - ALLOCATE(OutData%BlCenBn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlCenBn,2), UBOUND(OutData%BlCenBn,2) - DO i1 = LBOUND(OutData%BlCenBn,1), UBOUND(OutData%BlCenBn,1) - OutData%BlCenBn(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCenBt 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%BlCenBt)) DEALLOCATE(OutData%BlCenBt) - ALLOCATE(OutData%BlCenBt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlCenBt,2), UBOUND(OutData%BlCenBt,2) - DO i1 = LBOUND(OutData%BlCenBt,1), UBOUND(OutData%BlCenBt,1) - OutData%BlCenBt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%VolHub = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubCenBx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VolNac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%NacCenB,1) - i1_u = UBOUND(OutData%NacCenB,1) - DO i1 = LBOUND(OutData%NacCenB,1), UBOUND(OutData%NacCenB,1) - OutData%NacCenB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%VolBl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VolTwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlRad 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%BlRad)) DEALLOCATE(OutData%BlRad) - ALLOCATE(OutData%BlRad(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlRad,2), UBOUND(OutData%BlRad,2) - DO i1 = LBOUND(OutData%BlRad,1), UBOUND(OutData%BlRad,1) - OutData%BlRad(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlDL 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%BlDL)) DEALLOCATE(OutData%BlDL) - ALLOCATE(OutData%BlDL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlDL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlDL,2), UBOUND(OutData%BlDL,2) - DO i1 = LBOUND(OutData%BlDL,1), UBOUND(OutData%BlDL,1) - OutData%BlDL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlTaper 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%BlTaper)) DEALLOCATE(OutData%BlTaper) - ALLOCATE(OutData%BlTaper(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTaper.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlTaper,2), UBOUND(OutData%BlTaper,2) - DO i1 = LBOUND(OutData%BlTaper,1), UBOUND(OutData%BlTaper,1) - OutData%BlTaper(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAxCent 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%BlAxCent)) DEALLOCATE(OutData%BlAxCent) - ALLOCATE(OutData%BlAxCent(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAxCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlAxCent,2), UBOUND(OutData%BlAxCent,2) - DO i1 = LBOUND(OutData%BlAxCent,1), UBOUND(OutData%BlAxCent,1) - OutData%BlAxCent(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrRad 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%TwrRad)) DEALLOCATE(OutData%TwrRad) - ALLOCATE(OutData%TwrRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrRad,1), UBOUND(OutData%TwrRad,1) - OutData%TwrRad(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDL 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%TwrDL)) DEALLOCATE(OutData%TwrDL) - ALLOCATE(OutData%TwrDL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrDL,1), UBOUND(OutData%TwrDL,1) - OutData%TwrDL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrTaper 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%TwrTaper)) DEALLOCATE(OutData%TwrTaper) - ALLOCATE(OutData%TwrTaper(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTaper.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrTaper,1), UBOUND(OutData%TwrTaper,1) - OutData%TwrTaper(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrAxCent 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%TwrAxCent)) DEALLOCATE(OutData%TwrAxCent) - ALLOCATE(OutData%TwrAxCent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrAxCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrAxCent,1), UBOUND(OutData%TwrAxCent,1) - OutData%TwrAxCent(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 BEMT_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - 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) - 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 AA_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx 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%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du 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%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx 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%dx)) DEALLOCATE(OutData%dx) - ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBl_Lin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrAero) - Int_Xferred = Int_Xferred + 1 - OutData%FrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FrozenWake) - Int_Xferred = Int_Xferred + 1 - OutData%CavitCheck = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitCheck) - Int_Xferred = Int_Xferred + 1 - OutData%Buoyancy = TRANSFER(IntKiBuf(Int_Xferred), OutData%Buoyancy) - Int_Xferred = Int_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompAA = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompAA) - Int_Xferred = Int_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = 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%AeroProjMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AeroBEM_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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%NBlOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%BlOutNd,1) - i1_u = UBOUND(OutData%BlOutNd,1) - DO i1 = LBOUND(OutData%BlOutNd,1), UBOUND(OutData%BlOutNd,1) - OutData%BlOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NTwOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TwOutNd,1) - i1_u = UBOUND(OutData%TwOutNd,1) - DO i1 = LBOUND(OutData%TwOutNd,1), UBOUND(OutData%TwOutNd,1) - OutData%TwOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_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%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) - ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_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%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_BlOutNd 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%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) - ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) - OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFinAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TFinAero) - 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 AD_UnpackTFinParameterType( Re_Buf, Db_Buf, Int_Buf, OutData%TFin, ErrStat2, ErrMsg2 ) ! TFin - 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 AD_UnPackRotParameterType - SUBROUTINE AD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyParam' -! +subroutine AD_CopyTFinParameterType(SrcTFinParameterTypeData, DstTFinParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(TFinParameterType), intent(in) :: SrcTFinParameterTypeData + type(TFinParameterType), intent(inout) :: DstTFinParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_CopyTFinParameterType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcParamData%rotors)) THEN - i1_l = LBOUND(SrcParamData%rotors,1) - i1_u = UBOUND(SrcParamData%rotors,1) - IF (.NOT. ALLOCATED(DstParamData%rotors)) THEN - ALLOCATE(DstParamData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%rotors,1), UBOUND(SrcParamData%rotors,1) - CALL AD_Copyrotparametertype( SrcParamData%rotors(i1), DstParamData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%DT = SrcParamData%DT - DstParamData%RootName = SrcParamData%RootName -IF (ALLOCATED(SrcParamData%AFI)) THEN - i1_l = LBOUND(SrcParamData%AFI,1) - i1_u = UBOUND(SrcParamData%AFI,1) - IF (.NOT. ALLOCATED(DstParamData%AFI)) THEN - ALLOCATE(DstParamData%AFI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%AFI,1), UBOUND(SrcParamData%AFI,1) - CALL AFI_CopyParam( SrcParamData%AFI(i1), DstParamData%AFI(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%SkewMod = SrcParamData%SkewMod - DstParamData%WakeMod = SrcParamData%WakeMod - CALL FVW_CopyParam( SrcParamData%FVW, DstParamData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps - DstParamData%UA_Flag = SrcParamData%UA_Flag - DstParamData%FlowField => SrcParamData%FlowField - END SUBROUTINE AD_CopyParam - - SUBROUTINE AD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(AD_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 = 'AD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%rotors)) THEN -DO i1 = LBOUND(ParamData%rotors,1), UBOUND(ParamData%rotors,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%AFI) -ENDIF - CALL FVW_DestroyParam( ParamData%FVW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -NULLIFY(ParamData%FlowField) - END SUBROUTINE AD_DestroyParam - - SUBROUTINE AD_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(AD_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 = 'AD_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 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! AFI allocated yes/no - IF ( ALLOCATED(InData%AFI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AFI upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AFI,1), UBOUND(InData%AFI,1) - Int_BufSz = Int_BufSz + 3 ! AFI: size of buffers for each call to pack subtype - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFI(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AFI - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AFI - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AFI - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AFI - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SkewMod - Int_BufSz = Int_BufSz + 1 ! WakeMod - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CompAeroMaps - Int_BufSz = Int_BufSz + 1 ! UA_Flag - 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%rotors) ) 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%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - 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 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 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%AFI) ) 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%AFI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AFI,1), UBOUND(InData%AFI,1) - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFI(i1), ErrStat2, ErrMsg2, OnlySize ) ! AFI - 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%SkewMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WakeMod - Int_Xferred = Int_Xferred + 1 - CALL FVW_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - 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) = TRANSFER(InData%CompAeroMaps, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_PackParam - - SUBROUTINE AD_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(AD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors 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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 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 - - 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%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFI 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%AFI)) DEALLOCATE(OutData%AFI) - ALLOCATE(OutData%AFI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AFI,1), UBOUND(OutData%AFI,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 AFI_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AFI(i1), ErrStat2, ErrMsg2 ) ! AFI - 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%SkewMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakeMod = 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 FVW_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - 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%CompAeroMaps = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompAeroMaps) - Int_Xferred = Int_Xferred + 1 - OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) - Int_Xferred = Int_Xferred + 1 - NULLIFY(OutData%FlowField) - END SUBROUTINE AD_UnPackParam - - SUBROUTINE AD_CopyRotInputType( SrcRotInputTypeData, DstRotInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotInputType), INTENT(INOUT) :: SrcRotInputTypeData - TYPE(RotInputType), INTENT(INOUT) :: DstRotInputTypeData - 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 = 'AD_CopyRotInputType' -! + ErrMsg = '' + DstTFinParameterTypeData%TFinMod = SrcTFinParameterTypeData%TFinMod + DstTFinParameterTypeData%TFinChord = SrcTFinParameterTypeData%TFinChord + DstTFinParameterTypeData%TFinArea = SrcTFinParameterTypeData%TFinArea + DstTFinParameterTypeData%TFinIndMod = SrcTFinParameterTypeData%TFinIndMod + DstTFinParameterTypeData%TFinAFID = SrcTFinParameterTypeData%TFinAFID +end subroutine + +subroutine AD_DestroyTFinParameterType(TFinParameterTypeData, ErrStat, ErrMsg) + type(TFinParameterType), intent(inout) :: TFinParameterTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyTFinParameterType' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcRotInputTypeData%NacelleMotion, DstRotInputTypeData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotInputTypeData%TowerMotion, DstRotInputTypeData%TowerMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotInputTypeData%HubMotion, DstRotInputTypeData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotInputTypeData%BladeRootMotion)) THEN - i1_l = LBOUND(SrcRotInputTypeData%BladeRootMotion,1) - i1_u = UBOUND(SrcRotInputTypeData%BladeRootMotion,1) - IF (.NOT. ALLOCATED(DstRotInputTypeData%BladeRootMotion)) THEN - ALLOCATE(DstRotInputTypeData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInputTypeData%BladeRootMotion,1), UBOUND(SrcRotInputTypeData%BladeRootMotion,1) - CALL MeshCopy( SrcRotInputTypeData%BladeRootMotion(i1), DstRotInputTypeData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotInputTypeData%BladeMotion)) THEN - i1_l = LBOUND(SrcRotInputTypeData%BladeMotion,1) - i1_u = UBOUND(SrcRotInputTypeData%BladeMotion,1) - IF (.NOT. ALLOCATED(DstRotInputTypeData%BladeMotion)) THEN - ALLOCATE(DstRotInputTypeData%BladeMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInputTypeData%BladeMotion,1), UBOUND(SrcRotInputTypeData%BladeMotion,1) - CALL MeshCopy( SrcRotInputTypeData%BladeMotion(i1), DstRotInputTypeData%BladeMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcRotInputTypeData%TFinMotion, DstRotInputTypeData%TFinMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotInputTypeData%InflowOnBlade)) THEN - i1_l = LBOUND(SrcRotInputTypeData%InflowOnBlade,1) - i1_u = UBOUND(SrcRotInputTypeData%InflowOnBlade,1) - i2_l = LBOUND(SrcRotInputTypeData%InflowOnBlade,2) - i2_u = UBOUND(SrcRotInputTypeData%InflowOnBlade,2) - i3_l = LBOUND(SrcRotInputTypeData%InflowOnBlade,3) - i3_u = UBOUND(SrcRotInputTypeData%InflowOnBlade,3) - IF (.NOT. ALLOCATED(DstRotInputTypeData%InflowOnBlade)) THEN - ALLOCATE(DstRotInputTypeData%InflowOnBlade(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%InflowOnBlade.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputTypeData%InflowOnBlade = SrcRotInputTypeData%InflowOnBlade -ENDIF -IF (ALLOCATED(SrcRotInputTypeData%InflowOnTower)) THEN - i1_l = LBOUND(SrcRotInputTypeData%InflowOnTower,1) - i1_u = UBOUND(SrcRotInputTypeData%InflowOnTower,1) - i2_l = LBOUND(SrcRotInputTypeData%InflowOnTower,2) - i2_u = UBOUND(SrcRotInputTypeData%InflowOnTower,2) - IF (.NOT. ALLOCATED(DstRotInputTypeData%InflowOnTower)) THEN - ALLOCATE(DstRotInputTypeData%InflowOnTower(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%InflowOnTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputTypeData%InflowOnTower = SrcRotInputTypeData%InflowOnTower -ENDIF - DstRotInputTypeData%InflowOnHub = SrcRotInputTypeData%InflowOnHub - DstRotInputTypeData%InflowOnNacelle = SrcRotInputTypeData%InflowOnNacelle - DstRotInputTypeData%InflowOnTailFin = SrcRotInputTypeData%InflowOnTailFin -IF (ALLOCATED(SrcRotInputTypeData%UserProp)) THEN - i1_l = LBOUND(SrcRotInputTypeData%UserProp,1) - i1_u = UBOUND(SrcRotInputTypeData%UserProp,1) - i2_l = LBOUND(SrcRotInputTypeData%UserProp,2) - i2_u = UBOUND(SrcRotInputTypeData%UserProp,2) - IF (.NOT. ALLOCATED(DstRotInputTypeData%UserProp)) THEN - ALLOCATE(DstRotInputTypeData%UserProp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%UserProp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputTypeData%UserProp = SrcRotInputTypeData%UserProp -ENDIF - END SUBROUTINE AD_CopyRotInputType - - SUBROUTINE AD_DestroyRotInputType( RotInputTypeData, ErrStat, ErrMsg ) - TYPE(RotInputType), INTENT(INOUT) :: RotInputTypeData - 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 = 'AD_DestroyRotInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( RotInputTypeData%NacelleMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotInputTypeData%TowerMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotInputTypeData%HubMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotInputTypeData%BladeRootMotion)) THEN -DO i1 = LBOUND(RotInputTypeData%BladeRootMotion,1), UBOUND(RotInputTypeData%BladeRootMotion,1) - CALL MeshDestroy( RotInputTypeData%BladeRootMotion(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotInputTypeData%BladeRootMotion) -ENDIF -IF (ALLOCATED(RotInputTypeData%BladeMotion)) THEN -DO i1 = LBOUND(RotInputTypeData%BladeMotion,1), UBOUND(RotInputTypeData%BladeMotion,1) - CALL MeshDestroy( RotInputTypeData%BladeMotion(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotInputTypeData%BladeMotion) -ENDIF - CALL MeshDestroy( RotInputTypeData%TFinMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotInputTypeData%InflowOnBlade)) THEN - DEALLOCATE(RotInputTypeData%InflowOnBlade) -ENDIF -IF (ALLOCATED(RotInputTypeData%InflowOnTower)) THEN - DEALLOCATE(RotInputTypeData%InflowOnTower) -ENDIF -IF (ALLOCATED(RotInputTypeData%UserProp)) THEN - DEALLOCATE(RotInputTypeData%UserProp) -ENDIF - END SUBROUTINE AD_DestroyRotInputType - - SUBROUTINE AD_PackRotInputType( 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(RotInputType), 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 = 'AD_PackRotInputType' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! NacelleMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NacelleMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NacelleMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NacelleMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TowerMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%TowerMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TowerMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TowerMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TowerMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootMotion allocated yes/no - IF ( ALLOCATED(InData%BladeRootMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeRootMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - Int_BufSz = Int_BufSz + 3 ! BladeRootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeRootMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeRootMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeRootMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BladeMotion allocated yes/no - IF ( ALLOCATED(InData%BladeMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeMotion,1), UBOUND(InData%BladeMotion,1) - Int_BufSz = Int_BufSz + 3 ! BladeMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! TFinMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%TFinMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TFinMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFinMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFinMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFinMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! InflowOnBlade allocated yes/no - IF ( ALLOCATED(InData%InflowOnBlade) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! InflowOnBlade upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InflowOnBlade) ! InflowOnBlade - END IF - Int_BufSz = Int_BufSz + 1 ! InflowOnTower allocated yes/no - IF ( ALLOCATED(InData%InflowOnTower) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InflowOnTower upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InflowOnTower) ! InflowOnTower - END IF - Re_BufSz = Re_BufSz + SIZE(InData%InflowOnHub) ! InflowOnHub - Re_BufSz = Re_BufSz + SIZE(InData%InflowOnNacelle) ! InflowOnNacelle - Re_BufSz = Re_BufSz + SIZE(InData%InflowOnTailFin) ! InflowOnTailFin - Int_BufSz = Int_BufSz + 1 ! UserProp allocated yes/no - IF ( ALLOCATED(InData%UserProp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! UserProp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UserProp) ! UserProp - 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 - - CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleMotion - 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 - CALL MeshPack( InData%TowerMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerMotion - 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 - CALL MeshPack( InData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubMotion - 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 - IF ( .NOT. ALLOCATED(InData%BladeRootMotion) ) 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%BladeRootMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootMotion,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootMotion - 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 - IF ( .NOT. ALLOCATED(InData%BladeMotion) ) 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%BladeMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeMotion,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeMotion,1), UBOUND(InData%BladeMotion,1) - CALL MeshPack( InData%BladeMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeMotion - 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 - CALL MeshPack( InData%TFinMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TFinMotion - 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 - IF ( .NOT. ALLOCATED(InData%InflowOnBlade) ) 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%InflowOnBlade,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnBlade,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowOnBlade,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnBlade,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowOnBlade,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnBlade,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%InflowOnBlade,3), UBOUND(InData%InflowOnBlade,3) - DO i2 = LBOUND(InData%InflowOnBlade,2), UBOUND(InData%InflowOnBlade,2) - DO i1 = LBOUND(InData%InflowOnBlade,1), UBOUND(InData%InflowOnBlade,1) - ReKiBuf(Re_Xferred) = InData%InflowOnBlade(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InflowOnTower) ) 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%InflowOnTower,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnTower,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowOnTower,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnTower,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InflowOnTower,2), UBOUND(InData%InflowOnTower,2) - DO i1 = LBOUND(InData%InflowOnTower,1), UBOUND(InData%InflowOnTower,1) - ReKiBuf(Re_Xferred) = InData%InflowOnTower(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%InflowOnHub,1), UBOUND(InData%InflowOnHub,1) - ReKiBuf(Re_Xferred) = InData%InflowOnHub(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%InflowOnNacelle,1), UBOUND(InData%InflowOnNacelle,1) - ReKiBuf(Re_Xferred) = InData%InflowOnNacelle(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%InflowOnTailFin,1), UBOUND(InData%InflowOnTailFin,1) - ReKiBuf(Re_Xferred) = InData%InflowOnTailFin(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%UserProp) ) 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%UserProp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UserProp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%UserProp,2), UBOUND(InData%UserProp,2) - DO i1 = LBOUND(InData%UserProp,1), UBOUND(InData%UserProp,1) - ReKiBuf(Re_Xferred) = InData%UserProp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_PackRotInputType - - SUBROUTINE AD_UnPackRotInputType( 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(RotInputType), 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 = 'AD_UnPackRotInputType' - ! 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 - 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 MeshUnpack( OutData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleMotion - 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) - 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 MeshUnpack( OutData%TowerMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerMotion - 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) - 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 MeshUnpack( OutData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubMotion - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootMotion 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%BladeRootMotion)) DEALLOCATE(OutData%BladeRootMotion) - ALLOCATE(OutData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeRootMotion,1), UBOUND(OutData%BladeRootMotion,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 MeshUnpack( OutData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootMotion - 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 ! BladeMotion 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%BladeMotion)) DEALLOCATE(OutData%BladeMotion) - ALLOCATE(OutData%BladeMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeMotion,1), UBOUND(OutData%BladeMotion,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 MeshUnpack( OutData%BladeMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeMotion - 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 - 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 MeshUnpack( OutData%TFinMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TFinMotion - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InflowOnBlade 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%InflowOnBlade)) DEALLOCATE(OutData%InflowOnBlade) - ALLOCATE(OutData%InflowOnBlade(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%InflowOnBlade.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%InflowOnBlade,3), UBOUND(OutData%InflowOnBlade,3) - DO i2 = LBOUND(OutData%InflowOnBlade,2), UBOUND(OutData%InflowOnBlade,2) - DO i1 = LBOUND(OutData%InflowOnBlade,1), UBOUND(OutData%InflowOnBlade,1) - OutData%InflowOnBlade(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InflowOnTower 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%InflowOnTower)) DEALLOCATE(OutData%InflowOnTower) - ALLOCATE(OutData%InflowOnTower(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InflowOnTower,2), UBOUND(OutData%InflowOnTower,2) - DO i1 = LBOUND(OutData%InflowOnTower,1), UBOUND(OutData%InflowOnTower,1) - OutData%InflowOnTower(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%InflowOnHub,1) - i1_u = UBOUND(OutData%InflowOnHub,1) - DO i1 = LBOUND(OutData%InflowOnHub,1), UBOUND(OutData%InflowOnHub,1) - OutData%InflowOnHub(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%InflowOnNacelle,1) - i1_u = UBOUND(OutData%InflowOnNacelle,1) - DO i1 = LBOUND(OutData%InflowOnNacelle,1), UBOUND(OutData%InflowOnNacelle,1) - OutData%InflowOnNacelle(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%InflowOnTailFin,1) - i1_u = UBOUND(OutData%InflowOnTailFin,1) - DO i1 = LBOUND(OutData%InflowOnTailFin,1), UBOUND(OutData%InflowOnTailFin,1) - OutData%InflowOnTailFin(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserProp 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%UserProp)) DEALLOCATE(OutData%UserProp) - ALLOCATE(OutData%UserProp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%UserProp,2), UBOUND(OutData%UserProp,2) - DO i1 = LBOUND(OutData%UserProp,1), UBOUND(OutData%UserProp,1) - OutData%UserProp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_UnPackRotInputType - - SUBROUTINE AD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(AD_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) :: 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 = 'AD_CopyInput' -! + ErrMsg = '' +end subroutine + +subroutine AD_PackTFinParameterType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TFinParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackTFinParameterType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%TFinMod) + call RegPack(Buf, InData%TFinChord) + call RegPack(Buf, InData%TFinArea) + call RegPack(Buf, InData%TFinIndMod) + call RegPack(Buf, InData%TFinAFID) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackTFinParameterType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TFinParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackTFinParameterType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%TFinMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinChord) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinArea) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinIndMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinAFID) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_CopyTFinInputFileType(SrcTFinInputFileTypeData, DstTFinInputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(TFinInputFileType), intent(in) :: SrcTFinInputFileTypeData + type(TFinInputFileType), intent(inout) :: DstTFinInputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_CopyTFinInputFileType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%rotors)) THEN - i1_l = LBOUND(SrcInputData%rotors,1) - i1_u = UBOUND(SrcInputData%rotors,1) - IF (.NOT. ALLOCATED(DstInputData%rotors)) THEN - ALLOCATE(DstInputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%rotors,1), UBOUND(SrcInputData%rotors,1) - CALL AD_Copyrotinputtype( SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%InflowWakeVel)) THEN - i1_l = LBOUND(SrcInputData%InflowWakeVel,1) - i1_u = UBOUND(SrcInputData%InflowWakeVel,1) - i2_l = LBOUND(SrcInputData%InflowWakeVel,2) - i2_u = UBOUND(SrcInputData%InflowWakeVel,2) - IF (.NOT. ALLOCATED(DstInputData%InflowWakeVel)) THEN - ALLOCATE(DstInputData%InflowWakeVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InflowWakeVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%InflowWakeVel = SrcInputData%InflowWakeVel -ENDIF - END SUBROUTINE AD_CopyInput - - SUBROUTINE AD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(AD_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 = 'AD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%rotors)) THEN -DO i1 = LBOUND(InputData%rotors,1), UBOUND(InputData%rotors,1) - CALL AD_DestroyRotInputType( InputData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%rotors) -ENDIF -IF (ALLOCATED(InputData%InflowWakeVel)) THEN - DEALLOCATE(InputData%InflowWakeVel) -ENDIF - END SUBROUTINE AD_DestroyInput - - SUBROUTINE AD_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(AD_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 = 'AD_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 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InflowWakeVel allocated yes/no - IF ( ALLOCATED(InData%InflowWakeVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InflowWakeVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InflowWakeVel) ! InflowWakeVel - 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%rotors) ) 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%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%InflowWakeVel) ) 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%InflowWakeVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowWakeVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowWakeVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowWakeVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InflowWakeVel,2), UBOUND(InData%InflowWakeVel,2) - DO i1 = LBOUND(InData%InflowWakeVel,1), UBOUND(InData%InflowWakeVel,1) - ReKiBuf(Re_Xferred) = InData%InflowWakeVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_PackInput - - SUBROUTINE AD_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(AD_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) :: 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 = 'AD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors 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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 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 - - 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 ! InflowWakeVel 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%InflowWakeVel)) DEALLOCATE(OutData%InflowWakeVel) - ALLOCATE(OutData%InflowWakeVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowWakeVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InflowWakeVel,2), UBOUND(OutData%InflowWakeVel,2) - DO i1 = LBOUND(OutData%InflowWakeVel,1), UBOUND(OutData%InflowWakeVel,1) - OutData%InflowWakeVel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_UnPackInput - - SUBROUTINE AD_CopyRotOutputType( SrcRotOutputTypeData, DstRotOutputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotOutputType), INTENT(INOUT) :: SrcRotOutputTypeData - TYPE(RotOutputType), INTENT(INOUT) :: DstRotOutputTypeData - 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 = 'AD_CopyRotOutputType' -! + ErrMsg = '' + DstTFinInputFileTypeData%TFinMod = SrcTFinInputFileTypeData%TFinMod + DstTFinInputFileTypeData%TFinChord = SrcTFinInputFileTypeData%TFinChord + DstTFinInputFileTypeData%TFinArea = SrcTFinInputFileTypeData%TFinArea + DstTFinInputFileTypeData%TFinRefP_n = SrcTFinInputFileTypeData%TFinRefP_n + DstTFinInputFileTypeData%TFinAngles = SrcTFinInputFileTypeData%TFinAngles + DstTFinInputFileTypeData%TFinIndMod = SrcTFinInputFileTypeData%TFinIndMod + DstTFinInputFileTypeData%TFinAFID = SrcTFinInputFileTypeData%TFinAFID +end subroutine + +subroutine AD_DestroyTFinInputFileType(TFinInputFileTypeData, ErrStat, ErrMsg) + type(TFinInputFileType), intent(inout) :: TFinInputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyTFinInputFileType' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcRotOutputTypeData%NacelleLoad, DstRotOutputTypeData%NacelleLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotOutputTypeData%HubLoad, DstRotOutputTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotOutputTypeData%TowerLoad, DstRotOutputTypeData%TowerLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotOutputTypeData%BladeLoad)) THEN - i1_l = LBOUND(SrcRotOutputTypeData%BladeLoad,1) - i1_u = UBOUND(SrcRotOutputTypeData%BladeLoad,1) - IF (.NOT. ALLOCATED(DstRotOutputTypeData%BladeLoad)) THEN - ALLOCATE(DstRotOutputTypeData%BladeLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%BladeLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotOutputTypeData%BladeLoad,1), UBOUND(SrcRotOutputTypeData%BladeLoad,1) - CALL MeshCopy( SrcRotOutputTypeData%BladeLoad(i1), DstRotOutputTypeData%BladeLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcRotOutputTypeData%TFinLoad, DstRotOutputTypeData%TFinLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotOutputTypeData%WriteOutput)) THEN - i1_l = LBOUND(SrcRotOutputTypeData%WriteOutput,1) - i1_u = UBOUND(SrcRotOutputTypeData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstRotOutputTypeData%WriteOutput)) THEN - ALLOCATE(DstRotOutputTypeData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotOutputTypeData%WriteOutput = SrcRotOutputTypeData%WriteOutput -ENDIF - END SUBROUTINE AD_CopyRotOutputType - - SUBROUTINE AD_DestroyRotOutputType( RotOutputTypeData, ErrStat, ErrMsg ) - TYPE(RotOutputType), INTENT(INOUT) :: RotOutputTypeData - 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 = 'AD_DestroyRotOutputType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( RotOutputTypeData%NacelleLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotOutputTypeData%HubLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotOutputTypeData%TowerLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotOutputTypeData%BladeLoad)) THEN -DO i1 = LBOUND(RotOutputTypeData%BladeLoad,1), UBOUND(RotOutputTypeData%BladeLoad,1) - CALL MeshDestroy( RotOutputTypeData%BladeLoad(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotOutputTypeData%BladeLoad) -ENDIF - CALL MeshDestroy( RotOutputTypeData%TFinLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotOutputTypeData%WriteOutput)) THEN - DEALLOCATE(RotOutputTypeData%WriteOutput) -ENDIF - END SUBROUTINE AD_DestroyRotOutputType - - SUBROUTINE AD_PackRotOutputType( 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(RotOutputType), 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 = 'AD_PackRotOutputType' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! NacelleLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%NacelleLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NacelleLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NacelleLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NacelleLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TowerLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%TowerLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TowerLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TowerLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TowerLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BladeLoad allocated yes/no - IF ( ALLOCATED(InData%BladeLoad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeLoad upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeLoad,1), UBOUND(InData%BladeLoad,1) - Int_BufSz = Int_BufSz + 3 ! BladeLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! TFinLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%TFinLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TFinLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFinLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFinLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFinLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 - - CALL MeshPack( InData%NacelleLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleLoad - 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 - CALL MeshPack( InData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubLoad - 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 - CALL MeshPack( InData%TowerLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerLoad - 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 - IF ( .NOT. ALLOCATED(InData%BladeLoad) ) 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%BladeLoad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeLoad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeLoad,1), UBOUND(InData%BladeLoad,1) - CALL MeshPack( InData%BladeLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeLoad - 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 - CALL MeshPack( InData%TFinLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TFinLoad - 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 - 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 AD_PackRotOutputType - - SUBROUTINE AD_UnPackRotOutputType( 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(RotOutputType), 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 = 'AD_UnPackRotOutputType' - ! 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 - 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 MeshUnpack( OutData%NacelleLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleLoad - 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) - 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 MeshUnpack( OutData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubLoad - 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) - 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 MeshUnpack( OutData%TowerLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerLoad - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeLoad 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%BladeLoad)) DEALLOCATE(OutData%BladeLoad) - ALLOCATE(OutData%BladeLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeLoad,1), UBOUND(OutData%BladeLoad,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 MeshUnpack( OutData%BladeLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeLoad - 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 - 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 MeshUnpack( OutData%TFinLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TFinLoad - 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) - 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 AD_UnPackRotOutputType - - SUBROUTINE AD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(AD_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 = 'AD_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine AD_PackTFinInputFileType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TFinInputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackTFinInputFileType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%TFinMod) + call RegPack(Buf, InData%TFinChord) + call RegPack(Buf, InData%TFinArea) + call RegPack(Buf, InData%TFinRefP_n) + call RegPack(Buf, InData%TFinAngles) + call RegPack(Buf, InData%TFinIndMod) + call RegPack(Buf, InData%TFinAFID) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackTFinInputFileType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TFinInputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackTFinInputFileType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%TFinMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinChord) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinArea) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinRefP_n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinAngles) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinIndMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinAFID) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg) + type(AD_VTK_BLSurfaceType), intent(in) :: SrcVTK_BLSurfaceTypeData + type(AD_VTK_BLSurfaceType), intent(inout) :: DstVTK_BLSurfaceTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_CopyVTK_BLSurfaceType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%rotors)) THEN - i1_l = LBOUND(SrcOutputData%rotors,1) - i1_u = UBOUND(SrcOutputData%rotors,1) - IF (.NOT. ALLOCATED(DstOutputData%rotors)) THEN - ALLOCATE(DstOutputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%rotors,1), UBOUND(SrcOutputData%rotors,1) - CALL AD_Copyrotoutputtype( SrcOutputData%rotors(i1), DstOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AD_CopyOutput - - SUBROUTINE AD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(AD_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 = 'AD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%rotors)) THEN -DO i1 = LBOUND(OutputData%rotors,1), UBOUND(OutputData%rotors,1) - CALL AD_DestroyRotOutputType( OutputData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%rotors) -ENDIF - END SUBROUTINE AD_DestroyOutput - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%rotors) ) 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%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - 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 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 - END SUBROUTINE AD_PackOutput - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors 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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 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 - - 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 - END SUBROUTINE AD_UnPackOutput - - - SUBROUTINE AD_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(AD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(AD_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 + ErrMsg = '' + if (allocated(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) then + LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + if (.not. allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then + allocate(DstVTK_BLSurfaceTypeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_BLSurfaceTypeData%AirfoilCoords.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_BLSurfaceTypeData%AirfoilCoords = SrcVTK_BLSurfaceTypeData%AirfoilCoords + end if +end subroutine + +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 + character(*), parameter :: RoutineName = 'AD_DestroyVTK_BLSurfaceType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(VTK_BLSurfaceTypeData%AirfoilCoords)) then + deallocate(VTK_BLSurfaceTypeData%AirfoilCoords) + end if +end subroutine + +subroutine AD_PackVTK_BLSurfaceType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_VTK_BLSurfaceType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackVTK_BLSurfaceType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%AirfoilCoords)) + if (allocated(InData%AirfoilCoords)) then + call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords), ubound(InData%AirfoilCoords)) + call RegPack(Buf, InData%AirfoilCoords) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackVTK_BLSurfaceType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_VTK_BLSurfaceType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackVTK_BLSurfaceType' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%AirfoilCoords)) deallocate(OutData%AirfoilCoords) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AirfoilCoords) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD_CopyVTK_RotSurfaceType(SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfaceTypeData, CtrlCode, ErrStat, ErrMsg) + type(AD_VTK_RotSurfaceType), intent(in) :: SrcVTK_RotSurfaceTypeData + type(AD_VTK_RotSurfaceType), intent(inout) :: DstVTK_RotSurfaceTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyVTK_RotSurfaceType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcVTK_RotSurfaceTypeData%BladeShape)) then + LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%BladeShape) + UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%BladeShape) + if (.not. allocated(DstVTK_RotSurfaceTypeData%BladeShape)) then + allocate(DstVTK_RotSurfaceTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_RotSurfaceTypeData%BladeShape.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyVTK_BLSurfaceType(SrcVTK_RotSurfaceTypeData%BladeShape(i1), DstVTK_RotSurfaceTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcVTK_RotSurfaceTypeData%TowerRad)) then + LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%TowerRad) + UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%TowerRad) + if (.not. allocated(DstVTK_RotSurfaceTypeData%TowerRad)) then + allocate(DstVTK_RotSurfaceTypeData%TowerRad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_RotSurfaceTypeData%TowerRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_RotSurfaceTypeData%TowerRad = SrcVTK_RotSurfaceTypeData%TowerRad + end if +end subroutine + +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 + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyVTK_RotSurfaceType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(VTK_RotSurfaceTypeData%BladeShape)) then + LB(1:1) = lbound(VTK_RotSurfaceTypeData%BladeShape) + UB(1:1) = ubound(VTK_RotSurfaceTypeData%BladeShape) + do i1 = LB(1), UB(1) + call AD_DestroyVTK_BLSurfaceType(VTK_RotSurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(VTK_RotSurfaceTypeData%BladeShape) + end if + if (allocated(VTK_RotSurfaceTypeData%TowerRad)) then + deallocate(VTK_RotSurfaceTypeData%TowerRad) + end if +end subroutine + +subroutine AD_PackVTK_RotSurfaceType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_VTK_RotSurfaceType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackVTK_RotSurfaceType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%BladeShape)) + if (allocated(InData%BladeShape)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) + LB(1:1) = lbound(InData%BladeShape) + UB(1:1) = ubound(InData%BladeShape) + do i1 = LB(1), UB(1) + call AD_PackVTK_BLSurfaceType(Buf, InData%BladeShape(i1)) + end do + end if + call RegPack(Buf, allocated(InData%TowerRad)) + if (allocated(InData%TowerRad)) then + call RegPackBounds(Buf, 1, lbound(InData%TowerRad), ubound(InData%TowerRad)) + call RegPack(Buf, InData%TowerRad) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackVTK_RotSurfaceType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_VTK_RotSurfaceType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackVTK_RotSurfaceType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeShape(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackVTK_BLSurfaceType(Buf, OutData%BladeShape(i1)) ! BladeShape + end do + end if + if (allocated(OutData%TowerRad)) deallocate(OutData%TowerRad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TowerRad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TowerRad) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD_CopyRotInitInputType(SrcRotInitInputTypeData, DstRotInitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotInitInputType), intent(in) :: SrcRotInitInputTypeData + type(RotInitInputType), intent(inout) :: DstRotInitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_CopyRotInitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstRotInitInputTypeData%NumBlades = SrcRotInitInputTypeData%NumBlades + DstRotInitInputTypeData%HubPosition = SrcRotInitInputTypeData%HubPosition + DstRotInitInputTypeData%HubOrientation = SrcRotInitInputTypeData%HubOrientation + if (allocated(SrcRotInitInputTypeData%BladeRootPosition)) then + LB(1:2) = lbound(SrcRotInitInputTypeData%BladeRootPosition) + UB(1:2) = ubound(SrcRotInitInputTypeData%BladeRootPosition) + if (.not. allocated(DstRotInitInputTypeData%BladeRootPosition)) then + allocate(DstRotInitInputTypeData%BladeRootPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitInputTypeData%BladeRootPosition.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitInputTypeData%BladeRootPosition = SrcRotInitInputTypeData%BladeRootPosition + end if + if (allocated(SrcRotInitInputTypeData%BladeRootOrientation)) then + LB(1:3) = lbound(SrcRotInitInputTypeData%BladeRootOrientation) + UB(1:3) = ubound(SrcRotInitInputTypeData%BladeRootOrientation) + if (.not. allocated(DstRotInitInputTypeData%BladeRootOrientation)) then + allocate(DstRotInitInputTypeData%BladeRootOrientation(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitInputTypeData%BladeRootOrientation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitInputTypeData%BladeRootOrientation = SrcRotInitInputTypeData%BladeRootOrientation + end if + DstRotInitInputTypeData%NacellePosition = SrcRotInitInputTypeData%NacellePosition + DstRotInitInputTypeData%NacelleOrientation = SrcRotInitInputTypeData%NacelleOrientation + DstRotInitInputTypeData%AeroProjMod = SrcRotInitInputTypeData%AeroProjMod + DstRotInitInputTypeData%AeroBEM_Mod = SrcRotInitInputTypeData%AeroBEM_Mod +end subroutine + +subroutine AD_DestroyRotInitInputType(RotInitInputTypeData, ErrStat, ErrMsg) + type(RotInitInputType), intent(inout) :: RotInitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyRotInitInputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotInitInputTypeData%BladeRootPosition)) then + deallocate(RotInitInputTypeData%BladeRootPosition) + end if + if (allocated(RotInitInputTypeData%BladeRootOrientation)) then + deallocate(RotInitInputTypeData%BladeRootOrientation) + end if +end subroutine + +subroutine AD_PackRotInitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotInitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInitInputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%NumBlades) + call RegPack(Buf, InData%HubPosition) + call RegPack(Buf, InData%HubOrientation) + call RegPack(Buf, allocated(InData%BladeRootPosition)) + if (allocated(InData%BladeRootPosition)) then + call RegPackBounds(Buf, 2, lbound(InData%BladeRootPosition), ubound(InData%BladeRootPosition)) + call RegPack(Buf, InData%BladeRootPosition) + end if + call RegPack(Buf, allocated(InData%BladeRootOrientation)) + if (allocated(InData%BladeRootOrientation)) then + call RegPackBounds(Buf, 3, lbound(InData%BladeRootOrientation), ubound(InData%BladeRootOrientation)) + call RegPack(Buf, InData%BladeRootOrientation) + end if + call RegPack(Buf, InData%NacellePosition) + call RegPack(Buf, InData%NacelleOrientation) + call RegPack(Buf, InData%AeroProjMod) + call RegPack(Buf, InData%AeroBEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotInitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotInitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInitInputType' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubPosition) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubOrientation) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BladeRootPosition)) deallocate(OutData%BladeRootPosition) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootPosition(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootPosition.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BladeRootPosition) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BladeRootOrientation)) deallocate(OutData%BladeRootOrientation) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootOrientation(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootOrientation.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BladeRootOrientation) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NacellePosition) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacelleOrientation) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AeroProjMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AeroBEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(AD_InitInputType), intent(in) :: SrcInitInputData + type(AD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitInputData%rotors)) then + LB(1:1) = lbound(SrcInitInputData%rotors) + UB(1:1) = ubound(SrcInitInputData%rotors) + if (.not. allocated(DstInitInputData%rotors)) then + allocate(DstInitInputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotInitInputType(SrcInitInputData%rotors(i1), DstInitInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%UsePrimaryInputFile = SrcInitInputData%UsePrimaryInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%MHK = SrcInitInputData%MHK + DstInitInputData%defFldDens = SrcInitInputData%defFldDens + DstInitInputData%defKinVisc = SrcInitInputData%defKinVisc + DstInitInputData%defSpdSound = SrcInitInputData%defSpdSound + DstInitInputData%defPatm = SrcInitInputData%defPatm + DstInitInputData%defPvap = SrcInitInputData%defPvap + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL +end subroutine + +subroutine AD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(AD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%rotors)) then + LB(1:1) = lbound(InitInputData%rotors) + UB(1:1) = ubound(InitInputData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotInitInputType(InitInputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%rotors) + end if + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInitInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotInitInputType(Buf, InData%rotors(i1)) + end do + end if + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%UsePrimaryInputFile) + call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) + call RegPack(Buf, InData%Linearize) + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%MHK) + call RegPack(Buf, InData%defFldDens) + call RegPack(Buf, InData%defKinVisc) + call RegPack(Buf, InData%defSpdSound) + call RegPack(Buf, InData%defPatm) + call RegPack(Buf, InData%defPvap) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInitInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInitInputType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UsePrimaryInputFile) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%defFldDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%defKinVisc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%defSpdSound) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%defPatm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%defPvap) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg) + type(AD_BladePropsType), intent(in) :: SrcBladePropsTypeData + type(AD_BladePropsType), intent(inout) :: DstBladePropsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_CopyBladePropsType' + ErrStat = ErrID_None + ErrMsg = '' + DstBladePropsTypeData%NumBlNds = SrcBladePropsTypeData%NumBlNds + if (allocated(SrcBladePropsTypeData%BlSpn)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlSpn) + UB(1:1) = ubound(SrcBladePropsTypeData%BlSpn) + if (.not. allocated(DstBladePropsTypeData%BlSpn)) then + allocate(DstBladePropsTypeData%BlSpn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlSpn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlSpn = SrcBladePropsTypeData%BlSpn + end if + if (allocated(SrcBladePropsTypeData%BlCrvAC)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAC) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAC) + if (.not. allocated(DstBladePropsTypeData%BlCrvAC)) then + allocate(DstBladePropsTypeData%BlCrvAC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCrvAC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCrvAC = SrcBladePropsTypeData%BlCrvAC + end if + if (allocated(SrcBladePropsTypeData%BlSwpAC)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlSwpAC) + UB(1:1) = ubound(SrcBladePropsTypeData%BlSwpAC) + if (.not. allocated(DstBladePropsTypeData%BlSwpAC)) then + allocate(DstBladePropsTypeData%BlSwpAC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlSwpAC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlSwpAC = SrcBladePropsTypeData%BlSwpAC + end if + if (allocated(SrcBladePropsTypeData%BlCrvAng)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAng) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAng) + if (.not. allocated(DstBladePropsTypeData%BlCrvAng)) then + allocate(DstBladePropsTypeData%BlCrvAng(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCrvAng.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCrvAng = SrcBladePropsTypeData%BlCrvAng + end if + if (allocated(SrcBladePropsTypeData%BlTwist)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlTwist) + UB(1:1) = ubound(SrcBladePropsTypeData%BlTwist) + if (.not. allocated(DstBladePropsTypeData%BlTwist)) then + allocate(DstBladePropsTypeData%BlTwist(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlTwist.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlTwist = SrcBladePropsTypeData%BlTwist + end if + if (allocated(SrcBladePropsTypeData%BlChord)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlChord) + UB(1:1) = ubound(SrcBladePropsTypeData%BlChord) + if (.not. allocated(DstBladePropsTypeData%BlChord)) then + allocate(DstBladePropsTypeData%BlChord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlChord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlChord = SrcBladePropsTypeData%BlChord + end if + if (allocated(SrcBladePropsTypeData%BlAFID)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlAFID) + UB(1:1) = ubound(SrcBladePropsTypeData%BlAFID) + if (.not. allocated(DstBladePropsTypeData%BlAFID)) then + allocate(DstBladePropsTypeData%BlAFID(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlAFID.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlAFID = SrcBladePropsTypeData%BlAFID + end if + if (allocated(SrcBladePropsTypeData%BlCb)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCb) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCb) + if (.not. allocated(DstBladePropsTypeData%BlCb)) then + allocate(DstBladePropsTypeData%BlCb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCb = SrcBladePropsTypeData%BlCb + end if + if (allocated(SrcBladePropsTypeData%BlCenBn)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBn) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBn) + if (.not. allocated(DstBladePropsTypeData%BlCenBn)) then + allocate(DstBladePropsTypeData%BlCenBn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCenBn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCenBn = SrcBladePropsTypeData%BlCenBn + end if + if (allocated(SrcBladePropsTypeData%BlCenBt)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBt) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBt) + if (.not. allocated(DstBladePropsTypeData%BlCenBt)) then + allocate(DstBladePropsTypeData%BlCenBt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCenBt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCenBt = SrcBladePropsTypeData%BlCenBt + end if +end subroutine + +subroutine AD_DestroyBladePropsType(BladePropsTypeData, ErrStat, ErrMsg) + type(AD_BladePropsType), intent(inout) :: BladePropsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyBladePropsType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladePropsTypeData%BlSpn)) then + deallocate(BladePropsTypeData%BlSpn) + end if + if (allocated(BladePropsTypeData%BlCrvAC)) then + deallocate(BladePropsTypeData%BlCrvAC) + end if + if (allocated(BladePropsTypeData%BlSwpAC)) then + deallocate(BladePropsTypeData%BlSwpAC) + end if + if (allocated(BladePropsTypeData%BlCrvAng)) then + deallocate(BladePropsTypeData%BlCrvAng) + end if + if (allocated(BladePropsTypeData%BlTwist)) then + deallocate(BladePropsTypeData%BlTwist) + end if + if (allocated(BladePropsTypeData%BlChord)) then + deallocate(BladePropsTypeData%BlChord) + end if + if (allocated(BladePropsTypeData%BlAFID)) then + deallocate(BladePropsTypeData%BlAFID) + end if + if (allocated(BladePropsTypeData%BlCb)) then + deallocate(BladePropsTypeData%BlCb) + end if + if (allocated(BladePropsTypeData%BlCenBn)) then + deallocate(BladePropsTypeData%BlCenBn) + end if + if (allocated(BladePropsTypeData%BlCenBt)) then + deallocate(BladePropsTypeData%BlCenBt) + end if +end subroutine + +subroutine AD_PackBladePropsType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_BladePropsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackBladePropsType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%NumBlNds) + call RegPack(Buf, allocated(InData%BlSpn)) + if (allocated(InData%BlSpn)) then + call RegPackBounds(Buf, 1, lbound(InData%BlSpn), ubound(InData%BlSpn)) + call RegPack(Buf, InData%BlSpn) + end if + call RegPack(Buf, allocated(InData%BlCrvAC)) + if (allocated(InData%BlCrvAC)) then + call RegPackBounds(Buf, 1, lbound(InData%BlCrvAC), ubound(InData%BlCrvAC)) + call RegPack(Buf, InData%BlCrvAC) + end if + call RegPack(Buf, allocated(InData%BlSwpAC)) + if (allocated(InData%BlSwpAC)) then + call RegPackBounds(Buf, 1, lbound(InData%BlSwpAC), ubound(InData%BlSwpAC)) + call RegPack(Buf, InData%BlSwpAC) + end if + call RegPack(Buf, allocated(InData%BlCrvAng)) + if (allocated(InData%BlCrvAng)) then + call RegPackBounds(Buf, 1, lbound(InData%BlCrvAng), ubound(InData%BlCrvAng)) + call RegPack(Buf, InData%BlCrvAng) + end if + call RegPack(Buf, allocated(InData%BlTwist)) + if (allocated(InData%BlTwist)) then + call RegPackBounds(Buf, 1, lbound(InData%BlTwist), ubound(InData%BlTwist)) + call RegPack(Buf, InData%BlTwist) + end if + call RegPack(Buf, allocated(InData%BlChord)) + if (allocated(InData%BlChord)) then + call RegPackBounds(Buf, 1, lbound(InData%BlChord), ubound(InData%BlChord)) + call RegPack(Buf, InData%BlChord) + end if + call RegPack(Buf, allocated(InData%BlAFID)) + if (allocated(InData%BlAFID)) then + call RegPackBounds(Buf, 1, lbound(InData%BlAFID), ubound(InData%BlAFID)) + call RegPack(Buf, InData%BlAFID) + end if + call RegPack(Buf, allocated(InData%BlCb)) + if (allocated(InData%BlCb)) then + call RegPackBounds(Buf, 1, lbound(InData%BlCb), ubound(InData%BlCb)) + call RegPack(Buf, InData%BlCb) + end if + call RegPack(Buf, allocated(InData%BlCenBn)) + if (allocated(InData%BlCenBn)) then + call RegPackBounds(Buf, 1, lbound(InData%BlCenBn), ubound(InData%BlCenBn)) + call RegPack(Buf, InData%BlCenBn) + end if + call RegPack(Buf, allocated(InData%BlCenBt)) + if (allocated(InData%BlCenBt)) then + call RegPackBounds(Buf, 1, lbound(InData%BlCenBt), ubound(InData%BlCenBt)) + call RegPack(Buf, InData%BlCenBt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackBladePropsType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_BladePropsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackBladePropsType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NumBlNds) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BlSpn)) deallocate(OutData%BlSpn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlSpn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlSpn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlCrvAC)) deallocate(OutData%BlCrvAC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlCrvAC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlCrvAC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlSwpAC)) deallocate(OutData%BlSwpAC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlSwpAC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSwpAC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlSwpAC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlCrvAng)) deallocate(OutData%BlCrvAng) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlCrvAng(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAng.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlCrvAng) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlTwist)) deallocate(OutData%BlTwist) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlTwist(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlTwist) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlChord)) deallocate(OutData%BlChord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlChord(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlChord) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlAFID)) deallocate(OutData%BlAFID) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlAFID(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlAFID) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlCb)) deallocate(OutData%BlCb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlCb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlCb) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlCenBn)) deallocate(OutData%BlCenBn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlCenBn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlCenBn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlCenBt)) deallocate(OutData%BlCenBt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlCenBt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlCenBt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD_CopyBladeShape(SrcBladeShapeData, DstBladeShapeData, CtrlCode, ErrStat, ErrMsg) + type(AD_BladeShape), intent(in) :: SrcBladeShapeData + type(AD_BladeShape), intent(inout) :: DstBladeShapeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_CopyBladeShape' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcBladeShapeData%AirfoilCoords)) then + LB(1:3) = lbound(SrcBladeShapeData%AirfoilCoords) + UB(1:3) = ubound(SrcBladeShapeData%AirfoilCoords) + if (.not. allocated(DstBladeShapeData%AirfoilCoords)) then + allocate(DstBladeShapeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeShapeData%AirfoilCoords.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeShapeData%AirfoilCoords = SrcBladeShapeData%AirfoilCoords + end if +end subroutine + +subroutine AD_DestroyBladeShape(BladeShapeData, ErrStat, ErrMsg) + type(AD_BladeShape), intent(inout) :: BladeShapeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyBladeShape' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladeShapeData%AirfoilCoords)) then + deallocate(BladeShapeData%AirfoilCoords) + end if +end subroutine + +subroutine AD_PackBladeShape(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_BladeShape), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackBladeShape' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%AirfoilCoords)) + if (allocated(InData%AirfoilCoords)) then + call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords), ubound(InData%AirfoilCoords)) + call RegPack(Buf, InData%AirfoilCoords) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackBladeShape(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_BladeShape), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackBladeShape' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%AirfoilCoords)) deallocate(OutData%AirfoilCoords) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AirfoilCoords) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotInitOutputType), intent(in) :: SrcRotInitOutputTypeData + type(RotInitOutputType), intent(inout) :: DstRotInitOutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotInitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + DstRotInitOutputTypeData%AirDens = SrcRotInitOutputTypeData%AirDens + if (allocated(SrcRotInitOutputTypeData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputHdr) + UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputHdr) + if (.not. allocated(DstRotInitOutputTypeData%WriteOutputHdr)) then + allocate(DstRotInitOutputTypeData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%WriteOutputHdr = SrcRotInitOutputTypeData%WriteOutputHdr + end if + if (allocated(SrcRotInitOutputTypeData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputUnt) + UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputUnt) + if (.not. allocated(DstRotInitOutputTypeData%WriteOutputUnt)) then + allocate(DstRotInitOutputTypeData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%WriteOutputUnt = SrcRotInitOutputTypeData%WriteOutputUnt + end if + if (allocated(SrcRotInitOutputTypeData%BladeShape)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeShape) + UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeShape) + if (.not. allocated(DstRotInitOutputTypeData%BladeShape)) then + allocate(DstRotInitOutputTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%BladeShape.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyBladeShape(SrcRotInitOutputTypeData%BladeShape(i1), DstRotInitOutputTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotInitOutputTypeData%LinNames_y)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_y) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_y) + if (.not. allocated(DstRotInitOutputTypeData%LinNames_y)) then + allocate(DstRotInitOutputTypeData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%LinNames_y = SrcRotInitOutputTypeData%LinNames_y + end if + if (allocated(SrcRotInitOutputTypeData%LinNames_x)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_x) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_x) + if (.not. allocated(DstRotInitOutputTypeData%LinNames_x)) then + allocate(DstRotInitOutputTypeData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%LinNames_x = SrcRotInitOutputTypeData%LinNames_x + end if + if (allocated(SrcRotInitOutputTypeData%LinNames_u)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_u) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_u) + if (.not. allocated(DstRotInitOutputTypeData%LinNames_u)) then + allocate(DstRotInitOutputTypeData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%LinNames_u = SrcRotInitOutputTypeData%LinNames_u + end if + if (allocated(SrcRotInitOutputTypeData%RotFrame_y)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_y) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_y) + if (.not. allocated(DstRotInitOutputTypeData%RotFrame_y)) then + allocate(DstRotInitOutputTypeData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%RotFrame_y = SrcRotInitOutputTypeData%RotFrame_y + end if + if (allocated(SrcRotInitOutputTypeData%RotFrame_x)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_x) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_x) + if (.not. allocated(DstRotInitOutputTypeData%RotFrame_x)) then + allocate(DstRotInitOutputTypeData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%RotFrame_x = SrcRotInitOutputTypeData%RotFrame_x + end if + if (allocated(SrcRotInitOutputTypeData%RotFrame_u)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_u) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_u) + if (.not. allocated(DstRotInitOutputTypeData%RotFrame_u)) then + allocate(DstRotInitOutputTypeData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%RotFrame_u = SrcRotInitOutputTypeData%RotFrame_u + end if + if (allocated(SrcRotInitOutputTypeData%IsLoad_u)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%IsLoad_u) + UB(1:1) = ubound(SrcRotInitOutputTypeData%IsLoad_u) + if (.not. allocated(DstRotInitOutputTypeData%IsLoad_u)) then + allocate(DstRotInitOutputTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%IsLoad_u = SrcRotInitOutputTypeData%IsLoad_u + end if + if (allocated(SrcRotInitOutputTypeData%BladeProps)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeProps) + UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeProps) + if (.not. allocated(DstRotInitOutputTypeData%BladeProps)) then + allocate(DstRotInitOutputTypeData%BladeProps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%BladeProps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyBladePropsType(SrcRotInitOutputTypeData%BladeProps(i1), DstRotInitOutputTypeData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotInitOutputTypeData%DerivOrder_x)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%DerivOrder_x) + UB(1:1) = ubound(SrcRotInitOutputTypeData%DerivOrder_x) + if (.not. allocated(DstRotInitOutputTypeData%DerivOrder_x)) then + allocate(DstRotInitOutputTypeData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%DerivOrder_x = SrcRotInitOutputTypeData%DerivOrder_x + end if + if (allocated(SrcRotInitOutputTypeData%TwrElev)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrElev) + UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrElev) + if (.not. allocated(DstRotInitOutputTypeData%TwrElev)) then + allocate(DstRotInitOutputTypeData%TwrElev(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%TwrElev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%TwrElev = SrcRotInitOutputTypeData%TwrElev + end if + if (allocated(SrcRotInitOutputTypeData%TwrDiam)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrDiam) + UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrDiam) + if (.not. allocated(DstRotInitOutputTypeData%TwrDiam)) then + allocate(DstRotInitOutputTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%TwrDiam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%TwrDiam = SrcRotInitOutputTypeData%TwrDiam + end if +end subroutine + +subroutine AD_DestroyRotInitOutputType(RotInitOutputTypeData, ErrStat, ErrMsg) + type(RotInitOutputType), intent(inout) :: RotInitOutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotInitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotInitOutputTypeData%WriteOutputHdr)) then + deallocate(RotInitOutputTypeData%WriteOutputHdr) + end if + if (allocated(RotInitOutputTypeData%WriteOutputUnt)) then + deallocate(RotInitOutputTypeData%WriteOutputUnt) + end if + if (allocated(RotInitOutputTypeData%BladeShape)) then + LB(1:1) = lbound(RotInitOutputTypeData%BladeShape) + UB(1:1) = ubound(RotInitOutputTypeData%BladeShape) + do i1 = LB(1), UB(1) + call AD_DestroyBladeShape(RotInitOutputTypeData%BladeShape(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInitOutputTypeData%BladeShape) + end if + if (allocated(RotInitOutputTypeData%LinNames_y)) then + deallocate(RotInitOutputTypeData%LinNames_y) + end if + if (allocated(RotInitOutputTypeData%LinNames_x)) then + deallocate(RotInitOutputTypeData%LinNames_x) + end if + if (allocated(RotInitOutputTypeData%LinNames_u)) then + deallocate(RotInitOutputTypeData%LinNames_u) + end if + if (allocated(RotInitOutputTypeData%RotFrame_y)) then + deallocate(RotInitOutputTypeData%RotFrame_y) + end if + if (allocated(RotInitOutputTypeData%RotFrame_x)) then + deallocate(RotInitOutputTypeData%RotFrame_x) + end if + if (allocated(RotInitOutputTypeData%RotFrame_u)) then + deallocate(RotInitOutputTypeData%RotFrame_u) + end if + if (allocated(RotInitOutputTypeData%IsLoad_u)) then + deallocate(RotInitOutputTypeData%IsLoad_u) + end if + if (allocated(RotInitOutputTypeData%BladeProps)) then + LB(1:1) = lbound(RotInitOutputTypeData%BladeProps) + UB(1:1) = ubound(RotInitOutputTypeData%BladeProps) + do i1 = LB(1), UB(1) + call AD_DestroyBladePropsType(RotInitOutputTypeData%BladeProps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInitOutputTypeData%BladeProps) + end if + if (allocated(RotInitOutputTypeData%DerivOrder_x)) then + deallocate(RotInitOutputTypeData%DerivOrder_x) + end if + if (allocated(RotInitOutputTypeData%TwrElev)) then + deallocate(RotInitOutputTypeData%TwrElev) + end if + if (allocated(RotInitOutputTypeData%TwrDiam)) then + deallocate(RotInitOutputTypeData%TwrDiam) + end if +end subroutine + +subroutine AD_PackRotInitOutputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotInitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInitOutputType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%AirDens) + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call RegPack(Buf, allocated(InData%BladeShape)) + if (allocated(InData%BladeShape)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) + LB(1:1) = lbound(InData%BladeShape) + UB(1:1) = ubound(InData%BladeShape) + do i1 = LB(1), UB(1) + call AD_PackBladeShape(Buf, InData%BladeShape(i1)) + end do + end if + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + call RegPack(Buf, allocated(InData%BladeProps)) + if (allocated(InData%BladeProps)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) + LB(1:1) = lbound(InData%BladeProps) + UB(1:1) = ubound(InData%BladeProps) + do i1 = LB(1), UB(1) + call AD_PackBladePropsType(Buf, InData%BladeProps(i1)) + end do + end if + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + call RegPack(Buf, allocated(InData%TwrElev)) + if (allocated(InData%TwrElev)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrElev), ubound(InData%TwrElev)) + call RegPack(Buf, InData%TwrElev) + end if + call RegPack(Buf, allocated(InData%TwrDiam)) + if (allocated(InData%TwrDiam)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrDiam), ubound(InData%TwrDiam)) + call RegPack(Buf, InData%TwrDiam) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotInitOutputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotInitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInitOutputType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeShape(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackBladeShape(Buf, OutData%BladeShape(i1)) ! BladeShape + end do + end if + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeProps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackBladePropsType(Buf, OutData%BladeProps(i1)) ! BladeProps + end do + end if + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrElev)) deallocate(OutData%TwrElev) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrElev(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrElev) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrDiam)) deallocate(OutData%TwrDiam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrDiam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrDiam) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(AD_InitOutputType), intent(in) :: SrcInitOutputData + type(AD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%rotors)) then + LB(1:1) = lbound(SrcInitOutputData%rotors) + UB(1:1) = ubound(SrcInitOutputData%rotors) + if (.not. allocated(DstInitOutputData%rotors)) then + allocate(DstInitOutputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotInitOutputType(SrcInitOutputData%rotors(i1), DstInitOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(AD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%rotors)) then + LB(1:1) = lbound(InitOutputData%rotors) + UB(1:1) = ubound(InitOutputData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotInitOutputType(InitOutputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitOutputData%rotors) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInitOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotInitOutputType(Buf, InData%rotors(i1)) + end do + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInitOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInitOutputType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine + +subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCode, ErrStat, ErrMsg) + type(RotInputFile), intent(in) :: SrcRotInputFileData + type(RotInputFile), intent(inout) :: DstRotInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcRotInputFileData%BladeProps)) then + LB(1:1) = lbound(SrcRotInputFileData%BladeProps) + UB(1:1) = ubound(SrcRotInputFileData%BladeProps) + if (.not. allocated(DstRotInputFileData%BladeProps)) then + allocate(DstRotInputFileData%BladeProps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%BladeProps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyBladePropsType(SrcRotInputFileData%BladeProps(i1), DstRotInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstRotInputFileData%NumTwrNds = SrcRotInputFileData%NumTwrNds + if (allocated(SrcRotInputFileData%TwrElev)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrElev) + UB(1:1) = ubound(SrcRotInputFileData%TwrElev) + if (.not. allocated(DstRotInputFileData%TwrElev)) then + allocate(DstRotInputFileData%TwrElev(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrElev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrElev = SrcRotInputFileData%TwrElev + end if + if (allocated(SrcRotInputFileData%TwrDiam)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrDiam) + UB(1:1) = ubound(SrcRotInputFileData%TwrDiam) + if (.not. allocated(DstRotInputFileData%TwrDiam)) then + allocate(DstRotInputFileData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrDiam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrDiam = SrcRotInputFileData%TwrDiam + end if + if (allocated(SrcRotInputFileData%TwrCd)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrCd) + UB(1:1) = ubound(SrcRotInputFileData%TwrCd) + if (.not. allocated(DstRotInputFileData%TwrCd)) then + allocate(DstRotInputFileData%TwrCd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrCd = SrcRotInputFileData%TwrCd + end if + if (allocated(SrcRotInputFileData%TwrTI)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrTI) + UB(1:1) = ubound(SrcRotInputFileData%TwrTI) + if (.not. allocated(DstRotInputFileData%TwrTI)) then + allocate(DstRotInputFileData%TwrTI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrTI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrTI = SrcRotInputFileData%TwrTI + end if + if (allocated(SrcRotInputFileData%TwrCb)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrCb) + UB(1:1) = ubound(SrcRotInputFileData%TwrCb) + if (.not. allocated(DstRotInputFileData%TwrCb)) then + allocate(DstRotInputFileData%TwrCb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrCb = SrcRotInputFileData%TwrCb + end if + DstRotInputFileData%VolHub = SrcRotInputFileData%VolHub + DstRotInputFileData%HubCenBx = SrcRotInputFileData%HubCenBx + DstRotInputFileData%VolNac = SrcRotInputFileData%VolNac + DstRotInputFileData%NacCenB = SrcRotInputFileData%NacCenB + DstRotInputFileData%TFinAero = SrcRotInputFileData%TFinAero + DstRotInputFileData%TFinFile = SrcRotInputFileData%TFinFile + call AD_CopyTFinInputFileType(SrcRotInputFileData%TFin, DstRotInputFileData%TFin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyRotInputFile(RotInputFileData, ErrStat, ErrMsg) + type(RotInputFile), intent(inout) :: RotInputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotInputFileData%BladeProps)) then + LB(1:1) = lbound(RotInputFileData%BladeProps) + UB(1:1) = ubound(RotInputFileData%BladeProps) + do i1 = LB(1), UB(1) + call AD_DestroyBladePropsType(RotInputFileData%BladeProps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInputFileData%BladeProps) + end if + if (allocated(RotInputFileData%TwrElev)) then + deallocate(RotInputFileData%TwrElev) + end if + if (allocated(RotInputFileData%TwrDiam)) then + deallocate(RotInputFileData%TwrDiam) + end if + if (allocated(RotInputFileData%TwrCd)) then + deallocate(RotInputFileData%TwrCd) + end if + if (allocated(RotInputFileData%TwrTI)) then + deallocate(RotInputFileData%TwrTI) + end if + if (allocated(RotInputFileData%TwrCb)) then + deallocate(RotInputFileData%TwrCb) + end if + call AD_DestroyTFinInputFileType(RotInputFileData%TFin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotInputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInputFile' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%BladeProps)) + if (allocated(InData%BladeProps)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) + LB(1:1) = lbound(InData%BladeProps) + UB(1:1) = ubound(InData%BladeProps) + do i1 = LB(1), UB(1) + call AD_PackBladePropsType(Buf, InData%BladeProps(i1)) + end do + end if + call RegPack(Buf, InData%NumTwrNds) + call RegPack(Buf, allocated(InData%TwrElev)) + if (allocated(InData%TwrElev)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrElev), ubound(InData%TwrElev)) + call RegPack(Buf, InData%TwrElev) + end if + call RegPack(Buf, allocated(InData%TwrDiam)) + if (allocated(InData%TwrDiam)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrDiam), ubound(InData%TwrDiam)) + call RegPack(Buf, InData%TwrDiam) + end if + call RegPack(Buf, allocated(InData%TwrCd)) + if (allocated(InData%TwrCd)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrCd), ubound(InData%TwrCd)) + call RegPack(Buf, InData%TwrCd) + end if + call RegPack(Buf, allocated(InData%TwrTI)) + if (allocated(InData%TwrTI)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrTI), ubound(InData%TwrTI)) + call RegPack(Buf, InData%TwrTI) + end if + call RegPack(Buf, allocated(InData%TwrCb)) + if (allocated(InData%TwrCb)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrCb), ubound(InData%TwrCb)) + call RegPack(Buf, InData%TwrCb) + end if + call RegPack(Buf, InData%VolHub) + call RegPack(Buf, InData%HubCenBx) + call RegPack(Buf, InData%VolNac) + call RegPack(Buf, InData%NacCenB) + call RegPack(Buf, InData%TFinAero) + call RegPack(Buf, InData%TFinFile) + call AD_PackTFinInputFileType(Buf, InData%TFin) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotInputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInputFile' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeProps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackBladePropsType(Buf, OutData%BladeProps(i1)) ! BladeProps + end do + end if + call RegUnpack(Buf, OutData%NumTwrNds) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TwrElev)) deallocate(OutData%TwrElev) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrElev(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrElev) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrDiam)) deallocate(OutData%TwrDiam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrDiam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrDiam) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrCd)) deallocate(OutData%TwrCd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrCd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrCd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrTI)) deallocate(OutData%TwrTI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrTI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrTI) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrCb)) deallocate(OutData%TwrCb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrCb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrCb) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%VolHub) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubCenBx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VolNac) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacCenB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinAero) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinFile) + if (RegCheckErr(Buf, RoutineName)) return + call AD_UnpackTFinInputFileType(Buf, OutData%TFin) ! TFin +end subroutine + +subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(AD_InputFile), intent(in) :: SrcInputFileData + type(AD_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%DTAero = SrcInputFileData%DTAero + DstInputFileData%WakeMod = SrcInputFileData%WakeMod + DstInputFileData%AFAeroMod = SrcInputFileData%AFAeroMod + DstInputFileData%TwrPotent = SrcInputFileData%TwrPotent + DstInputFileData%TwrShadow = SrcInputFileData%TwrShadow + DstInputFileData%TwrAero = SrcInputFileData%TwrAero + DstInputFileData%FrozenWake = SrcInputFileData%FrozenWake + DstInputFileData%CavitCheck = SrcInputFileData%CavitCheck + DstInputFileData%Buoyancy = SrcInputFileData%Buoyancy + DstInputFileData%CompAA = SrcInputFileData%CompAA + DstInputFileData%AA_InputFile = SrcInputFileData%AA_InputFile + if (allocated(SrcInputFileData%ADBlFile)) then + LB(1:1) = lbound(SrcInputFileData%ADBlFile) + UB(1:1) = ubound(SrcInputFileData%ADBlFile) + if (.not. allocated(DstInputFileData%ADBlFile)) then + allocate(DstInputFileData%ADBlFile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ADBlFile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ADBlFile = SrcInputFileData%ADBlFile + end if + DstInputFileData%AirDens = SrcInputFileData%AirDens + DstInputFileData%KinVisc = SrcInputFileData%KinVisc + DstInputFileData%Patm = SrcInputFileData%Patm + DstInputFileData%Pvap = SrcInputFileData%Pvap + DstInputFileData%SpdSound = SrcInputFileData%SpdSound + DstInputFileData%SkewMod = SrcInputFileData%SkewMod + DstInputFileData%SkewModFactor = SrcInputFileData%SkewModFactor + DstInputFileData%TipLoss = SrcInputFileData%TipLoss + DstInputFileData%HubLoss = SrcInputFileData%HubLoss + DstInputFileData%TanInd = SrcInputFileData%TanInd + DstInputFileData%AIDrag = SrcInputFileData%AIDrag + DstInputFileData%TIDrag = SrcInputFileData%TIDrag + DstInputFileData%IndToler = SrcInputFileData%IndToler + DstInputFileData%MaxIter = SrcInputFileData%MaxIter + DstInputFileData%UAMod = SrcInputFileData%UAMod + DstInputFileData%FLookup = SrcInputFileData%FLookup + DstInputFileData%InCol_Alfa = SrcInputFileData%InCol_Alfa + DstInputFileData%InCol_Cl = SrcInputFileData%InCol_Cl + DstInputFileData%InCol_Cd = SrcInputFileData%InCol_Cd + DstInputFileData%InCol_Cm = SrcInputFileData%InCol_Cm + DstInputFileData%InCol_Cpmin = SrcInputFileData%InCol_Cpmin + DstInputFileData%AFTabMod = SrcInputFileData%AFTabMod + DstInputFileData%NumAFfiles = SrcInputFileData%NumAFfiles + DstInputFileData%FVWFileName = SrcInputFileData%FVWFileName + if (allocated(SrcInputFileData%AFNames)) then + LB(1:1) = lbound(SrcInputFileData%AFNames) + UB(1:1) = ubound(SrcInputFileData%AFNames) + if (.not. allocated(DstInputFileData%AFNames)) then + allocate(DstInputFileData%AFNames(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AFNames.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AFNames = SrcInputFileData%AFNames + end if + DstInputFileData%UseBlCm = SrcInputFileData%UseBlCm + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%NBlOuts = SrcInputFileData%NBlOuts + DstInputFileData%BlOutNd = SrcInputFileData%BlOutNd + DstInputFileData%NTwOuts = SrcInputFileData%NTwOuts + DstInputFileData%TwOutNd = SrcInputFileData%TwOutNd + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + end if + DstInputFileData%tau1_const = SrcInputFileData%tau1_const + DstInputFileData%DBEMT_Mod = SrcInputFileData%DBEMT_Mod + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts + if (allocated(SrcInputFileData%BldNd_OutList)) then + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) + if (.not. allocated(DstInputFileData%BldNd_OutList)) then + allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList + end if + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str + DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut + DstInputFileData%UAStartRad = SrcInputFileData%UAStartRad + DstInputFileData%UAEndRad = SrcInputFileData%UAEndRad + if (allocated(SrcInputFileData%rotors)) then + LB(1:1) = lbound(SrcInputFileData%rotors) + UB(1:1) = ubound(SrcInputFileData%rotors) + if (.not. allocated(DstInputFileData%rotors)) then + allocate(DstInputFileData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotInputFile(SrcInputFileData%rotors(i1), DstInputFileData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(AD_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%ADBlFile)) then + deallocate(InputFileData%ADBlFile) + end if + if (allocated(InputFileData%AFNames)) then + deallocate(InputFileData%AFNames) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%BldNd_OutList)) then + deallocate(InputFileData%BldNd_OutList) + end if + if (allocated(InputFileData%rotors)) then + LB(1:1) = lbound(InputFileData%rotors) + UB(1:1) = ubound(InputFileData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotInputFile(InputFileData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputFileData%rotors) + end if +end subroutine + +subroutine AD_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInputFile' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Echo) + call RegPack(Buf, InData%DTAero) + call RegPack(Buf, InData%WakeMod) + call RegPack(Buf, InData%AFAeroMod) + call RegPack(Buf, InData%TwrPotent) + call RegPack(Buf, InData%TwrShadow) + call RegPack(Buf, InData%TwrAero) + call RegPack(Buf, InData%FrozenWake) + call RegPack(Buf, InData%CavitCheck) + call RegPack(Buf, InData%Buoyancy) + call RegPack(Buf, InData%CompAA) + call RegPack(Buf, InData%AA_InputFile) + call RegPack(Buf, allocated(InData%ADBlFile)) + if (allocated(InData%ADBlFile)) then + call RegPackBounds(Buf, 1, lbound(InData%ADBlFile), ubound(InData%ADBlFile)) + call RegPack(Buf, InData%ADBlFile) + end if + call RegPack(Buf, InData%AirDens) + call RegPack(Buf, InData%KinVisc) + call RegPack(Buf, InData%Patm) + call RegPack(Buf, InData%Pvap) + call RegPack(Buf, InData%SpdSound) + call RegPack(Buf, InData%SkewMod) + call RegPack(Buf, InData%SkewModFactor) + call RegPack(Buf, InData%TipLoss) + call RegPack(Buf, InData%HubLoss) + call RegPack(Buf, InData%TanInd) + call RegPack(Buf, InData%AIDrag) + call RegPack(Buf, InData%TIDrag) + call RegPack(Buf, InData%IndToler) + call RegPack(Buf, InData%MaxIter) + call RegPack(Buf, InData%UAMod) + call RegPack(Buf, InData%FLookup) + call RegPack(Buf, InData%InCol_Alfa) + call RegPack(Buf, InData%InCol_Cl) + call RegPack(Buf, InData%InCol_Cd) + call RegPack(Buf, InData%InCol_Cm) + call RegPack(Buf, InData%InCol_Cpmin) + call RegPack(Buf, InData%AFTabMod) + call RegPack(Buf, InData%NumAFfiles) + call RegPack(Buf, InData%FVWFileName) + call RegPack(Buf, allocated(InData%AFNames)) + if (allocated(InData%AFNames)) then + call RegPackBounds(Buf, 1, lbound(InData%AFNames), ubound(InData%AFNames)) + call RegPack(Buf, InData%AFNames) + end if + call RegPack(Buf, InData%UseBlCm) + call RegPack(Buf, InData%SumPrint) + call RegPack(Buf, InData%NBlOuts) + call RegPack(Buf, InData%BlOutNd) + call RegPack(Buf, InData%NTwOuts) + call RegPack(Buf, InData%TwOutNd) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + call RegPack(Buf, InData%tau1_const) + call RegPack(Buf, InData%DBEMT_Mod) + call RegPack(Buf, InData%BldNd_NumOuts) + call RegPack(Buf, allocated(InData%BldNd_OutList)) + if (allocated(InData%BldNd_OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList), ubound(InData%BldNd_OutList)) + call RegPack(Buf, InData%BldNd_OutList) + end if + call RegPack(Buf, InData%BldNd_BlOutNd_Str) + call RegPack(Buf, InData%BldNd_BladesOut) + call RegPack(Buf, InData%UAStartRad) + call RegPack(Buf, InData%UAEndRad) + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotInputFile(Buf, InData%rotors(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInputFile' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DTAero) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WakeMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AFAeroMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrPotent) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrShadow) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrAero) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FrozenWake) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CavitCheck) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Buoyancy) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompAA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AA_InputFile) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ADBlFile)) deallocate(OutData%ADBlFile) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ADBlFile(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADBlFile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ADBlFile) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Patm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Pvap) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SkewMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SkewModFactor) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TipLoss) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubLoss) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TanInd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AIDrag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TIDrag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IndToler) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MaxIter) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UAMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FLookup) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InCol_Alfa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InCol_Cl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InCol_Cd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InCol_Cm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InCol_Cpmin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AFTabMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumAFfiles) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FVWFileName) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AFNames)) deallocate(OutData%AFNames) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFNames(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFNames.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFNames) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%UseBlCm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBlOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BlOutNd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NTwOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwOutNd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%tau1_const) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BldNd_OutList)) deallocate(OutData%BldNd_OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldNd_OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%BldNd_BlOutNd_Str) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldNd_BladesOut) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UAStartRad) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UAEndRad) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInputFile(Buf, OutData%rotors(i1)) ! rotors + end do + end if +end subroutine + +subroutine AD_CopyRotContinuousStateType(SrcRotContinuousStateTypeData, DstRotContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotContinuousStateType), intent(in) :: SrcRotContinuousStateTypeData + type(RotContinuousStateType), intent(inout) :: DstRotContinuousStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotContinuousStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_CopyContState(SrcRotContinuousStateTypeData%BEMT, DstRotContinuousStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyContState(SrcRotContinuousStateTypeData%AA, DstRotContinuousStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyRotContinuousStateType(RotContinuousStateTypeData, ErrStat, ErrMsg) + type(RotContinuousStateType), intent(inout) :: RotContinuousStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotContinuousStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_DestroyContState(RotContinuousStateTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyContState(RotContinuousStateTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotContinuousStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotContinuousStateType' + if (Buf%ErrStat >= AbortErrLev) return + call BEMT_PackContState(Buf, InData%BEMT) + call AA_PackContState(Buf, InData%AA) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotContinuousStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotContinuousStateType' + if (Buf%ErrStat /= ErrID_None) return + call BEMT_UnpackContState(Buf, OutData%BEMT) ! BEMT + call AA_UnpackContState(Buf, OutData%AA) ! AA +end subroutine + +subroutine AD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(AD_ContinuousStateType), intent(in) :: SrcContStateData + type(AD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%rotors)) then + LB(1:1) = lbound(SrcContStateData%rotors) + UB(1:1) = ubound(SrcContStateData%rotors) + if (.not. allocated(DstContStateData%rotors)) then + allocate(DstContStateData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotContinuousStateType(SrcContStateData%rotors(i1), DstContStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call FVW_CopyContState(SrcContStateData%FVW, DstContStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(AD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%rotors)) then + LB(1:1) = lbound(ContStateData%rotors) + UB(1:1) = ubound(ContStateData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotContinuousStateType(ContStateData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%rotors) + end if + call FVW_DestroyContState(ContStateData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotContinuousStateType(Buf, InData%rotors(i1)) + end do + end if + call FVW_PackContState(Buf, InData%FVW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotContinuousStateType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + call FVW_UnpackContState(Buf, OutData%FVW) ! FVW +end subroutine + +subroutine AD_CopyRotDiscreteStateType(SrcRotDiscreteStateTypeData, DstRotDiscreteStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotDiscreteStateType), intent(in) :: SrcRotDiscreteStateTypeData + type(RotDiscreteStateType), intent(inout) :: DstRotDiscreteStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotDiscreteStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_CopyDiscState(SrcRotDiscreteStateTypeData%BEMT, DstRotDiscreteStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyDiscState(SrcRotDiscreteStateTypeData%AA, DstRotDiscreteStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyRotDiscreteStateType(RotDiscreteStateTypeData, ErrStat, ErrMsg) + type(RotDiscreteStateType), intent(inout) :: RotDiscreteStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotDiscreteStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_DestroyDiscState(RotDiscreteStateTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyDiscState(RotDiscreteStateTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotDiscreteStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotDiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotDiscreteStateType' + if (Buf%ErrStat >= AbortErrLev) return + call BEMT_PackDiscState(Buf, InData%BEMT) + call AA_PackDiscState(Buf, InData%AA) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotDiscreteStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotDiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotDiscreteStateType' + if (Buf%ErrStat /= ErrID_None) return + call BEMT_UnpackDiscState(Buf, OutData%BEMT) ! BEMT + call AA_UnpackDiscState(Buf, OutData%AA) ! AA +end subroutine + +subroutine AD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(AD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(AD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDiscStateData%rotors)) then + LB(1:1) = lbound(SrcDiscStateData%rotors) + UB(1:1) = ubound(SrcDiscStateData%rotors) + if (.not. allocated(DstDiscStateData%rotors)) then + allocate(DstDiscStateData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotDiscreteStateType(SrcDiscStateData%rotors(i1), DstDiscStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call FVW_CopyDiscState(SrcDiscStateData%FVW, DstDiscStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(AD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%rotors)) then + LB(1:1) = lbound(DiscStateData%rotors) + UB(1:1) = ubound(DiscStateData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotDiscreteStateType(DiscStateData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%rotors) + end if + call FVW_DestroyDiscState(DiscStateData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotDiscreteStateType(Buf, InData%rotors(i1)) + end do + end if + call FVW_PackDiscState(Buf, InData%FVW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotDiscreteStateType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + call FVW_UnpackDiscState(Buf, OutData%FVW) ! FVW +end subroutine + +subroutine AD_CopyRotConstraintStateType(SrcRotConstraintStateTypeData, DstRotConstraintStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotConstraintStateType), intent(in) :: SrcRotConstraintStateTypeData + type(RotConstraintStateType), intent(inout) :: DstRotConstraintStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotConstraintStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_CopyConstrState(SrcRotConstraintStateTypeData%BEMT, DstRotConstraintStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyConstrState(SrcRotConstraintStateTypeData%AA, DstRotConstraintStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyRotConstraintStateType(RotConstraintStateTypeData, ErrStat, ErrMsg) + type(RotConstraintStateType), intent(inout) :: RotConstraintStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotConstraintStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_DestroyConstrState(RotConstraintStateTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyConstrState(RotConstraintStateTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotConstraintStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotConstraintStateType' + if (Buf%ErrStat >= AbortErrLev) return + call BEMT_PackConstrState(Buf, InData%BEMT) + call AA_PackConstrState(Buf, InData%AA) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotConstraintStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotConstraintStateType' + if (Buf%ErrStat /= ErrID_None) return + call BEMT_UnpackConstrState(Buf, OutData%BEMT) ! BEMT + call AA_UnpackConstrState(Buf, OutData%AA) ! AA +end subroutine + +subroutine AD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(AD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(AD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcConstrStateData%rotors)) then + LB(1:1) = lbound(SrcConstrStateData%rotors) + UB(1:1) = ubound(SrcConstrStateData%rotors) + if (.not. allocated(DstConstrStateData%rotors)) then + allocate(DstConstrStateData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotConstraintStateType(SrcConstrStateData%rotors(i1), DstConstrStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call FVW_CopyConstrState(SrcConstrStateData%FVW, DstConstrStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(AD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConstrStateData%rotors)) then + LB(1:1) = lbound(ConstrStateData%rotors) + UB(1:1) = ubound(ConstrStateData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotConstraintStateType(ConstrStateData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%rotors) + end if + call FVW_DestroyConstrState(ConstrStateData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotConstraintStateType(Buf, InData%rotors(i1)) + end do + end if + call FVW_PackConstrState(Buf, InData%FVW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotConstraintStateType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + call FVW_UnpackConstrState(Buf, OutData%FVW) ! FVW +end subroutine + +subroutine AD_CopyRotOtherStateType(SrcRotOtherStateTypeData, DstRotOtherStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotOtherStateType), intent(in) :: SrcRotOtherStateTypeData + type(RotOtherStateType), intent(inout) :: DstRotOtherStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotOtherStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_CopyOtherState(SrcRotOtherStateTypeData%BEMT, DstRotOtherStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyOtherState(SrcRotOtherStateTypeData%AA, DstRotOtherStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyRotOtherStateType(RotOtherStateTypeData, ErrStat, ErrMsg) + type(RotOtherStateType), intent(inout) :: RotOtherStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotOtherStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_DestroyOtherState(RotOtherStateTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyOtherState(RotOtherStateTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotOtherStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotOtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotOtherStateType' + if (Buf%ErrStat >= AbortErrLev) return + call BEMT_PackOtherState(Buf, InData%BEMT) + call AA_PackOtherState(Buf, InData%AA) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotOtherStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotOtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotOtherStateType' + if (Buf%ErrStat /= ErrID_None) return + call BEMT_UnpackOtherState(Buf, OutData%BEMT) ! BEMT + call AA_UnpackOtherState(Buf, OutData%AA) ! AA +end subroutine + +subroutine AD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(AD_OtherStateType), intent(in) :: SrcOtherStateData + type(AD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%rotors)) then + LB(1:1) = lbound(SrcOtherStateData%rotors) + UB(1:1) = ubound(SrcOtherStateData%rotors) + if (.not. allocated(DstOtherStateData%rotors)) then + allocate(DstOtherStateData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotOtherStateType(SrcOtherStateData%rotors(i1), DstOtherStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call FVW_CopyOtherState(SrcOtherStateData%FVW, DstOtherStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOtherStateData%WakeLocationPoints)) then + LB(1:2) = lbound(SrcOtherStateData%WakeLocationPoints) + UB(1:2) = ubound(SrcOtherStateData%WakeLocationPoints) + if (.not. allocated(DstOtherStateData%WakeLocationPoints)) then + allocate(DstOtherStateData%WakeLocationPoints(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%WakeLocationPoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%WakeLocationPoints = SrcOtherStateData%WakeLocationPoints + end if +end subroutine + +subroutine AD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(AD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%rotors)) then + LB(1:1) = lbound(OtherStateData%rotors) + UB(1:1) = ubound(OtherStateData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotOtherStateType(OtherStateData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%rotors) + end if + call FVW_DestroyOtherState(OtherStateData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OtherStateData%WakeLocationPoints)) then + deallocate(OtherStateData%WakeLocationPoints) + end if +end subroutine + +subroutine AD_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotOtherStateType(Buf, InData%rotors(i1)) + end do + end if + call FVW_PackOtherState(Buf, InData%FVW) + call RegPack(Buf, allocated(InData%WakeLocationPoints)) + if (allocated(InData%WakeLocationPoints)) then + call RegPackBounds(Buf, 2, lbound(InData%WakeLocationPoints), ubound(InData%WakeLocationPoints)) + call RegPack(Buf, InData%WakeLocationPoints) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotOtherStateType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + call FVW_UnpackOtherState(Buf, OutData%FVW) ! FVW + if (allocated(OutData%WakeLocationPoints)) deallocate(OutData%WakeLocationPoints) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WakeLocationPoints(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WakeLocationPoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WakeLocationPoints) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotMiscVarType), intent(inout) :: SrcRotMiscVarTypeData + type(RotMiscVarType), intent(inout) :: DstRotMiscVarTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotMiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_CopyMisc(SrcRotMiscVarTypeData%BEMT, DstRotMiscVarTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BEMT_CopyOutput(SrcRotMiscVarTypeData%BEMT_y, DstRotMiscVarTypeData%BEMT_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + LB(1:1) = lbound(SrcRotMiscVarTypeData%BEMT_u) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BEMT_u) + do i1 = LB(1), UB(1) + call BEMT_CopyInput(SrcRotMiscVarTypeData%BEMT_u(i1), DstRotMiscVarTypeData%BEMT_u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call AA_CopyMisc(SrcRotMiscVarTypeData%AA, DstRotMiscVarTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyOutput(SrcRotMiscVarTypeData%AA_y, DstRotMiscVarTypeData%AA_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyInput(SrcRotMiscVarTypeData%AA_u, DstRotMiscVarTypeData%AA_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotMiscVarTypeData%DisturbedInflow)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%DisturbedInflow) + UB(1:3) = ubound(SrcRotMiscVarTypeData%DisturbedInflow) + if (.not. allocated(DstRotMiscVarTypeData%DisturbedInflow)) then + allocate(DstRotMiscVarTypeData%DisturbedInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%DisturbedInflow.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%DisturbedInflow = SrcRotMiscVarTypeData%DisturbedInflow + end if + if (allocated(SrcRotMiscVarTypeData%orientationAnnulus)) then + LB(1:4) = lbound(SrcRotMiscVarTypeData%orientationAnnulus) + UB(1:4) = ubound(SrcRotMiscVarTypeData%orientationAnnulus) + if (.not. allocated(DstRotMiscVarTypeData%orientationAnnulus)) then + allocate(DstRotMiscVarTypeData%orientationAnnulus(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%orientationAnnulus.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%orientationAnnulus = SrcRotMiscVarTypeData%orientationAnnulus + end if + if (allocated(SrcRotMiscVarTypeData%AllOuts)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%AllOuts) + UB(1:1) = ubound(SrcRotMiscVarTypeData%AllOuts) + if (.not. allocated(DstRotMiscVarTypeData%AllOuts)) then + allocate(DstRotMiscVarTypeData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%AllOuts = SrcRotMiscVarTypeData%AllOuts + end if + if (allocated(SrcRotMiscVarTypeData%W_Twr)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%W_Twr) + UB(1:1) = ubound(SrcRotMiscVarTypeData%W_Twr) + if (.not. allocated(DstRotMiscVarTypeData%W_Twr)) then + allocate(DstRotMiscVarTypeData%W_Twr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%W_Twr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%W_Twr = SrcRotMiscVarTypeData%W_Twr + end if + if (allocated(SrcRotMiscVarTypeData%X_Twr)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%X_Twr) + UB(1:1) = ubound(SrcRotMiscVarTypeData%X_Twr) + if (.not. allocated(DstRotMiscVarTypeData%X_Twr)) then + allocate(DstRotMiscVarTypeData%X_Twr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X_Twr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%X_Twr = SrcRotMiscVarTypeData%X_Twr + end if + if (allocated(SrcRotMiscVarTypeData%Y_Twr)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%Y_Twr) + UB(1:1) = ubound(SrcRotMiscVarTypeData%Y_Twr) + if (.not. allocated(DstRotMiscVarTypeData%Y_Twr)) then + allocate(DstRotMiscVarTypeData%Y_Twr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y_Twr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Y_Twr = SrcRotMiscVarTypeData%Y_Twr + end if + if (allocated(SrcRotMiscVarTypeData%Curve)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Curve) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Curve) + if (.not. allocated(DstRotMiscVarTypeData%Curve)) then + allocate(DstRotMiscVarTypeData%Curve(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Curve.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Curve = SrcRotMiscVarTypeData%Curve + end if + if (allocated(SrcRotMiscVarTypeData%TwrClrnc)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrClrnc) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrClrnc) + if (.not. allocated(DstRotMiscVarTypeData%TwrClrnc)) then + allocate(DstRotMiscVarTypeData%TwrClrnc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrClrnc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%TwrClrnc = SrcRotMiscVarTypeData%TwrClrnc + end if + if (allocated(SrcRotMiscVarTypeData%X)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%X) + UB(1:2) = ubound(SrcRotMiscVarTypeData%X) + if (.not. allocated(DstRotMiscVarTypeData%X)) then + allocate(DstRotMiscVarTypeData%X(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%X = SrcRotMiscVarTypeData%X + end if + if (allocated(SrcRotMiscVarTypeData%Y)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Y) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Y) + if (.not. allocated(DstRotMiscVarTypeData%Y)) then + allocate(DstRotMiscVarTypeData%Y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Y = SrcRotMiscVarTypeData%Y + end if + if (allocated(SrcRotMiscVarTypeData%Z)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Z) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Z) + if (.not. allocated(DstRotMiscVarTypeData%Z)) then + allocate(DstRotMiscVarTypeData%Z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Z = SrcRotMiscVarTypeData%Z + end if + if (allocated(SrcRotMiscVarTypeData%M)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%M) + UB(1:2) = ubound(SrcRotMiscVarTypeData%M) + if (.not. allocated(DstRotMiscVarTypeData%M)) then + allocate(DstRotMiscVarTypeData%M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%M.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%M = SrcRotMiscVarTypeData%M + end if + if (allocated(SrcRotMiscVarTypeData%Mx)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Mx) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Mx) + if (.not. allocated(DstRotMiscVarTypeData%Mx)) then + allocate(DstRotMiscVarTypeData%Mx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Mx = SrcRotMiscVarTypeData%Mx + end if + if (allocated(SrcRotMiscVarTypeData%My)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%My) + UB(1:2) = ubound(SrcRotMiscVarTypeData%My) + if (.not. allocated(DstRotMiscVarTypeData%My)) then + allocate(DstRotMiscVarTypeData%My(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%My.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%My = SrcRotMiscVarTypeData%My + end if + if (allocated(SrcRotMiscVarTypeData%Mz)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Mz) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Mz) + if (.not. allocated(DstRotMiscVarTypeData%Mz)) then + allocate(DstRotMiscVarTypeData%Mz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Mz = SrcRotMiscVarTypeData%Mz + end if + DstRotMiscVarTypeData%V_DiskAvg = SrcRotMiscVarTypeData%V_DiskAvg + DstRotMiscVarTypeData%yaw = SrcRotMiscVarTypeData%yaw + DstRotMiscVarTypeData%tilt = SrcRotMiscVarTypeData%tilt + if (allocated(SrcRotMiscVarTypeData%hub_theta_x_root)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%hub_theta_x_root) + UB(1:1) = ubound(SrcRotMiscVarTypeData%hub_theta_x_root) + if (.not. allocated(DstRotMiscVarTypeData%hub_theta_x_root)) then + allocate(DstRotMiscVarTypeData%hub_theta_x_root(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%hub_theta_x_root.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%hub_theta_x_root = SrcRotMiscVarTypeData%hub_theta_x_root + end if + DstRotMiscVarTypeData%V_dot_x = SrcRotMiscVarTypeData%V_dot_x + call MeshCopy(SrcRotMiscVarTypeData%HubLoad, DstRotMiscVarTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotMiscVarTypeData%B_L_2_H_P)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_H_P) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_H_P) + if (.not. allocated(DstRotMiscVarTypeData%B_L_2_H_P)) then + allocate(DstRotMiscVarTypeData%B_L_2_H_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_H_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_H_P(i1), DstRotMiscVarTypeData%B_L_2_H_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotMiscVarTypeData%SigmaCavitCrit)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavitCrit) + UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavitCrit) + if (.not. allocated(DstRotMiscVarTypeData%SigmaCavitCrit)) then + allocate(DstRotMiscVarTypeData%SigmaCavitCrit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavitCrit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%SigmaCavitCrit = SrcRotMiscVarTypeData%SigmaCavitCrit + end if + if (allocated(SrcRotMiscVarTypeData%SigmaCavit)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavit) + UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavit) + if (.not. allocated(DstRotMiscVarTypeData%SigmaCavit)) then + allocate(DstRotMiscVarTypeData%SigmaCavit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%SigmaCavit = SrcRotMiscVarTypeData%SigmaCavit + end if + if (allocated(SrcRotMiscVarTypeData%CavitWarnSet)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%CavitWarnSet) + UB(1:2) = ubound(SrcRotMiscVarTypeData%CavitWarnSet) + if (.not. allocated(DstRotMiscVarTypeData%CavitWarnSet)) then + allocate(DstRotMiscVarTypeData%CavitWarnSet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%CavitWarnSet.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%CavitWarnSet = SrcRotMiscVarTypeData%CavitWarnSet + end if + if (allocated(SrcRotMiscVarTypeData%BlFB)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%BlFB) + UB(1:3) = ubound(SrcRotMiscVarTypeData%BlFB) + if (.not. allocated(DstRotMiscVarTypeData%BlFB)) then + allocate(DstRotMiscVarTypeData%BlFB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BlFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%BlFB = SrcRotMiscVarTypeData%BlFB + end if + if (allocated(SrcRotMiscVarTypeData%BlMB)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%BlMB) + UB(1:3) = ubound(SrcRotMiscVarTypeData%BlMB) + if (.not. allocated(DstRotMiscVarTypeData%BlMB)) then + allocate(DstRotMiscVarTypeData%BlMB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BlMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%BlMB = SrcRotMiscVarTypeData%BlMB + end if + if (allocated(SrcRotMiscVarTypeData%TwrFB)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFB) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFB) + if (.not. allocated(DstRotMiscVarTypeData%TwrFB)) then + allocate(DstRotMiscVarTypeData%TwrFB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%TwrFB = SrcRotMiscVarTypeData%TwrFB + end if + if (allocated(SrcRotMiscVarTypeData%TwrMB)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrMB) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrMB) + if (.not. allocated(DstRotMiscVarTypeData%TwrMB)) then + allocate(DstRotMiscVarTypeData%TwrMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%TwrMB = SrcRotMiscVarTypeData%TwrMB + end if + if (allocated(SrcRotMiscVarTypeData%HubFB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubFB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubFB) + if (.not. allocated(DstRotMiscVarTypeData%HubFB)) then + allocate(DstRotMiscVarTypeData%HubFB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%HubFB = SrcRotMiscVarTypeData%HubFB + end if + if (allocated(SrcRotMiscVarTypeData%HubMB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubMB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubMB) + if (.not. allocated(DstRotMiscVarTypeData%HubMB)) then + allocate(DstRotMiscVarTypeData%HubMB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%HubMB = SrcRotMiscVarTypeData%HubMB + end if + if (allocated(SrcRotMiscVarTypeData%NacFB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFB) + if (.not. allocated(DstRotMiscVarTypeData%NacFB)) then + allocate(DstRotMiscVarTypeData%NacFB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%NacFB = SrcRotMiscVarTypeData%NacFB + end if + if (allocated(SrcRotMiscVarTypeData%NacMB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMB) + if (.not. allocated(DstRotMiscVarTypeData%NacMB)) then + allocate(DstRotMiscVarTypeData%NacMB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB + end if + if (allocated(SrcRotMiscVarTypeData%BladeRootLoad)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeRootLoad) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeRootLoad) + if (.not. allocated(DstRotMiscVarTypeData%BladeRootLoad)) then + allocate(DstRotMiscVarTypeData%BladeRootLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeRootLoad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotMiscVarTypeData%BladeRootLoad(i1), DstRotMiscVarTypeData%BladeRootLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotMiscVarTypeData%B_L_2_R_P)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_R_P) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_R_P) + if (.not. allocated(DstRotMiscVarTypeData%B_L_2_R_P)) then + allocate(DstRotMiscVarTypeData%B_L_2_R_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_R_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_R_P(i1), DstRotMiscVarTypeData%B_L_2_R_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoadPoint)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) + if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) then + allocate(DstRotMiscVarTypeData%BladeBuoyLoadPoint(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoadPoint.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoadPoint(i1), DstRotMiscVarTypeData%BladeBuoyLoadPoint(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoad)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoad) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoad) + if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoad)) then + allocate(DstRotMiscVarTypeData%BladeBuoyLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoad(i1), DstRotMiscVarTypeData%BladeBuoyLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotMiscVarTypeData%B_P_2_B_L)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_P_2_B_L) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_P_2_B_L) + if (.not. allocated(DstRotMiscVarTypeData%B_P_2_B_L)) then + allocate(DstRotMiscVarTypeData%B_P_2_B_L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_P_2_B_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_P_2_B_L(i1), DstRotMiscVarTypeData%B_P_2_B_L(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcRotMiscVarTypeData%TwrBuoyLoadPoint, DstRotMiscVarTypeData%TwrBuoyLoadPoint, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotMiscVarTypeData%TwrBuoyLoad, DstRotMiscVarTypeData%TwrBuoyLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%T_P_2_T_L, DstRotMiscVarTypeData%T_P_2_T_L, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstRotMiscVarTypeData%FirstWarn_TowerStrike = SrcRotMiscVarTypeData%FirstWarn_TowerStrike + DstRotMiscVarTypeData%AvgDiskVel = SrcRotMiscVarTypeData%AvgDiskVel + DstRotMiscVarTypeData%AvgDiskVelDist = SrcRotMiscVarTypeData%AvgDiskVelDist + DstRotMiscVarTypeData%TFinAlpha = SrcRotMiscVarTypeData%TFinAlpha + DstRotMiscVarTypeData%TFinRe = SrcRotMiscVarTypeData%TFinRe + DstRotMiscVarTypeData%TFinVrel = SrcRotMiscVarTypeData%TFinVrel + DstRotMiscVarTypeData%TFinVund_i = SrcRotMiscVarTypeData%TFinVund_i + DstRotMiscVarTypeData%TFinVind_i = SrcRotMiscVarTypeData%TFinVind_i + DstRotMiscVarTypeData%TFinVrel_i = SrcRotMiscVarTypeData%TFinVrel_i + DstRotMiscVarTypeData%TFinSTV_i = SrcRotMiscVarTypeData%TFinSTV_i + DstRotMiscVarTypeData%TFinF_i = SrcRotMiscVarTypeData%TFinF_i + DstRotMiscVarTypeData%TFinM_i = SrcRotMiscVarTypeData%TFinM_i +end subroutine + +subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) + type(RotMiscVarType), intent(inout) :: RotMiscVarTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotMiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_DestroyMisc(RotMiscVarTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BEMT_DestroyOutput(RotMiscVarTypeData%BEMT_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + LB(1:1) = lbound(RotMiscVarTypeData%BEMT_u) + UB(1:1) = ubound(RotMiscVarTypeData%BEMT_u) + do i1 = LB(1), UB(1) + call BEMT_DestroyInput(RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call AA_DestroyMisc(RotMiscVarTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyOutput(RotMiscVarTypeData%AA_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyInput(RotMiscVarTypeData%AA_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotMiscVarTypeData%DisturbedInflow)) then + deallocate(RotMiscVarTypeData%DisturbedInflow) + end if + if (allocated(RotMiscVarTypeData%orientationAnnulus)) then + deallocate(RotMiscVarTypeData%orientationAnnulus) + end if + if (allocated(RotMiscVarTypeData%AllOuts)) then + deallocate(RotMiscVarTypeData%AllOuts) + end if + if (allocated(RotMiscVarTypeData%W_Twr)) then + deallocate(RotMiscVarTypeData%W_Twr) + end if + if (allocated(RotMiscVarTypeData%X_Twr)) then + deallocate(RotMiscVarTypeData%X_Twr) + end if + if (allocated(RotMiscVarTypeData%Y_Twr)) then + deallocate(RotMiscVarTypeData%Y_Twr) + end if + if (allocated(RotMiscVarTypeData%Curve)) then + deallocate(RotMiscVarTypeData%Curve) + end if + if (allocated(RotMiscVarTypeData%TwrClrnc)) then + deallocate(RotMiscVarTypeData%TwrClrnc) + end if + if (allocated(RotMiscVarTypeData%X)) then + deallocate(RotMiscVarTypeData%X) + end if + if (allocated(RotMiscVarTypeData%Y)) then + deallocate(RotMiscVarTypeData%Y) + end if + if (allocated(RotMiscVarTypeData%Z)) then + deallocate(RotMiscVarTypeData%Z) + end if + if (allocated(RotMiscVarTypeData%M)) then + deallocate(RotMiscVarTypeData%M) + end if + if (allocated(RotMiscVarTypeData%Mx)) then + deallocate(RotMiscVarTypeData%Mx) + end if + if (allocated(RotMiscVarTypeData%My)) then + deallocate(RotMiscVarTypeData%My) + end if + if (allocated(RotMiscVarTypeData%Mz)) then + deallocate(RotMiscVarTypeData%Mz) + end if + if (allocated(RotMiscVarTypeData%hub_theta_x_root)) then + deallocate(RotMiscVarTypeData%hub_theta_x_root) + end if + call MeshDestroy( RotMiscVarTypeData%HubLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotMiscVarTypeData%B_L_2_H_P)) then + LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_H_P) + UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_H_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%B_L_2_H_P) + end if + if (allocated(RotMiscVarTypeData%SigmaCavitCrit)) then + deallocate(RotMiscVarTypeData%SigmaCavitCrit) + end if + if (allocated(RotMiscVarTypeData%SigmaCavit)) then + deallocate(RotMiscVarTypeData%SigmaCavit) + end if + if (allocated(RotMiscVarTypeData%CavitWarnSet)) then + deallocate(RotMiscVarTypeData%CavitWarnSet) + end if + if (allocated(RotMiscVarTypeData%BlFB)) then + deallocate(RotMiscVarTypeData%BlFB) + end if + if (allocated(RotMiscVarTypeData%BlMB)) then + deallocate(RotMiscVarTypeData%BlMB) + end if + if (allocated(RotMiscVarTypeData%TwrFB)) then + deallocate(RotMiscVarTypeData%TwrFB) + end if + if (allocated(RotMiscVarTypeData%TwrMB)) then + deallocate(RotMiscVarTypeData%TwrMB) + end if + if (allocated(RotMiscVarTypeData%HubFB)) then + deallocate(RotMiscVarTypeData%HubFB) + end if + if (allocated(RotMiscVarTypeData%HubMB)) then + deallocate(RotMiscVarTypeData%HubMB) + end if + if (allocated(RotMiscVarTypeData%NacFB)) then + deallocate(RotMiscVarTypeData%NacFB) + end if + if (allocated(RotMiscVarTypeData%NacMB)) then + deallocate(RotMiscVarTypeData%NacMB) + end if + if (allocated(RotMiscVarTypeData%BladeRootLoad)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeRootLoad) + UB(1:1) = ubound(RotMiscVarTypeData%BladeRootLoad) + do i1 = LB(1), UB(1) + call MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%BladeRootLoad) + end if + if (allocated(RotMiscVarTypeData%B_L_2_R_P)) then + LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_R_P) + UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_R_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%B_L_2_R_P) + end if + if (allocated(RotMiscVarTypeData%BladeBuoyLoadPoint)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoadPoint) + UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoadPoint) + do i1 = LB(1), UB(1) + call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoadPoint(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%BladeBuoyLoadPoint) + end if + if (allocated(RotMiscVarTypeData%BladeBuoyLoad)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoad) + UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoad) + do i1 = LB(1), UB(1) + call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoad(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%BladeBuoyLoad) + end if + if (allocated(RotMiscVarTypeData%B_P_2_B_L)) then + LB(1:1) = lbound(RotMiscVarTypeData%B_P_2_B_L) + UB(1:1) = ubound(RotMiscVarTypeData%B_P_2_B_L) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%B_P_2_B_L) + end if + call MeshDestroy( RotMiscVarTypeData%TwrBuoyLoadPoint, ErrStat2, ErrMsg2) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotMiscVarType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotMiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotMiscVarType' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + if (Buf%ErrStat >= AbortErrLev) return + call BEMT_PackMisc(Buf, InData%BEMT) + call BEMT_PackOutput(Buf, InData%BEMT_y) + LB(1:1) = lbound(InData%BEMT_u) + UB(1:1) = ubound(InData%BEMT_u) + do i1 = LB(1), UB(1) + call BEMT_PackInput(Buf, InData%BEMT_u(i1)) + end do + call AA_PackMisc(Buf, InData%AA) + call AA_PackOutput(Buf, InData%AA_y) + call AA_PackInput(Buf, InData%AA_u) + call RegPack(Buf, allocated(InData%DisturbedInflow)) + if (allocated(InData%DisturbedInflow)) then + call RegPackBounds(Buf, 3, lbound(InData%DisturbedInflow), ubound(InData%DisturbedInflow)) + call RegPack(Buf, InData%DisturbedInflow) + end if + call RegPack(Buf, allocated(InData%orientationAnnulus)) + if (allocated(InData%orientationAnnulus)) then + call RegPackBounds(Buf, 4, lbound(InData%orientationAnnulus), ubound(InData%orientationAnnulus)) + call RegPack(Buf, InData%orientationAnnulus) + end if + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + call RegPack(Buf, allocated(InData%W_Twr)) + if (allocated(InData%W_Twr)) then + call RegPackBounds(Buf, 1, lbound(InData%W_Twr), ubound(InData%W_Twr)) + call RegPack(Buf, InData%W_Twr) + end if + call RegPack(Buf, allocated(InData%X_Twr)) + if (allocated(InData%X_Twr)) then + call RegPackBounds(Buf, 1, lbound(InData%X_Twr), ubound(InData%X_Twr)) + call RegPack(Buf, InData%X_Twr) + end if + call RegPack(Buf, allocated(InData%Y_Twr)) + if (allocated(InData%Y_Twr)) then + call RegPackBounds(Buf, 1, lbound(InData%Y_Twr), ubound(InData%Y_Twr)) + call RegPack(Buf, InData%Y_Twr) + end if + call RegPack(Buf, allocated(InData%Curve)) + if (allocated(InData%Curve)) then + call RegPackBounds(Buf, 2, lbound(InData%Curve), ubound(InData%Curve)) + call RegPack(Buf, InData%Curve) + end if + call RegPack(Buf, allocated(InData%TwrClrnc)) + if (allocated(InData%TwrClrnc)) then + call RegPackBounds(Buf, 2, lbound(InData%TwrClrnc), ubound(InData%TwrClrnc)) + call RegPack(Buf, InData%TwrClrnc) + end if + call RegPack(Buf, allocated(InData%X)) + if (allocated(InData%X)) then + call RegPackBounds(Buf, 2, lbound(InData%X), ubound(InData%X)) + call RegPack(Buf, InData%X) + end if + call RegPack(Buf, allocated(InData%Y)) + if (allocated(InData%Y)) then + call RegPackBounds(Buf, 2, lbound(InData%Y), ubound(InData%Y)) + call RegPack(Buf, InData%Y) + end if + call RegPack(Buf, allocated(InData%Z)) + if (allocated(InData%Z)) then + call RegPackBounds(Buf, 2, lbound(InData%Z), ubound(InData%Z)) + call RegPack(Buf, InData%Z) + end if + call RegPack(Buf, allocated(InData%M)) + if (allocated(InData%M)) then + call RegPackBounds(Buf, 2, lbound(InData%M), ubound(InData%M)) + call RegPack(Buf, InData%M) + end if + call RegPack(Buf, allocated(InData%Mx)) + if (allocated(InData%Mx)) then + call RegPackBounds(Buf, 2, lbound(InData%Mx), ubound(InData%Mx)) + call RegPack(Buf, InData%Mx) + end if + call RegPack(Buf, allocated(InData%My)) + if (allocated(InData%My)) then + call RegPackBounds(Buf, 2, lbound(InData%My), ubound(InData%My)) + call RegPack(Buf, InData%My) + end if + call RegPack(Buf, allocated(InData%Mz)) + if (allocated(InData%Mz)) then + call RegPackBounds(Buf, 2, lbound(InData%Mz), ubound(InData%Mz)) + call RegPack(Buf, InData%Mz) + end if + call RegPack(Buf, InData%V_DiskAvg) + call RegPack(Buf, InData%yaw) + call RegPack(Buf, InData%tilt) + call RegPack(Buf, allocated(InData%hub_theta_x_root)) + if (allocated(InData%hub_theta_x_root)) then + call RegPackBounds(Buf, 1, lbound(InData%hub_theta_x_root), ubound(InData%hub_theta_x_root)) + call RegPack(Buf, InData%hub_theta_x_root) + end if + call RegPack(Buf, InData%V_dot_x) + call MeshPack(Buf, InData%HubLoad) + call RegPack(Buf, allocated(InData%B_L_2_H_P)) + if (allocated(InData%B_L_2_H_P)) then + call RegPackBounds(Buf, 1, lbound(InData%B_L_2_H_P), ubound(InData%B_L_2_H_P)) + LB(1:1) = lbound(InData%B_L_2_H_P) + UB(1:1) = ubound(InData%B_L_2_H_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%B_L_2_H_P(i1)) + end do + end if + call RegPack(Buf, allocated(InData%SigmaCavitCrit)) + if (allocated(InData%SigmaCavitCrit)) then + call RegPackBounds(Buf, 2, lbound(InData%SigmaCavitCrit), ubound(InData%SigmaCavitCrit)) + call RegPack(Buf, InData%SigmaCavitCrit) + end if + call RegPack(Buf, allocated(InData%SigmaCavit)) + if (allocated(InData%SigmaCavit)) then + call RegPackBounds(Buf, 2, lbound(InData%SigmaCavit), ubound(InData%SigmaCavit)) + call RegPack(Buf, InData%SigmaCavit) + end if + call RegPack(Buf, allocated(InData%CavitWarnSet)) + if (allocated(InData%CavitWarnSet)) then + call RegPackBounds(Buf, 2, lbound(InData%CavitWarnSet), ubound(InData%CavitWarnSet)) + call RegPack(Buf, InData%CavitWarnSet) + end if + call RegPack(Buf, allocated(InData%BlFB)) + if (allocated(InData%BlFB)) then + call RegPackBounds(Buf, 3, lbound(InData%BlFB), ubound(InData%BlFB)) + call RegPack(Buf, InData%BlFB) + end if + call RegPack(Buf, allocated(InData%BlMB)) + if (allocated(InData%BlMB)) then + call RegPackBounds(Buf, 3, lbound(InData%BlMB), ubound(InData%BlMB)) + call RegPack(Buf, InData%BlMB) + end if + call RegPack(Buf, allocated(InData%TwrFB)) + if (allocated(InData%TwrFB)) then + call RegPackBounds(Buf, 2, lbound(InData%TwrFB), ubound(InData%TwrFB)) + call RegPack(Buf, InData%TwrFB) + end if + call RegPack(Buf, allocated(InData%TwrMB)) + if (allocated(InData%TwrMB)) then + call RegPackBounds(Buf, 2, lbound(InData%TwrMB), ubound(InData%TwrMB)) + call RegPack(Buf, InData%TwrMB) + end if + call RegPack(Buf, allocated(InData%HubFB)) + if (allocated(InData%HubFB)) then + call RegPackBounds(Buf, 1, lbound(InData%HubFB), ubound(InData%HubFB)) + call RegPack(Buf, InData%HubFB) + end if + call RegPack(Buf, allocated(InData%HubMB)) + if (allocated(InData%HubMB)) then + call RegPackBounds(Buf, 1, lbound(InData%HubMB), ubound(InData%HubMB)) + call RegPack(Buf, InData%HubMB) + end if + call RegPack(Buf, allocated(InData%NacFB)) + if (allocated(InData%NacFB)) then + call RegPackBounds(Buf, 1, lbound(InData%NacFB), ubound(InData%NacFB)) + call RegPack(Buf, InData%NacFB) + end if + call RegPack(Buf, allocated(InData%NacMB)) + if (allocated(InData%NacMB)) then + call RegPackBounds(Buf, 1, lbound(InData%NacMB), ubound(InData%NacMB)) + call RegPack(Buf, InData%NacMB) + end if + call RegPack(Buf, allocated(InData%BladeRootLoad)) + if (allocated(InData%BladeRootLoad)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeRootLoad), ubound(InData%BladeRootLoad)) + LB(1:1) = lbound(InData%BladeRootLoad) + UB(1:1) = ubound(InData%BladeRootLoad) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeRootLoad(i1)) + end do + end if + call RegPack(Buf, allocated(InData%B_L_2_R_P)) + if (allocated(InData%B_L_2_R_P)) then + call RegPackBounds(Buf, 1, lbound(InData%B_L_2_R_P), ubound(InData%B_L_2_R_P)) + LB(1:1) = lbound(InData%B_L_2_R_P) + UB(1:1) = ubound(InData%B_L_2_R_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%B_L_2_R_P(i1)) + end do + end if + call RegPack(Buf, allocated(InData%BladeBuoyLoadPoint)) + if (allocated(InData%BladeBuoyLoadPoint)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeBuoyLoadPoint), ubound(InData%BladeBuoyLoadPoint)) + LB(1:1) = lbound(InData%BladeBuoyLoadPoint) + UB(1:1) = ubound(InData%BladeBuoyLoadPoint) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeBuoyLoadPoint(i1)) + end do + end if + call RegPack(Buf, allocated(InData%BladeBuoyLoad)) + if (allocated(InData%BladeBuoyLoad)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeBuoyLoad), ubound(InData%BladeBuoyLoad)) + LB(1:1) = lbound(InData%BladeBuoyLoad) + UB(1:1) = ubound(InData%BladeBuoyLoad) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeBuoyLoad(i1)) + end do + end if + call RegPack(Buf, allocated(InData%B_P_2_B_L)) + if (allocated(InData%B_P_2_B_L)) then + call RegPackBounds(Buf, 1, lbound(InData%B_P_2_B_L), ubound(InData%B_P_2_B_L)) + LB(1:1) = lbound(InData%B_P_2_B_L) + UB(1:1) = ubound(InData%B_P_2_B_L) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%B_P_2_B_L(i1)) + end do + end if + call MeshPack(Buf, InData%TwrBuoyLoadPoint) + call MeshPack(Buf, InData%TwrBuoyLoad) + call NWTC_Library_PackMeshMapType(Buf, InData%T_P_2_T_L) + call RegPack(Buf, InData%FirstWarn_TowerStrike) + call RegPack(Buf, InData%AvgDiskVel) + call RegPack(Buf, InData%AvgDiskVelDist) + call RegPack(Buf, InData%TFinAlpha) + call RegPack(Buf, InData%TFinRe) + call RegPack(Buf, InData%TFinVrel) + call RegPack(Buf, InData%TFinVund_i) + call RegPack(Buf, InData%TFinVind_i) + call RegPack(Buf, InData%TFinVrel_i) + call RegPack(Buf, InData%TFinSTV_i) + call RegPack(Buf, InData%TFinF_i) + call RegPack(Buf, InData%TFinM_i) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotMiscVarType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotMiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotMiscVarType' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call BEMT_UnpackMisc(Buf, OutData%BEMT) ! BEMT + call BEMT_UnpackOutput(Buf, OutData%BEMT_y) ! BEMT_y + LB(1:1) = lbound(OutData%BEMT_u) + UB(1:1) = ubound(OutData%BEMT_u) + do i1 = LB(1), UB(1) + call BEMT_UnpackInput(Buf, OutData%BEMT_u(i1)) ! BEMT_u + end do + call AA_UnpackMisc(Buf, OutData%AA) ! AA + call AA_UnpackOutput(Buf, OutData%AA_y) ! AA_y + call AA_UnpackInput(Buf, OutData%AA_u) ! AA_u + if (allocated(OutData%DisturbedInflow)) deallocate(OutData%DisturbedInflow) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DisturbedInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DisturbedInflow.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DisturbedInflow) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%orientationAnnulus)) deallocate(OutData%orientationAnnulus) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%orientationAnnulus(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%orientationAnnulus.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%orientationAnnulus) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%W_Twr)) deallocate(OutData%W_Twr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W_Twr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W_Twr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%W_Twr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%X_Twr)) deallocate(OutData%X_Twr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X_Twr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Twr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X_Twr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Y_Twr)) deallocate(OutData%Y_Twr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y_Twr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Twr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y_Twr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Curve)) deallocate(OutData%Curve) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Curve(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Curve.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Curve) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrClrnc)) deallocate(OutData%TwrClrnc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrClrnc(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrClrnc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrClrnc) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%X)) deallocate(OutData%X) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Y)) deallocate(OutData%Y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Z)) deallocate(OutData%Z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Z(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Z) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%M)) deallocate(OutData%M) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Mx)) deallocate(OutData%Mx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Mx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%My)) deallocate(OutData%My) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%My(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%My.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%My) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Mz)) deallocate(OutData%Mz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Mz) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%V_DiskAvg) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%yaw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tilt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%hub_theta_x_root)) deallocate(OutData%hub_theta_x_root) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%hub_theta_x_root(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%hub_theta_x_root.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%hub_theta_x_root) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%V_dot_x) + if (RegCheckErr(Buf, RoutineName)) return + call MeshUnpack(Buf, OutData%HubLoad) ! HubLoad + if (allocated(OutData%B_L_2_H_P)) deallocate(OutData%B_L_2_H_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B_L_2_H_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_H_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%B_L_2_H_P(i1)) ! B_L_2_H_P + end do + end if + if (allocated(OutData%SigmaCavitCrit)) deallocate(OutData%SigmaCavitCrit) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SigmaCavitCrit(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavitCrit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SigmaCavitCrit) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SigmaCavit)) deallocate(OutData%SigmaCavit) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SigmaCavit(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SigmaCavit) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CavitWarnSet)) deallocate(OutData%CavitWarnSet) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CavitWarnSet(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CavitWarnSet.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CavitWarnSet) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlFB)) deallocate(OutData%BlFB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlFB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlFB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlFB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlMB)) deallocate(OutData%BlMB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlMB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlMB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlMB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrFB)) deallocate(OutData%TwrFB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrFB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrFB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrFB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrMB)) deallocate(OutData%TwrMB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrMB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrMB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrMB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%HubFB)) deallocate(OutData%HubFB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HubFB(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HubFB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HubFB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%HubMB)) deallocate(OutData%HubMB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HubMB(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HubMB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HubMB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%NacFB)) deallocate(OutData%NacFB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NacFB(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NacFB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NacFB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%NacMB)) deallocate(OutData%NacMB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NacMB(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NacMB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NacMB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BladeRootLoad)) deallocate(OutData%BladeRootLoad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootLoad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootLoad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeRootLoad(i1)) ! BladeRootLoad + end do + end if + if (allocated(OutData%B_L_2_R_P)) deallocate(OutData%B_L_2_R_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B_L_2_R_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_R_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%B_L_2_R_P(i1)) ! B_L_2_R_P + end do + end if + if (allocated(OutData%BladeBuoyLoadPoint)) deallocate(OutData%BladeBuoyLoadPoint) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeBuoyLoadPoint(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoadPoint.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeBuoyLoadPoint(i1)) ! BladeBuoyLoadPoint + end do + end if + if (allocated(OutData%BladeBuoyLoad)) deallocate(OutData%BladeBuoyLoad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeBuoyLoad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeBuoyLoad(i1)) ! BladeBuoyLoad + end do + end if + if (allocated(OutData%B_P_2_B_L)) deallocate(OutData%B_P_2_B_L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B_P_2_B_L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_P_2_B_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%B_P_2_B_L(i1)) ! B_P_2_B_L + end do + end if + call MeshUnpack(Buf, OutData%TwrBuoyLoadPoint) ! TwrBuoyLoadPoint + call MeshUnpack(Buf, OutData%TwrBuoyLoad) ! TwrBuoyLoad + call NWTC_Library_UnpackMeshMapType(Buf, OutData%T_P_2_T_L) ! T_P_2_T_L + call RegUnpack(Buf, OutData%FirstWarn_TowerStrike) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AvgDiskVel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AvgDiskVelDist) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinAlpha) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinRe) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinVrel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinVund_i) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinVind_i) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinVrel_i) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinSTV_i) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinF_i) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinM_i) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(AD_MiscVarType), intent(inout) :: SrcMiscData + type(AD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%rotors)) then + LB(1:1) = lbound(SrcMiscData%rotors) + UB(1:1) = ubound(SrcMiscData%rotors) + if (.not. allocated(DstMiscData%rotors)) then + allocate(DstMiscData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotMiscVarType(SrcMiscData%rotors(i1), DstMiscData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%FVW_u)) then + LB(1:1) = lbound(SrcMiscData%FVW_u) + UB(1:1) = ubound(SrcMiscData%FVW_u) + if (.not. allocated(DstMiscData%FVW_u)) then + allocate(DstMiscData%FVW_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FVW_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyInput(SrcMiscData%FVW_u(i1), DstMiscData%FVW_u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call FVW_CopyOutput(SrcMiscData%FVW_y, DstMiscData%FVW_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyMisc(SrcMiscData%FVW, DstMiscData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%WindPos)) then + LB(1:2) = lbound(SrcMiscData%WindPos) + UB(1:2) = ubound(SrcMiscData%WindPos) + if (.not. allocated(DstMiscData%WindPos)) then + allocate(DstMiscData%WindPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindPos = SrcMiscData%WindPos + end if + if (allocated(SrcMiscData%WindVel)) then + LB(1:2) = lbound(SrcMiscData%WindVel) + UB(1:2) = ubound(SrcMiscData%WindVel) + if (.not. allocated(DstMiscData%WindVel)) then + allocate(DstMiscData%WindVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindVel = SrcMiscData%WindVel + end if + if (allocated(SrcMiscData%WindAcc)) then + LB(1:2) = lbound(SrcMiscData%WindAcc) + UB(1:2) = ubound(SrcMiscData%WindAcc) + if (.not. allocated(DstMiscData%WindAcc)) then + allocate(DstMiscData%WindAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAcc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindAcc = SrcMiscData%WindAcc + end if +end subroutine + +subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(AD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%rotors)) then + LB(1:1) = lbound(MiscData%rotors) + UB(1:1) = ubound(MiscData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotMiscVarType(MiscData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%rotors) + end if + if (allocated(MiscData%FVW_u)) then + LB(1:1) = lbound(MiscData%FVW_u) + UB(1:1) = ubound(MiscData%FVW_u) + do i1 = LB(1), UB(1) + call FVW_DestroyInput(MiscData%FVW_u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%FVW_u) + end if + call FVW_DestroyOutput(MiscData%FVW_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyMisc(MiscData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%WindPos)) then + deallocate(MiscData%WindPos) + end if + if (allocated(MiscData%WindVel)) then + deallocate(MiscData%WindVel) + end if + if (allocated(MiscData%WindAcc)) then + deallocate(MiscData%WindAcc) + end if +end subroutine + +subroutine AD_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotMiscVarType(Buf, InData%rotors(i1)) + end do + end if + call RegPack(Buf, allocated(InData%FVW_u)) + if (allocated(InData%FVW_u)) then + call RegPackBounds(Buf, 1, lbound(InData%FVW_u), ubound(InData%FVW_u)) + LB(1:1) = lbound(InData%FVW_u) + UB(1:1) = ubound(InData%FVW_u) + do i1 = LB(1), UB(1) + call FVW_PackInput(Buf, InData%FVW_u(i1)) + end do + end if + call FVW_PackOutput(Buf, InData%FVW_y) + call FVW_PackMisc(Buf, InData%FVW) + call RegPack(Buf, allocated(InData%WindPos)) + if (allocated(InData%WindPos)) then + call RegPackBounds(Buf, 2, lbound(InData%WindPos), ubound(InData%WindPos)) + call RegPack(Buf, InData%WindPos) + end if + call RegPack(Buf, allocated(InData%WindVel)) + if (allocated(InData%WindVel)) then + call RegPackBounds(Buf, 2, lbound(InData%WindVel), ubound(InData%WindVel)) + call RegPack(Buf, InData%WindVel) + end if + call RegPack(Buf, allocated(InData%WindAcc)) + if (allocated(InData%WindAcc)) then + call RegPackBounds(Buf, 2, lbound(InData%WindAcc), ubound(InData%WindAcc)) + call RegPack(Buf, InData%WindAcc) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotMiscVarType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + if (allocated(OutData%FVW_u)) deallocate(OutData%FVW_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FVW_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackInput(Buf, OutData%FVW_u(i1)) ! FVW_u + end do + end if + call FVW_UnpackOutput(Buf, OutData%FVW_y) ! FVW_y + call FVW_UnpackMisc(Buf, OutData%FVW) ! FVW + if (allocated(OutData%WindPos)) deallocate(OutData%WindPos) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindPos) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WindVel)) deallocate(OutData%WindVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WindAcc)) deallocate(OutData%WindAcc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindAcc(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindAcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindAcc) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotParameterType), intent(in) :: SrcRotParameterTypeData + type(RotParameterType), intent(inout) :: DstRotParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotParameterType' + ErrStat = ErrID_None + ErrMsg = '' + DstRotParameterTypeData%NumBlades = SrcRotParameterTypeData%NumBlades + DstRotParameterTypeData%NumBlNds = SrcRotParameterTypeData%NumBlNds + DstRotParameterTypeData%NumTwrNds = SrcRotParameterTypeData%NumTwrNds + if (allocated(SrcRotParameterTypeData%TwrDiam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrDiam) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrDiam) + if (.not. allocated(DstRotParameterTypeData%TwrDiam)) then + allocate(DstRotParameterTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDiam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam + end if + if (allocated(SrcRotParameterTypeData%TwrCd)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCd) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCd) + if (.not. allocated(DstRotParameterTypeData%TwrCd)) then + allocate(DstRotParameterTypeData%TwrCd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd + end if + if (allocated(SrcRotParameterTypeData%TwrTI)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrTI) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrTI) + if (.not. allocated(DstRotParameterTypeData%TwrTI)) then + allocate(DstRotParameterTypeData%TwrTI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI + end if + if (allocated(SrcRotParameterTypeData%BlTwist)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlTwist) + UB(1:2) = ubound(SrcRotParameterTypeData%BlTwist) + if (.not. allocated(DstRotParameterTypeData%BlTwist)) then + allocate(DstRotParameterTypeData%BlTwist(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTwist.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist + end if + if (allocated(SrcRotParameterTypeData%TwrCb)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCb) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCb) + if (.not. allocated(DstRotParameterTypeData%TwrCb)) then + allocate(DstRotParameterTypeData%TwrCb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb + end if + if (allocated(SrcRotParameterTypeData%BlCenBn)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBn) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBn) + if (.not. allocated(DstRotParameterTypeData%BlCenBn)) then + allocate(DstRotParameterTypeData%BlCenBn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn + end if + if (allocated(SrcRotParameterTypeData%BlCenBt)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBt) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBt) + if (.not. allocated(DstRotParameterTypeData%BlCenBt)) then + allocate(DstRotParameterTypeData%BlCenBt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlCenBt = SrcRotParameterTypeData%BlCenBt + end if + DstRotParameterTypeData%VolHub = SrcRotParameterTypeData%VolHub + DstRotParameterTypeData%HubCenBx = SrcRotParameterTypeData%HubCenBx + DstRotParameterTypeData%VolNac = SrcRotParameterTypeData%VolNac + DstRotParameterTypeData%NacCenB = SrcRotParameterTypeData%NacCenB + DstRotParameterTypeData%VolBl = SrcRotParameterTypeData%VolBl + DstRotParameterTypeData%VolTwr = SrcRotParameterTypeData%VolTwr + if (allocated(SrcRotParameterTypeData%BlRad)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlRad) + UB(1:2) = ubound(SrcRotParameterTypeData%BlRad) + if (.not. allocated(DstRotParameterTypeData%BlRad)) then + allocate(DstRotParameterTypeData%BlRad(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad + end if + if (allocated(SrcRotParameterTypeData%BlDL)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlDL) + UB(1:2) = ubound(SrcRotParameterTypeData%BlDL) + if (.not. allocated(DstRotParameterTypeData%BlDL)) then + allocate(DstRotParameterTypeData%BlDL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlDL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlDL = SrcRotParameterTypeData%BlDL + end if + if (allocated(SrcRotParameterTypeData%BlTaper)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlTaper) + UB(1:2) = ubound(SrcRotParameterTypeData%BlTaper) + if (.not. allocated(DstRotParameterTypeData%BlTaper)) then + allocate(DstRotParameterTypeData%BlTaper(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTaper.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlTaper = SrcRotParameterTypeData%BlTaper + end if + if (allocated(SrcRotParameterTypeData%BlAxCent)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlAxCent) + UB(1:2) = ubound(SrcRotParameterTypeData%BlAxCent) + if (.not. allocated(DstRotParameterTypeData%BlAxCent)) then + allocate(DstRotParameterTypeData%BlAxCent(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAxCent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent + end if + if (allocated(SrcRotParameterTypeData%TwrRad)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrRad) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrRad) + if (.not. allocated(DstRotParameterTypeData%TwrRad)) then + allocate(DstRotParameterTypeData%TwrRad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrRad = SrcRotParameterTypeData%TwrRad + end if + if (allocated(SrcRotParameterTypeData%TwrDL)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrDL) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrDL) + if (.not. allocated(DstRotParameterTypeData%TwrDL)) then + allocate(DstRotParameterTypeData%TwrDL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrDL = SrcRotParameterTypeData%TwrDL + end if + if (allocated(SrcRotParameterTypeData%TwrTaper)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrTaper) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrTaper) + if (.not. allocated(DstRotParameterTypeData%TwrTaper)) then + allocate(DstRotParameterTypeData%TwrTaper(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTaper.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrTaper = SrcRotParameterTypeData%TwrTaper + end if + if (allocated(SrcRotParameterTypeData%TwrAxCent)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrAxCent) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrAxCent) + if (.not. allocated(DstRotParameterTypeData%TwrAxCent)) then + allocate(DstRotParameterTypeData%TwrAxCent(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrAxCent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrAxCent = SrcRotParameterTypeData%TwrAxCent + end if + call BEMT_CopyParam(SrcRotParameterTypeData%BEMT, DstRotParameterTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyParam(SrcRotParameterTypeData%AA, DstRotParameterTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotParameterTypeData%Jac_u_indx)) then + LB(1:2) = lbound(SrcRotParameterTypeData%Jac_u_indx) + UB(1:2) = ubound(SrcRotParameterTypeData%Jac_u_indx) + if (.not. allocated(DstRotParameterTypeData%Jac_u_indx)) then + allocate(DstRotParameterTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%Jac_u_indx = SrcRotParameterTypeData%Jac_u_indx + end if + if (allocated(SrcRotParameterTypeData%du)) then + LB(1:1) = lbound(SrcRotParameterTypeData%du) + UB(1:1) = ubound(SrcRotParameterTypeData%du) + if (.not. allocated(DstRotParameterTypeData%du)) then + allocate(DstRotParameterTypeData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%du = SrcRotParameterTypeData%du + end if + if (allocated(SrcRotParameterTypeData%dx)) then + LB(1:1) = lbound(SrcRotParameterTypeData%dx) + UB(1:1) = ubound(SrcRotParameterTypeData%dx) + if (.not. allocated(DstRotParameterTypeData%dx)) then + allocate(DstRotParameterTypeData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%dx = SrcRotParameterTypeData%dx + end if + DstRotParameterTypeData%Jac_ny = SrcRotParameterTypeData%Jac_ny + DstRotParameterTypeData%NumBl_Lin = SrcRotParameterTypeData%NumBl_Lin + DstRotParameterTypeData%TwrPotent = SrcRotParameterTypeData%TwrPotent + DstRotParameterTypeData%TwrShadow = SrcRotParameterTypeData%TwrShadow + DstRotParameterTypeData%TwrAero = SrcRotParameterTypeData%TwrAero + DstRotParameterTypeData%FrozenWake = SrcRotParameterTypeData%FrozenWake + DstRotParameterTypeData%CavitCheck = SrcRotParameterTypeData%CavitCheck + DstRotParameterTypeData%Buoyancy = SrcRotParameterTypeData%Buoyancy + DstRotParameterTypeData%MHK = SrcRotParameterTypeData%MHK + DstRotParameterTypeData%CompAA = SrcRotParameterTypeData%CompAA + DstRotParameterTypeData%AirDens = SrcRotParameterTypeData%AirDens + DstRotParameterTypeData%KinVisc = SrcRotParameterTypeData%KinVisc + DstRotParameterTypeData%SpdSound = SrcRotParameterTypeData%SpdSound + DstRotParameterTypeData%Gravity = SrcRotParameterTypeData%Gravity + DstRotParameterTypeData%Patm = SrcRotParameterTypeData%Patm + DstRotParameterTypeData%Pvap = SrcRotParameterTypeData%Pvap + DstRotParameterTypeData%WtrDpth = SrcRotParameterTypeData%WtrDpth + DstRotParameterTypeData%MSL2SWL = SrcRotParameterTypeData%MSL2SWL + DstRotParameterTypeData%AeroProjMod = SrcRotParameterTypeData%AeroProjMod + DstRotParameterTypeData%AeroBEM_Mod = SrcRotParameterTypeData%AeroBEM_Mod + DstRotParameterTypeData%NumOuts = SrcRotParameterTypeData%NumOuts + DstRotParameterTypeData%RootName = SrcRotParameterTypeData%RootName + if (allocated(SrcRotParameterTypeData%OutParam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%OutParam) + UB(1:1) = ubound(SrcRotParameterTypeData%OutParam) + if (.not. allocated(DstRotParameterTypeData%OutParam)) then + allocate(DstRotParameterTypeData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%OutParam(i1), DstRotParameterTypeData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstRotParameterTypeData%NBlOuts = SrcRotParameterTypeData%NBlOuts + DstRotParameterTypeData%BlOutNd = SrcRotParameterTypeData%BlOutNd + DstRotParameterTypeData%NTwOuts = SrcRotParameterTypeData%NTwOuts + DstRotParameterTypeData%TwOutNd = SrcRotParameterTypeData%TwOutNd + DstRotParameterTypeData%BldNd_NumOuts = SrcRotParameterTypeData%BldNd_NumOuts + DstRotParameterTypeData%BldNd_TotNumOuts = SrcRotParameterTypeData%BldNd_TotNumOuts + if (allocated(SrcRotParameterTypeData%BldNd_OutParam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_OutParam) + UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_OutParam) + if (.not. allocated(DstRotParameterTypeData%BldNd_OutParam)) then + allocate(DstRotParameterTypeData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%BldNd_OutParam(i1), DstRotParameterTypeData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotParameterTypeData%BldNd_BlOutNd)) then + LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_BlOutNd) + UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_BlOutNd) + if (.not. allocated(DstRotParameterTypeData%BldNd_BlOutNd)) then + allocate(DstRotParameterTypeData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_BlOutNd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BldNd_BlOutNd = SrcRotParameterTypeData%BldNd_BlOutNd + end if + DstRotParameterTypeData%BldNd_BladesOut = SrcRotParameterTypeData%BldNd_BladesOut + DstRotParameterTypeData%TFinAero = SrcRotParameterTypeData%TFinAero + call AD_CopyTFinParameterType(SrcRotParameterTypeData%TFin, DstRotParameterTypeData%TFin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) + type(RotParameterType), intent(inout) :: RotParameterTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotParameterType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotParameterTypeData%TwrDiam)) then + deallocate(RotParameterTypeData%TwrDiam) + end if + if (allocated(RotParameterTypeData%TwrCd)) then + deallocate(RotParameterTypeData%TwrCd) + end if + if (allocated(RotParameterTypeData%TwrTI)) then + deallocate(RotParameterTypeData%TwrTI) + end if + if (allocated(RotParameterTypeData%BlTwist)) then + deallocate(RotParameterTypeData%BlTwist) + end if + if (allocated(RotParameterTypeData%TwrCb)) then + deallocate(RotParameterTypeData%TwrCb) + end if + if (allocated(RotParameterTypeData%BlCenBn)) then + deallocate(RotParameterTypeData%BlCenBn) + end if + if (allocated(RotParameterTypeData%BlCenBt)) then + deallocate(RotParameterTypeData%BlCenBt) + end if + if (allocated(RotParameterTypeData%BlRad)) then + deallocate(RotParameterTypeData%BlRad) + end if + if (allocated(RotParameterTypeData%BlDL)) then + deallocate(RotParameterTypeData%BlDL) + end if + if (allocated(RotParameterTypeData%BlTaper)) then + deallocate(RotParameterTypeData%BlTaper) + end if + if (allocated(RotParameterTypeData%BlAxCent)) then + deallocate(RotParameterTypeData%BlAxCent) + end if + if (allocated(RotParameterTypeData%TwrRad)) then + deallocate(RotParameterTypeData%TwrRad) + end if + if (allocated(RotParameterTypeData%TwrDL)) then + deallocate(RotParameterTypeData%TwrDL) + end if + if (allocated(RotParameterTypeData%TwrTaper)) then + deallocate(RotParameterTypeData%TwrTaper) + end if + if (allocated(RotParameterTypeData%TwrAxCent)) then + deallocate(RotParameterTypeData%TwrAxCent) + end if + call BEMT_DestroyParam(RotParameterTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + end if + if (allocated(RotParameterTypeData%du)) then + deallocate(RotParameterTypeData%du) + end if + if (allocated(RotParameterTypeData%dx)) then + deallocate(RotParameterTypeData%dx) + end if + if (allocated(RotParameterTypeData%OutParam)) then + LB(1:1) = lbound(RotParameterTypeData%OutParam) + UB(1:1) = ubound(RotParameterTypeData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(RotParameterTypeData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotParameterTypeData%OutParam) + end if + if (allocated(RotParameterTypeData%BldNd_OutParam)) then + LB(1:1) = lbound(RotParameterTypeData%BldNd_OutParam) + UB(1:1) = ubound(RotParameterTypeData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotParameterTypeData%BldNd_OutParam) + end if + if (allocated(RotParameterTypeData%BldNd_BlOutNd)) then + deallocate(RotParameterTypeData%BldNd_BlOutNd) + end if + call AD_DestroyTFinParameterType(RotParameterTypeData%TFin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotParameterType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotParameterType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%NumBlades) + call RegPack(Buf, InData%NumBlNds) + call RegPack(Buf, InData%NumTwrNds) + call RegPack(Buf, allocated(InData%TwrDiam)) + if (allocated(InData%TwrDiam)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrDiam), ubound(InData%TwrDiam)) + call RegPack(Buf, InData%TwrDiam) + end if + call RegPack(Buf, allocated(InData%TwrCd)) + if (allocated(InData%TwrCd)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrCd), ubound(InData%TwrCd)) + call RegPack(Buf, InData%TwrCd) + end if + call RegPack(Buf, allocated(InData%TwrTI)) + if (allocated(InData%TwrTI)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrTI), ubound(InData%TwrTI)) + call RegPack(Buf, InData%TwrTI) + end if + call RegPack(Buf, allocated(InData%BlTwist)) + if (allocated(InData%BlTwist)) then + call RegPackBounds(Buf, 2, lbound(InData%BlTwist), ubound(InData%BlTwist)) + call RegPack(Buf, InData%BlTwist) + end if + call RegPack(Buf, allocated(InData%TwrCb)) + if (allocated(InData%TwrCb)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrCb), ubound(InData%TwrCb)) + call RegPack(Buf, InData%TwrCb) + end if + call RegPack(Buf, allocated(InData%BlCenBn)) + if (allocated(InData%BlCenBn)) then + call RegPackBounds(Buf, 2, lbound(InData%BlCenBn), ubound(InData%BlCenBn)) + call RegPack(Buf, InData%BlCenBn) + end if + call RegPack(Buf, allocated(InData%BlCenBt)) + if (allocated(InData%BlCenBt)) then + call RegPackBounds(Buf, 2, lbound(InData%BlCenBt), ubound(InData%BlCenBt)) + call RegPack(Buf, InData%BlCenBt) + end if + call RegPack(Buf, InData%VolHub) + call RegPack(Buf, InData%HubCenBx) + call RegPack(Buf, InData%VolNac) + call RegPack(Buf, InData%NacCenB) + call RegPack(Buf, InData%VolBl) + call RegPack(Buf, InData%VolTwr) + call RegPack(Buf, allocated(InData%BlRad)) + if (allocated(InData%BlRad)) then + call RegPackBounds(Buf, 2, lbound(InData%BlRad), ubound(InData%BlRad)) + call RegPack(Buf, InData%BlRad) + end if + call RegPack(Buf, allocated(InData%BlDL)) + if (allocated(InData%BlDL)) then + call RegPackBounds(Buf, 2, lbound(InData%BlDL), ubound(InData%BlDL)) + call RegPack(Buf, InData%BlDL) + end if + call RegPack(Buf, allocated(InData%BlTaper)) + if (allocated(InData%BlTaper)) then + call RegPackBounds(Buf, 2, lbound(InData%BlTaper), ubound(InData%BlTaper)) + call RegPack(Buf, InData%BlTaper) + end if + call RegPack(Buf, allocated(InData%BlAxCent)) + if (allocated(InData%BlAxCent)) then + call RegPackBounds(Buf, 2, lbound(InData%BlAxCent), ubound(InData%BlAxCent)) + call RegPack(Buf, InData%BlAxCent) + end if + call RegPack(Buf, allocated(InData%TwrRad)) + if (allocated(InData%TwrRad)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrRad), ubound(InData%TwrRad)) + call RegPack(Buf, InData%TwrRad) + end if + call RegPack(Buf, allocated(InData%TwrDL)) + if (allocated(InData%TwrDL)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrDL), ubound(InData%TwrDL)) + call RegPack(Buf, InData%TwrDL) + end if + call RegPack(Buf, allocated(InData%TwrTaper)) + if (allocated(InData%TwrTaper)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrTaper), ubound(InData%TwrTaper)) + call RegPack(Buf, InData%TwrTaper) + end if + call RegPack(Buf, allocated(InData%TwrAxCent)) + if (allocated(InData%TwrAxCent)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrAxCent), ubound(InData%TwrAxCent)) + call RegPack(Buf, InData%TwrAxCent) + end if + call BEMT_PackParam(Buf, InData%BEMT) + call AA_PackParam(Buf, InData%AA) + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + call RegPack(Buf, allocated(InData%du)) + if (allocated(InData%du)) then + call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPack(Buf, InData%du) + end if + call RegPack(Buf, allocated(InData%dx)) + if (allocated(InData%dx)) then + call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) + call RegPack(Buf, InData%dx) + end if + call RegPack(Buf, InData%Jac_ny) + call RegPack(Buf, InData%NumBl_Lin) + call RegPack(Buf, InData%TwrPotent) + call RegPack(Buf, InData%TwrShadow) + call RegPack(Buf, InData%TwrAero) + call RegPack(Buf, InData%FrozenWake) + call RegPack(Buf, InData%CavitCheck) + call RegPack(Buf, InData%Buoyancy) + call RegPack(Buf, InData%MHK) + call RegPack(Buf, InData%CompAA) + call RegPack(Buf, InData%AirDens) + call RegPack(Buf, InData%KinVisc) + call RegPack(Buf, InData%SpdSound) + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%Patm) + call RegPack(Buf, InData%Pvap) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%MSL2SWL) + call RegPack(Buf, InData%AeroProjMod) + call RegPack(Buf, InData%AeroBEM_Mod) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + call RegPack(Buf, InData%NBlOuts) + call RegPack(Buf, InData%BlOutNd) + call RegPack(Buf, InData%NTwOuts) + call RegPack(Buf, InData%TwOutNd) + call RegPack(Buf, InData%BldNd_NumOuts) + call RegPack(Buf, InData%BldNd_TotNumOuts) + call RegPack(Buf, allocated(InData%BldNd_OutParam)) + if (allocated(InData%BldNd_OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) + LB(1:1) = lbound(InData%BldNd_OutParam) + UB(1:1) = ubound(InData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%BldNd_OutParam(i1)) + end do + end if + call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) + if (allocated(InData%BldNd_BlOutNd)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd), ubound(InData%BldNd_BlOutNd)) + call RegPack(Buf, InData%BldNd_BlOutNd) + end if + call RegPack(Buf, InData%BldNd_BladesOut) + call RegPack(Buf, InData%TFinAero) + call AD_PackTFinParameterType(Buf, InData%TFin) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotParameterType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotParameterType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBlNds) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumTwrNds) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TwrDiam)) deallocate(OutData%TwrDiam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrDiam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrDiam) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrCd)) deallocate(OutData%TwrCd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrCd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrCd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrTI)) deallocate(OutData%TwrTI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrTI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrTI) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlTwist)) deallocate(OutData%BlTwist) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlTwist(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlTwist) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrCb)) deallocate(OutData%TwrCb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrCb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrCb) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlCenBn)) deallocate(OutData%BlCenBn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlCenBn(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlCenBn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlCenBt)) deallocate(OutData%BlCenBt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlCenBt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlCenBt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%VolHub) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubCenBx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VolNac) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacCenB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VolBl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VolTwr) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BlRad)) deallocate(OutData%BlRad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlRad(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlRad) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlDL)) deallocate(OutData%BlDL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlDL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlDL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlDL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlTaper)) deallocate(OutData%BlTaper) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlTaper(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTaper.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlTaper) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlAxCent)) deallocate(OutData%BlAxCent) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlAxCent(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAxCent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlAxCent) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrRad)) deallocate(OutData%TwrRad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrRad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrRad) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrDL)) deallocate(OutData%TwrDL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrDL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrDL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrTaper)) deallocate(OutData%TwrTaper) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrTaper(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTaper.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrTaper) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrAxCent)) deallocate(OutData%TwrAxCent) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrAxCent(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrAxCent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrAxCent) + if (RegCheckErr(Buf, RoutineName)) return + end if + call BEMT_UnpackParam(Buf, OutData%BEMT) ! BEMT + call AA_UnpackParam(Buf, OutData%AA) ! AA + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%du)) deallocate(OutData%du) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%du(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dx)) deallocate(OutData%dx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBl_Lin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrPotent) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrShadow) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrAero) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FrozenWake) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CavitCheck) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Buoyancy) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompAA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Patm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Pvap) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AeroProjMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AeroBEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(Buf, OutData%NBlOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BlOutNd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NTwOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwOutNd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldNd_TotNumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam + end do + end if + if (allocated(OutData%BldNd_BlOutNd)) deallocate(OutData%BldNd_BlOutNd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_BlOutNd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldNd_BlOutNd) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%BldNd_BladesOut) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinAero) + if (RegCheckErr(Buf, RoutineName)) return + call AD_UnpackTFinParameterType(Buf, OutData%TFin) ! TFin +end subroutine + +subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AD_ParameterType), intent(in) :: SrcParamData + type(AD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcParamData%rotors)) then + LB(1:1) = lbound(SrcParamData%rotors) + UB(1:1) = ubound(SrcParamData%rotors) + if (.not. allocated(DstParamData%rotors)) then + allocate(DstParamData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotParameterType(SrcParamData%rotors(i1), DstParamData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%DT = SrcParamData%DT + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%AFI)) then + LB(1:1) = lbound(SrcParamData%AFI) + UB(1:1) = ubound(SrcParamData%AFI) + if (.not. allocated(DstParamData%AFI)) then + allocate(DstParamData%AFI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AFI_CopyParam(SrcParamData%AFI(i1), DstParamData%AFI(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%SkewMod = SrcParamData%SkewMod + DstParamData%WakeMod = SrcParamData%WakeMod + call FVW_CopyParam(SrcParamData%FVW, DstParamData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps + DstParamData%UA_Flag = SrcParamData%UA_Flag + DstParamData%FlowField => SrcParamData%FlowField +end subroutine + +subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%rotors)) then + LB(1:1) = lbound(ParamData%rotors) + UB(1:1) = ubound(ParamData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotParameterType(ParamData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%rotors) + end if + if (allocated(ParamData%AFI)) then + LB(1:1) = lbound(ParamData%AFI) + UB(1:1) = ubound(ParamData%AFI) + do i1 = LB(1), UB(1) + call AFI_DestroyParam(ParamData%AFI(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%AFI) + end if + call FVW_DestroyParam(ParamData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(ParamData%FlowField) +end subroutine + +subroutine AD_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackParam' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotParameterType(Buf, InData%rotors(i1)) + end do + end if + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, allocated(InData%AFI)) + if (allocated(InData%AFI)) then + call RegPackBounds(Buf, 1, lbound(InData%AFI), ubound(InData%AFI)) + LB(1:1) = lbound(InData%AFI) + UB(1:1) = ubound(InData%AFI) + do i1 = LB(1), UB(1) + call AFI_PackParam(Buf, InData%AFI(i1)) + end do + end if + call RegPack(Buf, InData%SkewMod) + call RegPack(Buf, InData%WakeMod) + call FVW_PackParam(Buf, InData%FVW) + call RegPack(Buf, InData%CompAeroMaps) + call RegPack(Buf, InData%UA_Flag) + call RegPack(Buf, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(Buf, InData%FlowField) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackParam' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotParameterType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AFI)) deallocate(OutData%AFI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AFI_UnpackParam(Buf, OutData%AFI(i1)) ! AFI + end do + end if + call RegUnpack(Buf, OutData%SkewMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WakeMod) + if (RegCheckErr(Buf, RoutineName)) return + call FVW_UnpackParam(Buf, OutData%FVW) ! FVW + call RegUnpack(Buf, OutData%CompAeroMaps) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UA_Flag) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(Buf, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if +end subroutine + +subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotInputType), intent(inout) :: SrcRotInputTypeData + type(RotInputType), intent(inout) :: DstRotInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotInputType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcRotInputTypeData%NacelleMotion, DstRotInputTypeData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotInputTypeData%TowerMotion, DstRotInputTypeData%TowerMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotInputTypeData%HubMotion, DstRotInputTypeData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotInputTypeData%BladeRootMotion)) then + LB(1:1) = lbound(SrcRotInputTypeData%BladeRootMotion) + UB(1:1) = ubound(SrcRotInputTypeData%BladeRootMotion) + if (.not. allocated(DstRotInputTypeData%BladeRootMotion)) then + allocate(DstRotInputTypeData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotInputTypeData%BladeRootMotion(i1), DstRotInputTypeData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotInputTypeData%BladeMotion)) then + LB(1:1) = lbound(SrcRotInputTypeData%BladeMotion) + UB(1:1) = ubound(SrcRotInputTypeData%BladeMotion) + if (.not. allocated(DstRotInputTypeData%BladeMotion)) then + allocate(DstRotInputTypeData%BladeMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotInputTypeData%BladeMotion(i1), DstRotInputTypeData%BladeMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcRotInputTypeData%TFinMotion, DstRotInputTypeData%TFinMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotInputTypeData%InflowOnBlade)) then + LB(1:3) = lbound(SrcRotInputTypeData%InflowOnBlade) + UB(1:3) = ubound(SrcRotInputTypeData%InflowOnBlade) + if (.not. allocated(DstRotInputTypeData%InflowOnBlade)) then + allocate(DstRotInputTypeData%InflowOnBlade(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%InflowOnBlade.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputTypeData%InflowOnBlade = SrcRotInputTypeData%InflowOnBlade + end if + if (allocated(SrcRotInputTypeData%InflowOnTower)) then + LB(1:2) = lbound(SrcRotInputTypeData%InflowOnTower) + UB(1:2) = ubound(SrcRotInputTypeData%InflowOnTower) + if (.not. allocated(DstRotInputTypeData%InflowOnTower)) then + allocate(DstRotInputTypeData%InflowOnTower(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%InflowOnTower.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputTypeData%InflowOnTower = SrcRotInputTypeData%InflowOnTower + end if + DstRotInputTypeData%InflowOnHub = SrcRotInputTypeData%InflowOnHub + DstRotInputTypeData%InflowOnNacelle = SrcRotInputTypeData%InflowOnNacelle + DstRotInputTypeData%InflowOnTailFin = SrcRotInputTypeData%InflowOnTailFin + if (allocated(SrcRotInputTypeData%UserProp)) then + LB(1:2) = lbound(SrcRotInputTypeData%UserProp) + UB(1:2) = ubound(SrcRotInputTypeData%UserProp) + if (.not. allocated(DstRotInputTypeData%UserProp)) then + allocate(DstRotInputTypeData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%UserProp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputTypeData%UserProp = SrcRotInputTypeData%UserProp + end if +end subroutine + +subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) + type(RotInputType), intent(inout) :: RotInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotInputType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( RotInputTypeData%NacelleMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotInputTypeData%TowerMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotInputTypeData%HubMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotInputTypeData%BladeRootMotion)) then + LB(1:1) = lbound(RotInputTypeData%BladeRootMotion) + UB(1:1) = ubound(RotInputTypeData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( RotInputTypeData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInputTypeData%BladeRootMotion) + end if + if (allocated(RotInputTypeData%BladeMotion)) then + LB(1:1) = lbound(RotInputTypeData%BladeMotion) + UB(1:1) = ubound(RotInputTypeData%BladeMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( RotInputTypeData%BladeMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInputTypeData%BladeMotion) + end if + call MeshDestroy( RotInputTypeData%TFinMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotInputTypeData%InflowOnBlade)) then + deallocate(RotInputTypeData%InflowOnBlade) + end if + if (allocated(RotInputTypeData%InflowOnTower)) then + deallocate(RotInputTypeData%InflowOnTower) + end if + if (allocated(RotInputTypeData%UserProp)) then + deallocate(RotInputTypeData%UserProp) + end if +end subroutine + +subroutine AD_PackRotInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInputType' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%NacelleMotion) + call MeshPack(Buf, InData%TowerMotion) + call MeshPack(Buf, InData%HubMotion) + call RegPack(Buf, allocated(InData%BladeRootMotion)) + if (allocated(InData%BladeRootMotion)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeRootMotion(i1)) + end do + end if + call RegPack(Buf, allocated(InData%BladeMotion)) + if (allocated(InData%BladeMotion)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeMotion), ubound(InData%BladeMotion)) + LB(1:1) = lbound(InData%BladeMotion) + UB(1:1) = ubound(InData%BladeMotion) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeMotion(i1)) + end do + end if + call MeshPack(Buf, InData%TFinMotion) + call RegPack(Buf, allocated(InData%InflowOnBlade)) + if (allocated(InData%InflowOnBlade)) then + call RegPackBounds(Buf, 3, lbound(InData%InflowOnBlade), ubound(InData%InflowOnBlade)) + call RegPack(Buf, InData%InflowOnBlade) + end if + call RegPack(Buf, allocated(InData%InflowOnTower)) + if (allocated(InData%InflowOnTower)) then + call RegPackBounds(Buf, 2, lbound(InData%InflowOnTower), ubound(InData%InflowOnTower)) + call RegPack(Buf, InData%InflowOnTower) + end if + call RegPack(Buf, InData%InflowOnHub) + call RegPack(Buf, InData%InflowOnNacelle) + call RegPack(Buf, InData%InflowOnTailFin) + call RegPack(Buf, allocated(InData%UserProp)) + if (allocated(InData%UserProp)) then + call RegPackBounds(Buf, 2, lbound(InData%UserProp), ubound(InData%UserProp)) + call RegPack(Buf, InData%UserProp) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInputType' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%NacelleMotion) ! NacelleMotion + call MeshUnpack(Buf, OutData%TowerMotion) ! TowerMotion + call MeshUnpack(Buf, OutData%HubMotion) ! HubMotion + if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeRootMotion(i1)) ! BladeRootMotion + end do + end if + if (allocated(OutData%BladeMotion)) deallocate(OutData%BladeMotion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeMotion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeMotion(i1)) ! BladeMotion + end do + end if + call MeshUnpack(Buf, OutData%TFinMotion) ! TFinMotion + if (allocated(OutData%InflowOnBlade)) deallocate(OutData%InflowOnBlade) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InflowOnBlade(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnBlade.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InflowOnBlade) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%InflowOnTower)) deallocate(OutData%InflowOnTower) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InflowOnTower(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnTower.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InflowOnTower) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%InflowOnHub) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InflowOnNacelle) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InflowOnTailFin) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%UserProp)) deallocate(OutData%UserProp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UserProp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UserProp) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AD_InputType), intent(inout) :: SrcInputData + type(AD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%rotors)) then + LB(1:1) = lbound(SrcInputData%rotors) + UB(1:1) = ubound(SrcInputData%rotors) + if (.not. allocated(DstInputData%rotors)) then + allocate(DstInputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotInputType(SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%InflowWakeVel)) then + LB(1:2) = lbound(SrcInputData%InflowWakeVel) + UB(1:2) = ubound(SrcInputData%InflowWakeVel) + if (.not. allocated(DstInputData%InflowWakeVel)) then + allocate(DstInputData%InflowWakeVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InflowWakeVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%InflowWakeVel = SrcInputData%InflowWakeVel + end if +end subroutine + +subroutine AD_DestroyInput(InputData, ErrStat, ErrMsg) + type(AD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%rotors)) then + LB(1:1) = lbound(InputData%rotors) + UB(1:1) = ubound(InputData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotInputType(InputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%rotors) + end if + if (allocated(InputData%InflowWakeVel)) then + deallocate(InputData%InflowWakeVel) + end if +end subroutine + +subroutine AD_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotInputType(Buf, InData%rotors(i1)) + end do + end if + call RegPack(Buf, allocated(InData%InflowWakeVel)) + if (allocated(InData%InflowWakeVel)) then + call RegPackBounds(Buf, 2, lbound(InData%InflowWakeVel), ubound(InData%InflowWakeVel)) + call RegPack(Buf, InData%InflowWakeVel) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInputType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + if (allocated(OutData%InflowWakeVel)) deallocate(OutData%InflowWakeVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InflowWakeVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowWakeVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InflowWakeVel) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotOutputType), intent(inout) :: SrcRotOutputTypeData + type(RotOutputType), intent(inout) :: DstRotOutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotOutputType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcRotOutputTypeData%NacelleLoad, DstRotOutputTypeData%NacelleLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotOutputTypeData%HubLoad, DstRotOutputTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotOutputTypeData%TowerLoad, DstRotOutputTypeData%TowerLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotOutputTypeData%BladeLoad)) then + LB(1:1) = lbound(SrcRotOutputTypeData%BladeLoad) + UB(1:1) = ubound(SrcRotOutputTypeData%BladeLoad) + if (.not. allocated(DstRotOutputTypeData%BladeLoad)) then + allocate(DstRotOutputTypeData%BladeLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%BladeLoad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotOutputTypeData%BladeLoad(i1), DstRotOutputTypeData%BladeLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcRotOutputTypeData%TFinLoad, DstRotOutputTypeData%TFinLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotOutputTypeData%WriteOutput)) then + LB(1:1) = lbound(SrcRotOutputTypeData%WriteOutput) + UB(1:1) = ubound(SrcRotOutputTypeData%WriteOutput) + if (.not. allocated(DstRotOutputTypeData%WriteOutput)) then + allocate(DstRotOutputTypeData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotOutputTypeData%WriteOutput = SrcRotOutputTypeData%WriteOutput + end if +end subroutine + +subroutine AD_DestroyRotOutputType(RotOutputTypeData, ErrStat, ErrMsg) + type(RotOutputType), intent(inout) :: RotOutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotOutputType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( RotOutputTypeData%NacelleLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotOutputTypeData%HubLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotOutputTypeData%TowerLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotOutputTypeData%BladeLoad)) then + LB(1:1) = lbound(RotOutputTypeData%BladeLoad) + UB(1:1) = ubound(RotOutputTypeData%BladeLoad) + do i1 = LB(1), UB(1) + call MeshDestroy( RotOutputTypeData%BladeLoad(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotOutputTypeData%BladeLoad) + end if + call MeshDestroy( RotOutputTypeData%TFinLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotOutputTypeData%WriteOutput)) then + deallocate(RotOutputTypeData%WriteOutput) + end if +end subroutine + +subroutine AD_PackRotOutputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotOutputType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%NacelleLoad) + call MeshPack(Buf, InData%HubLoad) + call MeshPack(Buf, InData%TowerLoad) + call RegPack(Buf, allocated(InData%BladeLoad)) + if (allocated(InData%BladeLoad)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeLoad), ubound(InData%BladeLoad)) + LB(1:1) = lbound(InData%BladeLoad) + UB(1:1) = ubound(InData%BladeLoad) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeLoad(i1)) + end do + end if + call MeshPack(Buf, InData%TFinLoad) + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotOutputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotOutputType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%NacelleLoad) ! NacelleLoad + call MeshUnpack(Buf, OutData%HubLoad) ! HubLoad + call MeshUnpack(Buf, OutData%TowerLoad) ! TowerLoad + if (allocated(OutData%BladeLoad)) deallocate(OutData%BladeLoad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeLoad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeLoad(i1)) ! BladeLoad + end do + end if + call MeshUnpack(Buf, OutData%TFinLoad) ! TFinLoad + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AD_OutputType), intent(inout) :: SrcOutputData + type(AD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%rotors)) then + LB(1:1) = lbound(SrcOutputData%rotors) + UB(1:1) = ubound(SrcOutputData%rotors) + if (.not. allocated(DstOutputData%rotors)) then + allocate(DstOutputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotOutputType(SrcOutputData%rotors(i1), DstOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%rotors)) then + LB(1:1) = lbound(OutputData%rotors) + UB(1:1) = ubound(OutputData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotOutputType(OutputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%rotors) + end if +end subroutine + +subroutine AD_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotOutputType(Buf, InData%rotors(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotOutputType(Buf, OutData%rotors(i1)) ! rotors + end do + end if +end subroutine + +subroutine AD_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(AD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(AD_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 = 'AD_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 AD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AD_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 AD_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 AD_Input_ExtrapInterp - - - SUBROUTINE AD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call AD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE AD_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. @@ -18163,137 +7227,107 @@ SUBROUTINE AD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(AD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(AD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(AD_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 + TYPE(AD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(AD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(AD_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 = 'AD_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 - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 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(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1),UBOUND(u_out%rotors(i01)%BladeRootMotion,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1),UBOUND(u_out%rotors(i01)%BladeMotion,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%InflowOnBlade) .AND. ALLOCATED(u1%rotors(i01)%InflowOnBlade)) THEN - DO i3 = LBOUND(u_out%rotors(i01)%InflowOnBlade,3),UBOUND(u_out%rotors(i01)%InflowOnBlade,3) - DO i2 = LBOUND(u_out%rotors(i01)%InflowOnBlade,2),UBOUND(u_out%rotors(i01)%InflowOnBlade,2) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnBlade,1),UBOUND(u_out%rotors(i01)%InflowOnBlade,1) - b = -(u1%rotors(i01)%InflowOnBlade(i1,i2,i3) - u2%rotors(i01)%InflowOnBlade(i1,i2,i3)) - u_out%rotors(i01)%InflowOnBlade(i1,i2,i3) = u1%rotors(i01)%InflowOnBlade(i1,i2,i3) + b * ScaleFactor + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN + DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1),UBOUND(u_out%rotors(i01)%BladeRootMotion,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated END DO - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%InflowOnTower) .AND. ALLOCATED(u1%rotors(i01)%InflowOnTower)) THEN - DO i2 = LBOUND(u_out%rotors(i01)%InflowOnTower,2),UBOUND(u_out%rotors(i01)%InflowOnTower,2) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnTower,1),UBOUND(u_out%rotors(i01)%InflowOnTower,1) - b = -(u1%rotors(i01)%InflowOnTower(i1,i2) - u2%rotors(i01)%InflowOnTower(i1,i2)) - u_out%rotors(i01)%InflowOnTower(i1,i2) = u1%rotors(i01)%InflowOnTower(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnHub,1),UBOUND(u_out%rotors(i01)%InflowOnHub,1) - b = -(u1%rotors(i01)%InflowOnHub(i1) - u2%rotors(i01)%InflowOnHub(i1)) - u_out%rotors(i01)%InflowOnHub(i1) = u1%rotors(i01)%InflowOnHub(i1) + b * ScaleFactor - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnNacelle,1),UBOUND(u_out%rotors(i01)%InflowOnNacelle,1) - b = -(u1%rotors(i01)%InflowOnNacelle(i1) - u2%rotors(i01)%InflowOnNacelle(i1)) - u_out%rotors(i01)%InflowOnNacelle(i1) = u1%rotors(i01)%InflowOnNacelle(i1) + b * ScaleFactor - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnTailFin,1),UBOUND(u_out%rotors(i01)%InflowOnTailFin,1) - b = -(u1%rotors(i01)%InflowOnTailFin(i1) - u2%rotors(i01)%InflowOnTailFin(i1)) - u_out%rotors(i01)%InflowOnTailFin(i1) = u1%rotors(i01)%InflowOnTailFin(i1) + b * ScaleFactor - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN - DO i2 = LBOUND(u_out%rotors(i01)%UserProp,2),UBOUND(u_out%rotors(i01)%UserProp,2) - DO i1 = LBOUND(u_out%rotors(i01)%UserProp,1),UBOUND(u_out%rotors(i01)%UserProp,1) - b = -(u1%rotors(i01)%UserProp(i1,i2) - u2%rotors(i01)%UserProp(i1,i2)) - u_out%rotors(i01)%UserProp(i1,i2) = u1%rotors(i01)%UserProp(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN - DO i2 = LBOUND(u_out%InflowWakeVel,2),UBOUND(u_out%InflowWakeVel,2) - DO i1 = LBOUND(u_out%InflowWakeVel,1),UBOUND(u_out%InflowWakeVel,1) - b = -(u1%InflowWakeVel(i1,i2) - u2%InflowWakeVel(i1,i2)) - u_out%InflowWakeVel(i1,i2) = u1%InflowWakeVel(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE AD_Input_ExtrapInterp1 - + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN + DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1),UBOUND(u_out%rotors(i01)%BladeMotion,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%InflowOnBlade) .AND. ALLOCATED(u1%rotors(i01)%InflowOnBlade)) THEN + u_out%rotors(i01)%InflowOnBlade = a1*u1%rotors(i01)%InflowOnBlade + a2*u2%rotors(i01)%InflowOnBlade + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%InflowOnTower) .AND. ALLOCATED(u1%rotors(i01)%InflowOnTower)) THEN + u_out%rotors(i01)%InflowOnTower = a1*u1%rotors(i01)%InflowOnTower + a2*u2%rotors(i01)%InflowOnTower + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%InflowOnHub = a1*u1%rotors(i01)%InflowOnHub + a2*u2%rotors(i01)%InflowOnHub + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%InflowOnNacelle = a1*u1%rotors(i01)%InflowOnNacelle + a2*u2%rotors(i01)%InflowOnNacelle + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%InflowOnTailFin = a1*u1%rotors(i01)%InflowOnTailFin + a2*u2%rotors(i01)%InflowOnTailFin + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN + u_out%rotors(i01)%UserProp = a1*u1%rotors(i01)%UserProp + a2*u2%rotors(i01)%UserProp + END IF ! check if allocated + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN + u_out%InflowWakeVel = a1*u1%InflowWakeVel + a2*u2%InflowWakeVel + END IF ! check if allocated +END SUBROUTINE - SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE AD_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. @@ -18307,204 +7341,167 @@ SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(AD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(AD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(AD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(AD_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 + TYPE(AD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(AD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(AD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(AD_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 = 'AD_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 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 + 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 + 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 + 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(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, u3%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, u3%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, u3%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1),UBOUND(u_out%rotors(i01)%BladeRootMotion,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), u3%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1),UBOUND(u_out%rotors(i01)%BladeMotion,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), u3%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, u3%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%InflowOnBlade) .AND. ALLOCATED(u1%rotors(i01)%InflowOnBlade)) THEN - DO i3 = LBOUND(u_out%rotors(i01)%InflowOnBlade,3),UBOUND(u_out%rotors(i01)%InflowOnBlade,3) - DO i2 = LBOUND(u_out%rotors(i01)%InflowOnBlade,2),UBOUND(u_out%rotors(i01)%InflowOnBlade,2) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnBlade,1),UBOUND(u_out%rotors(i01)%InflowOnBlade,1) - b = (t(3)**2*(u1%rotors(i01)%InflowOnBlade(i1,i2,i3) - u2%rotors(i01)%InflowOnBlade(i1,i2,i3)) + t(2)**2*(-u1%rotors(i01)%InflowOnBlade(i1,i2,i3) + u3%rotors(i01)%InflowOnBlade(i1,i2,i3)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%InflowOnBlade(i1,i2,i3) + t(3)*u2%rotors(i01)%InflowOnBlade(i1,i2,i3) - t(2)*u3%rotors(i01)%InflowOnBlade(i1,i2,i3) ) * scaleFactor - u_out%rotors(i01)%InflowOnBlade(i1,i2,i3) = u1%rotors(i01)%InflowOnBlade(i1,i2,i3) + b + c * t_out + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, u3%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, u3%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, u3%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN + DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1),UBOUND(u_out%rotors(i01)%BladeRootMotion,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), u3%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated END DO - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%InflowOnTower) .AND. ALLOCATED(u1%rotors(i01)%InflowOnTower)) THEN - DO i2 = LBOUND(u_out%rotors(i01)%InflowOnTower,2),UBOUND(u_out%rotors(i01)%InflowOnTower,2) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnTower,1),UBOUND(u_out%rotors(i01)%InflowOnTower,1) - b = (t(3)**2*(u1%rotors(i01)%InflowOnTower(i1,i2) - u2%rotors(i01)%InflowOnTower(i1,i2)) + t(2)**2*(-u1%rotors(i01)%InflowOnTower(i1,i2) + u3%rotors(i01)%InflowOnTower(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%InflowOnTower(i1,i2) + t(3)*u2%rotors(i01)%InflowOnTower(i1,i2) - t(2)*u3%rotors(i01)%InflowOnTower(i1,i2) ) * scaleFactor - u_out%rotors(i01)%InflowOnTower(i1,i2) = u1%rotors(i01)%InflowOnTower(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnHub,1),UBOUND(u_out%rotors(i01)%InflowOnHub,1) - b = (t(3)**2*(u1%rotors(i01)%InflowOnHub(i1) - u2%rotors(i01)%InflowOnHub(i1)) + t(2)**2*(-u1%rotors(i01)%InflowOnHub(i1) + u3%rotors(i01)%InflowOnHub(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%InflowOnHub(i1) + t(3)*u2%rotors(i01)%InflowOnHub(i1) - t(2)*u3%rotors(i01)%InflowOnHub(i1) ) * scaleFactor - u_out%rotors(i01)%InflowOnHub(i1) = u1%rotors(i01)%InflowOnHub(i1) + b + c * t_out - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnNacelle,1),UBOUND(u_out%rotors(i01)%InflowOnNacelle,1) - b = (t(3)**2*(u1%rotors(i01)%InflowOnNacelle(i1) - u2%rotors(i01)%InflowOnNacelle(i1)) + t(2)**2*(-u1%rotors(i01)%InflowOnNacelle(i1) + u3%rotors(i01)%InflowOnNacelle(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%InflowOnNacelle(i1) + t(3)*u2%rotors(i01)%InflowOnNacelle(i1) - t(2)*u3%rotors(i01)%InflowOnNacelle(i1) ) * scaleFactor - u_out%rotors(i01)%InflowOnNacelle(i1) = u1%rotors(i01)%InflowOnNacelle(i1) + b + c * t_out - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnTailFin,1),UBOUND(u_out%rotors(i01)%InflowOnTailFin,1) - b = (t(3)**2*(u1%rotors(i01)%InflowOnTailFin(i1) - u2%rotors(i01)%InflowOnTailFin(i1)) + t(2)**2*(-u1%rotors(i01)%InflowOnTailFin(i1) + u3%rotors(i01)%InflowOnTailFin(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%InflowOnTailFin(i1) + t(3)*u2%rotors(i01)%InflowOnTailFin(i1) - t(2)*u3%rotors(i01)%InflowOnTailFin(i1) ) * scaleFactor - u_out%rotors(i01)%InflowOnTailFin(i1) = u1%rotors(i01)%InflowOnTailFin(i1) + b + c * t_out - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN - DO i2 = LBOUND(u_out%rotors(i01)%UserProp,2),UBOUND(u_out%rotors(i01)%UserProp,2) - DO i1 = LBOUND(u_out%rotors(i01)%UserProp,1),UBOUND(u_out%rotors(i01)%UserProp,1) - b = (t(3)**2*(u1%rotors(i01)%UserProp(i1,i2) - u2%rotors(i01)%UserProp(i1,i2)) + t(2)**2*(-u1%rotors(i01)%UserProp(i1,i2) + u3%rotors(i01)%UserProp(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%UserProp(i1,i2) + t(3)*u2%rotors(i01)%UserProp(i1,i2) - t(2)*u3%rotors(i01)%UserProp(i1,i2) ) * scaleFactor - u_out%rotors(i01)%UserProp(i1,i2) = u1%rotors(i01)%UserProp(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN - DO i2 = LBOUND(u_out%InflowWakeVel,2),UBOUND(u_out%InflowWakeVel,2) - DO i1 = LBOUND(u_out%InflowWakeVel,1),UBOUND(u_out%InflowWakeVel,1) - b = (t(3)**2*(u1%InflowWakeVel(i1,i2) - u2%InflowWakeVel(i1,i2)) + t(2)**2*(-u1%InflowWakeVel(i1,i2) + u3%InflowWakeVel(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%InflowWakeVel(i1,i2) + t(3)*u2%InflowWakeVel(i1,i2) - t(2)*u3%InflowWakeVel(i1,i2) ) * scaleFactor - u_out%InflowWakeVel(i1,i2) = u1%InflowWakeVel(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE AD_Input_ExtrapInterp2 - - - SUBROUTINE AD_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(AD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(AD_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 + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN + DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1),UBOUND(u_out%rotors(i01)%BladeMotion,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), u3%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, u3%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%InflowOnBlade) .AND. ALLOCATED(u1%rotors(i01)%InflowOnBlade)) THEN + u_out%rotors(i01)%InflowOnBlade = a1*u1%rotors(i01)%InflowOnBlade + a2*u2%rotors(i01)%InflowOnBlade + a3*u3%rotors(i01)%InflowOnBlade + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%InflowOnTower) .AND. ALLOCATED(u1%rotors(i01)%InflowOnTower)) THEN + u_out%rotors(i01)%InflowOnTower = a1*u1%rotors(i01)%InflowOnTower + a2*u2%rotors(i01)%InflowOnTower + a3*u3%rotors(i01)%InflowOnTower + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%InflowOnHub = a1*u1%rotors(i01)%InflowOnHub + a2*u2%rotors(i01)%InflowOnHub + a3*u3%rotors(i01)%InflowOnHub + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%InflowOnNacelle = a1*u1%rotors(i01)%InflowOnNacelle + a2*u2%rotors(i01)%InflowOnNacelle + a3*u3%rotors(i01)%InflowOnNacelle + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%InflowOnTailFin = a1*u1%rotors(i01)%InflowOnTailFin + a2*u2%rotors(i01)%InflowOnTailFin + a3*u3%rotors(i01)%InflowOnTailFin + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN + u_out%rotors(i01)%UserProp = a1*u1%rotors(i01)%UserProp + a2*u2%rotors(i01)%UserProp + a3*u3%rotors(i01)%UserProp + END IF ! check if allocated + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN + u_out%InflowWakeVel = a1*u1%InflowWakeVel + a2*u2%InflowWakeVel + a3*u3%InflowWakeVel + END IF ! check if allocated +END SUBROUTINE + +subroutine AD_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(AD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(AD_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 = 'AD_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 AD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AD_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 AD_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 AD_Output_ExtrapInterp - - - SUBROUTINE AD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'AD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call AD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE AD_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. @@ -18516,75 +7513,73 @@ SUBROUTINE AD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(AD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(AD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(AD_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 + TYPE(AD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(AD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(AD_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 = 'AD_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%rotors) .AND. ALLOCATED(y1%rotors)) THEN + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp1(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp1(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp1(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN + DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1),UBOUND(y_out%rotors(i01)%BladeLoad,1) + CALL MeshExtrapInterp1(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp1(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN + y_out%rotors(i01)%WriteOutput = a1*y1%rotors(i01)%WriteOutput + a2*y2%rotors(i01)%WriteOutput + END IF ! check if allocated + END DO + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%rotors) .AND. ALLOCATED(y1%rotors)) THEN - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp1(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp1(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp1(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) -IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1),UBOUND(y_out%rotors(i01)%BladeLoad,1) - CALL MeshExtrapInterp1(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp1(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) -IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%WriteOutput,1),UBOUND(y_out%rotors(i01)%WriteOutput,1) - b = -(y1%rotors(i01)%WriteOutput(i1) - y2%rotors(i01)%WriteOutput(i1)) - y_out%rotors(i01)%WriteOutput(i1) = y1%rotors(i01)%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated - END SUBROUTINE AD_Output_ExtrapInterp1 - - - SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE AD_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. @@ -18598,82 +7593,78 @@ SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(AD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(AD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(AD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(AD_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 + TYPE(AD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(AD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(AD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(AD_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 = 'AD_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD_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 + 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 + 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 + 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%rotors) .AND. ALLOCATED(y1%rotors)) THEN - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp2(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, y3%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp2(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, y3%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp2(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, y3%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) -IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1),UBOUND(y_out%rotors(i01)%BladeLoad,1) - CALL MeshExtrapInterp2(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), y3%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp2(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, y3%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) -IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%WriteOutput,1),UBOUND(y_out%rotors(i01)%WriteOutput,1) - b = (t(3)**2*(y1%rotors(i01)%WriteOutput(i1) - y2%rotors(i01)%WriteOutput(i1)) + t(2)**2*(-y1%rotors(i01)%WriteOutput(i1) + y3%rotors(i01)%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%rotors(i01)%WriteOutput(i1) + t(3)*y2%rotors(i01)%WriteOutput(i1) - t(2)*y3%rotors(i01)%WriteOutput(i1) ) * scaleFactor - y_out%rotors(i01)%WriteOutput(i1) = y1%rotors(i01)%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated - END SUBROUTINE AD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%rotors) .AND. ALLOCATED(y1%rotors)) THEN + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp2(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, y3%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp2(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, y3%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp2(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, y3%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN + DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1),UBOUND(y_out%rotors(i01)%BladeLoad,1) + CALL MeshExtrapInterp2(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), y3%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp2(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, y3%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN + y_out%rotors(i01)%WriteOutput = a1*y1%rotors(i01)%WriteOutput + a2*y2%rotors(i01)%WriteOutput + a3*y3%rotors(i01)%WriteOutput + END IF ! check if allocated + END DO + END IF ! check if allocated +END SUBROUTINE END MODULE AeroDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index ba566396c9..ec227a4ad7 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -38,53 +38,53 @@ MODULE AirfoilInfo_Types INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_2User = 3 ! 2D interpolation on AoA and UserProp [-] ! ========= AFI_UA_BL_Type ======= TYPE, PUBLIC :: AFI_UA_BL_Type - REAL(ReKi) :: alpha0 !< Angle of attack for zero lift (also used in HGM) [input in degrees; stored as radians] - REAL(ReKi) :: alpha1 !< angle of attack at f = 0.7, approximately the stall angle; for alpha >= alpha0 [input in degrees; stored as radians] - REAL(ReKi) :: alpha2 !< angle of attack at f = 0.7, approximately the stall angle; for alpha < alpha0 [input in degrees; stored as radians] - REAL(ReKi) :: eta_e !< Recovery factor in the range [0.85 - 0.95] [-] - REAL(ReKi) :: C_nalpha !< Cn slope for zero lift (used for Beddoes-Leishman unsteady aero) [1/rad] - REAL(ReKi) :: C_lalpha !< Cl slope for zero lift (used for HGM unsteady aero only) -> calculated [1/rad] - REAL(ReKi) :: T_f0 !< initial value of T_f, airfoil specific, used to compute D_f and fprimeprime (also used in HGM) [-] - REAL(ReKi) :: T_V0 !< initial value of T_V, airfoil specific, time parameter associated with the vortex lift decay process, used in Cn_v [-] - REAL(ReKi) :: T_p !< boundary-layer, leading edge pressure gradient time parameter; used in D_p; airfoil specific (also used in HGM) [-] - REAL(ReKi) :: T_VL !< Initial value of the time constant associated with the vortex advection process; it represents the non-dimensional time in semi-chords, needed for a vortex to travel from LE to trailing edge (TE); it is used in the expression of Cvn. It depends on Re, M (weakly), and airfoil. [valid range = 6 - 13] [-] - REAL(ReKi) :: b1 !< airfoil constant derived from experimental results (also used in HGM), usually 0.14 [-] - REAL(ReKi) :: b2 !< airfoil constant derived from experimental results (also used in HGM), usually 0.53 [-] - REAL(ReKi) :: b5 !< airfoil constant derived from experimental results, usually 5.0 [-] - REAL(ReKi) :: A1 !< airfoil constant derived from experimental results (also used in HGM), usually 0.3 [-] - REAL(ReKi) :: A2 !< airfoil constant derived from experimental results (also used in HGM), usually 0.7 [-] - REAL(ReKi) :: A5 !< airfoil constant derived from experimental results, usually 1.0 [-] - REAL(ReKi) :: S1 !< Constant in the f curve best-fit for alpha0<=AOA<=alpha1 [-] - REAL(ReKi) :: S2 !< Constant in the f curve best-fit for AOA> alpha1 [-] - REAL(ReKi) :: S3 !< Constant in the f curve best-fit for alpha2<=AOA< alpha0 [-] - REAL(ReKi) :: S4 !< Constant in the f curve best-fit for AOA< alpha2 [-] - REAL(ReKi) :: Cn1 !< Cn at stall value for positive angle of attack [or critical value of Cn_prime at LE separation for alpha >= alpha0] [-] - REAL(ReKi) :: Cn2 !< Cn at stall value for negative angle of attack [or critical value of Cn_prime at LE separation for alpha < alpha0] [-] - REAL(ReKi) :: St_sh !< Strouhal's shedding frequency constant. [-] - REAL(ReKi) :: Cd0 !< Minimum Cd value [-] - REAL(ReKi) :: Cm0 !< 2D pitching moment coefficient at zero lift, positive if nose is up [-] - REAL(ReKi) :: k0 !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] - REAL(ReKi) :: k1 !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] - 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) :: 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] - REAL(ReKi) :: filtCutOff !< Reduced frequency cutoff used to calculate the dynamic low pass filter cut-off frequency for the pitching rate and accelerations [default = 0.5] [-] - REAL(ReKi) :: alphaUpper !< (input) upper angle of attack defining fully attached region [input in degrees; stored as radians] - REAL(ReKi) :: alphaLower !< (input) lower angle of attack defining fully attached region [input in degrees; stored as radians] - REAL(ReKi) :: c_Rate !< (calculated) linear slope in the fully attached region of cn or cl [1/rad] - REAL(ReKi) :: c_RateUpper !< (calculated) linear slope in the upper fully attached region of cn or cl [1/rad] - REAL(ReKi) :: c_RateLower !< (calculated) linear slope in the lower fully attached region of cn or cl [1/rad] - REAL(ReKi) :: c_alphaLower !< (calculated) value of cn or cl at alphaLower [-] - REAL(ReKi) :: c_alphaUpper !< (calculated) value of cn or cl at alphaUpper [-] - REAL(ReKi) :: alphaUpperWrap !< (calculated) upper angle of attack defining fully attached wrap-around region [stored as radians] - REAL(ReKi) :: alphaLowerWrap !< (calculated) lower angle of attack defining fully attached wrap-around region [stored as radians] - REAL(ReKi) :: c_RateWrap !< (calculated) linear slope in the fully attached wrap-around region of cn or cl (will be negative) [1/rad] - REAL(ReKi) :: c_alphaLowerWrap !< (calculated) value of cn or cl at alphaLowerWrap [-] - REAL(ReKi) :: c_alphaUpperWrap !< (calculated) value of cn or cl at alphaUpperWrap [-] + REAL(ReKi) :: alpha0 = 0.0_ReKi !< Angle of attack for zero lift (also used in HGM) [input in degrees; stored as radians] + REAL(ReKi) :: alpha1 = 0.0_ReKi !< angle of attack at f = 0.7, approximately the stall angle; for alpha >= alpha0 [input in degrees; stored as radians] + REAL(ReKi) :: alpha2 = 0.0_ReKi !< angle of attack at f = 0.7, approximately the stall angle; for alpha < alpha0 [input in degrees; stored as radians] + REAL(ReKi) :: eta_e = 0.0_ReKi !< Recovery factor in the range [0.85 - 0.95] [-] + REAL(ReKi) :: C_nalpha = 0.0_ReKi !< Cn slope for zero lift (used for Beddoes-Leishman unsteady aero) [1/rad] + REAL(ReKi) :: C_lalpha = 0.0_ReKi !< Cl slope for zero lift (used for HGM unsteady aero only) -> calculated [1/rad] + REAL(ReKi) :: T_f0 = 0.0_ReKi !< initial value of T_f, airfoil specific, used to compute D_f and fprimeprime (also used in HGM) [-] + REAL(ReKi) :: T_V0 = 0.0_ReKi !< initial value of T_V, airfoil specific, time parameter associated with the vortex lift decay process, used in Cn_v [-] + REAL(ReKi) :: T_p = 0.0_ReKi !< boundary-layer, leading edge pressure gradient time parameter; used in D_p; airfoil specific (also used in HGM) [-] + REAL(ReKi) :: T_VL = 0.0_ReKi !< Initial value of the time constant associated with the vortex advection process; it represents the non-dimensional time in semi-chords, needed for a vortex to travel from LE to trailing edge (TE); it is used in the expression of Cvn. It depends on Re, M (weakly), and airfoil. [valid range = 6 - 13] [-] + REAL(ReKi) :: b1 = 0.0_ReKi !< airfoil constant derived from experimental results (also used in HGM), usually 0.14 [-] + REAL(ReKi) :: b2 = 0.0_ReKi !< airfoil constant derived from experimental results (also used in HGM), usually 0.53 [-] + REAL(ReKi) :: b5 = 0.0_ReKi !< airfoil constant derived from experimental results, usually 5.0 [-] + REAL(ReKi) :: A1 = 0.0_ReKi !< airfoil constant derived from experimental results (also used in HGM), usually 0.3 [-] + REAL(ReKi) :: A2 = 0.0_ReKi !< airfoil constant derived from experimental results (also used in HGM), usually 0.7 [-] + REAL(ReKi) :: A5 = 0.0_ReKi !< airfoil constant derived from experimental results, usually 1.0 [-] + REAL(ReKi) :: S1 = 0.0_ReKi !< Constant in the f curve best-fit for alpha0<=AOA<=alpha1 [-] + REAL(ReKi) :: S2 = 0.0_ReKi !< Constant in the f curve best-fit for AOA> alpha1 [-] + REAL(ReKi) :: S3 = 0.0_ReKi !< Constant in the f curve best-fit for alpha2<=AOA< alpha0 [-] + REAL(ReKi) :: S4 = 0.0_ReKi !< Constant in the f curve best-fit for AOA< alpha2 [-] + REAL(ReKi) :: Cn1 = 0.0_ReKi !< Cn at stall value for positive angle of attack [or critical value of Cn_prime at LE separation for alpha >= alpha0] [-] + REAL(ReKi) :: Cn2 = 0.0_ReKi !< Cn at stall value for negative angle of attack [or critical value of Cn_prime at LE separation for alpha < alpha0] [-] + REAL(ReKi) :: St_sh = 0.0_ReKi !< Strouhal's shedding frequency constant. [-] + REAL(ReKi) :: Cd0 = 0.0_ReKi !< Minimum Cd value [-] + REAL(ReKi) :: Cm0 = 0.0_ReKi !< 2D pitching moment coefficient at zero lift, positive if nose is up [-] + REAL(ReKi) :: k0 = 0.0_ReKi !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] + REAL(ReKi) :: k1 = 0.0_ReKi !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] + REAL(ReKi) :: k2 = 0.0_ReKi !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] + REAL(ReKi) :: k3 = 0.0_ReKi !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] + REAL(ReKi) :: k1_hat = 0.0_ReKi !< Constant in the expression of Cc due to leading edge vortex effects. [ignored if UAMod<>1] [-] + REAL(ReKi) :: x_cp_bar = 0.0_ReKi !< Constant in the expression of \hat(x)_cp^v [ignored if UAMod<>1, default = 0.2] [-] + REAL(ReKi) :: UACutout = 0.0_ReKi !< Angle of attack above which unsteady aerodynamics are disabled [input in degrees; stored as radians] + REAL(ReKi) :: UACutout_delta = 0.0_ReKi !< Number of angles-of-attack below UACutout where unsteady aerodynamics begin to be disabled [input in degrees; stored as radians] + REAL(ReKi) :: UACutout_blend = 0.0_ReKi !< Angle of attack above which unsteady aerodynamics begins to be disabled [stored as radians] + REAL(ReKi) :: filtCutOff = 0.0_ReKi !< Reduced frequency cutoff used to calculate the dynamic low pass filter cut-off frequency for the pitching rate and accelerations [default = 0.5] [-] + REAL(ReKi) :: alphaUpper = 0.0_ReKi !< (input) upper angle of attack defining fully attached region [input in degrees; stored as radians] + REAL(ReKi) :: alphaLower = 0.0_ReKi !< (input) lower angle of attack defining fully attached region [input in degrees; stored as radians] + REAL(ReKi) :: c_Rate = 0.0_ReKi !< (calculated) linear slope in the fully attached region of cn or cl [1/rad] + REAL(ReKi) :: c_RateUpper = 0.0_ReKi !< (calculated) linear slope in the upper fully attached region of cn or cl [1/rad] + REAL(ReKi) :: c_RateLower = 0.0_ReKi !< (calculated) linear slope in the lower fully attached region of cn or cl [1/rad] + REAL(ReKi) :: c_alphaLower = 0.0_ReKi !< (calculated) value of cn or cl at alphaLower [-] + REAL(ReKi) :: c_alphaUpper = 0.0_ReKi !< (calculated) value of cn or cl at alphaUpper [-] + REAL(ReKi) :: alphaUpperWrap = 0.0_ReKi !< (calculated) upper angle of attack defining fully attached wrap-around region [stored as radians] + REAL(ReKi) :: alphaLowerWrap = 0.0_ReKi !< (calculated) lower angle of attack defining fully attached wrap-around region [stored as radians] + REAL(ReKi) :: c_RateWrap = 0.0_ReKi !< (calculated) linear slope in the fully attached wrap-around region of cn or cl (will be negative) [1/rad] + REAL(ReKi) :: c_alphaLowerWrap = 0.0_ReKi !< (calculated) value of cn or cl at alphaLowerWrap [-] + REAL(ReKi) :: c_alphaUpperWrap = 0.0_ReKi !< (calculated) value of cn or cl at alphaUpperWrap [-] END TYPE AFI_UA_BL_Type ! ======================= ! ========= AFI_UA_BL_Default_Type ======= @@ -132,24 +132,24 @@ MODULE AirfoilInfo_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Alpha !< Angle-of-attack vector that matches the Coefs matrix [rad] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Coefs !< Airfoil coefficients for Cd, Cl, and maybe Cm and/or Cpmin [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SplineCoefs !< Spline coefficients for Cd, Cl, and maybe Cm and/or Cpmin [-] - REAL(ReKi) :: UserProp !< User Property for a table, for example a Control setting [-] - REAL(ReKi) :: Re !< Reynolds number [-] - INTEGER(IntKi) :: NumAlf !< Length of the Alpha and Coefs arrays [-] - LOGICAL :: ConstData !< Flag that tells if aerodynamic coefficients are the same for all alphas [-] - LOGICAL :: InclUAdata !< Flag that tells if UA data is included in the input file [-] + REAL(ReKi) :: UserProp = 0.0_ReKi !< User Property for a table, for example a Control setting [-] + REAL(ReKi) :: Re = 0.0_ReKi !< Reynolds number [-] + INTEGER(IntKi) :: NumAlf = 0_IntKi !< Length of the Alpha and Coefs arrays [-] + LOGICAL :: ConstData = .false. !< Flag that tells if aerodynamic coefficients are the same for all alphas [-] + LOGICAL :: InclUAdata = .false. !< Flag that tells if UA data is included in the input file [-] TYPE(AFI_UA_BL_Type) :: UA_BL !< The tables of Leishman-Beddoes unsteady-aero data for given Re and control setting [-] END TYPE AFI_Table_Type ! ======================= ! ========= AFI_InitInputType ======= TYPE, PUBLIC :: AFI_InitInputType CHARACTER(1024) :: FileName !< The name of the file the data is read from [-] - INTEGER(IntKi) :: AFTabMod !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] - INTEGER(IntKi) :: InCol_Alfa !< The column of the coefficient tables that holds the angle of attack [-] - INTEGER(IntKi) :: InCol_Cl !< The column of the coefficient tables that holds the lift coefficient [-] - INTEGER(IntKi) :: InCol_Cd !< The column of the coefficient tables that holds the minimum pressure coefficient [-] - INTEGER(IntKi) :: InCol_Cm !< The column of the coefficient tables that holds the pitching-moment coefficient [-] - INTEGER(IntKi) :: InCol_Cpmin !< The column of the coefficient tables that holds the minimum pressure coefficient [-] - LOGICAL :: UA_f_cn !< Whether any UA separation functions should be calculated on cn (true) or cl (false) [-] + INTEGER(IntKi) :: AFTabMod = 0_IntKi !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] + INTEGER(IntKi) :: InCol_Alfa = 0_IntKi !< The column of the coefficient tables that holds the angle of attack [-] + INTEGER(IntKi) :: InCol_Cl = 0_IntKi !< The column of the coefficient tables that holds the lift coefficient [-] + INTEGER(IntKi) :: InCol_Cd = 0_IntKi !< The column of the coefficient tables that holds the minimum pressure coefficient [-] + INTEGER(IntKi) :: InCol_Cm = 0_IntKi !< The column of the coefficient tables that holds the pitching-moment coefficient [-] + INTEGER(IntKi) :: InCol_Cpmin = 0_IntKi !< The column of the coefficient tables that holds the minimum pressure coefficient [-] + LOGICAL :: UA_f_cn = .false. !< Whether any UA separation functions should be calculated on cn (true) or cl (false) [-] END TYPE AFI_InitInputType ! ======================= ! ========= AFI_InitOutputType ======= @@ -159,20 +159,20 @@ MODULE AirfoilInfo_Types ! ======================= ! ========= AFI_ParameterType ======= TYPE, PUBLIC :: AFI_ParameterType - INTEGER(IntKi) :: ColCd !< The column in the p%Coefs arrays that contains Cd data [-] - INTEGER(IntKi) :: ColCl !< The column in the p%Coefs arrays that contains Cl data [-] - INTEGER(IntKi) :: ColCm !< The column in the p%Coefs arrays that contains Cm data [-] - INTEGER(IntKi) :: ColCpmin !< The column in the p%Coefs arrays that contains Cpmin data [-] - INTEGER(IntKi) :: ColUAf !< The column in the p%Coefs arrays that contains f_st data (on cl or cn) for UA [-] - INTEGER(IntKi) :: AFTabMod !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] + INTEGER(IntKi) :: ColCd = 0_IntKi !< The column in the p%Coefs arrays that contains Cd data [-] + INTEGER(IntKi) :: ColCl = 0_IntKi !< The column in the p%Coefs arrays that contains Cl data [-] + INTEGER(IntKi) :: ColCm = 0_IntKi !< The column in the p%Coefs arrays that contains Cm data [-] + INTEGER(IntKi) :: ColCpmin = 0_IntKi !< The column in the p%Coefs arrays that contains Cpmin data [-] + INTEGER(IntKi) :: ColUAf = 0_IntKi !< The column in the p%Coefs arrays that contains f_st data (on cl or cn) for UA [-] + INTEGER(IntKi) :: AFTabMod = 0_IntKi !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: secondVals !< The values of the 2nd dependent variable when using multiple airfoil tables (Re or UserProp, saved in an array so that the logic in the interpolation scheme is cleaner) [-] - INTEGER(IntKi) :: InterpOrd !< Interpolation order [-] - REAL(ReKi) :: RelThickness !< Relative thickness of airfoil thickness/chord [-] - REAL(ReKi) :: NonDimArea !< The non-dimensional area of the airfoil (area/chord^2) [unused] [-] - INTEGER(IntKi) :: NumCoords !< The number of coordinates which define the airfoil shape [-] + INTEGER(IntKi) :: InterpOrd = 0_IntKi !< Interpolation order [-] + REAL(ReKi) :: RelThickness = 0.0_ReKi !< Relative thickness of airfoil thickness/chord [-] + REAL(ReKi) :: NonDimArea = 0.0_ReKi !< The non-dimensional area of the airfoil (area/chord^2) [unused] [-] + INTEGER(IntKi) :: NumCoords = 0_IntKi !< The number of coordinates which define the airfoil shape [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X_Coord !< X-coordinate for the airfoil shape [unused] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y_Coord !< Y-coordinate for the airfoil shape [unused] [-] - INTEGER(IntKi) :: NumTabs !< The number of airfoil tables in the airfoil file [-] + INTEGER(IntKi) :: NumTabs = 0_IntKi !< The number of airfoil tables in the airfoil file [-] TYPE(AFI_Table_Type) , DIMENSION(:), ALLOCATABLE :: Table !< The tables of airfoil data for given Re and control setting [-] CHARACTER(1024) :: BL_file !< The name of the file with the boundary layer data [-] CHARACTER(1024) :: FileName !< The name of the file that stored this information. [-] @@ -180,9 +180,9 @@ MODULE AirfoilInfo_Types ! ======================= ! ========= AFI_InputType ======= TYPE, PUBLIC :: AFI_InputType - REAL(ReKi) :: AoA !< The angle of attack [radians] - REAL(ReKi) :: UserProp !< The user-defined control setting [-] - REAL(ReKi) :: Re !< Reynolds number [-] + REAL(ReKi) :: AoA = 0.0_ReKi !< The angle of attack [radians] + REAL(ReKi) :: UserProp = 0.0_ReKi !< The user-defined control setting [-] + REAL(ReKi) :: Re = 0.0_ReKi !< Reynolds number [-] END TYPE AFI_InputType ! ======================= ! ========= AFI_OutputType ======= @@ -199,2469 +199,1117 @@ MODULE AirfoilInfo_Types END TYPE AFI_OutputType ! ======================= CONTAINS - SUBROUTINE AFI_CopyUA_BL_Type( SrcUA_BL_TypeData, DstUA_BL_TypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_UA_BL_Type), INTENT(IN) :: SrcUA_BL_TypeData - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: DstUA_BL_TypeData - 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 = 'AFI_CopyUA_BL_Type' -! - ErrStat = ErrID_None - ErrMsg = "" - DstUA_BL_TypeData%alpha0 = SrcUA_BL_TypeData%alpha0 - DstUA_BL_TypeData%alpha1 = SrcUA_BL_TypeData%alpha1 - DstUA_BL_TypeData%alpha2 = SrcUA_BL_TypeData%alpha2 - DstUA_BL_TypeData%eta_e = SrcUA_BL_TypeData%eta_e - DstUA_BL_TypeData%C_nalpha = SrcUA_BL_TypeData%C_nalpha - DstUA_BL_TypeData%C_lalpha = SrcUA_BL_TypeData%C_lalpha - DstUA_BL_TypeData%T_f0 = SrcUA_BL_TypeData%T_f0 - DstUA_BL_TypeData%T_V0 = SrcUA_BL_TypeData%T_V0 - DstUA_BL_TypeData%T_p = SrcUA_BL_TypeData%T_p - DstUA_BL_TypeData%T_VL = SrcUA_BL_TypeData%T_VL - DstUA_BL_TypeData%b1 = SrcUA_BL_TypeData%b1 - DstUA_BL_TypeData%b2 = SrcUA_BL_TypeData%b2 - DstUA_BL_TypeData%b5 = SrcUA_BL_TypeData%b5 - DstUA_BL_TypeData%A1 = SrcUA_BL_TypeData%A1 - DstUA_BL_TypeData%A2 = SrcUA_BL_TypeData%A2 - DstUA_BL_TypeData%A5 = SrcUA_BL_TypeData%A5 - DstUA_BL_TypeData%S1 = SrcUA_BL_TypeData%S1 - DstUA_BL_TypeData%S2 = SrcUA_BL_TypeData%S2 - DstUA_BL_TypeData%S3 = SrcUA_BL_TypeData%S3 - DstUA_BL_TypeData%S4 = SrcUA_BL_TypeData%S4 - DstUA_BL_TypeData%Cn1 = SrcUA_BL_TypeData%Cn1 - DstUA_BL_TypeData%Cn2 = SrcUA_BL_TypeData%Cn2 - DstUA_BL_TypeData%St_sh = SrcUA_BL_TypeData%St_sh - DstUA_BL_TypeData%Cd0 = SrcUA_BL_TypeData%Cd0 - DstUA_BL_TypeData%Cm0 = SrcUA_BL_TypeData%Cm0 - DstUA_BL_TypeData%k0 = SrcUA_BL_TypeData%k0 - DstUA_BL_TypeData%k1 = SrcUA_BL_TypeData%k1 - DstUA_BL_TypeData%k2 = SrcUA_BL_TypeData%k2 - DstUA_BL_TypeData%k3 = SrcUA_BL_TypeData%k3 - DstUA_BL_TypeData%k1_hat = SrcUA_BL_TypeData%k1_hat - DstUA_BL_TypeData%x_cp_bar = SrcUA_BL_TypeData%x_cp_bar - DstUA_BL_TypeData%UACutout = SrcUA_BL_TypeData%UACutout - DstUA_BL_TypeData%UACutout_delta = SrcUA_BL_TypeData%UACutout_delta - DstUA_BL_TypeData%UACutout_blend = SrcUA_BL_TypeData%UACutout_blend - DstUA_BL_TypeData%filtCutOff = SrcUA_BL_TypeData%filtCutOff - DstUA_BL_TypeData%alphaUpper = SrcUA_BL_TypeData%alphaUpper - DstUA_BL_TypeData%alphaLower = SrcUA_BL_TypeData%alphaLower - DstUA_BL_TypeData%c_Rate = SrcUA_BL_TypeData%c_Rate - DstUA_BL_TypeData%c_RateUpper = SrcUA_BL_TypeData%c_RateUpper - DstUA_BL_TypeData%c_RateLower = SrcUA_BL_TypeData%c_RateLower - DstUA_BL_TypeData%c_alphaLower = SrcUA_BL_TypeData%c_alphaLower - DstUA_BL_TypeData%c_alphaUpper = SrcUA_BL_TypeData%c_alphaUpper - DstUA_BL_TypeData%alphaUpperWrap = SrcUA_BL_TypeData%alphaUpperWrap - DstUA_BL_TypeData%alphaLowerWrap = SrcUA_BL_TypeData%alphaLowerWrap - DstUA_BL_TypeData%c_RateWrap = SrcUA_BL_TypeData%c_RateWrap - DstUA_BL_TypeData%c_alphaLowerWrap = SrcUA_BL_TypeData%c_alphaLowerWrap - 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 ) - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: UA_BL_TypeData - 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 = 'AFI_DestroyUA_BL_Type' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AFI_DestroyUA_BL_Type - - SUBROUTINE AFI_PackUA_BL_Type( 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(AFI_UA_BL_Type), 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 = 'AFI_PackUA_BL_Type' - ! 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 ! alpha0 - Re_BufSz = Re_BufSz + 1 ! alpha1 - Re_BufSz = Re_BufSz + 1 ! alpha2 - Re_BufSz = Re_BufSz + 1 ! eta_e - Re_BufSz = Re_BufSz + 1 ! C_nalpha - Re_BufSz = Re_BufSz + 1 ! C_lalpha - Re_BufSz = Re_BufSz + 1 ! T_f0 - Re_BufSz = Re_BufSz + 1 ! T_V0 - Re_BufSz = Re_BufSz + 1 ! T_p - Re_BufSz = Re_BufSz + 1 ! T_VL - Re_BufSz = Re_BufSz + 1 ! b1 - Re_BufSz = Re_BufSz + 1 ! b2 - Re_BufSz = Re_BufSz + 1 ! b5 - Re_BufSz = Re_BufSz + 1 ! A1 - Re_BufSz = Re_BufSz + 1 ! A2 - Re_BufSz = Re_BufSz + 1 ! A5 - Re_BufSz = Re_BufSz + 1 ! S1 - Re_BufSz = Re_BufSz + 1 ! S2 - Re_BufSz = Re_BufSz + 1 ! S3 - Re_BufSz = Re_BufSz + 1 ! S4 - Re_BufSz = Re_BufSz + 1 ! Cn1 - Re_BufSz = Re_BufSz + 1 ! Cn2 - Re_BufSz = Re_BufSz + 1 ! St_sh - Re_BufSz = Re_BufSz + 1 ! Cd0 - Re_BufSz = Re_BufSz + 1 ! Cm0 - Re_BufSz = Re_BufSz + 1 ! k0 - Re_BufSz = Re_BufSz + 1 ! k1 - Re_BufSz = Re_BufSz + 1 ! k2 - Re_BufSz = Re_BufSz + 1 ! k3 - Re_BufSz = Re_BufSz + 1 ! k1_hat - Re_BufSz = Re_BufSz + 1 ! x_cp_bar - Re_BufSz = Re_BufSz + 1 ! UACutout - Re_BufSz = Re_BufSz + 1 ! UACutout_delta - Re_BufSz = Re_BufSz + 1 ! UACutout_blend - Re_BufSz = Re_BufSz + 1 ! filtCutOff - Re_BufSz = Re_BufSz + 1 ! alphaUpper - Re_BufSz = Re_BufSz + 1 ! alphaLower - Re_BufSz = Re_BufSz + 1 ! c_Rate - Re_BufSz = Re_BufSz + 1 ! c_RateUpper - Re_BufSz = Re_BufSz + 1 ! c_RateLower - Re_BufSz = Re_BufSz + 1 ! c_alphaLower - Re_BufSz = Re_BufSz + 1 ! c_alphaUpper - Re_BufSz = Re_BufSz + 1 ! alphaUpperWrap - Re_BufSz = Re_BufSz + 1 ! alphaLowerWrap - Re_BufSz = Re_BufSz + 1 ! c_RateWrap - Re_BufSz = Re_BufSz + 1 ! c_alphaLowerWrap - Re_BufSz = Re_BufSz + 1 ! c_alphaUpperWrap - 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%alpha0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%eta_e - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_nalpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_lalpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_f0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_V0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_p - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_VL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%b1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%b2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%b5 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%A1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%A2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%A5 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%S1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%S2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%S3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%S4 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%St_sh - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cd0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k1_hat - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%x_cp_bar - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UACutout - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UACutout_delta - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UACutout_blend - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%filtCutOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alphaUpper - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alphaLower - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_Rate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_RateUpper - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_RateLower - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_alphaLower - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_alphaUpper - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alphaUpperWrap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alphaLowerWrap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_RateWrap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_alphaLowerWrap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_alphaUpperWrap - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_PackUA_BL_Type - - SUBROUTINE AFI_UnPackUA_BL_Type( 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(AFI_UA_BL_Type), 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 = 'AFI_UnPackUA_BL_Type' - ! 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%alpha0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%eta_e = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_nalpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_lalpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_f0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_V0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_p = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_VL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%b1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%b2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%b5 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%A1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%A2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%A5 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%S1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%S2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%S3 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%S4 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%St_sh = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cd0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k3 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k1_hat = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%x_cp_bar = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UACutout = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UACutout_delta = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UACutout_blend = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%filtCutOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alphaUpper = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alphaLower = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_Rate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_RateUpper = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_RateLower = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_alphaLower = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_alphaUpper = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alphaUpperWrap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alphaLowerWrap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_RateWrap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_alphaLowerWrap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_alphaUpperWrap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_UnPackUA_BL_Type - - SUBROUTINE AFI_CopyUA_BL_Default_Type( SrcUA_BL_Default_TypeData, DstUA_BL_Default_TypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_UA_BL_Default_Type), INTENT(IN) :: SrcUA_BL_Default_TypeData - TYPE(AFI_UA_BL_Default_Type), INTENT(INOUT) :: DstUA_BL_Default_TypeData - 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 = 'AFI_CopyUA_BL_Default_Type' -! +subroutine AFI_CopyUA_BL_Type(SrcUA_BL_TypeData, DstUA_BL_TypeData, CtrlCode, ErrStat, ErrMsg) + type(AFI_UA_BL_Type), intent(in) :: SrcUA_BL_TypeData + type(AFI_UA_BL_Type), intent(inout) :: DstUA_BL_TypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_CopyUA_BL_Type' ErrStat = ErrID_None - ErrMsg = "" - DstUA_BL_Default_TypeData%alpha0 = SrcUA_BL_Default_TypeData%alpha0 - DstUA_BL_Default_TypeData%alpha1 = SrcUA_BL_Default_TypeData%alpha1 - DstUA_BL_Default_TypeData%alpha2 = SrcUA_BL_Default_TypeData%alpha2 - DstUA_BL_Default_TypeData%eta_e = SrcUA_BL_Default_TypeData%eta_e - DstUA_BL_Default_TypeData%C_nalpha = SrcUA_BL_Default_TypeData%C_nalpha - DstUA_BL_Default_TypeData%C_lalpha = SrcUA_BL_Default_TypeData%C_lalpha - DstUA_BL_Default_TypeData%T_f0 = SrcUA_BL_Default_TypeData%T_f0 - DstUA_BL_Default_TypeData%T_V0 = SrcUA_BL_Default_TypeData%T_V0 - DstUA_BL_Default_TypeData%T_p = SrcUA_BL_Default_TypeData%T_p - DstUA_BL_Default_TypeData%T_VL = SrcUA_BL_Default_TypeData%T_VL - DstUA_BL_Default_TypeData%b1 = SrcUA_BL_Default_TypeData%b1 - DstUA_BL_Default_TypeData%b2 = SrcUA_BL_Default_TypeData%b2 - DstUA_BL_Default_TypeData%b5 = SrcUA_BL_Default_TypeData%b5 - DstUA_BL_Default_TypeData%A1 = SrcUA_BL_Default_TypeData%A1 - DstUA_BL_Default_TypeData%A2 = SrcUA_BL_Default_TypeData%A2 - DstUA_BL_Default_TypeData%A5 = SrcUA_BL_Default_TypeData%A5 - DstUA_BL_Default_TypeData%S1 = SrcUA_BL_Default_TypeData%S1 - DstUA_BL_Default_TypeData%S2 = SrcUA_BL_Default_TypeData%S2 - DstUA_BL_Default_TypeData%S3 = SrcUA_BL_Default_TypeData%S3 - DstUA_BL_Default_TypeData%S4 = SrcUA_BL_Default_TypeData%S4 - DstUA_BL_Default_TypeData%Cn1 = SrcUA_BL_Default_TypeData%Cn1 - DstUA_BL_Default_TypeData%Cn2 = SrcUA_BL_Default_TypeData%Cn2 - DstUA_BL_Default_TypeData%St_sh = SrcUA_BL_Default_TypeData%St_sh - DstUA_BL_Default_TypeData%Cd0 = SrcUA_BL_Default_TypeData%Cd0 - DstUA_BL_Default_TypeData%Cm0 = SrcUA_BL_Default_TypeData%Cm0 - DstUA_BL_Default_TypeData%k0 = SrcUA_BL_Default_TypeData%k0 - DstUA_BL_Default_TypeData%k1 = SrcUA_BL_Default_TypeData%k1 - DstUA_BL_Default_TypeData%k2 = SrcUA_BL_Default_TypeData%k2 - DstUA_BL_Default_TypeData%k3 = SrcUA_BL_Default_TypeData%k3 - DstUA_BL_Default_TypeData%k1_hat = SrcUA_BL_Default_TypeData%k1_hat - DstUA_BL_Default_TypeData%x_cp_bar = SrcUA_BL_Default_TypeData%x_cp_bar - DstUA_BL_Default_TypeData%UACutout = SrcUA_BL_Default_TypeData%UACutout - DstUA_BL_Default_TypeData%UACutout_delta = SrcUA_BL_Default_TypeData%UACutout_delta - DstUA_BL_Default_TypeData%filtCutOff = SrcUA_BL_Default_TypeData%filtCutOff - DstUA_BL_Default_TypeData%alphaUpper = SrcUA_BL_Default_TypeData%alphaUpper - 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 ) - TYPE(AFI_UA_BL_Default_Type), INTENT(INOUT) :: UA_BL_Default_TypeData - 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 = 'AFI_DestroyUA_BL_Default_Type' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AFI_DestroyUA_BL_Default_Type - - SUBROUTINE AFI_PackUA_BL_Default_Type( 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(AFI_UA_BL_Default_Type), 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 = 'AFI_PackUA_BL_Default_Type' - ! 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 ! alpha0 - Int_BufSz = Int_BufSz + 1 ! alpha1 - Int_BufSz = Int_BufSz + 1 ! alpha2 - Int_BufSz = Int_BufSz + 1 ! eta_e - Int_BufSz = Int_BufSz + 1 ! C_nalpha - Int_BufSz = Int_BufSz + 1 ! C_lalpha - Int_BufSz = Int_BufSz + 1 ! T_f0 - Int_BufSz = Int_BufSz + 1 ! T_V0 - Int_BufSz = Int_BufSz + 1 ! T_p - Int_BufSz = Int_BufSz + 1 ! T_VL - Int_BufSz = Int_BufSz + 1 ! b1 - Int_BufSz = Int_BufSz + 1 ! b2 - Int_BufSz = Int_BufSz + 1 ! b5 - Int_BufSz = Int_BufSz + 1 ! A1 - Int_BufSz = Int_BufSz + 1 ! A2 - Int_BufSz = Int_BufSz + 1 ! A5 - Int_BufSz = Int_BufSz + 1 ! S1 - Int_BufSz = Int_BufSz + 1 ! S2 - Int_BufSz = Int_BufSz + 1 ! S3 - Int_BufSz = Int_BufSz + 1 ! S4 - Int_BufSz = Int_BufSz + 1 ! Cn1 - Int_BufSz = Int_BufSz + 1 ! Cn2 - Int_BufSz = Int_BufSz + 1 ! St_sh - Int_BufSz = Int_BufSz + 1 ! Cd0 - Int_BufSz = Int_BufSz + 1 ! Cm0 - Int_BufSz = Int_BufSz + 1 ! k0 - Int_BufSz = Int_BufSz + 1 ! k1 - Int_BufSz = Int_BufSz + 1 ! k2 - Int_BufSz = Int_BufSz + 1 ! k3 - Int_BufSz = Int_BufSz + 1 ! k1_hat - Int_BufSz = Int_BufSz + 1 ! x_cp_bar - Int_BufSz = Int_BufSz + 1 ! UACutout - Int_BufSz = Int_BufSz + 1 ! UACutout_delta - Int_BufSz = Int_BufSz + 1 ! filtCutOff - Int_BufSz = Int_BufSz + 1 ! alphaUpper - Int_BufSz = Int_BufSz + 1 ! alphaLower - 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) = TRANSFER(InData%alpha0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%alpha1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%alpha2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%eta_e, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%C_nalpha, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%C_lalpha, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%T_f0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%T_V0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%T_p, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%T_VL, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%b1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%b2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%b5, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%A1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%A2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%A5, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%S1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%S2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%S3, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%S4, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Cn1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Cn2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%St_sh, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Cd0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Cm0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%k0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%k1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%k2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%k3, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%k1_hat, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%x_cp_bar, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UACutout, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UACutout_delta, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%filtCutOff, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%alphaUpper, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%alphaLower, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AFI_PackUA_BL_Default_Type - - SUBROUTINE AFI_UnPackUA_BL_Default_Type( 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(AFI_UA_BL_Default_Type), 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 = 'AFI_UnPackUA_BL_Default_Type' - ! 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%alpha0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%alpha0) - Int_Xferred = Int_Xferred + 1 - OutData%alpha1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%alpha1) - Int_Xferred = Int_Xferred + 1 - OutData%alpha2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%alpha2) - Int_Xferred = Int_Xferred + 1 - OutData%eta_e = TRANSFER(IntKiBuf(Int_Xferred), OutData%eta_e) - Int_Xferred = Int_Xferred + 1 - OutData%C_nalpha = TRANSFER(IntKiBuf(Int_Xferred), OutData%C_nalpha) - Int_Xferred = Int_Xferred + 1 - OutData%C_lalpha = TRANSFER(IntKiBuf(Int_Xferred), OutData%C_lalpha) - Int_Xferred = Int_Xferred + 1 - OutData%T_f0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%T_f0) - Int_Xferred = Int_Xferred + 1 - OutData%T_V0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%T_V0) - Int_Xferred = Int_Xferred + 1 - OutData%T_p = TRANSFER(IntKiBuf(Int_Xferred), OutData%T_p) - Int_Xferred = Int_Xferred + 1 - OutData%T_VL = TRANSFER(IntKiBuf(Int_Xferred), OutData%T_VL) - Int_Xferred = Int_Xferred + 1 - OutData%b1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%b1) - Int_Xferred = Int_Xferred + 1 - OutData%b2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%b2) - Int_Xferred = Int_Xferred + 1 - OutData%b5 = TRANSFER(IntKiBuf(Int_Xferred), OutData%b5) - Int_Xferred = Int_Xferred + 1 - OutData%A1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%A1) - Int_Xferred = Int_Xferred + 1 - OutData%A2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%A2) - Int_Xferred = Int_Xferred + 1 - OutData%A5 = TRANSFER(IntKiBuf(Int_Xferred), OutData%A5) - Int_Xferred = Int_Xferred + 1 - OutData%S1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%S1) - Int_Xferred = Int_Xferred + 1 - OutData%S2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%S2) - Int_Xferred = Int_Xferred + 1 - OutData%S3 = TRANSFER(IntKiBuf(Int_Xferred), OutData%S3) - Int_Xferred = Int_Xferred + 1 - OutData%S4 = TRANSFER(IntKiBuf(Int_Xferred), OutData%S4) - Int_Xferred = Int_Xferred + 1 - OutData%Cn1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%Cn1) - Int_Xferred = Int_Xferred + 1 - OutData%Cn2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%Cn2) - Int_Xferred = Int_Xferred + 1 - OutData%St_sh = TRANSFER(IntKiBuf(Int_Xferred), OutData%St_sh) - Int_Xferred = Int_Xferred + 1 - OutData%Cd0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%Cd0) - Int_Xferred = Int_Xferred + 1 - OutData%Cm0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%Cm0) - Int_Xferred = Int_Xferred + 1 - OutData%k0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%k0) - Int_Xferred = Int_Xferred + 1 - OutData%k1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%k1) - Int_Xferred = Int_Xferred + 1 - OutData%k2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%k2) - Int_Xferred = Int_Xferred + 1 - OutData%k3 = TRANSFER(IntKiBuf(Int_Xferred), OutData%k3) - Int_Xferred = Int_Xferred + 1 - OutData%k1_hat = TRANSFER(IntKiBuf(Int_Xferred), OutData%k1_hat) - Int_Xferred = Int_Xferred + 1 - OutData%x_cp_bar = TRANSFER(IntKiBuf(Int_Xferred), OutData%x_cp_bar) - Int_Xferred = Int_Xferred + 1 - OutData%UACutout = TRANSFER(IntKiBuf(Int_Xferred), OutData%UACutout) - Int_Xferred = Int_Xferred + 1 - OutData%UACutout_delta = TRANSFER(IntKiBuf(Int_Xferred), OutData%UACutout_delta) - Int_Xferred = Int_Xferred + 1 - OutData%filtCutOff = TRANSFER(IntKiBuf(Int_Xferred), OutData%filtCutOff) - Int_Xferred = Int_Xferred + 1 - OutData%alphaUpper = TRANSFER(IntKiBuf(Int_Xferred), OutData%alphaUpper) - Int_Xferred = Int_Xferred + 1 - OutData%alphaLower = TRANSFER(IntKiBuf(Int_Xferred), OutData%alphaLower) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AFI_UnPackUA_BL_Default_Type - - SUBROUTINE AFI_CopyTable_Type( SrcTable_TypeData, DstTable_TypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_Table_Type), INTENT(IN) :: SrcTable_TypeData - TYPE(AFI_Table_Type), INTENT(INOUT) :: DstTable_TypeData - 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 = 'AFI_CopyTable_Type' -! + ErrMsg = '' + DstUA_BL_TypeData%alpha0 = SrcUA_BL_TypeData%alpha0 + DstUA_BL_TypeData%alpha1 = SrcUA_BL_TypeData%alpha1 + DstUA_BL_TypeData%alpha2 = SrcUA_BL_TypeData%alpha2 + DstUA_BL_TypeData%eta_e = SrcUA_BL_TypeData%eta_e + DstUA_BL_TypeData%C_nalpha = SrcUA_BL_TypeData%C_nalpha + DstUA_BL_TypeData%C_lalpha = SrcUA_BL_TypeData%C_lalpha + DstUA_BL_TypeData%T_f0 = SrcUA_BL_TypeData%T_f0 + DstUA_BL_TypeData%T_V0 = SrcUA_BL_TypeData%T_V0 + DstUA_BL_TypeData%T_p = SrcUA_BL_TypeData%T_p + DstUA_BL_TypeData%T_VL = SrcUA_BL_TypeData%T_VL + DstUA_BL_TypeData%b1 = SrcUA_BL_TypeData%b1 + DstUA_BL_TypeData%b2 = SrcUA_BL_TypeData%b2 + DstUA_BL_TypeData%b5 = SrcUA_BL_TypeData%b5 + DstUA_BL_TypeData%A1 = SrcUA_BL_TypeData%A1 + DstUA_BL_TypeData%A2 = SrcUA_BL_TypeData%A2 + DstUA_BL_TypeData%A5 = SrcUA_BL_TypeData%A5 + DstUA_BL_TypeData%S1 = SrcUA_BL_TypeData%S1 + DstUA_BL_TypeData%S2 = SrcUA_BL_TypeData%S2 + DstUA_BL_TypeData%S3 = SrcUA_BL_TypeData%S3 + DstUA_BL_TypeData%S4 = SrcUA_BL_TypeData%S4 + DstUA_BL_TypeData%Cn1 = SrcUA_BL_TypeData%Cn1 + DstUA_BL_TypeData%Cn2 = SrcUA_BL_TypeData%Cn2 + DstUA_BL_TypeData%St_sh = SrcUA_BL_TypeData%St_sh + DstUA_BL_TypeData%Cd0 = SrcUA_BL_TypeData%Cd0 + DstUA_BL_TypeData%Cm0 = SrcUA_BL_TypeData%Cm0 + DstUA_BL_TypeData%k0 = SrcUA_BL_TypeData%k0 + DstUA_BL_TypeData%k1 = SrcUA_BL_TypeData%k1 + DstUA_BL_TypeData%k2 = SrcUA_BL_TypeData%k2 + DstUA_BL_TypeData%k3 = SrcUA_BL_TypeData%k3 + DstUA_BL_TypeData%k1_hat = SrcUA_BL_TypeData%k1_hat + DstUA_BL_TypeData%x_cp_bar = SrcUA_BL_TypeData%x_cp_bar + DstUA_BL_TypeData%UACutout = SrcUA_BL_TypeData%UACutout + DstUA_BL_TypeData%UACutout_delta = SrcUA_BL_TypeData%UACutout_delta + DstUA_BL_TypeData%UACutout_blend = SrcUA_BL_TypeData%UACutout_blend + DstUA_BL_TypeData%filtCutOff = SrcUA_BL_TypeData%filtCutOff + DstUA_BL_TypeData%alphaUpper = SrcUA_BL_TypeData%alphaUpper + DstUA_BL_TypeData%alphaLower = SrcUA_BL_TypeData%alphaLower + DstUA_BL_TypeData%c_Rate = SrcUA_BL_TypeData%c_Rate + DstUA_BL_TypeData%c_RateUpper = SrcUA_BL_TypeData%c_RateUpper + DstUA_BL_TypeData%c_RateLower = SrcUA_BL_TypeData%c_RateLower + DstUA_BL_TypeData%c_alphaLower = SrcUA_BL_TypeData%c_alphaLower + DstUA_BL_TypeData%c_alphaUpper = SrcUA_BL_TypeData%c_alphaUpper + DstUA_BL_TypeData%alphaUpperWrap = SrcUA_BL_TypeData%alphaUpperWrap + DstUA_BL_TypeData%alphaLowerWrap = SrcUA_BL_TypeData%alphaLowerWrap + DstUA_BL_TypeData%c_RateWrap = SrcUA_BL_TypeData%c_RateWrap + DstUA_BL_TypeData%c_alphaLowerWrap = SrcUA_BL_TypeData%c_alphaLowerWrap + DstUA_BL_TypeData%c_alphaUpperWrap = SrcUA_BL_TypeData%c_alphaUpperWrap +end subroutine + +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 + character(*), parameter :: RoutineName = 'AFI_DestroyUA_BL_Type' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcTable_TypeData%Alpha)) THEN - i1_l = LBOUND(SrcTable_TypeData%Alpha,1) - i1_u = UBOUND(SrcTable_TypeData%Alpha,1) - IF (.NOT. ALLOCATED(DstTable_TypeData%Alpha)) THEN - ALLOCATE(DstTable_TypeData%Alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%Alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTable_TypeData%Alpha = SrcTable_TypeData%Alpha -ENDIF -IF (ALLOCATED(SrcTable_TypeData%Coefs)) THEN - i1_l = LBOUND(SrcTable_TypeData%Coefs,1) - i1_u = UBOUND(SrcTable_TypeData%Coefs,1) - i2_l = LBOUND(SrcTable_TypeData%Coefs,2) - i2_u = UBOUND(SrcTable_TypeData%Coefs,2) - IF (.NOT. ALLOCATED(DstTable_TypeData%Coefs)) THEN - ALLOCATE(DstTable_TypeData%Coefs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%Coefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTable_TypeData%Coefs = SrcTable_TypeData%Coefs -ENDIF -IF (ALLOCATED(SrcTable_TypeData%SplineCoefs)) THEN - i1_l = LBOUND(SrcTable_TypeData%SplineCoefs,1) - i1_u = UBOUND(SrcTable_TypeData%SplineCoefs,1) - i2_l = LBOUND(SrcTable_TypeData%SplineCoefs,2) - i2_u = UBOUND(SrcTable_TypeData%SplineCoefs,2) - i3_l = LBOUND(SrcTable_TypeData%SplineCoefs,3) - i3_u = UBOUND(SrcTable_TypeData%SplineCoefs,3) - IF (.NOT. ALLOCATED(DstTable_TypeData%SplineCoefs)) THEN - ALLOCATE(DstTable_TypeData%SplineCoefs(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%SplineCoefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTable_TypeData%SplineCoefs = SrcTable_TypeData%SplineCoefs -ENDIF - DstTable_TypeData%UserProp = SrcTable_TypeData%UserProp - DstTable_TypeData%Re = SrcTable_TypeData%Re - DstTable_TypeData%NumAlf = SrcTable_TypeData%NumAlf - DstTable_TypeData%ConstData = SrcTable_TypeData%ConstData - DstTable_TypeData%InclUAdata = SrcTable_TypeData%InclUAdata - CALL AFI_Copyua_bl_type( SrcTable_TypeData%UA_BL, DstTable_TypeData%UA_BL, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AFI_CopyTable_Type - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyTable_Type' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Table_TypeData%Alpha)) THEN - DEALLOCATE(Table_TypeData%Alpha) -ENDIF -IF (ALLOCATED(Table_TypeData%Coefs)) THEN - DEALLOCATE(Table_TypeData%Coefs) -ENDIF -IF (ALLOCATED(Table_TypeData%SplineCoefs)) THEN - DEALLOCATE(Table_TypeData%SplineCoefs) -ENDIF - CALL AFI_DestroyUA_BL_Type( Table_TypeData%UA_BL, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AFI_DestroyTable_Type - - SUBROUTINE AFI_PackTable_Type( 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(AFI_Table_Type), 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 = 'AFI_PackTable_Type' - ! 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 ! Alpha allocated yes/no - IF ( ALLOCATED(InData%Alpha) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Alpha upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Alpha) ! Alpha - END IF - Int_BufSz = Int_BufSz + 1 ! Coefs allocated yes/no - IF ( ALLOCATED(InData%Coefs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Coefs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Coefs) ! Coefs - END IF - Int_BufSz = Int_BufSz + 1 ! SplineCoefs allocated yes/no - IF ( ALLOCATED(InData%SplineCoefs) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SplineCoefs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SplineCoefs) ! SplineCoefs - END IF - Re_BufSz = Re_BufSz + 1 ! UserProp - Re_BufSz = Re_BufSz + 1 ! Re - Int_BufSz = Int_BufSz + 1 ! NumAlf - Int_BufSz = Int_BufSz + 1 ! ConstData - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA_BL - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA_BL - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA_BL - 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 - - IF ( .NOT. ALLOCATED(InData%Alpha) ) 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%Alpha,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Alpha,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Alpha,1), UBOUND(InData%Alpha,1) - ReKiBuf(Re_Xferred) = InData%Alpha(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Coefs) ) 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%Coefs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Coefs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Coefs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Coefs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Coefs,2), UBOUND(InData%Coefs,2) - DO i1 = LBOUND(InData%Coefs,1), UBOUND(InData%Coefs,1) - ReKiBuf(Re_Xferred) = InData%Coefs(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SplineCoefs) ) 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%SplineCoefs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SplineCoefs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SplineCoefs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SplineCoefs,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SplineCoefs,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SplineCoefs,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SplineCoefs,3), UBOUND(InData%SplineCoefs,3) - DO i2 = LBOUND(InData%SplineCoefs,2), UBOUND(InData%SplineCoefs,2) - DO i1 = LBOUND(InData%SplineCoefs,1), UBOUND(InData%SplineCoefs,1) - ReKiBuf(Re_Xferred) = InData%SplineCoefs(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%UserProp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Re - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumAlf - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ConstData, IntKiBuf(1)) - 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 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 AFI_PackTable_Type - - SUBROUTINE AFI_UnPackTable_Type( 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(AFI_Table_Type), 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 = 'AFI_UnPackTable_Type' - ! 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 ! Alpha 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%Alpha)) DEALLOCATE(OutData%Alpha) - ALLOCATE(OutData%Alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Alpha,1), UBOUND(OutData%Alpha,1) - OutData%Alpha(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Coefs 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%Coefs)) DEALLOCATE(OutData%Coefs) - ALLOCATE(OutData%Coefs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Coefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Coefs,2), UBOUND(OutData%Coefs,2) - DO i1 = LBOUND(OutData%Coefs,1), UBOUND(OutData%Coefs,1) - OutData%Coefs(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SplineCoefs 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%SplineCoefs)) DEALLOCATE(OutData%SplineCoefs) - ALLOCATE(OutData%SplineCoefs(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%SplineCoefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SplineCoefs,3), UBOUND(OutData%SplineCoefs,3) - DO i2 = LBOUND(OutData%SplineCoefs,2), UBOUND(OutData%SplineCoefs,2) - DO i1 = LBOUND(OutData%SplineCoefs,1), UBOUND(OutData%SplineCoefs,1) - OutData%SplineCoefs(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%UserProp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumAlf = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ConstData = TRANSFER(IntKiBuf(Int_Xferred), OutData%ConstData) - Int_Xferred = Int_Xferred + 1 - OutData%InclUAdata = TRANSFER(IntKiBuf(Int_Xferred), OutData%InclUAdata) - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AFI_UnPackTable_Type - - SUBROUTINE AFI_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AFI_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_CopyInitInput' -! + ErrMsg = '' +end subroutine + +subroutine AFI_PackUA_BL_Type(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_UA_BL_Type), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackUA_BL_Type' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%alpha0) + call RegPack(Buf, InData%alpha1) + call RegPack(Buf, InData%alpha2) + call RegPack(Buf, InData%eta_e) + call RegPack(Buf, InData%C_nalpha) + call RegPack(Buf, InData%C_lalpha) + call RegPack(Buf, InData%T_f0) + call RegPack(Buf, InData%T_V0) + call RegPack(Buf, InData%T_p) + call RegPack(Buf, InData%T_VL) + call RegPack(Buf, InData%b1) + call RegPack(Buf, InData%b2) + call RegPack(Buf, InData%b5) + call RegPack(Buf, InData%A1) + call RegPack(Buf, InData%A2) + call RegPack(Buf, InData%A5) + call RegPack(Buf, InData%S1) + call RegPack(Buf, InData%S2) + call RegPack(Buf, InData%S3) + call RegPack(Buf, InData%S4) + call RegPack(Buf, InData%Cn1) + call RegPack(Buf, InData%Cn2) + call RegPack(Buf, InData%St_sh) + call RegPack(Buf, InData%Cd0) + call RegPack(Buf, InData%Cm0) + call RegPack(Buf, InData%k0) + call RegPack(Buf, InData%k1) + call RegPack(Buf, InData%k2) + call RegPack(Buf, InData%k3) + call RegPack(Buf, InData%k1_hat) + call RegPack(Buf, InData%x_cp_bar) + call RegPack(Buf, InData%UACutout) + call RegPack(Buf, InData%UACutout_delta) + call RegPack(Buf, InData%UACutout_blend) + call RegPack(Buf, InData%filtCutOff) + call RegPack(Buf, InData%alphaUpper) + call RegPack(Buf, InData%alphaLower) + call RegPack(Buf, InData%c_Rate) + call RegPack(Buf, InData%c_RateUpper) + call RegPack(Buf, InData%c_RateLower) + call RegPack(Buf, InData%c_alphaLower) + call RegPack(Buf, InData%c_alphaUpper) + call RegPack(Buf, InData%alphaUpperWrap) + call RegPack(Buf, InData%alphaLowerWrap) + call RegPack(Buf, InData%c_RateWrap) + call RegPack(Buf, InData%c_alphaLowerWrap) + call RegPack(Buf, InData%c_alphaUpperWrap) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackUA_BL_Type(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_UA_BL_Type), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackUA_BL_Type' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%alpha0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alpha1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alpha2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%eta_e) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_nalpha) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_lalpha) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T_f0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T_V0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T_p) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T_VL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%b1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%b2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%b5) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%A1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%A2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%A5) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%S1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%S2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%S3) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%S4) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cn1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cn2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%St_sh) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cd0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cm0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k3) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k1_hat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%x_cp_bar) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UACutout) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UACutout_delta) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UACutout_blend) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%filtCutOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alphaUpper) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alphaLower) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%c_Rate) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%c_RateUpper) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%c_RateLower) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%c_alphaLower) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%c_alphaUpper) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alphaUpperWrap) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alphaLowerWrap) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%c_RateWrap) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%c_alphaLowerWrap) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%c_alphaUpperWrap) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_CopyUA_BL_Default_Type(SrcUA_BL_Default_TypeData, DstUA_BL_Default_TypeData, CtrlCode, ErrStat, ErrMsg) + type(AFI_UA_BL_Default_Type), intent(in) :: SrcUA_BL_Default_TypeData + type(AFI_UA_BL_Default_Type), intent(inout) :: DstUA_BL_Default_TypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_CopyUA_BL_Default_Type' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%FileName = SrcInitInputData%FileName - DstInitInputData%AFTabMod = SrcInitInputData%AFTabMod - DstInitInputData%InCol_Alfa = SrcInitInputData%InCol_Alfa - DstInitInputData%InCol_Cl = SrcInitInputData%InCol_Cl - DstInitInputData%InCol_Cd = SrcInitInputData%InCol_Cd - DstInitInputData%InCol_Cm = SrcInitInputData%InCol_Cm - DstInitInputData%InCol_Cpmin = SrcInitInputData%InCol_Cpmin - DstInitInputData%UA_f_cn = SrcInitInputData%UA_f_cn - END SUBROUTINE AFI_CopyInitInput - - SUBROUTINE AFI_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(AFI_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 = 'AFI_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AFI_DestroyInitInput - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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%FileName) ! FileName - Int_BufSz = Int_BufSz + 1 ! AFTabMod - Int_BufSz = Int_BufSz + 1 ! InCol_Alfa - Int_BufSz = Int_BufSz + 1 ! InCol_Cl - Int_BufSz = Int_BufSz + 1 ! InCol_Cd - Int_BufSz = Int_BufSz + 1 ! InCol_Cm - Int_BufSz = Int_BufSz + 1 ! InCol_Cpmin - Int_BufSz = Int_BufSz + 1 ! UA_f_cn - 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%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InCol_Alfa - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InCol_Cl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InCol_Cd - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InCol_Cm - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InCol_Cpmin - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_f_cn, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AFI_PackInitInput - - SUBROUTINE AFI_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(AFI_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_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%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%AFTabMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Alfa = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cd = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cm = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cpmin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UA_f_cn = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_f_cn) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AFI_UnPackInitInput - - SUBROUTINE AFI_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AFI_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_CopyInitOutput' -! + ErrMsg = '' + DstUA_BL_Default_TypeData%alpha0 = SrcUA_BL_Default_TypeData%alpha0 + DstUA_BL_Default_TypeData%alpha1 = SrcUA_BL_Default_TypeData%alpha1 + DstUA_BL_Default_TypeData%alpha2 = SrcUA_BL_Default_TypeData%alpha2 + DstUA_BL_Default_TypeData%eta_e = SrcUA_BL_Default_TypeData%eta_e + DstUA_BL_Default_TypeData%C_nalpha = SrcUA_BL_Default_TypeData%C_nalpha + DstUA_BL_Default_TypeData%C_lalpha = SrcUA_BL_Default_TypeData%C_lalpha + DstUA_BL_Default_TypeData%T_f0 = SrcUA_BL_Default_TypeData%T_f0 + DstUA_BL_Default_TypeData%T_V0 = SrcUA_BL_Default_TypeData%T_V0 + DstUA_BL_Default_TypeData%T_p = SrcUA_BL_Default_TypeData%T_p + DstUA_BL_Default_TypeData%T_VL = SrcUA_BL_Default_TypeData%T_VL + DstUA_BL_Default_TypeData%b1 = SrcUA_BL_Default_TypeData%b1 + DstUA_BL_Default_TypeData%b2 = SrcUA_BL_Default_TypeData%b2 + DstUA_BL_Default_TypeData%b5 = SrcUA_BL_Default_TypeData%b5 + DstUA_BL_Default_TypeData%A1 = SrcUA_BL_Default_TypeData%A1 + DstUA_BL_Default_TypeData%A2 = SrcUA_BL_Default_TypeData%A2 + DstUA_BL_Default_TypeData%A5 = SrcUA_BL_Default_TypeData%A5 + DstUA_BL_Default_TypeData%S1 = SrcUA_BL_Default_TypeData%S1 + DstUA_BL_Default_TypeData%S2 = SrcUA_BL_Default_TypeData%S2 + DstUA_BL_Default_TypeData%S3 = SrcUA_BL_Default_TypeData%S3 + DstUA_BL_Default_TypeData%S4 = SrcUA_BL_Default_TypeData%S4 + DstUA_BL_Default_TypeData%Cn1 = SrcUA_BL_Default_TypeData%Cn1 + DstUA_BL_Default_TypeData%Cn2 = SrcUA_BL_Default_TypeData%Cn2 + DstUA_BL_Default_TypeData%St_sh = SrcUA_BL_Default_TypeData%St_sh + DstUA_BL_Default_TypeData%Cd0 = SrcUA_BL_Default_TypeData%Cd0 + DstUA_BL_Default_TypeData%Cm0 = SrcUA_BL_Default_TypeData%Cm0 + DstUA_BL_Default_TypeData%k0 = SrcUA_BL_Default_TypeData%k0 + DstUA_BL_Default_TypeData%k1 = SrcUA_BL_Default_TypeData%k1 + DstUA_BL_Default_TypeData%k2 = SrcUA_BL_Default_TypeData%k2 + DstUA_BL_Default_TypeData%k3 = SrcUA_BL_Default_TypeData%k3 + DstUA_BL_Default_TypeData%k1_hat = SrcUA_BL_Default_TypeData%k1_hat + DstUA_BL_Default_TypeData%x_cp_bar = SrcUA_BL_Default_TypeData%x_cp_bar + DstUA_BL_Default_TypeData%UACutout = SrcUA_BL_Default_TypeData%UACutout + DstUA_BL_Default_TypeData%UACutout_delta = SrcUA_BL_Default_TypeData%UACutout_delta + DstUA_BL_Default_TypeData%filtCutOff = SrcUA_BL_Default_TypeData%filtCutOff + DstUA_BL_Default_TypeData%alphaUpper = SrcUA_BL_Default_TypeData%alphaUpper + DstUA_BL_Default_TypeData%alphaLower = SrcUA_BL_Default_TypeData%alphaLower +end subroutine + +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 + character(*), parameter :: RoutineName = 'AFI_DestroyUA_BL_Default_Type' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AFI_CopyInitOutput - - SUBROUTINE AFI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(AFI_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 = 'AFI_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AFI_DestroyInitOutput - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - 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 - - 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 - - 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 AFI_PackInitOutput - - SUBROUTINE AFI_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(AFI_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_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 - 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) - END SUBROUTINE AFI_UnPackInitOutput - - SUBROUTINE AFI_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AFI_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_CopyParam' -! + ErrMsg = '' +end subroutine + +subroutine AFI_PackUA_BL_Default_Type(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_UA_BL_Default_Type), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackUA_BL_Default_Type' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%alpha0) + call RegPack(Buf, InData%alpha1) + call RegPack(Buf, InData%alpha2) + call RegPack(Buf, InData%eta_e) + call RegPack(Buf, InData%C_nalpha) + call RegPack(Buf, InData%C_lalpha) + call RegPack(Buf, InData%T_f0) + call RegPack(Buf, InData%T_V0) + call RegPack(Buf, InData%T_p) + call RegPack(Buf, InData%T_VL) + call RegPack(Buf, InData%b1) + call RegPack(Buf, InData%b2) + call RegPack(Buf, InData%b5) + call RegPack(Buf, InData%A1) + call RegPack(Buf, InData%A2) + call RegPack(Buf, InData%A5) + call RegPack(Buf, InData%S1) + call RegPack(Buf, InData%S2) + call RegPack(Buf, InData%S3) + call RegPack(Buf, InData%S4) + call RegPack(Buf, InData%Cn1) + call RegPack(Buf, InData%Cn2) + call RegPack(Buf, InData%St_sh) + call RegPack(Buf, InData%Cd0) + call RegPack(Buf, InData%Cm0) + call RegPack(Buf, InData%k0) + call RegPack(Buf, InData%k1) + call RegPack(Buf, InData%k2) + call RegPack(Buf, InData%k3) + call RegPack(Buf, InData%k1_hat) + call RegPack(Buf, InData%x_cp_bar) + call RegPack(Buf, InData%UACutout) + call RegPack(Buf, InData%UACutout_delta) + call RegPack(Buf, InData%filtCutOff) + call RegPack(Buf, InData%alphaUpper) + call RegPack(Buf, InData%alphaLower) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackUA_BL_Default_Type(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_UA_BL_Default_Type), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackUA_BL_Default_Type' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%alpha0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alpha1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alpha2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%eta_e) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_nalpha) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_lalpha) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T_f0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T_V0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T_p) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T_VL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%b1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%b2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%b5) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%A1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%A2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%A5) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%S1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%S2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%S3) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%S4) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cn1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cn2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%St_sh) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cd0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cm0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k3) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k1_hat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%x_cp_bar) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UACutout) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UACutout_delta) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%filtCutOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alphaUpper) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alphaLower) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, ErrStat, ErrMsg) + type(AFI_Table_Type), intent(in) :: SrcTable_TypeData + type(AFI_Table_Type), intent(inout) :: DstTable_TypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_CopyTable_Type' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%ColCd = SrcParamData%ColCd - DstParamData%ColCl = SrcParamData%ColCl - DstParamData%ColCm = SrcParamData%ColCm - DstParamData%ColCpmin = SrcParamData%ColCpmin - DstParamData%ColUAf = SrcParamData%ColUAf - DstParamData%AFTabMod = SrcParamData%AFTabMod -IF (ALLOCATED(SrcParamData%secondVals)) THEN - i1_l = LBOUND(SrcParamData%secondVals,1) - i1_u = UBOUND(SrcParamData%secondVals,1) - IF (.NOT. ALLOCATED(DstParamData%secondVals)) THEN - ALLOCATE(DstParamData%secondVals(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%secondVals.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%secondVals = SrcParamData%secondVals -ENDIF - DstParamData%InterpOrd = SrcParamData%InterpOrd - DstParamData%RelThickness = SrcParamData%RelThickness - DstParamData%NonDimArea = SrcParamData%NonDimArea - DstParamData%NumCoords = SrcParamData%NumCoords -IF (ALLOCATED(SrcParamData%X_Coord)) THEN - i1_l = LBOUND(SrcParamData%X_Coord,1) - i1_u = UBOUND(SrcParamData%X_Coord,1) - IF (.NOT. ALLOCATED(DstParamData%X_Coord)) THEN - ALLOCATE(DstParamData%X_Coord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%X_Coord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%X_Coord = SrcParamData%X_Coord -ENDIF -IF (ALLOCATED(SrcParamData%Y_Coord)) THEN - i1_l = LBOUND(SrcParamData%Y_Coord,1) - i1_u = UBOUND(SrcParamData%Y_Coord,1) - IF (.NOT. ALLOCATED(DstParamData%Y_Coord)) THEN - ALLOCATE(DstParamData%Y_Coord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y_Coord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Y_Coord = SrcParamData%Y_Coord -ENDIF - DstParamData%NumTabs = SrcParamData%NumTabs -IF (ALLOCATED(SrcParamData%Table)) THEN - i1_l = LBOUND(SrcParamData%Table,1) - i1_u = UBOUND(SrcParamData%Table,1) - IF (.NOT. ALLOCATED(DstParamData%Table)) THEN - ALLOCATE(DstParamData%Table(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Table.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%Table,1), UBOUND(SrcParamData%Table,1) - CALL AFI_Copytable_type( SrcParamData%Table(i1), DstParamData%Table(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%BL_file = SrcParamData%BL_file - DstParamData%FileName = SrcParamData%FileName - END SUBROUTINE AFI_CopyParam - - SUBROUTINE AFI_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(AFI_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 = 'AFI_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%secondVals)) THEN - DEALLOCATE(ParamData%secondVals) -ENDIF -IF (ALLOCATED(ParamData%X_Coord)) THEN - DEALLOCATE(ParamData%X_Coord) -ENDIF -IF (ALLOCATED(ParamData%Y_Coord)) THEN - DEALLOCATE(ParamData%Y_Coord) -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%Table) -ENDIF - END SUBROUTINE AFI_DestroyParam - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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 - Int_BufSz = Int_BufSz + 1 ! ColCd - Int_BufSz = Int_BufSz + 1 ! ColCl - Int_BufSz = Int_BufSz + 1 ! ColCm - Int_BufSz = Int_BufSz + 1 ! ColCpmin - Int_BufSz = Int_BufSz + 1 ! ColUAf - Int_BufSz = Int_BufSz + 1 ! AFTabMod - Int_BufSz = Int_BufSz + 1 ! secondVals allocated yes/no - IF ( ALLOCATED(InData%secondVals) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! secondVals upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%secondVals) ! secondVals - END IF - Int_BufSz = Int_BufSz + 1 ! InterpOrd - Re_BufSz = Re_BufSz + 1 ! RelThickness - Re_BufSz = Re_BufSz + 1 ! NonDimArea - Int_BufSz = Int_BufSz + 1 ! NumCoords - Int_BufSz = Int_BufSz + 1 ! X_Coord allocated yes/no - IF ( ALLOCATED(InData%X_Coord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! X_Coord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X_Coord) ! X_Coord - END IF - Int_BufSz = Int_BufSz + 1 ! Y_Coord allocated yes/no - IF ( ALLOCATED(InData%Y_Coord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y_Coord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y_Coord) ! Y_Coord - END IF - Int_BufSz = Int_BufSz + 1 ! NumTabs - Int_BufSz = Int_BufSz + 1 ! Table allocated yes/no - IF ( ALLOCATED(InData%Table) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Table upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Table - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Table - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Table - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%BL_file) ! BL_file - Int_BufSz = Int_BufSz + 1*LEN(InData%FileName) ! FileName - 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%ColCd - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ColCl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ColCm - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ColCpmin - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ColUAf - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%secondVals) ) 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%secondVals,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%secondVals,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%secondVals,1), UBOUND(InData%secondVals,1) - ReKiBuf(Re_Xferred) = InData%secondVals(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%InterpOrd - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RelThickness - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NonDimArea - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCoords - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%X_Coord) ) 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%X_Coord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X_Coord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%X_Coord,1), UBOUND(InData%X_Coord,1) - ReKiBuf(Re_Xferred) = InData%X_Coord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y_Coord) ) 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%Y_Coord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_Coord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y_Coord,1), UBOUND(InData%Y_Coord,1) - ReKiBuf(Re_Xferred) = InData%Y_Coord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumTabs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Table) ) 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%Table,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Table,1) - 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 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 - DO I = 1, LEN(InData%BL_file) - IntKiBuf(Int_Xferred) = ICHAR(InData%BL_file(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AFI_PackParam - - SUBROUTINE AFI_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(AFI_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_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%ColCd = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ColCl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ColCm = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ColCpmin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ColUAf = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AFTabMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! secondVals 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%secondVals)) DEALLOCATE(OutData%secondVals) - ALLOCATE(OutData%secondVals(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%secondVals.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%secondVals,1), UBOUND(OutData%secondVals,1) - OutData%secondVals(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%InterpOrd = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RelThickness = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NonDimArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumCoords = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X_Coord 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%X_Coord)) DEALLOCATE(OutData%X_Coord) - ALLOCATE(OutData%X_Coord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Coord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%X_Coord,1), UBOUND(OutData%X_Coord,1) - OutData%X_Coord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_Coord 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%Y_Coord)) DEALLOCATE(OutData%Y_Coord) - ALLOCATE(OutData%Y_Coord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Coord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y_Coord,1), UBOUND(OutData%Y_Coord,1) - OutData%Y_Coord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NumTabs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Table 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%Table)) DEALLOCATE(OutData%Table) - ALLOCATE(OutData%Table(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Table.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Table,1), UBOUND(OutData%Table,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 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 - - 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 - DO I = 1, LEN(OutData%BL_file) - OutData%BL_file(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AFI_UnPackParam - - SUBROUTINE AFI_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_InputType), INTENT(IN) :: SrcInputData - TYPE(AFI_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 = 'AFI_CopyInput' -! + ErrMsg = '' + if (allocated(SrcTable_TypeData%Alpha)) then + LB(1:1) = lbound(SrcTable_TypeData%Alpha) + UB(1:1) = ubound(SrcTable_TypeData%Alpha) + if (.not. allocated(DstTable_TypeData%Alpha)) then + allocate(DstTable_TypeData%Alpha(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%Alpha.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTable_TypeData%Alpha = SrcTable_TypeData%Alpha + end if + if (allocated(SrcTable_TypeData%Coefs)) then + LB(1:2) = lbound(SrcTable_TypeData%Coefs) + UB(1:2) = ubound(SrcTable_TypeData%Coefs) + if (.not. allocated(DstTable_TypeData%Coefs)) then + allocate(DstTable_TypeData%Coefs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%Coefs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTable_TypeData%Coefs = SrcTable_TypeData%Coefs + end if + if (allocated(SrcTable_TypeData%SplineCoefs)) then + LB(1:3) = lbound(SrcTable_TypeData%SplineCoefs) + UB(1:3) = ubound(SrcTable_TypeData%SplineCoefs) + if (.not. allocated(DstTable_TypeData%SplineCoefs)) then + allocate(DstTable_TypeData%SplineCoefs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%SplineCoefs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTable_TypeData%SplineCoefs = SrcTable_TypeData%SplineCoefs + end if + DstTable_TypeData%UserProp = SrcTable_TypeData%UserProp + DstTable_TypeData%Re = SrcTable_TypeData%Re + DstTable_TypeData%NumAlf = SrcTable_TypeData%NumAlf + DstTable_TypeData%ConstData = SrcTable_TypeData%ConstData + DstTable_TypeData%InclUAdata = SrcTable_TypeData%InclUAdata + call AFI_CopyUA_BL_Type(SrcTable_TypeData%UA_BL, DstTable_TypeData%UA_BL, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +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 + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_DestroyTable_Type' ErrStat = ErrID_None - ErrMsg = "" - DstInputData%AoA = SrcInputData%AoA - DstInputData%UserProp = SrcInputData%UserProp - DstInputData%Re = SrcInputData%Re - END SUBROUTINE AFI_CopyInput - - SUBROUTINE AFI_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(AFI_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 = 'AFI_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AFI_DestroyInput - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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 ! AoA - Re_BufSz = Re_BufSz + 1 ! UserProp - Re_BufSz = Re_BufSz + 1 ! Re - 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%AoA - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UserProp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Re - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_PackInput - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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%AoA = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UserProp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_UnPackInput - - SUBROUTINE AFI_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_OutputType), INTENT(IN) :: SrcOutputData - TYPE(AFI_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 = 'AFI_CopyOutput' -! + ErrMsg = '' + if (allocated(Table_TypeData%Alpha)) then + deallocate(Table_TypeData%Alpha) + end if + if (allocated(Table_TypeData%Coefs)) then + deallocate(Table_TypeData%Coefs) + end if + if (allocated(Table_TypeData%SplineCoefs)) then + deallocate(Table_TypeData%SplineCoefs) + end if + call AFI_DestroyUA_BL_Type(Table_TypeData%UA_BL, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AFI_PackTable_Type(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_Table_Type), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackTable_Type' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Alpha)) + if (allocated(InData%Alpha)) then + call RegPackBounds(Buf, 1, lbound(InData%Alpha), ubound(InData%Alpha)) + call RegPack(Buf, InData%Alpha) + end if + call RegPack(Buf, allocated(InData%Coefs)) + if (allocated(InData%Coefs)) then + call RegPackBounds(Buf, 2, lbound(InData%Coefs), ubound(InData%Coefs)) + call RegPack(Buf, InData%Coefs) + end if + call RegPack(Buf, allocated(InData%SplineCoefs)) + if (allocated(InData%SplineCoefs)) then + call RegPackBounds(Buf, 3, lbound(InData%SplineCoefs), ubound(InData%SplineCoefs)) + call RegPack(Buf, InData%SplineCoefs) + end if + call RegPack(Buf, InData%UserProp) + call RegPack(Buf, InData%Re) + call RegPack(Buf, InData%NumAlf) + call RegPack(Buf, InData%ConstData) + call RegPack(Buf, InData%InclUAdata) + call AFI_PackUA_BL_Type(Buf, InData%UA_BL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackTable_Type(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_Table_Type), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackTable_Type' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Alpha)) deallocate(OutData%Alpha) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Alpha(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Alpha) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Coefs)) deallocate(OutData%Coefs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Coefs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Coefs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Coefs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SplineCoefs)) deallocate(OutData%SplineCoefs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SplineCoefs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SplineCoefs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SplineCoefs) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%UserProp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Re) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumAlf) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ConstData) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InclUAdata) + if (RegCheckErr(Buf, RoutineName)) return + call AFI_UnpackUA_BL_Type(Buf, OutData%UA_BL) ! UA_BL +end subroutine + +subroutine AFI_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(AFI_InitInputType), intent(in) :: SrcInitInputData + type(AFI_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstOutputData%Cl = SrcOutputData%Cl - DstOutputData%Cd = SrcOutputData%Cd - DstOutputData%Cm = SrcOutputData%Cm - DstOutputData%Cpmin = SrcOutputData%Cpmin - DstOutputData%Cd0 = SrcOutputData%Cd0 - DstOutputData%Cm0 = SrcOutputData%Cm0 - DstOutputData%f_st = SrcOutputData%f_st - DstOutputData%FullySeparate = SrcOutputData%FullySeparate - DstOutputData%FullyAttached = SrcOutputData%FullyAttached - END SUBROUTINE AFI_CopyOutput - - SUBROUTINE AFI_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(AFI_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 = 'AFI_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AFI_DestroyOutput - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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 ! Cl - Re_BufSz = Re_BufSz + 1 ! Cd - Re_BufSz = Re_BufSz + 1 ! Cm - Re_BufSz = Re_BufSz + 1 ! Cpmin - Re_BufSz = Re_BufSz + 1 ! Cd0 - Re_BufSz = Re_BufSz + 1 ! Cm0 - Re_BufSz = Re_BufSz + 1 ! f_st - Re_BufSz = Re_BufSz + 1 ! FullySeparate - Re_BufSz = Re_BufSz + 1 ! FullyAttached - 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%Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cpmin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cd0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%f_st - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FullySeparate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FullyAttached - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_PackOutput - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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%Cl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cpmin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cd0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%f_st = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FullySeparate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FullyAttached = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_UnPackOutput - - - SUBROUTINE AFI_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(AFI_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(ReKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(AFI_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(ReKi), 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 + ErrMsg = '' + DstInitInputData%FileName = SrcInitInputData%FileName + DstInitInputData%AFTabMod = SrcInitInputData%AFTabMod + DstInitInputData%InCol_Alfa = SrcInitInputData%InCol_Alfa + DstInitInputData%InCol_Cl = SrcInitInputData%InCol_Cl + DstInitInputData%InCol_Cd = SrcInitInputData%InCol_Cd + DstInitInputData%InCol_Cm = SrcInitInputData%InCol_Cm + DstInitInputData%InCol_Cpmin = SrcInitInputData%InCol_Cpmin + DstInitInputData%UA_f_cn = SrcInitInputData%UA_f_cn +end subroutine + +subroutine AFI_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(AFI_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AFI_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%FileName) + call RegPack(Buf, InData%AFTabMod) + call RegPack(Buf, InData%InCol_Alfa) + call RegPack(Buf, InData%InCol_Cl) + call RegPack(Buf, InData%InCol_Cd) + call RegPack(Buf, InData%InCol_Cm) + call RegPack(Buf, InData%InCol_Cpmin) + call RegPack(Buf, InData%UA_f_cn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%FileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AFTabMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InCol_Alfa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InCol_Cl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InCol_Cd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InCol_Cm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InCol_Cpmin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UA_f_cn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(AFI_InitOutputType), intent(in) :: SrcInitOutputData + type(AFI_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AFI_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(AFI_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AFI_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine + +subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AFI_ParameterType), intent(in) :: SrcParamData + type(AFI_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%ColCd = SrcParamData%ColCd + DstParamData%ColCl = SrcParamData%ColCl + DstParamData%ColCm = SrcParamData%ColCm + DstParamData%ColCpmin = SrcParamData%ColCpmin + DstParamData%ColUAf = SrcParamData%ColUAf + DstParamData%AFTabMod = SrcParamData%AFTabMod + if (allocated(SrcParamData%secondVals)) then + LB(1:1) = lbound(SrcParamData%secondVals) + UB(1:1) = ubound(SrcParamData%secondVals) + if (.not. allocated(DstParamData%secondVals)) then + allocate(DstParamData%secondVals(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%secondVals.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%secondVals = SrcParamData%secondVals + end if + DstParamData%InterpOrd = SrcParamData%InterpOrd + DstParamData%RelThickness = SrcParamData%RelThickness + DstParamData%NonDimArea = SrcParamData%NonDimArea + DstParamData%NumCoords = SrcParamData%NumCoords + if (allocated(SrcParamData%X_Coord)) then + LB(1:1) = lbound(SrcParamData%X_Coord) + UB(1:1) = ubound(SrcParamData%X_Coord) + if (.not. allocated(DstParamData%X_Coord)) then + allocate(DstParamData%X_Coord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%X_Coord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%X_Coord = SrcParamData%X_Coord + end if + if (allocated(SrcParamData%Y_Coord)) then + LB(1:1) = lbound(SrcParamData%Y_Coord) + UB(1:1) = ubound(SrcParamData%Y_Coord) + if (.not. allocated(DstParamData%Y_Coord)) then + allocate(DstParamData%Y_Coord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y_Coord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Y_Coord = SrcParamData%Y_Coord + end if + DstParamData%NumTabs = SrcParamData%NumTabs + if (allocated(SrcParamData%Table)) then + LB(1:1) = lbound(SrcParamData%Table) + UB(1:1) = ubound(SrcParamData%Table) + if (.not. allocated(DstParamData%Table)) then + allocate(DstParamData%Table(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Table.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AFI_CopyTable_Type(SrcParamData%Table(i1), DstParamData%Table(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%BL_file = SrcParamData%BL_file + DstParamData%FileName = SrcParamData%FileName +end subroutine + +subroutine AFI_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AFI_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%secondVals)) then + deallocate(ParamData%secondVals) + end if + if (allocated(ParamData%X_Coord)) then + deallocate(ParamData%X_Coord) + end if + if (allocated(ParamData%Y_Coord)) then + deallocate(ParamData%Y_Coord) + end if + if (allocated(ParamData%Table)) then + LB(1:1) = lbound(ParamData%Table) + UB(1:1) = ubound(ParamData%Table) + do i1 = LB(1), UB(1) + call AFI_DestroyTable_Type(ParamData%Table(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%Table) + end if +end subroutine + +subroutine AFI_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackParam' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%ColCd) + call RegPack(Buf, InData%ColCl) + call RegPack(Buf, InData%ColCm) + call RegPack(Buf, InData%ColCpmin) + call RegPack(Buf, InData%ColUAf) + call RegPack(Buf, InData%AFTabMod) + call RegPack(Buf, allocated(InData%secondVals)) + if (allocated(InData%secondVals)) then + call RegPackBounds(Buf, 1, lbound(InData%secondVals), ubound(InData%secondVals)) + call RegPack(Buf, InData%secondVals) + end if + call RegPack(Buf, InData%InterpOrd) + call RegPack(Buf, InData%RelThickness) + call RegPack(Buf, InData%NonDimArea) + call RegPack(Buf, InData%NumCoords) + call RegPack(Buf, allocated(InData%X_Coord)) + if (allocated(InData%X_Coord)) then + call RegPackBounds(Buf, 1, lbound(InData%X_Coord), ubound(InData%X_Coord)) + call RegPack(Buf, InData%X_Coord) + end if + call RegPack(Buf, allocated(InData%Y_Coord)) + if (allocated(InData%Y_Coord)) then + call RegPackBounds(Buf, 1, lbound(InData%Y_Coord), ubound(InData%Y_Coord)) + call RegPack(Buf, InData%Y_Coord) + end if + call RegPack(Buf, InData%NumTabs) + call RegPack(Buf, allocated(InData%Table)) + if (allocated(InData%Table)) then + call RegPackBounds(Buf, 1, lbound(InData%Table), ubound(InData%Table)) + LB(1:1) = lbound(InData%Table) + UB(1:1) = ubound(InData%Table) + do i1 = LB(1), UB(1) + call AFI_PackTable_Type(Buf, InData%Table(i1)) + end do + end if + call RegPack(Buf, InData%BL_file) + call RegPack(Buf, InData%FileName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackParam' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%ColCd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ColCl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ColCm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ColCpmin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ColUAf) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AFTabMod) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%secondVals)) deallocate(OutData%secondVals) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%secondVals(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%secondVals.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%secondVals) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%InterpOrd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RelThickness) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NonDimArea) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumCoords) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%X_Coord)) deallocate(OutData%X_Coord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X_Coord(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Coord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X_Coord) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Y_Coord)) deallocate(OutData%Y_Coord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y_Coord(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Coord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y_Coord) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NumTabs) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Table)) deallocate(OutData%Table) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Table(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Table.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AFI_UnpackTable_Type(Buf, OutData%Table(i1)) ! Table + end do + end if + call RegUnpack(Buf, OutData%BL_file) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FileName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AFI_InputType), intent(in) :: SrcInputData + type(AFI_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%AoA = SrcInputData%AoA + DstInputData%UserProp = SrcInputData%UserProp + DstInputData%Re = SrcInputData%Re +end subroutine + +subroutine AFI_DestroyInput(InputData, ErrStat, ErrMsg) + type(AFI_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AFI_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%AoA) + call RegPack(Buf, InData%UserProp) + call RegPack(Buf, InData%Re) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%AoA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UserProp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Re) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AFI_OutputType), intent(in) :: SrcOutputData + type(AFI_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstOutputData%Cl = SrcOutputData%Cl + DstOutputData%Cd = SrcOutputData%Cd + DstOutputData%Cm = SrcOutputData%Cm + DstOutputData%Cpmin = SrcOutputData%Cpmin + DstOutputData%Cd0 = SrcOutputData%Cd0 + DstOutputData%Cm0 = SrcOutputData%Cm0 + DstOutputData%f_st = SrcOutputData%f_st + DstOutputData%FullySeparate = SrcOutputData%FullySeparate + DstOutputData%FullyAttached = SrcOutputData%FullyAttached +end subroutine + +subroutine AFI_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AFI_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AFI_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Cl) + call RegPack(Buf, InData%Cd) + call RegPack(Buf, InData%Cm) + call RegPack(Buf, InData%Cpmin) + call RegPack(Buf, InData%Cd0) + call RegPack(Buf, InData%Cm0) + call RegPack(Buf, InData%f_st) + call RegPack(Buf, InData%FullySeparate) + call RegPack(Buf, InData%FullyAttached) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackOutput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Cl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cpmin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cd0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cm0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%f_st) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FullySeparate) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FullyAttached) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_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(AFI_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(ReKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(AFI_OutputType), intent(inout) :: y_out ! Output at tin_out + real(ReKi), 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 = 'AFI_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 AFI_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AFI_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 AFI_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 AFI_Output_ExtrapInterp - - - SUBROUTINE AFI_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call AFI_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AFI_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AFI_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE AFI_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. @@ -2673,57 +1321,49 @@ SUBROUTINE AFI_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(AFI_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(AFI_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(ReKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(AFI_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(ReKi), 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 + TYPE(AFI_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(AFI_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(ReKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(AFI_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(ReKi), 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(ReKi) :: t(2) ! Times associated with the Outputs - REAL(ReKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_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 + REAL(ReKi) :: t(2) ! Times associated with the Outputs + REAL(ReKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%Cl - y2%Cl) - y_out%Cl = y1%Cl + b * ScaleFactor - b = -(y1%Cd - y2%Cd) - y_out%Cd = y1%Cd + b * ScaleFactor - b = -(y1%Cm - y2%Cm) - y_out%Cm = y1%Cm + b * ScaleFactor - b = -(y1%Cpmin - y2%Cpmin) - y_out%Cpmin = y1%Cpmin + b * ScaleFactor - b = -(y1%Cd0 - y2%Cd0) - y_out%Cd0 = y1%Cd0 + b * ScaleFactor - b = -(y1%Cm0 - y2%Cm0) - y_out%Cm0 = y1%Cm0 + b * ScaleFactor - b = -(y1%f_st - y2%f_st) - y_out%f_st = y1%f_st + b * ScaleFactor - b = -(y1%FullySeparate - y2%FullySeparate) - y_out%FullySeparate = y1%FullySeparate + b * ScaleFactor - b = -(y1%FullyAttached - y2%FullyAttached) - y_out%FullyAttached = y1%FullyAttached + b * ScaleFactor - END SUBROUTINE AFI_Output_ExtrapInterp1 - - - SUBROUTINE AFI_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + y_out%Cl = a1*y1%Cl + a2*y2%Cl + y_out%Cd = a1*y1%Cd + a2*y2%Cd + y_out%Cm = a1*y1%Cm + a2*y2%Cm + y_out%Cpmin = a1*y1%Cpmin + a2*y2%Cpmin + y_out%Cd0 = a1*y1%Cd0 + a2*y2%Cd0 + y_out%Cm0 = a1*y1%Cm0 + a2*y2%Cm0 + y_out%f_st = a1*y1%f_st + a2*y2%f_st + y_out%FullySeparate = a1*y1%FullySeparate + a2*y2%FullySeparate + y_out%FullyAttached = a1*y1%FullyAttached + a2*y2%FullyAttached +END SUBROUTINE + +SUBROUTINE AFI_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. @@ -2737,126 +1377,109 @@ SUBROUTINE AFI_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(AFI_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(AFI_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(AFI_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(ReKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(AFI_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(ReKi), 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 + TYPE(AFI_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(AFI_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(AFI_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(ReKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(AFI_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(ReKi), 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(ReKi) :: t(3) ! Times associated with the Outputs - REAL(ReKi) :: 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 = 'AFI_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) - + REAL(ReKi) :: t(3) ! Times associated with the Outputs + REAL(ReKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AFI_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 + 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 + 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 + 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%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))* scaleFactor - c = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) * scaleFactor - y_out%Cl = y1%Cl + b + c * t_out - b = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))* scaleFactor - c = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) * scaleFactor - y_out%Cd = y1%Cd + b + c * t_out - b = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))* scaleFactor - c = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) * scaleFactor - y_out%Cm = y1%Cm + b + c * t_out - b = (t(3)**2*(y1%Cpmin - y2%Cpmin) + t(2)**2*(-y1%Cpmin + y3%Cpmin))* scaleFactor - c = ( (t(2)-t(3))*y1%Cpmin + t(3)*y2%Cpmin - t(2)*y3%Cpmin ) * scaleFactor - y_out%Cpmin = y1%Cpmin + b + c * t_out - b = (t(3)**2*(y1%Cd0 - y2%Cd0) + t(2)**2*(-y1%Cd0 + y3%Cd0))* scaleFactor - c = ( (t(2)-t(3))*y1%Cd0 + t(3)*y2%Cd0 - t(2)*y3%Cd0 ) * scaleFactor - y_out%Cd0 = y1%Cd0 + b + c * t_out - b = (t(3)**2*(y1%Cm0 - y2%Cm0) + t(2)**2*(-y1%Cm0 + y3%Cm0))* scaleFactor - c = ( (t(2)-t(3))*y1%Cm0 + t(3)*y2%Cm0 - t(2)*y3%Cm0 ) * scaleFactor - y_out%Cm0 = y1%Cm0 + b + c * t_out - b = (t(3)**2*(y1%f_st - y2%f_st) + t(2)**2*(-y1%f_st + y3%f_st))* scaleFactor - c = ( (t(2)-t(3))*y1%f_st + t(3)*y2%f_st - t(2)*y3%f_st ) * scaleFactor - y_out%f_st = y1%f_st + b + c * t_out - b = (t(3)**2*(y1%FullySeparate - y2%FullySeparate) + t(2)**2*(-y1%FullySeparate + y3%FullySeparate))* scaleFactor - c = ( (t(2)-t(3))*y1%FullySeparate + t(3)*y2%FullySeparate - t(2)*y3%FullySeparate ) * scaleFactor - y_out%FullySeparate = y1%FullySeparate + b + c * t_out - b = (t(3)**2*(y1%FullyAttached - y2%FullyAttached) + t(2)**2*(-y1%FullyAttached + y3%FullyAttached))* scaleFactor - c = ( (t(2)-t(3))*y1%FullyAttached + t(3)*y2%FullyAttached - t(2)*y3%FullyAttached ) * scaleFactor - y_out%FullyAttached = y1%FullyAttached + b + c * t_out - END SUBROUTINE AFI_Output_ExtrapInterp2 - - - SUBROUTINE AFI_UA_BL_Type_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) UA_BL_Type 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(AFI_UA_BL_Type), INTENT(IN) :: u(:) ! UA_BL_Type at t1 > t2 > t3 - REAL(ReKi), INTENT(IN ) :: t(:) ! Times associated with the UA_BL_Types - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: u_out ! UA_BL_Type at tin_out - REAL(ReKi), 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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + y_out%Cl = a1*y1%Cl + a2*y2%Cl + a3*y3%Cl + y_out%Cd = a1*y1%Cd + a2*y2%Cd + a3*y3%Cd + y_out%Cm = a1*y1%Cm + a2*y2%Cm + a3*y3%Cm + y_out%Cpmin = a1*y1%Cpmin + a2*y2%Cpmin + a3*y3%Cpmin + y_out%Cd0 = a1*y1%Cd0 + a2*y2%Cd0 + a3*y3%Cd0 + y_out%Cm0 = a1*y1%Cm0 + a2*y2%Cm0 + a3*y3%Cm0 + y_out%f_st = a1*y1%f_st + a2*y2%f_st + a3*y3%f_st + y_out%FullySeparate = a1*y1%FullySeparate + a2*y2%FullySeparate + a3*y3%FullySeparate + y_out%FullyAttached = a1*y1%FullyAttached + a2*y2%FullyAttached + a3*y3%FullyAttached +END SUBROUTINE + +subroutine AFI_UA_BL_Type_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) UA_BL_Type 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(AFI_UA_BL_Type), intent(in) :: u(:) ! UA_BL_Type at t1 > t2 > t3 + real(ReKi), intent(in ) :: t(:) ! Times associated with the UA_BL_Types + type(AFI_UA_BL_Type), intent(inout) :: u_out ! UA_BL_Type at tin_out + real(ReKi), 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 = 'AFI_UA_BL_Type_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 AFI_CopyUA_BL_Type(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AFI_UA_BL_Type_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 AFI_UA_BL_Type_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 AFI_UA_BL_Type_ExtrapInterp - - - SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call AFI_CopyUA_BL_Type(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AFI_UA_BL_Type_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AFI_UA_BL_Type_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) UA_BL_Type 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. @@ -2868,126 +1491,87 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u1 ! UA_BL_Type at t1 > t2 - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u2 ! UA_BL_Type at t2 - REAL(ReKi), INTENT(IN ) :: tin(2) ! Times associated with the UA_BL_Types - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: u_out ! UA_BL_Type at tin_out - REAL(ReKi), 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 + TYPE(AFI_UA_BL_Type), INTENT(IN) :: u1 ! UA_BL_Type at t1 > t2 + TYPE(AFI_UA_BL_Type), INTENT(IN) :: u2 ! UA_BL_Type at t2 + REAL(ReKi), INTENT(IN ) :: tin(2) ! Times associated with the UA_BL_Types + TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: u_out ! UA_BL_Type at tin_out + REAL(ReKi), 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(ReKi) :: t(2) ! Times associated with the UA_BL_Types - REAL(ReKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_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 + REAL(ReKi) :: t(2) ! Times associated with the UA_BL_Types + REAL(ReKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL Angles_ExtrapInterp( u1%alpha0, u2%alpha0, tin, u_out%alpha0, tin_out ) - CALL Angles_ExtrapInterp( u1%alpha1, u2%alpha1, tin, u_out%alpha1, tin_out ) - CALL Angles_ExtrapInterp( u1%alpha2, u2%alpha2, tin, u_out%alpha2, tin_out ) - b = -(u1%eta_e - u2%eta_e) - u_out%eta_e = u1%eta_e + b * ScaleFactor - b = -(u1%C_nalpha - u2%C_nalpha) - u_out%C_nalpha = u1%C_nalpha + b * ScaleFactor - b = -(u1%C_lalpha - u2%C_lalpha) - u_out%C_lalpha = u1%C_lalpha + b * ScaleFactor - b = -(u1%T_f0 - u2%T_f0) - u_out%T_f0 = u1%T_f0 + b * ScaleFactor - b = -(u1%T_V0 - u2%T_V0) - u_out%T_V0 = u1%T_V0 + b * ScaleFactor - b = -(u1%T_p - u2%T_p) - u_out%T_p = u1%T_p + b * ScaleFactor - b = -(u1%T_VL - u2%T_VL) - u_out%T_VL = u1%T_VL + b * ScaleFactor - b = -(u1%b1 - u2%b1) - u_out%b1 = u1%b1 + b * ScaleFactor - b = -(u1%b2 - u2%b2) - u_out%b2 = u1%b2 + b * ScaleFactor - b = -(u1%b5 - u2%b5) - u_out%b5 = u1%b5 + b * ScaleFactor - b = -(u1%A1 - u2%A1) - u_out%A1 = u1%A1 + b * ScaleFactor - b = -(u1%A2 - u2%A2) - u_out%A2 = u1%A2 + b * ScaleFactor - b = -(u1%A5 - u2%A5) - u_out%A5 = u1%A5 + b * ScaleFactor - b = -(u1%S1 - u2%S1) - u_out%S1 = u1%S1 + b * ScaleFactor - b = -(u1%S2 - u2%S2) - u_out%S2 = u1%S2 + b * ScaleFactor - b = -(u1%S3 - u2%S3) - u_out%S3 = u1%S3 + b * ScaleFactor - b = -(u1%S4 - u2%S4) - u_out%S4 = u1%S4 + b * ScaleFactor - b = -(u1%Cn1 - u2%Cn1) - u_out%Cn1 = u1%Cn1 + b * ScaleFactor - b = -(u1%Cn2 - u2%Cn2) - u_out%Cn2 = u1%Cn2 + b * ScaleFactor - b = -(u1%St_sh - u2%St_sh) - u_out%St_sh = u1%St_sh + b * ScaleFactor - b = -(u1%Cd0 - u2%Cd0) - u_out%Cd0 = u1%Cd0 + b * ScaleFactor - b = -(u1%Cm0 - u2%Cm0) - u_out%Cm0 = u1%Cm0 + b * ScaleFactor - b = -(u1%k0 - u2%k0) - u_out%k0 = u1%k0 + b * ScaleFactor - b = -(u1%k1 - u2%k1) - u_out%k1 = u1%k1 + b * ScaleFactor - b = -(u1%k2 - u2%k2) - u_out%k2 = u1%k2 + b * ScaleFactor - b = -(u1%k3 - u2%k3) - u_out%k3 = u1%k3 + b * ScaleFactor - b = -(u1%k1_hat - u2%k1_hat) - u_out%k1_hat = u1%k1_hat + b * ScaleFactor - b = -(u1%x_cp_bar - u2%x_cp_bar) - u_out%x_cp_bar = u1%x_cp_bar + b * ScaleFactor - b = -(u1%UACutout - u2%UACutout) - u_out%UACutout = u1%UACutout + b * ScaleFactor - b = -(u1%UACutout_delta - u2%UACutout_delta) - u_out%UACutout_delta = u1%UACutout_delta + b * ScaleFactor - b = -(u1%UACutout_blend - u2%UACutout_blend) - u_out%UACutout_blend = u1%UACutout_blend + b * ScaleFactor - b = -(u1%filtCutOff - u2%filtCutOff) - u_out%filtCutOff = u1%filtCutOff + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%alphaUpper, u2%alphaUpper, tin, u_out%alphaUpper, tin_out ) - CALL Angles_ExtrapInterp( u1%alphaLower, u2%alphaLower, tin, u_out%alphaLower, tin_out ) - b = -(u1%c_Rate - u2%c_Rate) - u_out%c_Rate = u1%c_Rate + b * ScaleFactor - b = -(u1%c_RateUpper - u2%c_RateUpper) - u_out%c_RateUpper = u1%c_RateUpper + b * ScaleFactor - b = -(u1%c_RateLower - u2%c_RateLower) - u_out%c_RateLower = u1%c_RateLower + b * ScaleFactor - b = -(u1%c_alphaLower - u2%c_alphaLower) - u_out%c_alphaLower = u1%c_alphaLower + b * ScaleFactor - b = -(u1%c_alphaUpper - u2%c_alphaUpper) - u_out%c_alphaUpper = u1%c_alphaUpper + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%alphaUpperWrap, u2%alphaUpperWrap, tin, u_out%alphaUpperWrap, tin_out ) - CALL Angles_ExtrapInterp( u1%alphaLowerWrap, u2%alphaLowerWrap, tin, u_out%alphaLowerWrap, tin_out ) - b = -(u1%c_RateWrap - u2%c_RateWrap) - u_out%c_RateWrap = u1%c_RateWrap + b * ScaleFactor - b = -(u1%c_alphaLowerWrap - u2%c_alphaLowerWrap) - u_out%c_alphaLowerWrap = u1%c_alphaLowerWrap + b * ScaleFactor - b = -(u1%c_alphaUpperWrap - u2%c_alphaUpperWrap) - u_out%c_alphaUpperWrap = u1%c_alphaUpperWrap + b * ScaleFactor - END SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1 - - - SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL Angles_ExtrapInterp( u1%alpha0, u2%alpha0, tin, u_out%alpha0, tin_out ) + CALL Angles_ExtrapInterp( u1%alpha1, u2%alpha1, tin, u_out%alpha1, tin_out ) + CALL Angles_ExtrapInterp( u1%alpha2, u2%alpha2, tin, u_out%alpha2, tin_out ) + u_out%eta_e = a1*u1%eta_e + a2*u2%eta_e + u_out%C_nalpha = a1*u1%C_nalpha + a2*u2%C_nalpha + u_out%C_lalpha = a1*u1%C_lalpha + a2*u2%C_lalpha + u_out%T_f0 = a1*u1%T_f0 + a2*u2%T_f0 + u_out%T_V0 = a1*u1%T_V0 + a2*u2%T_V0 + u_out%T_p = a1*u1%T_p + a2*u2%T_p + u_out%T_VL = a1*u1%T_VL + a2*u2%T_VL + u_out%b1 = a1*u1%b1 + a2*u2%b1 + u_out%b2 = a1*u1%b2 + a2*u2%b2 + u_out%b5 = a1*u1%b5 + a2*u2%b5 + u_out%A1 = a1*u1%A1 + a2*u2%A1 + u_out%A2 = a1*u1%A2 + a2*u2%A2 + u_out%A5 = a1*u1%A5 + a2*u2%A5 + u_out%S1 = a1*u1%S1 + a2*u2%S1 + u_out%S2 = a1*u1%S2 + a2*u2%S2 + u_out%S3 = a1*u1%S3 + a2*u2%S3 + u_out%S4 = a1*u1%S4 + a2*u2%S4 + u_out%Cn1 = a1*u1%Cn1 + a2*u2%Cn1 + u_out%Cn2 = a1*u1%Cn2 + a2*u2%Cn2 + u_out%St_sh = a1*u1%St_sh + a2*u2%St_sh + u_out%Cd0 = a1*u1%Cd0 + a2*u2%Cd0 + u_out%Cm0 = a1*u1%Cm0 + a2*u2%Cm0 + u_out%k0 = a1*u1%k0 + a2*u2%k0 + u_out%k1 = a1*u1%k1 + a2*u2%k1 + u_out%k2 = a1*u1%k2 + a2*u2%k2 + u_out%k3 = a1*u1%k3 + a2*u2%k3 + u_out%k1_hat = a1*u1%k1_hat + a2*u2%k1_hat + u_out%x_cp_bar = a1*u1%x_cp_bar + a2*u2%x_cp_bar + u_out%UACutout = a1*u1%UACutout + a2*u2%UACutout + u_out%UACutout_delta = a1*u1%UACutout_delta + a2*u2%UACutout_delta + u_out%UACutout_blend = a1*u1%UACutout_blend + a2*u2%UACutout_blend + u_out%filtCutOff = a1*u1%filtCutOff + a2*u2%filtCutOff + CALL Angles_ExtrapInterp( u1%alphaUpper, u2%alphaUpper, tin, u_out%alphaUpper, tin_out ) + CALL Angles_ExtrapInterp( u1%alphaLower, u2%alphaLower, tin, u_out%alphaLower, tin_out ) + u_out%c_Rate = a1*u1%c_Rate + a2*u2%c_Rate + u_out%c_RateUpper = a1*u1%c_RateUpper + a2*u2%c_RateUpper + u_out%c_RateLower = a1*u1%c_RateLower + a2*u2%c_RateLower + u_out%c_alphaLower = a1*u1%c_alphaLower + a2*u2%c_alphaLower + u_out%c_alphaUpper = a1*u1%c_alphaUpper + a2*u2%c_alphaUpper + CALL Angles_ExtrapInterp( u1%alphaUpperWrap, u2%alphaUpperWrap, tin, u_out%alphaUpperWrap, tin_out ) + CALL Angles_ExtrapInterp( u1%alphaLowerWrap, u2%alphaLowerWrap, tin, u_out%alphaLowerWrap, tin_out ) + u_out%c_RateWrap = a1*u1%c_RateWrap + a2*u2%c_RateWrap + u_out%c_alphaLowerWrap = a1*u1%c_alphaLowerWrap + a2*u2%c_alphaLowerWrap + u_out%c_alphaUpperWrap = a1*u1%c_alphaUpperWrap + a2*u2%c_alphaUpperWrap +END SUBROUTINE + +SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) UA_BL_Type 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. @@ -3001,172 +1585,92 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat ! !.................................................................................................................................. - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u1 ! UA_BL_Type at t1 > t2 > t3 - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u2 ! UA_BL_Type at t2 > t3 - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u3 ! UA_BL_Type at t3 - REAL(ReKi), INTENT(IN ) :: tin(3) ! Times associated with the UA_BL_Types - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: u_out ! UA_BL_Type at tin_out - REAL(ReKi), 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 + TYPE(AFI_UA_BL_Type), INTENT(IN) :: u1 ! UA_BL_Type at t1 > t2 > t3 + TYPE(AFI_UA_BL_Type), INTENT(IN) :: u2 ! UA_BL_Type at t2 > t3 + TYPE(AFI_UA_BL_Type), INTENT(IN) :: u3 ! UA_BL_Type at t3 + REAL(ReKi), INTENT(IN ) :: tin(3) ! Times associated with the UA_BL_Types + TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: u_out ! UA_BL_Type at tin_out + REAL(ReKi), 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(ReKi) :: t(3) ! Times associated with the UA_BL_Types - REAL(ReKi) :: 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 = 'AFI_UA_BL_Type_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) - + REAL(ReKi) :: t(3) ! Times associated with the UA_BL_Types + REAL(ReKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_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 + 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 + 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 + 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))) - CALL Angles_ExtrapInterp( u1%alpha0, u2%alpha0, u3%alpha0, tin, u_out%alpha0, tin_out ) - CALL Angles_ExtrapInterp( u1%alpha1, u2%alpha1, u3%alpha1, tin, u_out%alpha1, tin_out ) - CALL Angles_ExtrapInterp( u1%alpha2, u2%alpha2, u3%alpha2, tin, u_out%alpha2, tin_out ) - b = (t(3)**2*(u1%eta_e - u2%eta_e) + t(2)**2*(-u1%eta_e + u3%eta_e))* scaleFactor - c = ( (t(2)-t(3))*u1%eta_e + t(3)*u2%eta_e - t(2)*u3%eta_e ) * scaleFactor - u_out%eta_e = u1%eta_e + b + c * t_out - b = (t(3)**2*(u1%C_nalpha - u2%C_nalpha) + t(2)**2*(-u1%C_nalpha + u3%C_nalpha))* scaleFactor - c = ( (t(2)-t(3))*u1%C_nalpha + t(3)*u2%C_nalpha - t(2)*u3%C_nalpha ) * scaleFactor - u_out%C_nalpha = u1%C_nalpha + b + c * t_out - b = (t(3)**2*(u1%C_lalpha - u2%C_lalpha) + t(2)**2*(-u1%C_lalpha + u3%C_lalpha))* scaleFactor - c = ( (t(2)-t(3))*u1%C_lalpha + t(3)*u2%C_lalpha - t(2)*u3%C_lalpha ) * scaleFactor - u_out%C_lalpha = u1%C_lalpha + b + c * t_out - b = (t(3)**2*(u1%T_f0 - u2%T_f0) + t(2)**2*(-u1%T_f0 + u3%T_f0))* scaleFactor - c = ( (t(2)-t(3))*u1%T_f0 + t(3)*u2%T_f0 - t(2)*u3%T_f0 ) * scaleFactor - u_out%T_f0 = u1%T_f0 + b + c * t_out - b = (t(3)**2*(u1%T_V0 - u2%T_V0) + t(2)**2*(-u1%T_V0 + u3%T_V0))* scaleFactor - c = ( (t(2)-t(3))*u1%T_V0 + t(3)*u2%T_V0 - t(2)*u3%T_V0 ) * scaleFactor - u_out%T_V0 = u1%T_V0 + b + c * t_out - b = (t(3)**2*(u1%T_p - u2%T_p) + t(2)**2*(-u1%T_p + u3%T_p))* scaleFactor - c = ( (t(2)-t(3))*u1%T_p + t(3)*u2%T_p - t(2)*u3%T_p ) * scaleFactor - u_out%T_p = u1%T_p + b + c * t_out - b = (t(3)**2*(u1%T_VL - u2%T_VL) + t(2)**2*(-u1%T_VL + u3%T_VL))* scaleFactor - c = ( (t(2)-t(3))*u1%T_VL + t(3)*u2%T_VL - t(2)*u3%T_VL ) * scaleFactor - u_out%T_VL = u1%T_VL + b + c * t_out - b = (t(3)**2*(u1%b1 - u2%b1) + t(2)**2*(-u1%b1 + u3%b1))* scaleFactor - c = ( (t(2)-t(3))*u1%b1 + t(3)*u2%b1 - t(2)*u3%b1 ) * scaleFactor - u_out%b1 = u1%b1 + b + c * t_out - b = (t(3)**2*(u1%b2 - u2%b2) + t(2)**2*(-u1%b2 + u3%b2))* scaleFactor - c = ( (t(2)-t(3))*u1%b2 + t(3)*u2%b2 - t(2)*u3%b2 ) * scaleFactor - u_out%b2 = u1%b2 + b + c * t_out - b = (t(3)**2*(u1%b5 - u2%b5) + t(2)**2*(-u1%b5 + u3%b5))* scaleFactor - c = ( (t(2)-t(3))*u1%b5 + t(3)*u2%b5 - t(2)*u3%b5 ) * scaleFactor - u_out%b5 = u1%b5 + b + c * t_out - b = (t(3)**2*(u1%A1 - u2%A1) + t(2)**2*(-u1%A1 + u3%A1))* scaleFactor - c = ( (t(2)-t(3))*u1%A1 + t(3)*u2%A1 - t(2)*u3%A1 ) * scaleFactor - u_out%A1 = u1%A1 + b + c * t_out - b = (t(3)**2*(u1%A2 - u2%A2) + t(2)**2*(-u1%A2 + u3%A2))* scaleFactor - c = ( (t(2)-t(3))*u1%A2 + t(3)*u2%A2 - t(2)*u3%A2 ) * scaleFactor - u_out%A2 = u1%A2 + b + c * t_out - b = (t(3)**2*(u1%A5 - u2%A5) + t(2)**2*(-u1%A5 + u3%A5))* scaleFactor - c = ( (t(2)-t(3))*u1%A5 + t(3)*u2%A5 - t(2)*u3%A5 ) * scaleFactor - u_out%A5 = u1%A5 + b + c * t_out - b = (t(3)**2*(u1%S1 - u2%S1) + t(2)**2*(-u1%S1 + u3%S1))* scaleFactor - c = ( (t(2)-t(3))*u1%S1 + t(3)*u2%S1 - t(2)*u3%S1 ) * scaleFactor - u_out%S1 = u1%S1 + b + c * t_out - b = (t(3)**2*(u1%S2 - u2%S2) + t(2)**2*(-u1%S2 + u3%S2))* scaleFactor - c = ( (t(2)-t(3))*u1%S2 + t(3)*u2%S2 - t(2)*u3%S2 ) * scaleFactor - u_out%S2 = u1%S2 + b + c * t_out - b = (t(3)**2*(u1%S3 - u2%S3) + t(2)**2*(-u1%S3 + u3%S3))* scaleFactor - c = ( (t(2)-t(3))*u1%S3 + t(3)*u2%S3 - t(2)*u3%S3 ) * scaleFactor - u_out%S3 = u1%S3 + b + c * t_out - b = (t(3)**2*(u1%S4 - u2%S4) + t(2)**2*(-u1%S4 + u3%S4))* scaleFactor - c = ( (t(2)-t(3))*u1%S4 + t(3)*u2%S4 - t(2)*u3%S4 ) * scaleFactor - u_out%S4 = u1%S4 + b + c * t_out - b = (t(3)**2*(u1%Cn1 - u2%Cn1) + t(2)**2*(-u1%Cn1 + u3%Cn1))* scaleFactor - c = ( (t(2)-t(3))*u1%Cn1 + t(3)*u2%Cn1 - t(2)*u3%Cn1 ) * scaleFactor - u_out%Cn1 = u1%Cn1 + b + c * t_out - b = (t(3)**2*(u1%Cn2 - u2%Cn2) + t(2)**2*(-u1%Cn2 + u3%Cn2))* scaleFactor - c = ( (t(2)-t(3))*u1%Cn2 + t(3)*u2%Cn2 - t(2)*u3%Cn2 ) * scaleFactor - u_out%Cn2 = u1%Cn2 + b + c * t_out - b = (t(3)**2*(u1%St_sh - u2%St_sh) + t(2)**2*(-u1%St_sh + u3%St_sh))* scaleFactor - c = ( (t(2)-t(3))*u1%St_sh + t(3)*u2%St_sh - t(2)*u3%St_sh ) * scaleFactor - u_out%St_sh = u1%St_sh + b + c * t_out - b = (t(3)**2*(u1%Cd0 - u2%Cd0) + t(2)**2*(-u1%Cd0 + u3%Cd0))* scaleFactor - c = ( (t(2)-t(3))*u1%Cd0 + t(3)*u2%Cd0 - t(2)*u3%Cd0 ) * scaleFactor - u_out%Cd0 = u1%Cd0 + b + c * t_out - b = (t(3)**2*(u1%Cm0 - u2%Cm0) + t(2)**2*(-u1%Cm0 + u3%Cm0))* scaleFactor - c = ( (t(2)-t(3))*u1%Cm0 + t(3)*u2%Cm0 - t(2)*u3%Cm0 ) * scaleFactor - u_out%Cm0 = u1%Cm0 + b + c * t_out - b = (t(3)**2*(u1%k0 - u2%k0) + t(2)**2*(-u1%k0 + u3%k0))* scaleFactor - c = ( (t(2)-t(3))*u1%k0 + t(3)*u2%k0 - t(2)*u3%k0 ) * scaleFactor - u_out%k0 = u1%k0 + b + c * t_out - b = (t(3)**2*(u1%k1 - u2%k1) + t(2)**2*(-u1%k1 + u3%k1))* scaleFactor - c = ( (t(2)-t(3))*u1%k1 + t(3)*u2%k1 - t(2)*u3%k1 ) * scaleFactor - u_out%k1 = u1%k1 + b + c * t_out - b = (t(3)**2*(u1%k2 - u2%k2) + t(2)**2*(-u1%k2 + u3%k2))* scaleFactor - c = ( (t(2)-t(3))*u1%k2 + t(3)*u2%k2 - t(2)*u3%k2 ) * scaleFactor - u_out%k2 = u1%k2 + b + c * t_out - b = (t(3)**2*(u1%k3 - u2%k3) + t(2)**2*(-u1%k3 + u3%k3))* scaleFactor - c = ( (t(2)-t(3))*u1%k3 + t(3)*u2%k3 - t(2)*u3%k3 ) * scaleFactor - u_out%k3 = u1%k3 + b + c * t_out - b = (t(3)**2*(u1%k1_hat - u2%k1_hat) + t(2)**2*(-u1%k1_hat + u3%k1_hat))* scaleFactor - c = ( (t(2)-t(3))*u1%k1_hat + t(3)*u2%k1_hat - t(2)*u3%k1_hat ) * scaleFactor - u_out%k1_hat = u1%k1_hat + b + c * t_out - b = (t(3)**2*(u1%x_cp_bar - u2%x_cp_bar) + t(2)**2*(-u1%x_cp_bar + u3%x_cp_bar))* scaleFactor - c = ( (t(2)-t(3))*u1%x_cp_bar + t(3)*u2%x_cp_bar - t(2)*u3%x_cp_bar ) * scaleFactor - u_out%x_cp_bar = u1%x_cp_bar + b + c * t_out - b = (t(3)**2*(u1%UACutout - u2%UACutout) + t(2)**2*(-u1%UACutout + u3%UACutout))* scaleFactor - c = ( (t(2)-t(3))*u1%UACutout + t(3)*u2%UACutout - t(2)*u3%UACutout ) * scaleFactor - u_out%UACutout = u1%UACutout + b + c * t_out - b = (t(3)**2*(u1%UACutout_delta - u2%UACutout_delta) + t(2)**2*(-u1%UACutout_delta + u3%UACutout_delta))* scaleFactor - c = ( (t(2)-t(3))*u1%UACutout_delta + t(3)*u2%UACutout_delta - t(2)*u3%UACutout_delta ) * scaleFactor - u_out%UACutout_delta = u1%UACutout_delta + b + c * t_out - b = (t(3)**2*(u1%UACutout_blend - u2%UACutout_blend) + t(2)**2*(-u1%UACutout_blend + u3%UACutout_blend))* scaleFactor - c = ( (t(2)-t(3))*u1%UACutout_blend + t(3)*u2%UACutout_blend - t(2)*u3%UACutout_blend ) * scaleFactor - u_out%UACutout_blend = u1%UACutout_blend + b + c * t_out - b = (t(3)**2*(u1%filtCutOff - u2%filtCutOff) + t(2)**2*(-u1%filtCutOff + u3%filtCutOff))* scaleFactor - c = ( (t(2)-t(3))*u1%filtCutOff + t(3)*u2%filtCutOff - t(2)*u3%filtCutOff ) * scaleFactor - u_out%filtCutOff = u1%filtCutOff + b + c * t_out - CALL Angles_ExtrapInterp( u1%alphaUpper, u2%alphaUpper, u3%alphaUpper, tin, u_out%alphaUpper, tin_out ) - CALL Angles_ExtrapInterp( u1%alphaLower, u2%alphaLower, u3%alphaLower, tin, u_out%alphaLower, tin_out ) - b = (t(3)**2*(u1%c_Rate - u2%c_Rate) + t(2)**2*(-u1%c_Rate + u3%c_Rate))* scaleFactor - c = ( (t(2)-t(3))*u1%c_Rate + t(3)*u2%c_Rate - t(2)*u3%c_Rate ) * scaleFactor - u_out%c_Rate = u1%c_Rate + b + c * t_out - b = (t(3)**2*(u1%c_RateUpper - u2%c_RateUpper) + t(2)**2*(-u1%c_RateUpper + u3%c_RateUpper))* scaleFactor - c = ( (t(2)-t(3))*u1%c_RateUpper + t(3)*u2%c_RateUpper - t(2)*u3%c_RateUpper ) * scaleFactor - u_out%c_RateUpper = u1%c_RateUpper + b + c * t_out - b = (t(3)**2*(u1%c_RateLower - u2%c_RateLower) + t(2)**2*(-u1%c_RateLower + u3%c_RateLower))* scaleFactor - c = ( (t(2)-t(3))*u1%c_RateLower + t(3)*u2%c_RateLower - t(2)*u3%c_RateLower ) * scaleFactor - u_out%c_RateLower = u1%c_RateLower + b + c * t_out - b = (t(3)**2*(u1%c_alphaLower - u2%c_alphaLower) + t(2)**2*(-u1%c_alphaLower + u3%c_alphaLower))* scaleFactor - c = ( (t(2)-t(3))*u1%c_alphaLower + t(3)*u2%c_alphaLower - t(2)*u3%c_alphaLower ) * scaleFactor - u_out%c_alphaLower = u1%c_alphaLower + b + c * t_out - b = (t(3)**2*(u1%c_alphaUpper - u2%c_alphaUpper) + t(2)**2*(-u1%c_alphaUpper + u3%c_alphaUpper))* scaleFactor - c = ( (t(2)-t(3))*u1%c_alphaUpper + t(3)*u2%c_alphaUpper - t(2)*u3%c_alphaUpper ) * scaleFactor - u_out%c_alphaUpper = u1%c_alphaUpper + b + c * t_out - CALL Angles_ExtrapInterp( u1%alphaUpperWrap, u2%alphaUpperWrap, u3%alphaUpperWrap, tin, u_out%alphaUpperWrap, tin_out ) - CALL Angles_ExtrapInterp( u1%alphaLowerWrap, u2%alphaLowerWrap, u3%alphaLowerWrap, tin, u_out%alphaLowerWrap, tin_out ) - b = (t(3)**2*(u1%c_RateWrap - u2%c_RateWrap) + t(2)**2*(-u1%c_RateWrap + u3%c_RateWrap))* scaleFactor - c = ( (t(2)-t(3))*u1%c_RateWrap + t(3)*u2%c_RateWrap - t(2)*u3%c_RateWrap ) * scaleFactor - u_out%c_RateWrap = u1%c_RateWrap + b + c * t_out - b = (t(3)**2*(u1%c_alphaLowerWrap - u2%c_alphaLowerWrap) + t(2)**2*(-u1%c_alphaLowerWrap + u3%c_alphaLowerWrap))* scaleFactor - c = ( (t(2)-t(3))*u1%c_alphaLowerWrap + t(3)*u2%c_alphaLowerWrap - t(2)*u3%c_alphaLowerWrap ) * scaleFactor - u_out%c_alphaLowerWrap = u1%c_alphaLowerWrap + b + c * t_out - b = (t(3)**2*(u1%c_alphaUpperWrap - u2%c_alphaUpperWrap) + t(2)**2*(-u1%c_alphaUpperWrap + u3%c_alphaUpperWrap))* scaleFactor - c = ( (t(2)-t(3))*u1%c_alphaUpperWrap + t(3)*u2%c_alphaUpperWrap - t(2)*u3%c_alphaUpperWrap ) * scaleFactor - u_out%c_alphaUpperWrap = u1%c_alphaUpperWrap + b + c * t_out - END SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL Angles_ExtrapInterp( u1%alpha0, u2%alpha0, u3%alpha0, tin, u_out%alpha0, tin_out ) + CALL Angles_ExtrapInterp( u1%alpha1, u2%alpha1, u3%alpha1, tin, u_out%alpha1, tin_out ) + CALL Angles_ExtrapInterp( u1%alpha2, u2%alpha2, u3%alpha2, tin, u_out%alpha2, tin_out ) + u_out%eta_e = a1*u1%eta_e + a2*u2%eta_e + a3*u3%eta_e + u_out%C_nalpha = a1*u1%C_nalpha + a2*u2%C_nalpha + a3*u3%C_nalpha + u_out%C_lalpha = a1*u1%C_lalpha + a2*u2%C_lalpha + a3*u3%C_lalpha + u_out%T_f0 = a1*u1%T_f0 + a2*u2%T_f0 + a3*u3%T_f0 + u_out%T_V0 = a1*u1%T_V0 + a2*u2%T_V0 + a3*u3%T_V0 + u_out%T_p = a1*u1%T_p + a2*u2%T_p + a3*u3%T_p + u_out%T_VL = a1*u1%T_VL + a2*u2%T_VL + a3*u3%T_VL + u_out%b1 = a1*u1%b1 + a2*u2%b1 + a3*u3%b1 + u_out%b2 = a1*u1%b2 + a2*u2%b2 + a3*u3%b2 + u_out%b5 = a1*u1%b5 + a2*u2%b5 + a3*u3%b5 + u_out%A1 = a1*u1%A1 + a2*u2%A1 + a3*u3%A1 + u_out%A2 = a1*u1%A2 + a2*u2%A2 + a3*u3%A2 + u_out%A5 = a1*u1%A5 + a2*u2%A5 + a3*u3%A5 + u_out%S1 = a1*u1%S1 + a2*u2%S1 + a3*u3%S1 + u_out%S2 = a1*u1%S2 + a2*u2%S2 + a3*u3%S2 + u_out%S3 = a1*u1%S3 + a2*u2%S3 + a3*u3%S3 + u_out%S4 = a1*u1%S4 + a2*u2%S4 + a3*u3%S4 + u_out%Cn1 = a1*u1%Cn1 + a2*u2%Cn1 + a3*u3%Cn1 + u_out%Cn2 = a1*u1%Cn2 + a2*u2%Cn2 + a3*u3%Cn2 + u_out%St_sh = a1*u1%St_sh + a2*u2%St_sh + a3*u3%St_sh + u_out%Cd0 = a1*u1%Cd0 + a2*u2%Cd0 + a3*u3%Cd0 + u_out%Cm0 = a1*u1%Cm0 + a2*u2%Cm0 + a3*u3%Cm0 + u_out%k0 = a1*u1%k0 + a2*u2%k0 + a3*u3%k0 + u_out%k1 = a1*u1%k1 + a2*u2%k1 + a3*u3%k1 + u_out%k2 = a1*u1%k2 + a2*u2%k2 + a3*u3%k2 + u_out%k3 = a1*u1%k3 + a2*u2%k3 + a3*u3%k3 + u_out%k1_hat = a1*u1%k1_hat + a2*u2%k1_hat + a3*u3%k1_hat + u_out%x_cp_bar = a1*u1%x_cp_bar + a2*u2%x_cp_bar + a3*u3%x_cp_bar + u_out%UACutout = a1*u1%UACutout + a2*u2%UACutout + a3*u3%UACutout + u_out%UACutout_delta = a1*u1%UACutout_delta + a2*u2%UACutout_delta + a3*u3%UACutout_delta + u_out%UACutout_blend = a1*u1%UACutout_blend + a2*u2%UACutout_blend + a3*u3%UACutout_blend + u_out%filtCutOff = a1*u1%filtCutOff + a2*u2%filtCutOff + a3*u3%filtCutOff + CALL Angles_ExtrapInterp( u1%alphaUpper, u2%alphaUpper, u3%alphaUpper, tin, u_out%alphaUpper, tin_out ) + CALL Angles_ExtrapInterp( u1%alphaLower, u2%alphaLower, u3%alphaLower, tin, u_out%alphaLower, tin_out ) + u_out%c_Rate = a1*u1%c_Rate + a2*u2%c_Rate + a3*u3%c_Rate + u_out%c_RateUpper = a1*u1%c_RateUpper + a2*u2%c_RateUpper + a3*u3%c_RateUpper + u_out%c_RateLower = a1*u1%c_RateLower + a2*u2%c_RateLower + a3*u3%c_RateLower + u_out%c_alphaLower = a1*u1%c_alphaLower + a2*u2%c_alphaLower + a3*u3%c_alphaLower + u_out%c_alphaUpper = a1*u1%c_alphaUpper + a2*u2%c_alphaUpper + a3*u3%c_alphaUpper + CALL Angles_ExtrapInterp( u1%alphaUpperWrap, u2%alphaUpperWrap, u3%alphaUpperWrap, tin, u_out%alphaUpperWrap, tin_out ) + CALL Angles_ExtrapInterp( u1%alphaLowerWrap, u2%alphaLowerWrap, u3%alphaLowerWrap, tin, u_out%alphaLowerWrap, tin_out ) + u_out%c_RateWrap = a1*u1%c_RateWrap + a2*u2%c_RateWrap + a3*u3%c_RateWrap + u_out%c_alphaLowerWrap = a1*u1%c_alphaLowerWrap + a2*u2%c_alphaLowerWrap + a3*u3%c_alphaLowerWrap + u_out%c_alphaUpperWrap = a1*u1%c_alphaUpperWrap + a2*u2%c_alphaUpperWrap + a3*u3%c_alphaUpperWrap +END SUBROUTINE END MODULE AirfoilInfo_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index f1b4b40e07..7f863d8a46 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -46,39 +46,39 @@ MODULE BEMT_Types ! ========= BEMT_InitInputType ======= TYPE, PUBLIC :: BEMT_InitInputType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chord !< Chord length at node [m] - INTEGER(IntKi) :: numBlades !< Number of blades [-] - REAL(ReKi) :: airDens !< Air density [kg/m^3] - REAL(ReKi) :: kinVisc !< Kinematic air viscosity [m^2/s] - INTEGER(IntKi) :: skewWakeMod !< Type of skewed-wake correction model [switch] {1=uncoupled, 2=Pitt/Peters, 3=coupled} [-] - REAL(ReKi) :: aTol !< Tolerance for the induction solution [-] - LOGICAL :: useTipLoss !< Use the Prandtl tip-loss model? [flag] [-] - LOGICAL :: useHubLoss !< Use the Prandtl hub-loss model? [flag] [-] - LOGICAL :: useInduction !< Include induction in BEMT calculations [flag] { If FALSE then useTanInd will be set to FALSE} [-] - LOGICAL :: useTanInd !< Include tangential induction in BEMT calculations [flag] [-] - LOGICAL :: useAIDrag !< Include the drag term in the axial-induction calculation? [flag] [-] - LOGICAL :: useTIDrag !< Include the drag term in the tangential-induction calculation? Ignored if TanInd is False. [flag] [-] - LOGICAL :: MomentumCorr !< Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory} [-] - INTEGER(IntKi) :: numBladeNodes !< Number of blade nodes used in the analysis [-] - INTEGER(IntKi) :: numReIterations !< Number of iterations for finding the Reynolds number [-] - INTEGER(IntKi) :: maxIndIterations !< Maximum number of iterations of induction factor solve [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< Number of blades [-] + REAL(ReKi) :: airDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: kinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + INTEGER(IntKi) :: skewWakeMod = 0_IntKi !< Type of skewed-wake correction model [switch] {1=uncoupled, 2=Pitt/Peters, 3=coupled} [-] + REAL(ReKi) :: aTol = 0.0_ReKi !< Tolerance for the induction solution [-] + LOGICAL :: useTipLoss = .false. !< Use the Prandtl tip-loss model? [flag] [-] + LOGICAL :: useHubLoss = .false. !< Use the Prandtl hub-loss model? [flag] [-] + LOGICAL :: useInduction = .false. !< Include induction in BEMT calculations [flag] { If FALSE then useTanInd will be set to FALSE} [-] + LOGICAL :: useTanInd = .false. !< Include tangential induction in BEMT calculations [flag] [-] + LOGICAL :: useAIDrag = .false. !< Include the drag term in the axial-induction calculation? [flag] [-] + LOGICAL :: useTIDrag = .false. !< Include the drag term in the tangential-induction calculation? Ignored if TanInd is False. [flag] [-] + LOGICAL :: MomentumCorr = .false. !< Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory} [-] + INTEGER(IntKi) :: numBladeNodes = 0_IntKi !< Number of blade nodes used in the analysis [-] + INTEGER(IntKi) :: numReIterations = 0_IntKi !< Number of iterations for finding the Reynolds number [-] + INTEGER(IntKi) :: maxIndIterations = 0_IntKi !< Maximum number of iterations of induction factor solve [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: AFindx !< Index of airfoil data file for blade node location [array of numBladeNodes] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: zHub !< Distance to hub for each blade [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: zLocal !< Distance to blade node, measured along the blade [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: zTip !< Distance to blade tip, measured along the blade [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rLocal !< Radial distance to blade node from the center of rotation, measured in the rotor plane, needed for DBEMT [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rTipFix !< Nominally the coned rotor diameter (without prebend), used to align with Bladed calculations [m] - INTEGER(IntKi) :: UAMod !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] - LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] - LOGICAL :: Flookup !< Use table lookup for f' and f'' [-] - REAL(ReKi) :: a_s !< speed of sound [m/s] - INTEGER(IntKi) :: DBEMT_Mod !< DBEMT model. 1 = constant tau1, 2 = time dependent tau1 [-] - REAL(ReKi) :: tau1_const !< DBEMT time constant (when DBEMT_Mod=1) [s] - REAL(ReKi) :: yawCorrFactor !< constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] + INTEGER(IntKi) :: UAMod = 0_IntKi !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] + LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] + LOGICAL :: Flookup = .false. !< Use table lookup for f' and f'' [-] + REAL(ReKi) :: a_s = 0.0_ReKi !< speed of sound [m/s] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< DBEMT model. 1 = constant tau1, 2 = time dependent tau1 [-] + REAL(ReKi) :: tau1_const = 0.0_ReKi !< DBEMT time constant (when DBEMT_Mod=1) [s] + REAL(ReKi) :: yawCorrFactor = 0.0_ReKi !< constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: UAOff_innerNode !< Last node on each blade where UA should be turned off based on span location from blade root (0 if always on) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: UAOff_outerNode !< First node on each blade where UA should be turned off based on span location from blade tip (>nNodesPerBlade if always on) [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] - LOGICAL :: SumPrint !< logical flag indicating whether to use UnsteadyAero [-] - INTEGER(IntKi) :: BEM_Mod !< BEM Model 0=OpenFAST 2=Envision [-] + LOGICAL :: SumPrint = .false. !< logical flag indicating whether to use UnsteadyAero [-] + INTEGER(IntKi) :: BEM_Mod = 0_IntKi !< BEM Model 0=OpenFAST 2=Envision [-] END TYPE BEMT_InitInputType ! ======================= ! ========= BEMT_InitOutputType ======= @@ -88,16 +88,16 @@ MODULE BEMT_Types ! ======================= ! ========= BEMT_SkewWake_InputType ======= TYPE, PUBLIC :: BEMT_SkewWake_InputType - REAL(ReKi) , DIMENSION(1:3) :: v_qsw !< quasi-steady instantaneous wake velocity (value to be filtered in Skewed Wake model) [m/s] - REAL(ReKi) :: V0 !< magnitude of disk-averaged velocity (for input to SkewWake) [m/s] - REAL(ReKi) :: R !< rotor radius (for input to SkewWake) [m] + REAL(ReKi) , DIMENSION(1:3) :: v_qsw = 0.0_ReKi !< quasi-steady instantaneous wake velocity (value to be filtered in Skewed Wake model) [m/s] + REAL(ReKi) :: V0 = 0.0_ReKi !< magnitude of disk-averaged velocity (for input to SkewWake) [m/s] + REAL(ReKi) :: R = 0.0_ReKi !< rotor radius (for input to SkewWake) [m] END TYPE BEMT_SkewWake_InputType ! ======================= ! ========= BEMT_ContinuousStateType ======= TYPE, PUBLIC :: BEMT_ContinuousStateType TYPE(UA_ContinuousStateType) :: UA !< UA module continuous states [-] TYPE(DBEMT_ContinuousStateType) :: DBEMT !< DBEMT module continuous states [-] - REAL(R8Ki) , DIMENSION(1:3) :: V_w !< continuous state for filtering wake velocity [-] + REAL(R8Ki) , DIMENSION(1:3) :: V_w = 0.0_R8Ki !< continuous state for filtering wake velocity [-] END TYPE BEMT_ContinuousStateType ! ======================= ! ========= BEMT_DiscreteStateType ======= @@ -115,16 +115,16 @@ MODULE BEMT_Types TYPE(UA_OtherStateType) :: UA !< other states for UnsteadyAero [-] TYPE(DBEMT_OtherStateType) :: DBEMT !< other states for DBEMT [-] 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 [-] + LOGICAL :: nodesInitialized = .false. !< 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 = 0_IntKi !< time step # value used for continuous state integrator [-] END TYPE BEMT_OtherStateType ! ======================= ! ========= BEMT_MiscVarType ======= TYPE, PUBLIC :: BEMT_MiscVarType - LOGICAL :: FirstWarn_Skew !< flag so invalid skew warning doesn't get repeated forever [-] - LOGICAL :: FirstWarn_Phi !< flag so Invalid Phi warning doesn't get repeated forever [-] - LOGICAL :: FirstWarn_BEMoff !< flag to warn the BEM was turned off [-] + LOGICAL :: FirstWarn_Skew = .false. !< flag so invalid skew warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_Phi = .false. !< flag so Invalid Phi warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_BEMoff = .false. !< flag to warn the BEM was turned off [-] TYPE(UA_MiscVarType) :: UA !< misc vars for UnsteadyAero [-] TYPE(DBEMT_MiscVarType) :: DBEMT !< misc vars for DBEMT [-] TYPE(UA_OutputType) :: y_UA !< outputs from UnsteadyAero [-] @@ -135,66 +135,66 @@ MODULE BEMT_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AxInd_op !< axial induction at the operating point (for linearization) with frozen wake assumption [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AxInduction !< axial induction used for code run-time optimization [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TanInduction !< tangential induction used for code run-time optimization [-] - LOGICAL :: UseFrozenWake !< flag set to determine if frozen values of TnInd_op and AxInd_op should be used for this calculation in the linearization process [-] + LOGICAL :: UseFrozenWake = .false. !< flag set to determine if frozen values of TnInd_op and AxInd_op should be used for this calculation in the linearization process [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Rtip !< maximum rlocal value for each blade (typically the value at the tip) [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: phi !< temp variable used in update states for returning phi (to allow computing inputs and states at multiple times) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chi !< temp variable used in update states for returning chi (to allow calling same routine from CalcOutput and UpdateStates) [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: ValidPhi !< temp variable used in calcOutput for ValidPhi (to allow calling same routine from CalcOutput and UpdateStates) [-] - REAL(ReKi) :: BEM_weight + REAL(ReKi) :: BEM_weight = 0.0_ReKi END TYPE BEMT_MiscVarType ! ======================= ! ========= BEMT_ParameterType ======= TYPE, PUBLIC :: BEMT_ParameterType - REAL(DbKi) :: DT !< time step [s] + REAL(DbKi) :: DT = 0.0_R8Ki !< time step [s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chord !< Chord length at node [m] - INTEGER(IntKi) :: numBlades !< Number of blades [-] - REAL(ReKi) :: airDens !< Air density [kg/m^3] - REAL(ReKi) :: kinVisc !< Kinematic air viscosity [m^2/s] - INTEGER(IntKi) :: skewWakeMod !< Type of skewed-wake correction model [switch] {1=uncoupled, 2=Pitt/Peters, 3=coupled} [-] - REAL(ReKi) :: aTol !< Tolerance for the induction solution [-] - LOGICAL :: useTipLoss !< Use the Prandtl tip-loss model? [flag] [-] - LOGICAL :: useHubLoss !< Use the Prandtl hub-loss model? [flag] [-] - LOGICAL :: useInduction !< Include induction in BEMT calculations [flag] { If FALSE then useTanInd will be set to FALSE} [-] - LOGICAL :: useTanInd !< Include tangential induction in BEMT calculations [flag] [-] - LOGICAL :: useAIDrag !< Include the drag term in the axial-induction calculation? [flag] [-] - LOGICAL :: useTIDrag !< Include the drag term in the tangential-induction calculation? Ignored if TanInd is False. [flag] [-] - INTEGER(IntKi) :: numBladeNodes !< Number of blade nodes used in the analysis [-] - INTEGER(IntKi) :: numReIterations !< Number of iterations for finding the Reynolds number [-] - INTEGER(IntKi) :: maxIndIterations !< Maximum number of iterations of induction factor solve [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< Number of blades [-] + REAL(ReKi) :: airDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: kinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + INTEGER(IntKi) :: skewWakeMod = 0_IntKi !< Type of skewed-wake correction model [switch] {1=uncoupled, 2=Pitt/Peters, 3=coupled} [-] + REAL(ReKi) :: aTol = 0.0_ReKi !< Tolerance for the induction solution [-] + LOGICAL :: useTipLoss = .false. !< Use the Prandtl tip-loss model? [flag] [-] + LOGICAL :: useHubLoss = .false. !< Use the Prandtl hub-loss model? [flag] [-] + LOGICAL :: useInduction = .false. !< Include induction in BEMT calculations [flag] { If FALSE then useTanInd will be set to FALSE} [-] + LOGICAL :: useTanInd = .false. !< Include tangential induction in BEMT calculations [flag] [-] + LOGICAL :: useAIDrag = .false. !< Include the drag term in the axial-induction calculation? [flag] [-] + LOGICAL :: useTIDrag = .false. !< Include the drag term in the tangential-induction calculation? Ignored if TanInd is False. [flag] [-] + INTEGER(IntKi) :: numBladeNodes = 0_IntKi !< Number of blade nodes used in the analysis [-] + INTEGER(IntKi) :: numReIterations = 0_IntKi !< Number of iterations for finding the Reynolds number [-] + INTEGER(IntKi) :: maxIndIterations = 0_IntKi !< Maximum number of iterations of induction factor solve [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: AFindx !< Index of airfoil data file for blade node location [array of numBladeNodes] [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: tipLossConst !< A constant computed during initialization based on B*(zTip-zLocal)/(2*zLocal) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: hubLossConst !< A constant computed during initialization based on B*(zLocal-zHub)/(2*zHub) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: zHub !< Distance to hub for each blade [m] TYPE(UA_ParameterType) :: UA !< parameters for UnsteadyAero [-] TYPE(DBEMT_ParameterType) :: DBEMT !< parameters for DBEMT [-] - LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] - INTEGER(IntKi) :: DBEMT_Mod !< DBEMT Model. 0 = constant tau1, 1 = time dependent tau1 [-] - REAL(ReKi) :: yawCorrFactor !< constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] + LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< DBEMT Model. 0 = constant tau1, 1 = time dependent tau1 [-] + REAL(ReKi) :: yawCorrFactor = 0.0_ReKi !< constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: FixedInductions !< flag to determine if BEM inductions should be fixed and not modified by dbemt or skewed wake [-] - LOGICAL :: MomentumCorr !< Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory} [-] - REAL(ReKi) :: rTipFixMax !< Nominally the coned rotor diameter (without prebend), used to align with Bladed calculations [m] + LOGICAL :: MomentumCorr = .false. !< Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory} [-] + REAL(ReKi) :: rTipFixMax = 0.0_ReKi !< Nominally the coned rotor diameter (without prebend), used to align with Bladed calculations [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: IntegrateWeight !< A weighting factor for calculating rotor-averaged values (e.g., AxInd) [-] INTEGER(IntKi) :: lin_nx = 0 !< Number of continuous states for linearization [-] - INTEGER(IntKi) :: BEM_Mod !< BEM Model 0=OpenFAST 2=Envision [-] + INTEGER(IntKi) :: BEM_Mod = 0_IntKi !< BEM Model 0=OpenFAST 2=Envision [-] END TYPE BEMT_ParameterType ! ======================= ! ========= BEMT_InputType ======= TYPE, PUBLIC :: BEMT_InputType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: theta !< Twist angle (includes all sources of twist) [Array of size (NumBlNds,numBlades)] [rad] - REAL(ReKi) :: chi0 !< Angle between the vector normal to the rotor plane and the wind vector (e.g., the yaw angle in the case of no tilt) [rad] - REAL(ReKi) :: psiSkewOffset !< Azimuth angle offset (relative to 90 deg) of the most downwind blade when chi0 is non-zero [rad] + REAL(ReKi) :: chi0 = 0.0_ReKi !< Angle between the vector normal to the rotor plane and the wind vector (e.g., the yaw angle in the case of no tilt) [rad] + REAL(ReKi) :: psiSkewOffset = 0.0_ReKi !< Azimuth angle offset (relative to 90 deg) of the most downwind blade when chi0 is non-zero [rad] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: psi !< Azimuth angle [rad] - REAL(ReKi) :: omega !< Angular velocity of rotor [rad/s] - REAL(ReKi) :: TSR !< Tip-speed ratio (to check if BEM should be turned off) [-] + REAL(ReKi) :: omega = 0.0_ReKi !< Angular velocity of rotor [rad/s] + REAL(ReKi) :: TSR = 0.0_ReKi !< Tip-speed ratio (to check if BEM should be turned off) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vx !< Local axial velocity at node [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vy !< Local tangential velocity at node [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vz !< Local radial velocity at node [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: omega_z !< rotation of no-sweep-pitch-twist coordinate system around z (for CDBEMT and CUA) [rad/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: xVelCorr !< projection of velocity when yawed + prebend [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rLocal !< Radial distance from center-of-rotation to node [m] - REAL(ReKi) :: Un_disk !< disk-averaged velocity normal to the rotor disk (for input to DBEMT) [m/s] - REAL(ReKi) , DIMENSION(1:3) :: V0 !< disk-averaged velocity (for input to SkewWake) [m/s] - REAL(R8Ki) , DIMENSION(1:3) :: x_hat_disk !< Hub Orientation vector: normal to rotor disk [-] + REAL(ReKi) :: Un_disk = 0.0_ReKi !< disk-averaged velocity normal to the rotor disk (for input to DBEMT) [m/s] + REAL(ReKi) , DIMENSION(1:3) :: V0 = 0.0_ReKi !< disk-averaged velocity (for input to SkewWake) [m/s] + REAL(R8Ki) , DIMENSION(1:3) :: x_hat_disk = 0.0_R8Ki !< Hub Orientation vector: normal to rotor disk [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: UserProp !< Optional user property for interpolating airfoils (per element per blade) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CantAngle !< Cant angle [Array of size (NumBlNds,numBlades)] [rad] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: drdz !< dr/dz geometric parameter [-] @@ -223,6824 +223,2854 @@ MODULE BEMT_Types END TYPE BEMT_OutputType ! ======================= CONTAINS - SUBROUTINE BEMT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(BEMT_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 = 'BEMT_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitInputData%chord)) THEN - i1_l = LBOUND(SrcInitInputData%chord,1) - i1_u = UBOUND(SrcInitInputData%chord,1) - i2_l = LBOUND(SrcInitInputData%chord,2) - i2_u = UBOUND(SrcInitInputData%chord,2) - IF (.NOT. ALLOCATED(DstInitInputData%chord)) THEN - ALLOCATE(DstInitInputData%chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%chord = SrcInitInputData%chord -ENDIF - DstInitInputData%numBlades = SrcInitInputData%numBlades - DstInitInputData%airDens = SrcInitInputData%airDens - DstInitInputData%kinVisc = SrcInitInputData%kinVisc - DstInitInputData%skewWakeMod = SrcInitInputData%skewWakeMod - DstInitInputData%aTol = SrcInitInputData%aTol - DstInitInputData%useTipLoss = SrcInitInputData%useTipLoss - DstInitInputData%useHubLoss = SrcInitInputData%useHubLoss - DstInitInputData%useInduction = SrcInitInputData%useInduction - DstInitInputData%useTanInd = SrcInitInputData%useTanInd - DstInitInputData%useAIDrag = SrcInitInputData%useAIDrag - DstInitInputData%useTIDrag = SrcInitInputData%useTIDrag - DstInitInputData%MomentumCorr = SrcInitInputData%MomentumCorr - DstInitInputData%numBladeNodes = SrcInitInputData%numBladeNodes - DstInitInputData%numReIterations = SrcInitInputData%numReIterations - DstInitInputData%maxIndIterations = SrcInitInputData%maxIndIterations -IF (ALLOCATED(SrcInitInputData%AFindx)) THEN - i1_l = LBOUND(SrcInitInputData%AFindx,1) - i1_u = UBOUND(SrcInitInputData%AFindx,1) - i2_l = LBOUND(SrcInitInputData%AFindx,2) - i2_u = UBOUND(SrcInitInputData%AFindx,2) - IF (.NOT. ALLOCATED(DstInitInputData%AFindx)) THEN - ALLOCATE(DstInitInputData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%AFindx = SrcInitInputData%AFindx -ENDIF -IF (ALLOCATED(SrcInitInputData%zHub)) THEN - i1_l = LBOUND(SrcInitInputData%zHub,1) - i1_u = UBOUND(SrcInitInputData%zHub,1) - IF (.NOT. ALLOCATED(DstInitInputData%zHub)) THEN - ALLOCATE(DstInitInputData%zHub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zHub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%zHub = SrcInitInputData%zHub -ENDIF -IF (ALLOCATED(SrcInitInputData%zLocal)) THEN - i1_l = LBOUND(SrcInitInputData%zLocal,1) - i1_u = UBOUND(SrcInitInputData%zLocal,1) - i2_l = LBOUND(SrcInitInputData%zLocal,2) - i2_u = UBOUND(SrcInitInputData%zLocal,2) - IF (.NOT. ALLOCATED(DstInitInputData%zLocal)) THEN - ALLOCATE(DstInitInputData%zLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%zLocal = SrcInitInputData%zLocal -ENDIF -IF (ALLOCATED(SrcInitInputData%zTip)) THEN - i1_l = LBOUND(SrcInitInputData%zTip,1) - i1_u = UBOUND(SrcInitInputData%zTip,1) - IF (.NOT. ALLOCATED(DstInitInputData%zTip)) THEN - ALLOCATE(DstInitInputData%zTip(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zTip.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%zTip = SrcInitInputData%zTip -ENDIF -IF (ALLOCATED(SrcInitInputData%rLocal)) THEN - i1_l = LBOUND(SrcInitInputData%rLocal,1) - i1_u = UBOUND(SrcInitInputData%rLocal,1) - i2_l = LBOUND(SrcInitInputData%rLocal,2) - i2_u = UBOUND(SrcInitInputData%rLocal,2) - IF (.NOT. ALLOCATED(DstInitInputData%rLocal)) THEN - ALLOCATE(DstInitInputData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%rLocal = SrcInitInputData%rLocal -ENDIF -IF (ALLOCATED(SrcInitInputData%rTipFix)) THEN - i1_l = LBOUND(SrcInitInputData%rTipFix,1) - i1_u = UBOUND(SrcInitInputData%rTipFix,1) - IF (.NOT. ALLOCATED(DstInitInputData%rTipFix)) THEN - ALLOCATE(DstInitInputData%rTipFix(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rTipFix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%rTipFix = SrcInitInputData%rTipFix -ENDIF - DstInitInputData%UAMod = SrcInitInputData%UAMod - DstInitInputData%UA_Flag = SrcInitInputData%UA_Flag - DstInitInputData%Flookup = SrcInitInputData%Flookup - DstInitInputData%a_s = SrcInitInputData%a_s - DstInitInputData%DBEMT_Mod = SrcInitInputData%DBEMT_Mod - DstInitInputData%tau1_const = SrcInitInputData%tau1_const - DstInitInputData%yawCorrFactor = SrcInitInputData%yawCorrFactor -IF (ALLOCATED(SrcInitInputData%UAOff_innerNode)) THEN - i1_l = LBOUND(SrcInitInputData%UAOff_innerNode,1) - i1_u = UBOUND(SrcInitInputData%UAOff_innerNode,1) - IF (.NOT. ALLOCATED(DstInitInputData%UAOff_innerNode)) THEN - ALLOCATE(DstInitInputData%UAOff_innerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_innerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode -ENDIF -IF (ALLOCATED(SrcInitInputData%UAOff_outerNode)) THEN - i1_l = LBOUND(SrcInitInputData%UAOff_outerNode,1) - i1_u = UBOUND(SrcInitInputData%UAOff_outerNode,1) - IF (.NOT. ALLOCATED(DstInitInputData%UAOff_outerNode)) THEN - ALLOCATE(DstInitInputData%UAOff_outerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_outerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%UAOff_outerNode = SrcInitInputData%UAOff_outerNode -ENDIF - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%SumPrint = SrcInitInputData%SumPrint - DstInitInputData%BEM_Mod = SrcInitInputData%BEM_Mod - END SUBROUTINE BEMT_CopyInitInput - - SUBROUTINE BEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(BEMT_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 = 'BEMT_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%chord)) THEN - DEALLOCATE(InitInputData%chord) -ENDIF -IF (ALLOCATED(InitInputData%AFindx)) THEN - DEALLOCATE(InitInputData%AFindx) -ENDIF -IF (ALLOCATED(InitInputData%zHub)) THEN - DEALLOCATE(InitInputData%zHub) -ENDIF -IF (ALLOCATED(InitInputData%zLocal)) THEN - DEALLOCATE(InitInputData%zLocal) -ENDIF -IF (ALLOCATED(InitInputData%zTip)) THEN - DEALLOCATE(InitInputData%zTip) -ENDIF -IF (ALLOCATED(InitInputData%rLocal)) THEN - DEALLOCATE(InitInputData%rLocal) -ENDIF -IF (ALLOCATED(InitInputData%rTipFix)) THEN - DEALLOCATE(InitInputData%rTipFix) -ENDIF -IF (ALLOCATED(InitInputData%UAOff_innerNode)) THEN - DEALLOCATE(InitInputData%UAOff_innerNode) -ENDIF -IF (ALLOCATED(InitInputData%UAOff_outerNode)) THEN - DEALLOCATE(InitInputData%UAOff_outerNode) -ENDIF - END SUBROUTINE BEMT_DestroyInitInput - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 ! chord allocated yes/no - IF ( ALLOCATED(InData%chord) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! chord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord) ! chord - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Re_BufSz = Re_BufSz + 1 ! airDens - Re_BufSz = Re_BufSz + 1 ! kinVisc - Int_BufSz = Int_BufSz + 1 ! skewWakeMod - Re_BufSz = Re_BufSz + 1 ! aTol - Int_BufSz = Int_BufSz + 1 ! useTipLoss - Int_BufSz = Int_BufSz + 1 ! useHubLoss - Int_BufSz = Int_BufSz + 1 ! useInduction - Int_BufSz = Int_BufSz + 1 ! useTanInd - Int_BufSz = Int_BufSz + 1 ! useAIDrag - Int_BufSz = Int_BufSz + 1 ! useTIDrag - Int_BufSz = Int_BufSz + 1 ! MomentumCorr - Int_BufSz = Int_BufSz + 1 ! numBladeNodes - Int_BufSz = Int_BufSz + 1 ! numReIterations - Int_BufSz = Int_BufSz + 1 ! maxIndIterations - Int_BufSz = Int_BufSz + 1 ! AFindx allocated yes/no - IF ( ALLOCATED(InData%AFindx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFindx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AFindx) ! AFindx - END IF - Int_BufSz = Int_BufSz + 1 ! zHub allocated yes/no - IF ( ALLOCATED(InData%zHub) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zHub upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zHub) ! zHub - END IF - Int_BufSz = Int_BufSz + 1 ! zLocal allocated yes/no - IF ( ALLOCATED(InData%zLocal) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! zLocal upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zLocal) ! zLocal - END IF - Int_BufSz = Int_BufSz + 1 ! zTip allocated yes/no - IF ( ALLOCATED(InData%zTip) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zTip upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zTip) ! zTip - END IF - Int_BufSz = Int_BufSz + 1 ! rLocal allocated yes/no - IF ( ALLOCATED(InData%rLocal) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rLocal upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rLocal) ! rLocal - END IF - Int_BufSz = Int_BufSz + 1 ! rTipFix allocated yes/no - IF ( ALLOCATED(InData%rTipFix) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rTipFix upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rTipFix) ! rTipFix - END IF - Int_BufSz = Int_BufSz + 1 ! UAMod - Int_BufSz = Int_BufSz + 1 ! UA_Flag - Int_BufSz = Int_BufSz + 1 ! Flookup - Re_BufSz = Re_BufSz + 1 ! a_s - Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod - Re_BufSz = Re_BufSz + 1 ! tau1_const - Re_BufSz = Re_BufSz + 1 ! yawCorrFactor - Int_BufSz = Int_BufSz + 1 ! UAOff_innerNode allocated yes/no - IF ( ALLOCATED(InData%UAOff_innerNode) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UAOff_innerNode upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UAOff_innerNode) ! UAOff_innerNode - END IF - Int_BufSz = Int_BufSz + 1 ! UAOff_outerNode allocated yes/no - IF ( ALLOCATED(InData%UAOff_outerNode) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UAOff_outerNode upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UAOff_outerNode) ! UAOff_outerNode - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! BEM_Mod - 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%chord) ) 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%chord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%chord,2), UBOUND(InData%chord,2) - DO i1 = LBOUND(InData%chord,1), UBOUND(InData%chord,1) - ReKiBuf(Re_Xferred) = InData%chord(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%airDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%kinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%skewWakeMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%aTol - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTipLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useHubLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useInduction, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTanInd, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useAIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%MomentumCorr, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numBladeNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numReIterations - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%maxIndIterations - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AFindx) ) 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%AFindx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) - DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) - IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zHub) ) 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%zHub,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zHub,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zHub,1), UBOUND(InData%zHub,1) - ReKiBuf(Re_Xferred) = InData%zHub(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zLocal) ) 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%zLocal,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zLocal,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zLocal,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zLocal,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%zLocal,2), UBOUND(InData%zLocal,2) - DO i1 = LBOUND(InData%zLocal,1), UBOUND(InData%zLocal,1) - ReKiBuf(Re_Xferred) = InData%zLocal(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zTip) ) 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%zTip,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zTip,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%zTip,1), UBOUND(InData%zTip,1) - ReKiBuf(Re_Xferred) = InData%zTip(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rLocal) ) 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%rLocal,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) - DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) - ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rTipFix) ) 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%rTipFix,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTipFix,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rTipFix,1), UBOUND(InData%rTipFix,1) - ReKiBuf(Re_Xferred) = InData%rTipFix(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yawCorrFactor - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UAOff_innerNode) ) 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%UAOff_innerNode,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UAOff_innerNode,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UAOff_innerNode,1), UBOUND(InData%UAOff_innerNode,1) - IntKiBuf(Int_Xferred) = InData%UAOff_innerNode(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UAOff_outerNode) ) 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%UAOff_outerNode,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UAOff_outerNode,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UAOff_outerNode,1), UBOUND(InData%UAOff_outerNode,1) - IntKiBuf(Int_Xferred) = InData%UAOff_outerNode(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BEM_Mod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_PackInitInput - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord 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%chord)) DEALLOCATE(OutData%chord) - ALLOCATE(OutData%chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chord,2), UBOUND(OutData%chord,2) - DO i1 = LBOUND(OutData%chord,1), UBOUND(OutData%chord,1) - OutData%chord(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%airDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%kinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%skewWakeMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%aTol = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%useTipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTipLoss) - Int_Xferred = Int_Xferred + 1 - OutData%useHubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useHubLoss) - Int_Xferred = Int_Xferred + 1 - OutData%useInduction = TRANSFER(IntKiBuf(Int_Xferred), OutData%useInduction) - Int_Xferred = Int_Xferred + 1 - OutData%useTanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTanInd) - Int_Xferred = Int_Xferred + 1 - OutData%useAIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useAIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%useTIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%MomentumCorr = TRANSFER(IntKiBuf(Int_Xferred), OutData%MomentumCorr) - Int_Xferred = Int_Xferred + 1 - OutData%numBladeNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%numReIterations = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%maxIndIterations = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx 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%AFindx)) DEALLOCATE(OutData%AFindx) - ALLOCATE(OutData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) - DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) - OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zHub 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%zHub)) DEALLOCATE(OutData%zHub) - ALLOCATE(OutData%zHub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zHub,1), UBOUND(OutData%zHub,1) - OutData%zHub(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zLocal 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%zLocal)) DEALLOCATE(OutData%zLocal) - ALLOCATE(OutData%zLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%zLocal,2), UBOUND(OutData%zLocal,2) - DO i1 = LBOUND(OutData%zLocal,1), UBOUND(OutData%zLocal,1) - OutData%zLocal(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zTip 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%zTip)) DEALLOCATE(OutData%zTip) - ALLOCATE(OutData%zTip(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zTip.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zTip,1), UBOUND(OutData%zTip,1) - OutData%zTip(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal 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%rLocal)) DEALLOCATE(OutData%rLocal) - ALLOCATE(OutData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) - DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) - OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rTipFix 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%rTipFix)) DEALLOCATE(OutData%rTipFix) - ALLOCATE(OutData%rTipFix(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rTipFix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rTipFix,1), UBOUND(OutData%rTipFix,1) - OutData%rTipFix(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%UAMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) - Int_Xferred = Int_Xferred + 1 - OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%tau1_const = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%yawCorrFactor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UAOff_innerNode 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%UAOff_innerNode)) DEALLOCATE(OutData%UAOff_innerNode) - ALLOCATE(OutData%UAOff_innerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_innerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UAOff_innerNode,1), UBOUND(OutData%UAOff_innerNode,1) - OutData%UAOff_innerNode(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UAOff_outerNode 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%UAOff_outerNode)) DEALLOCATE(OutData%UAOff_outerNode) - ALLOCATE(OutData%UAOff_outerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_outerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UAOff_outerNode,1), UBOUND(OutData%UAOff_outerNode,1) - OutData%UAOff_outerNode(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%BEM_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_UnPackInitInput - - SUBROUTINE BEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(BEMT_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyInitOutput' -! +subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_InitInputType), intent(in) :: SrcInitInputData + type(BEMT_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BEMT_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Version, DstInitOutputData%Version, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE BEMT_CopyInitOutput - - SUBROUTINE BEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(BEMT_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 = 'BEMT_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Version, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE BEMT_DestroyInitOutput - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Version - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Version - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Version - 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 - - 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 - - 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 BEMT_PackInitOutput - - SUBROUTINE BEMT_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(BEMT_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_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 - 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%Version, ErrStat2, ErrMsg2 ) ! Version - 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 BEMT_UnPackInitOutput - - SUBROUTINE BEMT_CopySkewWake_InputType( SrcSkewWake_InputTypeData, DstSkewWake_InputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_SkewWake_InputType), INTENT(IN) :: SrcSkewWake_InputTypeData - TYPE(BEMT_SkewWake_InputType), INTENT(INOUT) :: DstSkewWake_InputTypeData - 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 = 'BEMT_CopySkewWake_InputType' -! + ErrMsg = '' + if (allocated(SrcInitInputData%chord)) then + LB(1:2) = lbound(SrcInitInputData%chord) + UB(1:2) = ubound(SrcInitInputData%chord) + if (.not. allocated(DstInitInputData%chord)) then + allocate(DstInitInputData%chord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%chord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%chord = SrcInitInputData%chord + end if + DstInitInputData%numBlades = SrcInitInputData%numBlades + DstInitInputData%airDens = SrcInitInputData%airDens + DstInitInputData%kinVisc = SrcInitInputData%kinVisc + DstInitInputData%skewWakeMod = SrcInitInputData%skewWakeMod + DstInitInputData%aTol = SrcInitInputData%aTol + DstInitInputData%useTipLoss = SrcInitInputData%useTipLoss + DstInitInputData%useHubLoss = SrcInitInputData%useHubLoss + DstInitInputData%useInduction = SrcInitInputData%useInduction + DstInitInputData%useTanInd = SrcInitInputData%useTanInd + DstInitInputData%useAIDrag = SrcInitInputData%useAIDrag + DstInitInputData%useTIDrag = SrcInitInputData%useTIDrag + DstInitInputData%MomentumCorr = SrcInitInputData%MomentumCorr + DstInitInputData%numBladeNodes = SrcInitInputData%numBladeNodes + DstInitInputData%numReIterations = SrcInitInputData%numReIterations + DstInitInputData%maxIndIterations = SrcInitInputData%maxIndIterations + if (allocated(SrcInitInputData%AFindx)) then + LB(1:2) = lbound(SrcInitInputData%AFindx) + UB(1:2) = ubound(SrcInitInputData%AFindx) + if (.not. allocated(DstInitInputData%AFindx)) then + allocate(DstInitInputData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFindx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%AFindx = SrcInitInputData%AFindx + end if + if (allocated(SrcInitInputData%zHub)) then + LB(1:1) = lbound(SrcInitInputData%zHub) + UB(1:1) = ubound(SrcInitInputData%zHub) + if (.not. allocated(DstInitInputData%zHub)) then + allocate(DstInitInputData%zHub(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zHub.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%zHub = SrcInitInputData%zHub + end if + if (allocated(SrcInitInputData%zLocal)) then + LB(1:2) = lbound(SrcInitInputData%zLocal) + UB(1:2) = ubound(SrcInitInputData%zLocal) + if (.not. allocated(DstInitInputData%zLocal)) then + allocate(DstInitInputData%zLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zLocal.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%zLocal = SrcInitInputData%zLocal + end if + if (allocated(SrcInitInputData%zTip)) then + LB(1:1) = lbound(SrcInitInputData%zTip) + UB(1:1) = ubound(SrcInitInputData%zTip) + if (.not. allocated(DstInitInputData%zTip)) then + allocate(DstInitInputData%zTip(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zTip.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%zTip = SrcInitInputData%zTip + end if + if (allocated(SrcInitInputData%rLocal)) then + LB(1:2) = lbound(SrcInitInputData%rLocal) + UB(1:2) = ubound(SrcInitInputData%rLocal) + if (.not. allocated(DstInitInputData%rLocal)) then + allocate(DstInitInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rLocal.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%rLocal = SrcInitInputData%rLocal + end if + if (allocated(SrcInitInputData%rTipFix)) then + LB(1:1) = lbound(SrcInitInputData%rTipFix) + UB(1:1) = ubound(SrcInitInputData%rTipFix) + if (.not. allocated(DstInitInputData%rTipFix)) then + allocate(DstInitInputData%rTipFix(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rTipFix.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%rTipFix = SrcInitInputData%rTipFix + end if + DstInitInputData%UAMod = SrcInitInputData%UAMod + DstInitInputData%UA_Flag = SrcInitInputData%UA_Flag + DstInitInputData%Flookup = SrcInitInputData%Flookup + DstInitInputData%a_s = SrcInitInputData%a_s + DstInitInputData%DBEMT_Mod = SrcInitInputData%DBEMT_Mod + DstInitInputData%tau1_const = SrcInitInputData%tau1_const + DstInitInputData%yawCorrFactor = SrcInitInputData%yawCorrFactor + if (allocated(SrcInitInputData%UAOff_innerNode)) then + LB(1:1) = lbound(SrcInitInputData%UAOff_innerNode) + UB(1:1) = ubound(SrcInitInputData%UAOff_innerNode) + if (.not. allocated(DstInitInputData%UAOff_innerNode)) then + allocate(DstInitInputData%UAOff_innerNode(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_innerNode.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode + end if + if (allocated(SrcInitInputData%UAOff_outerNode)) then + LB(1:1) = lbound(SrcInitInputData%UAOff_outerNode) + UB(1:1) = ubound(SrcInitInputData%UAOff_outerNode) + if (.not. allocated(DstInitInputData%UAOff_outerNode)) then + allocate(DstInitInputData%UAOff_outerNode(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_outerNode.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%UAOff_outerNode = SrcInitInputData%UAOff_outerNode + end if + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%SumPrint = SrcInitInputData%SumPrint + DstInitInputData%BEM_Mod = SrcInitInputData%BEM_Mod +end subroutine + +subroutine BEMT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(BEMT_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstSkewWake_InputTypeData%v_qsw = SrcSkewWake_InputTypeData%v_qsw - DstSkewWake_InputTypeData%V0 = SrcSkewWake_InputTypeData%V0 - DstSkewWake_InputTypeData%R = SrcSkewWake_InputTypeData%R - END SUBROUTINE BEMT_CopySkewWake_InputType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroySkewWake_InputType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE BEMT_DestroySkewWake_InputType - - SUBROUTINE BEMT_PackSkewWake_InputType( 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(BEMT_SkewWake_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 = 'BEMT_PackSkewWake_InputType' - ! 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 + SIZE(InData%v_qsw) ! v_qsw - Re_BufSz = Re_BufSz + 1 ! V0 - Re_BufSz = Re_BufSz + 1 ! R - 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 i1 = LBOUND(InData%v_qsw,1), UBOUND(InData%v_qsw,1) - ReKiBuf(Re_Xferred) = InData%v_qsw(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%V0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%R - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BEMT_PackSkewWake_InputType - - SUBROUTINE BEMT_UnPackSkewWake_InputType( 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(BEMT_SkewWake_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackSkewWake_InputType' - ! 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 - i1_l = LBOUND(OutData%v_qsw,1) - i1_u = UBOUND(OutData%v_qsw,1) - DO i1 = LBOUND(OutData%v_qsw,1), UBOUND(OutData%v_qsw,1) - OutData%v_qsw(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%V0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%R = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BEMT_UnPackSkewWake_InputType - - SUBROUTINE BEMT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(BEMT_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyContState' -! + ErrMsg = '' + if (allocated(InitInputData%chord)) then + deallocate(InitInputData%chord) + end if + if (allocated(InitInputData%AFindx)) then + deallocate(InitInputData%AFindx) + end if + if (allocated(InitInputData%zHub)) then + deallocate(InitInputData%zHub) + end if + if (allocated(InitInputData%zLocal)) then + deallocate(InitInputData%zLocal) + end if + if (allocated(InitInputData%zTip)) then + deallocate(InitInputData%zTip) + end if + if (allocated(InitInputData%rLocal)) then + deallocate(InitInputData%rLocal) + end if + if (allocated(InitInputData%rTipFix)) then + deallocate(InitInputData%rTipFix) + end if + if (allocated(InitInputData%UAOff_innerNode)) then + deallocate(InitInputData%UAOff_innerNode) + end if + if (allocated(InitInputData%UAOff_outerNode)) then + deallocate(InitInputData%UAOff_outerNode) + end if +end subroutine + +subroutine BEMT_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%chord)) + if (allocated(InData%chord)) then + call RegPackBounds(Buf, 2, lbound(InData%chord), ubound(InData%chord)) + call RegPack(Buf, InData%chord) + end if + call RegPack(Buf, InData%numBlades) + call RegPack(Buf, InData%airDens) + call RegPack(Buf, InData%kinVisc) + call RegPack(Buf, InData%skewWakeMod) + call RegPack(Buf, InData%aTol) + call RegPack(Buf, InData%useTipLoss) + call RegPack(Buf, InData%useHubLoss) + call RegPack(Buf, InData%useInduction) + call RegPack(Buf, InData%useTanInd) + call RegPack(Buf, InData%useAIDrag) + call RegPack(Buf, InData%useTIDrag) + call RegPack(Buf, InData%MomentumCorr) + call RegPack(Buf, InData%numBladeNodes) + call RegPack(Buf, InData%numReIterations) + call RegPack(Buf, InData%maxIndIterations) + call RegPack(Buf, allocated(InData%AFindx)) + if (allocated(InData%AFindx)) then + call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) + call RegPack(Buf, InData%AFindx) + end if + call RegPack(Buf, allocated(InData%zHub)) + if (allocated(InData%zHub)) then + call RegPackBounds(Buf, 1, lbound(InData%zHub), ubound(InData%zHub)) + call RegPack(Buf, InData%zHub) + end if + call RegPack(Buf, allocated(InData%zLocal)) + if (allocated(InData%zLocal)) then + call RegPackBounds(Buf, 2, lbound(InData%zLocal), ubound(InData%zLocal)) + call RegPack(Buf, InData%zLocal) + end if + call RegPack(Buf, allocated(InData%zTip)) + if (allocated(InData%zTip)) then + call RegPackBounds(Buf, 1, lbound(InData%zTip), ubound(InData%zTip)) + call RegPack(Buf, InData%zTip) + end if + call RegPack(Buf, allocated(InData%rLocal)) + if (allocated(InData%rLocal)) then + call RegPackBounds(Buf, 2, lbound(InData%rLocal), ubound(InData%rLocal)) + call RegPack(Buf, InData%rLocal) + end if + call RegPack(Buf, allocated(InData%rTipFix)) + if (allocated(InData%rTipFix)) then + call RegPackBounds(Buf, 1, lbound(InData%rTipFix), ubound(InData%rTipFix)) + call RegPack(Buf, InData%rTipFix) + end if + call RegPack(Buf, InData%UAMod) + call RegPack(Buf, InData%UA_Flag) + call RegPack(Buf, InData%Flookup) + call RegPack(Buf, InData%a_s) + call RegPack(Buf, InData%DBEMT_Mod) + call RegPack(Buf, InData%tau1_const) + call RegPack(Buf, InData%yawCorrFactor) + call RegPack(Buf, allocated(InData%UAOff_innerNode)) + if (allocated(InData%UAOff_innerNode)) then + call RegPackBounds(Buf, 1, lbound(InData%UAOff_innerNode), ubound(InData%UAOff_innerNode)) + call RegPack(Buf, InData%UAOff_innerNode) + end if + call RegPack(Buf, allocated(InData%UAOff_outerNode)) + if (allocated(InData%UAOff_outerNode)) then + call RegPackBounds(Buf, 1, lbound(InData%UAOff_outerNode), ubound(InData%UAOff_outerNode)) + call RegPack(Buf, InData%UAOff_outerNode) + end if + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%SumPrint) + call RegPack(Buf, InData%BEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%chord)) deallocate(OutData%chord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%chord(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%chord) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%airDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%kinVisc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%skewWakeMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%aTol) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%useTipLoss) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%useHubLoss) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%useInduction) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%useTanInd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%useAIDrag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%useTIDrag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MomentumCorr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%numBladeNodes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%numReIterations) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%maxIndIterations) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFindx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFindx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%zHub)) deallocate(OutData%zHub) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%zHub(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%zHub) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%zLocal)) deallocate(OutData%zLocal) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%zLocal(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zLocal.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%zLocal) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%zTip)) deallocate(OutData%zTip) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%zTip(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zTip.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%zTip) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rLocal)) deallocate(OutData%rLocal) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rLocal(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rLocal) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rTipFix)) deallocate(OutData%rTipFix) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rTipFix(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rTipFix.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rTipFix) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%UAMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UA_Flag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Flookup) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%a_s) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tau1_const) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%yawCorrFactor) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%UAOff_innerNode)) deallocate(OutData%UAOff_innerNode) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UAOff_innerNode(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_innerNode.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UAOff_innerNode) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%UAOff_outerNode)) deallocate(OutData%UAOff_outerNode) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UAOff_outerNode(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_outerNode.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UAOff_outerNode) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_InitOutputType), intent(in) :: SrcInitOutputData + type(BEMT_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL UA_CopyContState( SrcContStateData%UA, DstContStateData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DBEMT_CopyContState( SrcContStateData%DBEMT, DstContStateData%DBEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstContStateData%V_w = SrcContStateData%V_w - END SUBROUTINE BEMT_CopyContState - - SUBROUTINE BEMT_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(BEMT_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 = 'BEMT_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL UA_DestroyContState( ContStateData%UA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyContState( ContStateData%DBEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE BEMT_DestroyContState - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DBEMT: size of buffers for each call to pack subtype - CALL DBEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, .TRUE. ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DBEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DBEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DBEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + SIZE(InData%V_w) ! V_w - 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 - - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 - CALL DBEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, OnlySize ) ! DBEMT - 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 - DO i1 = LBOUND(InData%V_w,1), UBOUND(InData%V_w,1) - DbKiBuf(Db_Xferred) = InData%V_w(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE BEMT_PackContState - - SUBROUTINE BEMT_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(BEMT_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_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 - 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 UA_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - 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) - 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 DBEMT_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%DBEMT, ErrStat2, ErrMsg2 ) ! DBEMT - 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) - i1_l = LBOUND(OutData%V_w,1) - i1_u = UBOUND(OutData%V_w,1) - DO i1 = LBOUND(OutData%V_w,1), UBOUND(OutData%V_w,1) - OutData%V_w(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE BEMT_UnPackContState - - SUBROUTINE BEMT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(BEMT_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 = 'BEMT_CopyDiscState' -! + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Version, DstInitOutputData%Version, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine BEMT_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(BEMT_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL UA_CopyDiscState( SrcDiscStateData%UA, DstDiscStateData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE BEMT_CopyDiscState - - SUBROUTINE BEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(BEMT_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 = 'BEMT_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL UA_DestroyDiscState( DiscStateData%UA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE BEMT_DestroyDiscState - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - 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 - - CALL UA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 BEMT_PackDiscState - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - 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 UA_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - 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 BEMT_UnPackDiscState - - SUBROUTINE BEMT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(BEMT_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) :: 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 = 'BEMT_CopyConstrState' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Version, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine BEMT_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(Buf, InData%Version) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%Version) ! Version +end subroutine + +subroutine BEMT_CopySkewWake_InputType(SrcSkewWake_InputTypeData, DstSkewWake_InputTypeData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_SkewWake_InputType), intent(in) :: SrcSkewWake_InputTypeData + type(BEMT_SkewWake_InputType), intent(inout) :: DstSkewWake_InputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_CopySkewWake_InputType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcConstrStateData%phi)) THEN - i1_l = LBOUND(SrcConstrStateData%phi,1) - i1_u = UBOUND(SrcConstrStateData%phi,1) - i2_l = LBOUND(SrcConstrStateData%phi,2) - i2_u = UBOUND(SrcConstrStateData%phi,2) - IF (.NOT. ALLOCATED(DstConstrStateData%phi)) THEN - ALLOCATE(DstConstrStateData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstConstrStateData%phi = SrcConstrStateData%phi -ENDIF - END SUBROUTINE BEMT_CopyConstrState - - SUBROUTINE BEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(BEMT_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 = 'BEMT_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ConstrStateData%phi)) THEN - DEALLOCATE(ConstrStateData%phi) -ENDIF - END SUBROUTINE BEMT_DestroyConstrState - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - Int_BufSz = Int_BufSz + 1 ! phi allocated yes/no - IF ( ALLOCATED(InData%phi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%phi) ! phi - 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%phi) ) 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%phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%phi,2), UBOUND(InData%phi,2) - DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) - ReKiBuf(Re_Xferred) = InData%phi(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_PackConstrState - - SUBROUTINE BEMT_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(BEMT_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) :: 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 = 'BEMT_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi 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%phi)) DEALLOCATE(OutData%phi) - ALLOCATE(OutData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%phi,2), UBOUND(OutData%phi,2) - DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) - OutData%phi(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_UnPackConstrState - - SUBROUTINE BEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(BEMT_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) :: 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 = 'BEMT_CopyOtherState' -! + ErrMsg = '' + DstSkewWake_InputTypeData%v_qsw = SrcSkewWake_InputTypeData%v_qsw + DstSkewWake_InputTypeData%V0 = SrcSkewWake_InputTypeData%V0 + DstSkewWake_InputTypeData%R = SrcSkewWake_InputTypeData%R +end subroutine + +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 + character(*), parameter :: RoutineName = 'BEMT_DestroySkewWake_InputType' ErrStat = ErrID_None - ErrMsg = "" - CALL UA_CopyOtherState( SrcOtherStateData%UA, DstOtherStateData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DBEMT_CopyOtherState( SrcOtherStateData%DBEMT, DstOtherStateData%DBEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOtherStateData%ValidPhi)) THEN - i1_l = LBOUND(SrcOtherStateData%ValidPhi,1) - i1_u = UBOUND(SrcOtherStateData%ValidPhi,1) - i2_l = LBOUND(SrcOtherStateData%ValidPhi,2) - i2_u = UBOUND(SrcOtherStateData%ValidPhi,2) - IF (.NOT. ALLOCATED(DstOtherStateData%ValidPhi)) THEN - ALLOCATE(DstOtherStateData%ValidPhi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%ValidPhi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%ValidPhi = SrcOtherStateData%ValidPhi -ENDIF - DstOtherStateData%nodesInitialized = SrcOtherStateData%nodesInitialized - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL BEMT_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DstOtherStateData%n = SrcOtherStateData%n - END SUBROUTINE BEMT_CopyOtherState - - SUBROUTINE BEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(BEMT_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 = 'BEMT_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL UA_DestroyOtherState( OtherStateData%UA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - END SUBROUTINE BEMT_DestroyOtherState - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DBEMT: size of buffers for each call to pack subtype - CALL DBEMT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, .TRUE. ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DBEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DBEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DBEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! ValidPhi allocated yes/no - IF ( ALLOCATED(InData%ValidPhi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ValidPhi upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ValidPhi) ! ValidPhi - END IF - Int_BufSz = Int_BufSz + 1 ! nodesInitialized - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL BEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 1 ! n - 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 - - CALL UA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 - CALL DBEMT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, OnlySize ) ! DBEMT - 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 - IF ( .NOT. ALLOCATED(InData%ValidPhi) ) 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%ValidPhi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidPhi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ValidPhi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidPhi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ValidPhi,2), UBOUND(InData%ValidPhi,2) - DO i1 = LBOUND(InData%ValidPhi,1), UBOUND(InData%ValidPhi,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%ValidPhi(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%nodesInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL BEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - 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 - IntKiBuf(Int_Xferred) = InData%n - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_PackOtherState - - SUBROUTINE BEMT_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(BEMT_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) :: 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 = 'BEMT_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 - 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 UA_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - 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) - 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 DBEMT_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%DBEMT, ErrStat2, ErrMsg2 ) ! DBEMT - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ValidPhi 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%ValidPhi)) DEALLOCATE(OutData%ValidPhi) - ALLOCATE(OutData%ValidPhi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidPhi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ValidPhi,2), UBOUND(OutData%ValidPhi,2) - DO i1 = LBOUND(OutData%ValidPhi,1), UBOUND(OutData%ValidPhi,1) - OutData%ValidPhi(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ValidPhi(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%nodesInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%nodesInitialized) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,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 BEMT_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - 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 - OutData%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_UnPackOtherState - - SUBROUTINE BEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(BEMT_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) :: 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_CopyMisc' -! + ErrMsg = '' +end subroutine + +subroutine BEMT_PackSkewWake_InputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_SkewWake_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackSkewWake_InputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%v_qsw) + call RegPack(Buf, InData%V0) + call RegPack(Buf, InData%R) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackSkewWake_InputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_SkewWake_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackSkewWake_InputType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%v_qsw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%V0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%R) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_ContinuousStateType), intent(in) :: SrcContStateData + type(BEMT_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%FirstWarn_Skew = SrcMiscData%FirstWarn_Skew - DstMiscData%FirstWarn_Phi = SrcMiscData%FirstWarn_Phi - DstMiscData%FirstWarn_BEMoff = SrcMiscData%FirstWarn_BEMoff - CALL UA_CopyMisc( SrcMiscData%UA, DstMiscData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DBEMT_CopyMisc( SrcMiscData%DBEMT, DstMiscData%DBEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL UA_CopyOutput( SrcMiscData%y_UA, DstMiscData%y_UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%u_UA)) THEN - i1_l = LBOUND(SrcMiscData%u_UA,1) - i1_u = UBOUND(SrcMiscData%u_UA,1) - i2_l = LBOUND(SrcMiscData%u_UA,2) - i2_u = UBOUND(SrcMiscData%u_UA,2) - i3_l = LBOUND(SrcMiscData%u_UA,3) - i3_u = UBOUND(SrcMiscData%u_UA,3) - IF (.NOT. ALLOCATED(DstMiscData%u_UA)) THEN - ALLOCATE(DstMiscData%u_UA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i3 = LBOUND(SrcMiscData%u_UA,3), UBOUND(SrcMiscData%u_UA,3) - DO i2 = LBOUND(SrcMiscData%u_UA,2), UBOUND(SrcMiscData%u_UA,2) - DO i1 = LBOUND(SrcMiscData%u_UA,1), UBOUND(SrcMiscData%u_UA,1) - CALL UA_CopyInput( SrcMiscData%u_UA(i1,i2,i3), DstMiscData%u_UA(i1,i2,i3), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO - ENDDO -ENDIF - DO i1 = LBOUND(SrcMiscData%u_DBEMT,1), UBOUND(SrcMiscData%u_DBEMT,1) - CALL DBEMT_CopyInput( SrcMiscData%u_DBEMT(i1), DstMiscData%u_DBEMT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMiscData%u_SkewWake,1), UBOUND(SrcMiscData%u_SkewWake,1) - CALL BEMT_Copyskewwake_inputtype( SrcMiscData%u_SkewWake(i1), DstMiscData%u_SkewWake(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -IF (ALLOCATED(SrcMiscData%TnInd_op)) THEN - i1_l = LBOUND(SrcMiscData%TnInd_op,1) - i1_u = UBOUND(SrcMiscData%TnInd_op,1) - i2_l = LBOUND(SrcMiscData%TnInd_op,2) - i2_u = UBOUND(SrcMiscData%TnInd_op,2) - IF (.NOT. ALLOCATED(DstMiscData%TnInd_op)) THEN - ALLOCATE(DstMiscData%TnInd_op(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TnInd_op.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%TnInd_op = SrcMiscData%TnInd_op -ENDIF -IF (ALLOCATED(SrcMiscData%AxInd_op)) THEN - i1_l = LBOUND(SrcMiscData%AxInd_op,1) - i1_u = UBOUND(SrcMiscData%AxInd_op,1) - i2_l = LBOUND(SrcMiscData%AxInd_op,2) - i2_u = UBOUND(SrcMiscData%AxInd_op,2) - IF (.NOT. ALLOCATED(DstMiscData%AxInd_op)) THEN - ALLOCATE(DstMiscData%AxInd_op(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AxInd_op.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AxInd_op = SrcMiscData%AxInd_op -ENDIF -IF (ALLOCATED(SrcMiscData%AxInduction)) THEN - i1_l = LBOUND(SrcMiscData%AxInduction,1) - i1_u = UBOUND(SrcMiscData%AxInduction,1) - i2_l = LBOUND(SrcMiscData%AxInduction,2) - i2_u = UBOUND(SrcMiscData%AxInduction,2) - IF (.NOT. ALLOCATED(DstMiscData%AxInduction)) THEN - ALLOCATE(DstMiscData%AxInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AxInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AxInduction = SrcMiscData%AxInduction -ENDIF -IF (ALLOCATED(SrcMiscData%TanInduction)) THEN - i1_l = LBOUND(SrcMiscData%TanInduction,1) - i1_u = UBOUND(SrcMiscData%TanInduction,1) - i2_l = LBOUND(SrcMiscData%TanInduction,2) - i2_u = UBOUND(SrcMiscData%TanInduction,2) - IF (.NOT. ALLOCATED(DstMiscData%TanInduction)) THEN - ALLOCATE(DstMiscData%TanInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TanInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%TanInduction = SrcMiscData%TanInduction -ENDIF - DstMiscData%UseFrozenWake = SrcMiscData%UseFrozenWake -IF (ALLOCATED(SrcMiscData%Rtip)) THEN - i1_l = LBOUND(SrcMiscData%Rtip,1) - i1_u = UBOUND(SrcMiscData%Rtip,1) - IF (.NOT. ALLOCATED(DstMiscData%Rtip)) THEN - ALLOCATE(DstMiscData%Rtip(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Rtip.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Rtip = SrcMiscData%Rtip -ENDIF -IF (ALLOCATED(SrcMiscData%phi)) THEN - i1_l = LBOUND(SrcMiscData%phi,1) - i1_u = UBOUND(SrcMiscData%phi,1) - i2_l = LBOUND(SrcMiscData%phi,2) - i2_u = UBOUND(SrcMiscData%phi,2) - IF (.NOT. ALLOCATED(DstMiscData%phi)) THEN - ALLOCATE(DstMiscData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%phi = SrcMiscData%phi -ENDIF -IF (ALLOCATED(SrcMiscData%chi)) THEN - i1_l = LBOUND(SrcMiscData%chi,1) - i1_u = UBOUND(SrcMiscData%chi,1) - i2_l = LBOUND(SrcMiscData%chi,2) - i2_u = UBOUND(SrcMiscData%chi,2) - IF (.NOT. ALLOCATED(DstMiscData%chi)) THEN - ALLOCATE(DstMiscData%chi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%chi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%chi = SrcMiscData%chi -ENDIF -IF (ALLOCATED(SrcMiscData%ValidPhi)) THEN - i1_l = LBOUND(SrcMiscData%ValidPhi,1) - i1_u = UBOUND(SrcMiscData%ValidPhi,1) - i2_l = LBOUND(SrcMiscData%ValidPhi,2) - i2_u = UBOUND(SrcMiscData%ValidPhi,2) - IF (.NOT. ALLOCATED(DstMiscData%ValidPhi)) THEN - ALLOCATE(DstMiscData%ValidPhi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ValidPhi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ValidPhi = SrcMiscData%ValidPhi -ENDIF - DstMiscData%BEM_weight = SrcMiscData%BEM_weight - END SUBROUTINE BEMT_CopyMisc - - SUBROUTINE BEMT_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(BEMT_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 = 'BEMT_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL UA_DestroyMisc( MiscData%UA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyMisc( MiscData%DBEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO -ENDDO - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -IF (ALLOCATED(MiscData%TnInd_op)) THEN - DEALLOCATE(MiscData%TnInd_op) -ENDIF -IF (ALLOCATED(MiscData%AxInd_op)) THEN - DEALLOCATE(MiscData%AxInd_op) -ENDIF -IF (ALLOCATED(MiscData%AxInduction)) THEN - DEALLOCATE(MiscData%AxInduction) -ENDIF -IF (ALLOCATED(MiscData%TanInduction)) THEN - DEALLOCATE(MiscData%TanInduction) -ENDIF -IF (ALLOCATED(MiscData%Rtip)) THEN - DEALLOCATE(MiscData%Rtip) -ENDIF -IF (ALLOCATED(MiscData%phi)) THEN - DEALLOCATE(MiscData%phi) -ENDIF -IF (ALLOCATED(MiscData%chi)) THEN - DEALLOCATE(MiscData%chi) -ENDIF -IF (ALLOCATED(MiscData%ValidPhi)) THEN - DEALLOCATE(MiscData%ValidPhi) -ENDIF - END SUBROUTINE BEMT_DestroyMisc - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 ! FirstWarn_Skew - Int_BufSz = Int_BufSz + 1 ! FirstWarn_Phi - Int_BufSz = Int_BufSz + 1 ! FirstWarn_BEMoff - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DBEMT: size of buffers for each call to pack subtype - CALL DBEMT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, .TRUE. ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DBEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DBEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DBEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_UA: size of buffers for each call to pack subtype - CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, .TRUE. ) ! y_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! u_UA allocated yes/no - IF ( ALLOCATED(InData%u_UA) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! u_UA upper/lower bounds for each dimension - DO i3 = LBOUND(InData%u_UA,3), UBOUND(InData%u_UA,3) - DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) - DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) - Int_BufSz = Int_BufSz + 3 ! u_UA: size of buffers for each call to pack subtype - CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2, .TRUE. ) ! u_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%u_DBEMT,1), UBOUND(InData%u_DBEMT,1) - Int_BufSz = Int_BufSz + 3 ! u_DBEMT: size of buffers for each call to pack subtype - CALL DBEMT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_DBEMT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_DBEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_DBEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_DBEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SkewWake - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SkewWake - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SkewWake - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 1 ! TnInd_op allocated yes/no - IF ( ALLOCATED(InData%TnInd_op) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TnInd_op upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TnInd_op) ! TnInd_op - END IF - Int_BufSz = Int_BufSz + 1 ! AxInd_op allocated yes/no - IF ( ALLOCATED(InData%AxInd_op) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AxInd_op upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxInd_op) ! AxInd_op - END IF - Int_BufSz = Int_BufSz + 1 ! AxInduction allocated yes/no - IF ( ALLOCATED(InData%AxInduction) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AxInduction upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxInduction) ! AxInduction - END IF - Int_BufSz = Int_BufSz + 1 ! TanInduction allocated yes/no - IF ( ALLOCATED(InData%TanInduction) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TanInduction upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TanInduction) ! TanInduction - END IF - Int_BufSz = Int_BufSz + 1 ! UseFrozenWake - Int_BufSz = Int_BufSz + 1 ! Rtip allocated yes/no - IF ( ALLOCATED(InData%Rtip) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Rtip upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Rtip) ! Rtip - END IF - Int_BufSz = Int_BufSz + 1 ! phi allocated yes/no - IF ( ALLOCATED(InData%phi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%phi) ! phi - END IF - Int_BufSz = Int_BufSz + 1 ! chi allocated yes/no - IF ( ALLOCATED(InData%chi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! chi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chi) ! chi - END IF - Int_BufSz = Int_BufSz + 1 ! ValidPhi allocated yes/no - IF ( ALLOCATED(InData%ValidPhi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ValidPhi upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ValidPhi) ! ValidPhi - END IF - Re_BufSz = Re_BufSz + 1 ! BEM_weight - 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) = TRANSFER(InData%FirstWarn_Skew, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_Phi, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_BEMoff, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 - CALL DBEMT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, OnlySize ) ! DBEMT - 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 - CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, OnlySize ) ! y_UA - 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 - IF ( .NOT. ALLOCATED(InData%u_UA) ) 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%u_UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%u_UA,3), UBOUND(InData%u_UA,3) - DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) - DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) - CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2, OnlySize ) ! u_UA - 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 DO - END DO - END IF - DO i1 = LBOUND(InData%u_DBEMT,1), UBOUND(InData%u_DBEMT,1) - CALL DBEMT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_DBEMT(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_DBEMT - 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 - 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 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 - IF ( .NOT. ALLOCATED(InData%TnInd_op) ) 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%TnInd_op,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TnInd_op,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TnInd_op,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TnInd_op,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TnInd_op,2), UBOUND(InData%TnInd_op,2) - DO i1 = LBOUND(InData%TnInd_op,1), UBOUND(InData%TnInd_op,1) - ReKiBuf(Re_Xferred) = InData%TnInd_op(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxInd_op) ) 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%AxInd_op,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInd_op,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxInd_op,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInd_op,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AxInd_op,2), UBOUND(InData%AxInd_op,2) - DO i1 = LBOUND(InData%AxInd_op,1), UBOUND(InData%AxInd_op,1) - ReKiBuf(Re_Xferred) = InData%AxInd_op(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxInduction) ) 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%AxInduction,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInduction,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxInduction,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInduction,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AxInduction,2), UBOUND(InData%AxInduction,2) - DO i1 = LBOUND(InData%AxInduction,1), UBOUND(InData%AxInduction,1) - ReKiBuf(Re_Xferred) = InData%AxInduction(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TanInduction) ) 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%TanInduction,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TanInduction,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TanInduction,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TanInduction,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TanInduction,2), UBOUND(InData%TanInduction,2) - DO i1 = LBOUND(InData%TanInduction,1), UBOUND(InData%TanInduction,1) - ReKiBuf(Re_Xferred) = InData%TanInduction(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseFrozenWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Rtip) ) 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%Rtip,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Rtip,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Rtip,1), UBOUND(InData%Rtip,1) - ReKiBuf(Re_Xferred) = InData%Rtip(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%phi) ) 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%phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%phi,2), UBOUND(InData%phi,2) - DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) - ReKiBuf(Re_Xferred) = InData%phi(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%chi) ) 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%chi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%chi,2), UBOUND(InData%chi,2) - DO i1 = LBOUND(InData%chi,1), UBOUND(InData%chi,1) - ReKiBuf(Re_Xferred) = InData%chi(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ValidPhi) ) 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%ValidPhi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidPhi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ValidPhi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidPhi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ValidPhi,2), UBOUND(InData%ValidPhi,2) - DO i1 = LBOUND(InData%ValidPhi,1), UBOUND(InData%ValidPhi,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%ValidPhi(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BEM_weight - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BEMT_PackMisc - - SUBROUTINE BEMT_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(BEMT_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) :: 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_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%FirstWarn_Skew = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_Skew) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn_Phi = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_Phi) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn_BEMoff = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_BEMoff) - 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 UA_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - 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) - 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 DBEMT_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%DBEMT, ErrStat2, ErrMsg2 ) ! DBEMT - 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) - 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 UA_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_UA, ErrStat2, ErrMsg2 ) ! y_UA - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_UA 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%u_UA)) DEALLOCATE(OutData%u_UA) - ALLOCATE(OutData%u_UA(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%u_UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%u_UA,3), UBOUND(OutData%u_UA,3) - DO i2 = LBOUND(OutData%u_UA,2), UBOUND(OutData%u_UA,2) - DO i1 = LBOUND(OutData%u_UA,1), UBOUND(OutData%u_UA,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 UA_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2 ) ! u_UA - 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 DO - END DO - END IF - i1_l = LBOUND(OutData%u_DBEMT,1) - i1_u = UBOUND(OutData%u_DBEMT,1) - DO i1 = LBOUND(OutData%u_DBEMT,1), UBOUND(OutData%u_DBEMT,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 DBEMT_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_DBEMT(i1), ErrStat2, ErrMsg2 ) ! u_DBEMT - 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 - i1_l = LBOUND(OutData%u_SkewWake,1) - i1_u = UBOUND(OutData%u_SkewWake,1) - DO i1 = LBOUND(OutData%u_SkewWake,1), UBOUND(OutData%u_SkewWake,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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TnInd_op 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%TnInd_op)) DEALLOCATE(OutData%TnInd_op) - ALLOCATE(OutData%TnInd_op(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TnInd_op.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TnInd_op,2), UBOUND(OutData%TnInd_op,2) - DO i1 = LBOUND(OutData%TnInd_op,1), UBOUND(OutData%TnInd_op,1) - OutData%TnInd_op(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxInd_op 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%AxInd_op)) DEALLOCATE(OutData%AxInd_op) - ALLOCATE(OutData%AxInd_op(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInd_op.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AxInd_op,2), UBOUND(OutData%AxInd_op,2) - DO i1 = LBOUND(OutData%AxInd_op,1), UBOUND(OutData%AxInd_op,1) - OutData%AxInd_op(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxInduction 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%AxInduction)) DEALLOCATE(OutData%AxInduction) - ALLOCATE(OutData%AxInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AxInduction,2), UBOUND(OutData%AxInduction,2) - DO i1 = LBOUND(OutData%AxInduction,1), UBOUND(OutData%AxInduction,1) - OutData%AxInduction(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TanInduction 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%TanInduction)) DEALLOCATE(OutData%TanInduction) - ALLOCATE(OutData%TanInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TanInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TanInduction,2), UBOUND(OutData%TanInduction,2) - DO i1 = LBOUND(OutData%TanInduction,1), UBOUND(OutData%TanInduction,1) - OutData%TanInduction(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%UseFrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseFrozenWake) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Rtip 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%Rtip)) DEALLOCATE(OutData%Rtip) - ALLOCATE(OutData%Rtip(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Rtip.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Rtip,1), UBOUND(OutData%Rtip,1) - OutData%Rtip(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi 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%phi)) DEALLOCATE(OutData%phi) - ALLOCATE(OutData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%phi,2), UBOUND(OutData%phi,2) - DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) - OutData%phi(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chi 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%chi)) DEALLOCATE(OutData%chi) - ALLOCATE(OutData%chi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chi,2), UBOUND(OutData%chi,2) - DO i1 = LBOUND(OutData%chi,1), UBOUND(OutData%chi,1) - OutData%chi(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ValidPhi 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%ValidPhi)) DEALLOCATE(OutData%ValidPhi) - ALLOCATE(OutData%ValidPhi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidPhi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ValidPhi,2), UBOUND(OutData%ValidPhi,2) - DO i1 = LBOUND(OutData%ValidPhi,1), UBOUND(OutData%ValidPhi,1) - OutData%ValidPhi(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ValidPhi(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%BEM_weight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BEMT_UnPackMisc - - SUBROUTINE BEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_ParameterType), INTENT(IN) :: SrcParamData - TYPE(BEMT_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 = 'BEMT_CopyParam' -! + ErrMsg = '' + call UA_CopyContState(SrcContStateData%UA, DstContStateData%UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DBEMT_CopyContState(SrcContStateData%DBEMT, DstContStateData%DBEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstContStateData%V_w = SrcContStateData%V_w +end subroutine + +subroutine BEMT_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(BEMT_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT -IF (ALLOCATED(SrcParamData%chord)) THEN - i1_l = LBOUND(SrcParamData%chord,1) - i1_u = UBOUND(SrcParamData%chord,1) - i2_l = LBOUND(SrcParamData%chord,2) - i2_u = UBOUND(SrcParamData%chord,2) - IF (.NOT. ALLOCATED(DstParamData%chord)) THEN - ALLOCATE(DstParamData%chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%chord = SrcParamData%chord -ENDIF - DstParamData%numBlades = SrcParamData%numBlades - DstParamData%airDens = SrcParamData%airDens - DstParamData%kinVisc = SrcParamData%kinVisc - DstParamData%skewWakeMod = SrcParamData%skewWakeMod - DstParamData%aTol = SrcParamData%aTol - DstParamData%useTipLoss = SrcParamData%useTipLoss - DstParamData%useHubLoss = SrcParamData%useHubLoss - DstParamData%useInduction = SrcParamData%useInduction - DstParamData%useTanInd = SrcParamData%useTanInd - DstParamData%useAIDrag = SrcParamData%useAIDrag - DstParamData%useTIDrag = SrcParamData%useTIDrag - DstParamData%numBladeNodes = SrcParamData%numBladeNodes - DstParamData%numReIterations = SrcParamData%numReIterations - DstParamData%maxIndIterations = SrcParamData%maxIndIterations -IF (ALLOCATED(SrcParamData%AFindx)) THEN - i1_l = LBOUND(SrcParamData%AFindx,1) - i1_u = UBOUND(SrcParamData%AFindx,1) - i2_l = LBOUND(SrcParamData%AFindx,2) - i2_u = UBOUND(SrcParamData%AFindx,2) - IF (.NOT. ALLOCATED(DstParamData%AFindx)) THEN - ALLOCATE(DstParamData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFindx = SrcParamData%AFindx -ENDIF -IF (ALLOCATED(SrcParamData%tipLossConst)) THEN - i1_l = LBOUND(SrcParamData%tipLossConst,1) - i1_u = UBOUND(SrcParamData%tipLossConst,1) - i2_l = LBOUND(SrcParamData%tipLossConst,2) - i2_u = UBOUND(SrcParamData%tipLossConst,2) - IF (.NOT. ALLOCATED(DstParamData%tipLossConst)) THEN - ALLOCATE(DstParamData%tipLossConst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%tipLossConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%tipLossConst = SrcParamData%tipLossConst -ENDIF -IF (ALLOCATED(SrcParamData%hubLossConst)) THEN - i1_l = LBOUND(SrcParamData%hubLossConst,1) - i1_u = UBOUND(SrcParamData%hubLossConst,1) - i2_l = LBOUND(SrcParamData%hubLossConst,2) - i2_u = UBOUND(SrcParamData%hubLossConst,2) - IF (.NOT. ALLOCATED(DstParamData%hubLossConst)) THEN - ALLOCATE(DstParamData%hubLossConst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%hubLossConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%hubLossConst = SrcParamData%hubLossConst -ENDIF -IF (ALLOCATED(SrcParamData%zHub)) THEN - i1_l = LBOUND(SrcParamData%zHub,1) - i1_u = UBOUND(SrcParamData%zHub,1) - IF (.NOT. ALLOCATED(DstParamData%zHub)) THEN - ALLOCATE(DstParamData%zHub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zHub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%zHub = SrcParamData%zHub -ENDIF - CALL UA_CopyParam( SrcParamData%UA, DstParamData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DBEMT_CopyParam( SrcParamData%DBEMT, DstParamData%DBEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%UA_Flag = SrcParamData%UA_Flag - DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod - DstParamData%yawCorrFactor = SrcParamData%yawCorrFactor -IF (ALLOCATED(SrcParamData%FixedInductions)) THEN - i1_l = LBOUND(SrcParamData%FixedInductions,1) - i1_u = UBOUND(SrcParamData%FixedInductions,1) - i2_l = LBOUND(SrcParamData%FixedInductions,2) - i2_u = UBOUND(SrcParamData%FixedInductions,2) - IF (.NOT. ALLOCATED(DstParamData%FixedInductions)) THEN - ALLOCATE(DstParamData%FixedInductions(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FixedInductions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FixedInductions = SrcParamData%FixedInductions -ENDIF - DstParamData%MomentumCorr = SrcParamData%MomentumCorr - DstParamData%rTipFixMax = SrcParamData%rTipFixMax -IF (ALLOCATED(SrcParamData%IntegrateWeight)) THEN - i1_l = LBOUND(SrcParamData%IntegrateWeight,1) - i1_u = UBOUND(SrcParamData%IntegrateWeight,1) - i2_l = LBOUND(SrcParamData%IntegrateWeight,2) - i2_u = UBOUND(SrcParamData%IntegrateWeight,2) - IF (.NOT. ALLOCATED(DstParamData%IntegrateWeight)) THEN - ALLOCATE(DstParamData%IntegrateWeight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IntegrateWeight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IntegrateWeight = SrcParamData%IntegrateWeight -ENDIF - DstParamData%lin_nx = SrcParamData%lin_nx - DstParamData%BEM_Mod = SrcParamData%BEM_Mod - END SUBROUTINE BEMT_CopyParam - - SUBROUTINE BEMT_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(BEMT_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 = 'BEMT_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%chord)) THEN - DEALLOCATE(ParamData%chord) -ENDIF -IF (ALLOCATED(ParamData%AFindx)) THEN - DEALLOCATE(ParamData%AFindx) -ENDIF -IF (ALLOCATED(ParamData%tipLossConst)) THEN - DEALLOCATE(ParamData%tipLossConst) -ENDIF -IF (ALLOCATED(ParamData%hubLossConst)) THEN - DEALLOCATE(ParamData%hubLossConst) -ENDIF -IF (ALLOCATED(ParamData%zHub)) THEN - DEALLOCATE(ParamData%zHub) -ENDIF - CALL UA_DestroyParam( ParamData%UA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyParam( ParamData%DBEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%FixedInductions)) THEN - DEALLOCATE(ParamData%FixedInductions) -ENDIF -IF (ALLOCATED(ParamData%IntegrateWeight)) THEN - DEALLOCATE(ParamData%IntegrateWeight) -ENDIF - END SUBROUTINE BEMT_DestroyParam - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 ! chord allocated yes/no - IF ( ALLOCATED(InData%chord) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! chord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord) ! chord - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Re_BufSz = Re_BufSz + 1 ! airDens - Re_BufSz = Re_BufSz + 1 ! kinVisc - Int_BufSz = Int_BufSz + 1 ! skewWakeMod - Re_BufSz = Re_BufSz + 1 ! aTol - Int_BufSz = Int_BufSz + 1 ! useTipLoss - Int_BufSz = Int_BufSz + 1 ! useHubLoss - Int_BufSz = Int_BufSz + 1 ! useInduction - Int_BufSz = Int_BufSz + 1 ! useTanInd - Int_BufSz = Int_BufSz + 1 ! useAIDrag - Int_BufSz = Int_BufSz + 1 ! useTIDrag - Int_BufSz = Int_BufSz + 1 ! numBladeNodes - Int_BufSz = Int_BufSz + 1 ! numReIterations - Int_BufSz = Int_BufSz + 1 ! maxIndIterations - Int_BufSz = Int_BufSz + 1 ! AFindx allocated yes/no - IF ( ALLOCATED(InData%AFindx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFindx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AFindx) ! AFindx - END IF - Int_BufSz = Int_BufSz + 1 ! tipLossConst allocated yes/no - IF ( ALLOCATED(InData%tipLossConst) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tipLossConst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tipLossConst) ! tipLossConst - END IF - Int_BufSz = Int_BufSz + 1 ! hubLossConst allocated yes/no - IF ( ALLOCATED(InData%hubLossConst) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! hubLossConst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%hubLossConst) ! hubLossConst - END IF - Int_BufSz = Int_BufSz + 1 ! zHub allocated yes/no - IF ( ALLOCATED(InData%zHub) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zHub upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zHub) ! zHub - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DBEMT: size of buffers for each call to pack subtype - CALL DBEMT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, .TRUE. ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DBEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DBEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DBEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! UA_Flag - Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod - Re_BufSz = Re_BufSz + 1 ! yawCorrFactor - Int_BufSz = Int_BufSz + 1 ! FixedInductions allocated yes/no - IF ( ALLOCATED(InData%FixedInductions) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FixedInductions upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FixedInductions) ! FixedInductions - END IF - Int_BufSz = Int_BufSz + 1 ! MomentumCorr - Re_BufSz = Re_BufSz + 1 ! rTipFixMax - Int_BufSz = Int_BufSz + 1 ! IntegrateWeight allocated yes/no - IF ( ALLOCATED(InData%IntegrateWeight) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! IntegrateWeight upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%IntegrateWeight) ! IntegrateWeight - END IF - Int_BufSz = Int_BufSz + 1 ! lin_nx - Int_BufSz = Int_BufSz + 1 ! BEM_Mod - 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 - IF ( .NOT. ALLOCATED(InData%chord) ) 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%chord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%chord,2), UBOUND(InData%chord,2) - DO i1 = LBOUND(InData%chord,1), UBOUND(InData%chord,1) - ReKiBuf(Re_Xferred) = InData%chord(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%airDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%kinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%skewWakeMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%aTol - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTipLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useHubLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useInduction, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTanInd, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useAIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numBladeNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numReIterations - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%maxIndIterations - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AFindx) ) 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%AFindx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) - DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) - IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tipLossConst) ) 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%tipLossConst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tipLossConst,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tipLossConst,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tipLossConst,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tipLossConst,2), UBOUND(InData%tipLossConst,2) - DO i1 = LBOUND(InData%tipLossConst,1), UBOUND(InData%tipLossConst,1) - ReKiBuf(Re_Xferred) = InData%tipLossConst(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%hubLossConst) ) 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%hubLossConst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hubLossConst,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%hubLossConst,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hubLossConst,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%hubLossConst,2), UBOUND(InData%hubLossConst,2) - DO i1 = LBOUND(InData%hubLossConst,1), UBOUND(InData%hubLossConst,1) - ReKiBuf(Re_Xferred) = InData%hubLossConst(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zHub) ) 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%zHub,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zHub,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zHub,1), UBOUND(InData%zHub,1) - ReKiBuf(Re_Xferred) = InData%zHub(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 - CALL DBEMT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, OnlySize ) ! DBEMT - 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) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yawCorrFactor - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FixedInductions) ) 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%FixedInductions,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FixedInductions,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FixedInductions,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FixedInductions,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FixedInductions,2), UBOUND(InData%FixedInductions,2) - DO i1 = LBOUND(InData%FixedInductions,1), UBOUND(InData%FixedInductions,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%FixedInductions(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%MomentumCorr, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rTipFixMax - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%IntegrateWeight) ) 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%IntegrateWeight,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IntegrateWeight,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IntegrateWeight,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IntegrateWeight,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%IntegrateWeight,2), UBOUND(InData%IntegrateWeight,2) - DO i1 = LBOUND(InData%IntegrateWeight,1), UBOUND(InData%IntegrateWeight,1) - ReKiBuf(Re_Xferred) = InData%IntegrateWeight(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%lin_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BEM_Mod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_PackParam - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord 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%chord)) DEALLOCATE(OutData%chord) - ALLOCATE(OutData%chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chord,2), UBOUND(OutData%chord,2) - DO i1 = LBOUND(OutData%chord,1), UBOUND(OutData%chord,1) - OutData%chord(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%airDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%kinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%skewWakeMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%aTol = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%useTipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTipLoss) - Int_Xferred = Int_Xferred + 1 - OutData%useHubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useHubLoss) - Int_Xferred = Int_Xferred + 1 - OutData%useInduction = TRANSFER(IntKiBuf(Int_Xferred), OutData%useInduction) - Int_Xferred = Int_Xferred + 1 - OutData%useTanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTanInd) - Int_Xferred = Int_Xferred + 1 - OutData%useAIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useAIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%useTIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%numBladeNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%numReIterations = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%maxIndIterations = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx 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%AFindx)) DEALLOCATE(OutData%AFindx) - ALLOCATE(OutData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) - DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) - OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tipLossConst 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%tipLossConst)) DEALLOCATE(OutData%tipLossConst) - ALLOCATE(OutData%tipLossConst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tipLossConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tipLossConst,2), UBOUND(OutData%tipLossConst,2) - DO i1 = LBOUND(OutData%tipLossConst,1), UBOUND(OutData%tipLossConst,1) - OutData%tipLossConst(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hubLossConst 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%hubLossConst)) DEALLOCATE(OutData%hubLossConst) - ALLOCATE(OutData%hubLossConst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%hubLossConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%hubLossConst,2), UBOUND(OutData%hubLossConst,2) - DO i1 = LBOUND(OutData%hubLossConst,1), UBOUND(OutData%hubLossConst,1) - OutData%hubLossConst(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zHub 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%zHub)) DEALLOCATE(OutData%zHub) - ALLOCATE(OutData%zHub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zHub,1), UBOUND(OutData%zHub,1) - OutData%zHub(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 UA_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - 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) - 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 DBEMT_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%DBEMT, ErrStat2, ErrMsg2 ) ! DBEMT - 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%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) - Int_Xferred = Int_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%yawCorrFactor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FixedInductions 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%FixedInductions)) DEALLOCATE(OutData%FixedInductions) - ALLOCATE(OutData%FixedInductions(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FixedInductions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FixedInductions,2), UBOUND(OutData%FixedInductions,2) - DO i1 = LBOUND(OutData%FixedInductions,1), UBOUND(OutData%FixedInductions,1) - OutData%FixedInductions(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%FixedInductions(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%MomentumCorr = TRANSFER(IntKiBuf(Int_Xferred), OutData%MomentumCorr) - Int_Xferred = Int_Xferred + 1 - OutData%rTipFixMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IntegrateWeight 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%IntegrateWeight)) DEALLOCATE(OutData%IntegrateWeight) - ALLOCATE(OutData%IntegrateWeight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IntegrateWeight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%IntegrateWeight,2), UBOUND(OutData%IntegrateWeight,2) - DO i1 = LBOUND(OutData%IntegrateWeight,1), UBOUND(OutData%IntegrateWeight,1) - OutData%IntegrateWeight(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%lin_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BEM_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_UnPackParam - - SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_InputType), INTENT(IN) :: SrcInputData - TYPE(BEMT_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) :: 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 = 'BEMT_CopyInput' -! + ErrMsg = '' + call UA_DestroyContState(ContStateData%UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DBEMT_DestroyContState(ContStateData%DBEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine BEMT_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call UA_PackContState(Buf, InData%UA) + call DBEMT_PackContState(Buf, InData%DBEMT) + call RegPack(Buf, InData%V_w) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call UA_UnpackContState(Buf, OutData%UA) ! UA + call DBEMT_UnpackContState(Buf, OutData%DBEMT) ! DBEMT + call RegUnpack(Buf, OutData%V_w) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_DiscreteStateType), intent(in) :: SrcDiscStateData + type(BEMT_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%theta)) THEN - i1_l = LBOUND(SrcInputData%theta,1) - i1_u = UBOUND(SrcInputData%theta,1) - i2_l = LBOUND(SrcInputData%theta,2) - i2_u = UBOUND(SrcInputData%theta,2) - IF (.NOT. ALLOCATED(DstInputData%theta)) THEN - ALLOCATE(DstInputData%theta(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%theta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%theta = SrcInputData%theta -ENDIF - DstInputData%chi0 = SrcInputData%chi0 - DstInputData%psiSkewOffset = SrcInputData%psiSkewOffset -IF (ALLOCATED(SrcInputData%psi)) THEN - i1_l = LBOUND(SrcInputData%psi,1) - i1_u = UBOUND(SrcInputData%psi,1) - IF (.NOT. ALLOCATED(DstInputData%psi)) THEN - ALLOCATE(DstInputData%psi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%psi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%psi = SrcInputData%psi -ENDIF - DstInputData%omega = SrcInputData%omega - DstInputData%TSR = SrcInputData%TSR -IF (ALLOCATED(SrcInputData%Vx)) THEN - i1_l = LBOUND(SrcInputData%Vx,1) - i1_u = UBOUND(SrcInputData%Vx,1) - i2_l = LBOUND(SrcInputData%Vx,2) - i2_u = UBOUND(SrcInputData%Vx,2) - IF (.NOT. ALLOCATED(DstInputData%Vx)) THEN - ALLOCATE(DstInputData%Vx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vx = SrcInputData%Vx -ENDIF -IF (ALLOCATED(SrcInputData%Vy)) THEN - i1_l = LBOUND(SrcInputData%Vy,1) - i1_u = UBOUND(SrcInputData%Vy,1) - i2_l = LBOUND(SrcInputData%Vy,2) - i2_u = UBOUND(SrcInputData%Vy,2) - IF (.NOT. ALLOCATED(DstInputData%Vy)) THEN - ALLOCATE(DstInputData%Vy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vy = SrcInputData%Vy -ENDIF -IF (ALLOCATED(SrcInputData%Vz)) THEN - i1_l = LBOUND(SrcInputData%Vz,1) - i1_u = UBOUND(SrcInputData%Vz,1) - i2_l = LBOUND(SrcInputData%Vz,2) - i2_u = UBOUND(SrcInputData%Vz,2) - IF (.NOT. ALLOCATED(DstInputData%Vz)) THEN - ALLOCATE(DstInputData%Vz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vz = SrcInputData%Vz -ENDIF -IF (ALLOCATED(SrcInputData%omega_z)) THEN - i1_l = LBOUND(SrcInputData%omega_z,1) - i1_u = UBOUND(SrcInputData%omega_z,1) - i2_l = LBOUND(SrcInputData%omega_z,2) - i2_u = UBOUND(SrcInputData%omega_z,2) - IF (.NOT. ALLOCATED(DstInputData%omega_z)) THEN - ALLOCATE(DstInputData%omega_z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%omega_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%omega_z = SrcInputData%omega_z -ENDIF -IF (ALLOCATED(SrcInputData%xVelCorr)) THEN - i1_l = LBOUND(SrcInputData%xVelCorr,1) - i1_u = UBOUND(SrcInputData%xVelCorr,1) - i2_l = LBOUND(SrcInputData%xVelCorr,2) - i2_u = UBOUND(SrcInputData%xVelCorr,2) - IF (.NOT. ALLOCATED(DstInputData%xVelCorr)) THEN - ALLOCATE(DstInputData%xVelCorr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xVelCorr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%xVelCorr = SrcInputData%xVelCorr -ENDIF -IF (ALLOCATED(SrcInputData%rLocal)) THEN - i1_l = LBOUND(SrcInputData%rLocal,1) - i1_u = UBOUND(SrcInputData%rLocal,1) - i2_l = LBOUND(SrcInputData%rLocal,2) - i2_u = UBOUND(SrcInputData%rLocal,2) - IF (.NOT. ALLOCATED(DstInputData%rLocal)) THEN - ALLOCATE(DstInputData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%rLocal = SrcInputData%rLocal -ENDIF - DstInputData%Un_disk = SrcInputData%Un_disk - DstInputData%V0 = SrcInputData%V0 - DstInputData%x_hat_disk = SrcInputData%x_hat_disk -IF (ALLOCATED(SrcInputData%UserProp)) THEN - i1_l = LBOUND(SrcInputData%UserProp,1) - i1_u = UBOUND(SrcInputData%UserProp,1) - i2_l = LBOUND(SrcInputData%UserProp,2) - i2_u = UBOUND(SrcInputData%UserProp,2) - IF (.NOT. ALLOCATED(DstInputData%UserProp)) THEN - ALLOCATE(DstInputData%UserProp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%UserProp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%UserProp = SrcInputData%UserProp -ENDIF -IF (ALLOCATED(SrcInputData%CantAngle)) THEN - i1_l = LBOUND(SrcInputData%CantAngle,1) - i1_u = UBOUND(SrcInputData%CantAngle,1) - i2_l = LBOUND(SrcInputData%CantAngle,2) - i2_u = UBOUND(SrcInputData%CantAngle,2) - IF (.NOT. ALLOCATED(DstInputData%CantAngle)) THEN - ALLOCATE(DstInputData%CantAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CantAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CantAngle = SrcInputData%CantAngle -ENDIF -IF (ALLOCATED(SrcInputData%drdz)) THEN - i1_l = LBOUND(SrcInputData%drdz,1) - i1_u = UBOUND(SrcInputData%drdz,1) - i2_l = LBOUND(SrcInputData%drdz,2) - i2_u = UBOUND(SrcInputData%drdz,2) - IF (.NOT. ALLOCATED(DstInputData%drdz)) THEN - ALLOCATE(DstInputData%drdz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%drdz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%drdz = SrcInputData%drdz -ENDIF -IF (ALLOCATED(SrcInputData%toeAngle)) THEN - i1_l = LBOUND(SrcInputData%toeAngle,1) - i1_u = UBOUND(SrcInputData%toeAngle,1) - i2_l = LBOUND(SrcInputData%toeAngle,2) - i2_u = UBOUND(SrcInputData%toeAngle,2) - IF (.NOT. ALLOCATED(DstInputData%toeAngle)) THEN - ALLOCATE(DstInputData%toeAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toeAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%toeAngle = SrcInputData%toeAngle -ENDIF - END SUBROUTINE BEMT_CopyInput - - SUBROUTINE BEMT_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(BEMT_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 = 'BEMT_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%theta)) THEN - DEALLOCATE(InputData%theta) -ENDIF -IF (ALLOCATED(InputData%psi)) THEN - DEALLOCATE(InputData%psi) -ENDIF -IF (ALLOCATED(InputData%Vx)) THEN - DEALLOCATE(InputData%Vx) -ENDIF -IF (ALLOCATED(InputData%Vy)) THEN - DEALLOCATE(InputData%Vy) -ENDIF -IF (ALLOCATED(InputData%Vz)) THEN - DEALLOCATE(InputData%Vz) -ENDIF -IF (ALLOCATED(InputData%omega_z)) THEN - DEALLOCATE(InputData%omega_z) -ENDIF -IF (ALLOCATED(InputData%xVelCorr)) THEN - DEALLOCATE(InputData%xVelCorr) -ENDIF -IF (ALLOCATED(InputData%rLocal)) THEN - DEALLOCATE(InputData%rLocal) -ENDIF -IF (ALLOCATED(InputData%UserProp)) THEN - DEALLOCATE(InputData%UserProp) -ENDIF -IF (ALLOCATED(InputData%CantAngle)) THEN - DEALLOCATE(InputData%CantAngle) -ENDIF -IF (ALLOCATED(InputData%drdz)) THEN - DEALLOCATE(InputData%drdz) -ENDIF -IF (ALLOCATED(InputData%toeAngle)) THEN - DEALLOCATE(InputData%toeAngle) -ENDIF - END SUBROUTINE BEMT_DestroyInput - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - Int_BufSz = Int_BufSz + 1 ! theta allocated yes/no - IF ( ALLOCATED(InData%theta) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! theta upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%theta) ! theta - END IF - Re_BufSz = Re_BufSz + 1 ! chi0 - Re_BufSz = Re_BufSz + 1 ! psiSkewOffset - Int_BufSz = Int_BufSz + 1 ! psi allocated yes/no - IF ( ALLOCATED(InData%psi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! psi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%psi) ! psi - END IF - Re_BufSz = Re_BufSz + 1 ! omega - Re_BufSz = Re_BufSz + 1 ! TSR - Int_BufSz = Int_BufSz + 1 ! Vx allocated yes/no - IF ( ALLOCATED(InData%Vx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx) ! Vx - END IF - Int_BufSz = Int_BufSz + 1 ! Vy allocated yes/no - IF ( ALLOCATED(InData%Vy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vy) ! Vy - END IF - Int_BufSz = Int_BufSz + 1 ! Vz allocated yes/no - IF ( ALLOCATED(InData%Vz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vz) ! Vz - END IF - Int_BufSz = Int_BufSz + 1 ! omega_z allocated yes/no - IF ( ALLOCATED(InData%omega_z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! omega_z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%omega_z) ! omega_z - END IF - Int_BufSz = Int_BufSz + 1 ! xVelCorr allocated yes/no - IF ( ALLOCATED(InData%xVelCorr) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xVelCorr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xVelCorr) ! xVelCorr - END IF - Int_BufSz = Int_BufSz + 1 ! rLocal allocated yes/no - IF ( ALLOCATED(InData%rLocal) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rLocal upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rLocal) ! rLocal - END IF - Re_BufSz = Re_BufSz + 1 ! Un_disk - Re_BufSz = Re_BufSz + SIZE(InData%V0) ! V0 - Db_BufSz = Db_BufSz + SIZE(InData%x_hat_disk) ! x_hat_disk - Int_BufSz = Int_BufSz + 1 ! UserProp allocated yes/no - IF ( ALLOCATED(InData%UserProp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! UserProp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UserProp) ! UserProp - END IF - Int_BufSz = Int_BufSz + 1 ! CantAngle allocated yes/no - IF ( ALLOCATED(InData%CantAngle) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CantAngle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CantAngle) ! CantAngle - END IF - Int_BufSz = Int_BufSz + 1 ! drdz allocated yes/no - IF ( ALLOCATED(InData%drdz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! drdz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%drdz) ! drdz - END IF - Int_BufSz = Int_BufSz + 1 ! toeAngle allocated yes/no - IF ( ALLOCATED(InData%toeAngle) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! toeAngle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toeAngle) ! toeAngle - 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%theta) ) 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%theta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%theta,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%theta,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%theta,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%theta,2), UBOUND(InData%theta,2) - DO i1 = LBOUND(InData%theta,1), UBOUND(InData%theta,1) - ReKiBuf(Re_Xferred) = InData%theta(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%chi0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%psiSkewOffset - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%psi) ) 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%psi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%psi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%psi,1), UBOUND(InData%psi,1) - ReKiBuf(Re_Xferred) = InData%psi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%omega - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TSR - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Vx) ) 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%Vx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vx,2), UBOUND(InData%Vx,2) - DO i1 = LBOUND(InData%Vx,1), UBOUND(InData%Vx,1) - ReKiBuf(Re_Xferred) = InData%Vx(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vy) ) 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%Vy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vy,2), UBOUND(InData%Vy,2) - DO i1 = LBOUND(InData%Vy,1), UBOUND(InData%Vy,1) - ReKiBuf(Re_Xferred) = InData%Vy(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vz) ) 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%Vz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vz,2), UBOUND(InData%Vz,2) - DO i1 = LBOUND(InData%Vz,1), UBOUND(InData%Vz,1) - ReKiBuf(Re_Xferred) = InData%Vz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%omega_z) ) 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%omega_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_z,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%omega_z,2), UBOUND(InData%omega_z,2) - DO i1 = LBOUND(InData%omega_z,1), UBOUND(InData%omega_z,1) - ReKiBuf(Re_Xferred) = InData%omega_z(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xVelCorr) ) 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%xVelCorr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xVelCorr,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xVelCorr,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xVelCorr,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xVelCorr,2), UBOUND(InData%xVelCorr,2) - DO i1 = LBOUND(InData%xVelCorr,1), UBOUND(InData%xVelCorr,1) - ReKiBuf(Re_Xferred) = InData%xVelCorr(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rLocal) ) 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%rLocal,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) - DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) - ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Un_disk - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%V0,1), UBOUND(InData%V0,1) - ReKiBuf(Re_Xferred) = InData%V0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%x_hat_disk,1), UBOUND(InData%x_hat_disk,1) - DbKiBuf(Db_Xferred) = InData%x_hat_disk(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%UserProp) ) 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%UserProp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UserProp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%UserProp,2), UBOUND(InData%UserProp,2) - DO i1 = LBOUND(InData%UserProp,1), UBOUND(InData%UserProp,1) - ReKiBuf(Re_Xferred) = InData%UserProp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CantAngle) ) 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%CantAngle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CantAngle,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CantAngle,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CantAngle,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CantAngle,2), UBOUND(InData%CantAngle,2) - DO i1 = LBOUND(InData%CantAngle,1), UBOUND(InData%CantAngle,1) - ReKiBuf(Re_Xferred) = InData%CantAngle(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%drdz) ) 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%drdz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%drdz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%drdz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%drdz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%drdz,2), UBOUND(InData%drdz,2) - DO i1 = LBOUND(InData%drdz,1), UBOUND(InData%drdz,1) - ReKiBuf(Re_Xferred) = InData%drdz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%toeAngle) ) 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%toeAngle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toeAngle,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toeAngle,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toeAngle,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%toeAngle,2), UBOUND(InData%toeAngle,2) - DO i1 = LBOUND(InData%toeAngle,1), UBOUND(InData%toeAngle,1) - ReKiBuf(Re_Xferred) = InData%toeAngle(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_PackInput - - SUBROUTINE BEMT_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(BEMT_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) :: 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 = 'BEMT_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! theta 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%theta)) DEALLOCATE(OutData%theta) - ALLOCATE(OutData%theta(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%theta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%theta,2), UBOUND(OutData%theta,2) - DO i1 = LBOUND(OutData%theta,1), UBOUND(OutData%theta,1) - OutData%theta(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%chi0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%psiSkewOffset = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! psi 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%psi)) DEALLOCATE(OutData%psi) - ALLOCATE(OutData%psi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%psi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%psi,1), UBOUND(OutData%psi,1) - OutData%psi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%omega = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TSR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx 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%Vx)) DEALLOCATE(OutData%Vx) - ALLOCATE(OutData%Vx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vx,2), UBOUND(OutData%Vx,2) - DO i1 = LBOUND(OutData%Vx,1), UBOUND(OutData%Vx,1) - OutData%Vx(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vy 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%Vy)) DEALLOCATE(OutData%Vy) - ALLOCATE(OutData%Vy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vy,2), UBOUND(OutData%Vy,2) - DO i1 = LBOUND(OutData%Vy,1), UBOUND(OutData%Vy,1) - OutData%Vy(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vz 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%Vz)) DEALLOCATE(OutData%Vz) - ALLOCATE(OutData%Vz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vz,2), UBOUND(OutData%Vz,2) - DO i1 = LBOUND(OutData%Vz,1), UBOUND(OutData%Vz,1) - OutData%Vz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omega_z 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%omega_z)) DEALLOCATE(OutData%omega_z) - ALLOCATE(OutData%omega_z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%omega_z,2), UBOUND(OutData%omega_z,2) - DO i1 = LBOUND(OutData%omega_z,1), UBOUND(OutData%omega_z,1) - OutData%omega_z(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xVelCorr 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%xVelCorr)) DEALLOCATE(OutData%xVelCorr) - ALLOCATE(OutData%xVelCorr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xVelCorr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xVelCorr,2), UBOUND(OutData%xVelCorr,2) - DO i1 = LBOUND(OutData%xVelCorr,1), UBOUND(OutData%xVelCorr,1) - OutData%xVelCorr(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal 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%rLocal)) DEALLOCATE(OutData%rLocal) - ALLOCATE(OutData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) - DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) - OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%Un_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%V0,1) - i1_u = UBOUND(OutData%V0,1) - DO i1 = LBOUND(OutData%V0,1), UBOUND(OutData%V0,1) - OutData%V0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%x_hat_disk,1) - i1_u = UBOUND(OutData%x_hat_disk,1) - DO i1 = LBOUND(OutData%x_hat_disk,1), UBOUND(OutData%x_hat_disk,1) - OutData%x_hat_disk(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserProp 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%UserProp)) DEALLOCATE(OutData%UserProp) - ALLOCATE(OutData%UserProp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%UserProp,2), UBOUND(OutData%UserProp,2) - DO i1 = LBOUND(OutData%UserProp,1), UBOUND(OutData%UserProp,1) - OutData%UserProp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CantAngle 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%CantAngle)) DEALLOCATE(OutData%CantAngle) - ALLOCATE(OutData%CantAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CantAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CantAngle,2), UBOUND(OutData%CantAngle,2) - DO i1 = LBOUND(OutData%CantAngle,1), UBOUND(OutData%CantAngle,1) - OutData%CantAngle(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! drdz 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%drdz)) DEALLOCATE(OutData%drdz) - ALLOCATE(OutData%drdz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%drdz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%drdz,2), UBOUND(OutData%drdz,2) - DO i1 = LBOUND(OutData%drdz,1), UBOUND(OutData%drdz,1) - OutData%drdz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toeAngle 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%toeAngle)) DEALLOCATE(OutData%toeAngle) - ALLOCATE(OutData%toeAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toeAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%toeAngle,2), UBOUND(OutData%toeAngle,2) - DO i1 = LBOUND(OutData%toeAngle,1), UBOUND(OutData%toeAngle,1) - OutData%toeAngle(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_UnPackInput - - SUBROUTINE BEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_OutputType), INTENT(IN) :: SrcOutputData - TYPE(BEMT_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyOutput' -! + ErrMsg = '' + call UA_CopyDiscState(SrcDiscStateData%UA, DstDiscStateData%UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine BEMT_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(BEMT_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%Vrel)) THEN - i1_l = LBOUND(SrcOutputData%Vrel,1) - i1_u = UBOUND(SrcOutputData%Vrel,1) - i2_l = LBOUND(SrcOutputData%Vrel,2) - i2_u = UBOUND(SrcOutputData%Vrel,2) - IF (.NOT. ALLOCATED(DstOutputData%Vrel)) THEN - ALLOCATE(DstOutputData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vrel = SrcOutputData%Vrel -ENDIF -IF (ALLOCATED(SrcOutputData%phi)) THEN - i1_l = LBOUND(SrcOutputData%phi,1) - i1_u = UBOUND(SrcOutputData%phi,1) - i2_l = LBOUND(SrcOutputData%phi,2) - i2_u = UBOUND(SrcOutputData%phi,2) - IF (.NOT. ALLOCATED(DstOutputData%phi)) THEN - ALLOCATE(DstOutputData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%phi = SrcOutputData%phi -ENDIF -IF (ALLOCATED(SrcOutputData%axInduction)) THEN - i1_l = LBOUND(SrcOutputData%axInduction,1) - i1_u = UBOUND(SrcOutputData%axInduction,1) - i2_l = LBOUND(SrcOutputData%axInduction,2) - i2_u = UBOUND(SrcOutputData%axInduction,2) - IF (.NOT. ALLOCATED(DstOutputData%axInduction)) THEN - ALLOCATE(DstOutputData%axInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%axInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%axInduction = SrcOutputData%axInduction -ENDIF -IF (ALLOCATED(SrcOutputData%tanInduction)) THEN - i1_l = LBOUND(SrcOutputData%tanInduction,1) - i1_u = UBOUND(SrcOutputData%tanInduction,1) - i2_l = LBOUND(SrcOutputData%tanInduction,2) - i2_u = UBOUND(SrcOutputData%tanInduction,2) - IF (.NOT. ALLOCATED(DstOutputData%tanInduction)) THEN - ALLOCATE(DstOutputData%tanInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%tanInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%tanInduction = SrcOutputData%tanInduction -ENDIF -IF (ALLOCATED(SrcOutputData%Re)) THEN - i1_l = LBOUND(SrcOutputData%Re,1) - i1_u = UBOUND(SrcOutputData%Re,1) - i2_l = LBOUND(SrcOutputData%Re,2) - i2_u = UBOUND(SrcOutputData%Re,2) - IF (.NOT. ALLOCATED(DstOutputData%Re)) THEN - ALLOCATE(DstOutputData%Re(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Re.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Re = SrcOutputData%Re -ENDIF -IF (ALLOCATED(SrcOutputData%AOA)) THEN - i1_l = LBOUND(SrcOutputData%AOA,1) - i1_u = UBOUND(SrcOutputData%AOA,1) - i2_l = LBOUND(SrcOutputData%AOA,2) - i2_u = UBOUND(SrcOutputData%AOA,2) - IF (.NOT. ALLOCATED(DstOutputData%AOA)) THEN - ALLOCATE(DstOutputData%AOA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AOA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%AOA = SrcOutputData%AOA -ENDIF -IF (ALLOCATED(SrcOutputData%Cx)) THEN - i1_l = LBOUND(SrcOutputData%Cx,1) - i1_u = UBOUND(SrcOutputData%Cx,1) - i2_l = LBOUND(SrcOutputData%Cx,2) - i2_u = UBOUND(SrcOutputData%Cx,2) - IF (.NOT. ALLOCATED(DstOutputData%Cx)) THEN - ALLOCATE(DstOutputData%Cx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cx = SrcOutputData%Cx -ENDIF -IF (ALLOCATED(SrcOutputData%Cy)) THEN - i1_l = LBOUND(SrcOutputData%Cy,1) - i1_u = UBOUND(SrcOutputData%Cy,1) - i2_l = LBOUND(SrcOutputData%Cy,2) - i2_u = UBOUND(SrcOutputData%Cy,2) - IF (.NOT. ALLOCATED(DstOutputData%Cy)) THEN - ALLOCATE(DstOutputData%Cy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cy = SrcOutputData%Cy -ENDIF -IF (ALLOCATED(SrcOutputData%Cz)) THEN - i1_l = LBOUND(SrcOutputData%Cz,1) - i1_u = UBOUND(SrcOutputData%Cz,1) - i2_l = LBOUND(SrcOutputData%Cz,2) - i2_u = UBOUND(SrcOutputData%Cz,2) - IF (.NOT. ALLOCATED(DstOutputData%Cz)) THEN - ALLOCATE(DstOutputData%Cz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cz = SrcOutputData%Cz -ENDIF -IF (ALLOCATED(SrcOutputData%Cmx)) THEN - i1_l = LBOUND(SrcOutputData%Cmx,1) - i1_u = UBOUND(SrcOutputData%Cmx,1) - i2_l = LBOUND(SrcOutputData%Cmx,2) - i2_u = UBOUND(SrcOutputData%Cmx,2) - IF (.NOT. ALLOCATED(DstOutputData%Cmx)) THEN - ALLOCATE(DstOutputData%Cmx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cmx = SrcOutputData%Cmx -ENDIF -IF (ALLOCATED(SrcOutputData%Cmy)) THEN - i1_l = LBOUND(SrcOutputData%Cmy,1) - i1_u = UBOUND(SrcOutputData%Cmy,1) - i2_l = LBOUND(SrcOutputData%Cmy,2) - i2_u = UBOUND(SrcOutputData%Cmy,2) - IF (.NOT. ALLOCATED(DstOutputData%Cmy)) THEN - ALLOCATE(DstOutputData%Cmy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cmy = SrcOutputData%Cmy -ENDIF -IF (ALLOCATED(SrcOutputData%Cmz)) THEN - i1_l = LBOUND(SrcOutputData%Cmz,1) - i1_u = UBOUND(SrcOutputData%Cmz,1) - i2_l = LBOUND(SrcOutputData%Cmz,2) - i2_u = UBOUND(SrcOutputData%Cmz,2) - IF (.NOT. ALLOCATED(DstOutputData%Cmz)) THEN - ALLOCATE(DstOutputData%Cmz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cmz = SrcOutputData%Cmz -ENDIF -IF (ALLOCATED(SrcOutputData%Cm)) THEN - i1_l = LBOUND(SrcOutputData%Cm,1) - i1_u = UBOUND(SrcOutputData%Cm,1) - i2_l = LBOUND(SrcOutputData%Cm,2) - i2_u = UBOUND(SrcOutputData%Cm,2) - IF (.NOT. ALLOCATED(DstOutputData%Cm)) THEN - ALLOCATE(DstOutputData%Cm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cm = SrcOutputData%Cm -ENDIF -IF (ALLOCATED(SrcOutputData%Cl)) THEN - i1_l = LBOUND(SrcOutputData%Cl,1) - i1_u = UBOUND(SrcOutputData%Cl,1) - i2_l = LBOUND(SrcOutputData%Cl,2) - i2_u = UBOUND(SrcOutputData%Cl,2) - IF (.NOT. ALLOCATED(DstOutputData%Cl)) THEN - ALLOCATE(DstOutputData%Cl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cl = SrcOutputData%Cl -ENDIF -IF (ALLOCATED(SrcOutputData%Cd)) THEN - i1_l = LBOUND(SrcOutputData%Cd,1) - i1_u = UBOUND(SrcOutputData%Cd,1) - i2_l = LBOUND(SrcOutputData%Cd,2) - i2_u = UBOUND(SrcOutputData%Cd,2) - IF (.NOT. ALLOCATED(DstOutputData%Cd)) THEN - ALLOCATE(DstOutputData%Cd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cd = SrcOutputData%Cd -ENDIF -IF (ALLOCATED(SrcOutputData%chi)) THEN - i1_l = LBOUND(SrcOutputData%chi,1) - i1_u = UBOUND(SrcOutputData%chi,1) - i2_l = LBOUND(SrcOutputData%chi,2) - i2_u = UBOUND(SrcOutputData%chi,2) - IF (.NOT. ALLOCATED(DstOutputData%chi)) THEN - ALLOCATE(DstOutputData%chi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%chi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%chi = SrcOutputData%chi -ENDIF -IF (ALLOCATED(SrcOutputData%Cpmin)) THEN - i1_l = LBOUND(SrcOutputData%Cpmin,1) - i1_u = UBOUND(SrcOutputData%Cpmin,1) - i2_l = LBOUND(SrcOutputData%Cpmin,2) - i2_u = UBOUND(SrcOutputData%Cpmin,2) - IF (.NOT. ALLOCATED(DstOutputData%Cpmin)) THEN - ALLOCATE(DstOutputData%Cpmin(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cpmin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cpmin = SrcOutputData%Cpmin -ENDIF - END SUBROUTINE BEMT_CopyOutput - - SUBROUTINE BEMT_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(BEMT_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 = 'BEMT_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%Vrel)) THEN - DEALLOCATE(OutputData%Vrel) -ENDIF -IF (ALLOCATED(OutputData%phi)) THEN - DEALLOCATE(OutputData%phi) -ENDIF -IF (ALLOCATED(OutputData%axInduction)) THEN - DEALLOCATE(OutputData%axInduction) -ENDIF -IF (ALLOCATED(OutputData%tanInduction)) THEN - DEALLOCATE(OutputData%tanInduction) -ENDIF -IF (ALLOCATED(OutputData%Re)) THEN - DEALLOCATE(OutputData%Re) -ENDIF -IF (ALLOCATED(OutputData%AOA)) THEN - DEALLOCATE(OutputData%AOA) -ENDIF -IF (ALLOCATED(OutputData%Cx)) THEN - DEALLOCATE(OutputData%Cx) -ENDIF -IF (ALLOCATED(OutputData%Cy)) THEN - DEALLOCATE(OutputData%Cy) -ENDIF -IF (ALLOCATED(OutputData%Cz)) THEN - DEALLOCATE(OutputData%Cz) -ENDIF -IF (ALLOCATED(OutputData%Cmx)) THEN - DEALLOCATE(OutputData%Cmx) -ENDIF -IF (ALLOCATED(OutputData%Cmy)) THEN - DEALLOCATE(OutputData%Cmy) -ENDIF -IF (ALLOCATED(OutputData%Cmz)) THEN - DEALLOCATE(OutputData%Cmz) -ENDIF -IF (ALLOCATED(OutputData%Cm)) THEN - DEALLOCATE(OutputData%Cm) -ENDIF -IF (ALLOCATED(OutputData%Cl)) THEN - DEALLOCATE(OutputData%Cl) -ENDIF -IF (ALLOCATED(OutputData%Cd)) THEN - DEALLOCATE(OutputData%Cd) -ENDIF -IF (ALLOCATED(OutputData%chi)) THEN - DEALLOCATE(OutputData%chi) -ENDIF -IF (ALLOCATED(OutputData%Cpmin)) THEN - DEALLOCATE(OutputData%Cpmin) -ENDIF - END SUBROUTINE BEMT_DestroyOutput - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 ! Vrel allocated yes/no - IF ( ALLOCATED(InData%Vrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vrel) ! Vrel - END IF - Int_BufSz = Int_BufSz + 1 ! phi allocated yes/no - IF ( ALLOCATED(InData%phi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%phi) ! phi - END IF - Int_BufSz = Int_BufSz + 1 ! axInduction allocated yes/no - IF ( ALLOCATED(InData%axInduction) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! axInduction upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%axInduction) ! axInduction - END IF - Int_BufSz = Int_BufSz + 1 ! tanInduction allocated yes/no - IF ( ALLOCATED(InData%tanInduction) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tanInduction upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tanInduction) ! tanInduction - END IF - Int_BufSz = Int_BufSz + 1 ! Re allocated yes/no - IF ( ALLOCATED(InData%Re) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Re upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Re) ! Re - END IF - Int_BufSz = Int_BufSz + 1 ! AOA allocated yes/no - IF ( ALLOCATED(InData%AOA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AOA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AOA) ! AOA - END IF - Int_BufSz = Int_BufSz + 1 ! Cx allocated yes/no - IF ( ALLOCATED(InData%Cx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cx) ! Cx - END IF - Int_BufSz = Int_BufSz + 1 ! Cy allocated yes/no - IF ( ALLOCATED(InData%Cy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cy) ! Cy - END IF - Int_BufSz = Int_BufSz + 1 ! Cz allocated yes/no - IF ( ALLOCATED(InData%Cz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cz) ! Cz - END IF - Int_BufSz = Int_BufSz + 1 ! Cmx allocated yes/no - IF ( ALLOCATED(InData%Cmx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cmx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cmx) ! Cmx - END IF - Int_BufSz = Int_BufSz + 1 ! Cmy allocated yes/no - IF ( ALLOCATED(InData%Cmy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cmy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cmy) ! Cmy - END IF - Int_BufSz = Int_BufSz + 1 ! Cmz allocated yes/no - IF ( ALLOCATED(InData%Cmz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cmz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cmz) ! Cmz - END IF - Int_BufSz = Int_BufSz + 1 ! Cm allocated yes/no - IF ( ALLOCATED(InData%Cm) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cm) ! Cm - END IF - Int_BufSz = Int_BufSz + 1 ! Cl allocated yes/no - IF ( ALLOCATED(InData%Cl) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cl) ! Cl - END IF - Int_BufSz = Int_BufSz + 1 ! Cd allocated yes/no - IF ( ALLOCATED(InData%Cd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cd) ! Cd - END IF - Int_BufSz = Int_BufSz + 1 ! chi allocated yes/no - IF ( ALLOCATED(InData%chi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! chi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chi) ! chi - END IF - Int_BufSz = Int_BufSz + 1 ! Cpmin allocated yes/no - IF ( ALLOCATED(InData%Cpmin) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cpmin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cpmin) ! Cpmin - 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%Vrel) ) 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%Vrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vrel,2), UBOUND(InData%Vrel,2) - DO i1 = LBOUND(InData%Vrel,1), UBOUND(InData%Vrel,1) - ReKiBuf(Re_Xferred) = InData%Vrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%phi) ) 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%phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%phi,2), UBOUND(InData%phi,2) - DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) - ReKiBuf(Re_Xferred) = InData%phi(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%axInduction) ) 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%axInduction,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axInduction,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axInduction,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axInduction,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%axInduction,2), UBOUND(InData%axInduction,2) - DO i1 = LBOUND(InData%axInduction,1), UBOUND(InData%axInduction,1) - ReKiBuf(Re_Xferred) = InData%axInduction(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tanInduction) ) 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%tanInduction,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tanInduction,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tanInduction,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tanInduction,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tanInduction,2), UBOUND(InData%tanInduction,2) - DO i1 = LBOUND(InData%tanInduction,1), UBOUND(InData%tanInduction,1) - ReKiBuf(Re_Xferred) = InData%tanInduction(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Re) ) 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%Re,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Re,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Re,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Re,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Re,2), UBOUND(InData%Re,2) - DO i1 = LBOUND(InData%Re,1), UBOUND(InData%Re,1) - ReKiBuf(Re_Xferred) = InData%Re(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AOA) ) 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%AOA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AOA,2), UBOUND(InData%AOA,2) - DO i1 = LBOUND(InData%AOA,1), UBOUND(InData%AOA,1) - ReKiBuf(Re_Xferred) = InData%AOA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cx) ) 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%Cx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cx,2), UBOUND(InData%Cx,2) - DO i1 = LBOUND(InData%Cx,1), UBOUND(InData%Cx,1) - ReKiBuf(Re_Xferred) = InData%Cx(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cy) ) 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%Cy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cy,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cy,2), UBOUND(InData%Cy,2) - DO i1 = LBOUND(InData%Cy,1), UBOUND(InData%Cy,1) - ReKiBuf(Re_Xferred) = InData%Cy(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cz) ) 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%Cz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cz,2), UBOUND(InData%Cz,2) - DO i1 = LBOUND(InData%Cz,1), UBOUND(InData%Cz,1) - ReKiBuf(Re_Xferred) = InData%Cz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cmx) ) 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%Cmx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cmx,2), UBOUND(InData%Cmx,2) - DO i1 = LBOUND(InData%Cmx,1), UBOUND(InData%Cmx,1) - ReKiBuf(Re_Xferred) = InData%Cmx(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cmy) ) 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%Cmy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmy,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cmy,2), UBOUND(InData%Cmy,2) - DO i1 = LBOUND(InData%Cmy,1), UBOUND(InData%Cmy,1) - ReKiBuf(Re_Xferred) = InData%Cmy(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cmz) ) 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%Cmz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cmz,2), UBOUND(InData%Cmz,2) - DO i1 = LBOUND(InData%Cmz,1), UBOUND(InData%Cmz,1) - ReKiBuf(Re_Xferred) = InData%Cmz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cm) ) 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%Cm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cm,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cm,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cm,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cm,2), UBOUND(InData%Cm,2) - DO i1 = LBOUND(InData%Cm,1), UBOUND(InData%Cm,1) - ReKiBuf(Re_Xferred) = InData%Cm(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cl) ) 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%Cl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cl,2), UBOUND(InData%Cl,2) - DO i1 = LBOUND(InData%Cl,1), UBOUND(InData%Cl,1) - ReKiBuf(Re_Xferred) = InData%Cl(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cd) ) 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%Cd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cd,2), UBOUND(InData%Cd,2) - DO i1 = LBOUND(InData%Cd,1), UBOUND(InData%Cd,1) - ReKiBuf(Re_Xferred) = InData%Cd(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%chi) ) 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%chi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%chi,2), UBOUND(InData%chi,2) - DO i1 = LBOUND(InData%chi,1), UBOUND(InData%chi,1) - ReKiBuf(Re_Xferred) = InData%chi(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cpmin) ) 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%Cpmin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cpmin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cpmin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cpmin,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cpmin,2), UBOUND(InData%Cpmin,2) - DO i1 = LBOUND(InData%Cpmin,1), UBOUND(InData%Cpmin,1) - ReKiBuf(Re_Xferred) = InData%Cpmin(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_PackOutput - - SUBROUTINE BEMT_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(BEMT_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_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 ! Vrel 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%Vrel)) DEALLOCATE(OutData%Vrel) - ALLOCATE(OutData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vrel,2), UBOUND(OutData%Vrel,2) - DO i1 = LBOUND(OutData%Vrel,1), UBOUND(OutData%Vrel,1) - OutData%Vrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi 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%phi)) DEALLOCATE(OutData%phi) - ALLOCATE(OutData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%phi,2), UBOUND(OutData%phi,2) - DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) - OutData%phi(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! axInduction 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%axInduction)) DEALLOCATE(OutData%axInduction) - ALLOCATE(OutData%axInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%axInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%axInduction,2), UBOUND(OutData%axInduction,2) - DO i1 = LBOUND(OutData%axInduction,1), UBOUND(OutData%axInduction,1) - OutData%axInduction(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tanInduction 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%tanInduction)) DEALLOCATE(OutData%tanInduction) - ALLOCATE(OutData%tanInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tanInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tanInduction,2), UBOUND(OutData%tanInduction,2) - DO i1 = LBOUND(OutData%tanInduction,1), UBOUND(OutData%tanInduction,1) - OutData%tanInduction(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Re 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%Re)) DEALLOCATE(OutData%Re) - ALLOCATE(OutData%Re(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Re.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Re,2), UBOUND(OutData%Re,2) - DO i1 = LBOUND(OutData%Re,1), UBOUND(OutData%Re,1) - OutData%Re(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOA 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%AOA)) DEALLOCATE(OutData%AOA) - ALLOCATE(OutData%AOA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AOA,2), UBOUND(OutData%AOA,2) - DO i1 = LBOUND(OutData%AOA,1), UBOUND(OutData%AOA,1) - OutData%AOA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cx 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%Cx)) DEALLOCATE(OutData%Cx) - ALLOCATE(OutData%Cx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cx,2), UBOUND(OutData%Cx,2) - DO i1 = LBOUND(OutData%Cx,1), UBOUND(OutData%Cx,1) - OutData%Cx(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cy 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%Cy)) DEALLOCATE(OutData%Cy) - ALLOCATE(OutData%Cy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cy,2), UBOUND(OutData%Cy,2) - DO i1 = LBOUND(OutData%Cy,1), UBOUND(OutData%Cy,1) - OutData%Cy(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cz 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%Cz)) DEALLOCATE(OutData%Cz) - ALLOCATE(OutData%Cz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cz,2), UBOUND(OutData%Cz,2) - DO i1 = LBOUND(OutData%Cz,1), UBOUND(OutData%Cz,1) - OutData%Cz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cmx 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%Cmx)) DEALLOCATE(OutData%Cmx) - ALLOCATE(OutData%Cmx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cmx,2), UBOUND(OutData%Cmx,2) - DO i1 = LBOUND(OutData%Cmx,1), UBOUND(OutData%Cmx,1) - OutData%Cmx(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cmy 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%Cmy)) DEALLOCATE(OutData%Cmy) - ALLOCATE(OutData%Cmy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cmy,2), UBOUND(OutData%Cmy,2) - DO i1 = LBOUND(OutData%Cmy,1), UBOUND(OutData%Cmy,1) - OutData%Cmy(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cmz 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%Cmz)) DEALLOCATE(OutData%Cmz) - ALLOCATE(OutData%Cmz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cmz,2), UBOUND(OutData%Cmz,2) - DO i1 = LBOUND(OutData%Cmz,1), UBOUND(OutData%Cmz,1) - OutData%Cmz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cm 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%Cm)) DEALLOCATE(OutData%Cm) - ALLOCATE(OutData%Cm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cm,2), UBOUND(OutData%Cm,2) - DO i1 = LBOUND(OutData%Cm,1), UBOUND(OutData%Cm,1) - OutData%Cm(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cl 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%Cl)) DEALLOCATE(OutData%Cl) - ALLOCATE(OutData%Cl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cl,2), UBOUND(OutData%Cl,2) - DO i1 = LBOUND(OutData%Cl,1), UBOUND(OutData%Cl,1) - OutData%Cl(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cd 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%Cd)) DEALLOCATE(OutData%Cd) - ALLOCATE(OutData%Cd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cd,2), UBOUND(OutData%Cd,2) - DO i1 = LBOUND(OutData%Cd,1), UBOUND(OutData%Cd,1) - OutData%Cd(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chi 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%chi)) DEALLOCATE(OutData%chi) - ALLOCATE(OutData%chi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chi,2), UBOUND(OutData%chi,2) - DO i1 = LBOUND(OutData%chi,1), UBOUND(OutData%chi,1) - OutData%chi(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cpmin 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%Cpmin)) DEALLOCATE(OutData%Cpmin) - ALLOCATE(OutData%Cpmin(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cpmin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cpmin,2), UBOUND(OutData%Cpmin,2) - DO i1 = LBOUND(OutData%Cpmin,1), UBOUND(OutData%Cpmin,1) - OutData%Cpmin(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_UnPackOutput - - - SUBROUTINE BEMT_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(BEMT_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(BEMT_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 + ErrMsg = '' + call UA_DestroyDiscState(DiscStateData%UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine BEMT_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call UA_PackDiscState(Buf, InData%UA) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call UA_UnpackDiscState(Buf, OutData%UA) ! UA +end subroutine + +subroutine BEMT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_ConstraintStateType), intent(in) :: SrcConstrStateData + type(BEMT_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BEMT_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcConstrStateData%phi)) then + LB(1:2) = lbound(SrcConstrStateData%phi) + UB(1:2) = ubound(SrcConstrStateData%phi) + if (.not. allocated(DstConstrStateData%phi)) then + allocate(DstConstrStateData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%phi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstConstrStateData%phi = SrcConstrStateData%phi + end if +end subroutine + +subroutine BEMT_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(BEMT_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConstrStateData%phi)) then + deallocate(ConstrStateData%phi) + end if +end subroutine + +subroutine BEMT_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%phi)) + if (allocated(InData%phi)) then + call RegPackBounds(Buf, 2, lbound(InData%phi), ubound(InData%phi)) + call RegPack(Buf, InData%phi) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackConstrState' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%phi)) deallocate(OutData%phi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%phi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%phi) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine BEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_OtherStateType), intent(in) :: SrcOtherStateData + type(BEMT_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call UA_CopyOtherState(SrcOtherStateData%UA, DstOtherStateData%UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DBEMT_CopyOtherState(SrcOtherStateData%DBEMT, DstOtherStateData%DBEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOtherStateData%ValidPhi)) then + LB(1:2) = lbound(SrcOtherStateData%ValidPhi) + UB(1:2) = ubound(SrcOtherStateData%ValidPhi) + if (.not. allocated(DstOtherStateData%ValidPhi)) then + allocate(DstOtherStateData%ValidPhi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%ValidPhi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%ValidPhi = SrcOtherStateData%ValidPhi + end if + DstOtherStateData%nodesInitialized = SrcOtherStateData%nodesInitialized + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + do i1 = LB(1), UB(1) + call BEMT_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + DstOtherStateData%n = SrcOtherStateData%n +end subroutine + +subroutine BEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(BEMT_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call UA_DestroyOtherState(OtherStateData%UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DBEMT_DestroyOtherState(OtherStateData%DBEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OtherStateData%ValidPhi)) then + deallocate(OtherStateData%ValidPhi) + end if + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call BEMT_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do +end subroutine + +subroutine BEMT_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call UA_PackOtherState(Buf, InData%UA) + call DBEMT_PackOtherState(Buf, InData%DBEMT) + call RegPack(Buf, allocated(InData%ValidPhi)) + if (allocated(InData%ValidPhi)) then + call RegPackBounds(Buf, 2, lbound(InData%ValidPhi), ubound(InData%ValidPhi)) + call RegPack(Buf, InData%ValidPhi) + end if + call RegPack(Buf, InData%nodesInitialized) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call BEMT_PackContState(Buf, InData%xdot(i1)) + end do + call RegPack(Buf, InData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call UA_UnpackOtherState(Buf, OutData%UA) ! UA + call DBEMT_UnpackOtherState(Buf, OutData%DBEMT) ! DBEMT + if (allocated(OutData%ValidPhi)) deallocate(OutData%ValidPhi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ValidPhi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidPhi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ValidPhi) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%nodesInitialized) + if (RegCheckErr(Buf, RoutineName)) return + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call BEMT_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_MiscVarType), intent(in) :: SrcMiscData + type(BEMT_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%FirstWarn_Skew = SrcMiscData%FirstWarn_Skew + DstMiscData%FirstWarn_Phi = SrcMiscData%FirstWarn_Phi + DstMiscData%FirstWarn_BEMoff = SrcMiscData%FirstWarn_BEMoff + call UA_CopyMisc(SrcMiscData%UA, DstMiscData%UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DBEMT_CopyMisc(SrcMiscData%DBEMT, DstMiscData%DBEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call UA_CopyOutput(SrcMiscData%y_UA, DstMiscData%y_UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%u_UA)) then + LB(1:3) = lbound(SrcMiscData%u_UA) + UB(1:3) = ubound(SrcMiscData%u_UA) + if (.not. allocated(DstMiscData%u_UA)) then + allocate(DstMiscData%u_UA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_UA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i3 = LB(3), UB(3) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_CopyInput(SrcMiscData%u_UA(i1,i2,i3), DstMiscData%u_UA(i1,i2,i3), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end do + end if + LB(1:1) = lbound(SrcMiscData%u_DBEMT) + UB(1:1) = ubound(SrcMiscData%u_DBEMT) + do i1 = LB(1), UB(1) + call DBEMT_CopyInput(SrcMiscData%u_DBEMT(i1), DstMiscData%u_DBEMT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcMiscData%u_SkewWake) + UB(1:1) = ubound(SrcMiscData%u_SkewWake) + do i1 = LB(1), UB(1) + call BEMT_CopySkewWake_InputType(SrcMiscData%u_SkewWake(i1), DstMiscData%u_SkewWake(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + if (allocated(SrcMiscData%TnInd_op)) then + LB(1:2) = lbound(SrcMiscData%TnInd_op) + UB(1:2) = ubound(SrcMiscData%TnInd_op) + if (.not. allocated(DstMiscData%TnInd_op)) then + allocate(DstMiscData%TnInd_op(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TnInd_op.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%TnInd_op = SrcMiscData%TnInd_op + end if + if (allocated(SrcMiscData%AxInd_op)) then + LB(1:2) = lbound(SrcMiscData%AxInd_op) + UB(1:2) = ubound(SrcMiscData%AxInd_op) + if (.not. allocated(DstMiscData%AxInd_op)) then + allocate(DstMiscData%AxInd_op(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AxInd_op.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AxInd_op = SrcMiscData%AxInd_op + end if + if (allocated(SrcMiscData%AxInduction)) then + LB(1:2) = lbound(SrcMiscData%AxInduction) + UB(1:2) = ubound(SrcMiscData%AxInduction) + if (.not. allocated(DstMiscData%AxInduction)) then + allocate(DstMiscData%AxInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AxInduction.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AxInduction = SrcMiscData%AxInduction + end if + if (allocated(SrcMiscData%TanInduction)) then + LB(1:2) = lbound(SrcMiscData%TanInduction) + UB(1:2) = ubound(SrcMiscData%TanInduction) + if (.not. allocated(DstMiscData%TanInduction)) then + allocate(DstMiscData%TanInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TanInduction.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%TanInduction = SrcMiscData%TanInduction + end if + DstMiscData%UseFrozenWake = SrcMiscData%UseFrozenWake + if (allocated(SrcMiscData%Rtip)) then + LB(1:1) = lbound(SrcMiscData%Rtip) + UB(1:1) = ubound(SrcMiscData%Rtip) + if (.not. allocated(DstMiscData%Rtip)) then + allocate(DstMiscData%Rtip(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Rtip.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Rtip = SrcMiscData%Rtip + end if + if (allocated(SrcMiscData%phi)) then + LB(1:2) = lbound(SrcMiscData%phi) + UB(1:2) = ubound(SrcMiscData%phi) + if (.not. allocated(DstMiscData%phi)) then + allocate(DstMiscData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%phi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%phi = SrcMiscData%phi + end if + if (allocated(SrcMiscData%chi)) then + LB(1:2) = lbound(SrcMiscData%chi) + UB(1:2) = ubound(SrcMiscData%chi) + if (.not. allocated(DstMiscData%chi)) then + allocate(DstMiscData%chi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%chi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%chi = SrcMiscData%chi + end if + if (allocated(SrcMiscData%ValidPhi)) then + LB(1:2) = lbound(SrcMiscData%ValidPhi) + UB(1:2) = ubound(SrcMiscData%ValidPhi) + if (.not. allocated(DstMiscData%ValidPhi)) then + allocate(DstMiscData%ValidPhi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ValidPhi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ValidPhi = SrcMiscData%ValidPhi + end if + DstMiscData%BEM_weight = SrcMiscData%BEM_weight +end subroutine + +subroutine BEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(BEMT_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call UA_DestroyMisc(MiscData%UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DBEMT_DestroyMisc(MiscData%DBEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call UA_DestroyOutput(MiscData%y_UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%u_UA)) then + LB(1:3) = lbound(MiscData%u_UA) + UB(1:3) = ubound(MiscData%u_UA) + do i3 = LB(3), UB(3) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_DestroyInput(MiscData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + end do + deallocate(MiscData%u_UA) + end if + LB(1:1) = lbound(MiscData%u_DBEMT) + UB(1:1) = ubound(MiscData%u_DBEMT) + do i1 = LB(1), UB(1) + call DBEMT_DestroyInput(MiscData%u_DBEMT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MiscData%u_SkewWake) + UB(1:1) = ubound(MiscData%u_SkewWake) + do i1 = LB(1), UB(1) + call BEMT_DestroySkewWake_InputType(MiscData%u_SkewWake(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + if (allocated(MiscData%TnInd_op)) then + deallocate(MiscData%TnInd_op) + end if + if (allocated(MiscData%AxInd_op)) then + deallocate(MiscData%AxInd_op) + end if + if (allocated(MiscData%AxInduction)) then + deallocate(MiscData%AxInduction) + end if + if (allocated(MiscData%TanInduction)) then + deallocate(MiscData%TanInduction) + end if + if (allocated(MiscData%Rtip)) then + deallocate(MiscData%Rtip) + end if + if (allocated(MiscData%phi)) then + deallocate(MiscData%phi) + end if + if (allocated(MiscData%chi)) then + deallocate(MiscData%chi) + end if + if (allocated(MiscData%ValidPhi)) then + deallocate(MiscData%ValidPhi) + end if +end subroutine + +subroutine BEMT_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackMisc' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%FirstWarn_Skew) + call RegPack(Buf, InData%FirstWarn_Phi) + call RegPack(Buf, InData%FirstWarn_BEMoff) + call UA_PackMisc(Buf, InData%UA) + call DBEMT_PackMisc(Buf, InData%DBEMT) + call UA_PackOutput(Buf, InData%y_UA) + call RegPack(Buf, allocated(InData%u_UA)) + if (allocated(InData%u_UA)) then + call RegPackBounds(Buf, 3, lbound(InData%u_UA), ubound(InData%u_UA)) + LB(1:3) = lbound(InData%u_UA) + UB(1:3) = ubound(InData%u_UA) + do i3 = LB(3), UB(3) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_PackInput(Buf, InData%u_UA(i1,i2,i3)) + end do + end do + end do + end if + LB(1:1) = lbound(InData%u_DBEMT) + UB(1:1) = ubound(InData%u_DBEMT) + do i1 = LB(1), UB(1) + call DBEMT_PackInput(Buf, InData%u_DBEMT(i1)) + end do + LB(1:1) = lbound(InData%u_SkewWake) + UB(1:1) = ubound(InData%u_SkewWake) + do i1 = LB(1), UB(1) + call BEMT_PackSkewWake_InputType(Buf, InData%u_SkewWake(i1)) + end do + call RegPack(Buf, allocated(InData%TnInd_op)) + if (allocated(InData%TnInd_op)) then + call RegPackBounds(Buf, 2, lbound(InData%TnInd_op), ubound(InData%TnInd_op)) + call RegPack(Buf, InData%TnInd_op) + end if + call RegPack(Buf, allocated(InData%AxInd_op)) + if (allocated(InData%AxInd_op)) then + call RegPackBounds(Buf, 2, lbound(InData%AxInd_op), ubound(InData%AxInd_op)) + call RegPack(Buf, InData%AxInd_op) + end if + call RegPack(Buf, allocated(InData%AxInduction)) + if (allocated(InData%AxInduction)) then + call RegPackBounds(Buf, 2, lbound(InData%AxInduction), ubound(InData%AxInduction)) + call RegPack(Buf, InData%AxInduction) + end if + call RegPack(Buf, allocated(InData%TanInduction)) + if (allocated(InData%TanInduction)) then + call RegPackBounds(Buf, 2, lbound(InData%TanInduction), ubound(InData%TanInduction)) + call RegPack(Buf, InData%TanInduction) + end if + call RegPack(Buf, InData%UseFrozenWake) + call RegPack(Buf, allocated(InData%Rtip)) + if (allocated(InData%Rtip)) then + call RegPackBounds(Buf, 1, lbound(InData%Rtip), ubound(InData%Rtip)) + call RegPack(Buf, InData%Rtip) + end if + call RegPack(Buf, allocated(InData%phi)) + if (allocated(InData%phi)) then + call RegPackBounds(Buf, 2, lbound(InData%phi), ubound(InData%phi)) + call RegPack(Buf, InData%phi) + end if + call RegPack(Buf, allocated(InData%chi)) + if (allocated(InData%chi)) then + call RegPackBounds(Buf, 2, lbound(InData%chi), ubound(InData%chi)) + call RegPack(Buf, InData%chi) + end if + call RegPack(Buf, allocated(InData%ValidPhi)) + if (allocated(InData%ValidPhi)) then + call RegPackBounds(Buf, 2, lbound(InData%ValidPhi), ubound(InData%ValidPhi)) + call RegPack(Buf, InData%ValidPhi) + end if + call RegPack(Buf, InData%BEM_weight) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackMisc' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%FirstWarn_Skew) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FirstWarn_Phi) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FirstWarn_BEMoff) + if (RegCheckErr(Buf, RoutineName)) return + call UA_UnpackMisc(Buf, OutData%UA) ! UA + call DBEMT_UnpackMisc(Buf, OutData%DBEMT) ! DBEMT + call UA_UnpackOutput(Buf, OutData%y_UA) ! y_UA + if (allocated(OutData%u_UA)) deallocate(OutData%u_UA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_UA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i3 = LB(3), UB(3) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_UnpackInput(Buf, OutData%u_UA(i1,i2,i3)) ! u_UA + end do + end do + end do + end if + LB(1:1) = lbound(OutData%u_DBEMT) + UB(1:1) = ubound(OutData%u_DBEMT) + do i1 = LB(1), UB(1) + call DBEMT_UnpackInput(Buf, OutData%u_DBEMT(i1)) ! u_DBEMT + end do + LB(1:1) = lbound(OutData%u_SkewWake) + UB(1:1) = ubound(OutData%u_SkewWake) + do i1 = LB(1), UB(1) + call BEMT_UnpackSkewWake_InputType(Buf, OutData%u_SkewWake(i1)) ! u_SkewWake + end do + if (allocated(OutData%TnInd_op)) deallocate(OutData%TnInd_op) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TnInd_op(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TnInd_op.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TnInd_op) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AxInd_op)) deallocate(OutData%AxInd_op) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxInd_op(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInd_op.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxInd_op) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AxInduction)) deallocate(OutData%AxInduction) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxInduction(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInduction.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxInduction) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TanInduction)) deallocate(OutData%TanInduction) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TanInduction(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TanInduction.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TanInduction) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%UseFrozenWake) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Rtip)) deallocate(OutData%Rtip) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Rtip(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Rtip.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Rtip) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%phi)) deallocate(OutData%phi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%phi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%phi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%chi)) deallocate(OutData%chi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%chi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%chi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ValidPhi)) deallocate(OutData%ValidPhi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ValidPhi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidPhi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ValidPhi) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%BEM_weight) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_ParameterType), intent(in) :: SrcParamData + type(BEMT_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + if (allocated(SrcParamData%chord)) then + LB(1:2) = lbound(SrcParamData%chord) + UB(1:2) = ubound(SrcParamData%chord) + if (.not. allocated(DstParamData%chord)) then + allocate(DstParamData%chord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%chord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%chord = SrcParamData%chord + end if + DstParamData%numBlades = SrcParamData%numBlades + DstParamData%airDens = SrcParamData%airDens + DstParamData%kinVisc = SrcParamData%kinVisc + DstParamData%skewWakeMod = SrcParamData%skewWakeMod + DstParamData%aTol = SrcParamData%aTol + DstParamData%useTipLoss = SrcParamData%useTipLoss + DstParamData%useHubLoss = SrcParamData%useHubLoss + DstParamData%useInduction = SrcParamData%useInduction + DstParamData%useTanInd = SrcParamData%useTanInd + DstParamData%useAIDrag = SrcParamData%useAIDrag + DstParamData%useTIDrag = SrcParamData%useTIDrag + DstParamData%numBladeNodes = SrcParamData%numBladeNodes + DstParamData%numReIterations = SrcParamData%numReIterations + DstParamData%maxIndIterations = SrcParamData%maxIndIterations + if (allocated(SrcParamData%AFindx)) then + LB(1:2) = lbound(SrcParamData%AFindx) + UB(1:2) = ubound(SrcParamData%AFindx) + if (.not. allocated(DstParamData%AFindx)) then + allocate(DstParamData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFindx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AFindx = SrcParamData%AFindx + end if + if (allocated(SrcParamData%tipLossConst)) then + LB(1:2) = lbound(SrcParamData%tipLossConst) + UB(1:2) = ubound(SrcParamData%tipLossConst) + if (.not. allocated(DstParamData%tipLossConst)) then + allocate(DstParamData%tipLossConst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%tipLossConst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%tipLossConst = SrcParamData%tipLossConst + end if + if (allocated(SrcParamData%hubLossConst)) then + LB(1:2) = lbound(SrcParamData%hubLossConst) + UB(1:2) = ubound(SrcParamData%hubLossConst) + if (.not. allocated(DstParamData%hubLossConst)) then + allocate(DstParamData%hubLossConst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%hubLossConst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%hubLossConst = SrcParamData%hubLossConst + end if + if (allocated(SrcParamData%zHub)) then + LB(1:1) = lbound(SrcParamData%zHub) + UB(1:1) = ubound(SrcParamData%zHub) + if (.not. allocated(DstParamData%zHub)) then + allocate(DstParamData%zHub(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zHub.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%zHub = SrcParamData%zHub + end if + call UA_CopyParam(SrcParamData%UA, DstParamData%UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DBEMT_CopyParam(SrcParamData%DBEMT, DstParamData%DBEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%UA_Flag = SrcParamData%UA_Flag + DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod + DstParamData%yawCorrFactor = SrcParamData%yawCorrFactor + if (allocated(SrcParamData%FixedInductions)) then + LB(1:2) = lbound(SrcParamData%FixedInductions) + UB(1:2) = ubound(SrcParamData%FixedInductions) + if (.not. allocated(DstParamData%FixedInductions)) then + allocate(DstParamData%FixedInductions(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FixedInductions.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FixedInductions = SrcParamData%FixedInductions + end if + DstParamData%MomentumCorr = SrcParamData%MomentumCorr + DstParamData%rTipFixMax = SrcParamData%rTipFixMax + if (allocated(SrcParamData%IntegrateWeight)) then + LB(1:2) = lbound(SrcParamData%IntegrateWeight) + UB(1:2) = ubound(SrcParamData%IntegrateWeight) + if (.not. allocated(DstParamData%IntegrateWeight)) then + allocate(DstParamData%IntegrateWeight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IntegrateWeight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IntegrateWeight = SrcParamData%IntegrateWeight + end if + DstParamData%lin_nx = SrcParamData%lin_nx + DstParamData%BEM_Mod = SrcParamData%BEM_Mod +end subroutine + +subroutine BEMT_DestroyParam(ParamData, ErrStat, ErrMsg) + type(BEMT_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%chord)) then + deallocate(ParamData%chord) + end if + if (allocated(ParamData%AFindx)) then + deallocate(ParamData%AFindx) + end if + if (allocated(ParamData%tipLossConst)) then + deallocate(ParamData%tipLossConst) + end if + if (allocated(ParamData%hubLossConst)) then + deallocate(ParamData%hubLossConst) + end if + if (allocated(ParamData%zHub)) then + deallocate(ParamData%zHub) + end if + call UA_DestroyParam(ParamData%UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DBEMT_DestroyParam(ParamData%DBEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%FixedInductions)) then + deallocate(ParamData%FixedInductions) + end if + if (allocated(ParamData%IntegrateWeight)) then + deallocate(ParamData%IntegrateWeight) + end if +end subroutine + +subroutine BEMT_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, allocated(InData%chord)) + if (allocated(InData%chord)) then + call RegPackBounds(Buf, 2, lbound(InData%chord), ubound(InData%chord)) + call RegPack(Buf, InData%chord) + end if + call RegPack(Buf, InData%numBlades) + call RegPack(Buf, InData%airDens) + call RegPack(Buf, InData%kinVisc) + call RegPack(Buf, InData%skewWakeMod) + call RegPack(Buf, InData%aTol) + call RegPack(Buf, InData%useTipLoss) + call RegPack(Buf, InData%useHubLoss) + call RegPack(Buf, InData%useInduction) + call RegPack(Buf, InData%useTanInd) + call RegPack(Buf, InData%useAIDrag) + call RegPack(Buf, InData%useTIDrag) + call RegPack(Buf, InData%numBladeNodes) + call RegPack(Buf, InData%numReIterations) + call RegPack(Buf, InData%maxIndIterations) + call RegPack(Buf, allocated(InData%AFindx)) + if (allocated(InData%AFindx)) then + call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) + call RegPack(Buf, InData%AFindx) + end if + call RegPack(Buf, allocated(InData%tipLossConst)) + if (allocated(InData%tipLossConst)) then + call RegPackBounds(Buf, 2, lbound(InData%tipLossConst), ubound(InData%tipLossConst)) + call RegPack(Buf, InData%tipLossConst) + end if + call RegPack(Buf, allocated(InData%hubLossConst)) + if (allocated(InData%hubLossConst)) then + call RegPackBounds(Buf, 2, lbound(InData%hubLossConst), ubound(InData%hubLossConst)) + call RegPack(Buf, InData%hubLossConst) + end if + call RegPack(Buf, allocated(InData%zHub)) + if (allocated(InData%zHub)) then + call RegPackBounds(Buf, 1, lbound(InData%zHub), ubound(InData%zHub)) + call RegPack(Buf, InData%zHub) + end if + call UA_PackParam(Buf, InData%UA) + call DBEMT_PackParam(Buf, InData%DBEMT) + call RegPack(Buf, InData%UA_Flag) + call RegPack(Buf, InData%DBEMT_Mod) + call RegPack(Buf, InData%yawCorrFactor) + call RegPack(Buf, allocated(InData%FixedInductions)) + if (allocated(InData%FixedInductions)) then + call RegPackBounds(Buf, 2, lbound(InData%FixedInductions), ubound(InData%FixedInductions)) + call RegPack(Buf, InData%FixedInductions) + end if + call RegPack(Buf, InData%MomentumCorr) + call RegPack(Buf, InData%rTipFixMax) + call RegPack(Buf, allocated(InData%IntegrateWeight)) + if (allocated(InData%IntegrateWeight)) then + call RegPackBounds(Buf, 2, lbound(InData%IntegrateWeight), ubound(InData%IntegrateWeight)) + call RegPack(Buf, InData%IntegrateWeight) + end if + call RegPack(Buf, InData%lin_nx) + call RegPack(Buf, InData%BEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%chord)) deallocate(OutData%chord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%chord(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%chord) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%airDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%kinVisc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%skewWakeMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%aTol) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%useTipLoss) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%useHubLoss) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%useInduction) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%useTanInd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%useAIDrag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%useTIDrag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%numBladeNodes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%numReIterations) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%maxIndIterations) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFindx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFindx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%tipLossConst)) deallocate(OutData%tipLossConst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%tipLossConst(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tipLossConst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%tipLossConst) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%hubLossConst)) deallocate(OutData%hubLossConst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%hubLossConst(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%hubLossConst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%hubLossConst) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%zHub)) deallocate(OutData%zHub) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%zHub(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%zHub) + if (RegCheckErr(Buf, RoutineName)) return + end if + call UA_UnpackParam(Buf, OutData%UA) ! UA + call DBEMT_UnpackParam(Buf, OutData%DBEMT) ! DBEMT + call RegUnpack(Buf, OutData%UA_Flag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%yawCorrFactor) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%FixedInductions)) deallocate(OutData%FixedInductions) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FixedInductions(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FixedInductions.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FixedInductions) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%MomentumCorr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rTipFixMax) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%IntegrateWeight)) deallocate(OutData%IntegrateWeight) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IntegrateWeight(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IntegrateWeight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IntegrateWeight) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%lin_nx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_InputType), intent(in) :: SrcInputData + type(BEMT_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BEMT_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%theta)) then + LB(1:2) = lbound(SrcInputData%theta) + UB(1:2) = ubound(SrcInputData%theta) + if (.not. allocated(DstInputData%theta)) then + allocate(DstInputData%theta(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%theta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%theta = SrcInputData%theta + end if + DstInputData%chi0 = SrcInputData%chi0 + DstInputData%psiSkewOffset = SrcInputData%psiSkewOffset + if (allocated(SrcInputData%psi)) then + LB(1:1) = lbound(SrcInputData%psi) + UB(1:1) = ubound(SrcInputData%psi) + if (.not. allocated(DstInputData%psi)) then + allocate(DstInputData%psi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%psi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%psi = SrcInputData%psi + end if + DstInputData%omega = SrcInputData%omega + DstInputData%TSR = SrcInputData%TSR + if (allocated(SrcInputData%Vx)) then + LB(1:2) = lbound(SrcInputData%Vx) + UB(1:2) = ubound(SrcInputData%Vx) + if (.not. allocated(DstInputData%Vx)) then + allocate(DstInputData%Vx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vx = SrcInputData%Vx + end if + if (allocated(SrcInputData%Vy)) then + LB(1:2) = lbound(SrcInputData%Vy) + UB(1:2) = ubound(SrcInputData%Vy) + if (.not. allocated(DstInputData%Vy)) then + allocate(DstInputData%Vy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vy = SrcInputData%Vy + end if + if (allocated(SrcInputData%Vz)) then + LB(1:2) = lbound(SrcInputData%Vz) + UB(1:2) = ubound(SrcInputData%Vz) + if (.not. allocated(DstInputData%Vz)) then + allocate(DstInputData%Vz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vz = SrcInputData%Vz + end if + if (allocated(SrcInputData%omega_z)) then + LB(1:2) = lbound(SrcInputData%omega_z) + UB(1:2) = ubound(SrcInputData%omega_z) + if (.not. allocated(DstInputData%omega_z)) then + allocate(DstInputData%omega_z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%omega_z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%omega_z = SrcInputData%omega_z + end if + if (allocated(SrcInputData%xVelCorr)) then + LB(1:2) = lbound(SrcInputData%xVelCorr) + UB(1:2) = ubound(SrcInputData%xVelCorr) + if (.not. allocated(DstInputData%xVelCorr)) then + allocate(DstInputData%xVelCorr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xVelCorr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%xVelCorr = SrcInputData%xVelCorr + end if + if (allocated(SrcInputData%rLocal)) then + LB(1:2) = lbound(SrcInputData%rLocal) + UB(1:2) = ubound(SrcInputData%rLocal) + if (.not. allocated(DstInputData%rLocal)) then + allocate(DstInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rLocal.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%rLocal = SrcInputData%rLocal + end if + DstInputData%Un_disk = SrcInputData%Un_disk + DstInputData%V0 = SrcInputData%V0 + DstInputData%x_hat_disk = SrcInputData%x_hat_disk + if (allocated(SrcInputData%UserProp)) then + LB(1:2) = lbound(SrcInputData%UserProp) + UB(1:2) = ubound(SrcInputData%UserProp) + if (.not. allocated(DstInputData%UserProp)) then + allocate(DstInputData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%UserProp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%UserProp = SrcInputData%UserProp + end if + if (allocated(SrcInputData%CantAngle)) then + LB(1:2) = lbound(SrcInputData%CantAngle) + UB(1:2) = ubound(SrcInputData%CantAngle) + if (.not. allocated(DstInputData%CantAngle)) then + allocate(DstInputData%CantAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CantAngle.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CantAngle = SrcInputData%CantAngle + end if + if (allocated(SrcInputData%drdz)) then + LB(1:2) = lbound(SrcInputData%drdz) + UB(1:2) = ubound(SrcInputData%drdz) + if (.not. allocated(DstInputData%drdz)) then + allocate(DstInputData%drdz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%drdz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%drdz = SrcInputData%drdz + end if + if (allocated(SrcInputData%toeAngle)) then + LB(1:2) = lbound(SrcInputData%toeAngle) + UB(1:2) = ubound(SrcInputData%toeAngle) + if (.not. allocated(DstInputData%toeAngle)) then + allocate(DstInputData%toeAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toeAngle.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%toeAngle = SrcInputData%toeAngle + end if +end subroutine + +subroutine BEMT_DestroyInput(InputData, ErrStat, ErrMsg) + type(BEMT_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%theta)) then + deallocate(InputData%theta) + end if + if (allocated(InputData%psi)) then + deallocate(InputData%psi) + end if + if (allocated(InputData%Vx)) then + deallocate(InputData%Vx) + end if + if (allocated(InputData%Vy)) then + deallocate(InputData%Vy) + end if + if (allocated(InputData%Vz)) then + deallocate(InputData%Vz) + end if + if (allocated(InputData%omega_z)) then + deallocate(InputData%omega_z) + end if + if (allocated(InputData%xVelCorr)) then + deallocate(InputData%xVelCorr) + end if + if (allocated(InputData%rLocal)) then + deallocate(InputData%rLocal) + end if + if (allocated(InputData%UserProp)) then + deallocate(InputData%UserProp) + end if + if (allocated(InputData%CantAngle)) then + deallocate(InputData%CantAngle) + end if + if (allocated(InputData%drdz)) then + deallocate(InputData%drdz) + end if + if (allocated(InputData%toeAngle)) then + deallocate(InputData%toeAngle) + end if +end subroutine + +subroutine BEMT_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%theta)) + if (allocated(InData%theta)) then + call RegPackBounds(Buf, 2, lbound(InData%theta), ubound(InData%theta)) + call RegPack(Buf, InData%theta) + end if + call RegPack(Buf, InData%chi0) + call RegPack(Buf, InData%psiSkewOffset) + call RegPack(Buf, allocated(InData%psi)) + if (allocated(InData%psi)) then + call RegPackBounds(Buf, 1, lbound(InData%psi), ubound(InData%psi)) + call RegPack(Buf, InData%psi) + end if + call RegPack(Buf, InData%omega) + call RegPack(Buf, InData%TSR) + call RegPack(Buf, allocated(InData%Vx)) + if (allocated(InData%Vx)) then + call RegPackBounds(Buf, 2, lbound(InData%Vx), ubound(InData%Vx)) + call RegPack(Buf, InData%Vx) + end if + call RegPack(Buf, allocated(InData%Vy)) + if (allocated(InData%Vy)) then + call RegPackBounds(Buf, 2, lbound(InData%Vy), ubound(InData%Vy)) + call RegPack(Buf, InData%Vy) + end if + call RegPack(Buf, allocated(InData%Vz)) + if (allocated(InData%Vz)) then + call RegPackBounds(Buf, 2, lbound(InData%Vz), ubound(InData%Vz)) + call RegPack(Buf, InData%Vz) + end if + call RegPack(Buf, allocated(InData%omega_z)) + if (allocated(InData%omega_z)) then + call RegPackBounds(Buf, 2, lbound(InData%omega_z), ubound(InData%omega_z)) + call RegPack(Buf, InData%omega_z) + end if + call RegPack(Buf, allocated(InData%xVelCorr)) + if (allocated(InData%xVelCorr)) then + call RegPackBounds(Buf, 2, lbound(InData%xVelCorr), ubound(InData%xVelCorr)) + call RegPack(Buf, InData%xVelCorr) + end if + call RegPack(Buf, allocated(InData%rLocal)) + if (allocated(InData%rLocal)) then + call RegPackBounds(Buf, 2, lbound(InData%rLocal), ubound(InData%rLocal)) + call RegPack(Buf, InData%rLocal) + end if + call RegPack(Buf, InData%Un_disk) + call RegPack(Buf, InData%V0) + call RegPack(Buf, InData%x_hat_disk) + call RegPack(Buf, allocated(InData%UserProp)) + if (allocated(InData%UserProp)) then + call RegPackBounds(Buf, 2, lbound(InData%UserProp), ubound(InData%UserProp)) + call RegPack(Buf, InData%UserProp) + end if + call RegPack(Buf, allocated(InData%CantAngle)) + if (allocated(InData%CantAngle)) then + call RegPackBounds(Buf, 2, lbound(InData%CantAngle), ubound(InData%CantAngle)) + call RegPack(Buf, InData%CantAngle) + end if + call RegPack(Buf, allocated(InData%drdz)) + if (allocated(InData%drdz)) then + call RegPackBounds(Buf, 2, lbound(InData%drdz), ubound(InData%drdz)) + call RegPack(Buf, InData%drdz) + end if + call RegPack(Buf, allocated(InData%toeAngle)) + if (allocated(InData%toeAngle)) then + call RegPackBounds(Buf, 2, lbound(InData%toeAngle), ubound(InData%toeAngle)) + call RegPack(Buf, InData%toeAngle) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%theta)) deallocate(OutData%theta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%theta(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%theta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%theta) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%chi0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%psiSkewOffset) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%psi)) deallocate(OutData%psi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%psi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%psi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%psi) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%omega) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TSR) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Vx)) deallocate(OutData%Vx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vy)) deallocate(OutData%Vy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vy(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vy) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vz)) deallocate(OutData%Vz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vz) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%omega_z)) deallocate(OutData%omega_z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%omega_z(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%omega_z) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%xVelCorr)) deallocate(OutData%xVelCorr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xVelCorr(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xVelCorr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xVelCorr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rLocal)) deallocate(OutData%rLocal) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rLocal(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rLocal) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Un_disk) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%V0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%x_hat_disk) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%UserProp)) deallocate(OutData%UserProp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UserProp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UserProp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CantAngle)) deallocate(OutData%CantAngle) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CantAngle(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CantAngle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CantAngle) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%drdz)) deallocate(OutData%drdz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%drdz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%drdz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%drdz) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%toeAngle)) deallocate(OutData%toeAngle) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%toeAngle(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toeAngle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%toeAngle) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_OutputType), intent(in) :: SrcOutputData + type(BEMT_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BEMT_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%Vrel)) then + LB(1:2) = lbound(SrcOutputData%Vrel) + UB(1:2) = ubound(SrcOutputData%Vrel) + if (.not. allocated(DstOutputData%Vrel)) then + allocate(DstOutputData%Vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vrel = SrcOutputData%Vrel + end if + if (allocated(SrcOutputData%phi)) then + LB(1:2) = lbound(SrcOutputData%phi) + UB(1:2) = ubound(SrcOutputData%phi) + if (.not. allocated(DstOutputData%phi)) then + allocate(DstOutputData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%phi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%phi = SrcOutputData%phi + end if + if (allocated(SrcOutputData%axInduction)) then + LB(1:2) = lbound(SrcOutputData%axInduction) + UB(1:2) = ubound(SrcOutputData%axInduction) + if (.not. allocated(DstOutputData%axInduction)) then + allocate(DstOutputData%axInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%axInduction.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%axInduction = SrcOutputData%axInduction + end if + if (allocated(SrcOutputData%tanInduction)) then + LB(1:2) = lbound(SrcOutputData%tanInduction) + UB(1:2) = ubound(SrcOutputData%tanInduction) + if (.not. allocated(DstOutputData%tanInduction)) then + allocate(DstOutputData%tanInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%tanInduction.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%tanInduction = SrcOutputData%tanInduction + end if + if (allocated(SrcOutputData%Re)) then + LB(1:2) = lbound(SrcOutputData%Re) + UB(1:2) = ubound(SrcOutputData%Re) + if (.not. allocated(DstOutputData%Re)) then + allocate(DstOutputData%Re(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Re.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Re = SrcOutputData%Re + end if + if (allocated(SrcOutputData%AOA)) then + LB(1:2) = lbound(SrcOutputData%AOA) + UB(1:2) = ubound(SrcOutputData%AOA) + if (.not. allocated(DstOutputData%AOA)) then + allocate(DstOutputData%AOA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AOA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%AOA = SrcOutputData%AOA + end if + if (allocated(SrcOutputData%Cx)) then + LB(1:2) = lbound(SrcOutputData%Cx) + UB(1:2) = ubound(SrcOutputData%Cx) + if (.not. allocated(DstOutputData%Cx)) then + allocate(DstOutputData%Cx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cx = SrcOutputData%Cx + end if + if (allocated(SrcOutputData%Cy)) then + LB(1:2) = lbound(SrcOutputData%Cy) + UB(1:2) = ubound(SrcOutputData%Cy) + if (.not. allocated(DstOutputData%Cy)) then + allocate(DstOutputData%Cy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cy = SrcOutputData%Cy + end if + if (allocated(SrcOutputData%Cz)) then + LB(1:2) = lbound(SrcOutputData%Cz) + UB(1:2) = ubound(SrcOutputData%Cz) + if (.not. allocated(DstOutputData%Cz)) then + allocate(DstOutputData%Cz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cz = SrcOutputData%Cz + end if + if (allocated(SrcOutputData%Cmx)) then + LB(1:2) = lbound(SrcOutputData%Cmx) + UB(1:2) = ubound(SrcOutputData%Cmx) + if (.not. allocated(DstOutputData%Cmx)) then + allocate(DstOutputData%Cmx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cmx = SrcOutputData%Cmx + end if + if (allocated(SrcOutputData%Cmy)) then + LB(1:2) = lbound(SrcOutputData%Cmy) + UB(1:2) = ubound(SrcOutputData%Cmy) + if (.not. allocated(DstOutputData%Cmy)) then + allocate(DstOutputData%Cmy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cmy = SrcOutputData%Cmy + end if + if (allocated(SrcOutputData%Cmz)) then + LB(1:2) = lbound(SrcOutputData%Cmz) + UB(1:2) = ubound(SrcOutputData%Cmz) + if (.not. allocated(DstOutputData%Cmz)) then + allocate(DstOutputData%Cmz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cmz = SrcOutputData%Cmz + end if + if (allocated(SrcOutputData%Cm)) then + LB(1:2) = lbound(SrcOutputData%Cm) + UB(1:2) = ubound(SrcOutputData%Cm) + if (.not. allocated(DstOutputData%Cm)) then + allocate(DstOutputData%Cm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cm = SrcOutputData%Cm + end if + if (allocated(SrcOutputData%Cl)) then + LB(1:2) = lbound(SrcOutputData%Cl) + UB(1:2) = ubound(SrcOutputData%Cl) + if (.not. allocated(DstOutputData%Cl)) then + allocate(DstOutputData%Cl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cl = SrcOutputData%Cl + end if + if (allocated(SrcOutputData%Cd)) then + LB(1:2) = lbound(SrcOutputData%Cd) + UB(1:2) = ubound(SrcOutputData%Cd) + if (.not. allocated(DstOutputData%Cd)) then + allocate(DstOutputData%Cd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cd = SrcOutputData%Cd + end if + if (allocated(SrcOutputData%chi)) then + LB(1:2) = lbound(SrcOutputData%chi) + UB(1:2) = ubound(SrcOutputData%chi) + if (.not. allocated(DstOutputData%chi)) then + allocate(DstOutputData%chi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%chi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%chi = SrcOutputData%chi + end if + if (allocated(SrcOutputData%Cpmin)) then + LB(1:2) = lbound(SrcOutputData%Cpmin) + UB(1:2) = ubound(SrcOutputData%Cpmin) + if (.not. allocated(DstOutputData%Cpmin)) then + allocate(DstOutputData%Cpmin(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cpmin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cpmin = SrcOutputData%Cpmin + end if +end subroutine + +subroutine BEMT_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(BEMT_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%Vrel)) then + deallocate(OutputData%Vrel) + end if + if (allocated(OutputData%phi)) then + deallocate(OutputData%phi) + end if + if (allocated(OutputData%axInduction)) then + deallocate(OutputData%axInduction) + end if + if (allocated(OutputData%tanInduction)) then + deallocate(OutputData%tanInduction) + end if + if (allocated(OutputData%Re)) then + deallocate(OutputData%Re) + end if + if (allocated(OutputData%AOA)) then + deallocate(OutputData%AOA) + end if + if (allocated(OutputData%Cx)) then + deallocate(OutputData%Cx) + end if + if (allocated(OutputData%Cy)) then + deallocate(OutputData%Cy) + end if + if (allocated(OutputData%Cz)) then + deallocate(OutputData%Cz) + end if + if (allocated(OutputData%Cmx)) then + deallocate(OutputData%Cmx) + end if + if (allocated(OutputData%Cmy)) then + deallocate(OutputData%Cmy) + end if + if (allocated(OutputData%Cmz)) then + deallocate(OutputData%Cmz) + end if + if (allocated(OutputData%Cm)) then + deallocate(OutputData%Cm) + end if + if (allocated(OutputData%Cl)) then + deallocate(OutputData%Cl) + end if + if (allocated(OutputData%Cd)) then + deallocate(OutputData%Cd) + end if + if (allocated(OutputData%chi)) then + deallocate(OutputData%chi) + end if + if (allocated(OutputData%Cpmin)) then + deallocate(OutputData%Cpmin) + end if +end subroutine + +subroutine BEMT_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Vrel)) + if (allocated(InData%Vrel)) then + call RegPackBounds(Buf, 2, lbound(InData%Vrel), ubound(InData%Vrel)) + call RegPack(Buf, InData%Vrel) + end if + call RegPack(Buf, allocated(InData%phi)) + if (allocated(InData%phi)) then + call RegPackBounds(Buf, 2, lbound(InData%phi), ubound(InData%phi)) + call RegPack(Buf, InData%phi) + end if + call RegPack(Buf, allocated(InData%axInduction)) + if (allocated(InData%axInduction)) then + call RegPackBounds(Buf, 2, lbound(InData%axInduction), ubound(InData%axInduction)) + call RegPack(Buf, InData%axInduction) + end if + call RegPack(Buf, allocated(InData%tanInduction)) + if (allocated(InData%tanInduction)) then + call RegPackBounds(Buf, 2, lbound(InData%tanInduction), ubound(InData%tanInduction)) + call RegPack(Buf, InData%tanInduction) + end if + call RegPack(Buf, allocated(InData%Re)) + if (allocated(InData%Re)) then + call RegPackBounds(Buf, 2, lbound(InData%Re), ubound(InData%Re)) + call RegPack(Buf, InData%Re) + end if + call RegPack(Buf, allocated(InData%AOA)) + if (allocated(InData%AOA)) then + call RegPackBounds(Buf, 2, lbound(InData%AOA), ubound(InData%AOA)) + call RegPack(Buf, InData%AOA) + end if + call RegPack(Buf, allocated(InData%Cx)) + if (allocated(InData%Cx)) then + call RegPackBounds(Buf, 2, lbound(InData%Cx), ubound(InData%Cx)) + call RegPack(Buf, InData%Cx) + end if + call RegPack(Buf, allocated(InData%Cy)) + if (allocated(InData%Cy)) then + call RegPackBounds(Buf, 2, lbound(InData%Cy), ubound(InData%Cy)) + call RegPack(Buf, InData%Cy) + end if + call RegPack(Buf, allocated(InData%Cz)) + if (allocated(InData%Cz)) then + call RegPackBounds(Buf, 2, lbound(InData%Cz), ubound(InData%Cz)) + call RegPack(Buf, InData%Cz) + end if + call RegPack(Buf, allocated(InData%Cmx)) + if (allocated(InData%Cmx)) then + call RegPackBounds(Buf, 2, lbound(InData%Cmx), ubound(InData%Cmx)) + call RegPack(Buf, InData%Cmx) + end if + call RegPack(Buf, allocated(InData%Cmy)) + if (allocated(InData%Cmy)) then + call RegPackBounds(Buf, 2, lbound(InData%Cmy), ubound(InData%Cmy)) + call RegPack(Buf, InData%Cmy) + end if + call RegPack(Buf, allocated(InData%Cmz)) + if (allocated(InData%Cmz)) then + call RegPackBounds(Buf, 2, lbound(InData%Cmz), ubound(InData%Cmz)) + call RegPack(Buf, InData%Cmz) + end if + call RegPack(Buf, allocated(InData%Cm)) + if (allocated(InData%Cm)) then + call RegPackBounds(Buf, 2, lbound(InData%Cm), ubound(InData%Cm)) + call RegPack(Buf, InData%Cm) + end if + call RegPack(Buf, allocated(InData%Cl)) + if (allocated(InData%Cl)) then + call RegPackBounds(Buf, 2, lbound(InData%Cl), ubound(InData%Cl)) + call RegPack(Buf, InData%Cl) + end if + call RegPack(Buf, allocated(InData%Cd)) + if (allocated(InData%Cd)) then + call RegPackBounds(Buf, 2, lbound(InData%Cd), ubound(InData%Cd)) + call RegPack(Buf, InData%Cd) + end if + call RegPack(Buf, allocated(InData%chi)) + if (allocated(InData%chi)) then + call RegPackBounds(Buf, 2, lbound(InData%chi), ubound(InData%chi)) + call RegPack(Buf, InData%chi) + end if + call RegPack(Buf, allocated(InData%Cpmin)) + if (allocated(InData%Cpmin)) then + call RegPackBounds(Buf, 2, lbound(InData%Cpmin), ubound(InData%Cpmin)) + call RegPack(Buf, InData%Cpmin) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackOutput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Vrel)) deallocate(OutData%Vrel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vrel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vrel) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%phi)) deallocate(OutData%phi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%phi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%phi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%axInduction)) deallocate(OutData%axInduction) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%axInduction(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%axInduction.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%axInduction) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%tanInduction)) deallocate(OutData%tanInduction) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%tanInduction(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tanInduction.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%tanInduction) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Re)) deallocate(OutData%Re) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Re(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Re.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Re) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AOA)) deallocate(OutData%AOA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AOA(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AOA) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cx)) deallocate(OutData%Cx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cy)) deallocate(OutData%Cy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cy(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cy) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cz)) deallocate(OutData%Cz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cz) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cmx)) deallocate(OutData%Cmx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cmx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cmx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cmy)) deallocate(OutData%Cmy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cmy(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cmy) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cmz)) deallocate(OutData%Cmz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cmz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cmz) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cm)) deallocate(OutData%Cm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cm(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cm) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cl)) deallocate(OutData%Cl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cl(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cl) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cd)) deallocate(OutData%Cd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%chi)) deallocate(OutData%chi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%chi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%chi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cpmin)) deallocate(OutData%Cpmin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cpmin(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cpmin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cpmin) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine BEMT_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(BEMT_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(BEMT_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 = 'BEMT_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 BEMT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL BEMT_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 BEMT_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 BEMT_Input_ExtrapInterp - - - SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call BEMT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call BEMT_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call BEMT_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE BEMT_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. @@ -7052,155 +3082,87 @@ SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(BEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(BEMT_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(BEMT_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 + TYPE(BEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(BEMT_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(BEMT_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 = 'BEMT_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 - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN - DO i2 = LBOUND(u_out%theta,2),UBOUND(u_out%theta,2) - DO i1 = LBOUND(u_out%theta,1),UBOUND(u_out%theta,1) - b = -(u1%theta(i1,i2) - u2%theta(i1,i2)) - u_out%theta(i1,i2) = u1%theta(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - b = -(u1%chi0 - u2%chi0) - u_out%chi0 = u1%chi0 + b * ScaleFactor - b = -(u1%psiSkewOffset - u2%psiSkewOffset) - u_out%psiSkewOffset = u1%psiSkewOffset + b * ScaleFactor -IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN - DO i1 = LBOUND(u_out%psi,1),UBOUND(u_out%psi,1) - b = -(u1%psi(i1) - u2%psi(i1)) - u_out%psi(i1) = u1%psi(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - b = -(u1%omega - u2%omega) - u_out%omega = u1%omega + b * ScaleFactor - b = -(u1%TSR - u2%TSR) - u_out%TSR = u1%TSR + b * ScaleFactor -IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN - DO i2 = LBOUND(u_out%Vx,2),UBOUND(u_out%Vx,2) - DO i1 = LBOUND(u_out%Vx,1),UBOUND(u_out%Vx,1) - b = -(u1%Vx(i1,i2) - u2%Vx(i1,i2)) - u_out%Vx(i1,i2) = u1%Vx(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN - DO i2 = LBOUND(u_out%Vy,2),UBOUND(u_out%Vy,2) - DO i1 = LBOUND(u_out%Vy,1),UBOUND(u_out%Vy,1) - b = -(u1%Vy(i1,i2) - u2%Vy(i1,i2)) - u_out%Vy(i1,i2) = u1%Vy(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Vz) .AND. ALLOCATED(u1%Vz)) THEN - DO i2 = LBOUND(u_out%Vz,2),UBOUND(u_out%Vz,2) - DO i1 = LBOUND(u_out%Vz,1),UBOUND(u_out%Vz,1) - b = -(u1%Vz(i1,i2) - u2%Vz(i1,i2)) - u_out%Vz(i1,i2) = u1%Vz(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN - DO i2 = LBOUND(u_out%omega_z,2),UBOUND(u_out%omega_z,2) - DO i1 = LBOUND(u_out%omega_z,1),UBOUND(u_out%omega_z,1) - b = -(u1%omega_z(i1,i2) - u2%omega_z(i1,i2)) - u_out%omega_z(i1,i2) = u1%omega_z(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%xVelCorr) .AND. ALLOCATED(u1%xVelCorr)) THEN - DO i2 = LBOUND(u_out%xVelCorr,2),UBOUND(u_out%xVelCorr,2) - DO i1 = LBOUND(u_out%xVelCorr,1),UBOUND(u_out%xVelCorr,1) - b = -(u1%xVelCorr(i1,i2) - u2%xVelCorr(i1,i2)) - u_out%xVelCorr(i1,i2) = u1%xVelCorr(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN - DO i2 = LBOUND(u_out%rLocal,2),UBOUND(u_out%rLocal,2) - DO i1 = LBOUND(u_out%rLocal,1),UBOUND(u_out%rLocal,1) - b = -(u1%rLocal(i1,i2) - u2%rLocal(i1,i2)) - u_out%rLocal(i1,i2) = u1%rLocal(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - b = -(u1%Un_disk - u2%Un_disk) - u_out%Un_disk = u1%Un_disk + b * ScaleFactor - DO i1 = LBOUND(u_out%V0,1),UBOUND(u_out%V0,1) - b = -(u1%V0(i1) - u2%V0(i1)) - u_out%V0(i1) = u1%V0(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%x_hat_disk,1),UBOUND(u_out%x_hat_disk,1) - b = -(u1%x_hat_disk(i1) - u2%x_hat_disk(i1)) - u_out%x_hat_disk(i1) = u1%x_hat_disk(i1) + b * ScaleFactor - END DO -IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) - DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) - b = -(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) - u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CantAngle) .AND. ALLOCATED(u1%CantAngle)) THEN - DO i2 = LBOUND(u_out%CantAngle,2),UBOUND(u_out%CantAngle,2) - DO i1 = LBOUND(u_out%CantAngle,1),UBOUND(u_out%CantAngle,1) - b = -(u1%CantAngle(i1,i2) - u2%CantAngle(i1,i2)) - u_out%CantAngle(i1,i2) = u1%CantAngle(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%drdz) .AND. ALLOCATED(u1%drdz)) THEN - DO i2 = LBOUND(u_out%drdz,2),UBOUND(u_out%drdz,2) - DO i1 = LBOUND(u_out%drdz,1),UBOUND(u_out%drdz,1) - b = -(u1%drdz(i1,i2) - u2%drdz(i1,i2)) - u_out%drdz(i1,i2) = u1%drdz(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%toeAngle) .AND. ALLOCATED(u1%toeAngle)) THEN - DO i2 = LBOUND(u_out%toeAngle,2),UBOUND(u_out%toeAngle,2) - DO i1 = LBOUND(u_out%toeAngle,1),UBOUND(u_out%toeAngle,1) - b = -(u1%toeAngle(i1,i2) - u2%toeAngle(i1,i2)) - u_out%toeAngle(i1,i2) = u1%toeAngle(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE BEMT_Input_ExtrapInterp1 - - - SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN + u_out%theta = a1*u1%theta + a2*u2%theta + END IF ! check if allocated + u_out%chi0 = a1*u1%chi0 + a2*u2%chi0 + u_out%psiSkewOffset = a1*u1%psiSkewOffset + a2*u2%psiSkewOffset + IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN + u_out%psi = a1*u1%psi + a2*u2%psi + END IF ! check if allocated + u_out%omega = a1*u1%omega + a2*u2%omega + u_out%TSR = a1*u1%TSR + a2*u2%TSR + IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN + u_out%Vx = a1*u1%Vx + a2*u2%Vx + END IF ! check if allocated + IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN + u_out%Vy = a1*u1%Vy + a2*u2%Vy + END IF ! check if allocated + IF (ALLOCATED(u_out%Vz) .AND. ALLOCATED(u1%Vz)) THEN + u_out%Vz = a1*u1%Vz + a2*u2%Vz + END IF ! check if allocated + IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN + u_out%omega_z = a1*u1%omega_z + a2*u2%omega_z + END IF ! check if allocated + IF (ALLOCATED(u_out%xVelCorr) .AND. ALLOCATED(u1%xVelCorr)) THEN + u_out%xVelCorr = a1*u1%xVelCorr + a2*u2%xVelCorr + END IF ! check if allocated + IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN + u_out%rLocal = a1*u1%rLocal + a2*u2%rLocal + END IF ! check if allocated + u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk + u_out%V0 = a1*u1%V0 + a2*u2%V0 + u_out%x_hat_disk = a1*u1%x_hat_disk + a2*u2%x_hat_disk + IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN + u_out%UserProp = a1*u1%UserProp + a2*u2%UserProp + END IF ! check if allocated + IF (ALLOCATED(u_out%CantAngle) .AND. ALLOCATED(u1%CantAngle)) THEN + u_out%CantAngle = a1*u1%CantAngle + a2*u2%CantAngle + END IF ! check if allocated + IF (ALLOCATED(u_out%drdz) .AND. ALLOCATED(u1%drdz)) THEN + u_out%drdz = a1*u1%drdz + a2*u2%drdz + END IF ! check if allocated + IF (ALLOCATED(u_out%toeAngle) .AND. ALLOCATED(u1%toeAngle)) THEN + u_out%toeAngle = a1*u1%toeAngle + a2*u2%toeAngle + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE BEMT_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. @@ -7214,234 +3176,147 @@ SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(BEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(BEMT_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(BEMT_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(BEMT_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 + TYPE(BEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(BEMT_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(BEMT_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(BEMT_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 = 'BEMT_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN - DO i2 = LBOUND(u_out%theta,2),UBOUND(u_out%theta,2) - DO i1 = LBOUND(u_out%theta,1),UBOUND(u_out%theta,1) - b = (t(3)**2*(u1%theta(i1,i2) - u2%theta(i1,i2)) + t(2)**2*(-u1%theta(i1,i2) + u3%theta(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%theta(i1,i2) + t(3)*u2%theta(i1,i2) - t(2)*u3%theta(i1,i2) ) * scaleFactor - u_out%theta(i1,i2) = u1%theta(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%chi0 - u2%chi0) + t(2)**2*(-u1%chi0 + u3%chi0))* scaleFactor - c = ( (t(2)-t(3))*u1%chi0 + t(3)*u2%chi0 - t(2)*u3%chi0 ) * scaleFactor - u_out%chi0 = u1%chi0 + b + c * t_out - b = (t(3)**2*(u1%psiSkewOffset - u2%psiSkewOffset) + t(2)**2*(-u1%psiSkewOffset + u3%psiSkewOffset))* scaleFactor - c = ( (t(2)-t(3))*u1%psiSkewOffset + t(3)*u2%psiSkewOffset - t(2)*u3%psiSkewOffset ) * scaleFactor - u_out%psiSkewOffset = u1%psiSkewOffset + b + c * t_out -IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN - DO i1 = LBOUND(u_out%psi,1),UBOUND(u_out%psi,1) - b = (t(3)**2*(u1%psi(i1) - u2%psi(i1)) + t(2)**2*(-u1%psi(i1) + u3%psi(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%psi(i1) + t(3)*u2%psi(i1) - t(2)*u3%psi(i1) ) * scaleFactor - u_out%psi(i1) = u1%psi(i1) + b + c * t_out - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%omega - u2%omega) + t(2)**2*(-u1%omega + u3%omega))* scaleFactor - c = ( (t(2)-t(3))*u1%omega + t(3)*u2%omega - t(2)*u3%omega ) * scaleFactor - u_out%omega = u1%omega + b + c * t_out - b = (t(3)**2*(u1%TSR - u2%TSR) + t(2)**2*(-u1%TSR + u3%TSR))* scaleFactor - c = ( (t(2)-t(3))*u1%TSR + t(3)*u2%TSR - t(2)*u3%TSR ) * scaleFactor - u_out%TSR = u1%TSR + b + c * t_out -IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN - DO i2 = LBOUND(u_out%Vx,2),UBOUND(u_out%Vx,2) - DO i1 = LBOUND(u_out%Vx,1),UBOUND(u_out%Vx,1) - b = (t(3)**2*(u1%Vx(i1,i2) - u2%Vx(i1,i2)) + t(2)**2*(-u1%Vx(i1,i2) + u3%Vx(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Vx(i1,i2) + t(3)*u2%Vx(i1,i2) - t(2)*u3%Vx(i1,i2) ) * scaleFactor - u_out%Vx(i1,i2) = u1%Vx(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN - DO i2 = LBOUND(u_out%Vy,2),UBOUND(u_out%Vy,2) - DO i1 = LBOUND(u_out%Vy,1),UBOUND(u_out%Vy,1) - b = (t(3)**2*(u1%Vy(i1,i2) - u2%Vy(i1,i2)) + t(2)**2*(-u1%Vy(i1,i2) + u3%Vy(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Vy(i1,i2) + t(3)*u2%Vy(i1,i2) - t(2)*u3%Vy(i1,i2) ) * scaleFactor - u_out%Vy(i1,i2) = u1%Vy(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Vz) .AND. ALLOCATED(u1%Vz)) THEN - DO i2 = LBOUND(u_out%Vz,2),UBOUND(u_out%Vz,2) - DO i1 = LBOUND(u_out%Vz,1),UBOUND(u_out%Vz,1) - b = (t(3)**2*(u1%Vz(i1,i2) - u2%Vz(i1,i2)) + t(2)**2*(-u1%Vz(i1,i2) + u3%Vz(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Vz(i1,i2) + t(3)*u2%Vz(i1,i2) - t(2)*u3%Vz(i1,i2) ) * scaleFactor - u_out%Vz(i1,i2) = u1%Vz(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN - DO i2 = LBOUND(u_out%omega_z,2),UBOUND(u_out%omega_z,2) - DO i1 = LBOUND(u_out%omega_z,1),UBOUND(u_out%omega_z,1) - b = (t(3)**2*(u1%omega_z(i1,i2) - u2%omega_z(i1,i2)) + t(2)**2*(-u1%omega_z(i1,i2) + u3%omega_z(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%omega_z(i1,i2) + t(3)*u2%omega_z(i1,i2) - t(2)*u3%omega_z(i1,i2) ) * scaleFactor - u_out%omega_z(i1,i2) = u1%omega_z(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%xVelCorr) .AND. ALLOCATED(u1%xVelCorr)) THEN - DO i2 = LBOUND(u_out%xVelCorr,2),UBOUND(u_out%xVelCorr,2) - DO i1 = LBOUND(u_out%xVelCorr,1),UBOUND(u_out%xVelCorr,1) - b = (t(3)**2*(u1%xVelCorr(i1,i2) - u2%xVelCorr(i1,i2)) + t(2)**2*(-u1%xVelCorr(i1,i2) + u3%xVelCorr(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%xVelCorr(i1,i2) + t(3)*u2%xVelCorr(i1,i2) - t(2)*u3%xVelCorr(i1,i2) ) * scaleFactor - u_out%xVelCorr(i1,i2) = u1%xVelCorr(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN - DO i2 = LBOUND(u_out%rLocal,2),UBOUND(u_out%rLocal,2) - DO i1 = LBOUND(u_out%rLocal,1),UBOUND(u_out%rLocal,1) - b = (t(3)**2*(u1%rLocal(i1,i2) - u2%rLocal(i1,i2)) + t(2)**2*(-u1%rLocal(i1,i2) + u3%rLocal(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%rLocal(i1,i2) + t(3)*u2%rLocal(i1,i2) - t(2)*u3%rLocal(i1,i2) ) * scaleFactor - u_out%rLocal(i1,i2) = u1%rLocal(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))* scaleFactor - c = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) * scaleFactor - u_out%Un_disk = u1%Un_disk + b + c * t_out - DO i1 = LBOUND(u_out%V0,1),UBOUND(u_out%V0,1) - b = (t(3)**2*(u1%V0(i1) - u2%V0(i1)) + t(2)**2*(-u1%V0(i1) + u3%V0(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%V0(i1) + t(3)*u2%V0(i1) - t(2)*u3%V0(i1) ) * scaleFactor - u_out%V0(i1) = u1%V0(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%x_hat_disk,1),UBOUND(u_out%x_hat_disk,1) - b = (t(3)**2*(u1%x_hat_disk(i1) - u2%x_hat_disk(i1)) + t(2)**2*(-u1%x_hat_disk(i1) + u3%x_hat_disk(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%x_hat_disk(i1) + t(3)*u2%x_hat_disk(i1) - t(2)*u3%x_hat_disk(i1) ) * scaleFactor - u_out%x_hat_disk(i1) = u1%x_hat_disk(i1) + b + c * t_out - END DO -IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) - DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) - b = (t(3)**2*(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) + t(2)**2*(-u1%UserProp(i1,i2) + u3%UserProp(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%UserProp(i1,i2) + t(3)*u2%UserProp(i1,i2) - t(2)*u3%UserProp(i1,i2) ) * scaleFactor - u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CantAngle) .AND. ALLOCATED(u1%CantAngle)) THEN - DO i2 = LBOUND(u_out%CantAngle,2),UBOUND(u_out%CantAngle,2) - DO i1 = LBOUND(u_out%CantAngle,1),UBOUND(u_out%CantAngle,1) - b = (t(3)**2*(u1%CantAngle(i1,i2) - u2%CantAngle(i1,i2)) + t(2)**2*(-u1%CantAngle(i1,i2) + u3%CantAngle(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%CantAngle(i1,i2) + t(3)*u2%CantAngle(i1,i2) - t(2)*u3%CantAngle(i1,i2) ) * scaleFactor - u_out%CantAngle(i1,i2) = u1%CantAngle(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%drdz) .AND. ALLOCATED(u1%drdz)) THEN - DO i2 = LBOUND(u_out%drdz,2),UBOUND(u_out%drdz,2) - DO i1 = LBOUND(u_out%drdz,1),UBOUND(u_out%drdz,1) - b = (t(3)**2*(u1%drdz(i1,i2) - u2%drdz(i1,i2)) + t(2)**2*(-u1%drdz(i1,i2) + u3%drdz(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%drdz(i1,i2) + t(3)*u2%drdz(i1,i2) - t(2)*u3%drdz(i1,i2) ) * scaleFactor - u_out%drdz(i1,i2) = u1%drdz(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%toeAngle) .AND. ALLOCATED(u1%toeAngle)) THEN - DO i2 = LBOUND(u_out%toeAngle,2),UBOUND(u_out%toeAngle,2) - DO i1 = LBOUND(u_out%toeAngle,1),UBOUND(u_out%toeAngle,1) - b = (t(3)**2*(u1%toeAngle(i1,i2) - u2%toeAngle(i1,i2)) + t(2)**2*(-u1%toeAngle(i1,i2) + u3%toeAngle(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%toeAngle(i1,i2) + t(3)*u2%toeAngle(i1,i2) - t(2)*u3%toeAngle(i1,i2) ) * scaleFactor - u_out%toeAngle(i1,i2) = u1%toeAngle(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE BEMT_Input_ExtrapInterp2 - - - SUBROUTINE BEMT_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(BEMT_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(BEMT_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN + u_out%theta = a1*u1%theta + a2*u2%theta + a3*u3%theta + END IF ! check if allocated + u_out%chi0 = a1*u1%chi0 + a2*u2%chi0 + a3*u3%chi0 + u_out%psiSkewOffset = a1*u1%psiSkewOffset + a2*u2%psiSkewOffset + a3*u3%psiSkewOffset + IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN + u_out%psi = a1*u1%psi + a2*u2%psi + a3*u3%psi + END IF ! check if allocated + u_out%omega = a1*u1%omega + a2*u2%omega + a3*u3%omega + u_out%TSR = a1*u1%TSR + a2*u2%TSR + a3*u3%TSR + IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN + u_out%Vx = a1*u1%Vx + a2*u2%Vx + a3*u3%Vx + END IF ! check if allocated + IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN + u_out%Vy = a1*u1%Vy + a2*u2%Vy + a3*u3%Vy + END IF ! check if allocated + IF (ALLOCATED(u_out%Vz) .AND. ALLOCATED(u1%Vz)) THEN + u_out%Vz = a1*u1%Vz + a2*u2%Vz + a3*u3%Vz + END IF ! check if allocated + IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN + u_out%omega_z = a1*u1%omega_z + a2*u2%omega_z + a3*u3%omega_z + END IF ! check if allocated + IF (ALLOCATED(u_out%xVelCorr) .AND. ALLOCATED(u1%xVelCorr)) THEN + u_out%xVelCorr = a1*u1%xVelCorr + a2*u2%xVelCorr + a3*u3%xVelCorr + END IF ! check if allocated + IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN + u_out%rLocal = a1*u1%rLocal + a2*u2%rLocal + a3*u3%rLocal + END IF ! check if allocated + u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk + a3*u3%Un_disk + u_out%V0 = a1*u1%V0 + a2*u2%V0 + a3*u3%V0 + u_out%x_hat_disk = a1*u1%x_hat_disk + a2*u2%x_hat_disk + a3*u3%x_hat_disk + IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN + u_out%UserProp = a1*u1%UserProp + a2*u2%UserProp + a3*u3%UserProp + END IF ! check if allocated + IF (ALLOCATED(u_out%CantAngle) .AND. ALLOCATED(u1%CantAngle)) THEN + u_out%CantAngle = a1*u1%CantAngle + a2*u2%CantAngle + a3*u3%CantAngle + END IF ! check if allocated + IF (ALLOCATED(u_out%drdz) .AND. ALLOCATED(u1%drdz)) THEN + u_out%drdz = a1*u1%drdz + a2*u2%drdz + a3*u3%drdz + END IF ! check if allocated + IF (ALLOCATED(u_out%toeAngle) .AND. ALLOCATED(u1%toeAngle)) THEN + u_out%toeAngle = a1*u1%toeAngle + a2*u2%toeAngle + a3*u3%toeAngle + END IF ! check if allocated +END SUBROUTINE + +subroutine BEMT_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(BEMT_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(BEMT_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 = 'BEMT_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 BEMT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL BEMT_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 BEMT_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 BEMT_Output_ExtrapInterp - - - SUBROUTINE BEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call BEMT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call BEMT_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call BEMT_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE BEMT_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. @@ -7453,179 +3328,95 @@ SUBROUTINE BEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(BEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(BEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(BEMT_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 + TYPE(BEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(BEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(BEMT_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 = 'BEMT_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN - DO i2 = LBOUND(y_out%Vrel,2),UBOUND(y_out%Vrel,2) - DO i1 = LBOUND(y_out%Vrel,1),UBOUND(y_out%Vrel,1) - b = -(y1%Vrel(i1,i2) - y2%Vrel(i1,i2)) - y_out%Vrel(i1,i2) = y1%Vrel(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN - DO i2 = LBOUND(y_out%phi,2),UBOUND(y_out%phi,2) - DO i1 = LBOUND(y_out%phi,1),UBOUND(y_out%phi,1) - b = -(y1%phi(i1,i2) - y2%phi(i1,i2)) - y_out%phi(i1,i2) = y1%phi(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN - DO i2 = LBOUND(y_out%axInduction,2),UBOUND(y_out%axInduction,2) - DO i1 = LBOUND(y_out%axInduction,1),UBOUND(y_out%axInduction,1) - b = -(y1%axInduction(i1,i2) - y2%axInduction(i1,i2)) - y_out%axInduction(i1,i2) = y1%axInduction(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN - DO i2 = LBOUND(y_out%tanInduction,2),UBOUND(y_out%tanInduction,2) - DO i1 = LBOUND(y_out%tanInduction,1),UBOUND(y_out%tanInduction,1) - b = -(y1%tanInduction(i1,i2) - y2%tanInduction(i1,i2)) - y_out%tanInduction(i1,i2) = y1%tanInduction(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN - DO i2 = LBOUND(y_out%Re,2),UBOUND(y_out%Re,2) - DO i1 = LBOUND(y_out%Re,1),UBOUND(y_out%Re,1) - b = -(y1%Re(i1,i2) - y2%Re(i1,i2)) - y_out%Re(i1,i2) = y1%Re(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN - DO i2 = LBOUND(y_out%AOA,2),UBOUND(y_out%AOA,2) - DO i1 = LBOUND(y_out%AOA,1),UBOUND(y_out%AOA,1) - b = -(y1%AOA(i1,i2) - y2%AOA(i1,i2)) - y_out%AOA(i1,i2) = y1%AOA(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN - DO i2 = LBOUND(y_out%Cx,2),UBOUND(y_out%Cx,2) - DO i1 = LBOUND(y_out%Cx,1),UBOUND(y_out%Cx,1) - b = -(y1%Cx(i1,i2) - y2%Cx(i1,i2)) - y_out%Cx(i1,i2) = y1%Cx(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN - DO i2 = LBOUND(y_out%Cy,2),UBOUND(y_out%Cy,2) - DO i1 = LBOUND(y_out%Cy,1),UBOUND(y_out%Cy,1) - b = -(y1%Cy(i1,i2) - y2%Cy(i1,i2)) - y_out%Cy(i1,i2) = y1%Cy(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cz) .AND. ALLOCATED(y1%Cz)) THEN - DO i2 = LBOUND(y_out%Cz,2),UBOUND(y_out%Cz,2) - DO i1 = LBOUND(y_out%Cz,1),UBOUND(y_out%Cz,1) - b = -(y1%Cz(i1,i2) - y2%Cz(i1,i2)) - y_out%Cz(i1,i2) = y1%Cz(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmx) .AND. ALLOCATED(y1%Cmx)) THEN - DO i2 = LBOUND(y_out%Cmx,2),UBOUND(y_out%Cmx,2) - DO i1 = LBOUND(y_out%Cmx,1),UBOUND(y_out%Cmx,1) - b = -(y1%Cmx(i1,i2) - y2%Cmx(i1,i2)) - y_out%Cmx(i1,i2) = y1%Cmx(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmy) .AND. ALLOCATED(y1%Cmy)) THEN - DO i2 = LBOUND(y_out%Cmy,2),UBOUND(y_out%Cmy,2) - DO i1 = LBOUND(y_out%Cmy,1),UBOUND(y_out%Cmy,1) - b = -(y1%Cmy(i1,i2) - y2%Cmy(i1,i2)) - y_out%Cmy(i1,i2) = y1%Cmy(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmz) .AND. ALLOCATED(y1%Cmz)) THEN - DO i2 = LBOUND(y_out%Cmz,2),UBOUND(y_out%Cmz,2) - DO i1 = LBOUND(y_out%Cmz,1),UBOUND(y_out%Cmz,1) - b = -(y1%Cmz(i1,i2) - y2%Cmz(i1,i2)) - y_out%Cmz(i1,i2) = y1%Cmz(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN - DO i2 = LBOUND(y_out%Cm,2),UBOUND(y_out%Cm,2) - DO i1 = LBOUND(y_out%Cm,1),UBOUND(y_out%Cm,1) - b = -(y1%Cm(i1,i2) - y2%Cm(i1,i2)) - y_out%Cm(i1,i2) = y1%Cm(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN - DO i2 = LBOUND(y_out%Cl,2),UBOUND(y_out%Cl,2) - DO i1 = LBOUND(y_out%Cl,1),UBOUND(y_out%Cl,1) - b = -(y1%Cl(i1,i2) - y2%Cl(i1,i2)) - y_out%Cl(i1,i2) = y1%Cl(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN - DO i2 = LBOUND(y_out%Cd,2),UBOUND(y_out%Cd,2) - DO i1 = LBOUND(y_out%Cd,1),UBOUND(y_out%Cd,1) - b = -(y1%Cd(i1,i2) - y2%Cd(i1,i2)) - y_out%Cd(i1,i2) = y1%Cd(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN - DO i2 = LBOUND(y_out%chi,2),UBOUND(y_out%chi,2) - DO i1 = LBOUND(y_out%chi,1),UBOUND(y_out%chi,1) - b = -(y1%chi(i1,i2) - y2%chi(i1,i2)) - y_out%chi(i1,i2) = y1%chi(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN - DO i2 = LBOUND(y_out%Cpmin,2),UBOUND(y_out%Cpmin,2) - DO i1 = LBOUND(y_out%Cpmin,1),UBOUND(y_out%Cpmin,1) - b = -(y1%Cpmin(i1,i2) - y2%Cpmin(i1,i2)) - y_out%Cpmin(i1,i2) = y1%Cpmin(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE BEMT_Output_ExtrapInterp1 - - - SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN + y_out%Vrel = a1*y1%Vrel + a2*y2%Vrel + END IF ! check if allocated + IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN + y_out%phi = a1*y1%phi + a2*y2%phi + END IF ! check if allocated + IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN + y_out%axInduction = a1*y1%axInduction + a2*y2%axInduction + END IF ! check if allocated + IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN + y_out%tanInduction = a1*y1%tanInduction + a2*y2%tanInduction + END IF ! check if allocated + IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN + y_out%Re = a1*y1%Re + a2*y2%Re + END IF ! check if allocated + IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN + y_out%AOA = a1*y1%AOA + a2*y2%AOA + END IF ! check if allocated + IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN + y_out%Cx = a1*y1%Cx + a2*y2%Cx + END IF ! check if allocated + IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN + y_out%Cy = a1*y1%Cy + a2*y2%Cy + END IF ! check if allocated + IF (ALLOCATED(y_out%Cz) .AND. ALLOCATED(y1%Cz)) THEN + y_out%Cz = a1*y1%Cz + a2*y2%Cz + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmx) .AND. ALLOCATED(y1%Cmx)) THEN + y_out%Cmx = a1*y1%Cmx + a2*y2%Cmx + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmy) .AND. ALLOCATED(y1%Cmy)) THEN + y_out%Cmy = a1*y1%Cmy + a2*y2%Cmy + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmz) .AND. ALLOCATED(y1%Cmz)) THEN + y_out%Cmz = a1*y1%Cmz + a2*y2%Cmz + END IF ! check if allocated + IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN + y_out%Cm = a1*y1%Cm + a2*y2%Cm + END IF ! check if allocated + IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN + y_out%Cl = a1*y1%Cl + a2*y2%Cl + END IF ! check if allocated + IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN + y_out%Cd = a1*y1%Cd + a2*y2%Cd + END IF ! check if allocated + IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN + y_out%chi = a1*y1%chi + a2*y2%chi + END IF ! check if allocated + IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN + y_out%Cpmin = a1*y1%Cpmin + a2*y2%Cpmin + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE BEMT_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. @@ -7639,202 +3430,100 @@ SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(BEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(BEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(BEMT_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(BEMT_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 + TYPE(BEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(BEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(BEMT_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(BEMT_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 = 'BEMT_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN - DO i2 = LBOUND(y_out%Vrel,2),UBOUND(y_out%Vrel,2) - DO i1 = LBOUND(y_out%Vrel,1),UBOUND(y_out%Vrel,1) - b = (t(3)**2*(y1%Vrel(i1,i2) - y2%Vrel(i1,i2)) + t(2)**2*(-y1%Vrel(i1,i2) + y3%Vrel(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Vrel(i1,i2) + t(3)*y2%Vrel(i1,i2) - t(2)*y3%Vrel(i1,i2) ) * scaleFactor - y_out%Vrel(i1,i2) = y1%Vrel(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN - DO i2 = LBOUND(y_out%phi,2),UBOUND(y_out%phi,2) - DO i1 = LBOUND(y_out%phi,1),UBOUND(y_out%phi,1) - b = (t(3)**2*(y1%phi(i1,i2) - y2%phi(i1,i2)) + t(2)**2*(-y1%phi(i1,i2) + y3%phi(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%phi(i1,i2) + t(3)*y2%phi(i1,i2) - t(2)*y3%phi(i1,i2) ) * scaleFactor - y_out%phi(i1,i2) = y1%phi(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN - DO i2 = LBOUND(y_out%axInduction,2),UBOUND(y_out%axInduction,2) - DO i1 = LBOUND(y_out%axInduction,1),UBOUND(y_out%axInduction,1) - b = (t(3)**2*(y1%axInduction(i1,i2) - y2%axInduction(i1,i2)) + t(2)**2*(-y1%axInduction(i1,i2) + y3%axInduction(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%axInduction(i1,i2) + t(3)*y2%axInduction(i1,i2) - t(2)*y3%axInduction(i1,i2) ) * scaleFactor - y_out%axInduction(i1,i2) = y1%axInduction(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN - DO i2 = LBOUND(y_out%tanInduction,2),UBOUND(y_out%tanInduction,2) - DO i1 = LBOUND(y_out%tanInduction,1),UBOUND(y_out%tanInduction,1) - b = (t(3)**2*(y1%tanInduction(i1,i2) - y2%tanInduction(i1,i2)) + t(2)**2*(-y1%tanInduction(i1,i2) + y3%tanInduction(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%tanInduction(i1,i2) + t(3)*y2%tanInduction(i1,i2) - t(2)*y3%tanInduction(i1,i2) ) * scaleFactor - y_out%tanInduction(i1,i2) = y1%tanInduction(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN - DO i2 = LBOUND(y_out%Re,2),UBOUND(y_out%Re,2) - DO i1 = LBOUND(y_out%Re,1),UBOUND(y_out%Re,1) - b = (t(3)**2*(y1%Re(i1,i2) - y2%Re(i1,i2)) + t(2)**2*(-y1%Re(i1,i2) + y3%Re(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Re(i1,i2) + t(3)*y2%Re(i1,i2) - t(2)*y3%Re(i1,i2) ) * scaleFactor - y_out%Re(i1,i2) = y1%Re(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN - DO i2 = LBOUND(y_out%AOA,2),UBOUND(y_out%AOA,2) - DO i1 = LBOUND(y_out%AOA,1),UBOUND(y_out%AOA,1) - b = (t(3)**2*(y1%AOA(i1,i2) - y2%AOA(i1,i2)) + t(2)**2*(-y1%AOA(i1,i2) + y3%AOA(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%AOA(i1,i2) + t(3)*y2%AOA(i1,i2) - t(2)*y3%AOA(i1,i2) ) * scaleFactor - y_out%AOA(i1,i2) = y1%AOA(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN - DO i2 = LBOUND(y_out%Cx,2),UBOUND(y_out%Cx,2) - DO i1 = LBOUND(y_out%Cx,1),UBOUND(y_out%Cx,1) - b = (t(3)**2*(y1%Cx(i1,i2) - y2%Cx(i1,i2)) + t(2)**2*(-y1%Cx(i1,i2) + y3%Cx(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cx(i1,i2) + t(3)*y2%Cx(i1,i2) - t(2)*y3%Cx(i1,i2) ) * scaleFactor - y_out%Cx(i1,i2) = y1%Cx(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN - DO i2 = LBOUND(y_out%Cy,2),UBOUND(y_out%Cy,2) - DO i1 = LBOUND(y_out%Cy,1),UBOUND(y_out%Cy,1) - b = (t(3)**2*(y1%Cy(i1,i2) - y2%Cy(i1,i2)) + t(2)**2*(-y1%Cy(i1,i2) + y3%Cy(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cy(i1,i2) + t(3)*y2%Cy(i1,i2) - t(2)*y3%Cy(i1,i2) ) * scaleFactor - y_out%Cy(i1,i2) = y1%Cy(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cz) .AND. ALLOCATED(y1%Cz)) THEN - DO i2 = LBOUND(y_out%Cz,2),UBOUND(y_out%Cz,2) - DO i1 = LBOUND(y_out%Cz,1),UBOUND(y_out%Cz,1) - b = (t(3)**2*(y1%Cz(i1,i2) - y2%Cz(i1,i2)) + t(2)**2*(-y1%Cz(i1,i2) + y3%Cz(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cz(i1,i2) + t(3)*y2%Cz(i1,i2) - t(2)*y3%Cz(i1,i2) ) * scaleFactor - y_out%Cz(i1,i2) = y1%Cz(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmx) .AND. ALLOCATED(y1%Cmx)) THEN - DO i2 = LBOUND(y_out%Cmx,2),UBOUND(y_out%Cmx,2) - DO i1 = LBOUND(y_out%Cmx,1),UBOUND(y_out%Cmx,1) - b = (t(3)**2*(y1%Cmx(i1,i2) - y2%Cmx(i1,i2)) + t(2)**2*(-y1%Cmx(i1,i2) + y3%Cmx(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cmx(i1,i2) + t(3)*y2%Cmx(i1,i2) - t(2)*y3%Cmx(i1,i2) ) * scaleFactor - y_out%Cmx(i1,i2) = y1%Cmx(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmy) .AND. ALLOCATED(y1%Cmy)) THEN - DO i2 = LBOUND(y_out%Cmy,2),UBOUND(y_out%Cmy,2) - DO i1 = LBOUND(y_out%Cmy,1),UBOUND(y_out%Cmy,1) - b = (t(3)**2*(y1%Cmy(i1,i2) - y2%Cmy(i1,i2)) + t(2)**2*(-y1%Cmy(i1,i2) + y3%Cmy(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cmy(i1,i2) + t(3)*y2%Cmy(i1,i2) - t(2)*y3%Cmy(i1,i2) ) * scaleFactor - y_out%Cmy(i1,i2) = y1%Cmy(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmz) .AND. ALLOCATED(y1%Cmz)) THEN - DO i2 = LBOUND(y_out%Cmz,2),UBOUND(y_out%Cmz,2) - DO i1 = LBOUND(y_out%Cmz,1),UBOUND(y_out%Cmz,1) - b = (t(3)**2*(y1%Cmz(i1,i2) - y2%Cmz(i1,i2)) + t(2)**2*(-y1%Cmz(i1,i2) + y3%Cmz(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cmz(i1,i2) + t(3)*y2%Cmz(i1,i2) - t(2)*y3%Cmz(i1,i2) ) * scaleFactor - y_out%Cmz(i1,i2) = y1%Cmz(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN - DO i2 = LBOUND(y_out%Cm,2),UBOUND(y_out%Cm,2) - DO i1 = LBOUND(y_out%Cm,1),UBOUND(y_out%Cm,1) - b = (t(3)**2*(y1%Cm(i1,i2) - y2%Cm(i1,i2)) + t(2)**2*(-y1%Cm(i1,i2) + y3%Cm(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cm(i1,i2) + t(3)*y2%Cm(i1,i2) - t(2)*y3%Cm(i1,i2) ) * scaleFactor - y_out%Cm(i1,i2) = y1%Cm(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN - DO i2 = LBOUND(y_out%Cl,2),UBOUND(y_out%Cl,2) - DO i1 = LBOUND(y_out%Cl,1),UBOUND(y_out%Cl,1) - b = (t(3)**2*(y1%Cl(i1,i2) - y2%Cl(i1,i2)) + t(2)**2*(-y1%Cl(i1,i2) + y3%Cl(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cl(i1,i2) + t(3)*y2%Cl(i1,i2) - t(2)*y3%Cl(i1,i2) ) * scaleFactor - y_out%Cl(i1,i2) = y1%Cl(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN - DO i2 = LBOUND(y_out%Cd,2),UBOUND(y_out%Cd,2) - DO i1 = LBOUND(y_out%Cd,1),UBOUND(y_out%Cd,1) - b = (t(3)**2*(y1%Cd(i1,i2) - y2%Cd(i1,i2)) + t(2)**2*(-y1%Cd(i1,i2) + y3%Cd(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cd(i1,i2) + t(3)*y2%Cd(i1,i2) - t(2)*y3%Cd(i1,i2) ) * scaleFactor - y_out%Cd(i1,i2) = y1%Cd(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN - DO i2 = LBOUND(y_out%chi,2),UBOUND(y_out%chi,2) - DO i1 = LBOUND(y_out%chi,1),UBOUND(y_out%chi,1) - b = (t(3)**2*(y1%chi(i1,i2) - y2%chi(i1,i2)) + t(2)**2*(-y1%chi(i1,i2) + y3%chi(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%chi(i1,i2) + t(3)*y2%chi(i1,i2) - t(2)*y3%chi(i1,i2) ) * scaleFactor - y_out%chi(i1,i2) = y1%chi(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN - DO i2 = LBOUND(y_out%Cpmin,2),UBOUND(y_out%Cpmin,2) - DO i1 = LBOUND(y_out%Cpmin,1),UBOUND(y_out%Cpmin,1) - b = (t(3)**2*(y1%Cpmin(i1,i2) - y2%Cpmin(i1,i2)) + t(2)**2*(-y1%Cpmin(i1,i2) + y3%Cpmin(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cpmin(i1,i2) + t(3)*y2%Cpmin(i1,i2) - t(2)*y3%Cpmin(i1,i2) ) * scaleFactor - y_out%Cpmin(i1,i2) = y1%Cpmin(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE BEMT_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN + y_out%Vrel = a1*y1%Vrel + a2*y2%Vrel + a3*y3%Vrel + END IF ! check if allocated + IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN + y_out%phi = a1*y1%phi + a2*y2%phi + a3*y3%phi + END IF ! check if allocated + IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN + y_out%axInduction = a1*y1%axInduction + a2*y2%axInduction + a3*y3%axInduction + END IF ! check if allocated + IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN + y_out%tanInduction = a1*y1%tanInduction + a2*y2%tanInduction + a3*y3%tanInduction + END IF ! check if allocated + IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN + y_out%Re = a1*y1%Re + a2*y2%Re + a3*y3%Re + END IF ! check if allocated + IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN + y_out%AOA = a1*y1%AOA + a2*y2%AOA + a3*y3%AOA + END IF ! check if allocated + IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN + y_out%Cx = a1*y1%Cx + a2*y2%Cx + a3*y3%Cx + END IF ! check if allocated + IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN + y_out%Cy = a1*y1%Cy + a2*y2%Cy + a3*y3%Cy + END IF ! check if allocated + IF (ALLOCATED(y_out%Cz) .AND. ALLOCATED(y1%Cz)) THEN + y_out%Cz = a1*y1%Cz + a2*y2%Cz + a3*y3%Cz + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmx) .AND. ALLOCATED(y1%Cmx)) THEN + y_out%Cmx = a1*y1%Cmx + a2*y2%Cmx + a3*y3%Cmx + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmy) .AND. ALLOCATED(y1%Cmy)) THEN + y_out%Cmy = a1*y1%Cmy + a2*y2%Cmy + a3*y3%Cmy + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmz) .AND. ALLOCATED(y1%Cmz)) THEN + y_out%Cmz = a1*y1%Cmz + a2*y2%Cmz + a3*y3%Cmz + END IF ! check if allocated + IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN + y_out%Cm = a1*y1%Cm + a2*y2%Cm + a3*y3%Cm + END IF ! check if allocated + IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN + y_out%Cl = a1*y1%Cl + a2*y2%Cl + a3*y3%Cl + END IF ! check if allocated + IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN + y_out%Cd = a1*y1%Cd + a2*y2%Cd + a3*y3%Cd + END IF ! check if allocated + IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN + y_out%chi = a1*y1%chi + a2*y2%chi + a3*y3%chi + END IF ! check if allocated + IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN + y_out%Cpmin = a1*y1%Cpmin + a2*y2%Cpmin + a3*y3%Cpmin + END IF ! check if allocated +END SUBROUTINE END MODULE BEMT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index f77964897a..76ad84f50f 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -39,10 +39,10 @@ MODULE DBEMT_Types INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_cont_tauConst = 3 ! use continuous formulation with constant tau1 [-] ! ========= DBEMT_InitInputType ======= TYPE, PUBLIC :: DBEMT_InitInputType - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumNodes !< Number of nodes on each blade [-] - REAL(ReKi) :: tau1_const !< delay value based on disk-averaged quantities [-] - INTEGER(IntKi) :: DBEMT_Mod !< DBEMT Model. 1 = constant tau1, 2 = time dependent tau1, 3=continuous form with constant tau1 [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumNodes = 0_IntKi !< Number of nodes on each blade [-] + REAL(ReKi) :: tau1_const = 0.0_ReKi !< delay value based on disk-averaged quantities [-] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< DBEMT Model. 1 = constant tau1, 2 = time dependent tau1, 3=continuous form with constant tau1 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rLocal !< Radial distance to blade node from the center of rotation, measured in the rotor plane, needed for DBEMT [m] END TYPE DBEMT_InitInputType ! ======================= @@ -53,8 +53,8 @@ MODULE DBEMT_Types ! ======================= ! ========= DBEMT_ElementContinuousStateType ======= TYPE, PUBLIC :: DBEMT_ElementContinuousStateType - REAL(R8Ki) , DIMENSION(1:2) :: vind !< The filtered induced velocity, [1,i,j] is the axial induced velocity (-Vx*a) at node i on blade j and [2,i,j] is the tantential induced velocity (Vy*a') [m/s] - REAL(R8Ki) , DIMENSION(1:2) :: vind_1 !< The filtered reduced or intermediate induced velocity [m/s] + REAL(R8Ki) , DIMENSION(1:2) :: vind = 0.0_R8Ki !< The filtered induced velocity, [1,i,j] is the axial induced velocity (-Vx*a) at node i on blade j and [2,i,j] is the tantential induced velocity (Vy*a') [m/s] + REAL(R8Ki) , DIMENSION(1:2) :: vind_1 = 0.0_R8Ki !< The filtered reduced or intermediate induced velocity [m/s] END TYPE DBEMT_ElementContinuousStateType ! ======================= ! ========= DBEMT_ContinuousStateType ======= @@ -64,51 +64,51 @@ MODULE DBEMT_Types ! ======================= ! ========= DBEMT_DiscreteStateType ======= TYPE, PUBLIC :: DBEMT_DiscreteStateType - REAL(SiKi) :: DummyState !< Remove this variable if you have continuous states [-] + REAL(SiKi) :: DummyState = 0.0_R4Ki !< Remove this variable if you have continuous states [-] END TYPE DBEMT_DiscreteStateType ! ======================= ! ========= DBEMT_ConstraintStateType ======= TYPE, PUBLIC :: DBEMT_ConstraintStateType - REAL(SiKi) :: DummyState !< Remove this variable if you have constraint states [-] + REAL(SiKi) :: DummyState = 0.0_R4Ki !< Remove this variable if you have constraint states [-] END TYPE DBEMT_ConstraintStateType ! ======================= ! ========= DBEMT_OtherStateType ======= TYPE, PUBLIC :: DBEMT_OtherStateType 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) [-] + REAL(ReKi) :: tau1 = 0.0_ReKi !< value of tau1 used in updateStates (for output-to-file only) [-] + REAL(ReKi) :: tau2 = 0.0_ReKi !< 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 [-] TYPE(DBEMT_ContinuousStateType) , DIMENSION(1:4) :: xdot !< derivative history for continuous state integrators [-] END TYPE DBEMT_OtherStateType ! ======================= ! ========= DBEMT_MiscVarType ======= TYPE, PUBLIC :: DBEMT_MiscVarType - LOGICAL :: FirstWarn_tau1 !< flag so tau1 limit warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_tau1 = .false. !< flag so tau1 limit warning doesn't get repeated forever [-] END TYPE DBEMT_MiscVarType ! ======================= ! ========= DBEMT_ParameterType ======= TYPE, PUBLIC :: DBEMT_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] INTEGER(IntKi) :: lin_nx = 0 !< Number of continuous states for linearization [-] - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumNodes !< Number of nodes on each blade [-] - REAL(ReKi) :: k_0ye !< Filter dynamics constant [default = 0.6 ] [-] - REAL(ReKi) :: tau1_const !< constant version of the delay value [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumNodes = 0_IntKi !< Number of nodes on each blade [-] + REAL(ReKi) :: k_0ye = 0.0_ReKi !< Filter dynamics constant [default = 0.6 ] [-] + REAL(ReKi) :: tau1_const = 0.0_ReKi !< constant version of the delay value [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: spanRatio !< static span ratio of each blade node [-] - INTEGER(IntKi) :: DBEMT_Mod !< DBEMT Model. 1 = constant tau1, 2 = time dependent tau1, 3=continuous form of constant tau1 [-] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< DBEMT Model. 1 = constant tau1, 2 = time dependent tau1, 3=continuous form of constant tau1 [-] END TYPE DBEMT_ParameterType ! ======================= ! ========= DBEMT_ElementInputType ======= TYPE, PUBLIC :: DBEMT_ElementInputType - REAL(ReKi) , DIMENSION(1:2) :: vind_s !< The unfiltered induced velocity, [1] is the axial induced velocity (-Vx*a) and [2] is the tangential induced velocity (Vy*a') at node i on blade j. Note that the inputs are used only operated on at a particular node and blade, so we don't store all elements [m/s] - REAL(ReKi) :: spanRatio !< Normalized span location of blade node [-] + REAL(ReKi) , DIMENSION(1:2) :: vind_s = 0.0_ReKi !< The unfiltered induced velocity, [1] is the axial induced velocity (-Vx*a) and [2] is the tangential induced velocity (Vy*a') at node i on blade j. Note that the inputs are used only operated on at a particular node and blade, so we don't store all elements [m/s] + REAL(ReKi) :: spanRatio = 0.0_ReKi !< Normalized span location of blade node [-] END TYPE DBEMT_ElementInputType ! ======================= ! ========= DBEMT_InputType ======= TYPE, PUBLIC :: DBEMT_InputType - REAL(ReKi) :: AxInd_disk !< Disk-averaged axial induction (for time-varying tau) [-] - REAL(ReKi) :: Un_disk !< Disk-averaged normal relative inflow velocity (for time-varying tau) [m/s] - REAL(ReKi) :: R_disk !< Disk-averaged rotor radius (for time-varying tau) [m] + REAL(ReKi) :: AxInd_disk = 0.0_ReKi !< Disk-averaged axial induction (for time-varying tau) [-] + REAL(ReKi) :: Un_disk = 0.0_ReKi !< Disk-averaged normal relative inflow velocity (for time-varying tau) [m/s] + REAL(ReKi) :: R_disk = 0.0_ReKi !< Disk-averaged rotor radius (for time-varying tau) [m] TYPE(DBEMT_ElementInputType) , DIMENSION(:,:), ALLOCATABLE :: element !< The element-level inputs at each blade node [-] END TYPE DBEMT_InputType ! ======================= @@ -118,2576 +118,947 @@ MODULE DBEMT_Types END TYPE DBEMT_OutputType ! ======================= CONTAINS - SUBROUTINE DBEMT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(DBEMT_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 = 'DBEMT_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%NumBlades = SrcInitInputData%NumBlades - DstInitInputData%NumNodes = SrcInitInputData%NumNodes - DstInitInputData%tau1_const = SrcInitInputData%tau1_const - DstInitInputData%DBEMT_Mod = SrcInitInputData%DBEMT_Mod -IF (ALLOCATED(SrcInitInputData%rLocal)) THEN - i1_l = LBOUND(SrcInitInputData%rLocal,1) - i1_u = UBOUND(SrcInitInputData%rLocal,1) - i2_l = LBOUND(SrcInitInputData%rLocal,2) - i2_u = UBOUND(SrcInitInputData%rLocal,2) - IF (.NOT. ALLOCATED(DstInitInputData%rLocal)) THEN - ALLOCATE(DstInitInputData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%rLocal = SrcInitInputData%rLocal -ENDIF - END SUBROUTINE DBEMT_CopyInitInput - - SUBROUTINE DBEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(DBEMT_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 = 'DBEMT_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%rLocal)) THEN - DEALLOCATE(InitInputData%rLocal) -ENDIF - END SUBROUTINE DBEMT_DestroyInitInput - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumNodes - Re_BufSz = Re_BufSz + 1 ! tau1_const - Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod - Int_BufSz = Int_BufSz + 1 ! rLocal allocated yes/no - IF ( ALLOCATED(InData%rLocal) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rLocal upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rLocal) ! rLocal - 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 - IntKiBuf(Int_Xferred) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%rLocal) ) 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%rLocal,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) - DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) - ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE DBEMT_PackInitInput - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%tau1_const = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal 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%rLocal)) DEALLOCATE(OutData%rLocal) - ALLOCATE(OutData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) - DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) - OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE DBEMT_UnPackInitInput - - SUBROUTINE DBEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(DBEMT_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyInitOutput' -! +subroutine DBEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_InitInputType), intent(in) :: SrcInitInputData + type(DBEMT_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DBEMT_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DBEMT_CopyInitOutput - - SUBROUTINE DBEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(DBEMT_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 = 'DBEMT_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DBEMT_DestroyInitOutput - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - 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 - - 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 - - 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 DBEMT_PackInitOutput - - SUBROUTINE DBEMT_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(DBEMT_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_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 - 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) - END SUBROUTINE DBEMT_UnPackInitOutput - - SUBROUTINE DBEMT_CopyElementContinuousStateType( SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_ElementContinuousStateType), INTENT(IN) :: SrcElementContinuousStateTypeData - TYPE(DBEMT_ElementContinuousStateType), INTENT(INOUT) :: DstElementContinuousStateTypeData - 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 = 'DBEMT_CopyElementContinuousStateType' -! + ErrMsg = '' + DstInitInputData%NumBlades = SrcInitInputData%NumBlades + DstInitInputData%NumNodes = SrcInitInputData%NumNodes + DstInitInputData%tau1_const = SrcInitInputData%tau1_const + DstInitInputData%DBEMT_Mod = SrcInitInputData%DBEMT_Mod + if (allocated(SrcInitInputData%rLocal)) then + LB(1:2) = lbound(SrcInitInputData%rLocal) + UB(1:2) = ubound(SrcInitInputData%rLocal) + if (.not. allocated(DstInitInputData%rLocal)) then + allocate(DstInitInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rLocal.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%rLocal = SrcInitInputData%rLocal + end if +end subroutine + +subroutine DBEMT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(DBEMT_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstElementContinuousStateTypeData%vind = SrcElementContinuousStateTypeData%vind - DstElementContinuousStateTypeData%vind_1 = SrcElementContinuousStateTypeData%vind_1 - END SUBROUTINE DBEMT_CopyElementContinuousStateType - - SUBROUTINE DBEMT_DestroyElementContinuousStateType( ElementContinuousStateTypeData, ErrStat, ErrMsg ) - TYPE(DBEMT_ElementContinuousStateType), INTENT(INOUT) :: ElementContinuousStateTypeData - 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 = 'DBEMT_DestroyElementContinuousStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DBEMT_DestroyElementContinuousStateType - - SUBROUTINE DBEMT_PackElementContinuousStateType( 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(DBEMT_ElementContinuousStateType), 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 = 'DBEMT_PackElementContinuousStateType' - ! 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 + SIZE(InData%vind) ! vind - Db_BufSz = Db_BufSz + SIZE(InData%vind_1) ! vind_1 - 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 i1 = LBOUND(InData%vind,1), UBOUND(InData%vind,1) - DbKiBuf(Db_Xferred) = InData%vind(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%vind_1,1), UBOUND(InData%vind_1,1) - DbKiBuf(Db_Xferred) = InData%vind_1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE DBEMT_PackElementContinuousStateType - - SUBROUTINE DBEMT_UnPackElementContinuousStateType( 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(DBEMT_ElementContinuousStateType), 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 = 'DBEMT_UnPackElementContinuousStateType' - ! 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 - i1_l = LBOUND(OutData%vind,1) - i1_u = UBOUND(OutData%vind,1) - DO i1 = LBOUND(OutData%vind,1), UBOUND(OutData%vind,1) - OutData%vind(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%vind_1,1) - i1_u = UBOUND(OutData%vind_1,1) - DO i1 = LBOUND(OutData%vind_1,1), UBOUND(OutData%vind_1,1) - OutData%vind_1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE DBEMT_UnPackElementContinuousStateType - - SUBROUTINE DBEMT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(DBEMT_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) :: 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 = 'DBEMT_CopyContState' -! + ErrMsg = '' + if (allocated(InitInputData%rLocal)) then + deallocate(InitInputData%rLocal) + end if +end subroutine + +subroutine DBEMT_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%NumBlades) + call RegPack(Buf, InData%NumNodes) + call RegPack(Buf, InData%tau1_const) + call RegPack(Buf, InData%DBEMT_Mod) + call RegPack(Buf, allocated(InData%rLocal)) + if (allocated(InData%rLocal)) then + call RegPackBounds(Buf, 2, lbound(InData%rLocal), ubound(InData%rLocal)) + call RegPack(Buf, InData%rLocal) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumNodes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tau1_const) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%rLocal)) deallocate(OutData%rLocal) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rLocal(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rLocal) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine DBEMT_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_InitOutputType), intent(in) :: SrcInitOutputData + type(DBEMT_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%element)) THEN - i1_l = LBOUND(SrcContStateData%element,1) - i1_u = UBOUND(SrcContStateData%element,1) - i2_l = LBOUND(SrcContStateData%element,2) - i2_u = UBOUND(SrcContStateData%element,2) - IF (.NOT. ALLOCATED(DstContStateData%element)) THEN - ALLOCATE(DstContStateData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcContStateData%element,2), UBOUND(SrcContStateData%element,2) - DO i1 = LBOUND(SrcContStateData%element,1), UBOUND(SrcContStateData%element,1) - CALL DBEMT_Copyelementcontinuousstatetype( SrcContStateData%element(i1,i2), DstContStateData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF - END SUBROUTINE DBEMT_CopyContState - - SUBROUTINE DBEMT_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(DBEMT_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 = 'DBEMT_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ContStateData%element) -ENDIF - END SUBROUTINE DBEMT_DestroyContState - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 - Int_BufSz = Int_BufSz + 1 ! element allocated yes/no - IF ( ALLOCATED(InData%element) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! element upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! element - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! element - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! element - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - 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%element) ) 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%element,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%element,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,2) - Int_Xferred = Int_Xferred + 2 - - 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 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 DO - END IF - END SUBROUTINE DBEMT_PackContState - - SUBROUTINE DBEMT_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(DBEMT_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) :: 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 = 'DBEMT_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! element 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%element)) DEALLOCATE(OutData%element) - ALLOCATE(OutData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%element,2), UBOUND(OutData%element,2) - DO i1 = LBOUND(OutData%element,1), UBOUND(OutData%element,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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - END SUBROUTINE DBEMT_UnPackContState - - SUBROUTINE DBEMT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(DBEMT_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 = 'DBEMT_CopyDiscState' -! + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine DBEMT_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(DBEMT_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyState = SrcDiscStateData%DummyState - END SUBROUTINE DBEMT_CopyDiscState - - SUBROUTINE DBEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(DBEMT_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 = 'DBEMT_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DBEMT_DestroyDiscState - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! DummyState - 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%DummyState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_PackDiscState - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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%DummyState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_UnPackDiscState - - SUBROUTINE DBEMT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(DBEMT_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 = 'DBEMT_CopyConstrState' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine DBEMT_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine + +subroutine DBEMT_CopyElementContinuousStateType(SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_ElementContinuousStateType), intent(in) :: SrcElementContinuousStateTypeData + type(DBEMT_ElementContinuousStateType), intent(inout) :: DstElementContinuousStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_CopyElementContinuousStateType' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyState = SrcConstrStateData%DummyState - END SUBROUTINE DBEMT_CopyConstrState - - SUBROUTINE DBEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(DBEMT_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 = 'DBEMT_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DBEMT_DestroyConstrState - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! DummyState - 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%DummyState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_PackConstrState - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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%DummyState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_UnPackConstrState - - SUBROUTINE DBEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(DBEMT_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) :: 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 = 'DBEMT_CopyOtherState' -! + ErrMsg = '' + DstElementContinuousStateTypeData%vind = SrcElementContinuousStateTypeData%vind + DstElementContinuousStateTypeData%vind_1 = SrcElementContinuousStateTypeData%vind_1 +end subroutine + +subroutine DBEMT_DestroyElementContinuousStateType(ElementContinuousStateTypeData, ErrStat, ErrMsg) + type(DBEMT_ElementContinuousStateType), intent(inout) :: ElementContinuousStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyElementContinuousStateType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%areStatesInitialized)) THEN - i1_l = LBOUND(SrcOtherStateData%areStatesInitialized,1) - i1_u = UBOUND(SrcOtherStateData%areStatesInitialized,1) - i2_l = LBOUND(SrcOtherStateData%areStatesInitialized,2) - i2_u = UBOUND(SrcOtherStateData%areStatesInitialized,2) - IF (.NOT. ALLOCATED(DstOtherStateData%areStatesInitialized)) THEN - ALLOCATE(DstOtherStateData%areStatesInitialized(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%areStatesInitialized.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%areStatesInitialized = SrcOtherStateData%areStatesInitialized -ENDIF - DstOtherStateData%tau1 = SrcOtherStateData%tau1 - DstOtherStateData%tau2 = SrcOtherStateData%tau2 -IF (ALLOCATED(SrcOtherStateData%n)) THEN - i1_l = LBOUND(SrcOtherStateData%n,1) - i1_u = UBOUND(SrcOtherStateData%n,1) - i2_l = LBOUND(SrcOtherStateData%n,2) - i2_u = UBOUND(SrcOtherStateData%n,2) - IF (.NOT. ALLOCATED(DstOtherStateData%n)) THEN - ALLOCATE(DstOtherStateData%n(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%n = SrcOtherStateData%n -ENDIF - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL DBEMT_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - END SUBROUTINE DBEMT_CopyOtherState - - SUBROUTINE DBEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(DBEMT_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 = 'DBEMT_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%areStatesInitialized)) THEN - DEALLOCATE(OtherStateData%areStatesInitialized) -ENDIF -IF (ALLOCATED(OtherStateData%n)) THEN - DEALLOCATE(OtherStateData%n) -ENDIF -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL DBEMT_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - END SUBROUTINE DBEMT_DestroyOtherState - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! areStatesInitialized allocated yes/no - IF ( ALLOCATED(InData%areStatesInitialized) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! areStatesInitialized upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%areStatesInitialized) ! areStatesInitialized - END IF - Re_BufSz = Re_BufSz + 1 ! tau1 - Re_BufSz = Re_BufSz + 1 ! tau2 - Int_BufSz = Int_BufSz + 1 ! n allocated yes/no - IF ( ALLOCATED(InData%n) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! n upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%n) ! n - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL DBEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%areStatesInitialized) ) 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%areStatesInitialized,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%areStatesInitialized,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%areStatesInitialized,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%areStatesInitialized,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%areStatesInitialized,2), UBOUND(InData%areStatesInitialized,2) - DO i1 = LBOUND(InData%areStatesInitialized,1), UBOUND(InData%areStatesInitialized,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%areStatesInitialized(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%tau1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tau2 - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%n) ) 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%n,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%n,2), UBOUND(InData%n,2) - DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL DBEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - 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 SUBROUTINE DBEMT_PackOtherState - - SUBROUTINE DBEMT_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(DBEMT_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) :: 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 = 'DBEMT_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! areStatesInitialized 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%areStatesInitialized)) DEALLOCATE(OutData%areStatesInitialized) - ALLOCATE(OutData%areStatesInitialized(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%areStatesInitialized.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%areStatesInitialized,2), UBOUND(OutData%areStatesInitialized,2) - DO i1 = LBOUND(OutData%areStatesInitialized,1), UBOUND(OutData%areStatesInitialized,1) - OutData%areStatesInitialized(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%areStatesInitialized(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%tau1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tau2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n 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%n)) DEALLOCATE(OutData%n) - ALLOCATE(OutData%n(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%n,2), UBOUND(OutData%n,2) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,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 DBEMT_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - 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 SUBROUTINE DBEMT_UnPackOtherState - - SUBROUTINE DBEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(DBEMT_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 = 'DBEMT_CopyMisc' -! + ErrMsg = '' +end subroutine + +subroutine DBEMT_PackElementContinuousStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ElementContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackElementContinuousStateType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%vind) + call RegPack(Buf, InData%vind_1) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackElementContinuousStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ElementContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackElementContinuousStateType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%vind) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%vind_1) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_ContinuousStateType), intent(in) :: SrcContStateData + type(DBEMT_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%FirstWarn_tau1 = SrcMiscData%FirstWarn_tau1 - END SUBROUTINE DBEMT_CopyMisc - - SUBROUTINE DBEMT_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(DBEMT_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 = 'DBEMT_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DBEMT_DestroyMisc - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! FirstWarn_tau1 - 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) = TRANSFER(InData%FirstWarn_tau1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DBEMT_PackMisc - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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%FirstWarn_tau1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_tau1) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DBEMT_UnPackMisc - - SUBROUTINE DBEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_ParameterType), INTENT(IN) :: SrcParamData - TYPE(DBEMT_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 = 'DBEMT_CopyParam' -! + ErrMsg = '' + if (allocated(SrcContStateData%element)) then + LB(1:2) = lbound(SrcContStateData%element) + UB(1:2) = ubound(SrcContStateData%element) + if (.not. allocated(DstContStateData%element)) then + allocate(DstContStateData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%element.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_CopyElementContinuousStateType(SrcContStateData%element(i1,i2), DstContStateData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if +end subroutine + +subroutine DBEMT_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(DBEMT_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%lin_nx = SrcParamData%lin_nx - DstParamData%NumBlades = SrcParamData%NumBlades - DstParamData%NumNodes = SrcParamData%NumNodes - DstParamData%k_0ye = SrcParamData%k_0ye - DstParamData%tau1_const = SrcParamData%tau1_const -IF (ALLOCATED(SrcParamData%spanRatio)) THEN - i1_l = LBOUND(SrcParamData%spanRatio,1) - i1_u = UBOUND(SrcParamData%spanRatio,1) - i2_l = LBOUND(SrcParamData%spanRatio,2) - i2_u = UBOUND(SrcParamData%spanRatio,2) - IF (.NOT. ALLOCATED(DstParamData%spanRatio)) THEN - ALLOCATE(DstParamData%spanRatio(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spanRatio.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%spanRatio = SrcParamData%spanRatio -ENDIF - DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod - END SUBROUTINE DBEMT_CopyParam - - SUBROUTINE DBEMT_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(DBEMT_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 = 'DBEMT_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%spanRatio)) THEN - DEALLOCATE(ParamData%spanRatio) -ENDIF - END SUBROUTINE DBEMT_DestroyParam - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! lin_nx - Int_BufSz = Int_BufSz + 1 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumNodes - Re_BufSz = Re_BufSz + 1 ! k_0ye - Re_BufSz = Re_BufSz + 1 ! tau1_const - Int_BufSz = Int_BufSz + 1 ! spanRatio allocated yes/no - IF ( ALLOCATED(InData%spanRatio) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! spanRatio upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%spanRatio) ! spanRatio - END IF - Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod - 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) = InData%lin_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_0ye - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%spanRatio) ) 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%spanRatio,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spanRatio,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%spanRatio,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spanRatio,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%spanRatio,2), UBOUND(InData%spanRatio,2) - DO i1 = LBOUND(InData%spanRatio,1), UBOUND(InData%spanRatio,1) - ReKiBuf(Re_Xferred) = InData%spanRatio(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DBEMT_PackParam - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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%lin_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%k_0ye = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tau1_const = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! spanRatio 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%spanRatio)) DEALLOCATE(OutData%spanRatio) - ALLOCATE(OutData%spanRatio(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%spanRatio.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%spanRatio,2), UBOUND(OutData%spanRatio,2) - DO i1 = LBOUND(OutData%spanRatio,1), UBOUND(OutData%spanRatio,1) - OutData%spanRatio(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DBEMT_UnPackParam - - SUBROUTINE DBEMT_CopyElementInputType( SrcElementInputTypeData, DstElementInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_ElementInputType), INTENT(IN) :: SrcElementInputTypeData - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: DstElementInputTypeData - 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 = 'DBEMT_CopyElementInputType' -! + ErrMsg = '' + if (allocated(ContStateData%element)) then + LB(1:2) = lbound(ContStateData%element) + UB(1:2) = ubound(ContStateData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_DestroyElementContinuousStateType(ContStateData%element(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ContStateData%element) + end if +end subroutine + +subroutine DBEMT_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackContState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%element)) + if (allocated(InData%element)) then + call RegPackBounds(Buf, 2, lbound(InData%element), ubound(InData%element)) + LB(1:2) = lbound(InData%element) + UB(1:2) = ubound(InData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_PackElementContinuousStateType(Buf, InData%element(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackContState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%element)) deallocate(OutData%element) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%element(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_UnpackElementContinuousStateType(Buf, OutData%element(i1,i2)) ! element + end do + end do + end if +end subroutine + +subroutine DBEMT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_DiscreteStateType), intent(in) :: SrcDiscStateData + type(DBEMT_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstElementInputTypeData%vind_s = SrcElementInputTypeData%vind_s - DstElementInputTypeData%spanRatio = SrcElementInputTypeData%spanRatio - END SUBROUTINE DBEMT_CopyElementInputType - - SUBROUTINE DBEMT_DestroyElementInputType( ElementInputTypeData, ErrStat, ErrMsg ) - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: ElementInputTypeData - 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 = 'DBEMT_DestroyElementInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DBEMT_DestroyElementInputType - - SUBROUTINE DBEMT_PackElementInputType( 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(DBEMT_ElementInputType), 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 = 'DBEMT_PackElementInputType' - ! 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 + SIZE(InData%vind_s) ! vind_s - Re_BufSz = Re_BufSz + 1 ! spanRatio - 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 i1 = LBOUND(InData%vind_s,1), UBOUND(InData%vind_s,1) - ReKiBuf(Re_Xferred) = InData%vind_s(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%spanRatio - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_PackElementInputType - - SUBROUTINE DBEMT_UnPackElementInputType( 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(DBEMT_ElementInputType), 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 = 'DBEMT_UnPackElementInputType' - ! 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 - i1_l = LBOUND(OutData%vind_s,1) - i1_u = UBOUND(OutData%vind_s,1) - DO i1 = LBOUND(OutData%vind_s,1), UBOUND(OutData%vind_s,1) - OutData%vind_s(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%spanRatio = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_UnPackElementInputType - - SUBROUTINE DBEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_InputType), INTENT(IN) :: SrcInputData - TYPE(DBEMT_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) :: 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 = 'DBEMT_CopyInput' -! + ErrMsg = '' + DstDiscStateData%DummyState = SrcDiscStateData%DummyState +end subroutine + +subroutine DBEMT_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(DBEMT_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstInputData%AxInd_disk = SrcInputData%AxInd_disk - DstInputData%Un_disk = SrcInputData%Un_disk - DstInputData%R_disk = SrcInputData%R_disk -IF (ALLOCATED(SrcInputData%element)) THEN - i1_l = LBOUND(SrcInputData%element,1) - i1_u = UBOUND(SrcInputData%element,1) - i2_l = LBOUND(SrcInputData%element,2) - i2_u = UBOUND(SrcInputData%element,2) - IF (.NOT. ALLOCATED(DstInputData%element)) THEN - ALLOCATE(DstInputData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcInputData%element,2), UBOUND(SrcInputData%element,2) - DO i1 = LBOUND(SrcInputData%element,1), UBOUND(SrcInputData%element,1) - CALL DBEMT_Copyelementinputtype( SrcInputData%element(i1,i2), DstInputData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF - END SUBROUTINE DBEMT_CopyInput - - SUBROUTINE DBEMT_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(DBEMT_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 = 'DBEMT_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(InputData%element) -ENDIF - END SUBROUTINE DBEMT_DestroyInput - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! AxInd_disk - Re_BufSz = Re_BufSz + 1 ! Un_disk - Re_BufSz = Re_BufSz + 1 ! R_disk - Int_BufSz = Int_BufSz + 1 ! element allocated yes/no - IF ( ALLOCATED(InData%element) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! element upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! element - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! element - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! element - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - 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 - - ReKiBuf(Re_Xferred) = InData%AxInd_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Un_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%R_disk - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%element) ) 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%element,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%element,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,2) - Int_Xferred = Int_Xferred + 2 - - 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 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 DO - END IF - END SUBROUTINE DBEMT_PackInput - - SUBROUTINE DBEMT_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(DBEMT_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) :: 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 = 'DBEMT_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%AxInd_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Un_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%R_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! element 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%element)) DEALLOCATE(OutData%element) - ALLOCATE(OutData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%element,2), UBOUND(OutData%element,2) - DO i1 = LBOUND(OutData%element,1), UBOUND(OutData%element,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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - END SUBROUTINE DBEMT_UnPackInput - - SUBROUTINE DBEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_OutputType), INTENT(IN) :: SrcOutputData - TYPE(DBEMT_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) :: 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_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine DBEMT_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_ConstraintStateType), intent(in) :: SrcConstrStateData + type(DBEMT_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%vind)) THEN - i1_l = LBOUND(SrcOutputData%vind,1) - i1_u = UBOUND(SrcOutputData%vind,1) - i2_l = LBOUND(SrcOutputData%vind,2) - i2_u = UBOUND(SrcOutputData%vind,2) - i3_l = LBOUND(SrcOutputData%vind,3) - i3_u = UBOUND(SrcOutputData%vind,3) - IF (.NOT. ALLOCATED(DstOutputData%vind)) THEN - ALLOCATE(DstOutputData%vind(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%vind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%vind = SrcOutputData%vind -ENDIF - END SUBROUTINE DBEMT_CopyOutput - - SUBROUTINE DBEMT_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(DBEMT_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 = 'DBEMT_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%vind)) THEN - DEALLOCATE(OutputData%vind) -ENDIF - END SUBROUTINE DBEMT_DestroyOutput - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! vind allocated yes/no - IF ( ALLOCATED(InData%vind) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vind) ! vind - 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%vind) ) 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%vind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vind,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vind,3), UBOUND(InData%vind,3) - DO i2 = LBOUND(InData%vind,2), UBOUND(InData%vind,2) - DO i1 = LBOUND(InData%vind,1), UBOUND(InData%vind,1) - ReKiBuf(Re_Xferred) = InData%vind(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE DBEMT_PackOutput - - SUBROUTINE DBEMT_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(DBEMT_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) :: 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_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 ! vind 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%vind)) DEALLOCATE(OutData%vind) - ALLOCATE(OutData%vind(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%vind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vind,3), UBOUND(OutData%vind,3) - DO i2 = LBOUND(OutData%vind,2), UBOUND(OutData%vind,2) - DO i1 = LBOUND(OutData%vind,1), UBOUND(OutData%vind,1) - OutData%vind(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE DBEMT_UnPackOutput - - - SUBROUTINE DBEMT_ElementInputType_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) ElementInputType 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(DBEMT_ElementInputType), INTENT(IN) :: u(:) ! ElementInputType at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the ElementInputTypes - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: u_out ! ElementInputType 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 + ErrMsg = '' + DstConstrStateData%DummyState = SrcConstrStateData%DummyState +end subroutine + +subroutine DBEMT_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(DBEMT_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine DBEMT_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_OtherStateType), intent(in) :: SrcOtherStateData + type(DBEMT_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%areStatesInitialized)) then + LB(1:2) = lbound(SrcOtherStateData%areStatesInitialized) + UB(1:2) = ubound(SrcOtherStateData%areStatesInitialized) + if (.not. allocated(DstOtherStateData%areStatesInitialized)) then + allocate(DstOtherStateData%areStatesInitialized(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%areStatesInitialized.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%areStatesInitialized = SrcOtherStateData%areStatesInitialized + end if + DstOtherStateData%tau1 = SrcOtherStateData%tau1 + DstOtherStateData%tau2 = SrcOtherStateData%tau2 + if (allocated(SrcOtherStateData%n)) then + LB(1:2) = lbound(SrcOtherStateData%n) + UB(1:2) = ubound(SrcOtherStateData%n) + if (.not. allocated(DstOtherStateData%n)) then + allocate(DstOtherStateData%n(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%n.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%n = SrcOtherStateData%n + end if + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + do i1 = LB(1), UB(1) + call DBEMT_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do +end subroutine + +subroutine DBEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(DBEMT_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%areStatesInitialized)) then + deallocate(OtherStateData%areStatesInitialized) + end if + if (allocated(OtherStateData%n)) then + deallocate(OtherStateData%n) + end if + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call DBEMT_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do +end subroutine + +subroutine DBEMT_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%areStatesInitialized)) + if (allocated(InData%areStatesInitialized)) then + call RegPackBounds(Buf, 2, lbound(InData%areStatesInitialized), ubound(InData%areStatesInitialized)) + call RegPack(Buf, InData%areStatesInitialized) + end if + call RegPack(Buf, InData%tau1) + call RegPack(Buf, InData%tau2) + call RegPack(Buf, allocated(InData%n)) + if (allocated(InData%n)) then + call RegPackBounds(Buf, 2, lbound(InData%n), ubound(InData%n)) + call RegPack(Buf, InData%n) + end if + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call DBEMT_PackContState(Buf, InData%xdot(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%areStatesInitialized)) deallocate(OutData%areStatesInitialized) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%areStatesInitialized(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%areStatesInitialized.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%areStatesInitialized) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%tau1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tau2) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%n)) deallocate(OutData%n) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%n(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%n.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + end if + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call DBEMT_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do +end subroutine + +subroutine DBEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_MiscVarType), intent(in) :: SrcMiscData + type(DBEMT_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%FirstWarn_tau1 = SrcMiscData%FirstWarn_tau1 +end subroutine + +subroutine DBEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(DBEMT_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine DBEMT_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%FirstWarn_tau1) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%FirstWarn_tau1) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_ParameterType), intent(in) :: SrcParamData + type(DBEMT_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DBEMT_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%lin_nx = SrcParamData%lin_nx + DstParamData%NumBlades = SrcParamData%NumBlades + DstParamData%NumNodes = SrcParamData%NumNodes + DstParamData%k_0ye = SrcParamData%k_0ye + DstParamData%tau1_const = SrcParamData%tau1_const + if (allocated(SrcParamData%spanRatio)) then + LB(1:2) = lbound(SrcParamData%spanRatio) + UB(1:2) = ubound(SrcParamData%spanRatio) + if (.not. allocated(DstParamData%spanRatio)) then + allocate(DstParamData%spanRatio(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spanRatio.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%spanRatio = SrcParamData%spanRatio + end if + DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod +end subroutine + +subroutine DBEMT_DestroyParam(ParamData, ErrStat, ErrMsg) + type(DBEMT_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%spanRatio)) then + deallocate(ParamData%spanRatio) + end if +end subroutine + +subroutine DBEMT_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%lin_nx) + call RegPack(Buf, InData%NumBlades) + call RegPack(Buf, InData%NumNodes) + call RegPack(Buf, InData%k_0ye) + call RegPack(Buf, InData%tau1_const) + call RegPack(Buf, allocated(InData%spanRatio)) + if (allocated(InData%spanRatio)) then + call RegPackBounds(Buf, 2, lbound(InData%spanRatio), ubound(InData%spanRatio)) + call RegPack(Buf, InData%spanRatio) + end if + call RegPack(Buf, InData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%lin_nx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumNodes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k_0ye) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tau1_const) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%spanRatio)) deallocate(OutData%spanRatio) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%spanRatio(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%spanRatio.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%spanRatio) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_CopyElementInputType(SrcElementInputTypeData, DstElementInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_ElementInputType), intent(in) :: SrcElementInputTypeData + type(DBEMT_ElementInputType), intent(inout) :: DstElementInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_CopyElementInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstElementInputTypeData%vind_s = SrcElementInputTypeData%vind_s + DstElementInputTypeData%spanRatio = SrcElementInputTypeData%spanRatio +end subroutine + +subroutine DBEMT_DestroyElementInputType(ElementInputTypeData, ErrStat, ErrMsg) + type(DBEMT_ElementInputType), intent(inout) :: ElementInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyElementInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine DBEMT_PackElementInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ElementInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackElementInputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%vind_s) + call RegPack(Buf, InData%spanRatio) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackElementInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ElementInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackElementInputType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%vind_s) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%spanRatio) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_InputType), intent(in) :: SrcInputData + type(DBEMT_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%AxInd_disk = SrcInputData%AxInd_disk + DstInputData%Un_disk = SrcInputData%Un_disk + DstInputData%R_disk = SrcInputData%R_disk + if (allocated(SrcInputData%element)) then + LB(1:2) = lbound(SrcInputData%element) + UB(1:2) = ubound(SrcInputData%element) + if (.not. allocated(DstInputData%element)) then + allocate(DstInputData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%element.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_CopyElementInputType(SrcInputData%element(i1,i2), DstInputData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if +end subroutine + +subroutine DBEMT_DestroyInput(InputData, ErrStat, ErrMsg) + type(DBEMT_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%element)) then + LB(1:2) = lbound(InputData%element) + UB(1:2) = ubound(InputData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_DestroyElementInputType(InputData%element(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(InputData%element) + end if +end subroutine + +subroutine DBEMT_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%AxInd_disk) + call RegPack(Buf, InData%Un_disk) + call RegPack(Buf, InData%R_disk) + call RegPack(Buf, allocated(InData%element)) + if (allocated(InData%element)) then + call RegPackBounds(Buf, 2, lbound(InData%element), ubound(InData%element)) + LB(1:2) = lbound(InData%element) + UB(1:2) = ubound(InData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_PackElementInputType(Buf, InData%element(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%AxInd_disk) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Un_disk) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%R_disk) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%element)) deallocate(OutData%element) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%element(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_UnpackElementInputType(Buf, OutData%element(i1,i2)) ! element + end do + end do + end if +end subroutine + +subroutine DBEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_OutputType), intent(in) :: SrcOutputData + type(DBEMT_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DBEMT_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%vind)) then + LB(1:3) = lbound(SrcOutputData%vind) + UB(1:3) = ubound(SrcOutputData%vind) + if (.not. allocated(DstOutputData%vind)) then + allocate(DstOutputData%vind(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%vind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%vind = SrcOutputData%vind + end if +end subroutine + +subroutine DBEMT_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(DBEMT_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%vind)) then + deallocate(OutputData%vind) + end if +end subroutine + +subroutine DBEMT_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%vind)) + if (allocated(InData%vind)) then + call RegPackBounds(Buf, 3, lbound(InData%vind), ubound(InData%vind)) + call RegPack(Buf, InData%vind) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackOutput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%vind)) deallocate(OutData%vind) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vind(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vind.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vind) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine DBEMT_ElementInputType_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) ElementInputType 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(DBEMT_ElementInputType), intent(in) :: u(:) ! ElementInputType at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the ElementInputTypes + type(DBEMT_ElementInputType), intent(inout) :: u_out ! ElementInputType 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 = 'DBEMT_ElementInputType_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 DBEMT_CopyElementInputType(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL DBEMT_ElementInputType_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 DBEMT_ElementInputType_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 DBEMT_ElementInputType_ExtrapInterp - - - SUBROUTINE DBEMT_ElementInputType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'DBEMT_ElementInputType_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call DBEMT_CopyElementInputType(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call DBEMT_ElementInputType_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call DBEMT_ElementInputType_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE DBEMT_ElementInputType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) ElementInputType 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. @@ -2699,47 +1070,44 @@ SUBROUTINE DBEMT_ElementInputType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, Err ! !.................................................................................................................................. - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u1 ! ElementInputType at t1 > t2 - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u2 ! ElementInputType at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the ElementInputTypes - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: u_out ! ElementInputType 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 + TYPE(DBEMT_ElementInputType), INTENT(IN) :: u1 ! ElementInputType at t1 > t2 + TYPE(DBEMT_ElementInputType), INTENT(IN) :: u2 ! ElementInputType at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the ElementInputTypes + TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: u_out ! ElementInputType 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 ElementInputTypes - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_ElementInputType_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 + REAL(DbKi) :: t(2) ! Times associated with the ElementInputTypes + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_ElementInputType_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - DO i1 = LBOUND(u_out%vind_s,1),UBOUND(u_out%vind_s,1) - b = -(u1%vind_s(i1) - u2%vind_s(i1)) - u_out%vind_s(i1) = u1%vind_s(i1) + b * ScaleFactor - END DO - b = -(u1%spanRatio - u2%spanRatio) - u_out%spanRatio = u1%spanRatio + b * ScaleFactor - END SUBROUTINE DBEMT_ElementInputType_ExtrapInterp1 - - - SUBROUTINE DBEMT_ElementInputType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + u_out%vind_s = a1*u1%vind_s + a2*u2%vind_s + u_out%spanRatio = a1*u1%spanRatio + a2*u2%spanRatio +END SUBROUTINE + +SUBROUTINE DBEMT_ElementInputType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) ElementInputType 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. @@ -2753,109 +1121,104 @@ SUBROUTINE DBEMT_ElementInputType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ! !.................................................................................................................................. - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u1 ! ElementInputType at t1 > t2 > t3 - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u2 ! ElementInputType at t2 > t3 - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u3 ! ElementInputType at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the ElementInputTypes - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: u_out ! ElementInputType 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 + TYPE(DBEMT_ElementInputType), INTENT(IN) :: u1 ! ElementInputType at t1 > t2 > t3 + TYPE(DBEMT_ElementInputType), INTENT(IN) :: u2 ! ElementInputType at t2 > t3 + TYPE(DBEMT_ElementInputType), INTENT(IN) :: u3 ! ElementInputType at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the ElementInputTypes + TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: u_out ! ElementInputType 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 ElementInputTypes - 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 = 'DBEMT_ElementInputType_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) - + REAL(DbKi) :: t(3) ! Times associated with the ElementInputTypes + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_ElementInputType_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 + 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 + 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 + 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))) - DO i1 = LBOUND(u_out%vind_s,1),UBOUND(u_out%vind_s,1) - b = (t(3)**2*(u1%vind_s(i1) - u2%vind_s(i1)) + t(2)**2*(-u1%vind_s(i1) + u3%vind_s(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%vind_s(i1) + t(3)*u2%vind_s(i1) - t(2)*u3%vind_s(i1) ) * scaleFactor - u_out%vind_s(i1) = u1%vind_s(i1) + b + c * t_out - END DO - b = (t(3)**2*(u1%spanRatio - u2%spanRatio) + t(2)**2*(-u1%spanRatio + u3%spanRatio))* scaleFactor - c = ( (t(2)-t(3))*u1%spanRatio + t(3)*u2%spanRatio - t(2)*u3%spanRatio ) * scaleFactor - u_out%spanRatio = u1%spanRatio + b + c * t_out - END SUBROUTINE DBEMT_ElementInputType_ExtrapInterp2 - - - SUBROUTINE DBEMT_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(DBEMT_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(DBEMT_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + u_out%vind_s = a1*u1%vind_s + a2*u2%vind_s + a3*u3%vind_s + u_out%spanRatio = a1*u1%spanRatio + a2*u2%spanRatio + a3*u3%spanRatio +END SUBROUTINE + +subroutine DBEMT_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(DBEMT_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(DBEMT_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 = 'DBEMT_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 DBEMT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL DBEMT_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 DBEMT_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 DBEMT_Input_ExtrapInterp - - - SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call DBEMT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call DBEMT_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call DBEMT_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE DBEMT_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. @@ -2867,65 +1230,59 @@ SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(DBEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(DBEMT_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(DBEMT_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 + TYPE(DBEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(DBEMT_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(DBEMT_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 = 'DBEMT_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 - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + u_out%AxInd_disk = a1*u1%AxInd_disk + a2*u2%AxInd_disk + u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk + u_out%R_disk = a1*u1%R_disk + a2*u2%R_disk + IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN + DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) + DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) + u_out%element(i01,i02)%vind_s = a1*u1%element(i01,i02)%vind_s + a2*u2%element(i01,i02)%vind_s + END DO + END DO + DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) + DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) + u_out%element(i01,i02)%spanRatio = a1*u1%element(i01,i02)%spanRatio + a2*u2%element(i01,i02)%spanRatio + END DO + END DO + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / t(2) - b = -(u1%AxInd_disk - u2%AxInd_disk) - u_out%AxInd_disk = u1%AxInd_disk + b * ScaleFactor - b = -(u1%Un_disk - u2%Un_disk) - u_out%Un_disk = u1%Un_disk + b * ScaleFactor - b = -(u1%R_disk - u2%R_disk) - u_out%R_disk = u1%R_disk + b * ScaleFactor -IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) - DO i1 = LBOUND(u_out%element(i01,i02)%vind_s,1),UBOUND(u_out%element(i01,i02)%vind_s,1) - b = -(u1%element(i01,i02)%vind_s(i1) - u2%element(i01,i02)%vind_s(i1)) - u_out%element(i01,i02)%vind_s(i1) = u1%element(i01,i02)%vind_s(i1) + b * ScaleFactor - END DO - ENDDO - ENDDO - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) - b = -(u1%element(i01,i02)%spanRatio - u2%element(i01,i02)%spanRatio) - u_out%element(i01,i02)%spanRatio = u1%element(i01,i02)%spanRatio + b * ScaleFactor - ENDDO - ENDDO -END IF ! check if allocated - END SUBROUTINE DBEMT_Input_ExtrapInterp1 - - - SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE DBEMT_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. @@ -2939,130 +1296,119 @@ SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(DBEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(DBEMT_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(DBEMT_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(DBEMT_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 + TYPE(DBEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(DBEMT_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(DBEMT_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(DBEMT_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 = 'DBEMT_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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%AxInd_disk - u2%AxInd_disk) + t(2)**2*(-u1%AxInd_disk + u3%AxInd_disk))* scaleFactor - c = ( (t(2)-t(3))*u1%AxInd_disk + t(3)*u2%AxInd_disk - t(2)*u3%AxInd_disk ) * scaleFactor - u_out%AxInd_disk = u1%AxInd_disk + b + c * t_out - b = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))* scaleFactor - c = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) * scaleFactor - u_out%Un_disk = u1%Un_disk + b + c * t_out - b = (t(3)**2*(u1%R_disk - u2%R_disk) + t(2)**2*(-u1%R_disk + u3%R_disk))* scaleFactor - c = ( (t(2)-t(3))*u1%R_disk + t(3)*u2%R_disk - t(2)*u3%R_disk ) * scaleFactor - u_out%R_disk = u1%R_disk + b + c * t_out -IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) - DO i1 = LBOUND(u_out%element(i01,i02)%vind_s,1),UBOUND(u_out%element(i01,i02)%vind_s,1) - b = (t(3)**2*(u1%element(i01,i02)%vind_s(i1) - u2%element(i01,i02)%vind_s(i1)) + t(2)**2*(-u1%element(i01,i02)%vind_s(i1) + u3%element(i01,i02)%vind_s(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%element(i01,i02)%vind_s(i1) + t(3)*u2%element(i01,i02)%vind_s(i1) - t(2)*u3%element(i01,i02)%vind_s(i1) ) * scaleFactor - u_out%element(i01,i02)%vind_s(i1) = u1%element(i01,i02)%vind_s(i1) + b + c * t_out - END DO - ENDDO - ENDDO - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) - b = (t(3)**2*(u1%element(i01,i02)%spanRatio - u2%element(i01,i02)%spanRatio) + t(2)**2*(-u1%element(i01,i02)%spanRatio + u3%element(i01,i02)%spanRatio))* scaleFactor - c = ( (t(2)-t(3))*u1%element(i01,i02)%spanRatio + t(3)*u2%element(i01,i02)%spanRatio - t(2)*u3%element(i01,i02)%spanRatio ) * scaleFactor - u_out%element(i01,i02)%spanRatio = u1%element(i01,i02)%spanRatio + b + c * t_out - ENDDO - ENDDO -END IF ! check if allocated - END SUBROUTINE DBEMT_Input_ExtrapInterp2 - - - SUBROUTINE DBEMT_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(DBEMT_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(DBEMT_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + u_out%AxInd_disk = a1*u1%AxInd_disk + a2*u2%AxInd_disk + a3*u3%AxInd_disk + u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk + a3*u3%Un_disk + u_out%R_disk = a1*u1%R_disk + a2*u2%R_disk + a3*u3%R_disk + IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN + DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) + DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) + u_out%element(i01,i02)%vind_s = a1*u1%element(i01,i02)%vind_s + a2*u2%element(i01,i02)%vind_s + a3*u3%element(i01,i02)%vind_s + END DO + END DO + DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) + DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) + u_out%element(i01,i02)%spanRatio = a1*u1%element(i01,i02)%spanRatio + a2*u2%element(i01,i02)%spanRatio + a3*u3%element(i01,i02)%spanRatio + END DO + END DO + END IF ! check if allocated +END SUBROUTINE + +subroutine DBEMT_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(DBEMT_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(DBEMT_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 = 'DBEMT_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 DBEMT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL DBEMT_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 DBEMT_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 DBEMT_Output_ExtrapInterp - - - SUBROUTINE DBEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call DBEMT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call DBEMT_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call DBEMT_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE DBEMT_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. @@ -3074,55 +1420,49 @@ SUBROUTINE DBEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(DBEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(DBEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(DBEMT_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 + TYPE(DBEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(DBEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(DBEMT_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 = 'DBEMT_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 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%vind) .AND. ALLOCATED(y1%vind)) THEN - DO i3 = LBOUND(y_out%vind,3),UBOUND(y_out%vind,3) - DO i2 = LBOUND(y_out%vind,2),UBOUND(y_out%vind,2) - DO i1 = LBOUND(y_out%vind,1),UBOUND(y_out%vind,1) - b = -(y1%vind(i1,i2,i3) - y2%vind(i1,i2,i3)) - y_out%vind(i1,i2,i3) = y1%vind(i1,i2,i3) + b * ScaleFactor - END DO - END DO - END DO -END IF ! check if allocated - END SUBROUTINE DBEMT_Output_ExtrapInterp1 - - - SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%vind) .AND. ALLOCATED(y1%vind)) THEN + y_out%vind = a1*y1%vind + a2*y2%vind + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE DBEMT_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. @@ -3136,62 +1476,54 @@ SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(DBEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(DBEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(DBEMT_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(DBEMT_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 + TYPE(DBEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(DBEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(DBEMT_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(DBEMT_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 = 'DBEMT_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 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 + 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 + 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 + 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%vind) .AND. ALLOCATED(y1%vind)) THEN - DO i3 = LBOUND(y_out%vind,3),UBOUND(y_out%vind,3) - DO i2 = LBOUND(y_out%vind,2),UBOUND(y_out%vind,2) - DO i1 = LBOUND(y_out%vind,1),UBOUND(y_out%vind,1) - b = (t(3)**2*(y1%vind(i1,i2,i3) - y2%vind(i1,i2,i3)) + t(2)**2*(-y1%vind(i1,i2,i3) + y3%vind(i1,i2,i3)))* scaleFactor - c = ( (t(2)-t(3))*y1%vind(i1,i2,i3) + t(3)*y2%vind(i1,i2,i3) - t(2)*y3%vind(i1,i2,i3) ) * scaleFactor - y_out%vind(i1,i2,i3) = y1%vind(i1,i2,i3) + b + c * t_out - END DO - END DO - END DO -END IF ! check if allocated - END SUBROUTINE DBEMT_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%vind) .AND. ALLOCATED(y1%vind)) THEN + y_out%vind = a1*y1%vind + a2*y2%vind + a3*y3%vind + END IF ! check if allocated +END SUBROUTINE END MODULE DBEMT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index eee3c3393c..b1210cdd91 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -40,22 +40,22 @@ MODULE FVW_Types ! ========= GridOutType ======= TYPE, PUBLIC :: GridOutType CHARACTER(100) :: name !< Grid name [-] - INTEGER(IntKi) :: type !< Grid type [-] - REAL(ReKi) :: tStart !< Time at which outputs starts [-] - REAL(ReKi) :: tEnd !< Time at which outputs ends [-] - REAL(ReKi) :: DTout !< Output frequency of grid [-] - REAL(ReKi) :: xStart !< xStart [-] - REAL(ReKi) :: yStart !< yStart [-] - REAL(ReKi) :: zStart !< zStart [-] - REAL(ReKi) :: xEnd !< xEnd [-] - REAL(ReKi) :: yEnd !< yEnd [-] - REAL(ReKi) :: zEnd !< zEnd [-] - INTEGER(IntKi) :: nx !< nx [-] - INTEGER(IntKi) :: ny !< ny [-] - INTEGER(IntKi) :: nz !< nz [-] + INTEGER(IntKi) :: type = 0_IntKi !< Grid type [-] + REAL(ReKi) :: tStart = 0.0_ReKi !< Time at which outputs starts [-] + REAL(ReKi) :: tEnd = 0.0_ReKi !< Time at which outputs ends [-] + REAL(ReKi) :: DTout = 0.0_ReKi !< Output frequency of grid [-] + REAL(ReKi) :: xStart = 0.0_ReKi !< xStart [-] + REAL(ReKi) :: yStart = 0.0_ReKi !< yStart [-] + REAL(ReKi) :: zStart = 0.0_ReKi !< zStart [-] + REAL(ReKi) :: xEnd = 0.0_ReKi !< xEnd [-] + REAL(ReKi) :: yEnd = 0.0_ReKi !< yEnd [-] + REAL(ReKi) :: zEnd = 0.0_ReKi !< zEnd [-] + INTEGER(IntKi) :: nx = 0_IntKi !< nx [-] + INTEGER(IntKi) :: ny = 0_IntKi !< ny [-] + INTEGER(IntKi) :: nz = 0_IntKi !< nz [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uGrid !< Grid velocity 3 x nz x ny x nx [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: omGrid !< Grid vorticity 3 x nz x ny x nx [-] - REAL(DbKi) :: tLastOutput !< Last output time [-] + REAL(DbKi) :: tLastOutput = 0.0_R8Ki !< Last output time [-] END TYPE GridOutType ! ======================= ! ========= T_Sgmt ======= @@ -64,9 +64,9 @@ MODULE FVW_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Connct !< Connectivity of segments [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Gamma !< Segment circulations [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Epsilon !< Segment regularization parameter [-] - INTEGER(IntKi) :: RegFunction !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] - INTEGER(IntKi) :: nAct !< Number of active segments [-] - INTEGER(IntKi) :: nActP !< Number of active segment points [-] + INTEGER(IntKi) :: RegFunction = 0_IntKi !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] + INTEGER(IntKi) :: nAct = 0_IntKi !< Number of active segments [-] + INTEGER(IntKi) :: nActP = 0_IntKi !< Number of active segment points [-] END TYPE T_Sgmt ! ======================= ! ========= T_Part ======= @@ -74,8 +74,8 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: P !< Particle Points [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Alpha !< Particle intensity 3 x nP [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RegParam !< Particle regularization parameter [-] - INTEGER(IntKi) :: RegFunction !< Type of regularizaion function (FVW_BiotSavart) [-] - INTEGER(IntKi) :: nAct !< Number of active particles <=nP [-] + INTEGER(IntKi) :: RegFunction = 0_IntKi !< Type of regularizaion function (FVW_BiotSavart) [-] + INTEGER(IntKi) :: nAct = 0_IntKi !< Number of active particles <=nP [-] END TYPE T_Part ! ======================= ! ========= Wng_ParameterType ======= @@ -84,57 +84,57 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: chord_CP !< Chord on LL cp [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: s_LL !< Spanwise coordinate of LL elements [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: s_CP !< Spanwise coordinate of LL CP [m] - INTEGER(IntKi) :: iRotor !< Index of rotor the wing belong to [-] + INTEGER(IntKi) :: iRotor = 0_IntKi !< Index of rotor the wing belong to [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: AFindx !< Index to the airfoils from AD15 [BladeNode,BladeIndex=1] [-] - INTEGER(IntKi) :: nSpan !< TODO, should be defined per wing. Number of spanwise element [-] + INTEGER(IntKi) :: nSpan = 0_IntKi !< TODO, should be defined per wing. Number of spanwise element [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PrescribedCirculation !< Prescribed circulation on all lifting lines [m/s] END TYPE Wng_ParameterType ! ======================= ! ========= FVW_ParameterType ======= TYPE, PUBLIC :: FVW_ParameterType - INTEGER(IntKi) :: nRotors !< Number of Wings [-] - INTEGER(IntKi) :: nWings !< Number of Wings [-] + INTEGER(IntKi) :: nRotors = 0_IntKi !< Number of Wings [-] + INTEGER(IntKi) :: nWings = 0_IntKi !< Number of Wings [-] TYPE(Wng_ParameterType) , DIMENSION(:), ALLOCATABLE :: W !< Wings parameters [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Bld2Wings !< Index mapping from blades to wings [-] - INTEGER(IntKi) :: iNWStart !< Index where NW start in r_NW. (iNWStart=2, the first panel contains the lifting line panel, otherwise, start at 1) [-] - INTEGER(IntKi) :: nNWMax !< Maximum number of nw panels, per wing [-] - INTEGER(IntKi) :: nNWFree !< Number of nw panels that are free, per wing [-] - INTEGER(IntKi) :: nFWMax !< Maximum number of fw panels, per wing [-] - INTEGER(IntKi) :: nFWFree !< Number of fw panels that are free, per wing [-] - LOGICAL :: FWShedVorticity !< Include shed vorticity in the far wake [-] - INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1) [-] - REAL(ReKi) :: FreeWakeStart !< Time when wake starts convecting (rolling up) [s] - REAL(ReKi) :: FullCircStart !< Time when the circulation is full [s] - INTEGER(IntKi) :: CircSolvMethod !< Method to determine the circulation [-] - INTEGER(IntKi) :: CircSolvMaxIter !< Maximum number of iterations for circulation solving [-] - REAL(ReKi) :: CircSolvConvCrit !< Convergence criterion for circulation solving [-] - REAL(ReKi) :: CircSolvRelaxation !< Relaxation factor for circulation solving [-] - INTEGER(IntKi) :: CircSolvPolar !< (0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha) [-] - INTEGER(IntKi) :: DiffusionMethod !< Diffusion method (None, CoreSpreading, PSE) [-] - REAL(ReKi) :: CoreSpreadEddyVisc !< Eddy viscosity used in the core spreading method [-] - INTEGER(IntKi) :: RegDeterMethod !< Regularization determinatino method (manual, automatic) [-] - INTEGER(IntKi) :: RegFunction !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] - INTEGER(IntKi) :: WakeRegMethod !< Method for regularization (constant, stretching, age, etc.) [-] - REAL(ReKi) :: WakeRegParam !< Initial value of the regularization parameter [-] - REAL(ReKi) :: WingRegParam !< Regularization parameter of the wing [-] - INTEGER(IntKi) :: ShearModel !< Option for shear modelling [-] - LOGICAL :: TwrShadowOnWake !< Include tower shadow effects on wake [-] - INTEGER(IntKi) , DIMENSION(1:2) :: VelocityMethod !< Velocity calculation method for Full Wake and for LiftingLine [-] - REAL(ReKi) , DIMENSION(1:2) :: TreeBranchFactor !< Factor used to determine if a point is far enough, for full wake and lifting line [-] - INTEGER(IntKi) , DIMENSION(1:2) :: PartPerSegment !< Number of particles per segment, e.g. for tree method, for full wake and lifting line [-] - REAL(DbKi) :: DTaero !< Time interval for calls calculations [s] - REAL(DbKi) :: DTfvw !< Time interval for calculating wake induced velocities [s] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - INTEGER(IntKi) :: MHK !< MHK flag [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] - INTEGER(IntKi) :: WrVTK !< Outputs VTK at each calcoutput call, even if main fst doesnt do it [-] - INTEGER(IntKi) :: VTKBlades !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] - REAL(DbKi) :: DTvtk !< DT between vtk writes [s] - INTEGER(IntKi) :: VTKCoord !< Switch for VTK outputs coordinate system [-] + INTEGER(IntKi) :: iNWStart = 0_IntKi !< Index where NW start in r_NW. (iNWStart=2, the first panel contains the lifting line panel, otherwise, start at 1) [-] + INTEGER(IntKi) :: nNWMax = 0_IntKi !< Maximum number of nw panels, per wing [-] + INTEGER(IntKi) :: nNWFree = 0_IntKi !< Number of nw panels that are free, per wing [-] + INTEGER(IntKi) :: nFWMax = 0_IntKi !< Maximum number of fw panels, per wing [-] + INTEGER(IntKi) :: nFWFree = 0_IntKi !< Number of fw panels that are free, per wing [-] + LOGICAL :: FWShedVorticity = .false. !< Include shed vorticity in the far wake [-] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1) [-] + REAL(ReKi) :: FreeWakeStart = 0.0_ReKi !< Time when wake starts convecting (rolling up) [s] + REAL(ReKi) :: FullCircStart = 0.0_ReKi !< Time when the circulation is full [s] + INTEGER(IntKi) :: CircSolvMethod = 0_IntKi !< Method to determine the circulation [-] + INTEGER(IntKi) :: CircSolvMaxIter = 0_IntKi !< Maximum number of iterations for circulation solving [-] + REAL(ReKi) :: CircSolvConvCrit = 0.0_ReKi !< Convergence criterion for circulation solving [-] + REAL(ReKi) :: CircSolvRelaxation = 0.0_ReKi !< Relaxation factor for circulation solving [-] + INTEGER(IntKi) :: CircSolvPolar = 0_IntKi !< (0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha) [-] + INTEGER(IntKi) :: DiffusionMethod = 0_IntKi !< Diffusion method (None, CoreSpreading, PSE) [-] + REAL(ReKi) :: CoreSpreadEddyVisc = 0.0_ReKi !< Eddy viscosity used in the core spreading method [-] + INTEGER(IntKi) :: RegDeterMethod = 0_IntKi !< Regularization determinatino method (manual, automatic) [-] + INTEGER(IntKi) :: RegFunction = 0_IntKi !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] + INTEGER(IntKi) :: WakeRegMethod = 0_IntKi !< Method for regularization (constant, stretching, age, etc.) [-] + REAL(ReKi) :: WakeRegParam = 0.0_ReKi !< Initial value of the regularization parameter [-] + REAL(ReKi) :: WingRegParam = 0.0_ReKi !< Regularization parameter of the wing [-] + INTEGER(IntKi) :: ShearModel = 0_IntKi !< Option for shear modelling [-] + LOGICAL :: TwrShadowOnWake = .false. !< Include tower shadow effects on wake [-] + INTEGER(IntKi) , DIMENSION(1:2) :: VelocityMethod = 0_IntKi !< Velocity calculation method for Full Wake and for LiftingLine [-] + REAL(ReKi) , DIMENSION(1:2) :: TreeBranchFactor = 0.0_ReKi !< Factor used to determine if a point is far enough, for full wake and lifting line [-] + INTEGER(IntKi) , DIMENSION(1:2) :: PartPerSegment = 0_IntKi !< Number of particles per segment, e.g. for tree method, for full wake and lifting line [-] + REAL(DbKi) :: DTaero = 0.0_R8Ki !< Time interval for calls calculations [s] + REAL(DbKi) :: DTfvw = 0.0_R8Ki !< Time interval for calculating wake induced velocities [s] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK flag [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + INTEGER(IntKi) :: WrVTK = 0_IntKi !< Outputs VTK at each calcoutput call, even if main fst doesnt do it [-] + INTEGER(IntKi) :: VTKBlades = 0_IntKi !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] + REAL(DbKi) :: DTvtk = 0.0_R8Ki !< DT between vtk writes [s] + INTEGER(IntKi) :: VTKCoord = 0_IntKi !< Switch for VTK outputs coordinate system [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] CHARACTER(1024) :: VTK_OutFileRoot !< Rootdirectory for writing VTK files [-] CHARACTER(1024) :: VTK_OutFileBase !< Basename for writing VTK files [-] - INTEGER(IntKi) :: nGridOut !< Number of VTK grid to output [-] + INTEGER(IntKi) :: nGridOut = 0_IntKi !< Number of VTK grid to output [-] LOGICAL :: InductionAtCP = .true. !< Compute induced velocities at nodes or CP [-] LOGICAL :: WakeAtTE = .true. !< Start the wake at the trailing edge, or at the LL [-] LOGICAL :: DStallOnWake = .false. !< Dynamic stall has influence on wake [-] @@ -190,8 +190,8 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vind_NW !< Induced velocity on near wake panels [m/s] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vind_FW !< Induced velocity on far wake panels [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PitchAndTwist !< Twist angle (includes all sources of twist) [Array of size (NumBlNds,numBlades)] [rad] - INTEGER(IntKi) :: iTip !< Index where tip vorticity will be placed. TODO, per blade [-] - INTEGER(IntKi) :: iRoot !< Index where root vorticity will be placed [-] + INTEGER(IntKi) :: iTip = 0_IntKi !< Index where tip vorticity will be placed. TODO, per blade [-] + INTEGER(IntKi) :: iRoot = 0_IntKi !< Index where root vorticity will be placed [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: alpha_LL !< Angle of attack at lifting line CP, only computed with CircPolarData method [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vreln_LL !< Norm of Vrel on the lifting line [-] TYPE(UA_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_UA !< inputs to UnsteadyAero numNode x 2 (t and t+dt) [-] @@ -220,21 +220,21 @@ MODULE FVW_Types ! ========= FVW_MiscVarType ======= TYPE, PUBLIC :: FVW_MiscVarType TYPE(Wng_MiscVarType) , DIMENSION(:), ALLOCATABLE :: W !< Misc for all wings [-] - LOGICAL :: FirstCall !< True if this is the first call to update state (used in CalcOutput) [-] - INTEGER(IntKi) :: nNW !< Number of active near wake panels [-] - INTEGER(IntKi) :: nFW !< Number of active far wake panels [-] - INTEGER(IntKi) :: iStep !< Current step number used for update state [-] - INTEGER(IntKi) :: VTKstep !< Current vtk output step number [-] - REAL(DbKi) :: VTKlastTime !< Time the last VTK file set was written out [s] + LOGICAL :: FirstCall = .false. !< True if this is the first call to update state (used in CalcOutput) [-] + INTEGER(IntKi) :: nNW = 0_IntKi !< Number of active near wake panels [-] + INTEGER(IntKi) :: nFW = 0_IntKi !< Number of active far wake panels [-] + INTEGER(IntKi) :: iStep = 0_IntKi !< Current step number used for update state [-] + INTEGER(IntKi) :: VTKstep = 0_IntKi !< Current vtk output step number [-] + REAL(DbKi) :: VTKlastTime = 0.0_R8Ki !< Time the last VTK file set was written out [s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: r_wind !< List of points where wind is requested for next time step [-] - LOGICAL :: ComputeWakeInduced !< Compute induced velocities on this timestep [-] - REAL(DbKi) :: OldWakeTime !< Time the wake induction velocities were last calculated [s] + LOGICAL :: ComputeWakeInduced = .false. !< Compute induced velocities on this timestep [-] + REAL(DbKi) :: OldWakeTime = 0.0_R8Ki !< Time the wake induction velocities were last calculated [s] TYPE(FVW_ContinuousStateType) :: dxdt !< State time derivatie, stored for overcycling and convenience [-] TYPE(FVW_ContinuousStateType) :: x1 !< States at t (for overcycling) [-] TYPE(FVW_ContinuousStateType) :: x2 !< States at t+DTFVW (for overcycling) [-] - REAL(DbKi) :: t1 !< Time of x1 (for overcycling) [-] - REAL(DbKi) :: t2 !< Time of x2 t+DTFVW (for overcycling) [-] - LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] + REAL(DbKi) :: t1 = 0.0_R8Ki !< Time of x1 (for overcycling) [-] + REAL(DbKi) :: t2 = 0.0_R8Ki !< Time of x2 t+DTFVW (for overcycling) [-] + LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] TYPE(T_Sgmt) :: Sgmt !< Segments storage [-] TYPE(T_Part) :: Part !< Particle storage [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CPs !< Control points used for wake rollup computation [-] @@ -244,8 +244,8 @@ MODULE FVW_Types ! ======================= ! ========= Rot_InputType ======= TYPE, PUBLIC :: Rot_InputType - REAL(ReKi) , DIMENSION(1:3,1:3) :: HubOrientation !< Orientation of hub coordinate system (for output only) [-] - REAL(ReKi) , DIMENSION(1:3) :: HubPosition !< Origin of hub (for output only) [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: HubOrientation = 0.0_ReKi !< Orientation of hub coordinate system (for output only) [-] + REAL(ReKi) , DIMENSION(1:3) :: HubPosition = 0.0_ReKi !< Origin of hub (for output only) [-] END TYPE Rot_InputType ! ======================= ! ========= Wng_InputType ======= @@ -264,7 +264,7 @@ MODULE FVW_Types ! ======================= ! ========= FVW_DiscreteStateType ======= TYPE, PUBLIC :: FVW_DiscreteStateType - REAL(ReKi) :: Dummy !< Empty to satisfy framework [-] + REAL(ReKi) :: Dummy = 0.0_ReKi !< Empty to satisfy framework [-] TYPE(UA_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: UA !< states for UnsteadyAero for each Wing [-] END TYPE FVW_DiscreteStateType ! ======================= @@ -276,12 +276,12 @@ MODULE FVW_Types ! ========= FVW_ConstraintStateType ======= TYPE, PUBLIC :: FVW_ConstraintStateType TYPE(Wng_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: W !< rotors constr. states [-] - REAL(ReKi) :: residual !< Residual [-] + REAL(ReKi) :: residual = 0.0_ReKi !< Residual [-] END TYPE FVW_ConstraintStateType ! ======================= ! ========= FVW_OtherStateType ======= TYPE, PUBLIC :: FVW_OtherStateType - INTEGER(IntKi) :: Dummy !< Empty to satisfy framework [-] + INTEGER(IntKi) :: Dummy = 0_IntKi !< Empty to satisfy framework [-] TYPE(UA_OtherStateType) , DIMENSION(:), ALLOCATABLE :: UA !< other states for UnsteadyAero for each wing [-] END TYPE FVW_OtherStateType ! ======================= @@ -290,9 +290,9 @@ MODULE FVW_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: AFindx !< Index to the airfoils from AD15 [idx1=BladeNode, idx2=Blade number=1] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: chord !< Chord of each blade element from input file [idx1=BladeNode, idx2=Blade number] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RElm !< radius of center of each element [-] - INTEGER(IntKi) :: iRotor !< Index of rotor the wing belong to [-] - INTEGER(IntKi) :: UAOff_innerNode !< Last node on each blade where UA should be turned off based on span location from blade root (0 if always on) [-] - INTEGER(IntKi) :: UAOff_outerNode !< First node on each blade where UA should be turned off based on span location from blade tip (>nNodesPerBlade if always on) [-] + INTEGER(IntKi) :: iRotor = 0_IntKi !< Index of rotor the wing belong to [-] + INTEGER(IntKi) :: UAOff_innerNode = 0_IntKi !< Last node on each blade where UA should be turned off based on span location from blade root (0 if always on) [-] + INTEGER(IntKi) :: UAOff_outerNode = 0_IntKi !< First node on each blade where UA should be turned off based on span location from blade tip (>nNodesPerBlade if always on) [-] END TYPE Wng_InitInputType ! ======================= ! ========= FVW_InitInputType ======= @@ -301,11067 +301,4822 @@ MODULE FVW_Types CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(Wng_InitInputType) , DIMENSION(:), ALLOCATABLE :: W !< Number of blades [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: WingsMesh !< Input Mesh defining position and orientation of wings (nSpan+1) [-] - INTEGER(IntKi) :: numBladeNodes !< Number of nodes on each blade [-] - REAL(DbKi) :: DTaero !< Time interval for calls (from AD15) [s] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - INTEGER(IntKi) :: MHK !< MHK flag [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] - INTEGER(IntKi) :: UAMod !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] - LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] - LOGICAL :: Flookup !< Use table lookup for f' and f'' [-] - REAL(ReKi) :: a_s !< speed of sound [m/s] - LOGICAL :: SumPrint !< Whether to print summary file (primarially in in UA) [-] + INTEGER(IntKi) :: numBladeNodes = 0_IntKi !< Number of nodes on each blade [-] + REAL(DbKi) :: DTaero = 0.0_R8Ki !< Time interval for calls (from AD15) [s] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK flag [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + INTEGER(IntKi) :: UAMod = 0_IntKi !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] + LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] + LOGICAL :: Flookup = .false. !< Use table lookup for f' and f'' [-] + REAL(ReKi) :: a_s = 0.0_ReKi !< speed of sound [m/s] + LOGICAL :: SumPrint = .false. !< Whether to print summary file (primarially in in UA) [-] END TYPE FVW_InitInputType ! ======================= ! ========= FVW_InputFile ======= TYPE, PUBLIC :: FVW_InputFile - INTEGER(IntKi) :: CircSolvMethod !< Method to determine the circulation [-] + INTEGER(IntKi) :: CircSolvMethod = 0_IntKi !< Method to determine the circulation [-] CHARACTER(1024) :: CirculationFile !< Prescribed circulation file [-] - INTEGER(IntKi) :: CircSolvMaxIter !< Maximum number of iterations for circulation solving [-] - REAL(ReKi) :: CircSolvConvCrit !< Convergence criterion for circulation solving [-] - REAL(ReKi) :: CircSolvRelaxation !< Relaxation factor for circulation solving [-] - INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1, 7=Corrector/Predictor) [-] - LOGICAL :: FreeWake !< Disable roll up, wake convects with wind only (flag) [-] - REAL(ReKi) :: FreeWakeStart !< Time when wake starts convecting (rolling up) [s] - REAL(ReKi) :: FullCircStart !< Time when the circulation is full [s] - REAL(DbKi) :: DTfvw !< Time interval for calculating wake induced velocities [s] - INTEGER(IntKi) :: CircSolvPolar !< (0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha) [-] - INTEGER(IntKi) :: nNWPanels !< Number of nw panels [-] - INTEGER(IntKi) :: nNWPanelsFree !< Number of nw panels [-] - INTEGER(IntKi) :: nFWPanels !< Number of fw panels [-] - INTEGER(IntKi) :: nFWPanelsFree !< Number of fw panels that are free [-] - LOGICAL :: FWShedVorticity !< Include shed vorticity in the far wake [-] - INTEGER(IntKi) :: DiffusionMethod !< Diffusion method (None, CoreSpreading, PSE) [-] - REAL(ReKi) :: CoreSpreadEddyVisc !< Eddy viscosity used in the core spreading method [-] - INTEGER(IntKi) :: RegDeterMethod !< Regularization determinatino method (manual, automatic) [-] - INTEGER(IntKi) :: RegFunction !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] - INTEGER(IntKi) :: WakeRegMethod !< Method for regularization (constant, stretching, age, etc.) [-] - REAL(ReKi) :: WakeRegParam !< Factor used in the regularization [-] - REAL(ReKi) :: WingRegParam !< Factor used in the regularization [-] - INTEGER(IntKi) :: ShearModel !< Option for shear modelling [-] - LOGICAL :: TwrShadowOnWake !< Include tower shadow effects on wake [-] - INTEGER(IntKi) , DIMENSION(1:2) :: VelocityMethod !< Velocity calculation method for Full Wake and for LiftingLine [-] - REAL(ReKi) , DIMENSION(1:2) :: TreeBranchFactor !< Factor used to determine if a point is far enough, for full wake and lifting line [-] - INTEGER(IntKi) , DIMENSION(1:2) :: PartPerSegment !< Number of particles per segment, e.g. for tree method, for full wake and lifting line [-] - INTEGER(IntKi) :: WrVTK !< Outputs VTK at each calcoutput call, even if main fst doesnt do it [-] - INTEGER(IntKi) :: VTKBlades !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] - REAL(DbKi) :: DTvtk !< Requested timestep between VTK outputs (calculated from the VTK_fps read in) [s] - INTEGER(IntKi) :: VTKCoord !< Switch for VTK outputs coordinate system [-] + INTEGER(IntKi) :: CircSolvMaxIter = 0_IntKi !< Maximum number of iterations for circulation solving [-] + REAL(ReKi) :: CircSolvConvCrit = 0.0_ReKi !< Convergence criterion for circulation solving [-] + REAL(ReKi) :: CircSolvRelaxation = 0.0_ReKi !< Relaxation factor for circulation solving [-] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1, 7=Corrector/Predictor) [-] + LOGICAL :: FreeWake = .false. !< Disable roll up, wake convects with wind only (flag) [-] + REAL(ReKi) :: FreeWakeStart = 0.0_ReKi !< Time when wake starts convecting (rolling up) [s] + REAL(ReKi) :: FullCircStart = 0.0_ReKi !< Time when the circulation is full [s] + REAL(DbKi) :: DTfvw = 0.0_R8Ki !< Time interval for calculating wake induced velocities [s] + INTEGER(IntKi) :: CircSolvPolar = 0_IntKi !< (0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha) [-] + INTEGER(IntKi) :: nNWPanels = 0_IntKi !< Number of nw panels [-] + INTEGER(IntKi) :: nNWPanelsFree = 0_IntKi !< Number of nw panels [-] + INTEGER(IntKi) :: nFWPanels = 0_IntKi !< Number of fw panels [-] + INTEGER(IntKi) :: nFWPanelsFree = 0_IntKi !< Number of fw panels that are free [-] + LOGICAL :: FWShedVorticity = .false. !< Include shed vorticity in the far wake [-] + INTEGER(IntKi) :: DiffusionMethod = 0_IntKi !< Diffusion method (None, CoreSpreading, PSE) [-] + REAL(ReKi) :: CoreSpreadEddyVisc = 0.0_ReKi !< Eddy viscosity used in the core spreading method [-] + INTEGER(IntKi) :: RegDeterMethod = 0_IntKi !< Regularization determinatino method (manual, automatic) [-] + INTEGER(IntKi) :: RegFunction = 0_IntKi !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] + INTEGER(IntKi) :: WakeRegMethod = 0_IntKi !< Method for regularization (constant, stretching, age, etc.) [-] + REAL(ReKi) :: WakeRegParam = 0.0_ReKi !< Factor used in the regularization [-] + REAL(ReKi) :: WingRegParam = 0.0_ReKi !< Factor used in the regularization [-] + INTEGER(IntKi) :: ShearModel = 0_IntKi !< Option for shear modelling [-] + LOGICAL :: TwrShadowOnWake = .false. !< Include tower shadow effects on wake [-] + INTEGER(IntKi) , DIMENSION(1:2) :: VelocityMethod = 0_IntKi !< Velocity calculation method for Full Wake and for LiftingLine [-] + REAL(ReKi) , DIMENSION(1:2) :: TreeBranchFactor = 0.0_ReKi !< Factor used to determine if a point is far enough, for full wake and lifting line [-] + INTEGER(IntKi) , DIMENSION(1:2) :: PartPerSegment = 0_IntKi !< Number of particles per segment, e.g. for tree method, for full wake and lifting line [-] + INTEGER(IntKi) :: WrVTK = 0_IntKi !< Outputs VTK at each calcoutput call, even if main fst doesnt do it [-] + INTEGER(IntKi) :: VTKBlades = 0_IntKi !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] + REAL(DbKi) :: DTvtk = 0.0_R8Ki !< Requested timestep between VTK outputs (calculated from the VTK_fps read in) [s] + INTEGER(IntKi) :: VTKCoord = 0_IntKi !< Switch for VTK outputs coordinate system [-] END TYPE FVW_InputFile ! ======================= ! ========= FVW_InitOutputType ======= TYPE, PUBLIC :: FVW_InitOutputType - INTEGER(IntKi) :: Dummy !< Empty parameter to satisfy framework [-] + INTEGER(IntKi) :: Dummy = 0_IntKi !< Empty parameter to satisfy framework [-] END TYPE FVW_InitOutputType ! ======================= CONTAINS - SUBROUTINE FVW_CopyGridOutType( SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(GridOutType), INTENT(IN) :: SrcGridOutTypeData - TYPE(GridOutType), INTENT(INOUT) :: DstGridOutTypeData - 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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyGridOutType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstGridOutTypeData%name = SrcGridOutTypeData%name - DstGridOutTypeData%type = SrcGridOutTypeData%type - DstGridOutTypeData%tStart = SrcGridOutTypeData%tStart - DstGridOutTypeData%tEnd = SrcGridOutTypeData%tEnd - DstGridOutTypeData%DTout = SrcGridOutTypeData%DTout - DstGridOutTypeData%xStart = SrcGridOutTypeData%xStart - DstGridOutTypeData%yStart = SrcGridOutTypeData%yStart - DstGridOutTypeData%zStart = SrcGridOutTypeData%zStart - DstGridOutTypeData%xEnd = SrcGridOutTypeData%xEnd - DstGridOutTypeData%yEnd = SrcGridOutTypeData%yEnd - DstGridOutTypeData%zEnd = SrcGridOutTypeData%zEnd - DstGridOutTypeData%nx = SrcGridOutTypeData%nx - DstGridOutTypeData%ny = SrcGridOutTypeData%ny - DstGridOutTypeData%nz = SrcGridOutTypeData%nz -IF (ALLOCATED(SrcGridOutTypeData%uGrid)) THEN - i1_l = LBOUND(SrcGridOutTypeData%uGrid,1) - i1_u = UBOUND(SrcGridOutTypeData%uGrid,1) - i2_l = LBOUND(SrcGridOutTypeData%uGrid,2) - i2_u = UBOUND(SrcGridOutTypeData%uGrid,2) - i3_l = LBOUND(SrcGridOutTypeData%uGrid,3) - i3_u = UBOUND(SrcGridOutTypeData%uGrid,3) - i4_l = LBOUND(SrcGridOutTypeData%uGrid,4) - i4_u = UBOUND(SrcGridOutTypeData%uGrid,4) - IF (.NOT. ALLOCATED(DstGridOutTypeData%uGrid)) THEN - ALLOCATE(DstGridOutTypeData%uGrid(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 DstGridOutTypeData%uGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGridOutTypeData%uGrid = SrcGridOutTypeData%uGrid -ENDIF -IF (ALLOCATED(SrcGridOutTypeData%omGrid)) THEN - i1_l = LBOUND(SrcGridOutTypeData%omGrid,1) - i1_u = UBOUND(SrcGridOutTypeData%omGrid,1) - i2_l = LBOUND(SrcGridOutTypeData%omGrid,2) - i2_u = UBOUND(SrcGridOutTypeData%omGrid,2) - i3_l = LBOUND(SrcGridOutTypeData%omGrid,3) - i3_u = UBOUND(SrcGridOutTypeData%omGrid,3) - i4_l = LBOUND(SrcGridOutTypeData%omGrid,4) - i4_u = UBOUND(SrcGridOutTypeData%omGrid,4) - IF (.NOT. ALLOCATED(DstGridOutTypeData%omGrid)) THEN - ALLOCATE(DstGridOutTypeData%omGrid(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 DstGridOutTypeData%omGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGridOutTypeData%omGrid = SrcGridOutTypeData%omGrid -ENDIF - DstGridOutTypeData%tLastOutput = SrcGridOutTypeData%tLastOutput - END SUBROUTINE FVW_CopyGridOutType - - SUBROUTINE FVW_DestroyGridOutType( GridOutTypeData, ErrStat, ErrMsg ) - TYPE(GridOutType), INTENT(INOUT) :: GridOutTypeData - 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 = 'FVW_DestroyGridOutType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(GridOutTypeData%uGrid)) THEN - DEALLOCATE(GridOutTypeData%uGrid) -ENDIF -IF (ALLOCATED(GridOutTypeData%omGrid)) THEN - DEALLOCATE(GridOutTypeData%omGrid) -ENDIF - END SUBROUTINE FVW_DestroyGridOutType - - SUBROUTINE FVW_PackGridOutType( 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(GridOutType), 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 = 'FVW_PackGridOutType' - ! 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%name) ! name - Int_BufSz = Int_BufSz + 1 ! type - Re_BufSz = Re_BufSz + 1 ! tStart - Re_BufSz = Re_BufSz + 1 ! tEnd - Re_BufSz = Re_BufSz + 1 ! DTout - Re_BufSz = Re_BufSz + 1 ! xStart - Re_BufSz = Re_BufSz + 1 ! yStart - Re_BufSz = Re_BufSz + 1 ! zStart - Re_BufSz = Re_BufSz + 1 ! xEnd - Re_BufSz = Re_BufSz + 1 ! yEnd - Re_BufSz = Re_BufSz + 1 ! zEnd - Int_BufSz = Int_BufSz + 1 ! nx - Int_BufSz = Int_BufSz + 1 ! ny - Int_BufSz = Int_BufSz + 1 ! nz - Int_BufSz = Int_BufSz + 1 ! uGrid allocated yes/no - IF ( ALLOCATED(InData%uGrid) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! uGrid upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uGrid) ! uGrid - END IF - Int_BufSz = Int_BufSz + 1 ! omGrid allocated yes/no - IF ( ALLOCATED(InData%omGrid) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! omGrid upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%omGrid) ! omGrid - END IF - Db_BufSz = Db_BufSz + 1 ! tLastOutput - 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%name) - IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%type - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tEnd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTout - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%xStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%zStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%xEnd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yEnd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%zEnd - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nz - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%uGrid) ) 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%uGrid,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uGrid,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uGrid,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uGrid,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%uGrid,4), UBOUND(InData%uGrid,4) - DO i3 = LBOUND(InData%uGrid,3), UBOUND(InData%uGrid,3) - DO i2 = LBOUND(InData%uGrid,2), UBOUND(InData%uGrid,2) - DO i1 = LBOUND(InData%uGrid,1), UBOUND(InData%uGrid,1) - ReKiBuf(Re_Xferred) = InData%uGrid(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%omGrid) ) 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%omGrid,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omGrid,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omGrid,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omGrid,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omGrid,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omGrid,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omGrid,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omGrid,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%omGrid,4), UBOUND(InData%omGrid,4) - DO i3 = LBOUND(InData%omGrid,3), UBOUND(InData%omGrid,3) - DO i2 = LBOUND(InData%omGrid,2), UBOUND(InData%omGrid,2) - DO i1 = LBOUND(InData%omGrid,1), UBOUND(InData%omGrid,1) - ReKiBuf(Re_Xferred) = InData%omGrid(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%tLastOutput - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE FVW_PackGridOutType - - SUBROUTINE FVW_UnPackGridOutType( 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(GridOutType), 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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackGridOutType' - ! 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%name) - OutData%name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%tStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tEnd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DTout = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%xStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%yStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%zStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%xEnd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%yEnd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%zEnd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nz = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uGrid 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%uGrid)) DEALLOCATE(OutData%uGrid) - ALLOCATE(OutData%uGrid(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%uGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%uGrid,4), UBOUND(OutData%uGrid,4) - DO i3 = LBOUND(OutData%uGrid,3), UBOUND(OutData%uGrid,3) - DO i2 = LBOUND(OutData%uGrid,2), UBOUND(OutData%uGrid,2) - DO i1 = LBOUND(OutData%uGrid,1), UBOUND(OutData%uGrid,1) - OutData%uGrid(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omGrid 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%omGrid)) DEALLOCATE(OutData%omGrid) - ALLOCATE(OutData%omGrid(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%omGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%omGrid,4), UBOUND(OutData%omGrid,4) - DO i3 = LBOUND(OutData%omGrid,3), UBOUND(OutData%omGrid,3) - DO i2 = LBOUND(OutData%omGrid,2), UBOUND(OutData%omGrid,2) - DO i1 = LBOUND(OutData%omGrid,1), UBOUND(OutData%omGrid,1) - OutData%omGrid(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - OutData%tLastOutput = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE FVW_UnPackGridOutType - - SUBROUTINE FVW_CopyT_Sgmt( SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMsg ) - TYPE(T_Sgmt), INTENT(IN) :: SrcT_SgmtData - TYPE(T_Sgmt), INTENT(INOUT) :: DstT_SgmtData - 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 = 'FVW_CopyT_Sgmt' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcT_SgmtData%Points)) THEN - i1_l = LBOUND(SrcT_SgmtData%Points,1) - i1_u = UBOUND(SrcT_SgmtData%Points,1) - i2_l = LBOUND(SrcT_SgmtData%Points,2) - i2_u = UBOUND(SrcT_SgmtData%Points,2) - IF (.NOT. ALLOCATED(DstT_SgmtData%Points)) THEN - ALLOCATE(DstT_SgmtData%Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Points.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_SgmtData%Points = SrcT_SgmtData%Points -ENDIF -IF (ALLOCATED(SrcT_SgmtData%Connct)) THEN - i1_l = LBOUND(SrcT_SgmtData%Connct,1) - i1_u = UBOUND(SrcT_SgmtData%Connct,1) - i2_l = LBOUND(SrcT_SgmtData%Connct,2) - i2_u = UBOUND(SrcT_SgmtData%Connct,2) - IF (.NOT. ALLOCATED(DstT_SgmtData%Connct)) THEN - ALLOCATE(DstT_SgmtData%Connct(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Connct.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_SgmtData%Connct = SrcT_SgmtData%Connct -ENDIF -IF (ALLOCATED(SrcT_SgmtData%Gamma)) THEN - i1_l = LBOUND(SrcT_SgmtData%Gamma,1) - i1_u = UBOUND(SrcT_SgmtData%Gamma,1) - IF (.NOT. ALLOCATED(DstT_SgmtData%Gamma)) THEN - ALLOCATE(DstT_SgmtData%Gamma(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Gamma.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_SgmtData%Gamma = SrcT_SgmtData%Gamma -ENDIF -IF (ALLOCATED(SrcT_SgmtData%Epsilon)) THEN - i1_l = LBOUND(SrcT_SgmtData%Epsilon,1) - i1_u = UBOUND(SrcT_SgmtData%Epsilon,1) - IF (.NOT. ALLOCATED(DstT_SgmtData%Epsilon)) THEN - ALLOCATE(DstT_SgmtData%Epsilon(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Epsilon.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_SgmtData%Epsilon = SrcT_SgmtData%Epsilon -ENDIF - DstT_SgmtData%RegFunction = SrcT_SgmtData%RegFunction - DstT_SgmtData%nAct = SrcT_SgmtData%nAct - DstT_SgmtData%nActP = SrcT_SgmtData%nActP - END SUBROUTINE FVW_CopyT_Sgmt - - SUBROUTINE FVW_DestroyT_Sgmt( T_SgmtData, ErrStat, ErrMsg ) - TYPE(T_Sgmt), INTENT(INOUT) :: T_SgmtData - 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 = 'FVW_DestroyT_Sgmt' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(T_SgmtData%Points)) THEN - DEALLOCATE(T_SgmtData%Points) -ENDIF -IF (ALLOCATED(T_SgmtData%Connct)) THEN - DEALLOCATE(T_SgmtData%Connct) -ENDIF -IF (ALLOCATED(T_SgmtData%Gamma)) THEN - DEALLOCATE(T_SgmtData%Gamma) -ENDIF -IF (ALLOCATED(T_SgmtData%Epsilon)) THEN - DEALLOCATE(T_SgmtData%Epsilon) -ENDIF - END SUBROUTINE FVW_DestroyT_Sgmt - - SUBROUTINE FVW_PackT_Sgmt( 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(T_Sgmt), 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 = 'FVW_PackT_Sgmt' - ! 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 ! Points allocated yes/no - IF ( ALLOCATED(InData%Points) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Points upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Points) ! Points - END IF - Int_BufSz = Int_BufSz + 1 ! Connct allocated yes/no - IF ( ALLOCATED(InData%Connct) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Connct upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Connct) ! Connct - END IF - Int_BufSz = Int_BufSz + 1 ! Gamma allocated yes/no - IF ( ALLOCATED(InData%Gamma) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Gamma upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma) ! Gamma - END IF - Int_BufSz = Int_BufSz + 1 ! Epsilon allocated yes/no - IF ( ALLOCATED(InData%Epsilon) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Epsilon upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Epsilon) ! Epsilon - END IF - Int_BufSz = Int_BufSz + 1 ! RegFunction - Int_BufSz = Int_BufSz + 1 ! nAct - Int_BufSz = Int_BufSz + 1 ! nActP - 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%Points) ) 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%Points,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Points,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Points,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Points,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Points,2), UBOUND(InData%Points,2) - DO i1 = LBOUND(InData%Points,1), UBOUND(InData%Points,1) - ReKiBuf(Re_Xferred) = InData%Points(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Connct) ) 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%Connct,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Connct,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Connct,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Connct,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Connct,2), UBOUND(InData%Connct,2) - DO i1 = LBOUND(InData%Connct,1), UBOUND(InData%Connct,1) - IntKiBuf(Int_Xferred) = InData%Connct(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gamma) ) 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%Gamma,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Gamma,1), UBOUND(InData%Gamma,1) - ReKiBuf(Re_Xferred) = InData%Gamma(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Epsilon) ) 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%Epsilon,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Epsilon,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Epsilon,1), UBOUND(InData%Epsilon,1) - ReKiBuf(Re_Xferred) = InData%Epsilon(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%RegFunction - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nAct - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nActP - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackT_Sgmt - - SUBROUTINE FVW_UnPackT_Sgmt( 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(T_Sgmt), 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 = 'FVW_UnPackT_Sgmt' - ! 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 ! Points 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%Points)) DEALLOCATE(OutData%Points) - ALLOCATE(OutData%Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Points.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Points,2), UBOUND(OutData%Points,2) - DO i1 = LBOUND(OutData%Points,1), UBOUND(OutData%Points,1) - OutData%Points(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Connct 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%Connct)) DEALLOCATE(OutData%Connct) - ALLOCATE(OutData%Connct(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Connct.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Connct,2), UBOUND(OutData%Connct,2) - DO i1 = LBOUND(OutData%Connct,1), UBOUND(OutData%Connct,1) - OutData%Connct(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma 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%Gamma)) DEALLOCATE(OutData%Gamma) - ALLOCATE(OutData%Gamma(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Gamma,1), UBOUND(OutData%Gamma,1) - OutData%Gamma(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Epsilon 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%Epsilon)) DEALLOCATE(OutData%Epsilon) - ALLOCATE(OutData%Epsilon(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Epsilon.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Epsilon,1), UBOUND(OutData%Epsilon,1) - OutData%Epsilon(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%RegFunction = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nAct = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nActP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackT_Sgmt - - SUBROUTINE FVW_CopyT_Part( SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMsg ) - TYPE(T_Part), INTENT(IN) :: SrcT_PartData - TYPE(T_Part), INTENT(INOUT) :: DstT_PartData - 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 = 'FVW_CopyT_Part' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcT_PartData%P)) THEN - i1_l = LBOUND(SrcT_PartData%P,1) - i1_u = UBOUND(SrcT_PartData%P,1) - i2_l = LBOUND(SrcT_PartData%P,2) - i2_u = UBOUND(SrcT_PartData%P,2) - IF (.NOT. ALLOCATED(DstT_PartData%P)) THEN - ALLOCATE(DstT_PartData%P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_PartData%P = SrcT_PartData%P -ENDIF -IF (ALLOCATED(SrcT_PartData%Alpha)) THEN - i1_l = LBOUND(SrcT_PartData%Alpha,1) - i1_u = UBOUND(SrcT_PartData%Alpha,1) - i2_l = LBOUND(SrcT_PartData%Alpha,2) - i2_u = UBOUND(SrcT_PartData%Alpha,2) - IF (.NOT. ALLOCATED(DstT_PartData%Alpha)) THEN - ALLOCATE(DstT_PartData%Alpha(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%Alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_PartData%Alpha = SrcT_PartData%Alpha -ENDIF -IF (ALLOCATED(SrcT_PartData%RegParam)) THEN - i1_l = LBOUND(SrcT_PartData%RegParam,1) - i1_u = UBOUND(SrcT_PartData%RegParam,1) - IF (.NOT. ALLOCATED(DstT_PartData%RegParam)) THEN - ALLOCATE(DstT_PartData%RegParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%RegParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_PartData%RegParam = SrcT_PartData%RegParam -ENDIF - DstT_PartData%RegFunction = SrcT_PartData%RegFunction - DstT_PartData%nAct = SrcT_PartData%nAct - END SUBROUTINE FVW_CopyT_Part - - SUBROUTINE FVW_DestroyT_Part( T_PartData, ErrStat, ErrMsg ) - TYPE(T_Part), INTENT(INOUT) :: T_PartData - 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 = 'FVW_DestroyT_Part' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(T_PartData%P)) THEN - DEALLOCATE(T_PartData%P) -ENDIF -IF (ALLOCATED(T_PartData%Alpha)) THEN - DEALLOCATE(T_PartData%Alpha) -ENDIF -IF (ALLOCATED(T_PartData%RegParam)) THEN - DEALLOCATE(T_PartData%RegParam) -ENDIF - END SUBROUTINE FVW_DestroyT_Part - - SUBROUTINE FVW_PackT_Part( 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(T_Part), 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 = 'FVW_PackT_Part' - ! 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 ! P allocated yes/no - IF ( ALLOCATED(InData%P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%P) ! P - END IF - Int_BufSz = Int_BufSz + 1 ! Alpha allocated yes/no - IF ( ALLOCATED(InData%Alpha) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Alpha upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Alpha) ! Alpha - END IF - Int_BufSz = Int_BufSz + 1 ! RegParam allocated yes/no - IF ( ALLOCATED(InData%RegParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RegParam upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RegParam) ! RegParam - END IF - Int_BufSz = Int_BufSz + 1 ! RegFunction - Int_BufSz = Int_BufSz + 1 ! nAct - 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%P) ) 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%P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%P,2), UBOUND(InData%P,2) - DO i1 = LBOUND(InData%P,1), UBOUND(InData%P,1) - ReKiBuf(Re_Xferred) = InData%P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Alpha) ) 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%Alpha,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Alpha,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Alpha,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Alpha,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Alpha,2), UBOUND(InData%Alpha,2) - DO i1 = LBOUND(InData%Alpha,1), UBOUND(InData%Alpha,1) - ReKiBuf(Re_Xferred) = InData%Alpha(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RegParam) ) 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%RegParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RegParam,1), UBOUND(InData%RegParam,1) - ReKiBuf(Re_Xferred) = InData%RegParam(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%RegFunction - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nAct - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackT_Part - - SUBROUTINE FVW_UnPackT_Part( 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(T_Part), 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 = 'FVW_UnPackT_Part' - ! 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 ! P 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%P)) DEALLOCATE(OutData%P) - ALLOCATE(OutData%P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%P,2), UBOUND(OutData%P,2) - DO i1 = LBOUND(OutData%P,1), UBOUND(OutData%P,1) - OutData%P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Alpha 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%Alpha)) DEALLOCATE(OutData%Alpha) - ALLOCATE(OutData%Alpha(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Alpha,2), UBOUND(OutData%Alpha,2) - DO i1 = LBOUND(OutData%Alpha,1), UBOUND(OutData%Alpha,1) - OutData%Alpha(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RegParam 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%RegParam)) DEALLOCATE(OutData%RegParam) - ALLOCATE(OutData%RegParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RegParam,1), UBOUND(OutData%RegParam,1) - OutData%RegParam(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%RegFunction = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nAct = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackT_Part - - SUBROUTINE FVW_CopyWng_ParameterType( SrcWng_ParameterTypeData, DstWng_ParameterTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_ParameterType), INTENT(IN) :: SrcWng_ParameterTypeData - TYPE(Wng_ParameterType), INTENT(INOUT) :: DstWng_ParameterTypeData - 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 = 'FVW_CopyWng_ParameterType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_ParameterTypeData%chord_LL)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%chord_LL,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%chord_LL,1) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%chord_LL)) THEN - ALLOCATE(DstWng_ParameterTypeData%chord_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%chord_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%chord_LL = SrcWng_ParameterTypeData%chord_LL -ENDIF -IF (ALLOCATED(SrcWng_ParameterTypeData%chord_CP)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%chord_CP,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%chord_CP,1) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%chord_CP)) THEN - ALLOCATE(DstWng_ParameterTypeData%chord_CP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%chord_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%chord_CP = SrcWng_ParameterTypeData%chord_CP -ENDIF -IF (ALLOCATED(SrcWng_ParameterTypeData%s_LL)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%s_LL,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%s_LL,1) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%s_LL)) THEN - ALLOCATE(DstWng_ParameterTypeData%s_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%s_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%s_LL = SrcWng_ParameterTypeData%s_LL -ENDIF -IF (ALLOCATED(SrcWng_ParameterTypeData%s_CP)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%s_CP,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%s_CP,1) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%s_CP)) THEN - ALLOCATE(DstWng_ParameterTypeData%s_CP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%s_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%s_CP = SrcWng_ParameterTypeData%s_CP -ENDIF - DstWng_ParameterTypeData%iRotor = SrcWng_ParameterTypeData%iRotor -IF (ALLOCATED(SrcWng_ParameterTypeData%AFindx)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%AFindx,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%AFindx,1) - i2_l = LBOUND(SrcWng_ParameterTypeData%AFindx,2) - i2_u = UBOUND(SrcWng_ParameterTypeData%AFindx,2) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%AFindx)) THEN - ALLOCATE(DstWng_ParameterTypeData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%AFindx = SrcWng_ParameterTypeData%AFindx -ENDIF - DstWng_ParameterTypeData%nSpan = SrcWng_ParameterTypeData%nSpan -IF (ALLOCATED(SrcWng_ParameterTypeData%PrescribedCirculation)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%PrescribedCirculation,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%PrescribedCirculation,1) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%PrescribedCirculation)) THEN - ALLOCATE(DstWng_ParameterTypeData%PrescribedCirculation(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%PrescribedCirculation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%PrescribedCirculation = SrcWng_ParameterTypeData%PrescribedCirculation -ENDIF - END SUBROUTINE FVW_CopyWng_ParameterType - - SUBROUTINE FVW_DestroyWng_ParameterType( Wng_ParameterTypeData, ErrStat, ErrMsg ) - TYPE(Wng_ParameterType), INTENT(INOUT) :: Wng_ParameterTypeData - 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 = 'FVW_DestroyWng_ParameterType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Wng_ParameterTypeData%chord_LL)) THEN - DEALLOCATE(Wng_ParameterTypeData%chord_LL) -ENDIF -IF (ALLOCATED(Wng_ParameterTypeData%chord_CP)) THEN - DEALLOCATE(Wng_ParameterTypeData%chord_CP) -ENDIF -IF (ALLOCATED(Wng_ParameterTypeData%s_LL)) THEN - DEALLOCATE(Wng_ParameterTypeData%s_LL) -ENDIF -IF (ALLOCATED(Wng_ParameterTypeData%s_CP)) THEN - DEALLOCATE(Wng_ParameterTypeData%s_CP) -ENDIF -IF (ALLOCATED(Wng_ParameterTypeData%AFindx)) THEN - DEALLOCATE(Wng_ParameterTypeData%AFindx) -ENDIF -IF (ALLOCATED(Wng_ParameterTypeData%PrescribedCirculation)) THEN - DEALLOCATE(Wng_ParameterTypeData%PrescribedCirculation) -ENDIF - END SUBROUTINE FVW_DestroyWng_ParameterType - - SUBROUTINE FVW_PackWng_ParameterType( 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(Wng_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 = 'FVW_PackWng_ParameterType' - ! 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 ! chord_LL allocated yes/no - IF ( ALLOCATED(InData%chord_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! chord_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord_LL) ! chord_LL - END IF - Int_BufSz = Int_BufSz + 1 ! chord_CP allocated yes/no - IF ( ALLOCATED(InData%chord_CP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! chord_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord_CP) ! chord_CP - END IF - Int_BufSz = Int_BufSz + 1 ! s_LL allocated yes/no - IF ( ALLOCATED(InData%s_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! s_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%s_LL) ! s_LL - END IF - Int_BufSz = Int_BufSz + 1 ! s_CP allocated yes/no - IF ( ALLOCATED(InData%s_CP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! s_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%s_CP) ! s_CP - END IF - Int_BufSz = Int_BufSz + 1 ! iRotor - Int_BufSz = Int_BufSz + 1 ! AFindx allocated yes/no - IF ( ALLOCATED(InData%AFindx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFindx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AFindx) ! AFindx - END IF - Int_BufSz = Int_BufSz + 1 ! nSpan - Int_BufSz = Int_BufSz + 1 ! PrescribedCirculation allocated yes/no - IF ( ALLOCATED(InData%PrescribedCirculation) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PrescribedCirculation upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrescribedCirculation) ! PrescribedCirculation - 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%chord_LL) ) 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%chord_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%chord_LL,1), UBOUND(InData%chord_LL,1) - ReKiBuf(Re_Xferred) = InData%chord_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%chord_CP) ) 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%chord_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_CP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%chord_CP,1), UBOUND(InData%chord_CP,1) - ReKiBuf(Re_Xferred) = InData%chord_CP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%s_LL) ) 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%s_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%s_LL,1), UBOUND(InData%s_LL,1) - ReKiBuf(Re_Xferred) = InData%s_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%s_CP) ) 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%s_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_CP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%s_CP,1), UBOUND(InData%s_CP,1) - ReKiBuf(Re_Xferred) = InData%s_CP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iRotor - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AFindx) ) 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%AFindx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) - DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) - IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nSpan - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PrescribedCirculation) ) 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%PrescribedCirculation,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrescribedCirculation,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PrescribedCirculation,1), UBOUND(InData%PrescribedCirculation,1) - ReKiBuf(Re_Xferred) = InData%PrescribedCirculation(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_PackWng_ParameterType - - SUBROUTINE FVW_UnPackWng_ParameterType( 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(Wng_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 = 'FVW_UnPackWng_ParameterType' - ! 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 ! chord_LL 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%chord_LL)) DEALLOCATE(OutData%chord_LL) - ALLOCATE(OutData%chord_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%chord_LL,1), UBOUND(OutData%chord_LL,1) - OutData%chord_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord_CP 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%chord_CP)) DEALLOCATE(OutData%chord_CP) - ALLOCATE(OutData%chord_CP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%chord_CP,1), UBOUND(OutData%chord_CP,1) - OutData%chord_CP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_LL 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%s_LL)) DEALLOCATE(OutData%s_LL) - ALLOCATE(OutData%s_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%s_LL,1), UBOUND(OutData%s_LL,1) - OutData%s_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_CP 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%s_CP)) DEALLOCATE(OutData%s_CP) - ALLOCATE(OutData%s_CP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%s_CP,1), UBOUND(OutData%s_CP,1) - OutData%s_CP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%iRotor = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx 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%AFindx)) DEALLOCATE(OutData%AFindx) - ALLOCATE(OutData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) - DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) - OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%nSpan = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrescribedCirculation 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%PrescribedCirculation)) DEALLOCATE(OutData%PrescribedCirculation) - ALLOCATE(OutData%PrescribedCirculation(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrescribedCirculation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PrescribedCirculation,1), UBOUND(OutData%PrescribedCirculation,1) - OutData%PrescribedCirculation(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_UnPackWng_ParameterType - - SUBROUTINE FVW_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_ParameterType), INTENT(IN) :: SrcParamData - TYPE(FVW_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 = 'FVW_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%nRotors = SrcParamData%nRotors - DstParamData%nWings = SrcParamData%nWings -IF (ALLOCATED(SrcParamData%W)) THEN - i1_l = LBOUND(SrcParamData%W,1) - i1_u = UBOUND(SrcParamData%W,1) - IF (.NOT. ALLOCATED(DstParamData%W)) THEN - ALLOCATE(DstParamData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%W,1), UBOUND(SrcParamData%W,1) - CALL FVW_Copywng_parametertype( SrcParamData%W(i1), DstParamData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%Bld2Wings)) THEN - i1_l = LBOUND(SrcParamData%Bld2Wings,1) - i1_u = UBOUND(SrcParamData%Bld2Wings,1) - i2_l = LBOUND(SrcParamData%Bld2Wings,2) - i2_u = UBOUND(SrcParamData%Bld2Wings,2) - IF (.NOT. ALLOCATED(DstParamData%Bld2Wings)) THEN - ALLOCATE(DstParamData%Bld2Wings(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Bld2Wings.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Bld2Wings = SrcParamData%Bld2Wings -ENDIF - DstParamData%iNWStart = SrcParamData%iNWStart - DstParamData%nNWMax = SrcParamData%nNWMax - DstParamData%nNWFree = SrcParamData%nNWFree - DstParamData%nFWMax = SrcParamData%nFWMax - DstParamData%nFWFree = SrcParamData%nFWFree - DstParamData%FWShedVorticity = SrcParamData%FWShedVorticity - DstParamData%IntMethod = SrcParamData%IntMethod - DstParamData%FreeWakeStart = SrcParamData%FreeWakeStart - DstParamData%FullCircStart = SrcParamData%FullCircStart - DstParamData%CircSolvMethod = SrcParamData%CircSolvMethod - DstParamData%CircSolvMaxIter = SrcParamData%CircSolvMaxIter - DstParamData%CircSolvConvCrit = SrcParamData%CircSolvConvCrit - DstParamData%CircSolvRelaxation = SrcParamData%CircSolvRelaxation - DstParamData%CircSolvPolar = SrcParamData%CircSolvPolar - DstParamData%DiffusionMethod = SrcParamData%DiffusionMethod - DstParamData%CoreSpreadEddyVisc = SrcParamData%CoreSpreadEddyVisc - DstParamData%RegDeterMethod = SrcParamData%RegDeterMethod - DstParamData%RegFunction = SrcParamData%RegFunction - DstParamData%WakeRegMethod = SrcParamData%WakeRegMethod - DstParamData%WakeRegParam = SrcParamData%WakeRegParam - DstParamData%WingRegParam = SrcParamData%WingRegParam - DstParamData%ShearModel = SrcParamData%ShearModel - DstParamData%TwrShadowOnWake = SrcParamData%TwrShadowOnWake - DstParamData%VelocityMethod = SrcParamData%VelocityMethod - DstParamData%TreeBranchFactor = SrcParamData%TreeBranchFactor - DstParamData%PartPerSegment = SrcParamData%PartPerSegment - DstParamData%DTaero = SrcParamData%DTaero - DstParamData%DTfvw = SrcParamData%DTfvw - DstParamData%KinVisc = SrcParamData%KinVisc - DstParamData%MHK = SrcParamData%MHK - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%WrVTK = SrcParamData%WrVTK - DstParamData%VTKBlades = SrcParamData%VTKBlades - DstParamData%DTvtk = SrcParamData%DTvtk - DstParamData%VTKCoord = SrcParamData%VTKCoord - DstParamData%RootName = SrcParamData%RootName - DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot - DstParamData%VTK_OutFileBase = SrcParamData%VTK_OutFileBase - DstParamData%nGridOut = SrcParamData%nGridOut - DstParamData%InductionAtCP = SrcParamData%InductionAtCP - DstParamData%WakeAtTE = SrcParamData%WakeAtTE - DstParamData%DStallOnWake = SrcParamData%DStallOnWake - DstParamData%Induction = SrcParamData%Induction - DstParamData%kFrozenNWStart = SrcParamData%kFrozenNWStart - DstParamData%kFrozenNWEnd = SrcParamData%kFrozenNWEnd - END SUBROUTINE FVW_CopyParam - - SUBROUTINE FVW_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(FVW_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 = 'FVW_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%W)) THEN -DO i1 = LBOUND(ParamData%W,1), UBOUND(ParamData%W,1) - CALL FVW_DestroyWng_ParameterType( ParamData%W(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%W) -ENDIF -IF (ALLOCATED(ParamData%Bld2Wings)) THEN - DEALLOCATE(ParamData%Bld2Wings) -ENDIF - END SUBROUTINE FVW_DestroyParam - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 - Int_BufSz = Int_BufSz + 1 ! nRotors - Int_BufSz = Int_BufSz + 1 ! nWings - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Bld2Wings allocated yes/no - IF ( ALLOCATED(InData%Bld2Wings) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Bld2Wings upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Bld2Wings) ! Bld2Wings - END IF - Int_BufSz = Int_BufSz + 1 ! iNWStart - Int_BufSz = Int_BufSz + 1 ! nNWMax - Int_BufSz = Int_BufSz + 1 ! nNWFree - Int_BufSz = Int_BufSz + 1 ! nFWMax - Int_BufSz = Int_BufSz + 1 ! nFWFree - Int_BufSz = Int_BufSz + 1 ! FWShedVorticity - Int_BufSz = Int_BufSz + 1 ! IntMethod - Re_BufSz = Re_BufSz + 1 ! FreeWakeStart - Re_BufSz = Re_BufSz + 1 ! FullCircStart - Int_BufSz = Int_BufSz + 1 ! CircSolvMethod - Int_BufSz = Int_BufSz + 1 ! CircSolvMaxIter - Re_BufSz = Re_BufSz + 1 ! CircSolvConvCrit - Re_BufSz = Re_BufSz + 1 ! CircSolvRelaxation - Int_BufSz = Int_BufSz + 1 ! CircSolvPolar - Int_BufSz = Int_BufSz + 1 ! DiffusionMethod - Re_BufSz = Re_BufSz + 1 ! CoreSpreadEddyVisc - Int_BufSz = Int_BufSz + 1 ! RegDeterMethod - Int_BufSz = Int_BufSz + 1 ! RegFunction - Int_BufSz = Int_BufSz + 1 ! WakeRegMethod - Re_BufSz = Re_BufSz + 1 ! WakeRegParam - Re_BufSz = Re_BufSz + 1 ! WingRegParam - Int_BufSz = Int_BufSz + 1 ! ShearModel - Int_BufSz = Int_BufSz + 1 ! TwrShadowOnWake - Int_BufSz = Int_BufSz + SIZE(InData%VelocityMethod) ! VelocityMethod - Re_BufSz = Re_BufSz + SIZE(InData%TreeBranchFactor) ! TreeBranchFactor - Int_BufSz = Int_BufSz + SIZE(InData%PartPerSegment) ! PartPerSegment - Db_BufSz = Db_BufSz + 1 ! DTaero - Db_BufSz = Db_BufSz + 1 ! DTfvw - Re_BufSz = Re_BufSz + 1 ! KinVisc - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! WrVTK - Int_BufSz = Int_BufSz + 1 ! VTKBlades - Db_BufSz = Db_BufSz + 1 ! DTvtk - Int_BufSz = Int_BufSz + 1 ! VTKCoord - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileRoot) ! VTK_OutFileRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileBase) ! VTK_OutFileBase - Int_BufSz = Int_BufSz + 1 ! nGridOut - Int_BufSz = Int_BufSz + 1 ! InductionAtCP - Int_BufSz = Int_BufSz + 1 ! WakeAtTE - Int_BufSz = Int_BufSz + 1 ! DStallOnWake - Int_BufSz = Int_BufSz + 1 ! Induction - Re_BufSz = Re_BufSz + 1 ! kFrozenNWStart - Re_BufSz = Re_BufSz + 1 ! kFrozenNWEnd - 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%nRotors - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nWings - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%W) ) 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%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%Bld2Wings) ) 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%Bld2Wings,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bld2Wings,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bld2Wings,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bld2Wings,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Bld2Wings,2), UBOUND(InData%Bld2Wings,2) - DO i1 = LBOUND(InData%Bld2Wings,1), UBOUND(InData%Bld2Wings,1) - IntKiBuf(Int_Xferred) = InData%Bld2Wings(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iNWStart - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNWMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNWFree - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFWMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFWFree - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FWShedVorticity, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FreeWakeStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FullCircStart - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CircSolvMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CircSolvMaxIter - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CircSolvConvCrit - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CircSolvRelaxation - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CircSolvPolar - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DiffusionMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CoreSpreadEddyVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RegDeterMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RegFunction - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WakeRegMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WakeRegParam - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WingRegParam - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ShearModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadowOnWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%VelocityMethod,1), UBOUND(InData%VelocityMethod,1) - IntKiBuf(Int_Xferred) = InData%VelocityMethod(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TreeBranchFactor,1), UBOUND(InData%TreeBranchFactor,1) - ReKiBuf(Re_Xferred) = InData%TreeBranchFactor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PartPerSegment,1), UBOUND(InData%PartPerSegment,1) - IntKiBuf(Int_Xferred) = InData%PartPerSegment(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%DTaero - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTfvw - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKBlades - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTvtk - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKCoord - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%VTK_OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%VTK_OutFileBase) - IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileBase(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%nGridOut - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%InductionAtCP, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WakeAtTE, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DStallOnWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Induction, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%kFrozenNWStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%kFrozenNWEnd - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FVW_PackParam - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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%nRotors = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nWings = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W 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%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,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 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 - - 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 ! Bld2Wings 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%Bld2Wings)) DEALLOCATE(OutData%Bld2Wings) - ALLOCATE(OutData%Bld2Wings(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bld2Wings.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Bld2Wings,2), UBOUND(OutData%Bld2Wings,2) - DO i1 = LBOUND(OutData%Bld2Wings,1), UBOUND(OutData%Bld2Wings,1) - OutData%Bld2Wings(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%iNWStart = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNWMax = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNWFree = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFWMax = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFWFree = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FWShedVorticity = TRANSFER(IntKiBuf(Int_Xferred), OutData%FWShedVorticity) - Int_Xferred = Int_Xferred + 1 - OutData%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FreeWakeStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FullCircStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CircSolvMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CircSolvMaxIter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CircSolvConvCrit = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CircSolvRelaxation = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CircSolvPolar = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DiffusionMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CoreSpreadEddyVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RegDeterMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RegFunction = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakeRegMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakeRegParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WingRegParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShearModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadowOnWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadowOnWake) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%VelocityMethod,1) - i1_u = UBOUND(OutData%VelocityMethod,1) - DO i1 = LBOUND(OutData%VelocityMethod,1), UBOUND(OutData%VelocityMethod,1) - OutData%VelocityMethod(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TreeBranchFactor,1) - i1_u = UBOUND(OutData%TreeBranchFactor,1) - DO i1 = LBOUND(OutData%TreeBranchFactor,1), UBOUND(OutData%TreeBranchFactor,1) - OutData%TreeBranchFactor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PartPerSegment,1) - i1_u = UBOUND(OutData%PartPerSegment,1) - DO i1 = LBOUND(OutData%PartPerSegment,1), UBOUND(OutData%PartPerSegment,1) - OutData%PartPerSegment(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%DTaero = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DTfvw = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DTvtk = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%VTKCoord = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%VTK_OutFileRoot) - OutData%VTK_OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%VTK_OutFileBase) - OutData%VTK_OutFileBase(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%nGridOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InductionAtCP = TRANSFER(IntKiBuf(Int_Xferred), OutData%InductionAtCP) - Int_Xferred = Int_Xferred + 1 - OutData%WakeAtTE = TRANSFER(IntKiBuf(Int_Xferred), OutData%WakeAtTE) - Int_Xferred = Int_Xferred + 1 - OutData%DStallOnWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%DStallOnWake) - Int_Xferred = Int_Xferred + 1 - OutData%Induction = TRANSFER(IntKiBuf(Int_Xferred), OutData%Induction) - Int_Xferred = Int_Xferred + 1 - OutData%kFrozenNWStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%kFrozenNWEnd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FVW_UnPackParam - - SUBROUTINE FVW_CopyWng_ContinuousStateType( SrcWng_ContinuousStateTypeData, DstWng_ContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_ContinuousStateType), INTENT(IN) :: SrcWng_ContinuousStateTypeData - TYPE(Wng_ContinuousStateType), INTENT(INOUT) :: DstWng_ContinuousStateTypeData - 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 = 'FVW_CopyWng_ContinuousStateType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%Gamma_NW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%Gamma_NW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%Gamma_NW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%Gamma_NW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%Gamma_NW,2) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%Gamma_NW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%Gamma_NW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Gamma_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%Gamma_NW = SrcWng_ContinuousStateTypeData%Gamma_NW -ENDIF -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%Gamma_FW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%Gamma_FW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%Gamma_FW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%Gamma_FW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%Gamma_FW,2) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%Gamma_FW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%Gamma_FW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Gamma_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%Gamma_FW = SrcWng_ContinuousStateTypeData%Gamma_FW -ENDIF -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%Eps_NW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,2) - i3_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,3) - i3_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,3) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%Eps_NW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%Eps_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Eps_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%Eps_NW = SrcWng_ContinuousStateTypeData%Eps_NW -ENDIF -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%Eps_FW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,2) - i3_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,3) - i3_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,3) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%Eps_FW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%Eps_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Eps_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%Eps_FW = SrcWng_ContinuousStateTypeData%Eps_FW -ENDIF -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%r_NW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%r_NW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%r_NW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%r_NW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%r_NW,2) - i3_l = LBOUND(SrcWng_ContinuousStateTypeData%r_NW,3) - i3_u = UBOUND(SrcWng_ContinuousStateTypeData%r_NW,3) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%r_NW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%r_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%r_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%r_NW = SrcWng_ContinuousStateTypeData%r_NW -ENDIF -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%r_FW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%r_FW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%r_FW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%r_FW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%r_FW,2) - i3_l = LBOUND(SrcWng_ContinuousStateTypeData%r_FW,3) - i3_u = UBOUND(SrcWng_ContinuousStateTypeData%r_FW,3) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%r_FW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%r_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%r_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%r_FW = SrcWng_ContinuousStateTypeData%r_FW -ENDIF - END SUBROUTINE FVW_CopyWng_ContinuousStateType - - SUBROUTINE FVW_DestroyWng_ContinuousStateType( Wng_ContinuousStateTypeData, ErrStat, ErrMsg ) - TYPE(Wng_ContinuousStateType), INTENT(INOUT) :: Wng_ContinuousStateTypeData - 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 = 'FVW_DestroyWng_ContinuousStateType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Wng_ContinuousStateTypeData%Gamma_NW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%Gamma_NW) -ENDIF -IF (ALLOCATED(Wng_ContinuousStateTypeData%Gamma_FW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%Gamma_FW) -ENDIF -IF (ALLOCATED(Wng_ContinuousStateTypeData%Eps_NW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%Eps_NW) -ENDIF -IF (ALLOCATED(Wng_ContinuousStateTypeData%Eps_FW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%Eps_FW) -ENDIF -IF (ALLOCATED(Wng_ContinuousStateTypeData%r_NW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%r_NW) -ENDIF -IF (ALLOCATED(Wng_ContinuousStateTypeData%r_FW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%r_FW) -ENDIF - END SUBROUTINE FVW_DestroyWng_ContinuousStateType - - SUBROUTINE FVW_PackWng_ContinuousStateType( 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(Wng_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 = 'FVW_PackWng_ContinuousStateType' - ! 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 ! Gamma_NW allocated yes/no - IF ( ALLOCATED(InData%Gamma_NW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Gamma_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma_NW) ! Gamma_NW - END IF - Int_BufSz = Int_BufSz + 1 ! Gamma_FW allocated yes/no - IF ( ALLOCATED(InData%Gamma_FW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Gamma_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma_FW) ! Gamma_FW - END IF - Int_BufSz = Int_BufSz + 1 ! Eps_NW allocated yes/no - IF ( ALLOCATED(InData%Eps_NW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Eps_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Eps_NW) ! Eps_NW - END IF - Int_BufSz = Int_BufSz + 1 ! Eps_FW allocated yes/no - IF ( ALLOCATED(InData%Eps_FW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Eps_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Eps_FW) ! Eps_FW - END IF - Int_BufSz = Int_BufSz + 1 ! r_NW allocated yes/no - IF ( ALLOCATED(InData%r_NW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! r_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_NW) ! r_NW - END IF - Int_BufSz = Int_BufSz + 1 ! r_FW allocated yes/no - IF ( ALLOCATED(InData%r_FW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! r_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_FW) ! r_FW - 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%Gamma_NW) ) 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%Gamma_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_NW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Gamma_NW,2), UBOUND(InData%Gamma_NW,2) - DO i1 = LBOUND(InData%Gamma_NW,1), UBOUND(InData%Gamma_NW,1) - ReKiBuf(Re_Xferred) = InData%Gamma_NW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gamma_FW) ) 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%Gamma_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_FW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Gamma_FW,2), UBOUND(InData%Gamma_FW,2) - DO i1 = LBOUND(InData%Gamma_FW,1), UBOUND(InData%Gamma_FW,1) - ReKiBuf(Re_Xferred) = InData%Gamma_FW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Eps_NW) ) 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%Eps_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_NW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_NW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Eps_NW,3), UBOUND(InData%Eps_NW,3) - DO i2 = LBOUND(InData%Eps_NW,2), UBOUND(InData%Eps_NW,2) - DO i1 = LBOUND(InData%Eps_NW,1), UBOUND(InData%Eps_NW,1) - ReKiBuf(Re_Xferred) = InData%Eps_NW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Eps_FW) ) 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%Eps_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_FW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Eps_FW,3), UBOUND(InData%Eps_FW,3) - DO i2 = LBOUND(InData%Eps_FW,2), UBOUND(InData%Eps_FW,2) - DO i1 = LBOUND(InData%Eps_FW,1), UBOUND(InData%Eps_FW,1) - ReKiBuf(Re_Xferred) = InData%Eps_FW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_NW) ) 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%r_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%r_NW,3), UBOUND(InData%r_NW,3) - DO i2 = LBOUND(InData%r_NW,2), UBOUND(InData%r_NW,2) - DO i1 = LBOUND(InData%r_NW,1), UBOUND(InData%r_NW,1) - ReKiBuf(Re_Xferred) = InData%r_NW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_FW) ) 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%r_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%r_FW,3), UBOUND(InData%r_FW,3) - DO i2 = LBOUND(InData%r_FW,2), UBOUND(InData%r_FW,2) - DO i1 = LBOUND(InData%r_FW,1), UBOUND(InData%r_FW,1) - ReKiBuf(Re_Xferred) = InData%r_FW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FVW_PackWng_ContinuousStateType - - SUBROUTINE FVW_UnPackWng_ContinuousStateType( 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(Wng_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) :: 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 = 'FVW_UnPackWng_ContinuousStateType' - ! 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 ! Gamma_NW 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%Gamma_NW)) DEALLOCATE(OutData%Gamma_NW) - ALLOCATE(OutData%Gamma_NW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Gamma_NW,2), UBOUND(OutData%Gamma_NW,2) - DO i1 = LBOUND(OutData%Gamma_NW,1), UBOUND(OutData%Gamma_NW,1) - OutData%Gamma_NW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma_FW 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%Gamma_FW)) DEALLOCATE(OutData%Gamma_FW) - ALLOCATE(OutData%Gamma_FW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Gamma_FW,2), UBOUND(OutData%Gamma_FW,2) - DO i1 = LBOUND(OutData%Gamma_FW,1), UBOUND(OutData%Gamma_FW,1) - OutData%Gamma_FW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Eps_NW 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%Eps_NW)) DEALLOCATE(OutData%Eps_NW) - ALLOCATE(OutData%Eps_NW(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%Eps_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Eps_NW,3), UBOUND(OutData%Eps_NW,3) - DO i2 = LBOUND(OutData%Eps_NW,2), UBOUND(OutData%Eps_NW,2) - DO i1 = LBOUND(OutData%Eps_NW,1), UBOUND(OutData%Eps_NW,1) - OutData%Eps_NW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Eps_FW 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%Eps_FW)) DEALLOCATE(OutData%Eps_FW) - ALLOCATE(OutData%Eps_FW(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%Eps_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Eps_FW,3), UBOUND(OutData%Eps_FW,3) - DO i2 = LBOUND(OutData%Eps_FW,2), UBOUND(OutData%Eps_FW,2) - DO i1 = LBOUND(OutData%Eps_FW,1), UBOUND(OutData%Eps_FW,1) - OutData%Eps_FW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_NW 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%r_NW)) DEALLOCATE(OutData%r_NW) - ALLOCATE(OutData%r_NW(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%r_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%r_NW,3), UBOUND(OutData%r_NW,3) - DO i2 = LBOUND(OutData%r_NW,2), UBOUND(OutData%r_NW,2) - DO i1 = LBOUND(OutData%r_NW,1), UBOUND(OutData%r_NW,1) - OutData%r_NW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_FW 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%r_FW)) DEALLOCATE(OutData%r_FW) - ALLOCATE(OutData%r_FW(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%r_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%r_FW,3), UBOUND(OutData%r_FW,3) - DO i2 = LBOUND(OutData%r_FW,2), UBOUND(OutData%r_FW,2) - DO i1 = LBOUND(OutData%r_FW,1), UBOUND(OutData%r_FW,1) - OutData%r_FW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FVW_UnPackWng_ContinuousStateType - - SUBROUTINE FVW_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(FVW_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%W)) THEN - i1_l = LBOUND(SrcContStateData%W,1) - i1_u = UBOUND(SrcContStateData%W,1) - IF (.NOT. ALLOCATED(DstContStateData%W)) THEN - ALLOCATE(DstContStateData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%W,1), UBOUND(SrcContStateData%W,1) - CALL FVW_Copywng_continuousstatetype( SrcContStateData%W(i1), DstContStateData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcContStateData%UA)) THEN - i1_l = LBOUND(SrcContStateData%UA,1) - i1_u = UBOUND(SrcContStateData%UA,1) - IF (.NOT. ALLOCATED(DstContStateData%UA)) THEN - ALLOCATE(DstContStateData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%UA,1), UBOUND(SrcContStateData%UA,1) - CALL UA_CopyContState( SrcContStateData%UA(i1), DstContStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FVW_CopyContState - - SUBROUTINE FVW_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(FVW_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 = 'FVW_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%W)) THEN -DO i1 = LBOUND(ContStateData%W,1), UBOUND(ContStateData%W,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%UA) -ENDIF - END SUBROUTINE FVW_DestroyContState - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! UA allocated yes/no - IF ( ALLOCATED(InData%UA) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UA upper/lower bounds for each dimension - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%W) ) 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%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%UA) ) 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%UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 - END SUBROUTINE FVW_PackContState - - SUBROUTINE FVW_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(FVW_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W 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%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,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 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 - - 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 ! UA 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%UA)) DEALLOCATE(OutData%UA) - ALLOCATE(OutData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UA,1), UBOUND(OutData%UA,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 UA_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%UA(i1), ErrStat2, ErrMsg2 ) ! UA - 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 - END SUBROUTINE FVW_UnPackContState - - SUBROUTINE FVW_CopyWng_OutputType( SrcWng_OutputTypeData, DstWng_OutputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_OutputType), INTENT(IN) :: SrcWng_OutputTypeData - TYPE(Wng_OutputType), INTENT(INOUT) :: DstWng_OutputTypeData - 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 = 'FVW_CopyWng_OutputType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_OutputTypeData%Vind)) THEN - i1_l = LBOUND(SrcWng_OutputTypeData%Vind,1) - i1_u = UBOUND(SrcWng_OutputTypeData%Vind,1) - i2_l = LBOUND(SrcWng_OutputTypeData%Vind,2) - i2_u = UBOUND(SrcWng_OutputTypeData%Vind,2) - IF (.NOT. ALLOCATED(DstWng_OutputTypeData%Vind)) THEN - ALLOCATE(DstWng_OutputTypeData%Vind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_OutputTypeData%Vind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_OutputTypeData%Vind = SrcWng_OutputTypeData%Vind -ENDIF - END SUBROUTINE FVW_CopyWng_OutputType - - SUBROUTINE FVW_DestroyWng_OutputType( Wng_OutputTypeData, ErrStat, ErrMsg ) - TYPE(Wng_OutputType), INTENT(INOUT) :: Wng_OutputTypeData - 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 = 'FVW_DestroyWng_OutputType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Wng_OutputTypeData%Vind)) THEN - DEALLOCATE(Wng_OutputTypeData%Vind) -ENDIF - END SUBROUTINE FVW_DestroyWng_OutputType - - SUBROUTINE FVW_PackWng_OutputType( 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(Wng_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 = 'FVW_PackWng_OutputType' - ! 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 ! Vind allocated yes/no - IF ( ALLOCATED(InData%Vind) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind) ! Vind - 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%Vind) ) 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%Vind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vind,2), UBOUND(InData%Vind,2) - DO i1 = LBOUND(InData%Vind,1), UBOUND(InData%Vind,1) - ReKiBuf(Re_Xferred) = InData%Vind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FVW_PackWng_OutputType - - SUBROUTINE FVW_UnPackWng_OutputType( 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(Wng_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackWng_OutputType' - ! 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 ! Vind 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%Vind)) DEALLOCATE(OutData%Vind) - ALLOCATE(OutData%Vind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vind,2), UBOUND(OutData%Vind,2) - DO i1 = LBOUND(OutData%Vind,1), UBOUND(OutData%Vind,1) - OutData%Vind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FVW_UnPackWng_OutputType - - SUBROUTINE FVW_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_OutputType), INTENT(IN) :: SrcOutputData - TYPE(FVW_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 = 'FVW_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%W)) THEN - i1_l = LBOUND(SrcOutputData%W,1) - i1_u = UBOUND(SrcOutputData%W,1) - IF (.NOT. ALLOCATED(DstOutputData%W)) THEN - ALLOCATE(DstOutputData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%W,1), UBOUND(SrcOutputData%W,1) - CALL FVW_Copywng_outputtype( SrcOutputData%W(i1), DstOutputData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FVW_CopyOutput - - SUBROUTINE FVW_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(FVW_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 = 'FVW_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%W)) THEN -DO i1 = LBOUND(OutputData%W,1), UBOUND(OutputData%W,1) - CALL FVW_DestroyWng_OutputType( OutputData%W(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%W) -ENDIF - END SUBROUTINE FVW_DestroyOutput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%W) ) 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%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - 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 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 - END SUBROUTINE FVW_PackOutput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! W 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%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,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 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 - - 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 - END SUBROUTINE FVW_UnPackOutput - - SUBROUTINE FVW_CopyWng_MiscVarType( SrcWng_MiscVarTypeData, DstWng_MiscVarTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_MiscVarType), INTENT(IN) :: SrcWng_MiscVarTypeData - TYPE(Wng_MiscVarType), INTENT(INOUT) :: DstWng_MiscVarTypeData - 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 = 'FVW_CopyWng_MiscVarType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_MiscVarTypeData%LE)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%LE,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%LE,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%LE,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%LE,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%LE)) THEN - ALLOCATE(DstWng_MiscVarTypeData%LE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%LE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%LE = SrcWng_MiscVarTypeData%LE -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%TE)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%TE,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%TE,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%TE,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%TE,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%TE)) THEN - ALLOCATE(DstWng_MiscVarTypeData%TE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%TE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%TE = SrcWng_MiscVarTypeData%TE -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%r_LL)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%r_LL,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%r_LL,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%r_LL,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%r_LL,2) - i3_l = LBOUND(SrcWng_MiscVarTypeData%r_LL,3) - i3_u = UBOUND(SrcWng_MiscVarTypeData%r_LL,3) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%r_LL)) THEN - ALLOCATE(DstWng_MiscVarTypeData%r_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%r_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%r_LL = SrcWng_MiscVarTypeData%r_LL -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%CP)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%CP,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%CP,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%CP,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%CP,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%CP)) THEN - ALLOCATE(DstWng_MiscVarTypeData%CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%CP = SrcWng_MiscVarTypeData%CP -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Tang)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Tang,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Tang,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Tang,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Tang,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Tang)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Tang(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Tang.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Tang = SrcWng_MiscVarTypeData%Tang -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Norm)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Norm,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Norm,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Norm,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Norm,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Norm)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Norm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Norm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Norm = SrcWng_MiscVarTypeData%Norm -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Orth)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Orth,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Orth,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Orth,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Orth,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Orth)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Orth(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Orth.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Orth = SrcWng_MiscVarTypeData%Orth -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%dl)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%dl,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%dl,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%dl,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%dl,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%dl)) THEN - ALLOCATE(DstWng_MiscVarTypeData%dl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%dl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%dl = SrcWng_MiscVarTypeData%dl -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Area)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Area,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Area,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Area)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Area(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Area.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Area = SrcWng_MiscVarTypeData%Area -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%diag_LL)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%diag_LL,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%diag_LL,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%diag_LL)) THEN - ALLOCATE(DstWng_MiscVarTypeData%diag_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%diag_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%diag_LL = SrcWng_MiscVarTypeData%diag_LL -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vind_CP)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vind_CP,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vind_CP,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vind_CP,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vind_CP,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vind_CP)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vind_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vind_CP = SrcWng_MiscVarTypeData%Vind_CP -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vtot_CP)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vtot_CP,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vtot_CP,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vtot_CP,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vtot_CP,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vtot_CP)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vtot_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vtot_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vtot_CP = SrcWng_MiscVarTypeData%Vtot_CP -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vstr_CP)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vstr_CP,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vstr_CP,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vstr_CP,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vstr_CP,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vstr_CP)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vstr_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vstr_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vstr_CP = SrcWng_MiscVarTypeData%Vstr_CP -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vwnd_CP)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_CP,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_CP,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_CP,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_CP,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vwnd_CP)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vwnd_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vwnd_CP = SrcWng_MiscVarTypeData%Vwnd_CP -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vwnd_NW)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,2) - i3_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,3) - i3_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,3) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vwnd_NW)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vwnd_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vwnd_NW = SrcWng_MiscVarTypeData%Vwnd_NW -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vwnd_FW)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,2) - i3_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,3) - i3_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,3) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vwnd_FW)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vwnd_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vwnd_FW = SrcWng_MiscVarTypeData%Vwnd_FW -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vind_NW)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vind_NW,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vind_NW,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vind_NW,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vind_NW,2) - i3_l = LBOUND(SrcWng_MiscVarTypeData%Vind_NW,3) - i3_u = UBOUND(SrcWng_MiscVarTypeData%Vind_NW,3) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vind_NW)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vind_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vind_NW = SrcWng_MiscVarTypeData%Vind_NW -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vind_FW)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vind_FW,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vind_FW,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vind_FW,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vind_FW,2) - i3_l = LBOUND(SrcWng_MiscVarTypeData%Vind_FW,3) - i3_u = UBOUND(SrcWng_MiscVarTypeData%Vind_FW,3) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vind_FW)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vind_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vind_FW = SrcWng_MiscVarTypeData%Vind_FW -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%PitchAndTwist)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%PitchAndTwist,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%PitchAndTwist,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%PitchAndTwist)) THEN - ALLOCATE(DstWng_MiscVarTypeData%PitchAndTwist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%PitchAndTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%PitchAndTwist = SrcWng_MiscVarTypeData%PitchAndTwist -ENDIF - DstWng_MiscVarTypeData%iTip = SrcWng_MiscVarTypeData%iTip - DstWng_MiscVarTypeData%iRoot = SrcWng_MiscVarTypeData%iRoot -IF (ALLOCATED(SrcWng_MiscVarTypeData%alpha_LL)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%alpha_LL,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%alpha_LL,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%alpha_LL)) THEN - ALLOCATE(DstWng_MiscVarTypeData%alpha_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%alpha_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%alpha_LL = SrcWng_MiscVarTypeData%alpha_LL -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vreln_LL)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vreln_LL,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vreln_LL,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vreln_LL)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vreln_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vreln_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vreln_LL = SrcWng_MiscVarTypeData%Vreln_LL -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%u_UA)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%u_UA,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%u_UA,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%u_UA,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%u_UA,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%u_UA)) THEN - ALLOCATE(DstWng_MiscVarTypeData%u_UA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%u_UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcWng_MiscVarTypeData%u_UA,2), UBOUND(SrcWng_MiscVarTypeData%u_UA,2) - DO i1 = LBOUND(SrcWng_MiscVarTypeData%u_UA,1), UBOUND(SrcWng_MiscVarTypeData%u_UA,1) - CALL UA_CopyInput( SrcWng_MiscVarTypeData%u_UA(i1,i2), DstWng_MiscVarTypeData%u_UA(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF - CALL UA_CopyMisc( SrcWng_MiscVarTypeData%m_UA, DstWng_MiscVarTypeData%m_UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL UA_CopyOutput( SrcWng_MiscVarTypeData%y_UA, DstWng_MiscVarTypeData%y_UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL UA_CopyParam( SrcWng_MiscVarTypeData%p_UA, DstWng_MiscVarTypeData%p_UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vind_LL)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vind_LL,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vind_LL,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vind_LL,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vind_LL,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vind_LL)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vind_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vind_LL = SrcWng_MiscVarTypeData%Vind_LL -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_AxInd)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_AxInd,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_AxInd,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_AxInd)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_AxInd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_AxInd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_AxInd = SrcWng_MiscVarTypeData%BN_AxInd -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_TanInd)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_TanInd,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_TanInd,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_TanInd)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_TanInd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_TanInd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_TanInd = SrcWng_MiscVarTypeData%BN_TanInd -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Vrel)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Vrel,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Vrel,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Vrel)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Vrel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Vrel = SrcWng_MiscVarTypeData%BN_Vrel -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_alpha)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_alpha,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_alpha,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_alpha)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_alpha = SrcWng_MiscVarTypeData%BN_alpha -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_phi)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_phi,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_phi,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_phi)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_phi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_phi = SrcWng_MiscVarTypeData%BN_phi -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Re)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Re,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Re,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Re)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Re(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Re.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Re = SrcWng_MiscVarTypeData%BN_Re -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_URelWind_s)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_URelWind_s,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_URelWind_s,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%BN_URelWind_s,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%BN_URelWind_s,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_URelWind_s)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_URelWind_s(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_URelWind_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_URelWind_s = SrcWng_MiscVarTypeData%BN_URelWind_s -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cl_Static)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cl_Static,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cl_Static,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cl_Static)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cl_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cl_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cl_Static = SrcWng_MiscVarTypeData%BN_Cl_Static -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cd_Static)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cd_Static,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cd_Static,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cd_Static)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cd_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cd_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cd_Static = SrcWng_MiscVarTypeData%BN_Cd_Static -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cm_Static)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cm_Static,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cm_Static,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cm_Static)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cm_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cm_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cm_Static = SrcWng_MiscVarTypeData%BN_Cm_Static -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cpmin)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cpmin,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cpmin,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cpmin)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cpmin(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cpmin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cpmin = SrcWng_MiscVarTypeData%BN_Cpmin -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cl)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cl,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cl,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cl)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cl = SrcWng_MiscVarTypeData%BN_Cl -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cd)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cd,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cd,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cd)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cd = SrcWng_MiscVarTypeData%BN_Cd -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cm)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cm,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cm,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cm)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cm = SrcWng_MiscVarTypeData%BN_Cm -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cx)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cx,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cx,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cx)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cx = SrcWng_MiscVarTypeData%BN_Cx -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cy)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cy,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cy,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cy)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cy = SrcWng_MiscVarTypeData%BN_Cy -ENDIF - END SUBROUTINE FVW_CopyWng_MiscVarType - - SUBROUTINE FVW_DestroyWng_MiscVarType( Wng_MiscVarTypeData, ErrStat, ErrMsg ) - TYPE(Wng_MiscVarType), INTENT(INOUT) :: Wng_MiscVarTypeData - 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 = 'FVW_DestroyWng_MiscVarType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Wng_MiscVarTypeData%LE)) THEN - DEALLOCATE(Wng_MiscVarTypeData%LE) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%TE)) THEN - DEALLOCATE(Wng_MiscVarTypeData%TE) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%r_LL)) THEN - DEALLOCATE(Wng_MiscVarTypeData%r_LL) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%CP)) THEN - DEALLOCATE(Wng_MiscVarTypeData%CP) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Tang)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Tang) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Norm)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Norm) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Orth)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Orth) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%dl)) THEN - DEALLOCATE(Wng_MiscVarTypeData%dl) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Area)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Area) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%diag_LL)) THEN - DEALLOCATE(Wng_MiscVarTypeData%diag_LL) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vind_CP)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vind_CP) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vtot_CP)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vtot_CP) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vstr_CP)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vstr_CP) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vwnd_CP)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vwnd_CP) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vwnd_NW)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vwnd_NW) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vwnd_FW)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vwnd_FW) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vind_NW)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vind_NW) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vind_FW)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vind_FW) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%PitchAndTwist)) THEN - DEALLOCATE(Wng_MiscVarTypeData%PitchAndTwist) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%alpha_LL)) THEN - DEALLOCATE(Wng_MiscVarTypeData%alpha_LL) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vreln_LL)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vreln_LL) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(Wng_MiscVarTypeData%u_UA) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_AxInd)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_AxInd) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_TanInd)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_TanInd) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Vrel)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Vrel) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_alpha)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_alpha) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_phi)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_phi) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Re)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Re) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_URelWind_s)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_URelWind_s) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cl_Static)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cl_Static) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cd_Static)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cd_Static) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cm_Static)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cm_Static) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cpmin)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cpmin) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cl)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cl) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cd)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cd) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cm)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cm) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cx)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cx) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cy)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cy) -ENDIF - END SUBROUTINE FVW_DestroyWng_MiscVarType - - SUBROUTINE FVW_PackWng_MiscVarType( 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(Wng_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 = 'FVW_PackWng_MiscVarType' - ! 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 ! LE allocated yes/no - IF ( ALLOCATED(InData%LE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LE) ! LE - END IF - Int_BufSz = Int_BufSz + 1 ! TE allocated yes/no - IF ( ALLOCATED(InData%TE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TE) ! TE - END IF - Int_BufSz = Int_BufSz + 1 ! r_LL allocated yes/no - IF ( ALLOCATED(InData%r_LL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! r_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_LL) ! r_LL - END IF - Int_BufSz = Int_BufSz + 1 ! CP allocated yes/no - IF ( ALLOCATED(InData%CP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CP) ! CP - END IF - Int_BufSz = Int_BufSz + 1 ! Tang allocated yes/no - IF ( ALLOCATED(InData%Tang) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Tang upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Tang) ! Tang - END IF - Int_BufSz = Int_BufSz + 1 ! Norm allocated yes/no - IF ( ALLOCATED(InData%Norm) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Norm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Norm) ! Norm - END IF - Int_BufSz = Int_BufSz + 1 ! Orth allocated yes/no - IF ( ALLOCATED(InData%Orth) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Orth upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Orth) ! Orth - END IF - Int_BufSz = Int_BufSz + 1 ! dl allocated yes/no - IF ( ALLOCATED(InData%dl) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! dl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dl) ! dl - END IF - Int_BufSz = Int_BufSz + 1 ! Area allocated yes/no - IF ( ALLOCATED(InData%Area) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Area upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Area) ! Area - END IF - Int_BufSz = Int_BufSz + 1 ! diag_LL allocated yes/no - IF ( ALLOCATED(InData%diag_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! diag_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%diag_LL) ! diag_LL - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_CP allocated yes/no - IF ( ALLOCATED(InData%Vind_CP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vind_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_CP) ! Vind_CP - END IF - Int_BufSz = Int_BufSz + 1 ! Vtot_CP allocated yes/no - IF ( ALLOCATED(InData%Vtot_CP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vtot_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vtot_CP) ! Vtot_CP - END IF - Int_BufSz = Int_BufSz + 1 ! Vstr_CP allocated yes/no - IF ( ALLOCATED(InData%Vstr_CP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vstr_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vstr_CP) ! Vstr_CP - END IF - Int_BufSz = Int_BufSz + 1 ! Vwnd_CP allocated yes/no - IF ( ALLOCATED(InData%Vwnd_CP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vwnd_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_CP) ! Vwnd_CP - END IF - Int_BufSz = Int_BufSz + 1 ! Vwnd_NW allocated yes/no - IF ( ALLOCATED(InData%Vwnd_NW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vwnd_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_NW) ! Vwnd_NW - END IF - Int_BufSz = Int_BufSz + 1 ! Vwnd_FW allocated yes/no - IF ( ALLOCATED(InData%Vwnd_FW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vwnd_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_FW) ! Vwnd_FW - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_NW allocated yes/no - IF ( ALLOCATED(InData%Vind_NW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vind_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_NW) ! Vind_NW - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_FW allocated yes/no - IF ( ALLOCATED(InData%Vind_FW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vind_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_FW) ! Vind_FW - END IF - Int_BufSz = Int_BufSz + 1 ! PitchAndTwist allocated yes/no - IF ( ALLOCATED(InData%PitchAndTwist) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PitchAndTwist upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PitchAndTwist) ! PitchAndTwist - END IF - Int_BufSz = Int_BufSz + 1 ! iTip - Int_BufSz = Int_BufSz + 1 ! iRoot - Int_BufSz = Int_BufSz + 1 ! alpha_LL allocated yes/no - IF ( ALLOCATED(InData%alpha_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! alpha_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_LL) ! alpha_LL - END IF - Int_BufSz = Int_BufSz + 1 ! Vreln_LL allocated yes/no - IF ( ALLOCATED(InData%Vreln_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vreln_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vreln_LL) ! Vreln_LL - END IF - Int_BufSz = Int_BufSz + 1 ! u_UA allocated yes/no - IF ( ALLOCATED(InData%u_UA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_UA upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) - DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) - Int_BufSz = Int_BufSz + 3 ! u_UA: size of buffers for each call to pack subtype - CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! m_UA: size of buffers for each call to pack subtype - CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_UA, ErrStat2, ErrMsg2, .TRUE. ) ! m_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_UA: size of buffers for each call to pack subtype - CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, .TRUE. ) ! y_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p_UA: size of buffers for each call to pack subtype - CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_UA, ErrStat2, ErrMsg2, .TRUE. ) ! p_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_LL allocated yes/no - IF ( ALLOCATED(InData%Vind_LL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vind_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_LL) ! Vind_LL - END IF - Int_BufSz = Int_BufSz + 1 ! BN_AxInd allocated yes/no - IF ( ALLOCATED(InData%BN_AxInd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_AxInd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_AxInd) ! BN_AxInd - END IF - Int_BufSz = Int_BufSz + 1 ! BN_TanInd allocated yes/no - IF ( ALLOCATED(InData%BN_TanInd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_TanInd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_TanInd) ! BN_TanInd - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Vrel allocated yes/no - IF ( ALLOCATED(InData%BN_Vrel) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Vrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Vrel) ! BN_Vrel - END IF - Int_BufSz = Int_BufSz + 1 ! BN_alpha allocated yes/no - IF ( ALLOCATED(InData%BN_alpha) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_alpha upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_alpha) ! BN_alpha - END IF - Int_BufSz = Int_BufSz + 1 ! BN_phi allocated yes/no - IF ( ALLOCATED(InData%BN_phi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_phi) ! BN_phi - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Re allocated yes/no - IF ( ALLOCATED(InData%BN_Re) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Re upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Re) ! BN_Re - END IF - Int_BufSz = Int_BufSz + 1 ! BN_URelWind_s allocated yes/no - IF ( ALLOCATED(InData%BN_URelWind_s) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_URelWind_s upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_URelWind_s) ! BN_URelWind_s - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cl_Static allocated yes/no - IF ( ALLOCATED(InData%BN_Cl_Static) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cl_Static upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cl_Static) ! BN_Cl_Static - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cd_Static allocated yes/no - IF ( ALLOCATED(InData%BN_Cd_Static) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cd_Static upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cd_Static) ! BN_Cd_Static - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cm_Static allocated yes/no - IF ( ALLOCATED(InData%BN_Cm_Static) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cm_Static upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cm_Static) ! BN_Cm_Static - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cpmin allocated yes/no - IF ( ALLOCATED(InData%BN_Cpmin) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cpmin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cpmin) ! BN_Cpmin - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cl allocated yes/no - IF ( ALLOCATED(InData%BN_Cl) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cl) ! BN_Cl - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cd allocated yes/no - IF ( ALLOCATED(InData%BN_Cd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cd) ! BN_Cd - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cm allocated yes/no - IF ( ALLOCATED(InData%BN_Cm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cm) ! BN_Cm - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cx allocated yes/no - IF ( ALLOCATED(InData%BN_Cx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cx) ! BN_Cx - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cy allocated yes/no - IF ( ALLOCATED(InData%BN_Cy) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cy) ! BN_Cy - 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%LE) ) 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%LE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LE,2), UBOUND(InData%LE,2) - DO i1 = LBOUND(InData%LE,1), UBOUND(InData%LE,1) - ReKiBuf(Re_Xferred) = InData%LE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TE) ) 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%TE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TE,2), UBOUND(InData%TE,2) - DO i1 = LBOUND(InData%TE,1), UBOUND(InData%TE,1) - ReKiBuf(Re_Xferred) = InData%TE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_LL) ) 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%r_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%r_LL,3), UBOUND(InData%r_LL,3) - DO i2 = LBOUND(InData%r_LL,2), UBOUND(InData%r_LL,2) - DO i1 = LBOUND(InData%r_LL,1), UBOUND(InData%r_LL,1) - ReKiBuf(Re_Xferred) = InData%r_LL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CP) ) 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%CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CP,2), UBOUND(InData%CP,2) - DO i1 = LBOUND(InData%CP,1), UBOUND(InData%CP,1) - ReKiBuf(Re_Xferred) = InData%CP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Tang) ) 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%Tang,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tang,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Tang,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tang,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Tang,2), UBOUND(InData%Tang,2) - DO i1 = LBOUND(InData%Tang,1), UBOUND(InData%Tang,1) - ReKiBuf(Re_Xferred) = InData%Tang(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Norm) ) 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%Norm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Norm,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Norm,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Norm,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Norm,2), UBOUND(InData%Norm,2) - DO i1 = LBOUND(InData%Norm,1), UBOUND(InData%Norm,1) - ReKiBuf(Re_Xferred) = InData%Norm(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Orth) ) 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%Orth,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Orth,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Orth,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Orth,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Orth,2), UBOUND(InData%Orth,2) - DO i1 = LBOUND(InData%Orth,1), UBOUND(InData%Orth,1) - ReKiBuf(Re_Xferred) = InData%Orth(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dl) ) 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%dl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%dl,2), UBOUND(InData%dl,2) - DO i1 = LBOUND(InData%dl,1), UBOUND(InData%dl,1) - ReKiBuf(Re_Xferred) = InData%dl(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Area) ) 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%Area,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Area,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Area,1), UBOUND(InData%Area,1) - ReKiBuf(Re_Xferred) = InData%Area(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%diag_LL) ) 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%diag_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%diag_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%diag_LL,1), UBOUND(InData%diag_LL,1) - ReKiBuf(Re_Xferred) = InData%diag_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vind_CP) ) 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%Vind_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_CP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_CP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_CP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vind_CP,2), UBOUND(InData%Vind_CP,2) - DO i1 = LBOUND(InData%Vind_CP,1), UBOUND(InData%Vind_CP,1) - ReKiBuf(Re_Xferred) = InData%Vind_CP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vtot_CP) ) 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%Vtot_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vtot_CP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vtot_CP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vtot_CP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vtot_CP,2), UBOUND(InData%Vtot_CP,2) - DO i1 = LBOUND(InData%Vtot_CP,1), UBOUND(InData%Vtot_CP,1) - ReKiBuf(Re_Xferred) = InData%Vtot_CP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vstr_CP) ) 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%Vstr_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vstr_CP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vstr_CP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vstr_CP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vstr_CP,2), UBOUND(InData%Vstr_CP,2) - DO i1 = LBOUND(InData%Vstr_CP,1), UBOUND(InData%Vstr_CP,1) - ReKiBuf(Re_Xferred) = InData%Vstr_CP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vwnd_CP) ) 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%Vwnd_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_CP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_CP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_CP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vwnd_CP,2), UBOUND(InData%Vwnd_CP,2) - DO i1 = LBOUND(InData%Vwnd_CP,1), UBOUND(InData%Vwnd_CP,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_CP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vwnd_NW) ) 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%Vwnd_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vwnd_NW,3), UBOUND(InData%Vwnd_NW,3) - DO i2 = LBOUND(InData%Vwnd_NW,2), UBOUND(InData%Vwnd_NW,2) - DO i1 = LBOUND(InData%Vwnd_NW,1), UBOUND(InData%Vwnd_NW,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_NW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vwnd_FW) ) 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%Vwnd_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vwnd_FW,3), UBOUND(InData%Vwnd_FW,3) - DO i2 = LBOUND(InData%Vwnd_FW,2), UBOUND(InData%Vwnd_FW,2) - DO i1 = LBOUND(InData%Vwnd_FW,1), UBOUND(InData%Vwnd_FW,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_FW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vind_NW) ) 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%Vind_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vind_NW,3), UBOUND(InData%Vind_NW,3) - DO i2 = LBOUND(InData%Vind_NW,2), UBOUND(InData%Vind_NW,2) - DO i1 = LBOUND(InData%Vind_NW,1), UBOUND(InData%Vind_NW,1) - ReKiBuf(Re_Xferred) = InData%Vind_NW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vind_FW) ) 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%Vind_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vind_FW,3), UBOUND(InData%Vind_FW,3) - DO i2 = LBOUND(InData%Vind_FW,2), UBOUND(InData%Vind_FW,2) - DO i1 = LBOUND(InData%Vind_FW,1), UBOUND(InData%Vind_FW,1) - ReKiBuf(Re_Xferred) = InData%Vind_FW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PitchAndTwist) ) 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%PitchAndTwist,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAndTwist,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PitchAndTwist,1), UBOUND(InData%PitchAndTwist,1) - ReKiBuf(Re_Xferred) = InData%PitchAndTwist(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iTip - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iRoot - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%alpha_LL) ) 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%alpha_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%alpha_LL,1), UBOUND(InData%alpha_LL,1) - ReKiBuf(Re_Xferred) = InData%alpha_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vreln_LL) ) 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%Vreln_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vreln_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vreln_LL,1), UBOUND(InData%Vreln_LL,1) - ReKiBuf(Re_Xferred) = InData%Vreln_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_UA) ) 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%u_UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) - DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) - CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_UA - 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 DO - END IF - CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_UA, ErrStat2, ErrMsg2, OnlySize ) ! m_UA - 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 - CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, OnlySize ) ! y_UA - 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 - CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_UA, ErrStat2, ErrMsg2, OnlySize ) ! p_UA - 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 - IF ( .NOT. ALLOCATED(InData%Vind_LL) ) 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%Vind_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_LL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vind_LL,2), UBOUND(InData%Vind_LL,2) - DO i1 = LBOUND(InData%Vind_LL,1), UBOUND(InData%Vind_LL,1) - ReKiBuf(Re_Xferred) = InData%Vind_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_AxInd) ) 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%BN_AxInd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_AxInd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_AxInd,1), UBOUND(InData%BN_AxInd,1) - ReKiBuf(Re_Xferred) = InData%BN_AxInd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_TanInd) ) 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%BN_TanInd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_TanInd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_TanInd,1), UBOUND(InData%BN_TanInd,1) - ReKiBuf(Re_Xferred) = InData%BN_TanInd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Vrel) ) 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%BN_Vrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Vrel,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Vrel,1), UBOUND(InData%BN_Vrel,1) - ReKiBuf(Re_Xferred) = InData%BN_Vrel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_alpha) ) 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%BN_alpha,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_alpha,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_alpha,1), UBOUND(InData%BN_alpha,1) - ReKiBuf(Re_Xferred) = InData%BN_alpha(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_phi) ) 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%BN_phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_phi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_phi,1), UBOUND(InData%BN_phi,1) - ReKiBuf(Re_Xferred) = InData%BN_phi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Re) ) 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%BN_Re,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Re,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Re,1), UBOUND(InData%BN_Re,1) - ReKiBuf(Re_Xferred) = InData%BN_Re(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_URelWind_s) ) 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%BN_URelWind_s,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_URelWind_s,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_URelWind_s,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_URelWind_s,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BN_URelWind_s,2), UBOUND(InData%BN_URelWind_s,2) - DO i1 = LBOUND(InData%BN_URelWind_s,1), UBOUND(InData%BN_URelWind_s,1) - ReKiBuf(Re_Xferred) = InData%BN_URelWind_s(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cl_Static) ) 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%BN_Cl_Static,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl_Static,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cl_Static,1), UBOUND(InData%BN_Cl_Static,1) - ReKiBuf(Re_Xferred) = InData%BN_Cl_Static(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cd_Static) ) 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%BN_Cd_Static,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd_Static,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cd_Static,1), UBOUND(InData%BN_Cd_Static,1) - ReKiBuf(Re_Xferred) = InData%BN_Cd_Static(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cm_Static) ) 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%BN_Cm_Static,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm_Static,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cm_Static,1), UBOUND(InData%BN_Cm_Static,1) - ReKiBuf(Re_Xferred) = InData%BN_Cm_Static(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cpmin) ) 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%BN_Cpmin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cpmin,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cpmin,1), UBOUND(InData%BN_Cpmin,1) - ReKiBuf(Re_Xferred) = InData%BN_Cpmin(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cl) ) 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%BN_Cl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cl,1), UBOUND(InData%BN_Cl,1) - ReKiBuf(Re_Xferred) = InData%BN_Cl(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cd) ) 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%BN_Cd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cd,1), UBOUND(InData%BN_Cd,1) - ReKiBuf(Re_Xferred) = InData%BN_Cd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cm) ) 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%BN_Cm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cm,1), UBOUND(InData%BN_Cm,1) - ReKiBuf(Re_Xferred) = InData%BN_Cm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cx) ) 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%BN_Cx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cx,1), UBOUND(InData%BN_Cx,1) - ReKiBuf(Re_Xferred) = InData%BN_Cx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cy) ) 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%BN_Cy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cy,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cy,1), UBOUND(InData%BN_Cy,1) - ReKiBuf(Re_Xferred) = InData%BN_Cy(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_PackWng_MiscVarType - - SUBROUTINE FVW_UnPackWng_MiscVarType( 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(Wng_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) :: 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 = 'FVW_UnPackWng_MiscVarType' - ! 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 ! LE 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%LE)) DEALLOCATE(OutData%LE) - ALLOCATE(OutData%LE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LE,2), UBOUND(OutData%LE,2) - DO i1 = LBOUND(OutData%LE,1), UBOUND(OutData%LE,1) - OutData%LE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TE 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%TE)) DEALLOCATE(OutData%TE) - ALLOCATE(OutData%TE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TE,2), UBOUND(OutData%TE,2) - DO i1 = LBOUND(OutData%TE,1), UBOUND(OutData%TE,1) - OutData%TE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_LL 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%r_LL)) DEALLOCATE(OutData%r_LL) - ALLOCATE(OutData%r_LL(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%r_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%r_LL,3), UBOUND(OutData%r_LL,3) - DO i2 = LBOUND(OutData%r_LL,2), UBOUND(OutData%r_LL,2) - DO i1 = LBOUND(OutData%r_LL,1), UBOUND(OutData%r_LL,1) - OutData%r_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CP 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%CP)) DEALLOCATE(OutData%CP) - ALLOCATE(OutData%CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CP,2), UBOUND(OutData%CP,2) - DO i1 = LBOUND(OutData%CP,1), UBOUND(OutData%CP,1) - OutData%CP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Tang 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%Tang)) DEALLOCATE(OutData%Tang) - ALLOCATE(OutData%Tang(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tang.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Tang,2), UBOUND(OutData%Tang,2) - DO i1 = LBOUND(OutData%Tang,1), UBOUND(OutData%Tang,1) - OutData%Tang(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Norm 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%Norm)) DEALLOCATE(OutData%Norm) - ALLOCATE(OutData%Norm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Norm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Norm,2), UBOUND(OutData%Norm,2) - DO i1 = LBOUND(OutData%Norm,1), UBOUND(OutData%Norm,1) - OutData%Norm(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Orth 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%Orth)) DEALLOCATE(OutData%Orth) - ALLOCATE(OutData%Orth(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Orth.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Orth,2), UBOUND(OutData%Orth,2) - DO i1 = LBOUND(OutData%Orth,1), UBOUND(OutData%Orth,1) - OutData%Orth(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dl 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%dl)) DEALLOCATE(OutData%dl) - ALLOCATE(OutData%dl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%dl,2), UBOUND(OutData%dl,2) - DO i1 = LBOUND(OutData%dl,1), UBOUND(OutData%dl,1) - OutData%dl(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Area 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%Area)) DEALLOCATE(OutData%Area) - ALLOCATE(OutData%Area(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Area.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Area,1), UBOUND(OutData%Area,1) - OutData%Area(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! diag_LL 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%diag_LL)) DEALLOCATE(OutData%diag_LL) - ALLOCATE(OutData%diag_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%diag_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%diag_LL,1), UBOUND(OutData%diag_LL,1) - OutData%diag_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_CP 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%Vind_CP)) DEALLOCATE(OutData%Vind_CP) - ALLOCATE(OutData%Vind_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vind_CP,2), UBOUND(OutData%Vind_CP,2) - DO i1 = LBOUND(OutData%Vind_CP,1), UBOUND(OutData%Vind_CP,1) - OutData%Vind_CP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vtot_CP 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%Vtot_CP)) DEALLOCATE(OutData%Vtot_CP) - ALLOCATE(OutData%Vtot_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vtot_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vtot_CP,2), UBOUND(OutData%Vtot_CP,2) - DO i1 = LBOUND(OutData%Vtot_CP,1), UBOUND(OutData%Vtot_CP,1) - OutData%Vtot_CP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vstr_CP 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%Vstr_CP)) DEALLOCATE(OutData%Vstr_CP) - ALLOCATE(OutData%Vstr_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vstr_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vstr_CP,2), UBOUND(OutData%Vstr_CP,2) - DO i1 = LBOUND(OutData%Vstr_CP,1), UBOUND(OutData%Vstr_CP,1) - OutData%Vstr_CP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_CP 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%Vwnd_CP)) DEALLOCATE(OutData%Vwnd_CP) - ALLOCATE(OutData%Vwnd_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vwnd_CP,2), UBOUND(OutData%Vwnd_CP,2) - DO i1 = LBOUND(OutData%Vwnd_CP,1), UBOUND(OutData%Vwnd_CP,1) - OutData%Vwnd_CP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_NW 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%Vwnd_NW)) DEALLOCATE(OutData%Vwnd_NW) - ALLOCATE(OutData%Vwnd_NW(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%Vwnd_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vwnd_NW,3), UBOUND(OutData%Vwnd_NW,3) - DO i2 = LBOUND(OutData%Vwnd_NW,2), UBOUND(OutData%Vwnd_NW,2) - DO i1 = LBOUND(OutData%Vwnd_NW,1), UBOUND(OutData%Vwnd_NW,1) - OutData%Vwnd_NW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_FW 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%Vwnd_FW)) DEALLOCATE(OutData%Vwnd_FW) - ALLOCATE(OutData%Vwnd_FW(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%Vwnd_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vwnd_FW,3), UBOUND(OutData%Vwnd_FW,3) - DO i2 = LBOUND(OutData%Vwnd_FW,2), UBOUND(OutData%Vwnd_FW,2) - DO i1 = LBOUND(OutData%Vwnd_FW,1), UBOUND(OutData%Vwnd_FW,1) - OutData%Vwnd_FW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_NW 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%Vind_NW)) DEALLOCATE(OutData%Vind_NW) - ALLOCATE(OutData%Vind_NW(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%Vind_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vind_NW,3), UBOUND(OutData%Vind_NW,3) - DO i2 = LBOUND(OutData%Vind_NW,2), UBOUND(OutData%Vind_NW,2) - DO i1 = LBOUND(OutData%Vind_NW,1), UBOUND(OutData%Vind_NW,1) - OutData%Vind_NW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_FW 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%Vind_FW)) DEALLOCATE(OutData%Vind_FW) - ALLOCATE(OutData%Vind_FW(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%Vind_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vind_FW,3), UBOUND(OutData%Vind_FW,3) - DO i2 = LBOUND(OutData%Vind_FW,2), UBOUND(OutData%Vind_FW,2) - DO i1 = LBOUND(OutData%Vind_FW,1), UBOUND(OutData%Vind_FW,1) - OutData%Vind_FW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAndTwist 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%PitchAndTwist)) DEALLOCATE(OutData%PitchAndTwist) - ALLOCATE(OutData%PitchAndTwist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAndTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PitchAndTwist,1), UBOUND(OutData%PitchAndTwist,1) - OutData%PitchAndTwist(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%iTip = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iRoot = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_LL 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%alpha_LL)) DEALLOCATE(OutData%alpha_LL) - ALLOCATE(OutData%alpha_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%alpha_LL,1), UBOUND(OutData%alpha_LL,1) - OutData%alpha_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vreln_LL 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%Vreln_LL)) DEALLOCATE(OutData%Vreln_LL) - ALLOCATE(OutData%Vreln_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vreln_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vreln_LL,1), UBOUND(OutData%Vreln_LL,1) - OutData%Vreln_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_UA 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%u_UA)) DEALLOCATE(OutData%u_UA) - ALLOCATE(OutData%u_UA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_UA,2), UBOUND(OutData%u_UA,2) - DO i1 = LBOUND(OutData%u_UA,1), UBOUND(OutData%u_UA,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 UA_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_UA(i1,i2), ErrStat2, ErrMsg2 ) ! u_UA - 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 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 UA_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m_UA, ErrStat2, ErrMsg2 ) ! m_UA - 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) - 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 UA_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_UA, ErrStat2, ErrMsg2 ) ! y_UA - 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) - 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 UA_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p_UA, ErrStat2, ErrMsg2 ) ! p_UA - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_LL 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%Vind_LL)) DEALLOCATE(OutData%Vind_LL) - ALLOCATE(OutData%Vind_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vind_LL,2), UBOUND(OutData%Vind_LL,2) - DO i1 = LBOUND(OutData%Vind_LL,1), UBOUND(OutData%Vind_LL,1) - OutData%Vind_LL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_AxInd 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%BN_AxInd)) DEALLOCATE(OutData%BN_AxInd) - ALLOCATE(OutData%BN_AxInd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_AxInd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_AxInd,1), UBOUND(OutData%BN_AxInd,1) - OutData%BN_AxInd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_TanInd 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%BN_TanInd)) DEALLOCATE(OutData%BN_TanInd) - ALLOCATE(OutData%BN_TanInd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_TanInd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_TanInd,1), UBOUND(OutData%BN_TanInd,1) - OutData%BN_TanInd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Vrel 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%BN_Vrel)) DEALLOCATE(OutData%BN_Vrel) - ALLOCATE(OutData%BN_Vrel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Vrel,1), UBOUND(OutData%BN_Vrel,1) - OutData%BN_Vrel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_alpha 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%BN_alpha)) DEALLOCATE(OutData%BN_alpha) - ALLOCATE(OutData%BN_alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_alpha,1), UBOUND(OutData%BN_alpha,1) - OutData%BN_alpha(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_phi 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%BN_phi)) DEALLOCATE(OutData%BN_phi) - ALLOCATE(OutData%BN_phi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_phi,1), UBOUND(OutData%BN_phi,1) - OutData%BN_phi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Re 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%BN_Re)) DEALLOCATE(OutData%BN_Re) - ALLOCATE(OutData%BN_Re(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Re.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Re,1), UBOUND(OutData%BN_Re,1) - OutData%BN_Re(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_URelWind_s 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%BN_URelWind_s)) DEALLOCATE(OutData%BN_URelWind_s) - ALLOCATE(OutData%BN_URelWind_s(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_URelWind_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BN_URelWind_s,2), UBOUND(OutData%BN_URelWind_s,2) - DO i1 = LBOUND(OutData%BN_URelWind_s,1), UBOUND(OutData%BN_URelWind_s,1) - OutData%BN_URelWind_s(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cl_Static 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%BN_Cl_Static)) DEALLOCATE(OutData%BN_Cl_Static) - ALLOCATE(OutData%BN_Cl_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cl_Static,1), UBOUND(OutData%BN_Cl_Static,1) - OutData%BN_Cl_Static(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cd_Static 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%BN_Cd_Static)) DEALLOCATE(OutData%BN_Cd_Static) - ALLOCATE(OutData%BN_Cd_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cd_Static,1), UBOUND(OutData%BN_Cd_Static,1) - OutData%BN_Cd_Static(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cm_Static 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%BN_Cm_Static)) DEALLOCATE(OutData%BN_Cm_Static) - ALLOCATE(OutData%BN_Cm_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cm_Static,1), UBOUND(OutData%BN_Cm_Static,1) - OutData%BN_Cm_Static(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cpmin 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%BN_Cpmin)) DEALLOCATE(OutData%BN_Cpmin) - ALLOCATE(OutData%BN_Cpmin(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cpmin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cpmin,1), UBOUND(OutData%BN_Cpmin,1) - OutData%BN_Cpmin(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cl 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%BN_Cl)) DEALLOCATE(OutData%BN_Cl) - ALLOCATE(OutData%BN_Cl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cl,1), UBOUND(OutData%BN_Cl,1) - OutData%BN_Cl(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cd 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%BN_Cd)) DEALLOCATE(OutData%BN_Cd) - ALLOCATE(OutData%BN_Cd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cd,1), UBOUND(OutData%BN_Cd,1) - OutData%BN_Cd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cm 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%BN_Cm)) DEALLOCATE(OutData%BN_Cm) - ALLOCATE(OutData%BN_Cm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cm,1), UBOUND(OutData%BN_Cm,1) - OutData%BN_Cm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cx 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%BN_Cx)) DEALLOCATE(OutData%BN_Cx) - ALLOCATE(OutData%BN_Cx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cx,1), UBOUND(OutData%BN_Cx,1) - OutData%BN_Cx(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cy 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%BN_Cy)) DEALLOCATE(OutData%BN_Cy) - ALLOCATE(OutData%BN_Cy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cy,1), UBOUND(OutData%BN_Cy,1) - OutData%BN_Cy(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_UnPackWng_MiscVarType - - SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(FVW_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) :: 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 = 'FVW_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%W)) THEN - i1_l = LBOUND(SrcMiscData%W,1) - i1_u = UBOUND(SrcMiscData%W,1) - IF (.NOT. ALLOCATED(DstMiscData%W)) THEN - ALLOCATE(DstMiscData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%W,1), UBOUND(SrcMiscData%W,1) - CALL FVW_Copywng_miscvartype( SrcMiscData%W(i1), DstMiscData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstMiscData%FirstCall = SrcMiscData%FirstCall - DstMiscData%nNW = SrcMiscData%nNW - DstMiscData%nFW = SrcMiscData%nFW - DstMiscData%iStep = SrcMiscData%iStep - DstMiscData%VTKstep = SrcMiscData%VTKstep - DstMiscData%VTKlastTime = SrcMiscData%VTKlastTime -IF (ALLOCATED(SrcMiscData%r_wind)) THEN - i1_l = LBOUND(SrcMiscData%r_wind,1) - i1_u = UBOUND(SrcMiscData%r_wind,1) - i2_l = LBOUND(SrcMiscData%r_wind,2) - i2_u = UBOUND(SrcMiscData%r_wind,2) - IF (.NOT. ALLOCATED(DstMiscData%r_wind)) THEN - ALLOCATE(DstMiscData%r_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_wind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%r_wind = SrcMiscData%r_wind -ENDIF - DstMiscData%ComputeWakeInduced = SrcMiscData%ComputeWakeInduced - DstMiscData%OldWakeTime = SrcMiscData%OldWakeTime - CALL FVW_CopyContState( SrcMiscData%dxdt, DstMiscData%dxdt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FVW_CopyContState( SrcMiscData%x1, DstMiscData%x1, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FVW_CopyContState( SrcMiscData%x2, DstMiscData%x2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%t1 = SrcMiscData%t1 - DstMiscData%t2 = SrcMiscData%t2 - DstMiscData%UA_Flag = SrcMiscData%UA_Flag - CALL FVW_Copyt_sgmt( SrcMiscData%Sgmt, DstMiscData%Sgmt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FVW_Copyt_part( SrcMiscData%Part, DstMiscData%Part, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%CPs)) THEN - i1_l = LBOUND(SrcMiscData%CPs,1) - i1_u = UBOUND(SrcMiscData%CPs,1) - i2_l = LBOUND(SrcMiscData%CPs,2) - i2_u = UBOUND(SrcMiscData%CPs,2) - IF (.NOT. ALLOCATED(DstMiscData%CPs)) THEN - ALLOCATE(DstMiscData%CPs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CPs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CPs = SrcMiscData%CPs -ENDIF -IF (ALLOCATED(SrcMiscData%Uind)) THEN - i1_l = LBOUND(SrcMiscData%Uind,1) - i1_u = UBOUND(SrcMiscData%Uind,1) - i2_l = LBOUND(SrcMiscData%Uind,2) - i2_u = UBOUND(SrcMiscData%Uind,2) - IF (.NOT. ALLOCATED(DstMiscData%Uind)) THEN - ALLOCATE(DstMiscData%Uind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Uind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Uind = SrcMiscData%Uind -ENDIF -IF (ALLOCATED(SrcMiscData%GridOutputs)) THEN - i1_l = LBOUND(SrcMiscData%GridOutputs,1) - i1_u = UBOUND(SrcMiscData%GridOutputs,1) - IF (.NOT. ALLOCATED(DstMiscData%GridOutputs)) THEN - ALLOCATE(DstMiscData%GridOutputs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GridOutputs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%GridOutputs,1), UBOUND(SrcMiscData%GridOutputs,1) - CALL FVW_Copygridouttype( SrcMiscData%GridOutputs(i1), DstMiscData%GridOutputs(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FVW_CopyMisc - - SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(FVW_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 = 'FVW_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%W)) THEN -DO i1 = LBOUND(MiscData%W,1), UBOUND(MiscData%W,1) - CALL FVW_DestroyWng_MiscVarType( MiscData%W(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%W) -ENDIF -IF (ALLOCATED(MiscData%r_wind)) THEN - DEALLOCATE(MiscData%r_wind) -ENDIF - CALL FVW_DestroyContState( MiscData%dxdt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyContState( MiscData%x1, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyContState( MiscData%x2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyT_Sgmt( MiscData%Sgmt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyT_Part( MiscData%Part, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%CPs)) THEN - DEALLOCATE(MiscData%CPs) -ENDIF -IF (ALLOCATED(MiscData%Uind)) THEN - DEALLOCATE(MiscData%Uind) -ENDIF -IF (ALLOCATED(MiscData%GridOutputs)) THEN -DO i1 = LBOUND(MiscData%GridOutputs,1), UBOUND(MiscData%GridOutputs,1) - CALL FVW_DestroyGridOutType( MiscData%GridOutputs(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%GridOutputs) -ENDIF - END SUBROUTINE FVW_DestroyMisc - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FirstCall - Int_BufSz = Int_BufSz + 1 ! nNW - Int_BufSz = Int_BufSz + 1 ! nFW - Int_BufSz = Int_BufSz + 1 ! iStep - Int_BufSz = Int_BufSz + 1 ! VTKstep - Db_BufSz = Db_BufSz + 1 ! VTKlastTime - Int_BufSz = Int_BufSz + 1 ! r_wind allocated yes/no - IF ( ALLOCATED(InData%r_wind) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r_wind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_wind) ! r_wind - END IF - Int_BufSz = Int_BufSz + 1 ! ComputeWakeInduced - Db_BufSz = Db_BufSz + 1 ! OldWakeTime - Int_BufSz = Int_BufSz + 3 ! dxdt: size of buffers for each call to pack subtype - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%dxdt, ErrStat2, ErrMsg2, .TRUE. ) ! dxdt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! dxdt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! dxdt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! dxdt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! x1: size of buffers for each call to pack subtype - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x1, ErrStat2, ErrMsg2, .TRUE. ) ! x1 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x1 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x1 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x1 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! x2: size of buffers for each call to pack subtype - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x2, ErrStat2, ErrMsg2, .TRUE. ) ! x2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + 1 ! t1 - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Sgmt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Sgmt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Sgmt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Part - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Part - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Part - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CPs allocated yes/no - IF ( ALLOCATED(InData%CPs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CPs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CPs) ! CPs - END IF - Int_BufSz = Int_BufSz + 1 ! Uind allocated yes/no - IF ( ALLOCATED(InData%Uind) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Uind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Uind) ! Uind - END IF - Int_BufSz = Int_BufSz + 1 ! GridOutputs allocated yes/no - IF ( ALLOCATED(InData%GridOutputs) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! GridOutputs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! GridOutputs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! GridOutputs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%W) ) 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%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - 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 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) = TRANSFER(InData%FirstCall, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNW - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFW - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iStep - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKstep - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%VTKlastTime - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%r_wind) ) 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%r_wind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_wind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_wind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_wind,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r_wind,2), UBOUND(InData%r_wind,2) - DO i1 = LBOUND(InData%r_wind,1), UBOUND(InData%r_wind,1) - ReKiBuf(Re_Xferred) = InData%r_wind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%ComputeWakeInduced, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%OldWakeTime - Db_Xferred = Db_Xferred + 1 - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%dxdt, ErrStat2, ErrMsg2, OnlySize ) ! dxdt - 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 - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x1, ErrStat2, ErrMsg2, OnlySize ) ! x1 - 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 - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x2, ErrStat2, ErrMsg2, OnlySize ) ! x2 - 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 - DbKiBuf(Db_Xferred) = InData%t1 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%t2 - 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 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%CPs) ) 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%CPs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CPs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CPs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CPs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CPs,2), UBOUND(InData%CPs,2) - DO i1 = LBOUND(InData%CPs,1), UBOUND(InData%CPs,1) - ReKiBuf(Re_Xferred) = InData%CPs(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Uind) ) 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%Uind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Uind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Uind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Uind,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Uind,2), UBOUND(InData%Uind,2) - DO i1 = LBOUND(InData%Uind,1), UBOUND(InData%Uind,1) - ReKiBuf(Re_Xferred) = InData%Uind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GridOutputs) ) 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%GridOutputs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GridOutputs,1) - 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 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 - END SUBROUTINE FVW_PackMisc - - SUBROUTINE FVW_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(FVW_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) :: 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 = 'FVW_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W 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%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,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 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 - - 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%FirstCall = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstCall) - Int_Xferred = Int_Xferred + 1 - OutData%nNW = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFW = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iStep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKstep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKlastTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_wind 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%r_wind)) DEALLOCATE(OutData%r_wind) - ALLOCATE(OutData%r_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_wind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r_wind,2), UBOUND(OutData%r_wind,2) - DO i1 = LBOUND(OutData%r_wind,1), UBOUND(OutData%r_wind,1) - OutData%r_wind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%ComputeWakeInduced = TRANSFER(IntKiBuf(Int_Xferred), OutData%ComputeWakeInduced) - Int_Xferred = Int_Xferred + 1 - OutData%OldWakeTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_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 FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%dxdt, ErrStat2, ErrMsg2 ) ! dxdt - 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) - 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 FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x1, ErrStat2, ErrMsg2 ) ! x1 - 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) - 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 FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x2, ErrStat2, ErrMsg2 ) ! x2 - 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%t1 = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%t2 = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) - 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 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 - - 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 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 - - 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 ! CPs 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%CPs)) DEALLOCATE(OutData%CPs) - ALLOCATE(OutData%CPs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CPs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CPs,2), UBOUND(OutData%CPs,2) - DO i1 = LBOUND(OutData%CPs,1), UBOUND(OutData%CPs,1) - OutData%CPs(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Uind 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%Uind)) DEALLOCATE(OutData%Uind) - ALLOCATE(OutData%Uind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Uind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Uind,2), UBOUND(OutData%Uind,2) - DO i1 = LBOUND(OutData%Uind,1), UBOUND(OutData%Uind,1) - OutData%Uind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GridOutputs 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%GridOutputs)) DEALLOCATE(OutData%GridOutputs) - ALLOCATE(OutData%GridOutputs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GridOutputs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GridOutputs,1), UBOUND(OutData%GridOutputs,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 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 - - 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 - END SUBROUTINE FVW_UnPackMisc - - SUBROUTINE FVW_CopyRot_InputType( SrcRot_InputTypeData, DstRot_InputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Rot_InputType), INTENT(IN) :: SrcRot_InputTypeData - TYPE(Rot_InputType), INTENT(INOUT) :: DstRot_InputTypeData - 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 = 'FVW_CopyRot_InputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRot_InputTypeData%HubOrientation = SrcRot_InputTypeData%HubOrientation - DstRot_InputTypeData%HubPosition = SrcRot_InputTypeData%HubPosition - END SUBROUTINE FVW_CopyRot_InputType - - SUBROUTINE FVW_DestroyRot_InputType( Rot_InputTypeData, ErrStat, ErrMsg ) - TYPE(Rot_InputType), INTENT(INOUT) :: Rot_InputTypeData - 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 = 'FVW_DestroyRot_InputType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE FVW_DestroyRot_InputType - - SUBROUTINE FVW_PackRot_InputType( 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(Rot_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 = 'FVW_PackRot_InputType' - ! 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 + SIZE(InData%HubOrientation) ! HubOrientation - Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition - 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 i2 = LBOUND(InData%HubOrientation,2), UBOUND(InData%HubOrientation,2) - DO i1 = LBOUND(InData%HubOrientation,1), UBOUND(InData%HubOrientation,1) - ReKiBuf(Re_Xferred) = InData%HubOrientation(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) - ReKiBuf(Re_Xferred) = InData%HubPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FVW_PackRot_InputType - - SUBROUTINE FVW_UnPackRot_InputType( 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(Rot_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) :: 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 = 'FVW_UnPackRot_InputType' - ! 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 - i1_l = LBOUND(OutData%HubOrientation,1) - i1_u = UBOUND(OutData%HubOrientation,1) - i2_l = LBOUND(OutData%HubOrientation,2) - i2_u = UBOUND(OutData%HubOrientation,2) - DO i2 = LBOUND(OutData%HubOrientation,2), UBOUND(OutData%HubOrientation,2) - DO i1 = LBOUND(OutData%HubOrientation,1), UBOUND(OutData%HubOrientation,1) - OutData%HubOrientation(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%HubPosition,1) - i1_u = UBOUND(OutData%HubPosition,1) - DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) - OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FVW_UnPackRot_InputType - - SUBROUTINE FVW_CopyWng_InputType( SrcWng_InputTypeData, DstWng_InputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_InputType), INTENT(IN) :: SrcWng_InputTypeData - TYPE(Wng_InputType), INTENT(INOUT) :: DstWng_InputTypeData - 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 = 'FVW_CopyWng_InputType' -! +subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, ErrStat, ErrMsg) + type(GridOutType), intent(in) :: SrcGridOutTypeData + type(GridOutType), intent(inout) :: DstGridOutTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyGridOutType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_InputTypeData%Vwnd_LL)) THEN - i1_l = LBOUND(SrcWng_InputTypeData%Vwnd_LL,1) - i1_u = UBOUND(SrcWng_InputTypeData%Vwnd_LL,1) - i2_l = LBOUND(SrcWng_InputTypeData%Vwnd_LL,2) - i2_u = UBOUND(SrcWng_InputTypeData%Vwnd_LL,2) - IF (.NOT. ALLOCATED(DstWng_InputTypeData%Vwnd_LL)) THEN - ALLOCATE(DstWng_InputTypeData%Vwnd_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InputTypeData%Vwnd_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_InputTypeData%Vwnd_LL = SrcWng_InputTypeData%Vwnd_LL -ENDIF -IF (ALLOCATED(SrcWng_InputTypeData%omega_z)) THEN - i1_l = LBOUND(SrcWng_InputTypeData%omega_z,1) - i1_u = UBOUND(SrcWng_InputTypeData%omega_z,1) - IF (.NOT. ALLOCATED(DstWng_InputTypeData%omega_z)) THEN - ALLOCATE(DstWng_InputTypeData%omega_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InputTypeData%omega_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_InputTypeData%omega_z = SrcWng_InputTypeData%omega_z -ENDIF - END SUBROUTINE FVW_CopyWng_InputType - - SUBROUTINE FVW_DestroyWng_InputType( Wng_InputTypeData, ErrStat, ErrMsg ) - TYPE(Wng_InputType), INTENT(INOUT) :: Wng_InputTypeData - 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 = 'FVW_DestroyWng_InputType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Wng_InputTypeData%Vwnd_LL)) THEN - DEALLOCATE(Wng_InputTypeData%Vwnd_LL) -ENDIF -IF (ALLOCATED(Wng_InputTypeData%omega_z)) THEN - DEALLOCATE(Wng_InputTypeData%omega_z) -ENDIF - END SUBROUTINE FVW_DestroyWng_InputType - - SUBROUTINE FVW_PackWng_InputType( 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(Wng_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 = 'FVW_PackWng_InputType' - ! 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 ! Vwnd_LL allocated yes/no - IF ( ALLOCATED(InData%Vwnd_LL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vwnd_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_LL) ! Vwnd_LL - END IF - Int_BufSz = Int_BufSz + 1 ! omega_z allocated yes/no - IF ( ALLOCATED(InData%omega_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! omega_z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%omega_z) ! omega_z - 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%Vwnd_LL) ) 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%Vwnd_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vwnd_LL,2), UBOUND(InData%Vwnd_LL,2) - DO i1 = LBOUND(InData%Vwnd_LL,1), UBOUND(InData%Vwnd_LL,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%omega_z) ) 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%omega_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%omega_z,1), UBOUND(InData%omega_z,1) - ReKiBuf(Re_Xferred) = InData%omega_z(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_PackWng_InputType - - SUBROUTINE FVW_UnPackWng_InputType( 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(Wng_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) :: 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 = 'FVW_UnPackWng_InputType' - ! 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 ! Vwnd_LL 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%Vwnd_LL)) DEALLOCATE(OutData%Vwnd_LL) - ALLOCATE(OutData%Vwnd_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vwnd_LL,2), UBOUND(OutData%Vwnd_LL,2) - DO i1 = LBOUND(OutData%Vwnd_LL,1), UBOUND(OutData%Vwnd_LL,1) - OutData%Vwnd_LL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omega_z 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%omega_z)) DEALLOCATE(OutData%omega_z) - ALLOCATE(OutData%omega_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%omega_z,1), UBOUND(OutData%omega_z,1) - OutData%omega_z(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_UnPackWng_InputType - - SUBROUTINE FVW_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_InputType), INTENT(INOUT) :: SrcInputData - TYPE(FVW_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) :: 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 = 'FVW_CopyInput' -! + ErrMsg = '' + DstGridOutTypeData%name = SrcGridOutTypeData%name + DstGridOutTypeData%type = SrcGridOutTypeData%type + DstGridOutTypeData%tStart = SrcGridOutTypeData%tStart + DstGridOutTypeData%tEnd = SrcGridOutTypeData%tEnd + DstGridOutTypeData%DTout = SrcGridOutTypeData%DTout + DstGridOutTypeData%xStart = SrcGridOutTypeData%xStart + DstGridOutTypeData%yStart = SrcGridOutTypeData%yStart + DstGridOutTypeData%zStart = SrcGridOutTypeData%zStart + DstGridOutTypeData%xEnd = SrcGridOutTypeData%xEnd + DstGridOutTypeData%yEnd = SrcGridOutTypeData%yEnd + DstGridOutTypeData%zEnd = SrcGridOutTypeData%zEnd + DstGridOutTypeData%nx = SrcGridOutTypeData%nx + DstGridOutTypeData%ny = SrcGridOutTypeData%ny + DstGridOutTypeData%nz = SrcGridOutTypeData%nz + if (allocated(SrcGridOutTypeData%uGrid)) then + LB(1:4) = lbound(SrcGridOutTypeData%uGrid) + UB(1:4) = ubound(SrcGridOutTypeData%uGrid) + if (.not. allocated(DstGridOutTypeData%uGrid)) then + allocate(DstGridOutTypeData%uGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGridOutTypeData%uGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGridOutTypeData%uGrid = SrcGridOutTypeData%uGrid + end if + if (allocated(SrcGridOutTypeData%omGrid)) then + LB(1:4) = lbound(SrcGridOutTypeData%omGrid) + UB(1:4) = ubound(SrcGridOutTypeData%omGrid) + if (.not. allocated(DstGridOutTypeData%omGrid)) then + allocate(DstGridOutTypeData%omGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGridOutTypeData%omGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGridOutTypeData%omGrid = SrcGridOutTypeData%omGrid + end if + DstGridOutTypeData%tLastOutput = SrcGridOutTypeData%tLastOutput +end subroutine + +subroutine FVW_DestroyGridOutType(GridOutTypeData, ErrStat, ErrMsg) + type(GridOutType), intent(inout) :: GridOutTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyGridOutType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%rotors)) THEN - i1_l = LBOUND(SrcInputData%rotors,1) - i1_u = UBOUND(SrcInputData%rotors,1) - IF (.NOT. ALLOCATED(DstInputData%rotors)) THEN - ALLOCATE(DstInputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%rotors,1), UBOUND(SrcInputData%rotors,1) - CALL FVW_Copyrot_inputtype( SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%W)) THEN - i1_l = LBOUND(SrcInputData%W,1) - i1_u = UBOUND(SrcInputData%W,1) - IF (.NOT. ALLOCATED(DstInputData%W)) THEN - ALLOCATE(DstInputData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%W,1), UBOUND(SrcInputData%W,1) - CALL FVW_Copywng_inputtype( SrcInputData%W(i1), DstInputData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%WingsMesh)) THEN - i1_l = LBOUND(SrcInputData%WingsMesh,1) - i1_u = UBOUND(SrcInputData%WingsMesh,1) - IF (.NOT. ALLOCATED(DstInputData%WingsMesh)) THEN - ALLOCATE(DstInputData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%WingsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%WingsMesh,1), UBOUND(SrcInputData%WingsMesh,1) - CALL MeshCopy( SrcInputData%WingsMesh(i1), DstInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%V_wind)) THEN - i1_l = LBOUND(SrcInputData%V_wind,1) - i1_u = UBOUND(SrcInputData%V_wind,1) - i2_l = LBOUND(SrcInputData%V_wind,2) - i2_u = UBOUND(SrcInputData%V_wind,2) - IF (.NOT. ALLOCATED(DstInputData%V_wind)) THEN - ALLOCATE(DstInputData%V_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%V_wind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%V_wind = SrcInputData%V_wind -ENDIF - END SUBROUTINE FVW_CopyInput - - SUBROUTINE FVW_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(FVW_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 = 'FVW_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%rotors)) THEN -DO i1 = LBOUND(InputData%rotors,1), UBOUND(InputData%rotors,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%W) -ENDIF -IF (ALLOCATED(InputData%WingsMesh)) THEN -DO i1 = LBOUND(InputData%WingsMesh,1), UBOUND(InputData%WingsMesh,1) - CALL MeshDestroy( InputData%WingsMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%WingsMesh) -ENDIF -IF (ALLOCATED(InputData%V_wind)) THEN - DEALLOCATE(InputData%V_wind) -ENDIF - END SUBROUTINE FVW_DestroyInput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WingsMesh allocated yes/no - IF ( ALLOCATED(InData%WingsMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WingsMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) - Int_BufSz = Int_BufSz + 3 ! WingsMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WingsMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WingsMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WingsMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WingsMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! V_wind allocated yes/no - IF ( ALLOCATED(InData%V_wind) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! V_wind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_wind) ! V_wind - 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%rotors) ) 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%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%W) ) 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%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%WingsMesh) ) 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%WingsMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WingsMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) - CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WingsMesh - 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 - IF ( .NOT. ALLOCATED(InData%V_wind) ) 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%V_wind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_wind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_wind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_wind,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%V_wind,2), UBOUND(InData%V_wind,2) - DO i1 = LBOUND(InData%V_wind,1), UBOUND(InData%V_wind,1) - ReKiBuf(Re_Xferred) = InData%V_wind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FVW_PackInput - - SUBROUTINE FVW_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(FVW_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) :: 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 = 'FVW_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors 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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 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 - - 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 ! W 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%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,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 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 - - 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 ! WingsMesh 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%WingsMesh)) DEALLOCATE(OutData%WingsMesh) - ALLOCATE(OutData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WingsMesh,1), UBOUND(OutData%WingsMesh,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 MeshUnpack( OutData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WingsMesh - 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 ! V_wind 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%V_wind)) DEALLOCATE(OutData%V_wind) - ALLOCATE(OutData%V_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_wind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%V_wind,2), UBOUND(OutData%V_wind,2) - DO i1 = LBOUND(OutData%V_wind,1), UBOUND(OutData%V_wind,1) - OutData%V_wind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FVW_UnPackInput - - SUBROUTINE FVW_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(FVW_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyDiscState' -! + ErrMsg = '' + if (allocated(GridOutTypeData%uGrid)) then + deallocate(GridOutTypeData%uGrid) + end if + if (allocated(GridOutTypeData%omGrid)) then + deallocate(GridOutTypeData%omGrid) + end if +end subroutine + +subroutine FVW_PackGridOutType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(GridOutType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackGridOutType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%name) + call RegPack(Buf, InData%type) + call RegPack(Buf, InData%tStart) + call RegPack(Buf, InData%tEnd) + call RegPack(Buf, InData%DTout) + call RegPack(Buf, InData%xStart) + call RegPack(Buf, InData%yStart) + call RegPack(Buf, InData%zStart) + call RegPack(Buf, InData%xEnd) + call RegPack(Buf, InData%yEnd) + call RegPack(Buf, InData%zEnd) + call RegPack(Buf, InData%nx) + call RegPack(Buf, InData%ny) + call RegPack(Buf, InData%nz) + call RegPack(Buf, allocated(InData%uGrid)) + if (allocated(InData%uGrid)) then + call RegPackBounds(Buf, 4, lbound(InData%uGrid), ubound(InData%uGrid)) + call RegPack(Buf, InData%uGrid) + end if + call RegPack(Buf, allocated(InData%omGrid)) + if (allocated(InData%omGrid)) then + call RegPackBounds(Buf, 4, lbound(InData%omGrid), ubound(InData%omGrid)) + call RegPack(Buf, InData%omGrid) + end if + call RegPack(Buf, InData%tLastOutput) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackGridOutType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(GridOutType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackGridOutType' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%name) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%type) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tStart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tEnd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DTout) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%xStart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%yStart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%zStart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%xEnd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%yEnd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%zEnd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ny) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nz) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%uGrid)) deallocate(OutData%uGrid) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uGrid.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uGrid) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%omGrid)) deallocate(OutData%omGrid) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%omGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%omGrid.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%omGrid) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%tLastOutput) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMsg) + type(T_Sgmt), intent(in) :: SrcT_SgmtData + type(T_Sgmt), intent(inout) :: DstT_SgmtData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyT_Sgmt' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%Dummy = SrcDiscStateData%Dummy -IF (ALLOCATED(SrcDiscStateData%UA)) THEN - i1_l = LBOUND(SrcDiscStateData%UA,1) - i1_u = UBOUND(SrcDiscStateData%UA,1) - IF (.NOT. ALLOCATED(DstDiscStateData%UA)) THEN - ALLOCATE(DstDiscStateData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%UA,1), UBOUND(SrcDiscStateData%UA,1) - CALL UA_CopyDiscState( SrcDiscStateData%UA(i1), DstDiscStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FVW_CopyDiscState - - SUBROUTINE FVW_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(FVW_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 = 'FVW_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%UA)) THEN -DO i1 = LBOUND(DiscStateData%UA,1), UBOUND(DiscStateData%UA,1) - CALL UA_DestroyDiscState( DiscStateData%UA(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%UA) -ENDIF - END SUBROUTINE FVW_DestroyDiscState - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! Dummy - Int_BufSz = Int_BufSz + 1 ! UA allocated yes/no - IF ( ALLOCATED(InData%UA) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UA upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UA) ) 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%UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - CALL UA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 - END SUBROUTINE FVW_PackDiscState - - SUBROUTINE FVW_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(FVW_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_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%Dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UA 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%UA)) DEALLOCATE(OutData%UA) - ALLOCATE(OutData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UA,1), UBOUND(OutData%UA,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 UA_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%UA(i1), ErrStat2, ErrMsg2 ) ! UA - 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 - END SUBROUTINE FVW_UnPackDiscState - - SUBROUTINE FVW_CopyWng_ConstraintStateType( SrcWng_ConstraintStateTypeData, DstWng_ConstraintStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_ConstraintStateType), INTENT(IN) :: SrcWng_ConstraintStateTypeData - TYPE(Wng_ConstraintStateType), INTENT(INOUT) :: DstWng_ConstraintStateTypeData - 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 = 'FVW_CopyWng_ConstraintStateType' -! + ErrMsg = '' + if (allocated(SrcT_SgmtData%Points)) then + LB(1:2) = lbound(SrcT_SgmtData%Points) + UB(1:2) = ubound(SrcT_SgmtData%Points) + if (.not. allocated(DstT_SgmtData%Points)) then + allocate(DstT_SgmtData%Points(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Points.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_SgmtData%Points = SrcT_SgmtData%Points + end if + if (allocated(SrcT_SgmtData%Connct)) then + LB(1:2) = lbound(SrcT_SgmtData%Connct) + UB(1:2) = ubound(SrcT_SgmtData%Connct) + if (.not. allocated(DstT_SgmtData%Connct)) then + allocate(DstT_SgmtData%Connct(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Connct.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_SgmtData%Connct = SrcT_SgmtData%Connct + end if + if (allocated(SrcT_SgmtData%Gamma)) then + LB(1:1) = lbound(SrcT_SgmtData%Gamma) + UB(1:1) = ubound(SrcT_SgmtData%Gamma) + if (.not. allocated(DstT_SgmtData%Gamma)) then + allocate(DstT_SgmtData%Gamma(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Gamma.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_SgmtData%Gamma = SrcT_SgmtData%Gamma + end if + if (allocated(SrcT_SgmtData%Epsilon)) then + LB(1:1) = lbound(SrcT_SgmtData%Epsilon) + UB(1:1) = ubound(SrcT_SgmtData%Epsilon) + if (.not. allocated(DstT_SgmtData%Epsilon)) then + allocate(DstT_SgmtData%Epsilon(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Epsilon.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_SgmtData%Epsilon = SrcT_SgmtData%Epsilon + end if + DstT_SgmtData%RegFunction = SrcT_SgmtData%RegFunction + DstT_SgmtData%nAct = SrcT_SgmtData%nAct + DstT_SgmtData%nActP = SrcT_SgmtData%nActP +end subroutine + +subroutine FVW_DestroyT_Sgmt(T_SgmtData, ErrStat, ErrMsg) + type(T_Sgmt), intent(inout) :: T_SgmtData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyT_Sgmt' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_ConstraintStateTypeData%Gamma_LL)) THEN - i1_l = LBOUND(SrcWng_ConstraintStateTypeData%Gamma_LL,1) - i1_u = UBOUND(SrcWng_ConstraintStateTypeData%Gamma_LL,1) - IF (.NOT. ALLOCATED(DstWng_ConstraintStateTypeData%Gamma_LL)) THEN - ALLOCATE(DstWng_ConstraintStateTypeData%Gamma_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ConstraintStateTypeData%Gamma_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ConstraintStateTypeData%Gamma_LL = SrcWng_ConstraintStateTypeData%Gamma_LL -ENDIF - END SUBROUTINE FVW_CopyWng_ConstraintStateType - - SUBROUTINE FVW_DestroyWng_ConstraintStateType( Wng_ConstraintStateTypeData, ErrStat, ErrMsg ) - TYPE(Wng_ConstraintStateType), INTENT(INOUT) :: Wng_ConstraintStateTypeData - 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 = 'FVW_DestroyWng_ConstraintStateType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Wng_ConstraintStateTypeData%Gamma_LL)) THEN - DEALLOCATE(Wng_ConstraintStateTypeData%Gamma_LL) -ENDIF - END SUBROUTINE FVW_DestroyWng_ConstraintStateType - - SUBROUTINE FVW_PackWng_ConstraintStateType( 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(Wng_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 = 'FVW_PackWng_ConstraintStateType' - ! 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 ! Gamma_LL allocated yes/no - IF ( ALLOCATED(InData%Gamma_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Gamma_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma_LL) ! Gamma_LL - 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%Gamma_LL) ) 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%Gamma_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Gamma_LL,1), UBOUND(InData%Gamma_LL,1) - ReKiBuf(Re_Xferred) = InData%Gamma_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_PackWng_ConstraintStateType - - SUBROUTINE FVW_UnPackWng_ConstraintStateType( 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(Wng_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackWng_ConstraintStateType' - ! 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 ! Gamma_LL 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%Gamma_LL)) DEALLOCATE(OutData%Gamma_LL) - ALLOCATE(OutData%Gamma_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Gamma_LL,1), UBOUND(OutData%Gamma_LL,1) - OutData%Gamma_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_UnPackWng_ConstraintStateType - - SUBROUTINE FVW_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(FVW_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyConstrState' -! + ErrMsg = '' + if (allocated(T_SgmtData%Points)) then + deallocate(T_SgmtData%Points) + end if + if (allocated(T_SgmtData%Connct)) then + deallocate(T_SgmtData%Connct) + end if + if (allocated(T_SgmtData%Gamma)) then + deallocate(T_SgmtData%Gamma) + end if + if (allocated(T_SgmtData%Epsilon)) then + deallocate(T_SgmtData%Epsilon) + end if +end subroutine + +subroutine FVW_PackT_Sgmt(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(T_Sgmt), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackT_Sgmt' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Points)) + if (allocated(InData%Points)) then + call RegPackBounds(Buf, 2, lbound(InData%Points), ubound(InData%Points)) + call RegPack(Buf, InData%Points) + end if + call RegPack(Buf, allocated(InData%Connct)) + if (allocated(InData%Connct)) then + call RegPackBounds(Buf, 2, lbound(InData%Connct), ubound(InData%Connct)) + call RegPack(Buf, InData%Connct) + end if + call RegPack(Buf, allocated(InData%Gamma)) + if (allocated(InData%Gamma)) then + call RegPackBounds(Buf, 1, lbound(InData%Gamma), ubound(InData%Gamma)) + call RegPack(Buf, InData%Gamma) + end if + call RegPack(Buf, allocated(InData%Epsilon)) + if (allocated(InData%Epsilon)) then + call RegPackBounds(Buf, 1, lbound(InData%Epsilon), ubound(InData%Epsilon)) + call RegPack(Buf, InData%Epsilon) + end if + call RegPack(Buf, InData%RegFunction) + call RegPack(Buf, InData%nAct) + call RegPack(Buf, InData%nActP) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackT_Sgmt(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(T_Sgmt), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackT_Sgmt' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Points)) deallocate(OutData%Points) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Points(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Points.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Points) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Connct)) deallocate(OutData%Connct) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Connct(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Connct.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Connct) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Gamma)) deallocate(OutData%Gamma) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Gamma(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Gamma) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Epsilon)) deallocate(OutData%Epsilon) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Epsilon(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Epsilon.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Epsilon) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%RegFunction) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nAct) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nActP) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMsg) + type(T_Part), intent(in) :: SrcT_PartData + type(T_Part), intent(inout) :: DstT_PartData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyT_Part' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcConstrStateData%W)) THEN - i1_l = LBOUND(SrcConstrStateData%W,1) - i1_u = UBOUND(SrcConstrStateData%W,1) - IF (.NOT. ALLOCATED(DstConstrStateData%W)) THEN - ALLOCATE(DstConstrStateData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%W,1), UBOUND(SrcConstrStateData%W,1) - CALL FVW_Copywng_constraintstatetype( SrcConstrStateData%W(i1), DstConstrStateData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstConstrStateData%residual = SrcConstrStateData%residual - END SUBROUTINE FVW_CopyConstrState - - SUBROUTINE FVW_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(FVW_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 = 'FVW_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ConstrStateData%W)) THEN -DO i1 = LBOUND(ConstrStateData%W,1), UBOUND(ConstrStateData%W,1) - CALL FVW_DestroyWng_ConstraintStateType( ConstrStateData%W(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ConstrStateData%W) -ENDIF - END SUBROUTINE FVW_DestroyConstrState - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Re_BufSz = Re_BufSz + 1 ! residual - 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%W) ) 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%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - 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 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 - ReKiBuf(Re_Xferred) = InData%residual - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FVW_PackConstrState - - SUBROUTINE FVW_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(FVW_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W 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%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,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 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 - - 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%residual = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FVW_UnPackConstrState - - SUBROUTINE FVW_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(FVW_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyOtherState' -! + ErrMsg = '' + if (allocated(SrcT_PartData%P)) then + LB(1:2) = lbound(SrcT_PartData%P) + UB(1:2) = ubound(SrcT_PartData%P) + if (.not. allocated(DstT_PartData%P)) then + allocate(DstT_PartData%P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_PartData%P = SrcT_PartData%P + end if + if (allocated(SrcT_PartData%Alpha)) then + LB(1:2) = lbound(SrcT_PartData%Alpha) + UB(1:2) = ubound(SrcT_PartData%Alpha) + if (.not. allocated(DstT_PartData%Alpha)) then + allocate(DstT_PartData%Alpha(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%Alpha.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_PartData%Alpha = SrcT_PartData%Alpha + end if + if (allocated(SrcT_PartData%RegParam)) then + LB(1:1) = lbound(SrcT_PartData%RegParam) + UB(1:1) = ubound(SrcT_PartData%RegParam) + if (.not. allocated(DstT_PartData%RegParam)) then + allocate(DstT_PartData%RegParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%RegParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_PartData%RegParam = SrcT_PartData%RegParam + end if + DstT_PartData%RegFunction = SrcT_PartData%RegFunction + DstT_PartData%nAct = SrcT_PartData%nAct +end subroutine + +subroutine FVW_DestroyT_Part(T_PartData, ErrStat, ErrMsg) + type(T_Part), intent(inout) :: T_PartData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyT_Part' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%Dummy = SrcOtherStateData%Dummy -IF (ALLOCATED(SrcOtherStateData%UA)) THEN - i1_l = LBOUND(SrcOtherStateData%UA,1) - i1_u = UBOUND(SrcOtherStateData%UA,1) - IF (.NOT. ALLOCATED(DstOtherStateData%UA)) THEN - ALLOCATE(DstOtherStateData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%UA,1), UBOUND(SrcOtherStateData%UA,1) - CALL UA_CopyOtherState( SrcOtherStateData%UA(i1), DstOtherStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FVW_CopyOtherState - - SUBROUTINE FVW_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(FVW_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 = 'FVW_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%UA)) THEN -DO i1 = LBOUND(OtherStateData%UA,1), UBOUND(OtherStateData%UA,1) - CALL UA_DestroyOtherState( OtherStateData%UA(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%UA) -ENDIF - END SUBROUTINE FVW_DestroyOtherState - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! Dummy - Int_BufSz = Int_BufSz + 1 ! UA allocated yes/no - IF ( ALLOCATED(InData%UA) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UA upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - - IntKiBuf(Int_Xferred) = InData%Dummy - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UA) ) 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%UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - CALL UA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 - END SUBROUTINE FVW_PackOtherState - - SUBROUTINE FVW_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(FVW_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_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%Dummy = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UA 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%UA)) DEALLOCATE(OutData%UA) - ALLOCATE(OutData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UA,1), UBOUND(OutData%UA,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 UA_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%UA(i1), ErrStat2, ErrMsg2 ) ! UA - 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 - END SUBROUTINE FVW_UnPackOtherState - - SUBROUTINE FVW_CopyWng_InitInputType( SrcWng_InitInputTypeData, DstWng_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_InitInputType), INTENT(IN) :: SrcWng_InitInputTypeData - TYPE(Wng_InitInputType), INTENT(INOUT) :: DstWng_InitInputTypeData - 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 = 'FVW_CopyWng_InitInputType' -! + ErrMsg = '' + if (allocated(T_PartData%P)) then + deallocate(T_PartData%P) + end if + if (allocated(T_PartData%Alpha)) then + deallocate(T_PartData%Alpha) + end if + if (allocated(T_PartData%RegParam)) then + deallocate(T_PartData%RegParam) + end if +end subroutine + +subroutine FVW_PackT_Part(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(T_Part), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackT_Part' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%P)) + if (allocated(InData%P)) then + call RegPackBounds(Buf, 2, lbound(InData%P), ubound(InData%P)) + call RegPack(Buf, InData%P) + end if + call RegPack(Buf, allocated(InData%Alpha)) + if (allocated(InData%Alpha)) then + call RegPackBounds(Buf, 2, lbound(InData%Alpha), ubound(InData%Alpha)) + call RegPack(Buf, InData%Alpha) + end if + call RegPack(Buf, allocated(InData%RegParam)) + if (allocated(InData%RegParam)) then + call RegPackBounds(Buf, 1, lbound(InData%RegParam), ubound(InData%RegParam)) + call RegPack(Buf, InData%RegParam) + end if + call RegPack(Buf, InData%RegFunction) + call RegPack(Buf, InData%nAct) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackT_Part(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(T_Part), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackT_Part' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%P)) deallocate(OutData%P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%P) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Alpha)) deallocate(OutData%Alpha) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Alpha(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Alpha) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RegParam)) deallocate(OutData%RegParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RegParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RegParam) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%RegFunction) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nAct) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_ParameterType), intent(in) :: SrcWng_ParameterTypeData + type(Wng_ParameterType), intent(inout) :: DstWng_ParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_ParameterType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_InitInputTypeData%AFindx)) THEN - i1_l = LBOUND(SrcWng_InitInputTypeData%AFindx,1) - i1_u = UBOUND(SrcWng_InitInputTypeData%AFindx,1) - i2_l = LBOUND(SrcWng_InitInputTypeData%AFindx,2) - i2_u = UBOUND(SrcWng_InitInputTypeData%AFindx,2) - IF (.NOT. ALLOCATED(DstWng_InitInputTypeData%AFindx)) THEN - ALLOCATE(DstWng_InitInputTypeData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_InitInputTypeData%AFindx = SrcWng_InitInputTypeData%AFindx -ENDIF -IF (ALLOCATED(SrcWng_InitInputTypeData%chord)) THEN - i1_l = LBOUND(SrcWng_InitInputTypeData%chord,1) - i1_u = UBOUND(SrcWng_InitInputTypeData%chord,1) - IF (.NOT. ALLOCATED(DstWng_InitInputTypeData%chord)) THEN - ALLOCATE(DstWng_InitInputTypeData%chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_InitInputTypeData%chord = SrcWng_InitInputTypeData%chord -ENDIF -IF (ALLOCATED(SrcWng_InitInputTypeData%RElm)) THEN - i1_l = LBOUND(SrcWng_InitInputTypeData%RElm,1) - i1_u = UBOUND(SrcWng_InitInputTypeData%RElm,1) - IF (.NOT. ALLOCATED(DstWng_InitInputTypeData%RElm)) THEN - ALLOCATE(DstWng_InitInputTypeData%RElm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%RElm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_InitInputTypeData%RElm = SrcWng_InitInputTypeData%RElm -ENDIF - DstWng_InitInputTypeData%iRotor = SrcWng_InitInputTypeData%iRotor - DstWng_InitInputTypeData%UAOff_innerNode = SrcWng_InitInputTypeData%UAOff_innerNode - DstWng_InitInputTypeData%UAOff_outerNode = SrcWng_InitInputTypeData%UAOff_outerNode - END SUBROUTINE FVW_CopyWng_InitInputType - - SUBROUTINE FVW_DestroyWng_InitInputType( Wng_InitInputTypeData, ErrStat, ErrMsg ) - TYPE(Wng_InitInputType), INTENT(INOUT) :: Wng_InitInputTypeData - 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 = 'FVW_DestroyWng_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Wng_InitInputTypeData%AFindx)) THEN - DEALLOCATE(Wng_InitInputTypeData%AFindx) -ENDIF -IF (ALLOCATED(Wng_InitInputTypeData%chord)) THEN - DEALLOCATE(Wng_InitInputTypeData%chord) -ENDIF -IF (ALLOCATED(Wng_InitInputTypeData%RElm)) THEN - DEALLOCATE(Wng_InitInputTypeData%RElm) -ENDIF - END SUBROUTINE FVW_DestroyWng_InitInputType - - SUBROUTINE FVW_PackWng_InitInputType( 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(Wng_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 = 'FVW_PackWng_InitInputType' - ! 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 ! AFindx allocated yes/no - IF ( ALLOCATED(InData%AFindx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFindx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AFindx) ! AFindx - END IF - Int_BufSz = Int_BufSz + 1 ! chord allocated yes/no - IF ( ALLOCATED(InData%chord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! chord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord) ! chord - END IF - Int_BufSz = Int_BufSz + 1 ! RElm allocated yes/no - IF ( ALLOCATED(InData%RElm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RElm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RElm) ! RElm - END IF - Int_BufSz = Int_BufSz + 1 ! iRotor - Int_BufSz = Int_BufSz + 1 ! UAOff_innerNode - Int_BufSz = Int_BufSz + 1 ! UAOff_outerNode - 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%AFindx) ) 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%AFindx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) - DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) - IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%chord) ) 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%chord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%chord,1), UBOUND(InData%chord,1) - ReKiBuf(Re_Xferred) = InData%chord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RElm) ) 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%RElm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RElm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RElm,1), UBOUND(InData%RElm,1) - ReKiBuf(Re_Xferred) = InData%RElm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iRotor - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAOff_innerNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAOff_outerNode - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackWng_InitInputType - - SUBROUTINE FVW_UnPackWng_InitInputType( 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(Wng_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 = 'FVW_UnPackWng_InitInputType' - ! 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 ! AFindx 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%AFindx)) DEALLOCATE(OutData%AFindx) - ALLOCATE(OutData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) - DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) - OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord 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%chord)) DEALLOCATE(OutData%chord) - ALLOCATE(OutData%chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%chord,1), UBOUND(OutData%chord,1) - OutData%chord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RElm 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%RElm)) DEALLOCATE(OutData%RElm) - ALLOCATE(OutData%RElm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RElm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RElm,1), UBOUND(OutData%RElm,1) - OutData%RElm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%iRotor = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UAOff_innerNode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UAOff_outerNode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackWng_InitInputType - - SUBROUTINE FVW_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_InitInputType), INTENT(INOUT) :: SrcInitInputData - TYPE(FVW_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 = 'FVW_CopyInitInput' -! + ErrMsg = '' + if (allocated(SrcWng_ParameterTypeData%chord_LL)) then + LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_LL) + UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_LL) + if (.not. allocated(DstWng_ParameterTypeData%chord_LL)) then + allocate(DstWng_ParameterTypeData%chord_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%chord_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%chord_LL = SrcWng_ParameterTypeData%chord_LL + end if + if (allocated(SrcWng_ParameterTypeData%chord_CP)) then + LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_CP) + UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_CP) + if (.not. allocated(DstWng_ParameterTypeData%chord_CP)) then + allocate(DstWng_ParameterTypeData%chord_CP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%chord_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%chord_CP = SrcWng_ParameterTypeData%chord_CP + end if + if (allocated(SrcWng_ParameterTypeData%s_LL)) then + LB(1:1) = lbound(SrcWng_ParameterTypeData%s_LL) + UB(1:1) = ubound(SrcWng_ParameterTypeData%s_LL) + if (.not. allocated(DstWng_ParameterTypeData%s_LL)) then + allocate(DstWng_ParameterTypeData%s_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%s_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%s_LL = SrcWng_ParameterTypeData%s_LL + end if + if (allocated(SrcWng_ParameterTypeData%s_CP)) then + LB(1:1) = lbound(SrcWng_ParameterTypeData%s_CP) + UB(1:1) = ubound(SrcWng_ParameterTypeData%s_CP) + if (.not. allocated(DstWng_ParameterTypeData%s_CP)) then + allocate(DstWng_ParameterTypeData%s_CP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%s_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%s_CP = SrcWng_ParameterTypeData%s_CP + end if + DstWng_ParameterTypeData%iRotor = SrcWng_ParameterTypeData%iRotor + if (allocated(SrcWng_ParameterTypeData%AFindx)) then + LB(1:2) = lbound(SrcWng_ParameterTypeData%AFindx) + UB(1:2) = ubound(SrcWng_ParameterTypeData%AFindx) + if (.not. allocated(DstWng_ParameterTypeData%AFindx)) then + allocate(DstWng_ParameterTypeData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%AFindx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%AFindx = SrcWng_ParameterTypeData%AFindx + end if + DstWng_ParameterTypeData%nSpan = SrcWng_ParameterTypeData%nSpan + if (allocated(SrcWng_ParameterTypeData%PrescribedCirculation)) then + LB(1:1) = lbound(SrcWng_ParameterTypeData%PrescribedCirculation) + UB(1:1) = ubound(SrcWng_ParameterTypeData%PrescribedCirculation) + if (.not. allocated(DstWng_ParameterTypeData%PrescribedCirculation)) then + allocate(DstWng_ParameterTypeData%PrescribedCirculation(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%PrescribedCirculation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%PrescribedCirculation = SrcWng_ParameterTypeData%PrescribedCirculation + end if +end subroutine + +subroutine FVW_DestroyWng_ParameterType(Wng_ParameterTypeData, ErrStat, ErrMsg) + type(Wng_ParameterType), intent(inout) :: Wng_ParameterTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_ParameterType' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%FVWFileName = SrcInitInputData%FVWFileName - DstInitInputData%RootName = SrcInitInputData%RootName -IF (ALLOCATED(SrcInitInputData%W)) THEN - i1_l = LBOUND(SrcInitInputData%W,1) - i1_u = UBOUND(SrcInitInputData%W,1) - IF (.NOT. ALLOCATED(DstInitInputData%W)) THEN - ALLOCATE(DstInitInputData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%W,1), UBOUND(SrcInitInputData%W,1) - CALL FVW_Copywng_initinputtype( SrcInitInputData%W(i1), DstInitInputData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInitInputData%WingsMesh)) THEN - i1_l = LBOUND(SrcInitInputData%WingsMesh,1) - i1_u = UBOUND(SrcInitInputData%WingsMesh,1) - IF (.NOT. ALLOCATED(DstInitInputData%WingsMesh)) THEN - ALLOCATE(DstInitInputData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WingsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%WingsMesh,1), UBOUND(SrcInitInputData%WingsMesh,1) - CALL MeshCopy( SrcInitInputData%WingsMesh(i1), DstInitInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%numBladeNodes = SrcInitInputData%numBladeNodes - DstInitInputData%DTaero = SrcInitInputData%DTaero - DstInitInputData%KinVisc = SrcInitInputData%KinVisc - DstInitInputData%MHK = SrcInitInputData%MHK - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%UAMod = SrcInitInputData%UAMod - DstInitInputData%UA_Flag = SrcInitInputData%UA_Flag - DstInitInputData%Flookup = SrcInitInputData%Flookup - DstInitInputData%a_s = SrcInitInputData%a_s - DstInitInputData%SumPrint = SrcInitInputData%SumPrint - END SUBROUTINE FVW_CopyInitInput - - SUBROUTINE FVW_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(FVW_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 = 'FVW_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%W)) THEN -DO i1 = LBOUND(InitInputData%W,1), UBOUND(InitInputData%W,1) - CALL FVW_DestroyWng_InitInputType( InitInputData%W(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%W) -ENDIF -IF (ALLOCATED(InitInputData%WingsMesh)) THEN -DO i1 = LBOUND(InitInputData%WingsMesh,1), UBOUND(InitInputData%WingsMesh,1) - CALL MeshDestroy( InitInputData%WingsMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%WingsMesh) -ENDIF - END SUBROUTINE FVW_DestroyInitInput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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%FVWFileName) ! FVWFileName - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WingsMesh allocated yes/no - IF ( ALLOCATED(InData%WingsMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WingsMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) - Int_BufSz = Int_BufSz + 3 ! WingsMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WingsMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WingsMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WingsMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WingsMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! numBladeNodes - Db_BufSz = Db_BufSz + 1 ! DTaero - Re_BufSz = Re_BufSz + 1 ! KinVisc - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! UAMod - Int_BufSz = Int_BufSz + 1 ! UA_Flag - Int_BufSz = Int_BufSz + 1 ! Flookup - Re_BufSz = Re_BufSz + 1 ! a_s - Int_BufSz = Int_BufSz + 1 ! SumPrint - 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%FVWFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FVWFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%W) ) 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%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%WingsMesh) ) 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%WingsMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WingsMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) - CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WingsMesh - 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%numBladeNodes - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTaero - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackInitInput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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%FVWFileName) - OutData%FVWFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W 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%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,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 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 - - 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 ! WingsMesh 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%WingsMesh)) DEALLOCATE(OutData%WingsMesh) - ALLOCATE(OutData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WingsMesh,1), UBOUND(OutData%WingsMesh,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 MeshUnpack( OutData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WingsMesh - 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%numBladeNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DTaero = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UAMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) - Int_Xferred = Int_Xferred + 1 - OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackInitInput - - SUBROUTINE FVW_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(FVW_InputFile), INTENT(INOUT) :: DstInputFileData - 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 = 'FVW_CopyInputFile' -! + ErrMsg = '' + if (allocated(Wng_ParameterTypeData%chord_LL)) then + deallocate(Wng_ParameterTypeData%chord_LL) + end if + if (allocated(Wng_ParameterTypeData%chord_CP)) then + deallocate(Wng_ParameterTypeData%chord_CP) + end if + if (allocated(Wng_ParameterTypeData%s_LL)) then + deallocate(Wng_ParameterTypeData%s_LL) + end if + if (allocated(Wng_ParameterTypeData%s_CP)) then + deallocate(Wng_ParameterTypeData%s_CP) + end if + if (allocated(Wng_ParameterTypeData%AFindx)) then + deallocate(Wng_ParameterTypeData%AFindx) + end if + if (allocated(Wng_ParameterTypeData%PrescribedCirculation)) then + deallocate(Wng_ParameterTypeData%PrescribedCirculation) + end if +end subroutine + +subroutine FVW_PackWng_ParameterType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wng_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_ParameterType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%chord_LL)) + if (allocated(InData%chord_LL)) then + call RegPackBounds(Buf, 1, lbound(InData%chord_LL), ubound(InData%chord_LL)) + call RegPack(Buf, InData%chord_LL) + end if + call RegPack(Buf, allocated(InData%chord_CP)) + if (allocated(InData%chord_CP)) then + call RegPackBounds(Buf, 1, lbound(InData%chord_CP), ubound(InData%chord_CP)) + call RegPack(Buf, InData%chord_CP) + end if + call RegPack(Buf, allocated(InData%s_LL)) + if (allocated(InData%s_LL)) then + call RegPackBounds(Buf, 1, lbound(InData%s_LL), ubound(InData%s_LL)) + call RegPack(Buf, InData%s_LL) + end if + call RegPack(Buf, allocated(InData%s_CP)) + if (allocated(InData%s_CP)) then + call RegPackBounds(Buf, 1, lbound(InData%s_CP), ubound(InData%s_CP)) + call RegPack(Buf, InData%s_CP) + end if + call RegPack(Buf, InData%iRotor) + call RegPack(Buf, allocated(InData%AFindx)) + if (allocated(InData%AFindx)) then + call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) + call RegPack(Buf, InData%AFindx) + end if + call RegPack(Buf, InData%nSpan) + call RegPack(Buf, allocated(InData%PrescribedCirculation)) + if (allocated(InData%PrescribedCirculation)) then + call RegPackBounds(Buf, 1, lbound(InData%PrescribedCirculation), ubound(InData%PrescribedCirculation)) + call RegPack(Buf, InData%PrescribedCirculation) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_ParameterType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wng_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_ParameterType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%chord_LL)) deallocate(OutData%chord_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%chord_LL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%chord_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%chord_CP)) deallocate(OutData%chord_CP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%chord_CP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%chord_CP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%s_LL)) deallocate(OutData%s_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%s_LL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%s_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%s_CP)) deallocate(OutData%s_CP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%s_CP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%s_CP) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%iRotor) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFindx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFindx) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%nSpan) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PrescribedCirculation)) deallocate(OutData%PrescribedCirculation) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PrescribedCirculation(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrescribedCirculation.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PrescribedCirculation) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FVW_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(in) :: SrcParamData + type(FVW_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%CircSolvMethod = SrcInputFileData%CircSolvMethod - DstInputFileData%CirculationFile = SrcInputFileData%CirculationFile - DstInputFileData%CircSolvMaxIter = SrcInputFileData%CircSolvMaxIter - DstInputFileData%CircSolvConvCrit = SrcInputFileData%CircSolvConvCrit - DstInputFileData%CircSolvRelaxation = SrcInputFileData%CircSolvRelaxation - DstInputFileData%IntMethod = SrcInputFileData%IntMethod - DstInputFileData%FreeWake = SrcInputFileData%FreeWake - DstInputFileData%FreeWakeStart = SrcInputFileData%FreeWakeStart - DstInputFileData%FullCircStart = SrcInputFileData%FullCircStart - DstInputFileData%DTfvw = SrcInputFileData%DTfvw - DstInputFileData%CircSolvPolar = SrcInputFileData%CircSolvPolar - DstInputFileData%nNWPanels = SrcInputFileData%nNWPanels - DstInputFileData%nNWPanelsFree = SrcInputFileData%nNWPanelsFree - DstInputFileData%nFWPanels = SrcInputFileData%nFWPanels - DstInputFileData%nFWPanelsFree = SrcInputFileData%nFWPanelsFree - DstInputFileData%FWShedVorticity = SrcInputFileData%FWShedVorticity - DstInputFileData%DiffusionMethod = SrcInputFileData%DiffusionMethod - DstInputFileData%CoreSpreadEddyVisc = SrcInputFileData%CoreSpreadEddyVisc - DstInputFileData%RegDeterMethod = SrcInputFileData%RegDeterMethod - DstInputFileData%RegFunction = SrcInputFileData%RegFunction - DstInputFileData%WakeRegMethod = SrcInputFileData%WakeRegMethod - DstInputFileData%WakeRegParam = SrcInputFileData%WakeRegParam - DstInputFileData%WingRegParam = SrcInputFileData%WingRegParam - DstInputFileData%ShearModel = SrcInputFileData%ShearModel - DstInputFileData%TwrShadowOnWake = SrcInputFileData%TwrShadowOnWake - DstInputFileData%VelocityMethod = SrcInputFileData%VelocityMethod - DstInputFileData%TreeBranchFactor = SrcInputFileData%TreeBranchFactor - DstInputFileData%PartPerSegment = SrcInputFileData%PartPerSegment - DstInputFileData%WrVTK = SrcInputFileData%WrVTK - DstInputFileData%VTKBlades = SrcInputFileData%VTKBlades - DstInputFileData%DTvtk = SrcInputFileData%DTvtk - DstInputFileData%VTKCoord = SrcInputFileData%VTKCoord - END SUBROUTINE FVW_CopyInputFile - - SUBROUTINE FVW_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(FVW_InputFile), INTENT(INOUT) :: InputFileData - 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 = 'FVW_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE FVW_DestroyInputFile - - SUBROUTINE FVW_PackInputFile( 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(FVW_InputFile), 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 = 'FVW_PackInputFile' - ! 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 ! CircSolvMethod - Int_BufSz = Int_BufSz + 1*LEN(InData%CirculationFile) ! CirculationFile - Int_BufSz = Int_BufSz + 1 ! CircSolvMaxIter - Re_BufSz = Re_BufSz + 1 ! CircSolvConvCrit - Re_BufSz = Re_BufSz + 1 ! CircSolvRelaxation - Int_BufSz = Int_BufSz + 1 ! IntMethod - Int_BufSz = Int_BufSz + 1 ! FreeWake - Re_BufSz = Re_BufSz + 1 ! FreeWakeStart - Re_BufSz = Re_BufSz + 1 ! FullCircStart - Db_BufSz = Db_BufSz + 1 ! DTfvw - Int_BufSz = Int_BufSz + 1 ! CircSolvPolar - Int_BufSz = Int_BufSz + 1 ! nNWPanels - Int_BufSz = Int_BufSz + 1 ! nNWPanelsFree - Int_BufSz = Int_BufSz + 1 ! nFWPanels - Int_BufSz = Int_BufSz + 1 ! nFWPanelsFree - Int_BufSz = Int_BufSz + 1 ! FWShedVorticity - Int_BufSz = Int_BufSz + 1 ! DiffusionMethod - Re_BufSz = Re_BufSz + 1 ! CoreSpreadEddyVisc - Int_BufSz = Int_BufSz + 1 ! RegDeterMethod - Int_BufSz = Int_BufSz + 1 ! RegFunction - Int_BufSz = Int_BufSz + 1 ! WakeRegMethod - Re_BufSz = Re_BufSz + 1 ! WakeRegParam - Re_BufSz = Re_BufSz + 1 ! WingRegParam - Int_BufSz = Int_BufSz + 1 ! ShearModel - Int_BufSz = Int_BufSz + 1 ! TwrShadowOnWake - Int_BufSz = Int_BufSz + SIZE(InData%VelocityMethod) ! VelocityMethod - Re_BufSz = Re_BufSz + SIZE(InData%TreeBranchFactor) ! TreeBranchFactor - Int_BufSz = Int_BufSz + SIZE(InData%PartPerSegment) ! PartPerSegment - Int_BufSz = Int_BufSz + 1 ! WrVTK - Int_BufSz = Int_BufSz + 1 ! VTKBlades - Db_BufSz = Db_BufSz + 1 ! DTvtk - Int_BufSz = Int_BufSz + 1 ! VTKCoord - 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%CircSolvMethod - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%CirculationFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%CirculationFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%CircSolvMaxIter - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CircSolvConvCrit - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CircSolvRelaxation - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FreeWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FreeWakeStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FullCircStart - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTfvw - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CircSolvPolar - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNWPanels - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNWPanelsFree - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFWPanels - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFWPanelsFree - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FWShedVorticity, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DiffusionMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CoreSpreadEddyVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RegDeterMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RegFunction - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WakeRegMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WakeRegParam - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WingRegParam - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ShearModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadowOnWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%VelocityMethod,1), UBOUND(InData%VelocityMethod,1) - IntKiBuf(Int_Xferred) = InData%VelocityMethod(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TreeBranchFactor,1), UBOUND(InData%TreeBranchFactor,1) - ReKiBuf(Re_Xferred) = InData%TreeBranchFactor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PartPerSegment,1), UBOUND(InData%PartPerSegment,1) - IntKiBuf(Int_Xferred) = InData%PartPerSegment(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%WrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKBlades - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTvtk - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKCoord - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackInputFile - - SUBROUTINE FVW_UnPackInputFile( 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(FVW_InputFile), 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 = 'FVW_UnPackInputFile' - ! 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%CircSolvMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%CirculationFile) - OutData%CirculationFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CircSolvMaxIter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CircSolvConvCrit = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CircSolvRelaxation = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FreeWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FreeWake) - Int_Xferred = Int_Xferred + 1 - OutData%FreeWakeStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FullCircStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DTfvw = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CircSolvPolar = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNWPanels = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNWPanelsFree = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFWPanels = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFWPanelsFree = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FWShedVorticity = TRANSFER(IntKiBuf(Int_Xferred), OutData%FWShedVorticity) - Int_Xferred = Int_Xferred + 1 - OutData%DiffusionMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CoreSpreadEddyVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RegDeterMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RegFunction = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakeRegMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakeRegParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WingRegParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShearModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadowOnWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadowOnWake) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%VelocityMethod,1) - i1_u = UBOUND(OutData%VelocityMethod,1) - DO i1 = LBOUND(OutData%VelocityMethod,1), UBOUND(OutData%VelocityMethod,1) - OutData%VelocityMethod(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TreeBranchFactor,1) - i1_u = UBOUND(OutData%TreeBranchFactor,1) - DO i1 = LBOUND(OutData%TreeBranchFactor,1), UBOUND(OutData%TreeBranchFactor,1) - OutData%TreeBranchFactor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PartPerSegment,1) - i1_u = UBOUND(OutData%PartPerSegment,1) - DO i1 = LBOUND(OutData%PartPerSegment,1), UBOUND(OutData%PartPerSegment,1) - OutData%PartPerSegment(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%WrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DTvtk = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%VTKCoord = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackInputFile - - SUBROUTINE FVW_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(FVW_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyInitOutput' -! + ErrMsg = '' + DstParamData%nRotors = SrcParamData%nRotors + DstParamData%nWings = SrcParamData%nWings + if (allocated(SrcParamData%W)) then + LB(1:1) = lbound(SrcParamData%W) + UB(1:1) = ubound(SrcParamData%W) + if (.not. allocated(DstParamData%W)) then + allocate(DstParamData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_ParameterType(SrcParamData%W(i1), DstParamData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%Bld2Wings)) then + LB(1:2) = lbound(SrcParamData%Bld2Wings) + UB(1:2) = ubound(SrcParamData%Bld2Wings) + if (.not. allocated(DstParamData%Bld2Wings)) then + allocate(DstParamData%Bld2Wings(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Bld2Wings.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Bld2Wings = SrcParamData%Bld2Wings + end if + DstParamData%iNWStart = SrcParamData%iNWStart + DstParamData%nNWMax = SrcParamData%nNWMax + DstParamData%nNWFree = SrcParamData%nNWFree + DstParamData%nFWMax = SrcParamData%nFWMax + DstParamData%nFWFree = SrcParamData%nFWFree + DstParamData%FWShedVorticity = SrcParamData%FWShedVorticity + DstParamData%IntMethod = SrcParamData%IntMethod + DstParamData%FreeWakeStart = SrcParamData%FreeWakeStart + DstParamData%FullCircStart = SrcParamData%FullCircStart + DstParamData%CircSolvMethod = SrcParamData%CircSolvMethod + DstParamData%CircSolvMaxIter = SrcParamData%CircSolvMaxIter + DstParamData%CircSolvConvCrit = SrcParamData%CircSolvConvCrit + DstParamData%CircSolvRelaxation = SrcParamData%CircSolvRelaxation + DstParamData%CircSolvPolar = SrcParamData%CircSolvPolar + DstParamData%DiffusionMethod = SrcParamData%DiffusionMethod + DstParamData%CoreSpreadEddyVisc = SrcParamData%CoreSpreadEddyVisc + DstParamData%RegDeterMethod = SrcParamData%RegDeterMethod + DstParamData%RegFunction = SrcParamData%RegFunction + DstParamData%WakeRegMethod = SrcParamData%WakeRegMethod + DstParamData%WakeRegParam = SrcParamData%WakeRegParam + DstParamData%WingRegParam = SrcParamData%WingRegParam + DstParamData%ShearModel = SrcParamData%ShearModel + DstParamData%TwrShadowOnWake = SrcParamData%TwrShadowOnWake + DstParamData%VelocityMethod = SrcParamData%VelocityMethod + DstParamData%TreeBranchFactor = SrcParamData%TreeBranchFactor + DstParamData%PartPerSegment = SrcParamData%PartPerSegment + DstParamData%DTaero = SrcParamData%DTaero + DstParamData%DTfvw = SrcParamData%DTfvw + DstParamData%KinVisc = SrcParamData%KinVisc + DstParamData%MHK = SrcParamData%MHK + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%WrVTK = SrcParamData%WrVTK + DstParamData%VTKBlades = SrcParamData%VTKBlades + DstParamData%DTvtk = SrcParamData%DTvtk + DstParamData%VTKCoord = SrcParamData%VTKCoord + DstParamData%RootName = SrcParamData%RootName + DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot + DstParamData%VTK_OutFileBase = SrcParamData%VTK_OutFileBase + DstParamData%nGridOut = SrcParamData%nGridOut + DstParamData%InductionAtCP = SrcParamData%InductionAtCP + DstParamData%WakeAtTE = SrcParamData%WakeAtTE + DstParamData%DStallOnWake = SrcParamData%DStallOnWake + DstParamData%Induction = SrcParamData%Induction + DstParamData%kFrozenNWStart = SrcParamData%kFrozenNWStart + DstParamData%kFrozenNWEnd = SrcParamData%kFrozenNWEnd +end subroutine + +subroutine FVW_DestroyParam(ParamData, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyParam' ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%Dummy = SrcInitOutputData%Dummy - END SUBROUTINE FVW_CopyInitOutput - - SUBROUTINE FVW_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(FVW_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 = 'FVW_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE FVW_DestroyInitOutput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! Dummy - 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%Dummy - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackInitOutput - - SUBROUTINE FVW_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(FVW_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_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 - OutData%Dummy = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackInitOutput - - - SUBROUTINE FVW_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(FVW_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(FVW_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 + ErrMsg = '' + if (allocated(ParamData%W)) then + LB(1:1) = lbound(ParamData%W) + UB(1:1) = ubound(ParamData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_ParameterType(ParamData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%W) + end if + if (allocated(ParamData%Bld2Wings)) then + deallocate(ParamData%Bld2Wings) + end if +end subroutine + +subroutine FVW_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%nRotors) + call RegPack(Buf, InData%nWings) + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_ParameterType(Buf, InData%W(i1)) + end do + end if + call RegPack(Buf, allocated(InData%Bld2Wings)) + if (allocated(InData%Bld2Wings)) then + call RegPackBounds(Buf, 2, lbound(InData%Bld2Wings), ubound(InData%Bld2Wings)) + call RegPack(Buf, InData%Bld2Wings) + end if + call RegPack(Buf, InData%iNWStart) + call RegPack(Buf, InData%nNWMax) + call RegPack(Buf, InData%nNWFree) + call RegPack(Buf, InData%nFWMax) + call RegPack(Buf, InData%nFWFree) + call RegPack(Buf, InData%FWShedVorticity) + call RegPack(Buf, InData%IntMethod) + call RegPack(Buf, InData%FreeWakeStart) + call RegPack(Buf, InData%FullCircStart) + call RegPack(Buf, InData%CircSolvMethod) + call RegPack(Buf, InData%CircSolvMaxIter) + call RegPack(Buf, InData%CircSolvConvCrit) + call RegPack(Buf, InData%CircSolvRelaxation) + call RegPack(Buf, InData%CircSolvPolar) + call RegPack(Buf, InData%DiffusionMethod) + call RegPack(Buf, InData%CoreSpreadEddyVisc) + call RegPack(Buf, InData%RegDeterMethod) + call RegPack(Buf, InData%RegFunction) + call RegPack(Buf, InData%WakeRegMethod) + call RegPack(Buf, InData%WakeRegParam) + call RegPack(Buf, InData%WingRegParam) + call RegPack(Buf, InData%ShearModel) + call RegPack(Buf, InData%TwrShadowOnWake) + call RegPack(Buf, InData%VelocityMethod) + call RegPack(Buf, InData%TreeBranchFactor) + call RegPack(Buf, InData%PartPerSegment) + call RegPack(Buf, InData%DTaero) + call RegPack(Buf, InData%DTfvw) + call RegPack(Buf, InData%KinVisc) + call RegPack(Buf, InData%MHK) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%WrVTK) + call RegPack(Buf, InData%VTKBlades) + call RegPack(Buf, InData%DTvtk) + call RegPack(Buf, InData%VTKCoord) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%VTK_OutFileRoot) + call RegPack(Buf, InData%VTK_OutFileBase) + call RegPack(Buf, InData%nGridOut) + call RegPack(Buf, InData%InductionAtCP) + call RegPack(Buf, InData%WakeAtTE) + call RegPack(Buf, InData%DStallOnWake) + call RegPack(Buf, InData%Induction) + call RegPack(Buf, InData%kFrozenNWStart) + call RegPack(Buf, InData%kFrozenNWEnd) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%nRotors) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nWings) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_ParameterType(Buf, OutData%W(i1)) ! W + end do + end if + if (allocated(OutData%Bld2Wings)) deallocate(OutData%Bld2Wings) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Bld2Wings(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bld2Wings.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Bld2Wings) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%iNWStart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nNWMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nNWFree) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nFWMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nFWFree) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FWShedVorticity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IntMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FreeWakeStart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FullCircStart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CircSolvMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CircSolvMaxIter) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CircSolvConvCrit) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CircSolvRelaxation) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CircSolvPolar) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DiffusionMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CoreSpreadEddyVisc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RegDeterMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RegFunction) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WakeRegMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WakeRegParam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WingRegParam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ShearModel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrShadowOnWake) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VelocityMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TreeBranchFactor) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PartPerSegment) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DTaero) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DTfvw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrVTK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKBlades) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DTvtk) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKCoord) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTK_OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTK_OutFileBase) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nGridOut) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InductionAtCP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WakeAtTE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DStallOnWake) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Induction) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%kFrozenNWStart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%kFrozenNWEnd) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWng_ContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_ContinuousStateType), intent(in) :: SrcWng_ContinuousStateTypeData + type(Wng_ContinuousStateType), intent(inout) :: DstWng_ContinuousStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_ContinuousStateType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_ContinuousStateTypeData%Gamma_NW)) then + LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_NW) + UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_NW) + if (.not. allocated(DstWng_ContinuousStateTypeData%Gamma_NW)) then + allocate(DstWng_ContinuousStateTypeData%Gamma_NW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Gamma_NW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%Gamma_NW = SrcWng_ContinuousStateTypeData%Gamma_NW + end if + if (allocated(SrcWng_ContinuousStateTypeData%Gamma_FW)) then + LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_FW) + UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_FW) + if (.not. allocated(DstWng_ContinuousStateTypeData%Gamma_FW)) then + allocate(DstWng_ContinuousStateTypeData%Gamma_FW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Gamma_FW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%Gamma_FW = SrcWng_ContinuousStateTypeData%Gamma_FW + end if + if (allocated(SrcWng_ContinuousStateTypeData%Eps_NW)) then + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_NW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_NW) + if (.not. allocated(DstWng_ContinuousStateTypeData%Eps_NW)) then + allocate(DstWng_ContinuousStateTypeData%Eps_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Eps_NW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%Eps_NW = SrcWng_ContinuousStateTypeData%Eps_NW + end if + if (allocated(SrcWng_ContinuousStateTypeData%Eps_FW)) then + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_FW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_FW) + if (.not. allocated(DstWng_ContinuousStateTypeData%Eps_FW)) then + allocate(DstWng_ContinuousStateTypeData%Eps_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Eps_FW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%Eps_FW = SrcWng_ContinuousStateTypeData%Eps_FW + end if + if (allocated(SrcWng_ContinuousStateTypeData%r_NW)) then + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_NW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_NW) + if (.not. allocated(DstWng_ContinuousStateTypeData%r_NW)) then + allocate(DstWng_ContinuousStateTypeData%r_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%r_NW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%r_NW = SrcWng_ContinuousStateTypeData%r_NW + end if + if (allocated(SrcWng_ContinuousStateTypeData%r_FW)) then + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_FW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_FW) + if (.not. allocated(DstWng_ContinuousStateTypeData%r_FW)) then + allocate(DstWng_ContinuousStateTypeData%r_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%r_FW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%r_FW = SrcWng_ContinuousStateTypeData%r_FW + end if +end subroutine + +subroutine FVW_DestroyWng_ContinuousStateType(Wng_ContinuousStateTypeData, ErrStat, ErrMsg) + type(Wng_ContinuousStateType), intent(inout) :: Wng_ContinuousStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_ContinuousStateType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_ContinuousStateTypeData%Gamma_NW)) then + deallocate(Wng_ContinuousStateTypeData%Gamma_NW) + end if + if (allocated(Wng_ContinuousStateTypeData%Gamma_FW)) then + deallocate(Wng_ContinuousStateTypeData%Gamma_FW) + end if + if (allocated(Wng_ContinuousStateTypeData%Eps_NW)) then + deallocate(Wng_ContinuousStateTypeData%Eps_NW) + end if + if (allocated(Wng_ContinuousStateTypeData%Eps_FW)) then + deallocate(Wng_ContinuousStateTypeData%Eps_FW) + end if + if (allocated(Wng_ContinuousStateTypeData%r_NW)) then + deallocate(Wng_ContinuousStateTypeData%r_NW) + end if + if (allocated(Wng_ContinuousStateTypeData%r_FW)) then + deallocate(Wng_ContinuousStateTypeData%r_FW) + end if +end subroutine + +subroutine FVW_PackWng_ContinuousStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wng_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_ContinuousStateType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Gamma_NW)) + if (allocated(InData%Gamma_NW)) then + call RegPackBounds(Buf, 2, lbound(InData%Gamma_NW), ubound(InData%Gamma_NW)) + call RegPack(Buf, InData%Gamma_NW) + end if + call RegPack(Buf, allocated(InData%Gamma_FW)) + if (allocated(InData%Gamma_FW)) then + call RegPackBounds(Buf, 2, lbound(InData%Gamma_FW), ubound(InData%Gamma_FW)) + call RegPack(Buf, InData%Gamma_FW) + end if + call RegPack(Buf, allocated(InData%Eps_NW)) + if (allocated(InData%Eps_NW)) then + call RegPackBounds(Buf, 3, lbound(InData%Eps_NW), ubound(InData%Eps_NW)) + call RegPack(Buf, InData%Eps_NW) + end if + call RegPack(Buf, allocated(InData%Eps_FW)) + if (allocated(InData%Eps_FW)) then + call RegPackBounds(Buf, 3, lbound(InData%Eps_FW), ubound(InData%Eps_FW)) + call RegPack(Buf, InData%Eps_FW) + end if + call RegPack(Buf, allocated(InData%r_NW)) + if (allocated(InData%r_NW)) then + call RegPackBounds(Buf, 3, lbound(InData%r_NW), ubound(InData%r_NW)) + call RegPack(Buf, InData%r_NW) + end if + call RegPack(Buf, allocated(InData%r_FW)) + if (allocated(InData%r_FW)) then + call RegPackBounds(Buf, 3, lbound(InData%r_FW), ubound(InData%r_FW)) + call RegPack(Buf, InData%r_FW) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_ContinuousStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wng_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_ContinuousStateType' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Gamma_NW)) deallocate(OutData%Gamma_NW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Gamma_NW(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_NW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Gamma_NW) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Gamma_FW)) deallocate(OutData%Gamma_FW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Gamma_FW(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_FW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Gamma_FW) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Eps_NW)) deallocate(OutData%Eps_NW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Eps_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Eps_NW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Eps_NW) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Eps_FW)) deallocate(OutData%Eps_FW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Eps_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Eps_FW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Eps_FW) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%r_NW)) deallocate(OutData%r_NW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_NW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_NW) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%r_FW)) deallocate(OutData%r_FW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_FW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_FW) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FVW_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(FVW_ContinuousStateType), intent(in) :: SrcContStateData + type(FVW_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%W)) then + LB(1:1) = lbound(SrcContStateData%W) + UB(1:1) = ubound(SrcContStateData%W) + if (.not. allocated(DstContStateData%W)) then + allocate(DstContStateData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_ContinuousStateType(SrcContStateData%W(i1), DstContStateData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcContStateData%UA)) then + LB(1:1) = lbound(SrcContStateData%UA) + UB(1:1) = ubound(SrcContStateData%UA) + if (.not. allocated(DstContStateData%UA)) then + allocate(DstContStateData%UA(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%UA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call UA_CopyContState(SrcContStateData%UA(i1), DstContStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FVW_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(FVW_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%W)) then + LB(1:1) = lbound(ContStateData%W) + UB(1:1) = ubound(ContStateData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_ContinuousStateType(ContStateData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%W) + end if + if (allocated(ContStateData%UA)) then + LB(1:1) = lbound(ContStateData%UA) + UB(1:1) = ubound(ContStateData%UA) + do i1 = LB(1), UB(1) + call UA_DestroyContState(ContStateData%UA(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%UA) + end if +end subroutine + +subroutine FVW_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_ContinuousStateType(Buf, InData%W(i1)) + end do + end if + call RegPack(Buf, allocated(InData%UA)) + if (allocated(InData%UA)) then + call RegPackBounds(Buf, 1, lbound(InData%UA), ubound(InData%UA)) + LB(1:1) = lbound(InData%UA) + UB(1:1) = ubound(InData%UA) + do i1 = LB(1), UB(1) + call UA_PackContState(Buf, InData%UA(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_ContinuousStateType(Buf, OutData%W(i1)) ! W + end do + end if + if (allocated(OutData%UA)) deallocate(OutData%UA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UA(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call UA_UnpackContState(Buf, OutData%UA(i1)) ! UA + end do + end if +end subroutine + +subroutine FVW_CopyWng_OutputType(SrcWng_OutputTypeData, DstWng_OutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_OutputType), intent(in) :: SrcWng_OutputTypeData + type(Wng_OutputType), intent(inout) :: DstWng_OutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_OutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_OutputTypeData%Vind)) then + LB(1:2) = lbound(SrcWng_OutputTypeData%Vind) + UB(1:2) = ubound(SrcWng_OutputTypeData%Vind) + if (.not. allocated(DstWng_OutputTypeData%Vind)) then + allocate(DstWng_OutputTypeData%Vind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_OutputTypeData%Vind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_OutputTypeData%Vind = SrcWng_OutputTypeData%Vind + end if +end subroutine + +subroutine FVW_DestroyWng_OutputType(Wng_OutputTypeData, ErrStat, ErrMsg) + type(Wng_OutputType), intent(inout) :: Wng_OutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_OutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_OutputTypeData%Vind)) then + deallocate(Wng_OutputTypeData%Vind) + end if +end subroutine + +subroutine FVW_PackWng_OutputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wng_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_OutputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Vind)) + if (allocated(InData%Vind)) then + call RegPackBounds(Buf, 2, lbound(InData%Vind), ubound(InData%Vind)) + call RegPack(Buf, InData%Vind) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_OutputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wng_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_OutputType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Vind)) deallocate(OutData%Vind) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vind(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vind) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FVW_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(FVW_OutputType), intent(in) :: SrcOutputData + type(FVW_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%W)) then + LB(1:1) = lbound(SrcOutputData%W) + UB(1:1) = ubound(SrcOutputData%W) + if (.not. allocated(DstOutputData%W)) then + allocate(DstOutputData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_OutputType(SrcOutputData%W(i1), DstOutputData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FVW_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(FVW_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%W)) then + LB(1:1) = lbound(OutputData%W) + UB(1:1) = ubound(OutputData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_OutputType(OutputData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%W) + end if +end subroutine + +subroutine FVW_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_OutputType(Buf, InData%W(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_OutputType(Buf, OutData%W(i1)) ! W + end do + end if +end subroutine + +subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_MiscVarType), intent(in) :: SrcWng_MiscVarTypeData + type(Wng_MiscVarType), intent(inout) :: DstWng_MiscVarTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_MiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_MiscVarTypeData%LE)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%LE) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%LE) + if (.not. allocated(DstWng_MiscVarTypeData%LE)) then + allocate(DstWng_MiscVarTypeData%LE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%LE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%LE = SrcWng_MiscVarTypeData%LE + end if + if (allocated(SrcWng_MiscVarTypeData%TE)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%TE) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%TE) + if (.not. allocated(DstWng_MiscVarTypeData%TE)) then + allocate(DstWng_MiscVarTypeData%TE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%TE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%TE = SrcWng_MiscVarTypeData%TE + end if + if (allocated(SrcWng_MiscVarTypeData%r_LL)) then + LB(1:3) = lbound(SrcWng_MiscVarTypeData%r_LL) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%r_LL) + if (.not. allocated(DstWng_MiscVarTypeData%r_LL)) then + allocate(DstWng_MiscVarTypeData%r_LL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%r_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%r_LL = SrcWng_MiscVarTypeData%r_LL + end if + if (allocated(SrcWng_MiscVarTypeData%CP)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%CP) + if (.not. allocated(DstWng_MiscVarTypeData%CP)) then + allocate(DstWng_MiscVarTypeData%CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%CP = SrcWng_MiscVarTypeData%CP + end if + if (allocated(SrcWng_MiscVarTypeData%Tang)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Tang) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Tang) + if (.not. allocated(DstWng_MiscVarTypeData%Tang)) then + allocate(DstWng_MiscVarTypeData%Tang(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Tang.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Tang = SrcWng_MiscVarTypeData%Tang + end if + if (allocated(SrcWng_MiscVarTypeData%Norm)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Norm) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Norm) + if (.not. allocated(DstWng_MiscVarTypeData%Norm)) then + allocate(DstWng_MiscVarTypeData%Norm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Norm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Norm = SrcWng_MiscVarTypeData%Norm + end if + if (allocated(SrcWng_MiscVarTypeData%Orth)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Orth) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Orth) + if (.not. allocated(DstWng_MiscVarTypeData%Orth)) then + allocate(DstWng_MiscVarTypeData%Orth(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Orth.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Orth = SrcWng_MiscVarTypeData%Orth + end if + if (allocated(SrcWng_MiscVarTypeData%dl)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%dl) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%dl) + if (.not. allocated(DstWng_MiscVarTypeData%dl)) then + allocate(DstWng_MiscVarTypeData%dl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%dl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%dl = SrcWng_MiscVarTypeData%dl + end if + if (allocated(SrcWng_MiscVarTypeData%Area)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%Area) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%Area) + if (.not. allocated(DstWng_MiscVarTypeData%Area)) then + allocate(DstWng_MiscVarTypeData%Area(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Area.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Area = SrcWng_MiscVarTypeData%Area + end if + if (allocated(SrcWng_MiscVarTypeData%diag_LL)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%diag_LL) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%diag_LL) + if (.not. allocated(DstWng_MiscVarTypeData%diag_LL)) then + allocate(DstWng_MiscVarTypeData%diag_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%diag_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%diag_LL = SrcWng_MiscVarTypeData%diag_LL + end if + if (allocated(SrcWng_MiscVarTypeData%Vind_CP)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_CP) + if (.not. allocated(DstWng_MiscVarTypeData%Vind_CP)) then + allocate(DstWng_MiscVarTypeData%Vind_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vind_CP = SrcWng_MiscVarTypeData%Vind_CP + end if + if (allocated(SrcWng_MiscVarTypeData%Vtot_CP)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vtot_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vtot_CP) + if (.not. allocated(DstWng_MiscVarTypeData%Vtot_CP)) then + allocate(DstWng_MiscVarTypeData%Vtot_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vtot_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vtot_CP = SrcWng_MiscVarTypeData%Vtot_CP + end if + if (allocated(SrcWng_MiscVarTypeData%Vstr_CP)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vstr_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vstr_CP) + if (.not. allocated(DstWng_MiscVarTypeData%Vstr_CP)) then + allocate(DstWng_MiscVarTypeData%Vstr_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vstr_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vstr_CP = SrcWng_MiscVarTypeData%Vstr_CP + end if + if (allocated(SrcWng_MiscVarTypeData%Vwnd_CP)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vwnd_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vwnd_CP) + if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_CP)) then + allocate(DstWng_MiscVarTypeData%Vwnd_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vwnd_CP = SrcWng_MiscVarTypeData%Vwnd_CP + end if + if (allocated(SrcWng_MiscVarTypeData%Vwnd_NW)) then + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_NW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_NW) + if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_NW)) then + allocate(DstWng_MiscVarTypeData%Vwnd_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_NW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vwnd_NW = SrcWng_MiscVarTypeData%Vwnd_NW + end if + if (allocated(SrcWng_MiscVarTypeData%Vwnd_FW)) then + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_FW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_FW) + if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_FW)) then + allocate(DstWng_MiscVarTypeData%Vwnd_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_FW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vwnd_FW = SrcWng_MiscVarTypeData%Vwnd_FW + end if + if (allocated(SrcWng_MiscVarTypeData%Vind_NW)) then + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_NW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_NW) + if (.not. allocated(DstWng_MiscVarTypeData%Vind_NW)) then + allocate(DstWng_MiscVarTypeData%Vind_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_NW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vind_NW = SrcWng_MiscVarTypeData%Vind_NW + end if + if (allocated(SrcWng_MiscVarTypeData%Vind_FW)) then + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_FW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_FW) + if (.not. allocated(DstWng_MiscVarTypeData%Vind_FW)) then + allocate(DstWng_MiscVarTypeData%Vind_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_FW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vind_FW = SrcWng_MiscVarTypeData%Vind_FW + end if + if (allocated(SrcWng_MiscVarTypeData%PitchAndTwist)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%PitchAndTwist) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%PitchAndTwist) + if (.not. allocated(DstWng_MiscVarTypeData%PitchAndTwist)) then + allocate(DstWng_MiscVarTypeData%PitchAndTwist(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%PitchAndTwist.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%PitchAndTwist = SrcWng_MiscVarTypeData%PitchAndTwist + end if + DstWng_MiscVarTypeData%iTip = SrcWng_MiscVarTypeData%iTip + DstWng_MiscVarTypeData%iRoot = SrcWng_MiscVarTypeData%iRoot + if (allocated(SrcWng_MiscVarTypeData%alpha_LL)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%alpha_LL) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%alpha_LL) + if (.not. allocated(DstWng_MiscVarTypeData%alpha_LL)) then + allocate(DstWng_MiscVarTypeData%alpha_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%alpha_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%alpha_LL = SrcWng_MiscVarTypeData%alpha_LL + end if + if (allocated(SrcWng_MiscVarTypeData%Vreln_LL)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%Vreln_LL) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%Vreln_LL) + if (.not. allocated(DstWng_MiscVarTypeData%Vreln_LL)) then + allocate(DstWng_MiscVarTypeData%Vreln_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vreln_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vreln_LL = SrcWng_MiscVarTypeData%Vreln_LL + end if + if (allocated(SrcWng_MiscVarTypeData%u_UA)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%u_UA) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%u_UA) + if (.not. allocated(DstWng_MiscVarTypeData%u_UA)) then + allocate(DstWng_MiscVarTypeData%u_UA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%u_UA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_CopyInput(SrcWng_MiscVarTypeData%u_UA(i1,i2), DstWng_MiscVarTypeData%u_UA(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + call UA_CopyMisc(SrcWng_MiscVarTypeData%m_UA, DstWng_MiscVarTypeData%m_UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call UA_CopyOutput(SrcWng_MiscVarTypeData%y_UA, DstWng_MiscVarTypeData%y_UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call UA_CopyParam(SrcWng_MiscVarTypeData%p_UA, DstWng_MiscVarTypeData%p_UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcWng_MiscVarTypeData%Vind_LL)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_LL) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_LL) + if (.not. allocated(DstWng_MiscVarTypeData%Vind_LL)) then + allocate(DstWng_MiscVarTypeData%Vind_LL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vind_LL = SrcWng_MiscVarTypeData%Vind_LL + end if + if (allocated(SrcWng_MiscVarTypeData%BN_AxInd)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_AxInd) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_AxInd) + if (.not. allocated(DstWng_MiscVarTypeData%BN_AxInd)) then + allocate(DstWng_MiscVarTypeData%BN_AxInd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_AxInd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_AxInd = SrcWng_MiscVarTypeData%BN_AxInd + end if + if (allocated(SrcWng_MiscVarTypeData%BN_TanInd)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_TanInd) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_TanInd) + if (.not. allocated(DstWng_MiscVarTypeData%BN_TanInd)) then + allocate(DstWng_MiscVarTypeData%BN_TanInd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_TanInd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_TanInd = SrcWng_MiscVarTypeData%BN_TanInd + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Vrel)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Vrel) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Vrel) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Vrel)) then + allocate(DstWng_MiscVarTypeData%BN_Vrel(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Vrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Vrel = SrcWng_MiscVarTypeData%BN_Vrel + end if + if (allocated(SrcWng_MiscVarTypeData%BN_alpha)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_alpha) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_alpha) + if (.not. allocated(DstWng_MiscVarTypeData%BN_alpha)) then + allocate(DstWng_MiscVarTypeData%BN_alpha(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_alpha.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_alpha = SrcWng_MiscVarTypeData%BN_alpha + end if + if (allocated(SrcWng_MiscVarTypeData%BN_phi)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_phi) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_phi) + if (.not. allocated(DstWng_MiscVarTypeData%BN_phi)) then + allocate(DstWng_MiscVarTypeData%BN_phi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_phi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_phi = SrcWng_MiscVarTypeData%BN_phi + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Re)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Re) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Re) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Re)) then + allocate(DstWng_MiscVarTypeData%BN_Re(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Re.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Re = SrcWng_MiscVarTypeData%BN_Re + end if + if (allocated(SrcWng_MiscVarTypeData%BN_URelWind_s)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%BN_URelWind_s) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%BN_URelWind_s) + if (.not. allocated(DstWng_MiscVarTypeData%BN_URelWind_s)) then + allocate(DstWng_MiscVarTypeData%BN_URelWind_s(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_URelWind_s.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_URelWind_s = SrcWng_MiscVarTypeData%BN_URelWind_s + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cl_Static)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl_Static) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl_Static) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cl_Static)) then + allocate(DstWng_MiscVarTypeData%BN_Cl_Static(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cl_Static.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cl_Static = SrcWng_MiscVarTypeData%BN_Cl_Static + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cd_Static)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd_Static) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd_Static) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cd_Static)) then + allocate(DstWng_MiscVarTypeData%BN_Cd_Static(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cd_Static.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cd_Static = SrcWng_MiscVarTypeData%BN_Cd_Static + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cm_Static)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm_Static) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm_Static) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cm_Static)) then + allocate(DstWng_MiscVarTypeData%BN_Cm_Static(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cm_Static.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cm_Static = SrcWng_MiscVarTypeData%BN_Cm_Static + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cpmin)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cpmin) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cpmin) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cpmin)) then + allocate(DstWng_MiscVarTypeData%BN_Cpmin(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cpmin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cpmin = SrcWng_MiscVarTypeData%BN_Cpmin + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cl)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cl)) then + allocate(DstWng_MiscVarTypeData%BN_Cl(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cl = SrcWng_MiscVarTypeData%BN_Cl + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cd)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cd)) then + allocate(DstWng_MiscVarTypeData%BN_Cd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cd = SrcWng_MiscVarTypeData%BN_Cd + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cm)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cm)) then + allocate(DstWng_MiscVarTypeData%BN_Cm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cm = SrcWng_MiscVarTypeData%BN_Cm + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cx)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cx) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cx) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cx)) then + allocate(DstWng_MiscVarTypeData%BN_Cx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cx = SrcWng_MiscVarTypeData%BN_Cx + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cy)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cy) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cy) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cy)) then + allocate(DstWng_MiscVarTypeData%BN_Cy(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cy = SrcWng_MiscVarTypeData%BN_Cy + end if +end subroutine + +subroutine FVW_DestroyWng_MiscVarType(Wng_MiscVarTypeData, ErrStat, ErrMsg) + type(Wng_MiscVarType), intent(inout) :: Wng_MiscVarTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyWng_MiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_MiscVarTypeData%LE)) then + deallocate(Wng_MiscVarTypeData%LE) + end if + if (allocated(Wng_MiscVarTypeData%TE)) then + deallocate(Wng_MiscVarTypeData%TE) + end if + if (allocated(Wng_MiscVarTypeData%r_LL)) then + deallocate(Wng_MiscVarTypeData%r_LL) + end if + if (allocated(Wng_MiscVarTypeData%CP)) then + deallocate(Wng_MiscVarTypeData%CP) + end if + if (allocated(Wng_MiscVarTypeData%Tang)) then + deallocate(Wng_MiscVarTypeData%Tang) + end if + if (allocated(Wng_MiscVarTypeData%Norm)) then + deallocate(Wng_MiscVarTypeData%Norm) + end if + if (allocated(Wng_MiscVarTypeData%Orth)) then + deallocate(Wng_MiscVarTypeData%Orth) + end if + if (allocated(Wng_MiscVarTypeData%dl)) then + deallocate(Wng_MiscVarTypeData%dl) + end if + if (allocated(Wng_MiscVarTypeData%Area)) then + deallocate(Wng_MiscVarTypeData%Area) + end if + if (allocated(Wng_MiscVarTypeData%diag_LL)) then + deallocate(Wng_MiscVarTypeData%diag_LL) + end if + if (allocated(Wng_MiscVarTypeData%Vind_CP)) then + deallocate(Wng_MiscVarTypeData%Vind_CP) + end if + if (allocated(Wng_MiscVarTypeData%Vtot_CP)) then + deallocate(Wng_MiscVarTypeData%Vtot_CP) + end if + if (allocated(Wng_MiscVarTypeData%Vstr_CP)) then + deallocate(Wng_MiscVarTypeData%Vstr_CP) + end if + if (allocated(Wng_MiscVarTypeData%Vwnd_CP)) then + deallocate(Wng_MiscVarTypeData%Vwnd_CP) + end if + if (allocated(Wng_MiscVarTypeData%Vwnd_NW)) then + deallocate(Wng_MiscVarTypeData%Vwnd_NW) + end if + if (allocated(Wng_MiscVarTypeData%Vwnd_FW)) then + deallocate(Wng_MiscVarTypeData%Vwnd_FW) + end if + if (allocated(Wng_MiscVarTypeData%Vind_NW)) then + deallocate(Wng_MiscVarTypeData%Vind_NW) + end if + if (allocated(Wng_MiscVarTypeData%Vind_FW)) then + deallocate(Wng_MiscVarTypeData%Vind_FW) + end if + if (allocated(Wng_MiscVarTypeData%PitchAndTwist)) then + deallocate(Wng_MiscVarTypeData%PitchAndTwist) + end if + if (allocated(Wng_MiscVarTypeData%alpha_LL)) then + deallocate(Wng_MiscVarTypeData%alpha_LL) + end if + if (allocated(Wng_MiscVarTypeData%Vreln_LL)) then + deallocate(Wng_MiscVarTypeData%Vreln_LL) + end if + if (allocated(Wng_MiscVarTypeData%u_UA)) then + LB(1:2) = lbound(Wng_MiscVarTypeData%u_UA) + UB(1:2) = ubound(Wng_MiscVarTypeData%u_UA) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_DestroyInput(Wng_MiscVarTypeData%u_UA(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(Wng_MiscVarTypeData%u_UA) + end if + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + end if + if (allocated(Wng_MiscVarTypeData%BN_AxInd)) then + deallocate(Wng_MiscVarTypeData%BN_AxInd) + end if + if (allocated(Wng_MiscVarTypeData%BN_TanInd)) then + deallocate(Wng_MiscVarTypeData%BN_TanInd) + end if + if (allocated(Wng_MiscVarTypeData%BN_Vrel)) then + deallocate(Wng_MiscVarTypeData%BN_Vrel) + end if + if (allocated(Wng_MiscVarTypeData%BN_alpha)) then + deallocate(Wng_MiscVarTypeData%BN_alpha) + end if + if (allocated(Wng_MiscVarTypeData%BN_phi)) then + deallocate(Wng_MiscVarTypeData%BN_phi) + end if + if (allocated(Wng_MiscVarTypeData%BN_Re)) then + deallocate(Wng_MiscVarTypeData%BN_Re) + end if + if (allocated(Wng_MiscVarTypeData%BN_URelWind_s)) then + deallocate(Wng_MiscVarTypeData%BN_URelWind_s) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cl_Static)) then + deallocate(Wng_MiscVarTypeData%BN_Cl_Static) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cd_Static)) then + deallocate(Wng_MiscVarTypeData%BN_Cd_Static) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cm_Static)) then + deallocate(Wng_MiscVarTypeData%BN_Cm_Static) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cpmin)) then + deallocate(Wng_MiscVarTypeData%BN_Cpmin) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cl)) then + deallocate(Wng_MiscVarTypeData%BN_Cl) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cd)) then + deallocate(Wng_MiscVarTypeData%BN_Cd) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cm)) then + deallocate(Wng_MiscVarTypeData%BN_Cm) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cx)) then + deallocate(Wng_MiscVarTypeData%BN_Cx) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cy)) then + deallocate(Wng_MiscVarTypeData%BN_Cy) + end if +end subroutine + +subroutine FVW_PackWng_MiscVarType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wng_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_MiscVarType' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%LE)) + if (allocated(InData%LE)) then + call RegPackBounds(Buf, 2, lbound(InData%LE), ubound(InData%LE)) + call RegPack(Buf, InData%LE) + end if + call RegPack(Buf, allocated(InData%TE)) + if (allocated(InData%TE)) then + call RegPackBounds(Buf, 2, lbound(InData%TE), ubound(InData%TE)) + call RegPack(Buf, InData%TE) + end if + call RegPack(Buf, allocated(InData%r_LL)) + if (allocated(InData%r_LL)) then + call RegPackBounds(Buf, 3, lbound(InData%r_LL), ubound(InData%r_LL)) + call RegPack(Buf, InData%r_LL) + end if + call RegPack(Buf, allocated(InData%CP)) + if (allocated(InData%CP)) then + call RegPackBounds(Buf, 2, lbound(InData%CP), ubound(InData%CP)) + call RegPack(Buf, InData%CP) + end if + call RegPack(Buf, allocated(InData%Tang)) + if (allocated(InData%Tang)) then + call RegPackBounds(Buf, 2, lbound(InData%Tang), ubound(InData%Tang)) + call RegPack(Buf, InData%Tang) + end if + call RegPack(Buf, allocated(InData%Norm)) + if (allocated(InData%Norm)) then + call RegPackBounds(Buf, 2, lbound(InData%Norm), ubound(InData%Norm)) + call RegPack(Buf, InData%Norm) + end if + call RegPack(Buf, allocated(InData%Orth)) + if (allocated(InData%Orth)) then + call RegPackBounds(Buf, 2, lbound(InData%Orth), ubound(InData%Orth)) + call RegPack(Buf, InData%Orth) + end if + call RegPack(Buf, allocated(InData%dl)) + if (allocated(InData%dl)) then + call RegPackBounds(Buf, 2, lbound(InData%dl), ubound(InData%dl)) + call RegPack(Buf, InData%dl) + end if + call RegPack(Buf, allocated(InData%Area)) + if (allocated(InData%Area)) then + call RegPackBounds(Buf, 1, lbound(InData%Area), ubound(InData%Area)) + call RegPack(Buf, InData%Area) + end if + call RegPack(Buf, allocated(InData%diag_LL)) + if (allocated(InData%diag_LL)) then + call RegPackBounds(Buf, 1, lbound(InData%diag_LL), ubound(InData%diag_LL)) + call RegPack(Buf, InData%diag_LL) + end if + call RegPack(Buf, allocated(InData%Vind_CP)) + if (allocated(InData%Vind_CP)) then + call RegPackBounds(Buf, 2, lbound(InData%Vind_CP), ubound(InData%Vind_CP)) + call RegPack(Buf, InData%Vind_CP) + end if + call RegPack(Buf, allocated(InData%Vtot_CP)) + if (allocated(InData%Vtot_CP)) then + call RegPackBounds(Buf, 2, lbound(InData%Vtot_CP), ubound(InData%Vtot_CP)) + call RegPack(Buf, InData%Vtot_CP) + end if + call RegPack(Buf, allocated(InData%Vstr_CP)) + if (allocated(InData%Vstr_CP)) then + call RegPackBounds(Buf, 2, lbound(InData%Vstr_CP), ubound(InData%Vstr_CP)) + call RegPack(Buf, InData%Vstr_CP) + end if + call RegPack(Buf, allocated(InData%Vwnd_CP)) + if (allocated(InData%Vwnd_CP)) then + call RegPackBounds(Buf, 2, lbound(InData%Vwnd_CP), ubound(InData%Vwnd_CP)) + call RegPack(Buf, InData%Vwnd_CP) + end if + call RegPack(Buf, allocated(InData%Vwnd_NW)) + if (allocated(InData%Vwnd_NW)) then + call RegPackBounds(Buf, 3, lbound(InData%Vwnd_NW), ubound(InData%Vwnd_NW)) + call RegPack(Buf, InData%Vwnd_NW) + end if + call RegPack(Buf, allocated(InData%Vwnd_FW)) + if (allocated(InData%Vwnd_FW)) then + call RegPackBounds(Buf, 3, lbound(InData%Vwnd_FW), ubound(InData%Vwnd_FW)) + call RegPack(Buf, InData%Vwnd_FW) + end if + call RegPack(Buf, allocated(InData%Vind_NW)) + if (allocated(InData%Vind_NW)) then + call RegPackBounds(Buf, 3, lbound(InData%Vind_NW), ubound(InData%Vind_NW)) + call RegPack(Buf, InData%Vind_NW) + end if + call RegPack(Buf, allocated(InData%Vind_FW)) + if (allocated(InData%Vind_FW)) then + call RegPackBounds(Buf, 3, lbound(InData%Vind_FW), ubound(InData%Vind_FW)) + call RegPack(Buf, InData%Vind_FW) + end if + call RegPack(Buf, allocated(InData%PitchAndTwist)) + if (allocated(InData%PitchAndTwist)) then + call RegPackBounds(Buf, 1, lbound(InData%PitchAndTwist), ubound(InData%PitchAndTwist)) + call RegPack(Buf, InData%PitchAndTwist) + end if + call RegPack(Buf, InData%iTip) + call RegPack(Buf, InData%iRoot) + call RegPack(Buf, allocated(InData%alpha_LL)) + if (allocated(InData%alpha_LL)) then + call RegPackBounds(Buf, 1, lbound(InData%alpha_LL), ubound(InData%alpha_LL)) + call RegPack(Buf, InData%alpha_LL) + end if + call RegPack(Buf, allocated(InData%Vreln_LL)) + if (allocated(InData%Vreln_LL)) then + call RegPackBounds(Buf, 1, lbound(InData%Vreln_LL), ubound(InData%Vreln_LL)) + call RegPack(Buf, InData%Vreln_LL) + end if + call RegPack(Buf, allocated(InData%u_UA)) + if (allocated(InData%u_UA)) then + call RegPackBounds(Buf, 2, lbound(InData%u_UA), ubound(InData%u_UA)) + LB(1:2) = lbound(InData%u_UA) + UB(1:2) = ubound(InData%u_UA) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_PackInput(Buf, InData%u_UA(i1,i2)) + end do + end do + end if + call UA_PackMisc(Buf, InData%m_UA) + call UA_PackOutput(Buf, InData%y_UA) + call UA_PackParam(Buf, InData%p_UA) + call RegPack(Buf, allocated(InData%Vind_LL)) + if (allocated(InData%Vind_LL)) then + call RegPackBounds(Buf, 2, lbound(InData%Vind_LL), ubound(InData%Vind_LL)) + call RegPack(Buf, InData%Vind_LL) + end if + call RegPack(Buf, allocated(InData%BN_AxInd)) + if (allocated(InData%BN_AxInd)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_AxInd), ubound(InData%BN_AxInd)) + call RegPack(Buf, InData%BN_AxInd) + end if + call RegPack(Buf, allocated(InData%BN_TanInd)) + if (allocated(InData%BN_TanInd)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_TanInd), ubound(InData%BN_TanInd)) + call RegPack(Buf, InData%BN_TanInd) + end if + call RegPack(Buf, allocated(InData%BN_Vrel)) + if (allocated(InData%BN_Vrel)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Vrel), ubound(InData%BN_Vrel)) + call RegPack(Buf, InData%BN_Vrel) + end if + call RegPack(Buf, allocated(InData%BN_alpha)) + if (allocated(InData%BN_alpha)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_alpha), ubound(InData%BN_alpha)) + call RegPack(Buf, InData%BN_alpha) + end if + call RegPack(Buf, allocated(InData%BN_phi)) + if (allocated(InData%BN_phi)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_phi), ubound(InData%BN_phi)) + call RegPack(Buf, InData%BN_phi) + end if + call RegPack(Buf, allocated(InData%BN_Re)) + if (allocated(InData%BN_Re)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Re), ubound(InData%BN_Re)) + call RegPack(Buf, InData%BN_Re) + end if + call RegPack(Buf, allocated(InData%BN_URelWind_s)) + if (allocated(InData%BN_URelWind_s)) then + call RegPackBounds(Buf, 2, lbound(InData%BN_URelWind_s), ubound(InData%BN_URelWind_s)) + call RegPack(Buf, InData%BN_URelWind_s) + end if + call RegPack(Buf, allocated(InData%BN_Cl_Static)) + if (allocated(InData%BN_Cl_Static)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cl_Static), ubound(InData%BN_Cl_Static)) + call RegPack(Buf, InData%BN_Cl_Static) + end if + call RegPack(Buf, allocated(InData%BN_Cd_Static)) + if (allocated(InData%BN_Cd_Static)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cd_Static), ubound(InData%BN_Cd_Static)) + call RegPack(Buf, InData%BN_Cd_Static) + end if + call RegPack(Buf, allocated(InData%BN_Cm_Static)) + if (allocated(InData%BN_Cm_Static)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cm_Static), ubound(InData%BN_Cm_Static)) + call RegPack(Buf, InData%BN_Cm_Static) + end if + call RegPack(Buf, allocated(InData%BN_Cpmin)) + if (allocated(InData%BN_Cpmin)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cpmin), ubound(InData%BN_Cpmin)) + call RegPack(Buf, InData%BN_Cpmin) + end if + call RegPack(Buf, allocated(InData%BN_Cl)) + if (allocated(InData%BN_Cl)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cl), ubound(InData%BN_Cl)) + call RegPack(Buf, InData%BN_Cl) + end if + call RegPack(Buf, allocated(InData%BN_Cd)) + if (allocated(InData%BN_Cd)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cd), ubound(InData%BN_Cd)) + call RegPack(Buf, InData%BN_Cd) + end if + call RegPack(Buf, allocated(InData%BN_Cm)) + if (allocated(InData%BN_Cm)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cm), ubound(InData%BN_Cm)) + call RegPack(Buf, InData%BN_Cm) + end if + call RegPack(Buf, allocated(InData%BN_Cx)) + if (allocated(InData%BN_Cx)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cx), ubound(InData%BN_Cx)) + call RegPack(Buf, InData%BN_Cx) + end if + call RegPack(Buf, allocated(InData%BN_Cy)) + if (allocated(InData%BN_Cy)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cy), ubound(InData%BN_Cy)) + call RegPack(Buf, InData%BN_Cy) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wng_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_MiscVarType' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%LE)) deallocate(OutData%LE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TE)) deallocate(OutData%TE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%r_LL)) deallocate(OutData%r_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_LL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CP)) deallocate(OutData%CP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Tang)) deallocate(OutData%Tang) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Tang(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tang.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Tang) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Norm)) deallocate(OutData%Norm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Norm(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Norm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Norm) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Orth)) deallocate(OutData%Orth) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Orth(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Orth.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Orth) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dl)) deallocate(OutData%dl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dl(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dl) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Area)) deallocate(OutData%Area) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Area(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Area.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Area) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%diag_LL)) deallocate(OutData%diag_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%diag_LL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%diag_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%diag_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vind_CP)) deallocate(OutData%Vind_CP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vind_CP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vind_CP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vtot_CP)) deallocate(OutData%Vtot_CP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vtot_CP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vtot_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vtot_CP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vstr_CP)) deallocate(OutData%Vstr_CP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vstr_CP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vstr_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vstr_CP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vwnd_CP)) deallocate(OutData%Vwnd_CP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vwnd_CP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vwnd_CP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vwnd_NW)) deallocate(OutData%Vwnd_NW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vwnd_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_NW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vwnd_NW) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vwnd_FW)) deallocate(OutData%Vwnd_FW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vwnd_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_FW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vwnd_FW) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vind_NW)) deallocate(OutData%Vind_NW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vind_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_NW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vind_NW) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vind_FW)) deallocate(OutData%Vind_FW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vind_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_FW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vind_FW) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PitchAndTwist)) deallocate(OutData%PitchAndTwist) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PitchAndTwist(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAndTwist.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PitchAndTwist) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%iTip) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%iRoot) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%alpha_LL)) deallocate(OutData%alpha_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_LL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vreln_LL)) deallocate(OutData%Vreln_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vreln_LL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vreln_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vreln_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%u_UA)) deallocate(OutData%u_UA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_UA(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_UnpackInput(Buf, OutData%u_UA(i1,i2)) ! u_UA + end do + end do + end if + call UA_UnpackMisc(Buf, OutData%m_UA) ! m_UA + call UA_UnpackOutput(Buf, OutData%y_UA) ! y_UA + call UA_UnpackParam(Buf, OutData%p_UA) ! p_UA + if (allocated(OutData%Vind_LL)) deallocate(OutData%Vind_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vind_LL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vind_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_AxInd)) deallocate(OutData%BN_AxInd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_AxInd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_AxInd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_AxInd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_TanInd)) deallocate(OutData%BN_TanInd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_TanInd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_TanInd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_TanInd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_Vrel)) deallocate(OutData%BN_Vrel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Vrel(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Vrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Vrel) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_alpha)) deallocate(OutData%BN_alpha) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_alpha(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_alpha.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_alpha) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_phi)) deallocate(OutData%BN_phi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_phi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_phi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_phi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_Re)) deallocate(OutData%BN_Re) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Re(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Re.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Re) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_URelWind_s)) deallocate(OutData%BN_URelWind_s) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_URelWind_s(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_URelWind_s.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_URelWind_s) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_Cl_Static)) deallocate(OutData%BN_Cl_Static) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cl_Static(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl_Static.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cl_Static) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_Cd_Static)) deallocate(OutData%BN_Cd_Static) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cd_Static(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd_Static.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cd_Static) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_Cm_Static)) deallocate(OutData%BN_Cm_Static) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cm_Static(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm_Static.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cm_Static) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_Cpmin)) deallocate(OutData%BN_Cpmin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cpmin(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cpmin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cpmin) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_Cl)) deallocate(OutData%BN_Cl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cl(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cl) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_Cd)) deallocate(OutData%BN_Cd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_Cm)) deallocate(OutData%BN_Cm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cm) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_Cx)) deallocate(OutData%BN_Cx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BN_Cy)) deallocate(OutData%BN_Cy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cy(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cy) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(FVW_MiscVarType), intent(in) :: SrcMiscData + type(FVW_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%W)) then + LB(1:1) = lbound(SrcMiscData%W) + UB(1:1) = ubound(SrcMiscData%W) + if (.not. allocated(DstMiscData%W)) then + allocate(DstMiscData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_MiscVarType(SrcMiscData%W(i1), DstMiscData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstMiscData%FirstCall = SrcMiscData%FirstCall + DstMiscData%nNW = SrcMiscData%nNW + DstMiscData%nFW = SrcMiscData%nFW + DstMiscData%iStep = SrcMiscData%iStep + DstMiscData%VTKstep = SrcMiscData%VTKstep + DstMiscData%VTKlastTime = SrcMiscData%VTKlastTime + if (allocated(SrcMiscData%r_wind)) then + LB(1:2) = lbound(SrcMiscData%r_wind) + UB(1:2) = ubound(SrcMiscData%r_wind) + if (.not. allocated(DstMiscData%r_wind)) then + allocate(DstMiscData%r_wind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_wind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%r_wind = SrcMiscData%r_wind + end if + DstMiscData%ComputeWakeInduced = SrcMiscData%ComputeWakeInduced + DstMiscData%OldWakeTime = SrcMiscData%OldWakeTime + call FVW_CopyContState(SrcMiscData%dxdt, DstMiscData%dxdt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyContState(SrcMiscData%x1, DstMiscData%x1, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyContState(SrcMiscData%x2, DstMiscData%x2, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%t1 = SrcMiscData%t1 + DstMiscData%t2 = SrcMiscData%t2 + DstMiscData%UA_Flag = SrcMiscData%UA_Flag + call FVW_CopyT_Sgmt(SrcMiscData%Sgmt, DstMiscData%Sgmt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyT_Part(SrcMiscData%Part, DstMiscData%Part, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%CPs)) then + LB(1:2) = lbound(SrcMiscData%CPs) + UB(1:2) = ubound(SrcMiscData%CPs) + if (.not. allocated(DstMiscData%CPs)) then + allocate(DstMiscData%CPs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CPs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CPs = SrcMiscData%CPs + end if + if (allocated(SrcMiscData%Uind)) then + LB(1:2) = lbound(SrcMiscData%Uind) + UB(1:2) = ubound(SrcMiscData%Uind) + if (.not. allocated(DstMiscData%Uind)) then + allocate(DstMiscData%Uind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Uind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Uind = SrcMiscData%Uind + end if + if (allocated(SrcMiscData%GridOutputs)) then + LB(1:1) = lbound(SrcMiscData%GridOutputs) + UB(1:1) = ubound(SrcMiscData%GridOutputs) + if (.not. allocated(DstMiscData%GridOutputs)) then + allocate(DstMiscData%GridOutputs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GridOutputs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyGridOutType(SrcMiscData%GridOutputs(i1), DstMiscData%GridOutputs(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FVW_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(FVW_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%W)) then + LB(1:1) = lbound(MiscData%W) + UB(1:1) = ubound(MiscData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_MiscVarType(MiscData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%W) + end if + if (allocated(MiscData%r_wind)) then + deallocate(MiscData%r_wind) + end if + call FVW_DestroyContState(MiscData%dxdt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyContState(MiscData%x1, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyContState(MiscData%x2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyT_Sgmt(MiscData%Sgmt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyT_Part(MiscData%Part, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%CPs)) then + deallocate(MiscData%CPs) + end if + if (allocated(MiscData%Uind)) then + deallocate(MiscData%Uind) + end if + if (allocated(MiscData%GridOutputs)) then + LB(1:1) = lbound(MiscData%GridOutputs) + UB(1:1) = ubound(MiscData%GridOutputs) + do i1 = LB(1), UB(1) + call FVW_DestroyGridOutType(MiscData%GridOutputs(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%GridOutputs) + end if +end subroutine + +subroutine FVW_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_MiscVarType(Buf, InData%W(i1)) + end do + end if + call RegPack(Buf, InData%FirstCall) + call RegPack(Buf, InData%nNW) + call RegPack(Buf, InData%nFW) + call RegPack(Buf, InData%iStep) + call RegPack(Buf, InData%VTKstep) + call RegPack(Buf, InData%VTKlastTime) + call RegPack(Buf, allocated(InData%r_wind)) + if (allocated(InData%r_wind)) then + call RegPackBounds(Buf, 2, lbound(InData%r_wind), ubound(InData%r_wind)) + call RegPack(Buf, InData%r_wind) + end if + call RegPack(Buf, InData%ComputeWakeInduced) + call RegPack(Buf, InData%OldWakeTime) + call FVW_PackContState(Buf, InData%dxdt) + call FVW_PackContState(Buf, InData%x1) + call FVW_PackContState(Buf, InData%x2) + call RegPack(Buf, InData%t1) + call RegPack(Buf, InData%t2) + call RegPack(Buf, InData%UA_Flag) + call FVW_PackT_Sgmt(Buf, InData%Sgmt) + call FVW_PackT_Part(Buf, InData%Part) + call RegPack(Buf, allocated(InData%CPs)) + if (allocated(InData%CPs)) then + call RegPackBounds(Buf, 2, lbound(InData%CPs), ubound(InData%CPs)) + call RegPack(Buf, InData%CPs) + end if + call RegPack(Buf, allocated(InData%Uind)) + if (allocated(InData%Uind)) then + call RegPackBounds(Buf, 2, lbound(InData%Uind), ubound(InData%Uind)) + call RegPack(Buf, InData%Uind) + end if + call RegPack(Buf, allocated(InData%GridOutputs)) + if (allocated(InData%GridOutputs)) then + call RegPackBounds(Buf, 1, lbound(InData%GridOutputs), ubound(InData%GridOutputs)) + LB(1:1) = lbound(InData%GridOutputs) + UB(1:1) = ubound(InData%GridOutputs) + do i1 = LB(1), UB(1) + call FVW_PackGridOutType(Buf, InData%GridOutputs(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_MiscVarType(Buf, OutData%W(i1)) ! W + end do + end if + call RegUnpack(Buf, OutData%FirstCall) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nNW) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nFW) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%iStep) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKstep) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKlastTime) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%r_wind)) deallocate(OutData%r_wind) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_wind(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_wind.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_wind) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%ComputeWakeInduced) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OldWakeTime) + if (RegCheckErr(Buf, RoutineName)) return + call FVW_UnpackContState(Buf, OutData%dxdt) ! dxdt + call FVW_UnpackContState(Buf, OutData%x1) ! x1 + call FVW_UnpackContState(Buf, OutData%x2) ! x2 + call RegUnpack(Buf, OutData%t1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%t2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UA_Flag) + if (RegCheckErr(Buf, RoutineName)) return + call FVW_UnpackT_Sgmt(Buf, OutData%Sgmt) ! Sgmt + call FVW_UnpackT_Part(Buf, OutData%Part) ! Part + if (allocated(OutData%CPs)) deallocate(OutData%CPs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CPs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CPs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CPs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Uind)) deallocate(OutData%Uind) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Uind(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Uind.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Uind) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%GridOutputs)) deallocate(OutData%GridOutputs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GridOutputs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GridOutputs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackGridOutType(Buf, OutData%GridOutputs(i1)) ! GridOutputs + end do + end if +end subroutine + +subroutine FVW_CopyRot_InputType(SrcRot_InputTypeData, DstRot_InputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Rot_InputType), intent(in) :: SrcRot_InputTypeData + type(Rot_InputType), intent(inout) :: DstRot_InputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_CopyRot_InputType' + ErrStat = ErrID_None + ErrMsg = '' + DstRot_InputTypeData%HubOrientation = SrcRot_InputTypeData%HubOrientation + DstRot_InputTypeData%HubPosition = SrcRot_InputTypeData%HubPosition +end subroutine + +subroutine FVW_DestroyRot_InputType(Rot_InputTypeData, ErrStat, ErrMsg) + type(Rot_InputType), intent(inout) :: Rot_InputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyRot_InputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FVW_PackRot_InputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Rot_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackRot_InputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%HubOrientation) + call RegPack(Buf, InData%HubPosition) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackRot_InputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Rot_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackRot_InputType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%HubOrientation) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubPosition) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_CopyWng_InputType(SrcWng_InputTypeData, DstWng_InputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_InputType), intent(in) :: SrcWng_InputTypeData + type(Wng_InputType), intent(inout) :: DstWng_InputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_InputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_InputTypeData%Vwnd_LL)) then + LB(1:2) = lbound(SrcWng_InputTypeData%Vwnd_LL) + UB(1:2) = ubound(SrcWng_InputTypeData%Vwnd_LL) + if (.not. allocated(DstWng_InputTypeData%Vwnd_LL)) then + allocate(DstWng_InputTypeData%Vwnd_LL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InputTypeData%Vwnd_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_InputTypeData%Vwnd_LL = SrcWng_InputTypeData%Vwnd_LL + end if + if (allocated(SrcWng_InputTypeData%omega_z)) then + LB(1:1) = lbound(SrcWng_InputTypeData%omega_z) + UB(1:1) = ubound(SrcWng_InputTypeData%omega_z) + if (.not. allocated(DstWng_InputTypeData%omega_z)) then + allocate(DstWng_InputTypeData%omega_z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InputTypeData%omega_z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_InputTypeData%omega_z = SrcWng_InputTypeData%omega_z + end if +end subroutine + +subroutine FVW_DestroyWng_InputType(Wng_InputTypeData, ErrStat, ErrMsg) + type(Wng_InputType), intent(inout) :: Wng_InputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_InputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_InputTypeData%Vwnd_LL)) then + deallocate(Wng_InputTypeData%Vwnd_LL) + end if + if (allocated(Wng_InputTypeData%omega_z)) then + deallocate(Wng_InputTypeData%omega_z) + end if +end subroutine + +subroutine FVW_PackWng_InputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wng_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_InputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Vwnd_LL)) + if (allocated(InData%Vwnd_LL)) then + call RegPackBounds(Buf, 2, lbound(InData%Vwnd_LL), ubound(InData%Vwnd_LL)) + call RegPack(Buf, InData%Vwnd_LL) + end if + call RegPack(Buf, allocated(InData%omega_z)) + if (allocated(InData%omega_z)) then + call RegPackBounds(Buf, 1, lbound(InData%omega_z), ubound(InData%omega_z)) + call RegPack(Buf, InData%omega_z) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_InputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wng_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_InputType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Vwnd_LL)) deallocate(OutData%Vwnd_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vwnd_LL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vwnd_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%omega_z)) deallocate(OutData%omega_z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%omega_z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%omega_z) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(FVW_InputType), intent(inout) :: SrcInputData + type(FVW_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%rotors)) then + LB(1:1) = lbound(SrcInputData%rotors) + UB(1:1) = ubound(SrcInputData%rotors) + if (.not. allocated(DstInputData%rotors)) then + allocate(DstInputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyRot_InputType(SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%W)) then + LB(1:1) = lbound(SrcInputData%W) + UB(1:1) = ubound(SrcInputData%W) + if (.not. allocated(DstInputData%W)) then + allocate(DstInputData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_InputType(SrcInputData%W(i1), DstInputData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%WingsMesh)) then + LB(1:1) = lbound(SrcInputData%WingsMesh) + UB(1:1) = ubound(SrcInputData%WingsMesh) + if (.not. allocated(DstInputData%WingsMesh)) then + allocate(DstInputData%WingsMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%WingsMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%WingsMesh(i1), DstInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%V_wind)) then + LB(1:2) = lbound(SrcInputData%V_wind) + UB(1:2) = ubound(SrcInputData%V_wind) + if (.not. allocated(DstInputData%V_wind)) then + allocate(DstInputData%V_wind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%V_wind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%V_wind = SrcInputData%V_wind + end if +end subroutine + +subroutine FVW_DestroyInput(InputData, ErrStat, ErrMsg) + type(FVW_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%rotors)) then + LB(1:1) = lbound(InputData%rotors) + UB(1:1) = ubound(InputData%rotors) + do i1 = LB(1), UB(1) + call FVW_DestroyRot_InputType(InputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%rotors) + end if + if (allocated(InputData%W)) then + LB(1:1) = lbound(InputData%W) + UB(1:1) = ubound(InputData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_InputType(InputData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%W) + end if + if (allocated(InputData%WingsMesh)) then + LB(1:1) = lbound(InputData%WingsMesh) + UB(1:1) = ubound(InputData%WingsMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%WingsMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%WingsMesh) + end if + if (allocated(InputData%V_wind)) then + deallocate(InputData%V_wind) + end if +end subroutine + +subroutine FVW_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call FVW_PackRot_InputType(Buf, InData%rotors(i1)) + end do + end if + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_InputType(Buf, InData%W(i1)) + end do + end if + call RegPack(Buf, allocated(InData%WingsMesh)) + if (allocated(InData%WingsMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) + LB(1:1) = lbound(InData%WingsMesh) + UB(1:1) = ubound(InData%WingsMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%WingsMesh(i1)) + end do + end if + call RegPack(Buf, allocated(InData%V_wind)) + if (allocated(InData%V_wind)) then + call RegPackBounds(Buf, 2, lbound(InData%V_wind), ubound(InData%V_wind)) + call RegPack(Buf, InData%V_wind) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackRot_InputType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_InputType(Buf, OutData%W(i1)) ! W + end do + end if + if (allocated(OutData%WingsMesh)) deallocate(OutData%WingsMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WingsMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%WingsMesh(i1)) ! WingsMesh + end do + end if + if (allocated(OutData%V_wind)) deallocate(OutData%V_wind) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V_wind(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_wind.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V_wind) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FVW_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(FVW_DiscreteStateType), intent(in) :: SrcDiscStateData + type(FVW_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%Dummy = SrcDiscStateData%Dummy + if (allocated(SrcDiscStateData%UA)) then + LB(1:1) = lbound(SrcDiscStateData%UA) + UB(1:1) = ubound(SrcDiscStateData%UA) + if (.not. allocated(DstDiscStateData%UA)) then + allocate(DstDiscStateData%UA(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%UA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call UA_CopyDiscState(SrcDiscStateData%UA(i1), DstDiscStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FVW_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(FVW_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%UA)) then + LB(1:1) = lbound(DiscStateData%UA) + UB(1:1) = ubound(DiscStateData%UA) + do i1 = LB(1), UB(1) + call UA_DestroyDiscState(DiscStateData%UA(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%UA) + end if +end subroutine + +subroutine FVW_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Dummy) + call RegPack(Buf, allocated(InData%UA)) + if (allocated(InData%UA)) then + call RegPackBounds(Buf, 1, lbound(InData%UA), ubound(InData%UA)) + LB(1:1) = lbound(InData%UA) + UB(1:1) = ubound(InData%UA) + do i1 = LB(1), UB(1) + call UA_PackDiscState(Buf, InData%UA(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%UA)) deallocate(OutData%UA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UA(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call UA_UnpackDiscState(Buf, OutData%UA(i1)) ! UA + end do + end if +end subroutine + +subroutine FVW_CopyWng_ConstraintStateType(SrcWng_ConstraintStateTypeData, DstWng_ConstraintStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_ConstraintStateType), intent(in) :: SrcWng_ConstraintStateTypeData + type(Wng_ConstraintStateType), intent(inout) :: DstWng_ConstraintStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_ConstraintStateType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_ConstraintStateTypeData%Gamma_LL)) then + LB(1:1) = lbound(SrcWng_ConstraintStateTypeData%Gamma_LL) + UB(1:1) = ubound(SrcWng_ConstraintStateTypeData%Gamma_LL) + if (.not. allocated(DstWng_ConstraintStateTypeData%Gamma_LL)) then + allocate(DstWng_ConstraintStateTypeData%Gamma_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ConstraintStateTypeData%Gamma_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ConstraintStateTypeData%Gamma_LL = SrcWng_ConstraintStateTypeData%Gamma_LL + end if +end subroutine + +subroutine FVW_DestroyWng_ConstraintStateType(Wng_ConstraintStateTypeData, ErrStat, ErrMsg) + type(Wng_ConstraintStateType), intent(inout) :: Wng_ConstraintStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_ConstraintStateType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_ConstraintStateTypeData%Gamma_LL)) then + deallocate(Wng_ConstraintStateTypeData%Gamma_LL) + end if +end subroutine + +subroutine FVW_PackWng_ConstraintStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wng_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_ConstraintStateType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Gamma_LL)) + if (allocated(InData%Gamma_LL)) then + call RegPackBounds(Buf, 1, lbound(InData%Gamma_LL), ubound(InData%Gamma_LL)) + call RegPack(Buf, InData%Gamma_LL) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_ConstraintStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wng_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_ConstraintStateType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Gamma_LL)) deallocate(OutData%Gamma_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Gamma_LL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Gamma_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FVW_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(FVW_ConstraintStateType), intent(in) :: SrcConstrStateData + type(FVW_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcConstrStateData%W)) then + LB(1:1) = lbound(SrcConstrStateData%W) + UB(1:1) = ubound(SrcConstrStateData%W) + if (.not. allocated(DstConstrStateData%W)) then + allocate(DstConstrStateData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_ConstraintStateType(SrcConstrStateData%W(i1), DstConstrStateData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstConstrStateData%residual = SrcConstrStateData%residual +end subroutine + +subroutine FVW_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(FVW_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConstrStateData%W)) then + LB(1:1) = lbound(ConstrStateData%W) + UB(1:1) = ubound(ConstrStateData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_ConstraintStateType(ConstrStateData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%W) + end if +end subroutine + +subroutine FVW_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_ConstraintStateType(Buf, InData%W(i1)) + end do + end if + call RegPack(Buf, InData%residual) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_ConstraintStateType(Buf, OutData%W(i1)) ! W + end do + end if + call RegUnpack(Buf, OutData%residual) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(FVW_OtherStateType), intent(in) :: SrcOtherStateData + type(FVW_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%Dummy = SrcOtherStateData%Dummy + if (allocated(SrcOtherStateData%UA)) then + LB(1:1) = lbound(SrcOtherStateData%UA) + UB(1:1) = ubound(SrcOtherStateData%UA) + if (.not. allocated(DstOtherStateData%UA)) then + allocate(DstOtherStateData%UA(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%UA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call UA_CopyOtherState(SrcOtherStateData%UA(i1), DstOtherStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FVW_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(FVW_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%UA)) then + LB(1:1) = lbound(OtherStateData%UA) + UB(1:1) = ubound(OtherStateData%UA) + do i1 = LB(1), UB(1) + call UA_DestroyOtherState(OtherStateData%UA(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%UA) + end if +end subroutine + +subroutine FVW_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Dummy) + call RegPack(Buf, allocated(InData%UA)) + if (allocated(InData%UA)) then + call RegPackBounds(Buf, 1, lbound(InData%UA), ubound(InData%UA)) + LB(1:1) = lbound(InData%UA) + UB(1:1) = ubound(InData%UA) + do i1 = LB(1), UB(1) + call UA_PackOtherState(Buf, InData%UA(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%UA)) deallocate(OutData%UA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UA(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call UA_UnpackOtherState(Buf, OutData%UA(i1)) ! UA + end do + end if +end subroutine + +subroutine FVW_CopyWng_InitInputType(SrcWng_InitInputTypeData, DstWng_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_InitInputType), intent(in) :: SrcWng_InitInputTypeData + type(Wng_InitInputType), intent(inout) :: DstWng_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_InitInputTypeData%AFindx)) then + LB(1:2) = lbound(SrcWng_InitInputTypeData%AFindx) + UB(1:2) = ubound(SrcWng_InitInputTypeData%AFindx) + if (.not. allocated(DstWng_InitInputTypeData%AFindx)) then + allocate(DstWng_InitInputTypeData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%AFindx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_InitInputTypeData%AFindx = SrcWng_InitInputTypeData%AFindx + end if + if (allocated(SrcWng_InitInputTypeData%chord)) then + LB(1:1) = lbound(SrcWng_InitInputTypeData%chord) + UB(1:1) = ubound(SrcWng_InitInputTypeData%chord) + if (.not. allocated(DstWng_InitInputTypeData%chord)) then + allocate(DstWng_InitInputTypeData%chord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%chord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_InitInputTypeData%chord = SrcWng_InitInputTypeData%chord + end if + if (allocated(SrcWng_InitInputTypeData%RElm)) then + LB(1:1) = lbound(SrcWng_InitInputTypeData%RElm) + UB(1:1) = ubound(SrcWng_InitInputTypeData%RElm) + if (.not. allocated(DstWng_InitInputTypeData%RElm)) then + allocate(DstWng_InitInputTypeData%RElm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%RElm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_InitInputTypeData%RElm = SrcWng_InitInputTypeData%RElm + end if + DstWng_InitInputTypeData%iRotor = SrcWng_InitInputTypeData%iRotor + DstWng_InitInputTypeData%UAOff_innerNode = SrcWng_InitInputTypeData%UAOff_innerNode + DstWng_InitInputTypeData%UAOff_outerNode = SrcWng_InitInputTypeData%UAOff_outerNode +end subroutine + +subroutine FVW_DestroyWng_InitInputType(Wng_InitInputTypeData, ErrStat, ErrMsg) + type(Wng_InitInputType), intent(inout) :: Wng_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_InitInputTypeData%AFindx)) then + deallocate(Wng_InitInputTypeData%AFindx) + end if + if (allocated(Wng_InitInputTypeData%chord)) then + deallocate(Wng_InitInputTypeData%chord) + end if + if (allocated(Wng_InitInputTypeData%RElm)) then + deallocate(Wng_InitInputTypeData%RElm) + end if +end subroutine + +subroutine FVW_PackWng_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wng_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%AFindx)) + if (allocated(InData%AFindx)) then + call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) + call RegPack(Buf, InData%AFindx) + end if + call RegPack(Buf, allocated(InData%chord)) + if (allocated(InData%chord)) then + call RegPackBounds(Buf, 1, lbound(InData%chord), ubound(InData%chord)) + call RegPack(Buf, InData%chord) + end if + call RegPack(Buf, allocated(InData%RElm)) + if (allocated(InData%RElm)) then + call RegPackBounds(Buf, 1, lbound(InData%RElm), ubound(InData%RElm)) + call RegPack(Buf, InData%RElm) + end if + call RegPack(Buf, InData%iRotor) + call RegPack(Buf, InData%UAOff_innerNode) + call RegPack(Buf, InData%UAOff_outerNode) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wng_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_InitInputType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFindx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFindx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%chord)) deallocate(OutData%chord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%chord(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%chord) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RElm)) deallocate(OutData%RElm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RElm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RElm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RElm) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%iRotor) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UAOff_innerNode) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UAOff_outerNode) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(FVW_InitInputType), intent(inout) :: SrcInitInputData + type(FVW_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%FVWFileName = SrcInitInputData%FVWFileName + DstInitInputData%RootName = SrcInitInputData%RootName + if (allocated(SrcInitInputData%W)) then + LB(1:1) = lbound(SrcInitInputData%W) + UB(1:1) = ubound(SrcInitInputData%W) + if (.not. allocated(DstInitInputData%W)) then + allocate(DstInitInputData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_InitInputType(SrcInitInputData%W(i1), DstInitInputData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInitInputData%WingsMesh)) then + LB(1:1) = lbound(SrcInitInputData%WingsMesh) + UB(1:1) = ubound(SrcInitInputData%WingsMesh) + if (.not. allocated(DstInitInputData%WingsMesh)) then + allocate(DstInitInputData%WingsMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WingsMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInitInputData%WingsMesh(i1), DstInitInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%numBladeNodes = SrcInitInputData%numBladeNodes + DstInitInputData%DTaero = SrcInitInputData%DTaero + DstInitInputData%KinVisc = SrcInitInputData%KinVisc + DstInitInputData%MHK = SrcInitInputData%MHK + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%UAMod = SrcInitInputData%UAMod + DstInitInputData%UA_Flag = SrcInitInputData%UA_Flag + DstInitInputData%Flookup = SrcInitInputData%Flookup + DstInitInputData%a_s = SrcInitInputData%a_s + DstInitInputData%SumPrint = SrcInitInputData%SumPrint +end subroutine + +subroutine FVW_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(FVW_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%W)) then + LB(1:1) = lbound(InitInputData%W) + UB(1:1) = ubound(InitInputData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_InitInputType(InitInputData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%W) + end if + if (allocated(InitInputData%WingsMesh)) then + LB(1:1) = lbound(InitInputData%WingsMesh) + UB(1:1) = ubound(InitInputData%WingsMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InitInputData%WingsMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%WingsMesh) + end if +end subroutine + +subroutine FVW_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackInitInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%FVWFileName) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_InitInputType(Buf, InData%W(i1)) + end do + end if + call RegPack(Buf, allocated(InData%WingsMesh)) + if (allocated(InData%WingsMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) + LB(1:1) = lbound(InData%WingsMesh) + UB(1:1) = ubound(InData%WingsMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%WingsMesh(i1)) + end do + end if + call RegPack(Buf, InData%numBladeNodes) + call RegPack(Buf, InData%DTaero) + call RegPack(Buf, InData%KinVisc) + call RegPack(Buf, InData%MHK) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%UAMod) + call RegPack(Buf, InData%UA_Flag) + call RegPack(Buf, InData%Flookup) + call RegPack(Buf, InData%a_s) + call RegPack(Buf, InData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackInitInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%FVWFileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_InitInputType(Buf, OutData%W(i1)) ! W + end do + end if + if (allocated(OutData%WingsMesh)) deallocate(OutData%WingsMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WingsMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%WingsMesh(i1)) ! WingsMesh + end do + end if + call RegUnpack(Buf, OutData%numBladeNodes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DTaero) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UAMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UA_Flag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Flookup) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%a_s) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(FVW_InputFile), intent(in) :: SrcInputFileData + type(FVW_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%CircSolvMethod = SrcInputFileData%CircSolvMethod + DstInputFileData%CirculationFile = SrcInputFileData%CirculationFile + DstInputFileData%CircSolvMaxIter = SrcInputFileData%CircSolvMaxIter + DstInputFileData%CircSolvConvCrit = SrcInputFileData%CircSolvConvCrit + DstInputFileData%CircSolvRelaxation = SrcInputFileData%CircSolvRelaxation + DstInputFileData%IntMethod = SrcInputFileData%IntMethod + DstInputFileData%FreeWake = SrcInputFileData%FreeWake + DstInputFileData%FreeWakeStart = SrcInputFileData%FreeWakeStart + DstInputFileData%FullCircStart = SrcInputFileData%FullCircStart + DstInputFileData%DTfvw = SrcInputFileData%DTfvw + DstInputFileData%CircSolvPolar = SrcInputFileData%CircSolvPolar + DstInputFileData%nNWPanels = SrcInputFileData%nNWPanels + DstInputFileData%nNWPanelsFree = SrcInputFileData%nNWPanelsFree + DstInputFileData%nFWPanels = SrcInputFileData%nFWPanels + DstInputFileData%nFWPanelsFree = SrcInputFileData%nFWPanelsFree + DstInputFileData%FWShedVorticity = SrcInputFileData%FWShedVorticity + DstInputFileData%DiffusionMethod = SrcInputFileData%DiffusionMethod + DstInputFileData%CoreSpreadEddyVisc = SrcInputFileData%CoreSpreadEddyVisc + DstInputFileData%RegDeterMethod = SrcInputFileData%RegDeterMethod + DstInputFileData%RegFunction = SrcInputFileData%RegFunction + DstInputFileData%WakeRegMethod = SrcInputFileData%WakeRegMethod + DstInputFileData%WakeRegParam = SrcInputFileData%WakeRegParam + DstInputFileData%WingRegParam = SrcInputFileData%WingRegParam + DstInputFileData%ShearModel = SrcInputFileData%ShearModel + DstInputFileData%TwrShadowOnWake = SrcInputFileData%TwrShadowOnWake + DstInputFileData%VelocityMethod = SrcInputFileData%VelocityMethod + DstInputFileData%TreeBranchFactor = SrcInputFileData%TreeBranchFactor + DstInputFileData%PartPerSegment = SrcInputFileData%PartPerSegment + DstInputFileData%WrVTK = SrcInputFileData%WrVTK + DstInputFileData%VTKBlades = SrcInputFileData%VTKBlades + DstInputFileData%DTvtk = SrcInputFileData%DTvtk + DstInputFileData%VTKCoord = SrcInputFileData%VTKCoord +end subroutine + +subroutine FVW_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(FVW_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FVW_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%CircSolvMethod) + call RegPack(Buf, InData%CirculationFile) + call RegPack(Buf, InData%CircSolvMaxIter) + call RegPack(Buf, InData%CircSolvConvCrit) + call RegPack(Buf, InData%CircSolvRelaxation) + call RegPack(Buf, InData%IntMethod) + call RegPack(Buf, InData%FreeWake) + call RegPack(Buf, InData%FreeWakeStart) + call RegPack(Buf, InData%FullCircStart) + call RegPack(Buf, InData%DTfvw) + call RegPack(Buf, InData%CircSolvPolar) + call RegPack(Buf, InData%nNWPanels) + call RegPack(Buf, InData%nNWPanelsFree) + call RegPack(Buf, InData%nFWPanels) + call RegPack(Buf, InData%nFWPanelsFree) + call RegPack(Buf, InData%FWShedVorticity) + call RegPack(Buf, InData%DiffusionMethod) + call RegPack(Buf, InData%CoreSpreadEddyVisc) + call RegPack(Buf, InData%RegDeterMethod) + call RegPack(Buf, InData%RegFunction) + call RegPack(Buf, InData%WakeRegMethod) + call RegPack(Buf, InData%WakeRegParam) + call RegPack(Buf, InData%WingRegParam) + call RegPack(Buf, InData%ShearModel) + call RegPack(Buf, InData%TwrShadowOnWake) + call RegPack(Buf, InData%VelocityMethod) + call RegPack(Buf, InData%TreeBranchFactor) + call RegPack(Buf, InData%PartPerSegment) + call RegPack(Buf, InData%WrVTK) + call RegPack(Buf, InData%VTKBlades) + call RegPack(Buf, InData%DTvtk) + call RegPack(Buf, InData%VTKCoord) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackInputFile' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%CircSolvMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CirculationFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CircSolvMaxIter) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CircSolvConvCrit) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CircSolvRelaxation) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IntMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FreeWake) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FreeWakeStart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FullCircStart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DTfvw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CircSolvPolar) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nNWPanels) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nNWPanelsFree) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nFWPanels) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nFWPanelsFree) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FWShedVorticity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DiffusionMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CoreSpreadEddyVisc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RegDeterMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RegFunction) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WakeRegMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WakeRegParam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WingRegParam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ShearModel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrShadowOnWake) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VelocityMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TreeBranchFactor) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PartPerSegment) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrVTK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKBlades) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DTvtk) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKCoord) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(FVW_InitOutputType), intent(in) :: SrcInitOutputData + type(FVW_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitOutputData%Dummy = SrcInitOutputData%Dummy +end subroutine + +subroutine FVW_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(FVW_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FVW_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_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(FVW_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(FVW_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 = 'FVW_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 FVW_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL FVW_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 FVW_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 FVW_Input_ExtrapInterp - - - SUBROUTINE FVW_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call FVW_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call FVW_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call FVW_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE FVW_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. @@ -11373,93 +5128,73 @@ SUBROUTINE FVW_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(FVW_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(FVW_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(FVW_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 + TYPE(FVW_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(FVW_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(FVW_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 = 'FVW_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 - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i2 = LBOUND(u_out%rotors(i01)%HubOrientation,2),UBOUND(u_out%rotors(i01)%HubOrientation,2) - DO i1 = LBOUND(u_out%rotors(i01)%HubOrientation,1),UBOUND(u_out%rotors(i01)%HubOrientation,1) - b = -(u1%rotors(i01)%HubOrientation(i1,i2) - u2%rotors(i01)%HubOrientation(i1,i2)) - u_out%rotors(i01)%HubOrientation(i1,i2) = u1%rotors(i01)%HubOrientation(i1,i2) + b * ScaleFactor - END DO - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%HubPosition,1),UBOUND(u_out%rotors(i01)%HubPosition,1) - b = -(u1%rotors(i01)%HubPosition(i1) - u2%rotors(i01)%HubPosition(i1)) - u_out%rotors(i01)%HubPosition(i1) = u1%rotors(i01)%HubPosition(i1) + b * ScaleFactor - END DO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) -IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN - DO i2 = LBOUND(u_out%W(i01)%Vwnd_LL,2),UBOUND(u_out%W(i01)%Vwnd_LL,2) - DO i1 = LBOUND(u_out%W(i01)%Vwnd_LL,1),UBOUND(u_out%W(i01)%Vwnd_LL,1) - b = -(u1%W(i01)%Vwnd_LL(i1,i2) - u2%W(i01)%Vwnd_LL(i1,i2)) - u_out%W(i01)%Vwnd_LL(i1,i2) = u1%W(i01)%Vwnd_LL(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) -IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN - DO i1 = LBOUND(u_out%W(i01)%omega_z,1),UBOUND(u_out%W(i01)%omega_z,1) - b = -(u1%W(i01)%omega_z(i1) - u2%W(i01)%omega_z(i1)) - u_out%W(i01)%omega_z(i1) = u1%W(i01)%omega_z(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN - DO i1 = LBOUND(u_out%WingsMesh,1),UBOUND(u_out%WingsMesh,1) - CALL MeshExtrapInterp1(u1%WingsMesh(i1), u2%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%V_wind) .AND. ALLOCATED(u1%V_wind)) THEN - DO i2 = LBOUND(u_out%V_wind,2),UBOUND(u_out%V_wind,2) - DO i1 = LBOUND(u_out%V_wind,1),UBOUND(u_out%V_wind,1) - b = -(u1%V_wind(i1,i2) - u2%V_wind(i1,i2)) - u_out%V_wind(i1,i2) = u1%V_wind(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE FVW_Input_ExtrapInterp1 - - - SUBROUTINE FVW_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%HubOrientation = a1*u1%rotors(i01)%HubOrientation + a2*u2%rotors(i01)%HubOrientation + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%HubPosition = a1*u1%rotors(i01)%HubPosition + a2*u2%rotors(i01)%HubPosition + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN + DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) + IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN + u_out%W(i01)%Vwnd_LL = a1*u1%W(i01)%Vwnd_LL + a2*u2%W(i01)%Vwnd_LL + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) + IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN + u_out%W(i01)%omega_z = a1*u1%W(i01)%omega_z + a2*u2%W(i01)%omega_z + END IF ! check if allocated + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN + DO i1 = LBOUND(u_out%WingsMesh,1),UBOUND(u_out%WingsMesh,1) + CALL MeshExtrapInterp1(u1%WingsMesh(i1), u2%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%V_wind) .AND. ALLOCATED(u1%V_wind)) THEN + u_out%V_wind = a1*u1%V_wind + a2*u2%V_wind + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE FVW_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. @@ -11473,158 +5208,133 @@ SUBROUTINE FVW_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(FVW_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(FVW_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(FVW_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(FVW_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 + TYPE(FVW_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(FVW_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(FVW_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(FVW_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 = 'FVW_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i2 = LBOUND(u_out%rotors(i01)%HubOrientation,2),UBOUND(u_out%rotors(i01)%HubOrientation,2) - DO i1 = LBOUND(u_out%rotors(i01)%HubOrientation,1),UBOUND(u_out%rotors(i01)%HubOrientation,1) - b = (t(3)**2*(u1%rotors(i01)%HubOrientation(i1,i2) - u2%rotors(i01)%HubOrientation(i1,i2)) + t(2)**2*(-u1%rotors(i01)%HubOrientation(i1,i2) + u3%rotors(i01)%HubOrientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%HubOrientation(i1,i2) + t(3)*u2%rotors(i01)%HubOrientation(i1,i2) - t(2)*u3%rotors(i01)%HubOrientation(i1,i2) ) * scaleFactor - u_out%rotors(i01)%HubOrientation(i1,i2) = u1%rotors(i01)%HubOrientation(i1,i2) + b + c * t_out - END DO - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%HubPosition,1),UBOUND(u_out%rotors(i01)%HubPosition,1) - b = (t(3)**2*(u1%rotors(i01)%HubPosition(i1) - u2%rotors(i01)%HubPosition(i1)) + t(2)**2*(-u1%rotors(i01)%HubPosition(i1) + u3%rotors(i01)%HubPosition(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%HubPosition(i1) + t(3)*u2%rotors(i01)%HubPosition(i1) - t(2)*u3%rotors(i01)%HubPosition(i1) ) * scaleFactor - u_out%rotors(i01)%HubPosition(i1) = u1%rotors(i01)%HubPosition(i1) + b + c * t_out - END DO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) -IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN - DO i2 = LBOUND(u_out%W(i01)%Vwnd_LL,2),UBOUND(u_out%W(i01)%Vwnd_LL,2) - DO i1 = LBOUND(u_out%W(i01)%Vwnd_LL,1),UBOUND(u_out%W(i01)%Vwnd_LL,1) - b = (t(3)**2*(u1%W(i01)%Vwnd_LL(i1,i2) - u2%W(i01)%Vwnd_LL(i1,i2)) + t(2)**2*(-u1%W(i01)%Vwnd_LL(i1,i2) + u3%W(i01)%Vwnd_LL(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%W(i01)%Vwnd_LL(i1,i2) + t(3)*u2%W(i01)%Vwnd_LL(i1,i2) - t(2)*u3%W(i01)%Vwnd_LL(i1,i2) ) * scaleFactor - u_out%W(i01)%Vwnd_LL(i1,i2) = u1%W(i01)%Vwnd_LL(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) -IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN - DO i1 = LBOUND(u_out%W(i01)%omega_z,1),UBOUND(u_out%W(i01)%omega_z,1) - b = (t(3)**2*(u1%W(i01)%omega_z(i1) - u2%W(i01)%omega_z(i1)) + t(2)**2*(-u1%W(i01)%omega_z(i1) + u3%W(i01)%omega_z(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%W(i01)%omega_z(i1) + t(3)*u2%W(i01)%omega_z(i1) - t(2)*u3%W(i01)%omega_z(i1) ) * scaleFactor - u_out%W(i01)%omega_z(i1) = u1%W(i01)%omega_z(i1) + b + c * t_out - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN - DO i1 = LBOUND(u_out%WingsMesh,1),UBOUND(u_out%WingsMesh,1) - CALL MeshExtrapInterp2(u1%WingsMesh(i1), u2%WingsMesh(i1), u3%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%V_wind) .AND. ALLOCATED(u1%V_wind)) THEN - DO i2 = LBOUND(u_out%V_wind,2),UBOUND(u_out%V_wind,2) - DO i1 = LBOUND(u_out%V_wind,1),UBOUND(u_out%V_wind,1) - b = (t(3)**2*(u1%V_wind(i1,i2) - u2%V_wind(i1,i2)) + t(2)**2*(-u1%V_wind(i1,i2) + u3%V_wind(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%V_wind(i1,i2) + t(3)*u2%V_wind(i1,i2) - t(2)*u3%V_wind(i1,i2) ) * scaleFactor - u_out%V_wind(i1,i2) = u1%V_wind(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE FVW_Input_ExtrapInterp2 - - - SUBROUTINE FVW_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(FVW_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(FVW_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%HubOrientation = a1*u1%rotors(i01)%HubOrientation + a2*u2%rotors(i01)%HubOrientation + a3*u3%rotors(i01)%HubOrientation + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%HubPosition = a1*u1%rotors(i01)%HubPosition + a2*u2%rotors(i01)%HubPosition + a3*u3%rotors(i01)%HubPosition + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN + DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) + IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN + u_out%W(i01)%Vwnd_LL = a1*u1%W(i01)%Vwnd_LL + a2*u2%W(i01)%Vwnd_LL + a3*u3%W(i01)%Vwnd_LL + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) + IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN + u_out%W(i01)%omega_z = a1*u1%W(i01)%omega_z + a2*u2%W(i01)%omega_z + a3*u3%W(i01)%omega_z + END IF ! check if allocated + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN + DO i1 = LBOUND(u_out%WingsMesh,1),UBOUND(u_out%WingsMesh,1) + CALL MeshExtrapInterp2(u1%WingsMesh(i1), u2%WingsMesh(i1), u3%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%V_wind) .AND. ALLOCATED(u1%V_wind)) THEN + u_out%V_wind = a1*u1%V_wind + a2*u2%V_wind + a3*u3%V_wind + END IF ! check if allocated +END SUBROUTINE + +subroutine FVW_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(FVW_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(FVW_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 = 'FVW_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 FVW_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL FVW_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 FVW_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 FVW_Output_ExtrapInterp - - - SUBROUTINE FVW_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'FVW_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call FVW_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call FVW_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call FVW_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE FVW_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. @@ -11636,55 +5346,51 @@ SUBROUTINE FVW_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(FVW_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(FVW_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(FVW_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 + TYPE(FVW_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(FVW_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(FVW_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 = 'FVW_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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%W) .AND. ALLOCATED(y1%W)) THEN - DO i01 = LBOUND(y_out%W,1),UBOUND(y_out%W,1) -IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN - DO i2 = LBOUND(y_out%W(i01)%Vind,2),UBOUND(y_out%W(i01)%Vind,2) - DO i1 = LBOUND(y_out%W(i01)%Vind,1),UBOUND(y_out%W(i01)%Vind,1) - b = -(y1%W(i01)%Vind(i1,i2) - y2%W(i01)%Vind(i1,i2)) - y_out%W(i01)%Vind(i1,i2) = y1%W(i01)%Vind(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated - END SUBROUTINE FVW_Output_ExtrapInterp1 - - - SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%W) .AND. ALLOCATED(y1%W)) THEN + DO i01 = LBOUND(y_out%W,1),UBOUND(y_out%W,1) + IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN + y_out%W(i01)%Vind = a1*y1%W(i01)%Vind + a2*y2%W(i01)%Vind + END IF ! check if allocated + END DO + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE FVW_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. @@ -11698,62 +5404,56 @@ SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(FVW_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(FVW_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(FVW_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(FVW_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 + TYPE(FVW_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(FVW_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(FVW_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(FVW_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 = 'FVW_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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%W) .AND. ALLOCATED(y1%W)) THEN - DO i01 = LBOUND(y_out%W,1),UBOUND(y_out%W,1) -IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN - DO i2 = LBOUND(y_out%W(i01)%Vind,2),UBOUND(y_out%W(i01)%Vind,2) - DO i1 = LBOUND(y_out%W(i01)%Vind,1),UBOUND(y_out%W(i01)%Vind,1) - b = (t(3)**2*(y1%W(i01)%Vind(i1,i2) - y2%W(i01)%Vind(i1,i2)) + t(2)**2*(-y1%W(i01)%Vind(i1,i2) + y3%W(i01)%Vind(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%W(i01)%Vind(i1,i2) + t(3)*y2%W(i01)%Vind(i1,i2) - t(2)*y3%W(i01)%Vind(i1,i2) ) * scaleFactor - y_out%W(i01)%Vind(i1,i2) = y1%W(i01)%Vind(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated - END SUBROUTINE FVW_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%W) .AND. ALLOCATED(y1%W)) THEN + DO i01 = LBOUND(y_out%W,1),UBOUND(y_out%W,1) + IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN + y_out%W(i01)%Vind = a1*y1%W(i01)%Vind + a2*y2%W(i01)%Vind + a3*y3%W(i01)%Vind + END IF ! check if allocated + END DO + END IF ! check if allocated +END SUBROUTINE END MODULE FVW_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 4702a51955..fa003b201c 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -43,14 +43,14 @@ MODULE UnsteadyAero_Types INTEGER(IntKi), PUBLIC, PARAMETER :: UA_BV = 7 ! Boeing-Vertol dynamic stall model (e.g. used in CACTUS) [-] ! ========= UA_InitInputType ======= TYPE, PUBLIC :: UA_InitInputType - REAL(DbKi) :: dt !< time step [s] + REAL(DbKi) :: dt = 0.0_R8Ki !< time step [s] CHARACTER(1024) :: OutRootName !< Supplied by Driver: The name of the root file (without extension) including the full path [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: c !< Chord length at node [m] - INTEGER(IntKi) :: numBlades !< Number nodes of all blades [-] - INTEGER(IntKi) :: nNodesPerBlade !< Number nodes per blades [-] - INTEGER(IntKi) :: UAMod !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] - REAL(ReKi) :: a_s !< speed of sound [m/s] - LOGICAL :: Flookup !< Use table lookup for f' and f'' [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< Number nodes of all blades [-] + INTEGER(IntKi) :: nNodesPerBlade = 0_IntKi !< Number nodes per blades [-] + INTEGER(IntKi) :: UAMod = 0_IntKi !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] + REAL(ReKi) :: a_s = 0.0_ReKi !< speed of sound [m/s] + LOGICAL :: Flookup = .false. !< Use table lookup for f' and f'' [-] LOGICAL :: ShedEffect = .True. !< Include the effect of shed vorticity. If False, the input alpha is assumed to already contain this effect (e.g. vortex methods) [-] LOGICAL :: WrSum = .false. !< Write UA AFI parameters to summary file? [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: UAOff_innerNode !< Last node on each blade where UA should be turned off based on span location from blade root (0 if always on) [-] @@ -121,7 +121,7 @@ MODULE UnsteadyAero_Types ! ======================= ! ========= UA_ElementContinuousStateType ======= TYPE, PUBLIC :: UA_ElementContinuousStateType - REAL(R8Ki) , DIMENSION(1:5) :: x !< continuous states when UA_Mod=4 (x1 and x2:Downwash memory terms; x3:Clp', Lift coefficient with a time lag to the attached lift coeff; x4: f'' , Final separation point function) [{rad, rad, - -}] + REAL(R8Ki) , DIMENSION(1:5) :: x = 0.0_R8Ki !< continuous states when UA_Mod=4 (x1 and x2:Downwash memory terms; x3:Clp', Lift coefficient with a time lag to the attached lift coeff; x4: f'' , Final separation point function) [{rad, rad, - -}] END TYPE UA_ElementContinuousStateType ! ======================= ! ========= UA_ContinuousStateType ======= @@ -169,7 +169,7 @@ MODULE UnsteadyAero_Types ! ======================= ! ========= UA_ConstraintStateType ======= TYPE, PUBLIC :: UA_ConstraintStateType - REAL(ReKi) :: DummyConstraintState !< [-] + REAL(ReKi) :: DummyConstraintState = 0.0_ReKi !< [-] END TYPE UA_ConstraintStateType ! ======================= ! ========= UA_OtherStateType ======= @@ -192,9 +192,9 @@ MODULE UnsteadyAero_Types ! ======================= ! ========= UA_MiscVarType ======= TYPE, PUBLIC :: UA_MiscVarType - LOGICAL :: FirstWarn_M !< flag so Mach number warning doesn't get repeated forever [-] - LOGICAL :: FirstWarn_UA !< flag so UA state warning doesn't get repeated forever [-] - LOGICAL :: FirstWarn_UA_off !< flag so UA state warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_M = .false. !< flag so Mach number warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_UA = .false. !< flag so UA state warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_UA_off = .false. !< flag so UA state warning doesn't get repeated forever [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: TESF !< logical flag indicating if trailing edge separation is possible [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: LESF !< logical flag indicating if leading edge separation is possible [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: VRTX !< logical flag indicating if a vortex is being processed [-] @@ -205,6443 +205,3101 @@ MODULE UnsteadyAero_Types ! ======================= ! ========= UA_ParameterType ======= TYPE, PUBLIC :: UA_ParameterType - REAL(DbKi) :: dt !< time step [s] + REAL(DbKi) :: dt = 0.0_R8Ki !< time step [s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: c !< Chord length at node [m] - INTEGER(IntKi) :: numBlades !< Number nodes of all blades [-] - INTEGER(IntKi) :: nNodesPerBlade !< Number nodes per blades [-] - INTEGER(IntKi) :: UAMod !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] - LOGICAL :: Flookup !< Use table lookup for f' and f'' [-] - REAL(ReKi) :: a_s !< speed of sound [m/s] + INTEGER(IntKi) :: numBlades = 0_IntKi !< Number nodes of all blades [-] + INTEGER(IntKi) :: nNodesPerBlade = 0_IntKi !< Number nodes per blades [-] + INTEGER(IntKi) :: UAMod = 0_IntKi !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] + LOGICAL :: Flookup = .false. !< Use table lookup for f' and f'' [-] + REAL(ReKi) :: a_s = 0.0_ReKi !< speed of sound [m/s] INTEGER(IntKi) :: NumOuts = 0 !< Number of outputs [-] - INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=Unsteady.out 2=GlueCode.out 3=both files] [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=Unsteady.out 2=GlueCode.out 3=both files] [-] CHARACTER(20) :: OutFmt !< Output format for numerical results [-] CHARACTER(20) :: OutSFmt !< Output format for header strings [-] CHARACTER(1) :: Delim !< Delimiter string for outputs, defaults to tab-delimiters [-] INTEGER(IntKi) :: UnOutFile = 0 !< File unit for the UnsteadyAero outputs [-] - LOGICAL :: ShedEffect !< Include the effect of shed vorticity. If False, the input alpha is assumed to already contain this effect (e.g. vortex methods) [-] + LOGICAL :: ShedEffect = .false. !< Include the effect of shed vorticity. If False, the input alpha is assumed to already contain this effect (e.g. vortex methods) [-] INTEGER(IntKi) :: lin_nx = 0 !< Number of continuous states for linearization [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: UA_off_forGood !< logical flag indicating if UA is off for good [-] END TYPE UA_ParameterType ! ======================= ! ========= UA_InputType ======= TYPE, PUBLIC :: UA_InputType - REAL(ReKi) :: U !< air velocity magnitude relative to the airfoil [m/s] - REAL(ReKi) :: alpha !< angle of attack [rad] - REAL(ReKi) :: Re !< Reynold's number [-] + REAL(ReKi) :: U = 0.0_ReKi !< air velocity magnitude relative to the airfoil [m/s] + REAL(ReKi) :: alpha = 0.0_ReKi !< angle of attack [rad] + REAL(ReKi) :: Re = 0.0_ReKi !< Reynold's number [-] REAL(ReKi) :: UserProp = 0.0 !< UserProp value for interpolating airfoil tables [-] - REAL(ReKi) , DIMENSION(1:2) :: v_ac !< Relative fluid velocity at the aerodynamic center (UAMod=4) [m/s] - REAL(ReKi) :: omega !< pitching/twisting rate of the airfoil section (UAMod=4) [rad/s] + REAL(ReKi) , DIMENSION(1:2) :: v_ac = 0.0_ReKi !< Relative fluid velocity at the aerodynamic center (UAMod=4) [m/s] + REAL(ReKi) :: omega = 0.0_ReKi !< pitching/twisting rate of the airfoil section (UAMod=4) [rad/s] END TYPE UA_InputType ! ======================= ! ========= UA_OutputType ======= TYPE, PUBLIC :: UA_OutputType - REAL(ReKi) :: Cn !< 2D, normal to chord, force coefficient [-] - REAL(ReKi) :: Cc !< 2D, tangent to chord, force coefficient [-] - REAL(ReKi) :: Cm !< 2D pitching moment coefficient about the 1/4 chord, positive when nose is up [-] - REAL(ReKi) :: Cl !< 2D lift coefficient [-] - REAL(ReKi) :: Cd !< 2D drag coefficient [-] + REAL(ReKi) :: Cn = 0.0_ReKi !< 2D, normal to chord, force coefficient [-] + REAL(ReKi) :: Cc = 0.0_ReKi !< 2D, tangent to chord, force coefficient [-] + REAL(ReKi) :: Cm = 0.0_ReKi !< 2D pitching moment coefficient about the 1/4 chord, positive when nose is up [-] + REAL(ReKi) :: Cl = 0.0_ReKi !< 2D lift coefficient [-] + REAL(ReKi) :: Cd = 0.0_ReKi !< 2D drag coefficient [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< outputs to be written to a file [-] END TYPE UA_OutputType ! ======================= CONTAINS - SUBROUTINE UA_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(UA_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 = 'UA_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%dt = SrcInitInputData%dt - DstInitInputData%OutRootName = SrcInitInputData%OutRootName -IF (ALLOCATED(SrcInitInputData%c)) THEN - i1_l = LBOUND(SrcInitInputData%c,1) - i1_u = UBOUND(SrcInitInputData%c,1) - i2_l = LBOUND(SrcInitInputData%c,2) - i2_u = UBOUND(SrcInitInputData%c,2) - IF (.NOT. ALLOCATED(DstInitInputData%c)) THEN - ALLOCATE(DstInitInputData%c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%c = SrcInitInputData%c -ENDIF - DstInitInputData%numBlades = SrcInitInputData%numBlades - DstInitInputData%nNodesPerBlade = SrcInitInputData%nNodesPerBlade - DstInitInputData%UAMod = SrcInitInputData%UAMod - DstInitInputData%a_s = SrcInitInputData%a_s - DstInitInputData%Flookup = SrcInitInputData%Flookup - DstInitInputData%ShedEffect = SrcInitInputData%ShedEffect - DstInitInputData%WrSum = SrcInitInputData%WrSum -IF (ALLOCATED(SrcInitInputData%UAOff_innerNode)) THEN - i1_l = LBOUND(SrcInitInputData%UAOff_innerNode,1) - i1_u = UBOUND(SrcInitInputData%UAOff_innerNode,1) - IF (.NOT. ALLOCATED(DstInitInputData%UAOff_innerNode)) THEN - ALLOCATE(DstInitInputData%UAOff_innerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_innerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode -ENDIF -IF (ALLOCATED(SrcInitInputData%UAOff_outerNode)) THEN - i1_l = LBOUND(SrcInitInputData%UAOff_outerNode,1) - i1_u = UBOUND(SrcInitInputData%UAOff_outerNode,1) - IF (.NOT. ALLOCATED(DstInitInputData%UAOff_outerNode)) THEN - ALLOCATE(DstInitInputData%UAOff_outerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_outerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%UAOff_outerNode = SrcInitInputData%UAOff_outerNode -ENDIF - END SUBROUTINE UA_CopyInitInput - - SUBROUTINE UA_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(UA_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 = 'UA_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%c)) THEN - DEALLOCATE(InitInputData%c) -ENDIF -IF (ALLOCATED(InitInputData%UAOff_innerNode)) THEN - DEALLOCATE(InitInputData%UAOff_innerNode) -ENDIF -IF (ALLOCATED(InitInputData%UAOff_outerNode)) THEN - DEALLOCATE(InitInputData%UAOff_outerNode) -ENDIF - END SUBROUTINE UA_DestroyInitInput - - SUBROUTINE UA_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(UA_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 = 'UA_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 - Db_BufSz = Db_BufSz + 1 ! dt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutRootName) ! OutRootName - Int_BufSz = Int_BufSz + 1 ! c allocated yes/no - IF ( ALLOCATED(InData%c) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! c upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%c) ! c - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Int_BufSz = Int_BufSz + 1 ! nNodesPerBlade - Int_BufSz = Int_BufSz + 1 ! UAMod - Re_BufSz = Re_BufSz + 1 ! a_s - Int_BufSz = Int_BufSz + 1 ! Flookup - Int_BufSz = Int_BufSz + 1 ! ShedEffect - Int_BufSz = Int_BufSz + 1 ! WrSum - Int_BufSz = Int_BufSz + 1 ! UAOff_innerNode allocated yes/no - IF ( ALLOCATED(InData%UAOff_innerNode) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UAOff_innerNode upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UAOff_innerNode) ! UAOff_innerNode - END IF - Int_BufSz = Int_BufSz + 1 ! UAOff_outerNode allocated yes/no - IF ( ALLOCATED(InData%UAOff_outerNode) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UAOff_outerNode upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UAOff_outerNode) ! UAOff_outerNode - 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 - DbKiBuf(Db_Xferred) = InData%dt - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%c) ) 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%c,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%c,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%c,2), UBOUND(InData%c,2) - DO i1 = LBOUND(InData%c,1), UBOUND(InData%c,1) - ReKiBuf(Re_Xferred) = InData%c(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodesPerBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ShedEffect, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrSum, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UAOff_innerNode) ) 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%UAOff_innerNode,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UAOff_innerNode,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UAOff_innerNode,1), UBOUND(InData%UAOff_innerNode,1) - IntKiBuf(Int_Xferred) = InData%UAOff_innerNode(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UAOff_outerNode) ) 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%UAOff_outerNode,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UAOff_outerNode,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UAOff_outerNode,1), UBOUND(InData%UAOff_outerNode,1) - IntKiBuf(Int_Xferred) = InData%UAOff_outerNode(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE UA_PackInitInput - - SUBROUTINE UA_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(UA_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 = 'UA_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%dt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! c 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%c)) DEALLOCATE(OutData%c) - ALLOCATE(OutData%c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%c,2), UBOUND(OutData%c,2) - DO i1 = LBOUND(OutData%c,1), UBOUND(OutData%c,1) - OutData%c(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodesPerBlade = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UAMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) - Int_Xferred = Int_Xferred + 1 - OutData%ShedEffect = TRANSFER(IntKiBuf(Int_Xferred), OutData%ShedEffect) - Int_Xferred = Int_Xferred + 1 - OutData%WrSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrSum) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UAOff_innerNode 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%UAOff_innerNode)) DEALLOCATE(OutData%UAOff_innerNode) - ALLOCATE(OutData%UAOff_innerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_innerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UAOff_innerNode,1), UBOUND(OutData%UAOff_innerNode,1) - OutData%UAOff_innerNode(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UAOff_outerNode 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%UAOff_outerNode)) DEALLOCATE(OutData%UAOff_outerNode) - ALLOCATE(OutData%UAOff_outerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_outerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UAOff_outerNode,1), UBOUND(OutData%UAOff_outerNode,1) - OutData%UAOff_outerNode(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE UA_UnPackInitInput - - SUBROUTINE UA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(UA_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 = 'UA_CopyInitOutput' -! +subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(UA_InitInputType), intent(in) :: SrcInitInputData + type(UA_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'UA_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Version, DstInitOutputData%Version, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -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 - END SUBROUTINE UA_CopyInitOutput - - SUBROUTINE UA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(UA_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 = 'UA_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Version, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE UA_DestroyInitOutput - - SUBROUTINE UA_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(UA_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 = 'UA_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Version - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Version - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Version - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 - 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 - - 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 - - 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 - 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 - END SUBROUTINE UA_PackInitOutput - - SUBROUTINE UA_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(UA_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 = 'UA_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 - 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%Version, ErrStat2, ErrMsg2 ) ! Version - 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) - 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 - END SUBROUTINE UA_UnPackInitOutput - - SUBROUTINE UA_CopyKelvinChainType( SrcKelvinChainTypeData, DstKelvinChainTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_KelvinChainType), INTENT(IN) :: SrcKelvinChainTypeData - TYPE(UA_KelvinChainType), INTENT(INOUT) :: DstKelvinChainTypeData - 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 = 'UA_CopyKelvinChainType' -! + ErrMsg = '' + DstInitInputData%dt = SrcInitInputData%dt + DstInitInputData%OutRootName = SrcInitInputData%OutRootName + if (allocated(SrcInitInputData%c)) then + LB(1:2) = lbound(SrcInitInputData%c) + UB(1:2) = ubound(SrcInitInputData%c) + if (.not. allocated(DstInitInputData%c)) then + allocate(DstInitInputData%c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%c = SrcInitInputData%c + end if + DstInitInputData%numBlades = SrcInitInputData%numBlades + DstInitInputData%nNodesPerBlade = SrcInitInputData%nNodesPerBlade + DstInitInputData%UAMod = SrcInitInputData%UAMod + DstInitInputData%a_s = SrcInitInputData%a_s + DstInitInputData%Flookup = SrcInitInputData%Flookup + DstInitInputData%ShedEffect = SrcInitInputData%ShedEffect + DstInitInputData%WrSum = SrcInitInputData%WrSum + if (allocated(SrcInitInputData%UAOff_innerNode)) then + LB(1:1) = lbound(SrcInitInputData%UAOff_innerNode) + UB(1:1) = ubound(SrcInitInputData%UAOff_innerNode) + if (.not. allocated(DstInitInputData%UAOff_innerNode)) then + allocate(DstInitInputData%UAOff_innerNode(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_innerNode.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode + end if + if (allocated(SrcInitInputData%UAOff_outerNode)) then + LB(1:1) = lbound(SrcInitInputData%UAOff_outerNode) + UB(1:1) = ubound(SrcInitInputData%UAOff_outerNode) + if (.not. allocated(DstInitInputData%UAOff_outerNode)) then + allocate(DstInitInputData%UAOff_outerNode(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_outerNode.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%UAOff_outerNode = SrcInitInputData%UAOff_outerNode + end if +end subroutine + +subroutine UA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(UA_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstKelvinChainTypeData%Cn_prime = SrcKelvinChainTypeData%Cn_prime - DstKelvinChainTypeData%C_nalpha_circ = SrcKelvinChainTypeData%C_nalpha_circ - DstKelvinChainTypeData%Kalpha_f = SrcKelvinChainTypeData%Kalpha_f - DstKelvinChainTypeData%Kq_f = SrcKelvinChainTypeData%Kq_f - DstKelvinChainTypeData%alpha_filt_cur = SrcKelvinChainTypeData%alpha_filt_cur - DstKelvinChainTypeData%alpha_e = SrcKelvinChainTypeData%alpha_e - DstKelvinChainTypeData%dalpha0 = SrcKelvinChainTypeData%dalpha0 - DstKelvinChainTypeData%alpha_f = SrcKelvinChainTypeData%alpha_f - DstKelvinChainTypeData%Kq = SrcKelvinChainTypeData%Kq - DstKelvinChainTypeData%q_cur = SrcKelvinChainTypeData%q_cur - DstKelvinChainTypeData%q_f_cur = SrcKelvinChainTypeData%q_f_cur - DstKelvinChainTypeData%X1 = SrcKelvinChainTypeData%X1 - DstKelvinChainTypeData%X2 = SrcKelvinChainTypeData%X2 - DstKelvinChainTypeData%X3 = SrcKelvinChainTypeData%X3 - DstKelvinChainTypeData%X4 = SrcKelvinChainTypeData%X4 - DstKelvinChainTypeData%Kprime_alpha = SrcKelvinChainTypeData%Kprime_alpha - DstKelvinChainTypeData%Kprime_q = SrcKelvinChainTypeData%Kprime_q - DstKelvinChainTypeData%K3prime_q = SrcKelvinChainTypeData%K3prime_q - DstKelvinChainTypeData%Kprimeprime_q = SrcKelvinChainTypeData%Kprimeprime_q - DstKelvinChainTypeData%Dp = SrcKelvinChainTypeData%Dp - DstKelvinChainTypeData%Cn_pot = SrcKelvinChainTypeData%Cn_pot - DstKelvinChainTypeData%Cc_pot = SrcKelvinChainTypeData%Cc_pot - DstKelvinChainTypeData%Cn_alpha_q_circ = SrcKelvinChainTypeData%Cn_alpha_q_circ - DstKelvinChainTypeData%Cn_alpha_q_nc = SrcKelvinChainTypeData%Cn_alpha_q_nc - DstKelvinChainTypeData%Cm_q_circ = SrcKelvinChainTypeData%Cm_q_circ - DstKelvinChainTypeData%Cn_alpha_nc = SrcKelvinChainTypeData%Cn_alpha_nc - DstKelvinChainTypeData%Cn_q_circ = SrcKelvinChainTypeData%Cn_q_circ - DstKelvinChainTypeData%Cn_q_nc = SrcKelvinChainTypeData%Cn_q_nc - DstKelvinChainTypeData%Cm_q_nc = SrcKelvinChainTypeData%Cm_q_nc - DstKelvinChainTypeData%fprimeprime = SrcKelvinChainTypeData%fprimeprime - DstKelvinChainTypeData%Df = SrcKelvinChainTypeData%Df - DstKelvinChainTypeData%Df_c = SrcKelvinChainTypeData%Df_c - DstKelvinChainTypeData%Df_m = SrcKelvinChainTypeData%Df_m - DstKelvinChainTypeData%Dalphaf = SrcKelvinChainTypeData%Dalphaf - DstKelvinChainTypeData%fprime = SrcKelvinChainTypeData%fprime - DstKelvinChainTypeData%fprime_c = SrcKelvinChainTypeData%fprime_c - DstKelvinChainTypeData%fprimeprime_c = SrcKelvinChainTypeData%fprimeprime_c - DstKelvinChainTypeData%fprime_m = SrcKelvinChainTypeData%fprime_m - DstKelvinChainTypeData%fprimeprime_m = SrcKelvinChainTypeData%fprimeprime_m - DstKelvinChainTypeData%Cn_v = SrcKelvinChainTypeData%Cn_v - DstKelvinChainTypeData%C_V = SrcKelvinChainTypeData%C_V - DstKelvinChainTypeData%Cn_FS = SrcKelvinChainTypeData%Cn_FS - DstKelvinChainTypeData%T_f = SrcKelvinChainTypeData%T_f - DstKelvinChainTypeData%T_fc = SrcKelvinChainTypeData%T_fc - DstKelvinChainTypeData%T_fm = SrcKelvinChainTypeData%T_fm - DstKelvinChainTypeData%T_V = SrcKelvinChainTypeData%T_V - DstKelvinChainTypeData%k_alpha = SrcKelvinChainTypeData%k_alpha - DstKelvinChainTypeData%k_q = SrcKelvinChainTypeData%k_q - DstKelvinChainTypeData%T_alpha = SrcKelvinChainTypeData%T_alpha - DstKelvinChainTypeData%T_q = SrcKelvinChainTypeData%T_q - DstKelvinChainTypeData%ds = SrcKelvinChainTypeData%ds - END SUBROUTINE UA_CopyKelvinChainType - - SUBROUTINE UA_DestroyKelvinChainType( KelvinChainTypeData, ErrStat, ErrMsg ) - TYPE(UA_KelvinChainType), INTENT(INOUT) :: KelvinChainTypeData - 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 = 'UA_DestroyKelvinChainType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE UA_DestroyKelvinChainType - - SUBROUTINE UA_PackKelvinChainType( 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(UA_KelvinChainType), 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 = 'UA_PackKelvinChainType' - ! 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 ! Cn_prime - Re_BufSz = Re_BufSz + 1 ! C_nalpha_circ - Re_BufSz = Re_BufSz + 1 ! Kalpha_f - Re_BufSz = Re_BufSz + 1 ! Kq_f - Re_BufSz = Re_BufSz + 1 ! alpha_filt_cur - Re_BufSz = Re_BufSz + 1 ! alpha_e - Re_BufSz = Re_BufSz + 1 ! dalpha0 - Re_BufSz = Re_BufSz + 1 ! alpha_f - Re_BufSz = Re_BufSz + 1 ! Kq - Re_BufSz = Re_BufSz + 1 ! q_cur - Re_BufSz = Re_BufSz + 1 ! q_f_cur - Re_BufSz = Re_BufSz + 1 ! X1 - Re_BufSz = Re_BufSz + 1 ! X2 - Re_BufSz = Re_BufSz + 1 ! X3 - Re_BufSz = Re_BufSz + 1 ! X4 - Re_BufSz = Re_BufSz + 1 ! Kprime_alpha - Re_BufSz = Re_BufSz + 1 ! Kprime_q - Re_BufSz = Re_BufSz + 1 ! K3prime_q - Re_BufSz = Re_BufSz + 1 ! Kprimeprime_q - Re_BufSz = Re_BufSz + 1 ! Dp - Re_BufSz = Re_BufSz + 1 ! Cn_pot - Re_BufSz = Re_BufSz + 1 ! Cc_pot - Re_BufSz = Re_BufSz + 1 ! Cn_alpha_q_circ - Re_BufSz = Re_BufSz + 1 ! Cn_alpha_q_nc - Re_BufSz = Re_BufSz + 1 ! Cm_q_circ - Re_BufSz = Re_BufSz + 1 ! Cn_alpha_nc - Re_BufSz = Re_BufSz + 1 ! Cn_q_circ - Re_BufSz = Re_BufSz + 1 ! Cn_q_nc - Re_BufSz = Re_BufSz + 1 ! Cm_q_nc - Re_BufSz = Re_BufSz + 1 ! fprimeprime - Re_BufSz = Re_BufSz + 1 ! Df - Re_BufSz = Re_BufSz + 1 ! Df_c - Re_BufSz = Re_BufSz + 1 ! Df_m - Re_BufSz = Re_BufSz + 1 ! Dalphaf - Re_BufSz = Re_BufSz + 1 ! fprime - Re_BufSz = Re_BufSz + 1 ! fprime_c - Re_BufSz = Re_BufSz + 1 ! fprimeprime_c - Re_BufSz = Re_BufSz + 1 ! fprime_m - Re_BufSz = Re_BufSz + 1 ! fprimeprime_m - Re_BufSz = Re_BufSz + 1 ! Cn_v - Re_BufSz = Re_BufSz + 1 ! C_V - Re_BufSz = Re_BufSz + 1 ! Cn_FS - Re_BufSz = Re_BufSz + 1 ! T_f - Re_BufSz = Re_BufSz + 1 ! T_fc - Re_BufSz = Re_BufSz + 1 ! T_fm - Re_BufSz = Re_BufSz + 1 ! T_V - Re_BufSz = Re_BufSz + 1 ! k_alpha - Re_BufSz = Re_BufSz + 1 ! k_q - Re_BufSz = Re_BufSz + 1 ! T_alpha - Re_BufSz = Re_BufSz + 1 ! T_q - Re_BufSz = Re_BufSz + 1 ! ds - 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%Cn_prime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_nalpha_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kalpha_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kq_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha_filt_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha_e - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dalpha0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%q_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%q_f_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X4 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kprime_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kprime_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%K3prime_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kprimeprime_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Dp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_pot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cc_pot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_alpha_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_alpha_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_alpha_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprimeprime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Df - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Df_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Df_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Dalphaf - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprime_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprimeprime_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprime_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprimeprime_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_v - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_V - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_FS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_fc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_fm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_V - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ds - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_PackKelvinChainType - - SUBROUTINE UA_UnPackKelvinChainType( 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(UA_KelvinChainType), 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 = 'UA_UnPackKelvinChainType' - ! 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%Cn_prime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_nalpha_circ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kalpha_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kq_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_filt_cur = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_e = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dalpha0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%q_cur = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%q_f_cur = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X3 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X4 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kprime_alpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kprime_q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%K3prime_q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kprimeprime_q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Dp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_pot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cc_pot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_q_circ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_q_nc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm_q_circ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_nc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_q_circ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_q_nc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm_q_nc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Df = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Df_c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Df_m = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Dalphaf = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprime_c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime_c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprime_m = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime_m = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_v = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_V = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_FS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_fc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_fm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_V = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_alpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_alpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ds = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_UnPackKelvinChainType - - SUBROUTINE UA_CopyElementContinuousStateType( SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_ElementContinuousStateType), INTENT(IN) :: SrcElementContinuousStateTypeData - TYPE(UA_ElementContinuousStateType), INTENT(INOUT) :: DstElementContinuousStateTypeData - 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 = 'UA_CopyElementContinuousStateType' -! + ErrMsg = '' + if (allocated(InitInputData%c)) then + deallocate(InitInputData%c) + end if + if (allocated(InitInputData%UAOff_innerNode)) then + deallocate(InitInputData%UAOff_innerNode) + end if + if (allocated(InitInputData%UAOff_outerNode)) then + deallocate(InitInputData%UAOff_outerNode) + end if +end subroutine + +subroutine UA_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dt) + call RegPack(Buf, InData%OutRootName) + call RegPack(Buf, allocated(InData%c)) + if (allocated(InData%c)) then + call RegPackBounds(Buf, 2, lbound(InData%c), ubound(InData%c)) + call RegPack(Buf, InData%c) + end if + call RegPack(Buf, InData%numBlades) + call RegPack(Buf, InData%nNodesPerBlade) + call RegPack(Buf, InData%UAMod) + call RegPack(Buf, InData%a_s) + call RegPack(Buf, InData%Flookup) + call RegPack(Buf, InData%ShedEffect) + call RegPack(Buf, InData%WrSum) + call RegPack(Buf, allocated(InData%UAOff_innerNode)) + if (allocated(InData%UAOff_innerNode)) then + call RegPackBounds(Buf, 1, lbound(InData%UAOff_innerNode), ubound(InData%UAOff_innerNode)) + call RegPack(Buf, InData%UAOff_innerNode) + end if + call RegPack(Buf, allocated(InData%UAOff_outerNode)) + if (allocated(InData%UAOff_outerNode)) then + call RegPackBounds(Buf, 1, lbound(InData%UAOff_outerNode), ubound(InData%UAOff_outerNode)) + call RegPack(Buf, InData%UAOff_outerNode) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutRootName) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%c)) deallocate(OutData%c) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%c(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%c) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nNodesPerBlade) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UAMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%a_s) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Flookup) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ShedEffect) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrSum) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%UAOff_innerNode)) deallocate(OutData%UAOff_innerNode) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UAOff_innerNode(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_innerNode.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UAOff_innerNode) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%UAOff_outerNode)) deallocate(OutData%UAOff_outerNode) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UAOff_outerNode(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_outerNode.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UAOff_outerNode) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine UA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(UA_InitOutputType), intent(in) :: SrcInitOutputData + type(UA_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstElementContinuousStateTypeData%x = SrcElementContinuousStateTypeData%x - END SUBROUTINE UA_CopyElementContinuousStateType - - SUBROUTINE UA_DestroyElementContinuousStateType( ElementContinuousStateTypeData, ErrStat, ErrMsg ) - TYPE(UA_ElementContinuousStateType), INTENT(INOUT) :: ElementContinuousStateTypeData - 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 = 'UA_DestroyElementContinuousStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE UA_DestroyElementContinuousStateType - - SUBROUTINE UA_PackElementContinuousStateType( 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(UA_ElementContinuousStateType), 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 = 'UA_PackElementContinuousStateType' - ! 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 + SIZE(InData%x) ! x - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE UA_PackElementContinuousStateType - - SUBROUTINE UA_UnPackElementContinuousStateType( 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(UA_ElementContinuousStateType), 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 = 'UA_UnPackElementContinuousStateType' - ! 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 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE UA_UnPackElementContinuousStateType - - SUBROUTINE UA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(UA_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) :: 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 = 'UA_CopyContState' -! + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Version, DstInitOutputData%Version, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine UA_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(UA_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%element)) THEN - i1_l = LBOUND(SrcContStateData%element,1) - i1_u = UBOUND(SrcContStateData%element,1) - i2_l = LBOUND(SrcContStateData%element,2) - i2_u = UBOUND(SrcContStateData%element,2) - IF (.NOT. ALLOCATED(DstContStateData%element)) THEN - ALLOCATE(DstContStateData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcContStateData%element,2), UBOUND(SrcContStateData%element,2) - DO i1 = LBOUND(SrcContStateData%element,1), UBOUND(SrcContStateData%element,1) - CALL UA_Copyelementcontinuousstatetype( SrcContStateData%element(i1,i2), DstContStateData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF - END SUBROUTINE UA_CopyContState - - SUBROUTINE UA_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(UA_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 = 'UA_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ContStateData%element) -ENDIF - END SUBROUTINE UA_DestroyContState - - SUBROUTINE UA_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(UA_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 = 'UA_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 - Int_BufSz = Int_BufSz + 1 ! element allocated yes/no - IF ( ALLOCATED(InData%element) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! element upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! element - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! element - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! element - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - 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%element) ) 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%element,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%element,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,2) - Int_Xferred = Int_Xferred + 2 - - 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 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 DO - END IF - END SUBROUTINE UA_PackContState - - SUBROUTINE UA_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(UA_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) :: 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 = 'UA_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! element 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%element)) DEALLOCATE(OutData%element) - ALLOCATE(OutData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%element,2), UBOUND(OutData%element,2) - DO i1 = LBOUND(OutData%element,1), UBOUND(OutData%element,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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - END SUBROUTINE UA_UnPackContState - - SUBROUTINE UA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(UA_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) :: 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 = 'UA_CopyDiscState' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Version, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine + +subroutine UA_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(Buf, InData%Version) + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%Version) ! Version + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine UA_CopyKelvinChainType(SrcKelvinChainTypeData, DstKelvinChainTypeData, CtrlCode, ErrStat, ErrMsg) + type(UA_KelvinChainType), intent(in) :: SrcKelvinChainTypeData + type(UA_KelvinChainType), intent(inout) :: DstKelvinChainTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_CopyKelvinChainType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%alpha_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%alpha_minus1,1) - i1_u = UBOUND(SrcDiscStateData%alpha_minus1,1) - i2_l = LBOUND(SrcDiscStateData%alpha_minus1,2) - i2_u = UBOUND(SrcDiscStateData%alpha_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%alpha_minus1)) THEN - ALLOCATE(DstDiscStateData%alpha_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%alpha_minus1 = SrcDiscStateData%alpha_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%alpha_filt_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%alpha_filt_minus1,1) - i1_u = UBOUND(SrcDiscStateData%alpha_filt_minus1,1) - i2_l = LBOUND(SrcDiscStateData%alpha_filt_minus1,2) - i2_u = UBOUND(SrcDiscStateData%alpha_filt_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%alpha_filt_minus1)) THEN - ALLOCATE(DstDiscStateData%alpha_filt_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_filt_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%alpha_filt_minus1 = SrcDiscStateData%alpha_filt_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%alpha_dot)) THEN - i1_l = LBOUND(SrcDiscStateData%alpha_dot,1) - i1_u = UBOUND(SrcDiscStateData%alpha_dot,1) - i2_l = LBOUND(SrcDiscStateData%alpha_dot,2) - i2_u = UBOUND(SrcDiscStateData%alpha_dot,2) - IF (.NOT. ALLOCATED(DstDiscStateData%alpha_dot)) THEN - ALLOCATE(DstDiscStateData%alpha_dot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%alpha_dot = SrcDiscStateData%alpha_dot -ENDIF -IF (ALLOCATED(SrcDiscStateData%alpha_dot_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%alpha_dot_minus1,1) - i1_u = UBOUND(SrcDiscStateData%alpha_dot_minus1,1) - i2_l = LBOUND(SrcDiscStateData%alpha_dot_minus1,2) - i2_u = UBOUND(SrcDiscStateData%alpha_dot_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%alpha_dot_minus1)) THEN - ALLOCATE(DstDiscStateData%alpha_dot_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_dot_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%alpha_dot_minus1 = SrcDiscStateData%alpha_dot_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%q_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%q_minus1,1) - i1_u = UBOUND(SrcDiscStateData%q_minus1,1) - i2_l = LBOUND(SrcDiscStateData%q_minus1,2) - i2_u = UBOUND(SrcDiscStateData%q_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%q_minus1)) THEN - ALLOCATE(DstDiscStateData%q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%q_minus1 = SrcDiscStateData%q_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Kalpha_f_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Kalpha_f_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Kalpha_f_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Kalpha_f_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Kalpha_f_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Kalpha_f_minus1)) THEN - ALLOCATE(DstDiscStateData%Kalpha_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kalpha_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Kalpha_f_minus1 = SrcDiscStateData%Kalpha_f_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Kq_f_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Kq_f_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Kq_f_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Kq_f_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Kq_f_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Kq_f_minus1)) THEN - ALLOCATE(DstDiscStateData%Kq_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kq_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Kq_f_minus1 = SrcDiscStateData%Kq_f_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%q_f_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%q_f_minus1,1) - i1_u = UBOUND(SrcDiscStateData%q_f_minus1,1) - i2_l = LBOUND(SrcDiscStateData%q_f_minus1,2) - i2_u = UBOUND(SrcDiscStateData%q_f_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%q_f_minus1)) THEN - ALLOCATE(DstDiscStateData%q_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%q_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%q_f_minus1 = SrcDiscStateData%q_f_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%X1_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%X1_minus1,1) - i1_u = UBOUND(SrcDiscStateData%X1_minus1,1) - i2_l = LBOUND(SrcDiscStateData%X1_minus1,2) - i2_u = UBOUND(SrcDiscStateData%X1_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%X1_minus1)) THEN - ALLOCATE(DstDiscStateData%X1_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X1_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%X1_minus1 = SrcDiscStateData%X1_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%X2_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%X2_minus1,1) - i1_u = UBOUND(SrcDiscStateData%X2_minus1,1) - i2_l = LBOUND(SrcDiscStateData%X2_minus1,2) - i2_u = UBOUND(SrcDiscStateData%X2_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%X2_minus1)) THEN - ALLOCATE(DstDiscStateData%X2_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X2_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%X2_minus1 = SrcDiscStateData%X2_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%X3_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%X3_minus1,1) - i1_u = UBOUND(SrcDiscStateData%X3_minus1,1) - i2_l = LBOUND(SrcDiscStateData%X3_minus1,2) - i2_u = UBOUND(SrcDiscStateData%X3_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%X3_minus1)) THEN - ALLOCATE(DstDiscStateData%X3_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X3_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%X3_minus1 = SrcDiscStateData%X3_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%X4_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%X4_minus1,1) - i1_u = UBOUND(SrcDiscStateData%X4_minus1,1) - i2_l = LBOUND(SrcDiscStateData%X4_minus1,2) - i2_u = UBOUND(SrcDiscStateData%X4_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%X4_minus1)) THEN - ALLOCATE(DstDiscStateData%X4_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X4_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%X4_minus1 = SrcDiscStateData%X4_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Kprime_alpha_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Kprime_alpha_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Kprime_alpha_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Kprime_alpha_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Kprime_alpha_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Kprime_alpha_minus1)) THEN - ALLOCATE(DstDiscStateData%Kprime_alpha_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprime_alpha_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Kprime_alpha_minus1 = SrcDiscStateData%Kprime_alpha_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Kprime_q_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Kprime_q_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Kprime_q_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Kprime_q_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Kprime_q_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Kprime_q_minus1)) THEN - ALLOCATE(DstDiscStateData%Kprime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Kprime_q_minus1 = SrcDiscStateData%Kprime_q_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Kprimeprime_q_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Kprimeprime_q_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Kprimeprime_q_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Kprimeprime_q_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Kprimeprime_q_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Kprimeprime_q_minus1)) THEN - ALLOCATE(DstDiscStateData%Kprimeprime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprimeprime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Kprimeprime_q_minus1 = SrcDiscStateData%Kprimeprime_q_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%K3prime_q_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%K3prime_q_minus1,1) - i1_u = UBOUND(SrcDiscStateData%K3prime_q_minus1,1) - i2_l = LBOUND(SrcDiscStateData%K3prime_q_minus1,2) - i2_u = UBOUND(SrcDiscStateData%K3prime_q_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%K3prime_q_minus1)) THEN - ALLOCATE(DstDiscStateData%K3prime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%K3prime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%K3prime_q_minus1 = SrcDiscStateData%K3prime_q_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Dp_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Dp_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Dp_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Dp_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Dp_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Dp_minus1)) THEN - ALLOCATE(DstDiscStateData%Dp_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Dp_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Dp_minus1 = SrcDiscStateData%Dp_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Cn_pot_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Cn_pot_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Cn_pot_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Cn_pot_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Cn_pot_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Cn_pot_minus1)) THEN - ALLOCATE(DstDiscStateData%Cn_pot_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_pot_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Cn_pot_minus1 = SrcDiscStateData%Cn_pot_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprimeprime_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprimeprime_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprimeprime_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprimeprime_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprimeprime_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprimeprime_minus1)) THEN - ALLOCATE(DstDiscStateData%fprimeprime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprimeprime_minus1 = SrcDiscStateData%fprimeprime_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprimeprime_c_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprimeprime_c_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprimeprime_c_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprimeprime_c_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprimeprime_c_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprimeprime_c_minus1)) THEN - ALLOCATE(DstDiscStateData%fprimeprime_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprimeprime_c_minus1 = SrcDiscStateData%fprimeprime_c_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprimeprime_m_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprimeprime_m_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprimeprime_m_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprimeprime_m_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprimeprime_m_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprimeprime_m_minus1)) THEN - ALLOCATE(DstDiscStateData%fprimeprime_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprimeprime_m_minus1 = SrcDiscStateData%fprimeprime_m_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Df_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Df_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Df_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Df_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Df_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Df_minus1)) THEN - ALLOCATE(DstDiscStateData%Df_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Df_minus1 = SrcDiscStateData%Df_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Df_c_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Df_c_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Df_c_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Df_c_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Df_c_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Df_c_minus1)) THEN - ALLOCATE(DstDiscStateData%Df_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Df_c_minus1 = SrcDiscStateData%Df_c_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Df_m_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Df_m_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Df_m_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Df_m_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Df_m_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Df_m_minus1)) THEN - ALLOCATE(DstDiscStateData%Df_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Df_m_minus1 = SrcDiscStateData%Df_m_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Dalphaf_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Dalphaf_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Dalphaf_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Dalphaf_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Dalphaf_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Dalphaf_minus1)) THEN - ALLOCATE(DstDiscStateData%Dalphaf_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Dalphaf_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Dalphaf_minus1 = SrcDiscStateData%Dalphaf_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%alphaf_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%alphaf_minus1,1) - i1_u = UBOUND(SrcDiscStateData%alphaf_minus1,1) - i2_l = LBOUND(SrcDiscStateData%alphaf_minus1,2) - i2_u = UBOUND(SrcDiscStateData%alphaf_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%alphaf_minus1)) THEN - ALLOCATE(DstDiscStateData%alphaf_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alphaf_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%alphaf_minus1 = SrcDiscStateData%alphaf_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprime_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprime_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprime_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprime_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprime_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprime_minus1)) THEN - ALLOCATE(DstDiscStateData%fprime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprime_minus1 = SrcDiscStateData%fprime_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprime_c_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprime_c_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprime_c_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprime_c_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprime_c_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprime_c_minus1)) THEN - ALLOCATE(DstDiscStateData%fprime_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprime_c_minus1 = SrcDiscStateData%fprime_c_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprime_m_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprime_m_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprime_m_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprime_m_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprime_m_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprime_m_minus1)) THEN - ALLOCATE(DstDiscStateData%fprime_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprime_m_minus1 = SrcDiscStateData%fprime_m_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%tau_V)) THEN - i1_l = LBOUND(SrcDiscStateData%tau_V,1) - i1_u = UBOUND(SrcDiscStateData%tau_V,1) - i2_l = LBOUND(SrcDiscStateData%tau_V,2) - i2_u = UBOUND(SrcDiscStateData%tau_V,2) - IF (.NOT. ALLOCATED(DstDiscStateData%tau_V)) THEN - ALLOCATE(DstDiscStateData%tau_V(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%tau_V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%tau_V = SrcDiscStateData%tau_V -ENDIF -IF (ALLOCATED(SrcDiscStateData%tau_V_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%tau_V_minus1,1) - i1_u = UBOUND(SrcDiscStateData%tau_V_minus1,1) - i2_l = LBOUND(SrcDiscStateData%tau_V_minus1,2) - i2_u = UBOUND(SrcDiscStateData%tau_V_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%tau_V_minus1)) THEN - ALLOCATE(DstDiscStateData%tau_V_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%tau_V_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%tau_V_minus1 = SrcDiscStateData%tau_V_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Cn_v_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Cn_v_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Cn_v_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Cn_v_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Cn_v_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Cn_v_minus1)) THEN - ALLOCATE(DstDiscStateData%Cn_v_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_v_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Cn_v_minus1 = SrcDiscStateData%Cn_v_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%C_V_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%C_V_minus1,1) - i1_u = UBOUND(SrcDiscStateData%C_V_minus1,1) - i2_l = LBOUND(SrcDiscStateData%C_V_minus1,2) - i2_u = UBOUND(SrcDiscStateData%C_V_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%C_V_minus1)) THEN - ALLOCATE(DstDiscStateData%C_V_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%C_V_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%C_V_minus1 = SrcDiscStateData%C_V_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Cn_prime_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Cn_prime_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Cn_prime_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Cn_prime_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Cn_prime_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Cn_prime_minus1)) THEN - ALLOCATE(DstDiscStateData%Cn_prime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_prime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Cn_prime_minus1 = SrcDiscStateData%Cn_prime_minus1 -ENDIF - END SUBROUTINE UA_CopyDiscState - - SUBROUTINE UA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(UA_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 = 'UA_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%alpha_minus1)) THEN - DEALLOCATE(DiscStateData%alpha_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%alpha_filt_minus1)) THEN - DEALLOCATE(DiscStateData%alpha_filt_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%alpha_dot)) THEN - DEALLOCATE(DiscStateData%alpha_dot) -ENDIF -IF (ALLOCATED(DiscStateData%alpha_dot_minus1)) THEN - DEALLOCATE(DiscStateData%alpha_dot_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%q_minus1)) THEN - DEALLOCATE(DiscStateData%q_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Kalpha_f_minus1)) THEN - DEALLOCATE(DiscStateData%Kalpha_f_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Kq_f_minus1)) THEN - DEALLOCATE(DiscStateData%Kq_f_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%q_f_minus1)) THEN - DEALLOCATE(DiscStateData%q_f_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%X1_minus1)) THEN - DEALLOCATE(DiscStateData%X1_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%X2_minus1)) THEN - DEALLOCATE(DiscStateData%X2_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%X3_minus1)) THEN - DEALLOCATE(DiscStateData%X3_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%X4_minus1)) THEN - DEALLOCATE(DiscStateData%X4_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Kprime_alpha_minus1)) THEN - DEALLOCATE(DiscStateData%Kprime_alpha_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Kprime_q_minus1)) THEN - DEALLOCATE(DiscStateData%Kprime_q_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Kprimeprime_q_minus1)) THEN - DEALLOCATE(DiscStateData%Kprimeprime_q_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%K3prime_q_minus1)) THEN - DEALLOCATE(DiscStateData%K3prime_q_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Dp_minus1)) THEN - DEALLOCATE(DiscStateData%Dp_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Cn_pot_minus1)) THEN - DEALLOCATE(DiscStateData%Cn_pot_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprimeprime_minus1)) THEN - DEALLOCATE(DiscStateData%fprimeprime_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprimeprime_c_minus1)) THEN - DEALLOCATE(DiscStateData%fprimeprime_c_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprimeprime_m_minus1)) THEN - DEALLOCATE(DiscStateData%fprimeprime_m_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Df_minus1)) THEN - DEALLOCATE(DiscStateData%Df_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Df_c_minus1)) THEN - DEALLOCATE(DiscStateData%Df_c_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Df_m_minus1)) THEN - DEALLOCATE(DiscStateData%Df_m_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Dalphaf_minus1)) THEN - DEALLOCATE(DiscStateData%Dalphaf_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%alphaf_minus1)) THEN - DEALLOCATE(DiscStateData%alphaf_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprime_minus1)) THEN - DEALLOCATE(DiscStateData%fprime_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprime_c_minus1)) THEN - DEALLOCATE(DiscStateData%fprime_c_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprime_m_minus1)) THEN - DEALLOCATE(DiscStateData%fprime_m_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%tau_V)) THEN - DEALLOCATE(DiscStateData%tau_V) -ENDIF -IF (ALLOCATED(DiscStateData%tau_V_minus1)) THEN - DEALLOCATE(DiscStateData%tau_V_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Cn_v_minus1)) THEN - DEALLOCATE(DiscStateData%Cn_v_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%C_V_minus1)) THEN - DEALLOCATE(DiscStateData%C_V_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Cn_prime_minus1)) THEN - DEALLOCATE(DiscStateData%Cn_prime_minus1) -ENDIF - END SUBROUTINE UA_DestroyDiscState - - SUBROUTINE UA_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(UA_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 = 'UA_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 - Int_BufSz = Int_BufSz + 1 ! alpha_minus1 allocated yes/no - IF ( ALLOCATED(InData%alpha_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_minus1) ! alpha_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_filt_minus1 allocated yes/no - IF ( ALLOCATED(InData%alpha_filt_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_filt_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_filt_minus1) ! alpha_filt_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_dot allocated yes/no - IF ( ALLOCATED(InData%alpha_dot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_dot) ! alpha_dot - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_dot_minus1 allocated yes/no - IF ( ALLOCATED(InData%alpha_dot_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_dot_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_dot_minus1) ! alpha_dot_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! q_minus1 allocated yes/no - IF ( ALLOCATED(InData%q_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! q_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%q_minus1) ! q_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Kalpha_f_minus1 allocated yes/no - IF ( ALLOCATED(InData%Kalpha_f_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Kalpha_f_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Kalpha_f_minus1) ! Kalpha_f_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Kq_f_minus1 allocated yes/no - IF ( ALLOCATED(InData%Kq_f_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Kq_f_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Kq_f_minus1) ! Kq_f_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! q_f_minus1 allocated yes/no - IF ( ALLOCATED(InData%q_f_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! q_f_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%q_f_minus1) ! q_f_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! X1_minus1 allocated yes/no - IF ( ALLOCATED(InData%X1_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! X1_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X1_minus1) ! X1_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! X2_minus1 allocated yes/no - IF ( ALLOCATED(InData%X2_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! X2_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X2_minus1) ! X2_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! X3_minus1 allocated yes/no - IF ( ALLOCATED(InData%X3_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! X3_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X3_minus1) ! X3_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! X4_minus1 allocated yes/no - IF ( ALLOCATED(InData%X4_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! X4_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X4_minus1) ! X4_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Kprime_alpha_minus1 allocated yes/no - IF ( ALLOCATED(InData%Kprime_alpha_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Kprime_alpha_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Kprime_alpha_minus1) ! Kprime_alpha_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Kprime_q_minus1 allocated yes/no - IF ( ALLOCATED(InData%Kprime_q_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Kprime_q_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Kprime_q_minus1) ! Kprime_q_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Kprimeprime_q_minus1 allocated yes/no - IF ( ALLOCATED(InData%Kprimeprime_q_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Kprimeprime_q_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Kprimeprime_q_minus1) ! Kprimeprime_q_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! K3prime_q_minus1 allocated yes/no - IF ( ALLOCATED(InData%K3prime_q_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K3prime_q_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%K3prime_q_minus1) ! K3prime_q_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Dp_minus1 allocated yes/no - IF ( ALLOCATED(InData%Dp_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dp_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Dp_minus1) ! Dp_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Cn_pot_minus1 allocated yes/no - IF ( ALLOCATED(InData%Cn_pot_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cn_pot_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cn_pot_minus1) ! Cn_pot_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprimeprime_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprimeprime_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprimeprime_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprimeprime_minus1) ! fprimeprime_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprimeprime_c_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprimeprime_c_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprimeprime_c_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprimeprime_c_minus1) ! fprimeprime_c_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprimeprime_m_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprimeprime_m_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprimeprime_m_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprimeprime_m_minus1) ! fprimeprime_m_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Df_minus1 allocated yes/no - IF ( ALLOCATED(InData%Df_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Df_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Df_minus1) ! Df_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Df_c_minus1 allocated yes/no - IF ( ALLOCATED(InData%Df_c_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Df_c_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Df_c_minus1) ! Df_c_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Df_m_minus1 allocated yes/no - IF ( ALLOCATED(InData%Df_m_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Df_m_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Df_m_minus1) ! Df_m_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Dalphaf_minus1 allocated yes/no - IF ( ALLOCATED(InData%Dalphaf_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dalphaf_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Dalphaf_minus1) ! Dalphaf_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! alphaf_minus1 allocated yes/no - IF ( ALLOCATED(InData%alphaf_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alphaf_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alphaf_minus1) ! alphaf_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprime_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprime_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprime_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprime_minus1) ! fprime_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprime_c_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprime_c_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprime_c_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprime_c_minus1) ! fprime_c_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprime_m_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprime_m_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprime_m_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprime_m_minus1) ! fprime_m_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! tau_V allocated yes/no - IF ( ALLOCATED(InData%tau_V) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tau_V upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tau_V) ! tau_V - END IF - Int_BufSz = Int_BufSz + 1 ! tau_V_minus1 allocated yes/no - IF ( ALLOCATED(InData%tau_V_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tau_V_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tau_V_minus1) ! tau_V_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Cn_v_minus1 allocated yes/no - IF ( ALLOCATED(InData%Cn_v_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cn_v_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cn_v_minus1) ! Cn_v_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! C_V_minus1 allocated yes/no - IF ( ALLOCATED(InData%C_V_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C_V_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C_V_minus1) ! C_V_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Cn_prime_minus1 allocated yes/no - IF ( ALLOCATED(InData%Cn_prime_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cn_prime_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cn_prime_minus1) ! Cn_prime_minus1 - 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%alpha_minus1) ) 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%alpha_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alpha_minus1,2), UBOUND(InData%alpha_minus1,2) - DO i1 = LBOUND(InData%alpha_minus1,1), UBOUND(InData%alpha_minus1,1) - ReKiBuf(Re_Xferred) = InData%alpha_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_filt_minus1) ) 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%alpha_filt_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_filt_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_filt_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_filt_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alpha_filt_minus1,2), UBOUND(InData%alpha_filt_minus1,2) - DO i1 = LBOUND(InData%alpha_filt_minus1,1), UBOUND(InData%alpha_filt_minus1,1) - ReKiBuf(Re_Xferred) = InData%alpha_filt_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_dot) ) 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%alpha_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_dot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_dot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_dot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alpha_dot,2), UBOUND(InData%alpha_dot,2) - DO i1 = LBOUND(InData%alpha_dot,1), UBOUND(InData%alpha_dot,1) - ReKiBuf(Re_Xferred) = InData%alpha_dot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_dot_minus1) ) 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%alpha_dot_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_dot_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_dot_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_dot_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alpha_dot_minus1,2), UBOUND(InData%alpha_dot_minus1,2) - DO i1 = LBOUND(InData%alpha_dot_minus1,1), UBOUND(InData%alpha_dot_minus1,1) - ReKiBuf(Re_Xferred) = InData%alpha_dot_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%q_minus1) ) 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%q_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%q_minus1,2), UBOUND(InData%q_minus1,2) - DO i1 = LBOUND(InData%q_minus1,1), UBOUND(InData%q_minus1,1) - ReKiBuf(Re_Xferred) = InData%q_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kalpha_f_minus1) ) 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%Kalpha_f_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kalpha_f_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kalpha_f_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kalpha_f_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Kalpha_f_minus1,2), UBOUND(InData%Kalpha_f_minus1,2) - DO i1 = LBOUND(InData%Kalpha_f_minus1,1), UBOUND(InData%Kalpha_f_minus1,1) - ReKiBuf(Re_Xferred) = InData%Kalpha_f_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kq_f_minus1) ) 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%Kq_f_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kq_f_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kq_f_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kq_f_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Kq_f_minus1,2), UBOUND(InData%Kq_f_minus1,2) - DO i1 = LBOUND(InData%Kq_f_minus1,1), UBOUND(InData%Kq_f_minus1,1) - ReKiBuf(Re_Xferred) = InData%Kq_f_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%q_f_minus1) ) 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%q_f_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_f_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q_f_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_f_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%q_f_minus1,2), UBOUND(InData%q_f_minus1,2) - DO i1 = LBOUND(InData%q_f_minus1,1), UBOUND(InData%q_f_minus1,1) - ReKiBuf(Re_Xferred) = InData%q_f_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X1_minus1) ) 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%X1_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X1_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X1_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X1_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%X1_minus1,2), UBOUND(InData%X1_minus1,2) - DO i1 = LBOUND(InData%X1_minus1,1), UBOUND(InData%X1_minus1,1) - ReKiBuf(Re_Xferred) = InData%X1_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X2_minus1) ) 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%X2_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X2_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X2_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X2_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%X2_minus1,2), UBOUND(InData%X2_minus1,2) - DO i1 = LBOUND(InData%X2_minus1,1), UBOUND(InData%X2_minus1,1) - ReKiBuf(Re_Xferred) = InData%X2_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X3_minus1) ) 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%X3_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X3_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X3_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X3_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%X3_minus1,2), UBOUND(InData%X3_minus1,2) - DO i1 = LBOUND(InData%X3_minus1,1), UBOUND(InData%X3_minus1,1) - ReKiBuf(Re_Xferred) = InData%X3_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X4_minus1) ) 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%X4_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X4_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X4_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X4_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%X4_minus1,2), UBOUND(InData%X4_minus1,2) - DO i1 = LBOUND(InData%X4_minus1,1), UBOUND(InData%X4_minus1,1) - ReKiBuf(Re_Xferred) = InData%X4_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kprime_alpha_minus1) ) 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%Kprime_alpha_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_alpha_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kprime_alpha_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_alpha_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Kprime_alpha_minus1,2), UBOUND(InData%Kprime_alpha_minus1,2) - DO i1 = LBOUND(InData%Kprime_alpha_minus1,1), UBOUND(InData%Kprime_alpha_minus1,1) - ReKiBuf(Re_Xferred) = InData%Kprime_alpha_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kprime_q_minus1) ) 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%Kprime_q_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_q_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kprime_q_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_q_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Kprime_q_minus1,2), UBOUND(InData%Kprime_q_minus1,2) - DO i1 = LBOUND(InData%Kprime_q_minus1,1), UBOUND(InData%Kprime_q_minus1,1) - ReKiBuf(Re_Xferred) = InData%Kprime_q_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kprimeprime_q_minus1) ) 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%Kprimeprime_q_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprimeprime_q_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kprimeprime_q_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprimeprime_q_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Kprimeprime_q_minus1,2), UBOUND(InData%Kprimeprime_q_minus1,2) - DO i1 = LBOUND(InData%Kprimeprime_q_minus1,1), UBOUND(InData%Kprimeprime_q_minus1,1) - ReKiBuf(Re_Xferred) = InData%Kprimeprime_q_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%K3prime_q_minus1) ) 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%K3prime_q_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K3prime_q_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K3prime_q_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K3prime_q_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%K3prime_q_minus1,2), UBOUND(InData%K3prime_q_minus1,2) - DO i1 = LBOUND(InData%K3prime_q_minus1,1), UBOUND(InData%K3prime_q_minus1,1) - ReKiBuf(Re_Xferred) = InData%K3prime_q_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dp_minus1) ) 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%Dp_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dp_minus1,2), UBOUND(InData%Dp_minus1,2) - DO i1 = LBOUND(InData%Dp_minus1,1), UBOUND(InData%Dp_minus1,1) - ReKiBuf(Re_Xferred) = InData%Dp_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cn_pot_minus1) ) 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%Cn_pot_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_pot_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cn_pot_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_pot_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cn_pot_minus1,2), UBOUND(InData%Cn_pot_minus1,2) - DO i1 = LBOUND(InData%Cn_pot_minus1,1), UBOUND(InData%Cn_pot_minus1,1) - ReKiBuf(Re_Xferred) = InData%Cn_pot_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprimeprime_minus1) ) 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%fprimeprime_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprimeprime_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprimeprime_minus1,2), UBOUND(InData%fprimeprime_minus1,2) - DO i1 = LBOUND(InData%fprimeprime_minus1,1), UBOUND(InData%fprimeprime_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprimeprime_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprimeprime_c_minus1) ) 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%fprimeprime_c_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_c_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprimeprime_c_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_c_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprimeprime_c_minus1,2), UBOUND(InData%fprimeprime_c_minus1,2) - DO i1 = LBOUND(InData%fprimeprime_c_minus1,1), UBOUND(InData%fprimeprime_c_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprimeprime_c_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprimeprime_m_minus1) ) 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%fprimeprime_m_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_m_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprimeprime_m_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_m_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprimeprime_m_minus1,2), UBOUND(InData%fprimeprime_m_minus1,2) - DO i1 = LBOUND(InData%fprimeprime_m_minus1,1), UBOUND(InData%fprimeprime_m_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprimeprime_m_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Df_minus1) ) 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%Df_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Df_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Df_minus1,2), UBOUND(InData%Df_minus1,2) - DO i1 = LBOUND(InData%Df_minus1,1), UBOUND(InData%Df_minus1,1) - ReKiBuf(Re_Xferred) = InData%Df_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Df_c_minus1) ) 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%Df_c_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_c_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Df_c_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_c_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Df_c_minus1,2), UBOUND(InData%Df_c_minus1,2) - DO i1 = LBOUND(InData%Df_c_minus1,1), UBOUND(InData%Df_c_minus1,1) - ReKiBuf(Re_Xferred) = InData%Df_c_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Df_m_minus1) ) 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%Df_m_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_m_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Df_m_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_m_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Df_m_minus1,2), UBOUND(InData%Df_m_minus1,2) - DO i1 = LBOUND(InData%Df_m_minus1,1), UBOUND(InData%Df_m_minus1,1) - ReKiBuf(Re_Xferred) = InData%Df_m_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dalphaf_minus1) ) 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%Dalphaf_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dalphaf_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dalphaf_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dalphaf_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dalphaf_minus1,2), UBOUND(InData%Dalphaf_minus1,2) - DO i1 = LBOUND(InData%Dalphaf_minus1,1), UBOUND(InData%Dalphaf_minus1,1) - ReKiBuf(Re_Xferred) = InData%Dalphaf_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alphaf_minus1) ) 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%alphaf_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alphaf_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alphaf_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alphaf_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alphaf_minus1,2), UBOUND(InData%alphaf_minus1,2) - DO i1 = LBOUND(InData%alphaf_minus1,1), UBOUND(InData%alphaf_minus1,1) - ReKiBuf(Re_Xferred) = InData%alphaf_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprime_minus1) ) 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%fprime_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprime_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprime_minus1,2), UBOUND(InData%fprime_minus1,2) - DO i1 = LBOUND(InData%fprime_minus1,1), UBOUND(InData%fprime_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprime_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprime_c_minus1) ) 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%fprime_c_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_c_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprime_c_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_c_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprime_c_minus1,2), UBOUND(InData%fprime_c_minus1,2) - DO i1 = LBOUND(InData%fprime_c_minus1,1), UBOUND(InData%fprime_c_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprime_c_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprime_m_minus1) ) 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%fprime_m_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_m_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprime_m_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_m_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprime_m_minus1,2), UBOUND(InData%fprime_m_minus1,2) - DO i1 = LBOUND(InData%fprime_m_minus1,1), UBOUND(InData%fprime_m_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprime_m_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tau_V) ) 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%tau_V,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tau_V,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tau_V,2), UBOUND(InData%tau_V,2) - DO i1 = LBOUND(InData%tau_V,1), UBOUND(InData%tau_V,1) - ReKiBuf(Re_Xferred) = InData%tau_V(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tau_V_minus1) ) 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%tau_V_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tau_V_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tau_V_minus1,2), UBOUND(InData%tau_V_minus1,2) - DO i1 = LBOUND(InData%tau_V_minus1,1), UBOUND(InData%tau_V_minus1,1) - ReKiBuf(Re_Xferred) = InData%tau_V_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cn_v_minus1) ) 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%Cn_v_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_v_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cn_v_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_v_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cn_v_minus1,2), UBOUND(InData%Cn_v_minus1,2) - DO i1 = LBOUND(InData%Cn_v_minus1,1), UBOUND(InData%Cn_v_minus1,1) - ReKiBuf(Re_Xferred) = InData%Cn_v_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C_V_minus1) ) 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%C_V_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_V_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C_V_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_V_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C_V_minus1,2), UBOUND(InData%C_V_minus1,2) - DO i1 = LBOUND(InData%C_V_minus1,1), UBOUND(InData%C_V_minus1,1) - ReKiBuf(Re_Xferred) = InData%C_V_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cn_prime_minus1) ) 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%Cn_prime_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_prime_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cn_prime_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_prime_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cn_prime_minus1,2), UBOUND(InData%Cn_prime_minus1,2) - DO i1 = LBOUND(InData%Cn_prime_minus1,1), UBOUND(InData%Cn_prime_minus1,1) - ReKiBuf(Re_Xferred) = InData%Cn_prime_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_PackDiscState - - SUBROUTINE UA_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(UA_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) :: 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 = 'UA_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_minus1 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%alpha_minus1)) DEALLOCATE(OutData%alpha_minus1) - ALLOCATE(OutData%alpha_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alpha_minus1,2), UBOUND(OutData%alpha_minus1,2) - DO i1 = LBOUND(OutData%alpha_minus1,1), UBOUND(OutData%alpha_minus1,1) - OutData%alpha_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_filt_minus1 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%alpha_filt_minus1)) DEALLOCATE(OutData%alpha_filt_minus1) - ALLOCATE(OutData%alpha_filt_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_filt_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alpha_filt_minus1,2), UBOUND(OutData%alpha_filt_minus1,2) - DO i1 = LBOUND(OutData%alpha_filt_minus1,1), UBOUND(OutData%alpha_filt_minus1,1) - OutData%alpha_filt_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_dot 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%alpha_dot)) DEALLOCATE(OutData%alpha_dot) - ALLOCATE(OutData%alpha_dot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alpha_dot,2), UBOUND(OutData%alpha_dot,2) - DO i1 = LBOUND(OutData%alpha_dot,1), UBOUND(OutData%alpha_dot,1) - OutData%alpha_dot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_dot_minus1 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%alpha_dot_minus1)) DEALLOCATE(OutData%alpha_dot_minus1) - ALLOCATE(OutData%alpha_dot_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_dot_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alpha_dot_minus1,2), UBOUND(OutData%alpha_dot_minus1,2) - DO i1 = LBOUND(OutData%alpha_dot_minus1,1), UBOUND(OutData%alpha_dot_minus1,1) - OutData%alpha_dot_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q_minus1 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%q_minus1)) DEALLOCATE(OutData%q_minus1) - ALLOCATE(OutData%q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%q_minus1,2), UBOUND(OutData%q_minus1,2) - DO i1 = LBOUND(OutData%q_minus1,1), UBOUND(OutData%q_minus1,1) - OutData%q_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kalpha_f_minus1 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%Kalpha_f_minus1)) DEALLOCATE(OutData%Kalpha_f_minus1) - ALLOCATE(OutData%Kalpha_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kalpha_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Kalpha_f_minus1,2), UBOUND(OutData%Kalpha_f_minus1,2) - DO i1 = LBOUND(OutData%Kalpha_f_minus1,1), UBOUND(OutData%Kalpha_f_minus1,1) - OutData%Kalpha_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kq_f_minus1 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%Kq_f_minus1)) DEALLOCATE(OutData%Kq_f_minus1) - ALLOCATE(OutData%Kq_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kq_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Kq_f_minus1,2), UBOUND(OutData%Kq_f_minus1,2) - DO i1 = LBOUND(OutData%Kq_f_minus1,1), UBOUND(OutData%Kq_f_minus1,1) - OutData%Kq_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q_f_minus1 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%q_f_minus1)) DEALLOCATE(OutData%q_f_minus1) - ALLOCATE(OutData%q_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%q_f_minus1,2), UBOUND(OutData%q_f_minus1,2) - DO i1 = LBOUND(OutData%q_f_minus1,1), UBOUND(OutData%q_f_minus1,1) - OutData%q_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X1_minus1 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%X1_minus1)) DEALLOCATE(OutData%X1_minus1) - ALLOCATE(OutData%X1_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X1_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%X1_minus1,2), UBOUND(OutData%X1_minus1,2) - DO i1 = LBOUND(OutData%X1_minus1,1), UBOUND(OutData%X1_minus1,1) - OutData%X1_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X2_minus1 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%X2_minus1)) DEALLOCATE(OutData%X2_minus1) - ALLOCATE(OutData%X2_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X2_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%X2_minus1,2), UBOUND(OutData%X2_minus1,2) - DO i1 = LBOUND(OutData%X2_minus1,1), UBOUND(OutData%X2_minus1,1) - OutData%X2_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X3_minus1 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%X3_minus1)) DEALLOCATE(OutData%X3_minus1) - ALLOCATE(OutData%X3_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X3_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%X3_minus1,2), UBOUND(OutData%X3_minus1,2) - DO i1 = LBOUND(OutData%X3_minus1,1), UBOUND(OutData%X3_minus1,1) - OutData%X3_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X4_minus1 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%X4_minus1)) DEALLOCATE(OutData%X4_minus1) - ALLOCATE(OutData%X4_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X4_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%X4_minus1,2), UBOUND(OutData%X4_minus1,2) - DO i1 = LBOUND(OutData%X4_minus1,1), UBOUND(OutData%X4_minus1,1) - OutData%X4_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprime_alpha_minus1 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%Kprime_alpha_minus1)) DEALLOCATE(OutData%Kprime_alpha_minus1) - ALLOCATE(OutData%Kprime_alpha_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_alpha_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Kprime_alpha_minus1,2), UBOUND(OutData%Kprime_alpha_minus1,2) - DO i1 = LBOUND(OutData%Kprime_alpha_minus1,1), UBOUND(OutData%Kprime_alpha_minus1,1) - OutData%Kprime_alpha_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprime_q_minus1 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%Kprime_q_minus1)) DEALLOCATE(OutData%Kprime_q_minus1) - ALLOCATE(OutData%Kprime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Kprime_q_minus1,2), UBOUND(OutData%Kprime_q_minus1,2) - DO i1 = LBOUND(OutData%Kprime_q_minus1,1), UBOUND(OutData%Kprime_q_minus1,1) - OutData%Kprime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprimeprime_q_minus1 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%Kprimeprime_q_minus1)) DEALLOCATE(OutData%Kprimeprime_q_minus1) - ALLOCATE(OutData%Kprimeprime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprimeprime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Kprimeprime_q_minus1,2), UBOUND(OutData%Kprimeprime_q_minus1,2) - DO i1 = LBOUND(OutData%Kprimeprime_q_minus1,1), UBOUND(OutData%Kprimeprime_q_minus1,1) - OutData%Kprimeprime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K3prime_q_minus1 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%K3prime_q_minus1)) DEALLOCATE(OutData%K3prime_q_minus1) - ALLOCATE(OutData%K3prime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K3prime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%K3prime_q_minus1,2), UBOUND(OutData%K3prime_q_minus1,2) - DO i1 = LBOUND(OutData%K3prime_q_minus1,1), UBOUND(OutData%K3prime_q_minus1,1) - OutData%K3prime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp_minus1 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%Dp_minus1)) DEALLOCATE(OutData%Dp_minus1) - ALLOCATE(OutData%Dp_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dp_minus1,2), UBOUND(OutData%Dp_minus1,2) - DO i1 = LBOUND(OutData%Dp_minus1,1), UBOUND(OutData%Dp_minus1,1) - OutData%Dp_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_pot_minus1 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%Cn_pot_minus1)) DEALLOCATE(OutData%Cn_pot_minus1) - ALLOCATE(OutData%Cn_pot_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_pot_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cn_pot_minus1,2), UBOUND(OutData%Cn_pot_minus1,2) - DO i1 = LBOUND(OutData%Cn_pot_minus1,1), UBOUND(OutData%Cn_pot_minus1,1) - OutData%Cn_pot_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_minus1 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%fprimeprime_minus1)) DEALLOCATE(OutData%fprimeprime_minus1) - ALLOCATE(OutData%fprimeprime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprimeprime_minus1,2), UBOUND(OutData%fprimeprime_minus1,2) - DO i1 = LBOUND(OutData%fprimeprime_minus1,1), UBOUND(OutData%fprimeprime_minus1,1) - OutData%fprimeprime_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_c_minus1 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%fprimeprime_c_minus1)) DEALLOCATE(OutData%fprimeprime_c_minus1) - ALLOCATE(OutData%fprimeprime_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprimeprime_c_minus1,2), UBOUND(OutData%fprimeprime_c_minus1,2) - DO i1 = LBOUND(OutData%fprimeprime_c_minus1,1), UBOUND(OutData%fprimeprime_c_minus1,1) - OutData%fprimeprime_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_m_minus1 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%fprimeprime_m_minus1)) DEALLOCATE(OutData%fprimeprime_m_minus1) - ALLOCATE(OutData%fprimeprime_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprimeprime_m_minus1,2), UBOUND(OutData%fprimeprime_m_minus1,2) - DO i1 = LBOUND(OutData%fprimeprime_m_minus1,1), UBOUND(OutData%fprimeprime_m_minus1,1) - OutData%fprimeprime_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_minus1 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%Df_minus1)) DEALLOCATE(OutData%Df_minus1) - ALLOCATE(OutData%Df_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Df_minus1,2), UBOUND(OutData%Df_minus1,2) - DO i1 = LBOUND(OutData%Df_minus1,1), UBOUND(OutData%Df_minus1,1) - OutData%Df_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_c_minus1 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%Df_c_minus1)) DEALLOCATE(OutData%Df_c_minus1) - ALLOCATE(OutData%Df_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Df_c_minus1,2), UBOUND(OutData%Df_c_minus1,2) - DO i1 = LBOUND(OutData%Df_c_minus1,1), UBOUND(OutData%Df_c_minus1,1) - OutData%Df_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_m_minus1 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%Df_m_minus1)) DEALLOCATE(OutData%Df_m_minus1) - ALLOCATE(OutData%Df_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Df_m_minus1,2), UBOUND(OutData%Df_m_minus1,2) - DO i1 = LBOUND(OutData%Df_m_minus1,1), UBOUND(OutData%Df_m_minus1,1) - OutData%Df_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dalphaf_minus1 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%Dalphaf_minus1)) DEALLOCATE(OutData%Dalphaf_minus1) - ALLOCATE(OutData%Dalphaf_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dalphaf_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dalphaf_minus1,2), UBOUND(OutData%Dalphaf_minus1,2) - DO i1 = LBOUND(OutData%Dalphaf_minus1,1), UBOUND(OutData%Dalphaf_minus1,1) - OutData%Dalphaf_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alphaf_minus1 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%alphaf_minus1)) DEALLOCATE(OutData%alphaf_minus1) - ALLOCATE(OutData%alphaf_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alphaf_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alphaf_minus1,2), UBOUND(OutData%alphaf_minus1,2) - DO i1 = LBOUND(OutData%alphaf_minus1,1), UBOUND(OutData%alphaf_minus1,1) - OutData%alphaf_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_minus1 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%fprime_minus1)) DEALLOCATE(OutData%fprime_minus1) - ALLOCATE(OutData%fprime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprime_minus1,2), UBOUND(OutData%fprime_minus1,2) - DO i1 = LBOUND(OutData%fprime_minus1,1), UBOUND(OutData%fprime_minus1,1) - OutData%fprime_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_c_minus1 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%fprime_c_minus1)) DEALLOCATE(OutData%fprime_c_minus1) - ALLOCATE(OutData%fprime_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprime_c_minus1,2), UBOUND(OutData%fprime_c_minus1,2) - DO i1 = LBOUND(OutData%fprime_c_minus1,1), UBOUND(OutData%fprime_c_minus1,1) - OutData%fprime_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_m_minus1 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%fprime_m_minus1)) DEALLOCATE(OutData%fprime_m_minus1) - ALLOCATE(OutData%fprime_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprime_m_minus1,2), UBOUND(OutData%fprime_m_minus1,2) - DO i1 = LBOUND(OutData%fprime_m_minus1,1), UBOUND(OutData%fprime_m_minus1,1) - OutData%fprime_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tau_V 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%tau_V)) DEALLOCATE(OutData%tau_V) - ALLOCATE(OutData%tau_V(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tau_V,2), UBOUND(OutData%tau_V,2) - DO i1 = LBOUND(OutData%tau_V,1), UBOUND(OutData%tau_V,1) - OutData%tau_V(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tau_V_minus1 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%tau_V_minus1)) DEALLOCATE(OutData%tau_V_minus1) - ALLOCATE(OutData%tau_V_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tau_V_minus1,2), UBOUND(OutData%tau_V_minus1,2) - DO i1 = LBOUND(OutData%tau_V_minus1,1), UBOUND(OutData%tau_V_minus1,1) - OutData%tau_V_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_v_minus1 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%Cn_v_minus1)) DEALLOCATE(OutData%Cn_v_minus1) - ALLOCATE(OutData%Cn_v_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_v_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cn_v_minus1,2), UBOUND(OutData%Cn_v_minus1,2) - DO i1 = LBOUND(OutData%Cn_v_minus1,1), UBOUND(OutData%Cn_v_minus1,1) - OutData%Cn_v_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C_V_minus1 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%C_V_minus1)) DEALLOCATE(OutData%C_V_minus1) - ALLOCATE(OutData%C_V_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_V_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C_V_minus1,2), UBOUND(OutData%C_V_minus1,2) - DO i1 = LBOUND(OutData%C_V_minus1,1), UBOUND(OutData%C_V_minus1,1) - OutData%C_V_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_prime_minus1 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%Cn_prime_minus1)) DEALLOCATE(OutData%Cn_prime_minus1) - ALLOCATE(OutData%Cn_prime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_prime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cn_prime_minus1,2), UBOUND(OutData%Cn_prime_minus1,2) - DO i1 = LBOUND(OutData%Cn_prime_minus1,1), UBOUND(OutData%Cn_prime_minus1,1) - OutData%Cn_prime_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_UnPackDiscState - - SUBROUTINE UA_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(UA_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 = 'UA_CopyConstrState' -! + ErrMsg = '' + DstKelvinChainTypeData%Cn_prime = SrcKelvinChainTypeData%Cn_prime + DstKelvinChainTypeData%C_nalpha_circ = SrcKelvinChainTypeData%C_nalpha_circ + DstKelvinChainTypeData%Kalpha_f = SrcKelvinChainTypeData%Kalpha_f + DstKelvinChainTypeData%Kq_f = SrcKelvinChainTypeData%Kq_f + DstKelvinChainTypeData%alpha_filt_cur = SrcKelvinChainTypeData%alpha_filt_cur + DstKelvinChainTypeData%alpha_e = SrcKelvinChainTypeData%alpha_e + DstKelvinChainTypeData%dalpha0 = SrcKelvinChainTypeData%dalpha0 + DstKelvinChainTypeData%alpha_f = SrcKelvinChainTypeData%alpha_f + DstKelvinChainTypeData%Kq = SrcKelvinChainTypeData%Kq + DstKelvinChainTypeData%q_cur = SrcKelvinChainTypeData%q_cur + DstKelvinChainTypeData%q_f_cur = SrcKelvinChainTypeData%q_f_cur + DstKelvinChainTypeData%X1 = SrcKelvinChainTypeData%X1 + DstKelvinChainTypeData%X2 = SrcKelvinChainTypeData%X2 + DstKelvinChainTypeData%X3 = SrcKelvinChainTypeData%X3 + DstKelvinChainTypeData%X4 = SrcKelvinChainTypeData%X4 + DstKelvinChainTypeData%Kprime_alpha = SrcKelvinChainTypeData%Kprime_alpha + DstKelvinChainTypeData%Kprime_q = SrcKelvinChainTypeData%Kprime_q + DstKelvinChainTypeData%K3prime_q = SrcKelvinChainTypeData%K3prime_q + DstKelvinChainTypeData%Kprimeprime_q = SrcKelvinChainTypeData%Kprimeprime_q + DstKelvinChainTypeData%Dp = SrcKelvinChainTypeData%Dp + DstKelvinChainTypeData%Cn_pot = SrcKelvinChainTypeData%Cn_pot + DstKelvinChainTypeData%Cc_pot = SrcKelvinChainTypeData%Cc_pot + DstKelvinChainTypeData%Cn_alpha_q_circ = SrcKelvinChainTypeData%Cn_alpha_q_circ + DstKelvinChainTypeData%Cn_alpha_q_nc = SrcKelvinChainTypeData%Cn_alpha_q_nc + DstKelvinChainTypeData%Cm_q_circ = SrcKelvinChainTypeData%Cm_q_circ + DstKelvinChainTypeData%Cn_alpha_nc = SrcKelvinChainTypeData%Cn_alpha_nc + DstKelvinChainTypeData%Cn_q_circ = SrcKelvinChainTypeData%Cn_q_circ + DstKelvinChainTypeData%Cn_q_nc = SrcKelvinChainTypeData%Cn_q_nc + DstKelvinChainTypeData%Cm_q_nc = SrcKelvinChainTypeData%Cm_q_nc + DstKelvinChainTypeData%fprimeprime = SrcKelvinChainTypeData%fprimeprime + DstKelvinChainTypeData%Df = SrcKelvinChainTypeData%Df + DstKelvinChainTypeData%Df_c = SrcKelvinChainTypeData%Df_c + DstKelvinChainTypeData%Df_m = SrcKelvinChainTypeData%Df_m + DstKelvinChainTypeData%Dalphaf = SrcKelvinChainTypeData%Dalphaf + DstKelvinChainTypeData%fprime = SrcKelvinChainTypeData%fprime + DstKelvinChainTypeData%fprime_c = SrcKelvinChainTypeData%fprime_c + DstKelvinChainTypeData%fprimeprime_c = SrcKelvinChainTypeData%fprimeprime_c + DstKelvinChainTypeData%fprime_m = SrcKelvinChainTypeData%fprime_m + DstKelvinChainTypeData%fprimeprime_m = SrcKelvinChainTypeData%fprimeprime_m + DstKelvinChainTypeData%Cn_v = SrcKelvinChainTypeData%Cn_v + DstKelvinChainTypeData%C_V = SrcKelvinChainTypeData%C_V + DstKelvinChainTypeData%Cn_FS = SrcKelvinChainTypeData%Cn_FS + DstKelvinChainTypeData%T_f = SrcKelvinChainTypeData%T_f + DstKelvinChainTypeData%T_fc = SrcKelvinChainTypeData%T_fc + DstKelvinChainTypeData%T_fm = SrcKelvinChainTypeData%T_fm + DstKelvinChainTypeData%T_V = SrcKelvinChainTypeData%T_V + DstKelvinChainTypeData%k_alpha = SrcKelvinChainTypeData%k_alpha + DstKelvinChainTypeData%k_q = SrcKelvinChainTypeData%k_q + DstKelvinChainTypeData%T_alpha = SrcKelvinChainTypeData%T_alpha + DstKelvinChainTypeData%T_q = SrcKelvinChainTypeData%T_q + DstKelvinChainTypeData%ds = SrcKelvinChainTypeData%ds +end subroutine + +subroutine UA_DestroyKelvinChainType(KelvinChainTypeData, ErrStat, ErrMsg) + type(UA_KelvinChainType), intent(inout) :: KelvinChainTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyKelvinChainType' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstraintState = SrcConstrStateData%DummyConstraintState - END SUBROUTINE UA_CopyConstrState - - SUBROUTINE UA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(UA_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 = 'UA_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE UA_DestroyConstrState - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! DummyConstraintState - 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%DummyConstraintState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_PackConstrState - - SUBROUTINE UA_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(UA_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 = 'UA_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%DummyConstraintState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_UnPackConstrState - - SUBROUTINE UA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(UA_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) :: 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 = 'UA_CopyOtherState' -! + ErrMsg = '' +end subroutine + +subroutine UA_PackKelvinChainType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_KelvinChainType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackKelvinChainType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Cn_prime) + call RegPack(Buf, InData%C_nalpha_circ) + call RegPack(Buf, InData%Kalpha_f) + call RegPack(Buf, InData%Kq_f) + call RegPack(Buf, InData%alpha_filt_cur) + call RegPack(Buf, InData%alpha_e) + call RegPack(Buf, InData%dalpha0) + call RegPack(Buf, InData%alpha_f) + call RegPack(Buf, InData%Kq) + call RegPack(Buf, InData%q_cur) + call RegPack(Buf, InData%q_f_cur) + call RegPack(Buf, InData%X1) + call RegPack(Buf, InData%X2) + call RegPack(Buf, InData%X3) + call RegPack(Buf, InData%X4) + call RegPack(Buf, InData%Kprime_alpha) + call RegPack(Buf, InData%Kprime_q) + call RegPack(Buf, InData%K3prime_q) + call RegPack(Buf, InData%Kprimeprime_q) + call RegPack(Buf, InData%Dp) + call RegPack(Buf, InData%Cn_pot) + call RegPack(Buf, InData%Cc_pot) + call RegPack(Buf, InData%Cn_alpha_q_circ) + call RegPack(Buf, InData%Cn_alpha_q_nc) + call RegPack(Buf, InData%Cm_q_circ) + call RegPack(Buf, InData%Cn_alpha_nc) + call RegPack(Buf, InData%Cn_q_circ) + call RegPack(Buf, InData%Cn_q_nc) + call RegPack(Buf, InData%Cm_q_nc) + call RegPack(Buf, InData%fprimeprime) + call RegPack(Buf, InData%Df) + call RegPack(Buf, InData%Df_c) + call RegPack(Buf, InData%Df_m) + call RegPack(Buf, InData%Dalphaf) + call RegPack(Buf, InData%fprime) + call RegPack(Buf, InData%fprime_c) + call RegPack(Buf, InData%fprimeprime_c) + call RegPack(Buf, InData%fprime_m) + call RegPack(Buf, InData%fprimeprime_m) + call RegPack(Buf, InData%Cn_v) + call RegPack(Buf, InData%C_V) + call RegPack(Buf, InData%Cn_FS) + call RegPack(Buf, InData%T_f) + call RegPack(Buf, InData%T_fc) + call RegPack(Buf, InData%T_fm) + call RegPack(Buf, InData%T_V) + call RegPack(Buf, InData%k_alpha) + call RegPack(Buf, InData%k_q) + call RegPack(Buf, InData%T_alpha) + call RegPack(Buf, InData%T_q) + call RegPack(Buf, InData%ds) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackKelvinChainType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_KelvinChainType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackKelvinChainType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Cn_prime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_nalpha_circ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Kalpha_f) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Kq_f) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alpha_filt_cur) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alpha_e) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dalpha0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alpha_f) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Kq) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%q_cur) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%q_f_cur) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%X1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%X2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%X3) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%X4) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Kprime_alpha) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Kprime_q) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%K3prime_q) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Kprimeprime_q) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Dp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cn_pot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cc_pot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cn_alpha_q_circ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cn_alpha_q_nc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cm_q_circ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cn_alpha_nc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cn_q_circ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cn_q_nc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cm_q_nc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%fprimeprime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Df) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Df_c) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Df_m) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Dalphaf) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%fprime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%fprime_c) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%fprimeprime_c) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%fprime_m) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%fprimeprime_m) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cn_v) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_V) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cn_FS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T_f) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T_fc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T_fm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T_V) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k_alpha) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k_q) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T_alpha) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T_q) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ds) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_CopyElementContinuousStateType(SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(UA_ElementContinuousStateType), intent(in) :: SrcElementContinuousStateTypeData + type(UA_ElementContinuousStateType), intent(inout) :: DstElementContinuousStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_CopyElementContinuousStateType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%FirstPass)) THEN - i1_l = LBOUND(SrcOtherStateData%FirstPass,1) - i1_u = UBOUND(SrcOtherStateData%FirstPass,1) - i2_l = LBOUND(SrcOtherStateData%FirstPass,2) - i2_u = UBOUND(SrcOtherStateData%FirstPass,2) - IF (.NOT. ALLOCATED(DstOtherStateData%FirstPass)) THEN - ALLOCATE(DstOtherStateData%FirstPass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FirstPass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%FirstPass = SrcOtherStateData%FirstPass -ENDIF -IF (ALLOCATED(SrcOtherStateData%sigma1)) THEN - i1_l = LBOUND(SrcOtherStateData%sigma1,1) - i1_u = UBOUND(SrcOtherStateData%sigma1,1) - i2_l = LBOUND(SrcOtherStateData%sigma1,2) - i2_u = UBOUND(SrcOtherStateData%sigma1,2) - IF (.NOT. ALLOCATED(DstOtherStateData%sigma1)) THEN - ALLOCATE(DstOtherStateData%sigma1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%sigma1 = SrcOtherStateData%sigma1 -ENDIF -IF (ALLOCATED(SrcOtherStateData%sigma1c)) THEN - i1_l = LBOUND(SrcOtherStateData%sigma1c,1) - i1_u = UBOUND(SrcOtherStateData%sigma1c,1) - i2_l = LBOUND(SrcOtherStateData%sigma1c,2) - i2_u = UBOUND(SrcOtherStateData%sigma1c,2) - IF (.NOT. ALLOCATED(DstOtherStateData%sigma1c)) THEN - ALLOCATE(DstOtherStateData%sigma1c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%sigma1c = SrcOtherStateData%sigma1c -ENDIF -IF (ALLOCATED(SrcOtherStateData%sigma1m)) THEN - i1_l = LBOUND(SrcOtherStateData%sigma1m,1) - i1_u = UBOUND(SrcOtherStateData%sigma1m,1) - i2_l = LBOUND(SrcOtherStateData%sigma1m,2) - i2_u = UBOUND(SrcOtherStateData%sigma1m,2) - IF (.NOT. ALLOCATED(DstOtherStateData%sigma1m)) THEN - ALLOCATE(DstOtherStateData%sigma1m(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%sigma1m = SrcOtherStateData%sigma1m -ENDIF -IF (ALLOCATED(SrcOtherStateData%sigma3)) THEN - i1_l = LBOUND(SrcOtherStateData%sigma3,1) - i1_u = UBOUND(SrcOtherStateData%sigma3,1) - i2_l = LBOUND(SrcOtherStateData%sigma3,2) - i2_u = UBOUND(SrcOtherStateData%sigma3,2) - IF (.NOT. ALLOCATED(DstOtherStateData%sigma3)) THEN - ALLOCATE(DstOtherStateData%sigma3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%sigma3 = SrcOtherStateData%sigma3 -ENDIF -IF (ALLOCATED(SrcOtherStateData%n)) THEN - i1_l = LBOUND(SrcOtherStateData%n,1) - i1_u = UBOUND(SrcOtherStateData%n,1) - i2_l = LBOUND(SrcOtherStateData%n,2) - i2_u = UBOUND(SrcOtherStateData%n,2) - IF (.NOT. ALLOCATED(DstOtherStateData%n)) THEN - ALLOCATE(DstOtherStateData%n(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%n = SrcOtherStateData%n -ENDIF - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL UA_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -IF (ALLOCATED(SrcOtherStateData%t_vortexBegin)) THEN - i1_l = LBOUND(SrcOtherStateData%t_vortexBegin,1) - i1_u = UBOUND(SrcOtherStateData%t_vortexBegin,1) - i2_l = LBOUND(SrcOtherStateData%t_vortexBegin,2) - i2_u = UBOUND(SrcOtherStateData%t_vortexBegin,2) - IF (.NOT. ALLOCATED(DstOtherStateData%t_vortexBegin)) THEN - ALLOCATE(DstOtherStateData%t_vortexBegin(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%t_vortexBegin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%t_vortexBegin = SrcOtherStateData%t_vortexBegin -ENDIF -IF (ALLOCATED(SrcOtherStateData%SignOfOmega)) THEN - i1_l = LBOUND(SrcOtherStateData%SignOfOmega,1) - i1_u = UBOUND(SrcOtherStateData%SignOfOmega,1) - i2_l = LBOUND(SrcOtherStateData%SignOfOmega,2) - i2_u = UBOUND(SrcOtherStateData%SignOfOmega,2) - IF (.NOT. ALLOCATED(DstOtherStateData%SignOfOmega)) THEN - ALLOCATE(DstOtherStateData%SignOfOmega(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%SignOfOmega.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%SignOfOmega = SrcOtherStateData%SignOfOmega -ENDIF -IF (ALLOCATED(SrcOtherStateData%PositivePressure)) THEN - i1_l = LBOUND(SrcOtherStateData%PositivePressure,1) - i1_u = UBOUND(SrcOtherStateData%PositivePressure,1) - i2_l = LBOUND(SrcOtherStateData%PositivePressure,2) - i2_u = UBOUND(SrcOtherStateData%PositivePressure,2) - IF (.NOT. ALLOCATED(DstOtherStateData%PositivePressure)) THEN - ALLOCATE(DstOtherStateData%PositivePressure(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%PositivePressure.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%PositivePressure = SrcOtherStateData%PositivePressure -ENDIF -IF (ALLOCATED(SrcOtherStateData%vortexOn)) THEN - i1_l = LBOUND(SrcOtherStateData%vortexOn,1) - i1_u = UBOUND(SrcOtherStateData%vortexOn,1) - i2_l = LBOUND(SrcOtherStateData%vortexOn,2) - i2_u = UBOUND(SrcOtherStateData%vortexOn,2) - IF (.NOT. ALLOCATED(DstOtherStateData%vortexOn)) THEN - ALLOCATE(DstOtherStateData%vortexOn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%vortexOn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%vortexOn = SrcOtherStateData%vortexOn -ENDIF -IF (ALLOCATED(SrcOtherStateData%BelowThreshold)) THEN - i1_l = LBOUND(SrcOtherStateData%BelowThreshold,1) - i1_u = UBOUND(SrcOtherStateData%BelowThreshold,1) - i2_l = LBOUND(SrcOtherStateData%BelowThreshold,2) - i2_u = UBOUND(SrcOtherStateData%BelowThreshold,2) - IF (.NOT. ALLOCATED(DstOtherStateData%BelowThreshold)) THEN - ALLOCATE(DstOtherStateData%BelowThreshold(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BelowThreshold.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%BelowThreshold = SrcOtherStateData%BelowThreshold -ENDIF -IF (ALLOCATED(SrcOtherStateData%activeL)) THEN - i1_l = LBOUND(SrcOtherStateData%activeL,1) - i1_u = UBOUND(SrcOtherStateData%activeL,1) - i2_l = LBOUND(SrcOtherStateData%activeL,2) - i2_u = UBOUND(SrcOtherStateData%activeL,2) - IF (.NOT. ALLOCATED(DstOtherStateData%activeL)) THEN - ALLOCATE(DstOtherStateData%activeL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%activeL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%activeL = SrcOtherStateData%activeL -ENDIF -IF (ALLOCATED(SrcOtherStateData%activeD)) THEN - i1_l = LBOUND(SrcOtherStateData%activeD,1) - i1_u = UBOUND(SrcOtherStateData%activeD,1) - i2_l = LBOUND(SrcOtherStateData%activeD,2) - i2_u = UBOUND(SrcOtherStateData%activeD,2) - IF (.NOT. ALLOCATED(DstOtherStateData%activeD)) THEN - ALLOCATE(DstOtherStateData%activeD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%activeD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%activeD = SrcOtherStateData%activeD -ENDIF - END SUBROUTINE UA_CopyOtherState - - SUBROUTINE UA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(UA_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 = 'UA_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%FirstPass)) THEN - DEALLOCATE(OtherStateData%FirstPass) -ENDIF -IF (ALLOCATED(OtherStateData%sigma1)) THEN - DEALLOCATE(OtherStateData%sigma1) -ENDIF -IF (ALLOCATED(OtherStateData%sigma1c)) THEN - DEALLOCATE(OtherStateData%sigma1c) -ENDIF -IF (ALLOCATED(OtherStateData%sigma1m)) THEN - DEALLOCATE(OtherStateData%sigma1m) -ENDIF -IF (ALLOCATED(OtherStateData%sigma3)) THEN - DEALLOCATE(OtherStateData%sigma3) -ENDIF -IF (ALLOCATED(OtherStateData%n)) THEN - DEALLOCATE(OtherStateData%n) -ENDIF -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL UA_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -IF (ALLOCATED(OtherStateData%t_vortexBegin)) THEN - DEALLOCATE(OtherStateData%t_vortexBegin) -ENDIF -IF (ALLOCATED(OtherStateData%SignOfOmega)) THEN - DEALLOCATE(OtherStateData%SignOfOmega) -ENDIF -IF (ALLOCATED(OtherStateData%PositivePressure)) THEN - DEALLOCATE(OtherStateData%PositivePressure) -ENDIF -IF (ALLOCATED(OtherStateData%vortexOn)) THEN - DEALLOCATE(OtherStateData%vortexOn) -ENDIF -IF (ALLOCATED(OtherStateData%BelowThreshold)) THEN - DEALLOCATE(OtherStateData%BelowThreshold) -ENDIF -IF (ALLOCATED(OtherStateData%activeL)) THEN - DEALLOCATE(OtherStateData%activeL) -ENDIF -IF (ALLOCATED(OtherStateData%activeD)) THEN - DEALLOCATE(OtherStateData%activeD) -ENDIF - END SUBROUTINE UA_DestroyOtherState - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! FirstPass allocated yes/no - IF ( ALLOCATED(InData%FirstPass) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FirstPass upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FirstPass) ! FirstPass - END IF - Int_BufSz = Int_BufSz + 1 ! sigma1 allocated yes/no - IF ( ALLOCATED(InData%sigma1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! sigma1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%sigma1) ! sigma1 - END IF - Int_BufSz = Int_BufSz + 1 ! sigma1c allocated yes/no - IF ( ALLOCATED(InData%sigma1c) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! sigma1c upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%sigma1c) ! sigma1c - END IF - Int_BufSz = Int_BufSz + 1 ! sigma1m allocated yes/no - IF ( ALLOCATED(InData%sigma1m) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! sigma1m upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%sigma1m) ! sigma1m - END IF - Int_BufSz = Int_BufSz + 1 ! sigma3 allocated yes/no - IF ( ALLOCATED(InData%sigma3) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! sigma3 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%sigma3) ! sigma3 - END IF - Int_BufSz = Int_BufSz + 1 ! n allocated yes/no - IF ( ALLOCATED(InData%n) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! n upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%n) ! n - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 1 ! t_vortexBegin allocated yes/no - IF ( ALLOCATED(InData%t_vortexBegin) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! t_vortexBegin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%t_vortexBegin) ! t_vortexBegin - END IF - Int_BufSz = Int_BufSz + 1 ! SignOfOmega allocated yes/no - IF ( ALLOCATED(InData%SignOfOmega) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SignOfOmega upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SignOfOmega) ! SignOfOmega - END IF - Int_BufSz = Int_BufSz + 1 ! PositivePressure allocated yes/no - IF ( ALLOCATED(InData%PositivePressure) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PositivePressure upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PositivePressure) ! PositivePressure - END IF - Int_BufSz = Int_BufSz + 1 ! vortexOn allocated yes/no - IF ( ALLOCATED(InData%vortexOn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vortexOn upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%vortexOn) ! vortexOn - END IF - Int_BufSz = Int_BufSz + 1 ! BelowThreshold allocated yes/no - IF ( ALLOCATED(InData%BelowThreshold) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BelowThreshold upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BelowThreshold) ! BelowThreshold - END IF - Int_BufSz = Int_BufSz + 1 ! activeL allocated yes/no - IF ( ALLOCATED(InData%activeL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! activeL upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%activeL) ! activeL - END IF - Int_BufSz = Int_BufSz + 1 ! activeD allocated yes/no - IF ( ALLOCATED(InData%activeD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! activeD upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%activeD) ! activeD - 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%FirstPass) ) 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%FirstPass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstPass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FirstPass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstPass,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FirstPass,2), UBOUND(InData%FirstPass,2) - DO i1 = LBOUND(InData%FirstPass,1), UBOUND(InData%FirstPass,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstPass(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%sigma1) ) 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%sigma1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%sigma1,2), UBOUND(InData%sigma1,2) - DO i1 = LBOUND(InData%sigma1,1), UBOUND(InData%sigma1,1) - ReKiBuf(Re_Xferred) = InData%sigma1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%sigma1c) ) 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%sigma1c,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1c,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma1c,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1c,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%sigma1c,2), UBOUND(InData%sigma1c,2) - DO i1 = LBOUND(InData%sigma1c,1), UBOUND(InData%sigma1c,1) - ReKiBuf(Re_Xferred) = InData%sigma1c(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%sigma1m) ) 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%sigma1m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1m,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma1m,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1m,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%sigma1m,2), UBOUND(InData%sigma1m,2) - DO i1 = LBOUND(InData%sigma1m,1), UBOUND(InData%sigma1m,1) - ReKiBuf(Re_Xferred) = InData%sigma1m(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%sigma3) ) 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%sigma3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma3,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%sigma3,2), UBOUND(InData%sigma3,2) - DO i1 = LBOUND(InData%sigma3,1), UBOUND(InData%sigma3,1) - ReKiBuf(Re_Xferred) = InData%sigma3(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%n) ) 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%n,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%n,2), UBOUND(InData%n,2) - DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - 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 - IF ( .NOT. ALLOCATED(InData%t_vortexBegin) ) 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%t_vortexBegin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t_vortexBegin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t_vortexBegin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t_vortexBegin,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%t_vortexBegin,2), UBOUND(InData%t_vortexBegin,2) - DO i1 = LBOUND(InData%t_vortexBegin,1), UBOUND(InData%t_vortexBegin,1) - ReKiBuf(Re_Xferred) = InData%t_vortexBegin(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SignOfOmega) ) 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%SignOfOmega,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SignOfOmega,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SignOfOmega,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SignOfOmega,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SignOfOmega,2), UBOUND(InData%SignOfOmega,2) - DO i1 = LBOUND(InData%SignOfOmega,1), UBOUND(InData%SignOfOmega,1) - ReKiBuf(Re_Xferred) = InData%SignOfOmega(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PositivePressure) ) 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%PositivePressure,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositivePressure,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PositivePressure,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositivePressure,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PositivePressure,2), UBOUND(InData%PositivePressure,2) - DO i1 = LBOUND(InData%PositivePressure,1), UBOUND(InData%PositivePressure,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%PositivePressure(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vortexOn) ) 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%vortexOn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vortexOn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vortexOn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vortexOn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vortexOn,2), UBOUND(InData%vortexOn,2) - DO i1 = LBOUND(InData%vortexOn,1), UBOUND(InData%vortexOn,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%vortexOn(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BelowThreshold) ) 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%BelowThreshold,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BelowThreshold,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BelowThreshold,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BelowThreshold,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BelowThreshold,2), UBOUND(InData%BelowThreshold,2) - DO i1 = LBOUND(InData%BelowThreshold,1), UBOUND(InData%BelowThreshold,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%BelowThreshold(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%activeL) ) 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%activeL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%activeL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%activeL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%activeL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%activeL,2), UBOUND(InData%activeL,2) - DO i1 = LBOUND(InData%activeL,1), UBOUND(InData%activeL,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%activeL(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%activeD) ) 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%activeD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%activeD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%activeD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%activeD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%activeD,2), UBOUND(InData%activeD,2) - DO i1 = LBOUND(InData%activeD,1), UBOUND(InData%activeD,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%activeD(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_PackOtherState - - SUBROUTINE UA_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(UA_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) :: 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 = 'UA_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FirstPass 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%FirstPass)) DEALLOCATE(OutData%FirstPass) - ALLOCATE(OutData%FirstPass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstPass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FirstPass,2), UBOUND(OutData%FirstPass,2) - DO i1 = LBOUND(OutData%FirstPass,1), UBOUND(OutData%FirstPass,1) - OutData%FirstPass(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstPass(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1 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%sigma1)) DEALLOCATE(OutData%sigma1) - ALLOCATE(OutData%sigma1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%sigma1,2), UBOUND(OutData%sigma1,2) - DO i1 = LBOUND(OutData%sigma1,1), UBOUND(OutData%sigma1,1) - OutData%sigma1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1c 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%sigma1c)) DEALLOCATE(OutData%sigma1c) - ALLOCATE(OutData%sigma1c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%sigma1c,2), UBOUND(OutData%sigma1c,2) - DO i1 = LBOUND(OutData%sigma1c,1), UBOUND(OutData%sigma1c,1) - OutData%sigma1c(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1m 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%sigma1m)) DEALLOCATE(OutData%sigma1m) - ALLOCATE(OutData%sigma1m(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%sigma1m,2), UBOUND(OutData%sigma1m,2) - DO i1 = LBOUND(OutData%sigma1m,1), UBOUND(OutData%sigma1m,1) - OutData%sigma1m(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma3 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%sigma3)) DEALLOCATE(OutData%sigma3) - ALLOCATE(OutData%sigma3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%sigma3,2), UBOUND(OutData%sigma3,2) - DO i1 = LBOUND(OutData%sigma3,1), UBOUND(OutData%sigma3,1) - OutData%sigma3(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n 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%n)) DEALLOCATE(OutData%n) - ALLOCATE(OutData%n(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%n,2), UBOUND(OutData%n,2) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,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 UA_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t_vortexBegin 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%t_vortexBegin)) DEALLOCATE(OutData%t_vortexBegin) - ALLOCATE(OutData%t_vortexBegin(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_vortexBegin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%t_vortexBegin,2), UBOUND(OutData%t_vortexBegin,2) - DO i1 = LBOUND(OutData%t_vortexBegin,1), UBOUND(OutData%t_vortexBegin,1) - OutData%t_vortexBegin(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SignOfOmega 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%SignOfOmega)) DEALLOCATE(OutData%SignOfOmega) - ALLOCATE(OutData%SignOfOmega(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SignOfOmega.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SignOfOmega,2), UBOUND(OutData%SignOfOmega,2) - DO i1 = LBOUND(OutData%SignOfOmega,1), UBOUND(OutData%SignOfOmega,1) - OutData%SignOfOmega(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PositivePressure 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%PositivePressure)) DEALLOCATE(OutData%PositivePressure) - ALLOCATE(OutData%PositivePressure(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositivePressure.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PositivePressure,2), UBOUND(OutData%PositivePressure,2) - DO i1 = LBOUND(OutData%PositivePressure,1), UBOUND(OutData%PositivePressure,1) - OutData%PositivePressure(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%PositivePressure(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vortexOn 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%vortexOn)) DEALLOCATE(OutData%vortexOn) - ALLOCATE(OutData%vortexOn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vortexOn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vortexOn,2), UBOUND(OutData%vortexOn,2) - DO i1 = LBOUND(OutData%vortexOn,1), UBOUND(OutData%vortexOn,1) - OutData%vortexOn(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%vortexOn(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BelowThreshold 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%BelowThreshold)) DEALLOCATE(OutData%BelowThreshold) - ALLOCATE(OutData%BelowThreshold(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BelowThreshold.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BelowThreshold,2), UBOUND(OutData%BelowThreshold,2) - DO i1 = LBOUND(OutData%BelowThreshold,1), UBOUND(OutData%BelowThreshold,1) - OutData%BelowThreshold(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BelowThreshold(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! activeL 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%activeL)) DEALLOCATE(OutData%activeL) - ALLOCATE(OutData%activeL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%activeL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%activeL,2), UBOUND(OutData%activeL,2) - DO i1 = LBOUND(OutData%activeL,1), UBOUND(OutData%activeL,1) - OutData%activeL(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%activeL(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! activeD 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%activeD)) DEALLOCATE(OutData%activeD) - ALLOCATE(OutData%activeD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%activeD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%activeD,2), UBOUND(OutData%activeD,2) - DO i1 = LBOUND(OutData%activeD,1), UBOUND(OutData%activeD,1) - OutData%activeD(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%activeD(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_UnPackOtherState - - SUBROUTINE UA_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(UA_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) :: 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 = 'UA_CopyMisc' -! + ErrMsg = '' + DstElementContinuousStateTypeData%x = SrcElementContinuousStateTypeData%x +end subroutine + +subroutine UA_DestroyElementContinuousStateType(ElementContinuousStateTypeData, ErrStat, ErrMsg) + type(UA_ElementContinuousStateType), intent(inout) :: ElementContinuousStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyElementContinuousStateType' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%FirstWarn_M = SrcMiscData%FirstWarn_M - DstMiscData%FirstWarn_UA = SrcMiscData%FirstWarn_UA - DstMiscData%FirstWarn_UA_off = SrcMiscData%FirstWarn_UA_off -IF (ALLOCATED(SrcMiscData%TESF)) THEN - i1_l = LBOUND(SrcMiscData%TESF,1) - i1_u = UBOUND(SrcMiscData%TESF,1) - i2_l = LBOUND(SrcMiscData%TESF,2) - i2_u = UBOUND(SrcMiscData%TESF,2) - IF (.NOT. ALLOCATED(DstMiscData%TESF)) THEN - ALLOCATE(DstMiscData%TESF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TESF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%TESF = SrcMiscData%TESF -ENDIF -IF (ALLOCATED(SrcMiscData%LESF)) THEN - i1_l = LBOUND(SrcMiscData%LESF,1) - i1_u = UBOUND(SrcMiscData%LESF,1) - i2_l = LBOUND(SrcMiscData%LESF,2) - i2_u = UBOUND(SrcMiscData%LESF,2) - IF (.NOT. ALLOCATED(DstMiscData%LESF)) THEN - ALLOCATE(DstMiscData%LESF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LESF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LESF = SrcMiscData%LESF -ENDIF -IF (ALLOCATED(SrcMiscData%VRTX)) THEN - i1_l = LBOUND(SrcMiscData%VRTX,1) - i1_u = UBOUND(SrcMiscData%VRTX,1) - i2_l = LBOUND(SrcMiscData%VRTX,2) - i2_u = UBOUND(SrcMiscData%VRTX,2) - IF (.NOT. ALLOCATED(DstMiscData%VRTX)) THEN - ALLOCATE(DstMiscData%VRTX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%VRTX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%VRTX = SrcMiscData%VRTX -ENDIF -IF (ALLOCATED(SrcMiscData%T_Sh)) THEN - i1_l = LBOUND(SrcMiscData%T_Sh,1) - i1_u = UBOUND(SrcMiscData%T_Sh,1) - i2_l = LBOUND(SrcMiscData%T_Sh,2) - i2_u = UBOUND(SrcMiscData%T_Sh,2) - IF (.NOT. ALLOCATED(DstMiscData%T_Sh)) THEN - ALLOCATE(DstMiscData%T_Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%T_Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%T_Sh = SrcMiscData%T_Sh -ENDIF -IF (ALLOCATED(SrcMiscData%BEDSEP)) THEN - i1_l = LBOUND(SrcMiscData%BEDSEP,1) - i1_u = UBOUND(SrcMiscData%BEDSEP,1) - i2_l = LBOUND(SrcMiscData%BEDSEP,2) - i2_u = UBOUND(SrcMiscData%BEDSEP,2) - IF (.NOT. ALLOCATED(DstMiscData%BEDSEP)) THEN - ALLOCATE(DstMiscData%BEDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BEDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BEDSEP = SrcMiscData%BEDSEP -ENDIF -IF (ALLOCATED(SrcMiscData%weight)) THEN - i1_l = LBOUND(SrcMiscData%weight,1) - i1_u = UBOUND(SrcMiscData%weight,1) - i2_l = LBOUND(SrcMiscData%weight,2) - i2_u = UBOUND(SrcMiscData%weight,2) - IF (.NOT. ALLOCATED(DstMiscData%weight)) THEN - ALLOCATE(DstMiscData%weight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%weight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%weight = SrcMiscData%weight -ENDIF - END SUBROUTINE UA_CopyMisc - - SUBROUTINE UA_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(UA_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 = 'UA_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%TESF)) THEN - DEALLOCATE(MiscData%TESF) -ENDIF -IF (ALLOCATED(MiscData%LESF)) THEN - DEALLOCATE(MiscData%LESF) -ENDIF -IF (ALLOCATED(MiscData%VRTX)) THEN - DEALLOCATE(MiscData%VRTX) -ENDIF -IF (ALLOCATED(MiscData%T_Sh)) THEN - DEALLOCATE(MiscData%T_Sh) -ENDIF -IF (ALLOCATED(MiscData%BEDSEP)) THEN - DEALLOCATE(MiscData%BEDSEP) -ENDIF -IF (ALLOCATED(MiscData%weight)) THEN - DEALLOCATE(MiscData%weight) -ENDIF - END SUBROUTINE UA_DestroyMisc - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! FirstWarn_M - Int_BufSz = Int_BufSz + 1 ! FirstWarn_UA - Int_BufSz = Int_BufSz + 1 ! FirstWarn_UA_off - Int_BufSz = Int_BufSz + 1 ! TESF allocated yes/no - IF ( ALLOCATED(InData%TESF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TESF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%TESF) ! TESF - END IF - Int_BufSz = Int_BufSz + 1 ! LESF allocated yes/no - IF ( ALLOCATED(InData%LESF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LESF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LESF) ! LESF - END IF - Int_BufSz = Int_BufSz + 1 ! VRTX allocated yes/no - IF ( ALLOCATED(InData%VRTX) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VRTX upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%VRTX) ! VRTX - END IF - Int_BufSz = Int_BufSz + 1 ! T_Sh allocated yes/no - IF ( ALLOCATED(InData%T_Sh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T_Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%T_Sh) ! T_Sh - END IF - Int_BufSz = Int_BufSz + 1 ! BEDSEP allocated yes/no - IF ( ALLOCATED(InData%BEDSEP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BEDSEP upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BEDSEP) ! BEDSEP - END IF - Int_BufSz = Int_BufSz + 1 ! weight allocated yes/no - IF ( ALLOCATED(InData%weight) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! weight upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%weight) ! weight - 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 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_M, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_UA, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_UA_off, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TESF) ) 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%TESF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TESF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TESF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TESF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TESF,2), UBOUND(InData%TESF,2) - DO i1 = LBOUND(InData%TESF,1), UBOUND(InData%TESF,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%TESF(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LESF) ) 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%LESF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LESF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LESF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LESF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LESF,2), UBOUND(InData%LESF,2) - DO i1 = LBOUND(InData%LESF,1), UBOUND(InData%LESF,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%LESF(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VRTX) ) 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%VRTX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VRTX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VRTX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VRTX,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%VRTX,2), UBOUND(InData%VRTX,2) - DO i1 = LBOUND(InData%VRTX,1), UBOUND(InData%VRTX,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%VRTX(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%T_Sh) ) 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%T_Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_Sh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_Sh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_Sh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%T_Sh,2), UBOUND(InData%T_Sh,2) - DO i1 = LBOUND(InData%T_Sh,1), UBOUND(InData%T_Sh,1) - ReKiBuf(Re_Xferred) = InData%T_Sh(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BEDSEP) ) 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%BEDSEP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BEDSEP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BEDSEP,2), UBOUND(InData%BEDSEP,2) - DO i1 = LBOUND(InData%BEDSEP,1), UBOUND(InData%BEDSEP,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%BEDSEP(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%weight) ) 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%weight,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%weight,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%weight,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%weight,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%weight,2), UBOUND(InData%weight,2) - DO i1 = LBOUND(InData%weight,1), UBOUND(InData%weight,1) - ReKiBuf(Re_Xferred) = InData%weight(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_PackMisc - - SUBROUTINE UA_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(UA_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) :: 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 = 'UA_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%FirstWarn_M = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_M) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn_UA = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_UA) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn_UA_off = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_UA_off) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TESF 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%TESF)) DEALLOCATE(OutData%TESF) - ALLOCATE(OutData%TESF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TESF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TESF,2), UBOUND(OutData%TESF,2) - DO i1 = LBOUND(OutData%TESF,1), UBOUND(OutData%TESF,1) - OutData%TESF(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%TESF(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LESF 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%LESF)) DEALLOCATE(OutData%LESF) - ALLOCATE(OutData%LESF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LESF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LESF,2), UBOUND(OutData%LESF,2) - DO i1 = LBOUND(OutData%LESF,1), UBOUND(OutData%LESF,1) - OutData%LESF(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%LESF(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VRTX 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%VRTX)) DEALLOCATE(OutData%VRTX) - ALLOCATE(OutData%VRTX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VRTX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%VRTX,2), UBOUND(OutData%VRTX,2) - DO i1 = LBOUND(OutData%VRTX,1), UBOUND(OutData%VRTX,1) - OutData%VRTX(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%VRTX(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_Sh 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%T_Sh)) DEALLOCATE(OutData%T_Sh) - ALLOCATE(OutData%T_Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%T_Sh,2), UBOUND(OutData%T_Sh,2) - DO i1 = LBOUND(OutData%T_Sh,1), UBOUND(OutData%T_Sh,1) - OutData%T_Sh(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BEDSEP 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%BEDSEP)) DEALLOCATE(OutData%BEDSEP) - ALLOCATE(OutData%BEDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BEDSEP,2), UBOUND(OutData%BEDSEP,2) - DO i1 = LBOUND(OutData%BEDSEP,1), UBOUND(OutData%BEDSEP,1) - OutData%BEDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BEDSEP(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! weight 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%weight)) DEALLOCATE(OutData%weight) - ALLOCATE(OutData%weight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%weight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%weight,2), UBOUND(OutData%weight,2) - DO i1 = LBOUND(OutData%weight,1), UBOUND(OutData%weight,1) - OutData%weight(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_UnPackMisc - - SUBROUTINE UA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_ParameterType), INTENT(IN) :: SrcParamData - TYPE(UA_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 = 'UA_CopyParam' -! + ErrMsg = '' +end subroutine + +subroutine UA_PackElementContinuousStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_ElementContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackElementContinuousStateType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%x) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackElementContinuousStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_ElementContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackElementContinuousStateType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%x) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(UA_ContinuousStateType), intent(in) :: SrcContStateData + type(UA_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%dt = SrcParamData%dt -IF (ALLOCATED(SrcParamData%c)) THEN - i1_l = LBOUND(SrcParamData%c,1) - i1_u = UBOUND(SrcParamData%c,1) - i2_l = LBOUND(SrcParamData%c,2) - i2_u = UBOUND(SrcParamData%c,2) - IF (.NOT. ALLOCATED(DstParamData%c)) THEN - ALLOCATE(DstParamData%c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%c = SrcParamData%c -ENDIF - DstParamData%numBlades = SrcParamData%numBlades - DstParamData%nNodesPerBlade = SrcParamData%nNodesPerBlade - DstParamData%UAMod = SrcParamData%UAMod - DstParamData%Flookup = SrcParamData%Flookup - DstParamData%a_s = SrcParamData%a_s - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - DstParamData%Delim = SrcParamData%Delim - DstParamData%UnOutFile = SrcParamData%UnOutFile - DstParamData%ShedEffect = SrcParamData%ShedEffect - DstParamData%lin_nx = SrcParamData%lin_nx -IF (ALLOCATED(SrcParamData%UA_off_forGood)) THEN - i1_l = LBOUND(SrcParamData%UA_off_forGood,1) - i1_u = UBOUND(SrcParamData%UA_off_forGood,1) - i2_l = LBOUND(SrcParamData%UA_off_forGood,2) - i2_u = UBOUND(SrcParamData%UA_off_forGood,2) - IF (.NOT. ALLOCATED(DstParamData%UA_off_forGood)) THEN - ALLOCATE(DstParamData%UA_off_forGood(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%UA_off_forGood.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%UA_off_forGood = SrcParamData%UA_off_forGood -ENDIF - END SUBROUTINE UA_CopyParam - - SUBROUTINE UA_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(UA_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 = 'UA_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%c)) THEN - DEALLOCATE(ParamData%c) -ENDIF -IF (ALLOCATED(ParamData%UA_off_forGood)) THEN - DEALLOCATE(ParamData%UA_off_forGood) -ENDIF - END SUBROUTINE UA_DestroyParam - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! c allocated yes/no - IF ( ALLOCATED(InData%c) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! c upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%c) ! c - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Int_BufSz = Int_BufSz + 1 ! nNodesPerBlade - Int_BufSz = Int_BufSz + 1 ! UAMod - Int_BufSz = Int_BufSz + 1 ! Flookup - Re_BufSz = Re_BufSz + 1 ! a_s - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutSwtch - 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 - Int_BufSz = Int_BufSz + 1 ! ShedEffect - Int_BufSz = Int_BufSz + 1 ! lin_nx - Int_BufSz = Int_BufSz + 1 ! UA_off_forGood allocated yes/no - IF ( ALLOCATED(InData%UA_off_forGood) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! UA_off_forGood upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UA_off_forGood) ! UA_off_forGood - 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 - - DbKiBuf(Db_Xferred) = InData%dt - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%c) ) 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%c,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%c,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%c,2), UBOUND(InData%c,2) - DO i1 = LBOUND(InData%c,1), UBOUND(InData%c,1) - ReKiBuf(Re_Xferred) = InData%c(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodesPerBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutSwtch - 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ShedEffect, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%lin_nx - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UA_off_forGood) ) 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%UA_off_forGood,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA_off_forGood,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UA_off_forGood,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA_off_forGood,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%UA_off_forGood,2), UBOUND(InData%UA_off_forGood,2) - DO i1 = LBOUND(InData%UA_off_forGood,1), UBOUND(InData%UA_off_forGood,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_off_forGood(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_PackParam - - SUBROUTINE UA_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(UA_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 = 'UA_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! c 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%c)) DEALLOCATE(OutData%c) - ALLOCATE(OutData%c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%c,2), UBOUND(OutData%c,2) - DO i1 = LBOUND(OutData%c,1), UBOUND(OutData%c,1) - OutData%c(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodesPerBlade = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UAMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = 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 - OutData%ShedEffect = TRANSFER(IntKiBuf(Int_Xferred), OutData%ShedEffect) - Int_Xferred = Int_Xferred + 1 - OutData%lin_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UA_off_forGood 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%UA_off_forGood)) DEALLOCATE(OutData%UA_off_forGood) - ALLOCATE(OutData%UA_off_forGood(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA_off_forGood.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%UA_off_forGood,2), UBOUND(OutData%UA_off_forGood,2) - DO i1 = LBOUND(OutData%UA_off_forGood,1), UBOUND(OutData%UA_off_forGood,1) - OutData%UA_off_forGood(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_off_forGood(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_UnPackParam - - SUBROUTINE UA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_InputType), INTENT(IN) :: SrcInputData - TYPE(UA_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyInput' -! + ErrMsg = '' + if (allocated(SrcContStateData%element)) then + LB(1:2) = lbound(SrcContStateData%element) + UB(1:2) = ubound(SrcContStateData%element) + if (.not. allocated(DstContStateData%element)) then + allocate(DstContStateData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%element.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_CopyElementContinuousStateType(SrcContStateData%element(i1,i2), DstContStateData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if +end subroutine + +subroutine UA_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(UA_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstInputData%U = SrcInputData%U - DstInputData%alpha = SrcInputData%alpha - DstInputData%Re = SrcInputData%Re - DstInputData%UserProp = SrcInputData%UserProp - DstInputData%v_ac = SrcInputData%v_ac - DstInputData%omega = SrcInputData%omega - END SUBROUTINE UA_CopyInput - - SUBROUTINE UA_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(UA_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 = 'UA_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE UA_DestroyInput - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! U - Re_BufSz = Re_BufSz + 1 ! alpha - Re_BufSz = Re_BufSz + 1 ! Re - Re_BufSz = Re_BufSz + 1 ! UserProp - Re_BufSz = Re_BufSz + SIZE(InData%v_ac) ! v_ac - Re_BufSz = Re_BufSz + 1 ! omega - 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%U - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Re - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UserProp - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%v_ac,1), UBOUND(InData%v_ac,1) - ReKiBuf(Re_Xferred) = InData%v_ac(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%omega - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_PackInput - - SUBROUTINE UA_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(UA_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_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%U = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UserProp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%v_ac,1) - i1_u = UBOUND(OutData%v_ac,1) - DO i1 = LBOUND(OutData%v_ac,1), UBOUND(OutData%v_ac,1) - OutData%v_ac(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%omega = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_UnPackInput - - SUBROUTINE UA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_OutputType), INTENT(IN) :: SrcOutputData - TYPE(UA_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 = 'UA_CopyOutput' -! + ErrMsg = '' + if (allocated(ContStateData%element)) then + LB(1:2) = lbound(ContStateData%element) + UB(1:2) = ubound(ContStateData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_DestroyElementContinuousStateType(ContStateData%element(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ContStateData%element) + end if +end subroutine + +subroutine UA_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackContState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%element)) + if (allocated(InData%element)) then + call RegPackBounds(Buf, 2, lbound(InData%element), ubound(InData%element)) + LB(1:2) = lbound(InData%element) + UB(1:2) = ubound(InData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_PackElementContinuousStateType(Buf, InData%element(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackContState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%element)) deallocate(OutData%element) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%element(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_UnpackElementContinuousStateType(Buf, OutData%element(i1,i2)) ! element + end do + end do + end if +end subroutine + +subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(UA_DiscreteStateType), intent(in) :: SrcDiscStateData + type(UA_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'UA_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstOutputData%Cn = SrcOutputData%Cn - DstOutputData%Cc = SrcOutputData%Cc - DstOutputData%Cm = SrcOutputData%Cm - DstOutputData%Cl = SrcOutputData%Cl - DstOutputData%Cd = SrcOutputData%Cd -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 UA_CopyOutput - - SUBROUTINE UA_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(UA_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 = 'UA_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE UA_DestroyOutput - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! Cn - Re_BufSz = Re_BufSz + 1 ! Cc - Re_BufSz = Re_BufSz + 1 ! Cm - Re_BufSz = Re_BufSz + 1 ! Cl - Re_BufSz = Re_BufSz + 1 ! Cd - 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 - - ReKiBuf(Re_Xferred) = InData%Cn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cd - Re_Xferred = Re_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 UA_PackOutput - - SUBROUTINE UA_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(UA_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 = 'UA_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%Cn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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 UA_UnPackOutput - - - SUBROUTINE UA_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(UA_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(UA_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 + ErrMsg = '' + if (allocated(SrcDiscStateData%alpha_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%alpha_minus1) + UB(1:2) = ubound(SrcDiscStateData%alpha_minus1) + if (.not. allocated(DstDiscStateData%alpha_minus1)) then + allocate(DstDiscStateData%alpha_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%alpha_minus1 = SrcDiscStateData%alpha_minus1 + end if + if (allocated(SrcDiscStateData%alpha_filt_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%alpha_filt_minus1) + UB(1:2) = ubound(SrcDiscStateData%alpha_filt_minus1) + if (.not. allocated(DstDiscStateData%alpha_filt_minus1)) then + allocate(DstDiscStateData%alpha_filt_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_filt_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%alpha_filt_minus1 = SrcDiscStateData%alpha_filt_minus1 + end if + if (allocated(SrcDiscStateData%alpha_dot)) then + LB(1:2) = lbound(SrcDiscStateData%alpha_dot) + UB(1:2) = ubound(SrcDiscStateData%alpha_dot) + if (.not. allocated(DstDiscStateData%alpha_dot)) then + allocate(DstDiscStateData%alpha_dot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_dot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%alpha_dot = SrcDiscStateData%alpha_dot + end if + if (allocated(SrcDiscStateData%alpha_dot_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%alpha_dot_minus1) + UB(1:2) = ubound(SrcDiscStateData%alpha_dot_minus1) + if (.not. allocated(DstDiscStateData%alpha_dot_minus1)) then + allocate(DstDiscStateData%alpha_dot_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_dot_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%alpha_dot_minus1 = SrcDiscStateData%alpha_dot_minus1 + end if + if (allocated(SrcDiscStateData%q_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%q_minus1) + UB(1:2) = ubound(SrcDiscStateData%q_minus1) + if (.not. allocated(DstDiscStateData%q_minus1)) then + allocate(DstDiscStateData%q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%q_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%q_minus1 = SrcDiscStateData%q_minus1 + end if + if (allocated(SrcDiscStateData%Kalpha_f_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Kalpha_f_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kalpha_f_minus1) + if (.not. allocated(DstDiscStateData%Kalpha_f_minus1)) then + allocate(DstDiscStateData%Kalpha_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kalpha_f_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Kalpha_f_minus1 = SrcDiscStateData%Kalpha_f_minus1 + end if + if (allocated(SrcDiscStateData%Kq_f_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Kq_f_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kq_f_minus1) + if (.not. allocated(DstDiscStateData%Kq_f_minus1)) then + allocate(DstDiscStateData%Kq_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kq_f_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Kq_f_minus1 = SrcDiscStateData%Kq_f_minus1 + end if + if (allocated(SrcDiscStateData%q_f_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%q_f_minus1) + UB(1:2) = ubound(SrcDiscStateData%q_f_minus1) + if (.not. allocated(DstDiscStateData%q_f_minus1)) then + allocate(DstDiscStateData%q_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%q_f_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%q_f_minus1 = SrcDiscStateData%q_f_minus1 + end if + if (allocated(SrcDiscStateData%X1_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%X1_minus1) + UB(1:2) = ubound(SrcDiscStateData%X1_minus1) + if (.not. allocated(DstDiscStateData%X1_minus1)) then + allocate(DstDiscStateData%X1_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X1_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%X1_minus1 = SrcDiscStateData%X1_minus1 + end if + if (allocated(SrcDiscStateData%X2_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%X2_minus1) + UB(1:2) = ubound(SrcDiscStateData%X2_minus1) + if (.not. allocated(DstDiscStateData%X2_minus1)) then + allocate(DstDiscStateData%X2_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X2_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%X2_minus1 = SrcDiscStateData%X2_minus1 + end if + if (allocated(SrcDiscStateData%X3_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%X3_minus1) + UB(1:2) = ubound(SrcDiscStateData%X3_minus1) + if (.not. allocated(DstDiscStateData%X3_minus1)) then + allocate(DstDiscStateData%X3_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X3_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%X3_minus1 = SrcDiscStateData%X3_minus1 + end if + if (allocated(SrcDiscStateData%X4_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%X4_minus1) + UB(1:2) = ubound(SrcDiscStateData%X4_minus1) + if (.not. allocated(DstDiscStateData%X4_minus1)) then + allocate(DstDiscStateData%X4_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X4_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%X4_minus1 = SrcDiscStateData%X4_minus1 + end if + if (allocated(SrcDiscStateData%Kprime_alpha_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Kprime_alpha_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kprime_alpha_minus1) + if (.not. allocated(DstDiscStateData%Kprime_alpha_minus1)) then + allocate(DstDiscStateData%Kprime_alpha_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprime_alpha_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Kprime_alpha_minus1 = SrcDiscStateData%Kprime_alpha_minus1 + end if + if (allocated(SrcDiscStateData%Kprime_q_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Kprime_q_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kprime_q_minus1) + if (.not. allocated(DstDiscStateData%Kprime_q_minus1)) then + allocate(DstDiscStateData%Kprime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprime_q_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Kprime_q_minus1 = SrcDiscStateData%Kprime_q_minus1 + end if + if (allocated(SrcDiscStateData%Kprimeprime_q_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Kprimeprime_q_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kprimeprime_q_minus1) + if (.not. allocated(DstDiscStateData%Kprimeprime_q_minus1)) then + allocate(DstDiscStateData%Kprimeprime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprimeprime_q_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Kprimeprime_q_minus1 = SrcDiscStateData%Kprimeprime_q_minus1 + end if + if (allocated(SrcDiscStateData%K3prime_q_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%K3prime_q_minus1) + UB(1:2) = ubound(SrcDiscStateData%K3prime_q_minus1) + if (.not. allocated(DstDiscStateData%K3prime_q_minus1)) then + allocate(DstDiscStateData%K3prime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%K3prime_q_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%K3prime_q_minus1 = SrcDiscStateData%K3prime_q_minus1 + end if + if (allocated(SrcDiscStateData%Dp_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Dp_minus1) + UB(1:2) = ubound(SrcDiscStateData%Dp_minus1) + if (.not. allocated(DstDiscStateData%Dp_minus1)) then + allocate(DstDiscStateData%Dp_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Dp_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Dp_minus1 = SrcDiscStateData%Dp_minus1 + end if + if (allocated(SrcDiscStateData%Cn_pot_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Cn_pot_minus1) + UB(1:2) = ubound(SrcDiscStateData%Cn_pot_minus1) + if (.not. allocated(DstDiscStateData%Cn_pot_minus1)) then + allocate(DstDiscStateData%Cn_pot_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_pot_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Cn_pot_minus1 = SrcDiscStateData%Cn_pot_minus1 + end if + if (allocated(SrcDiscStateData%fprimeprime_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_minus1) + if (.not. allocated(DstDiscStateData%fprimeprime_minus1)) then + allocate(DstDiscStateData%fprimeprime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprimeprime_minus1 = SrcDiscStateData%fprimeprime_minus1 + end if + if (allocated(SrcDiscStateData%fprimeprime_c_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_c_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_c_minus1) + if (.not. allocated(DstDiscStateData%fprimeprime_c_minus1)) then + allocate(DstDiscStateData%fprimeprime_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_c_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprimeprime_c_minus1 = SrcDiscStateData%fprimeprime_c_minus1 + end if + if (allocated(SrcDiscStateData%fprimeprime_m_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_m_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_m_minus1) + if (.not. allocated(DstDiscStateData%fprimeprime_m_minus1)) then + allocate(DstDiscStateData%fprimeprime_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_m_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprimeprime_m_minus1 = SrcDiscStateData%fprimeprime_m_minus1 + end if + if (allocated(SrcDiscStateData%Df_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Df_minus1) + UB(1:2) = ubound(SrcDiscStateData%Df_minus1) + if (.not. allocated(DstDiscStateData%Df_minus1)) then + allocate(DstDiscStateData%Df_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Df_minus1 = SrcDiscStateData%Df_minus1 + end if + if (allocated(SrcDiscStateData%Df_c_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Df_c_minus1) + UB(1:2) = ubound(SrcDiscStateData%Df_c_minus1) + if (.not. allocated(DstDiscStateData%Df_c_minus1)) then + allocate(DstDiscStateData%Df_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_c_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Df_c_minus1 = SrcDiscStateData%Df_c_minus1 + end if + if (allocated(SrcDiscStateData%Df_m_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Df_m_minus1) + UB(1:2) = ubound(SrcDiscStateData%Df_m_minus1) + if (.not. allocated(DstDiscStateData%Df_m_minus1)) then + allocate(DstDiscStateData%Df_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_m_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Df_m_minus1 = SrcDiscStateData%Df_m_minus1 + end if + if (allocated(SrcDiscStateData%Dalphaf_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Dalphaf_minus1) + UB(1:2) = ubound(SrcDiscStateData%Dalphaf_minus1) + if (.not. allocated(DstDiscStateData%Dalphaf_minus1)) then + allocate(DstDiscStateData%Dalphaf_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Dalphaf_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Dalphaf_minus1 = SrcDiscStateData%Dalphaf_minus1 + end if + if (allocated(SrcDiscStateData%alphaf_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%alphaf_minus1) + UB(1:2) = ubound(SrcDiscStateData%alphaf_minus1) + if (.not. allocated(DstDiscStateData%alphaf_minus1)) then + allocate(DstDiscStateData%alphaf_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alphaf_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%alphaf_minus1 = SrcDiscStateData%alphaf_minus1 + end if + if (allocated(SrcDiscStateData%fprime_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprime_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprime_minus1) + if (.not. allocated(DstDiscStateData%fprime_minus1)) then + allocate(DstDiscStateData%fprime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprime_minus1 = SrcDiscStateData%fprime_minus1 + end if + if (allocated(SrcDiscStateData%fprime_c_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprime_c_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprime_c_minus1) + if (.not. allocated(DstDiscStateData%fprime_c_minus1)) then + allocate(DstDiscStateData%fprime_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_c_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprime_c_minus1 = SrcDiscStateData%fprime_c_minus1 + end if + if (allocated(SrcDiscStateData%fprime_m_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprime_m_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprime_m_minus1) + if (.not. allocated(DstDiscStateData%fprime_m_minus1)) then + allocate(DstDiscStateData%fprime_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_m_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprime_m_minus1 = SrcDiscStateData%fprime_m_minus1 + end if + if (allocated(SrcDiscStateData%tau_V)) then + LB(1:2) = lbound(SrcDiscStateData%tau_V) + UB(1:2) = ubound(SrcDiscStateData%tau_V) + if (.not. allocated(DstDiscStateData%tau_V)) then + allocate(DstDiscStateData%tau_V(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%tau_V.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%tau_V = SrcDiscStateData%tau_V + end if + if (allocated(SrcDiscStateData%tau_V_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%tau_V_minus1) + UB(1:2) = ubound(SrcDiscStateData%tau_V_minus1) + if (.not. allocated(DstDiscStateData%tau_V_minus1)) then + allocate(DstDiscStateData%tau_V_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%tau_V_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%tau_V_minus1 = SrcDiscStateData%tau_V_minus1 + end if + if (allocated(SrcDiscStateData%Cn_v_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Cn_v_minus1) + UB(1:2) = ubound(SrcDiscStateData%Cn_v_minus1) + if (.not. allocated(DstDiscStateData%Cn_v_minus1)) then + allocate(DstDiscStateData%Cn_v_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_v_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Cn_v_minus1 = SrcDiscStateData%Cn_v_minus1 + end if + if (allocated(SrcDiscStateData%C_V_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%C_V_minus1) + UB(1:2) = ubound(SrcDiscStateData%C_V_minus1) + if (.not. allocated(DstDiscStateData%C_V_minus1)) then + allocate(DstDiscStateData%C_V_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%C_V_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%C_V_minus1 = SrcDiscStateData%C_V_minus1 + end if + if (allocated(SrcDiscStateData%Cn_prime_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Cn_prime_minus1) + UB(1:2) = ubound(SrcDiscStateData%Cn_prime_minus1) + if (.not. allocated(DstDiscStateData%Cn_prime_minus1)) then + allocate(DstDiscStateData%Cn_prime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_prime_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Cn_prime_minus1 = SrcDiscStateData%Cn_prime_minus1 + end if +end subroutine + +subroutine UA_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(UA_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%alpha_minus1)) then + deallocate(DiscStateData%alpha_minus1) + end if + if (allocated(DiscStateData%alpha_filt_minus1)) then + deallocate(DiscStateData%alpha_filt_minus1) + end if + if (allocated(DiscStateData%alpha_dot)) then + deallocate(DiscStateData%alpha_dot) + end if + if (allocated(DiscStateData%alpha_dot_minus1)) then + deallocate(DiscStateData%alpha_dot_minus1) + end if + if (allocated(DiscStateData%q_minus1)) then + deallocate(DiscStateData%q_minus1) + end if + if (allocated(DiscStateData%Kalpha_f_minus1)) then + deallocate(DiscStateData%Kalpha_f_minus1) + end if + if (allocated(DiscStateData%Kq_f_minus1)) then + deallocate(DiscStateData%Kq_f_minus1) + end if + if (allocated(DiscStateData%q_f_minus1)) then + deallocate(DiscStateData%q_f_minus1) + end if + if (allocated(DiscStateData%X1_minus1)) then + deallocate(DiscStateData%X1_minus1) + end if + if (allocated(DiscStateData%X2_minus1)) then + deallocate(DiscStateData%X2_minus1) + end if + if (allocated(DiscStateData%X3_minus1)) then + deallocate(DiscStateData%X3_minus1) + end if + if (allocated(DiscStateData%X4_minus1)) then + deallocate(DiscStateData%X4_minus1) + end if + if (allocated(DiscStateData%Kprime_alpha_minus1)) then + deallocate(DiscStateData%Kprime_alpha_minus1) + end if + if (allocated(DiscStateData%Kprime_q_minus1)) then + deallocate(DiscStateData%Kprime_q_minus1) + end if + if (allocated(DiscStateData%Kprimeprime_q_minus1)) then + deallocate(DiscStateData%Kprimeprime_q_minus1) + end if + if (allocated(DiscStateData%K3prime_q_minus1)) then + deallocate(DiscStateData%K3prime_q_minus1) + end if + if (allocated(DiscStateData%Dp_minus1)) then + deallocate(DiscStateData%Dp_minus1) + end if + if (allocated(DiscStateData%Cn_pot_minus1)) then + deallocate(DiscStateData%Cn_pot_minus1) + end if + if (allocated(DiscStateData%fprimeprime_minus1)) then + deallocate(DiscStateData%fprimeprime_minus1) + end if + if (allocated(DiscStateData%fprimeprime_c_minus1)) then + deallocate(DiscStateData%fprimeprime_c_minus1) + end if + if (allocated(DiscStateData%fprimeprime_m_minus1)) then + deallocate(DiscStateData%fprimeprime_m_minus1) + end if + if (allocated(DiscStateData%Df_minus1)) then + deallocate(DiscStateData%Df_minus1) + end if + if (allocated(DiscStateData%Df_c_minus1)) then + deallocate(DiscStateData%Df_c_minus1) + end if + if (allocated(DiscStateData%Df_m_minus1)) then + deallocate(DiscStateData%Df_m_minus1) + end if + if (allocated(DiscStateData%Dalphaf_minus1)) then + deallocate(DiscStateData%Dalphaf_minus1) + end if + if (allocated(DiscStateData%alphaf_minus1)) then + deallocate(DiscStateData%alphaf_minus1) + end if + if (allocated(DiscStateData%fprime_minus1)) then + deallocate(DiscStateData%fprime_minus1) + end if + if (allocated(DiscStateData%fprime_c_minus1)) then + deallocate(DiscStateData%fprime_c_minus1) + end if + if (allocated(DiscStateData%fprime_m_minus1)) then + deallocate(DiscStateData%fprime_m_minus1) + end if + if (allocated(DiscStateData%tau_V)) then + deallocate(DiscStateData%tau_V) + end if + if (allocated(DiscStateData%tau_V_minus1)) then + deallocate(DiscStateData%tau_V_minus1) + end if + if (allocated(DiscStateData%Cn_v_minus1)) then + deallocate(DiscStateData%Cn_v_minus1) + end if + if (allocated(DiscStateData%C_V_minus1)) then + deallocate(DiscStateData%C_V_minus1) + end if + if (allocated(DiscStateData%Cn_prime_minus1)) then + deallocate(DiscStateData%Cn_prime_minus1) + end if +end subroutine + +subroutine UA_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%alpha_minus1)) + if (allocated(InData%alpha_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%alpha_minus1), ubound(InData%alpha_minus1)) + call RegPack(Buf, InData%alpha_minus1) + end if + call RegPack(Buf, allocated(InData%alpha_filt_minus1)) + if (allocated(InData%alpha_filt_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%alpha_filt_minus1), ubound(InData%alpha_filt_minus1)) + call RegPack(Buf, InData%alpha_filt_minus1) + end if + call RegPack(Buf, allocated(InData%alpha_dot)) + if (allocated(InData%alpha_dot)) then + call RegPackBounds(Buf, 2, lbound(InData%alpha_dot), ubound(InData%alpha_dot)) + call RegPack(Buf, InData%alpha_dot) + end if + call RegPack(Buf, allocated(InData%alpha_dot_minus1)) + if (allocated(InData%alpha_dot_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%alpha_dot_minus1), ubound(InData%alpha_dot_minus1)) + call RegPack(Buf, InData%alpha_dot_minus1) + end if + call RegPack(Buf, allocated(InData%q_minus1)) + if (allocated(InData%q_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%q_minus1), ubound(InData%q_minus1)) + call RegPack(Buf, InData%q_minus1) + end if + call RegPack(Buf, allocated(InData%Kalpha_f_minus1)) + if (allocated(InData%Kalpha_f_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Kalpha_f_minus1), ubound(InData%Kalpha_f_minus1)) + call RegPack(Buf, InData%Kalpha_f_minus1) + end if + call RegPack(Buf, allocated(InData%Kq_f_minus1)) + if (allocated(InData%Kq_f_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Kq_f_minus1), ubound(InData%Kq_f_minus1)) + call RegPack(Buf, InData%Kq_f_minus1) + end if + call RegPack(Buf, allocated(InData%q_f_minus1)) + if (allocated(InData%q_f_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%q_f_minus1), ubound(InData%q_f_minus1)) + call RegPack(Buf, InData%q_f_minus1) + end if + call RegPack(Buf, allocated(InData%X1_minus1)) + if (allocated(InData%X1_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%X1_minus1), ubound(InData%X1_minus1)) + call RegPack(Buf, InData%X1_minus1) + end if + call RegPack(Buf, allocated(InData%X2_minus1)) + if (allocated(InData%X2_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%X2_minus1), ubound(InData%X2_minus1)) + call RegPack(Buf, InData%X2_minus1) + end if + call RegPack(Buf, allocated(InData%X3_minus1)) + if (allocated(InData%X3_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%X3_minus1), ubound(InData%X3_minus1)) + call RegPack(Buf, InData%X3_minus1) + end if + call RegPack(Buf, allocated(InData%X4_minus1)) + if (allocated(InData%X4_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%X4_minus1), ubound(InData%X4_minus1)) + call RegPack(Buf, InData%X4_minus1) + end if + call RegPack(Buf, allocated(InData%Kprime_alpha_minus1)) + if (allocated(InData%Kprime_alpha_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Kprime_alpha_minus1), ubound(InData%Kprime_alpha_minus1)) + call RegPack(Buf, InData%Kprime_alpha_minus1) + end if + call RegPack(Buf, allocated(InData%Kprime_q_minus1)) + if (allocated(InData%Kprime_q_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Kprime_q_minus1), ubound(InData%Kprime_q_minus1)) + call RegPack(Buf, InData%Kprime_q_minus1) + end if + call RegPack(Buf, allocated(InData%Kprimeprime_q_minus1)) + if (allocated(InData%Kprimeprime_q_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Kprimeprime_q_minus1), ubound(InData%Kprimeprime_q_minus1)) + call RegPack(Buf, InData%Kprimeprime_q_minus1) + end if + call RegPack(Buf, allocated(InData%K3prime_q_minus1)) + if (allocated(InData%K3prime_q_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%K3prime_q_minus1), ubound(InData%K3prime_q_minus1)) + call RegPack(Buf, InData%K3prime_q_minus1) + end if + call RegPack(Buf, allocated(InData%Dp_minus1)) + if (allocated(InData%Dp_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Dp_minus1), ubound(InData%Dp_minus1)) + call RegPack(Buf, InData%Dp_minus1) + end if + call RegPack(Buf, allocated(InData%Cn_pot_minus1)) + if (allocated(InData%Cn_pot_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Cn_pot_minus1), ubound(InData%Cn_pot_minus1)) + call RegPack(Buf, InData%Cn_pot_minus1) + end if + call RegPack(Buf, allocated(InData%fprimeprime_minus1)) + if (allocated(InData%fprimeprime_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_minus1), ubound(InData%fprimeprime_minus1)) + call RegPack(Buf, InData%fprimeprime_minus1) + end if + call RegPack(Buf, allocated(InData%fprimeprime_c_minus1)) + if (allocated(InData%fprimeprime_c_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_c_minus1), ubound(InData%fprimeprime_c_minus1)) + call RegPack(Buf, InData%fprimeprime_c_minus1) + end if + call RegPack(Buf, allocated(InData%fprimeprime_m_minus1)) + if (allocated(InData%fprimeprime_m_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_m_minus1), ubound(InData%fprimeprime_m_minus1)) + call RegPack(Buf, InData%fprimeprime_m_minus1) + end if + call RegPack(Buf, allocated(InData%Df_minus1)) + if (allocated(InData%Df_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Df_minus1), ubound(InData%Df_minus1)) + call RegPack(Buf, InData%Df_minus1) + end if + call RegPack(Buf, allocated(InData%Df_c_minus1)) + if (allocated(InData%Df_c_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Df_c_minus1), ubound(InData%Df_c_minus1)) + call RegPack(Buf, InData%Df_c_minus1) + end if + call RegPack(Buf, allocated(InData%Df_m_minus1)) + if (allocated(InData%Df_m_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Df_m_minus1), ubound(InData%Df_m_minus1)) + call RegPack(Buf, InData%Df_m_minus1) + end if + call RegPack(Buf, allocated(InData%Dalphaf_minus1)) + if (allocated(InData%Dalphaf_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Dalphaf_minus1), ubound(InData%Dalphaf_minus1)) + call RegPack(Buf, InData%Dalphaf_minus1) + end if + call RegPack(Buf, allocated(InData%alphaf_minus1)) + if (allocated(InData%alphaf_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%alphaf_minus1), ubound(InData%alphaf_minus1)) + call RegPack(Buf, InData%alphaf_minus1) + end if + call RegPack(Buf, allocated(InData%fprime_minus1)) + if (allocated(InData%fprime_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%fprime_minus1), ubound(InData%fprime_minus1)) + call RegPack(Buf, InData%fprime_minus1) + end if + call RegPack(Buf, allocated(InData%fprime_c_minus1)) + if (allocated(InData%fprime_c_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%fprime_c_minus1), ubound(InData%fprime_c_minus1)) + call RegPack(Buf, InData%fprime_c_minus1) + end if + call RegPack(Buf, allocated(InData%fprime_m_minus1)) + if (allocated(InData%fprime_m_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%fprime_m_minus1), ubound(InData%fprime_m_minus1)) + call RegPack(Buf, InData%fprime_m_minus1) + end if + call RegPack(Buf, allocated(InData%tau_V)) + if (allocated(InData%tau_V)) then + call RegPackBounds(Buf, 2, lbound(InData%tau_V), ubound(InData%tau_V)) + call RegPack(Buf, InData%tau_V) + end if + call RegPack(Buf, allocated(InData%tau_V_minus1)) + if (allocated(InData%tau_V_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%tau_V_minus1), ubound(InData%tau_V_minus1)) + call RegPack(Buf, InData%tau_V_minus1) + end if + call RegPack(Buf, allocated(InData%Cn_v_minus1)) + if (allocated(InData%Cn_v_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Cn_v_minus1), ubound(InData%Cn_v_minus1)) + call RegPack(Buf, InData%Cn_v_minus1) + end if + call RegPack(Buf, allocated(InData%C_V_minus1)) + if (allocated(InData%C_V_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%C_V_minus1), ubound(InData%C_V_minus1)) + call RegPack(Buf, InData%C_V_minus1) + end if + call RegPack(Buf, allocated(InData%Cn_prime_minus1)) + if (allocated(InData%Cn_prime_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Cn_prime_minus1), ubound(InData%Cn_prime_minus1)) + call RegPack(Buf, InData%Cn_prime_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackDiscState' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%alpha_minus1)) deallocate(OutData%alpha_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%alpha_filt_minus1)) deallocate(OutData%alpha_filt_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_filt_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_filt_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_filt_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%alpha_dot)) deallocate(OutData%alpha_dot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_dot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_dot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_dot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%alpha_dot_minus1)) deallocate(OutData%alpha_dot_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_dot_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_dot_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_dot_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%q_minus1)) deallocate(OutData%q_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%q_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%q_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Kalpha_f_minus1)) deallocate(OutData%Kalpha_f_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Kalpha_f_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kalpha_f_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Kalpha_f_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Kq_f_minus1)) deallocate(OutData%Kq_f_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Kq_f_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kq_f_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Kq_f_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%q_f_minus1)) deallocate(OutData%q_f_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%q_f_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_f_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%q_f_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%X1_minus1)) deallocate(OutData%X1_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X1_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X1_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X1_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%X2_minus1)) deallocate(OutData%X2_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X2_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X2_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X2_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%X3_minus1)) deallocate(OutData%X3_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X3_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X3_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X3_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%X4_minus1)) deallocate(OutData%X4_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X4_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X4_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X4_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Kprime_alpha_minus1)) deallocate(OutData%Kprime_alpha_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Kprime_alpha_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_alpha_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Kprime_alpha_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Kprime_q_minus1)) deallocate(OutData%Kprime_q_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Kprime_q_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_q_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Kprime_q_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Kprimeprime_q_minus1)) deallocate(OutData%Kprimeprime_q_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Kprimeprime_q_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprimeprime_q_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Kprimeprime_q_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%K3prime_q_minus1)) deallocate(OutData%K3prime_q_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%K3prime_q_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%K3prime_q_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%K3prime_q_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Dp_minus1)) deallocate(OutData%Dp_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Dp_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Dp_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cn_pot_minus1)) deallocate(OutData%Cn_pot_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cn_pot_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_pot_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cn_pot_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%fprimeprime_minus1)) deallocate(OutData%fprimeprime_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fprimeprime_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fprimeprime_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%fprimeprime_c_minus1)) deallocate(OutData%fprimeprime_c_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fprimeprime_c_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_c_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fprimeprime_c_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%fprimeprime_m_minus1)) deallocate(OutData%fprimeprime_m_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fprimeprime_m_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_m_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fprimeprime_m_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Df_minus1)) deallocate(OutData%Df_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Df_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Df_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Df_c_minus1)) deallocate(OutData%Df_c_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Df_c_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_c_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Df_c_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Df_m_minus1)) deallocate(OutData%Df_m_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Df_m_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_m_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Df_m_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Dalphaf_minus1)) deallocate(OutData%Dalphaf_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Dalphaf_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dalphaf_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Dalphaf_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%alphaf_minus1)) deallocate(OutData%alphaf_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alphaf_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alphaf_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alphaf_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%fprime_minus1)) deallocate(OutData%fprime_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fprime_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fprime_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%fprime_c_minus1)) deallocate(OutData%fprime_c_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fprime_c_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_c_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fprime_c_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%fprime_m_minus1)) deallocate(OutData%fprime_m_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fprime_m_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_m_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fprime_m_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%tau_V)) deallocate(OutData%tau_V) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%tau_V(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%tau_V) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%tau_V_minus1)) deallocate(OutData%tau_V_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%tau_V_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%tau_V_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cn_v_minus1)) deallocate(OutData%Cn_v_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cn_v_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_v_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cn_v_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%C_V_minus1)) deallocate(OutData%C_V_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C_V_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_V_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C_V_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cn_prime_minus1)) deallocate(OutData%Cn_prime_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cn_prime_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_prime_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cn_prime_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine UA_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(UA_ConstraintStateType), intent(in) :: SrcConstrStateData + type(UA_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstraintState = SrcConstrStateData%DummyConstraintState +end subroutine + +subroutine UA_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(UA_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine UA_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstraintState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstraintState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(UA_OtherStateType), intent(in) :: SrcOtherStateData + type(UA_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%FirstPass)) then + LB(1:2) = lbound(SrcOtherStateData%FirstPass) + UB(1:2) = ubound(SrcOtherStateData%FirstPass) + if (.not. allocated(DstOtherStateData%FirstPass)) then + allocate(DstOtherStateData%FirstPass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FirstPass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%FirstPass = SrcOtherStateData%FirstPass + end if + if (allocated(SrcOtherStateData%sigma1)) then + LB(1:2) = lbound(SrcOtherStateData%sigma1) + UB(1:2) = ubound(SrcOtherStateData%sigma1) + if (.not. allocated(DstOtherStateData%sigma1)) then + allocate(DstOtherStateData%sigma1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%sigma1 = SrcOtherStateData%sigma1 + end if + if (allocated(SrcOtherStateData%sigma1c)) then + LB(1:2) = lbound(SrcOtherStateData%sigma1c) + UB(1:2) = ubound(SrcOtherStateData%sigma1c) + if (.not. allocated(DstOtherStateData%sigma1c)) then + allocate(DstOtherStateData%sigma1c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%sigma1c = SrcOtherStateData%sigma1c + end if + if (allocated(SrcOtherStateData%sigma1m)) then + LB(1:2) = lbound(SrcOtherStateData%sigma1m) + UB(1:2) = ubound(SrcOtherStateData%sigma1m) + if (.not. allocated(DstOtherStateData%sigma1m)) then + allocate(DstOtherStateData%sigma1m(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%sigma1m = SrcOtherStateData%sigma1m + end if + if (allocated(SrcOtherStateData%sigma3)) then + LB(1:2) = lbound(SrcOtherStateData%sigma3) + UB(1:2) = ubound(SrcOtherStateData%sigma3) + if (.not. allocated(DstOtherStateData%sigma3)) then + allocate(DstOtherStateData%sigma3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%sigma3 = SrcOtherStateData%sigma3 + end if + if (allocated(SrcOtherStateData%n)) then + LB(1:2) = lbound(SrcOtherStateData%n) + UB(1:2) = ubound(SrcOtherStateData%n) + if (.not. allocated(DstOtherStateData%n)) then + allocate(DstOtherStateData%n(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%n.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%n = SrcOtherStateData%n + end if + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + do i1 = LB(1), UB(1) + call UA_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + if (allocated(SrcOtherStateData%t_vortexBegin)) then + LB(1:2) = lbound(SrcOtherStateData%t_vortexBegin) + UB(1:2) = ubound(SrcOtherStateData%t_vortexBegin) + if (.not. allocated(DstOtherStateData%t_vortexBegin)) then + allocate(DstOtherStateData%t_vortexBegin(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%t_vortexBegin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%t_vortexBegin = SrcOtherStateData%t_vortexBegin + end if + if (allocated(SrcOtherStateData%SignOfOmega)) then + LB(1:2) = lbound(SrcOtherStateData%SignOfOmega) + UB(1:2) = ubound(SrcOtherStateData%SignOfOmega) + if (.not. allocated(DstOtherStateData%SignOfOmega)) then + allocate(DstOtherStateData%SignOfOmega(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%SignOfOmega.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%SignOfOmega = SrcOtherStateData%SignOfOmega + end if + if (allocated(SrcOtherStateData%PositivePressure)) then + LB(1:2) = lbound(SrcOtherStateData%PositivePressure) + UB(1:2) = ubound(SrcOtherStateData%PositivePressure) + if (.not. allocated(DstOtherStateData%PositivePressure)) then + allocate(DstOtherStateData%PositivePressure(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%PositivePressure.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%PositivePressure = SrcOtherStateData%PositivePressure + end if + if (allocated(SrcOtherStateData%vortexOn)) then + LB(1:2) = lbound(SrcOtherStateData%vortexOn) + UB(1:2) = ubound(SrcOtherStateData%vortexOn) + if (.not. allocated(DstOtherStateData%vortexOn)) then + allocate(DstOtherStateData%vortexOn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%vortexOn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%vortexOn = SrcOtherStateData%vortexOn + end if + if (allocated(SrcOtherStateData%BelowThreshold)) then + LB(1:2) = lbound(SrcOtherStateData%BelowThreshold) + UB(1:2) = ubound(SrcOtherStateData%BelowThreshold) + if (.not. allocated(DstOtherStateData%BelowThreshold)) then + allocate(DstOtherStateData%BelowThreshold(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BelowThreshold.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%BelowThreshold = SrcOtherStateData%BelowThreshold + end if + if (allocated(SrcOtherStateData%activeL)) then + LB(1:2) = lbound(SrcOtherStateData%activeL) + UB(1:2) = ubound(SrcOtherStateData%activeL) + if (.not. allocated(DstOtherStateData%activeL)) then + allocate(DstOtherStateData%activeL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%activeL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%activeL = SrcOtherStateData%activeL + end if + if (allocated(SrcOtherStateData%activeD)) then + LB(1:2) = lbound(SrcOtherStateData%activeD) + UB(1:2) = ubound(SrcOtherStateData%activeD) + if (.not. allocated(DstOtherStateData%activeD)) then + allocate(DstOtherStateData%activeD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%activeD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%activeD = SrcOtherStateData%activeD + end if +end subroutine + +subroutine UA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(UA_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%FirstPass)) then + deallocate(OtherStateData%FirstPass) + end if + if (allocated(OtherStateData%sigma1)) then + deallocate(OtherStateData%sigma1) + end if + if (allocated(OtherStateData%sigma1c)) then + deallocate(OtherStateData%sigma1c) + end if + if (allocated(OtherStateData%sigma1m)) then + deallocate(OtherStateData%sigma1m) + end if + if (allocated(OtherStateData%sigma3)) then + deallocate(OtherStateData%sigma3) + end if + if (allocated(OtherStateData%n)) then + deallocate(OtherStateData%n) + end if + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call UA_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + if (allocated(OtherStateData%t_vortexBegin)) then + deallocate(OtherStateData%t_vortexBegin) + end if + if (allocated(OtherStateData%SignOfOmega)) then + deallocate(OtherStateData%SignOfOmega) + end if + if (allocated(OtherStateData%PositivePressure)) then + deallocate(OtherStateData%PositivePressure) + end if + if (allocated(OtherStateData%vortexOn)) then + deallocate(OtherStateData%vortexOn) + end if + if (allocated(OtherStateData%BelowThreshold)) then + deallocate(OtherStateData%BelowThreshold) + end if + if (allocated(OtherStateData%activeL)) then + deallocate(OtherStateData%activeL) + end if + if (allocated(OtherStateData%activeD)) then + deallocate(OtherStateData%activeD) + end if +end subroutine + +subroutine UA_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%FirstPass)) + if (allocated(InData%FirstPass)) then + call RegPackBounds(Buf, 2, lbound(InData%FirstPass), ubound(InData%FirstPass)) + call RegPack(Buf, InData%FirstPass) + end if + call RegPack(Buf, allocated(InData%sigma1)) + if (allocated(InData%sigma1)) then + call RegPackBounds(Buf, 2, lbound(InData%sigma1), ubound(InData%sigma1)) + call RegPack(Buf, InData%sigma1) + end if + call RegPack(Buf, allocated(InData%sigma1c)) + if (allocated(InData%sigma1c)) then + call RegPackBounds(Buf, 2, lbound(InData%sigma1c), ubound(InData%sigma1c)) + call RegPack(Buf, InData%sigma1c) + end if + call RegPack(Buf, allocated(InData%sigma1m)) + if (allocated(InData%sigma1m)) then + call RegPackBounds(Buf, 2, lbound(InData%sigma1m), ubound(InData%sigma1m)) + call RegPack(Buf, InData%sigma1m) + end if + call RegPack(Buf, allocated(InData%sigma3)) + if (allocated(InData%sigma3)) then + call RegPackBounds(Buf, 2, lbound(InData%sigma3), ubound(InData%sigma3)) + call RegPack(Buf, InData%sigma3) + end if + call RegPack(Buf, allocated(InData%n)) + if (allocated(InData%n)) then + call RegPackBounds(Buf, 2, lbound(InData%n), ubound(InData%n)) + call RegPack(Buf, InData%n) + end if + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call UA_PackContState(Buf, InData%xdot(i1)) + end do + call RegPack(Buf, allocated(InData%t_vortexBegin)) + if (allocated(InData%t_vortexBegin)) then + call RegPackBounds(Buf, 2, lbound(InData%t_vortexBegin), ubound(InData%t_vortexBegin)) + call RegPack(Buf, InData%t_vortexBegin) + end if + call RegPack(Buf, allocated(InData%SignOfOmega)) + if (allocated(InData%SignOfOmega)) then + call RegPackBounds(Buf, 2, lbound(InData%SignOfOmega), ubound(InData%SignOfOmega)) + call RegPack(Buf, InData%SignOfOmega) + end if + call RegPack(Buf, allocated(InData%PositivePressure)) + if (allocated(InData%PositivePressure)) then + call RegPackBounds(Buf, 2, lbound(InData%PositivePressure), ubound(InData%PositivePressure)) + call RegPack(Buf, InData%PositivePressure) + end if + call RegPack(Buf, allocated(InData%vortexOn)) + if (allocated(InData%vortexOn)) then + call RegPackBounds(Buf, 2, lbound(InData%vortexOn), ubound(InData%vortexOn)) + call RegPack(Buf, InData%vortexOn) + end if + call RegPack(Buf, allocated(InData%BelowThreshold)) + if (allocated(InData%BelowThreshold)) then + call RegPackBounds(Buf, 2, lbound(InData%BelowThreshold), ubound(InData%BelowThreshold)) + call RegPack(Buf, InData%BelowThreshold) + end if + call RegPack(Buf, allocated(InData%activeL)) + if (allocated(InData%activeL)) then + call RegPackBounds(Buf, 2, lbound(InData%activeL), ubound(InData%activeL)) + call RegPack(Buf, InData%activeL) + end if + call RegPack(Buf, allocated(InData%activeD)) + if (allocated(InData%activeD)) then + call RegPackBounds(Buf, 2, lbound(InData%activeD), ubound(InData%activeD)) + call RegPack(Buf, InData%activeD) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%FirstPass)) deallocate(OutData%FirstPass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FirstPass(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstPass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FirstPass) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%sigma1)) deallocate(OutData%sigma1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%sigma1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%sigma1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%sigma1c)) deallocate(OutData%sigma1c) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%sigma1c(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1c.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%sigma1c) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%sigma1m)) deallocate(OutData%sigma1m) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%sigma1m(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%sigma1m) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%sigma3)) deallocate(OutData%sigma3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%sigma3(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%sigma3) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%n)) deallocate(OutData%n) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%n(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%n.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + end if + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call UA_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do + if (allocated(OutData%t_vortexBegin)) deallocate(OutData%t_vortexBegin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%t_vortexBegin(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_vortexBegin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%t_vortexBegin) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SignOfOmega)) deallocate(OutData%SignOfOmega) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SignOfOmega(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SignOfOmega.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SignOfOmega) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PositivePressure)) deallocate(OutData%PositivePressure) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PositivePressure(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositivePressure.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PositivePressure) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%vortexOn)) deallocate(OutData%vortexOn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vortexOn(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vortexOn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vortexOn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BelowThreshold)) deallocate(OutData%BelowThreshold) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BelowThreshold(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BelowThreshold.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BelowThreshold) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%activeL)) deallocate(OutData%activeL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%activeL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%activeL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%activeL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%activeD)) deallocate(OutData%activeD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%activeD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%activeD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%activeD) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(UA_MiscVarType), intent(in) :: SrcMiscData + type(UA_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'UA_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%FirstWarn_M = SrcMiscData%FirstWarn_M + DstMiscData%FirstWarn_UA = SrcMiscData%FirstWarn_UA + DstMiscData%FirstWarn_UA_off = SrcMiscData%FirstWarn_UA_off + if (allocated(SrcMiscData%TESF)) then + LB(1:2) = lbound(SrcMiscData%TESF) + UB(1:2) = ubound(SrcMiscData%TESF) + if (.not. allocated(DstMiscData%TESF)) then + allocate(DstMiscData%TESF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TESF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%TESF = SrcMiscData%TESF + end if + if (allocated(SrcMiscData%LESF)) then + LB(1:2) = lbound(SrcMiscData%LESF) + UB(1:2) = ubound(SrcMiscData%LESF) + if (.not. allocated(DstMiscData%LESF)) then + allocate(DstMiscData%LESF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LESF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LESF = SrcMiscData%LESF + end if + if (allocated(SrcMiscData%VRTX)) then + LB(1:2) = lbound(SrcMiscData%VRTX) + UB(1:2) = ubound(SrcMiscData%VRTX) + if (.not. allocated(DstMiscData%VRTX)) then + allocate(DstMiscData%VRTX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%VRTX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%VRTX = SrcMiscData%VRTX + end if + if (allocated(SrcMiscData%T_Sh)) then + LB(1:2) = lbound(SrcMiscData%T_Sh) + UB(1:2) = ubound(SrcMiscData%T_Sh) + if (.not. allocated(DstMiscData%T_Sh)) then + allocate(DstMiscData%T_Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%T_Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%T_Sh = SrcMiscData%T_Sh + end if + if (allocated(SrcMiscData%BEDSEP)) then + LB(1:2) = lbound(SrcMiscData%BEDSEP) + UB(1:2) = ubound(SrcMiscData%BEDSEP) + if (.not. allocated(DstMiscData%BEDSEP)) then + allocate(DstMiscData%BEDSEP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BEDSEP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BEDSEP = SrcMiscData%BEDSEP + end if + if (allocated(SrcMiscData%weight)) then + LB(1:2) = lbound(SrcMiscData%weight) + UB(1:2) = ubound(SrcMiscData%weight) + if (.not. allocated(DstMiscData%weight)) then + allocate(DstMiscData%weight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%weight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%weight = SrcMiscData%weight + end if +end subroutine + +subroutine UA_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(UA_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%TESF)) then + deallocate(MiscData%TESF) + end if + if (allocated(MiscData%LESF)) then + deallocate(MiscData%LESF) + end if + if (allocated(MiscData%VRTX)) then + deallocate(MiscData%VRTX) + end if + if (allocated(MiscData%T_Sh)) then + deallocate(MiscData%T_Sh) + end if + if (allocated(MiscData%BEDSEP)) then + deallocate(MiscData%BEDSEP) + end if + if (allocated(MiscData%weight)) then + deallocate(MiscData%weight) + end if +end subroutine + +subroutine UA_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%FirstWarn_M) + call RegPack(Buf, InData%FirstWarn_UA) + call RegPack(Buf, InData%FirstWarn_UA_off) + call RegPack(Buf, allocated(InData%TESF)) + if (allocated(InData%TESF)) then + call RegPackBounds(Buf, 2, lbound(InData%TESF), ubound(InData%TESF)) + call RegPack(Buf, InData%TESF) + end if + call RegPack(Buf, allocated(InData%LESF)) + if (allocated(InData%LESF)) then + call RegPackBounds(Buf, 2, lbound(InData%LESF), ubound(InData%LESF)) + call RegPack(Buf, InData%LESF) + end if + call RegPack(Buf, allocated(InData%VRTX)) + if (allocated(InData%VRTX)) then + call RegPackBounds(Buf, 2, lbound(InData%VRTX), ubound(InData%VRTX)) + call RegPack(Buf, InData%VRTX) + end if + call RegPack(Buf, allocated(InData%T_Sh)) + if (allocated(InData%T_Sh)) then + call RegPackBounds(Buf, 2, lbound(InData%T_Sh), ubound(InData%T_Sh)) + call RegPack(Buf, InData%T_Sh) + end if + call RegPack(Buf, allocated(InData%BEDSEP)) + if (allocated(InData%BEDSEP)) then + call RegPackBounds(Buf, 2, lbound(InData%BEDSEP), ubound(InData%BEDSEP)) + call RegPack(Buf, InData%BEDSEP) + end if + call RegPack(Buf, allocated(InData%weight)) + if (allocated(InData%weight)) then + call RegPackBounds(Buf, 2, lbound(InData%weight), ubound(InData%weight)) + call RegPack(Buf, InData%weight) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackMisc' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%FirstWarn_M) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FirstWarn_UA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FirstWarn_UA_off) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TESF)) deallocate(OutData%TESF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TESF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TESF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TESF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LESF)) deallocate(OutData%LESF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LESF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LESF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LESF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%VRTX)) deallocate(OutData%VRTX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VRTX(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VRTX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VRTX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%T_Sh)) deallocate(OutData%T_Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%T_Sh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%T_Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BEDSEP)) deallocate(OutData%BEDSEP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BEDSEP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BEDSEP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%weight)) deallocate(OutData%weight) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%weight(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%weight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%weight) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine UA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(UA_ParameterType), intent(in) :: SrcParamData + type(UA_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'UA_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%dt = SrcParamData%dt + if (allocated(SrcParamData%c)) then + LB(1:2) = lbound(SrcParamData%c) + UB(1:2) = ubound(SrcParamData%c) + if (.not. allocated(DstParamData%c)) then + allocate(DstParamData%c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%c = SrcParamData%c + end if + DstParamData%numBlades = SrcParamData%numBlades + DstParamData%nNodesPerBlade = SrcParamData%nNodesPerBlade + DstParamData%UAMod = SrcParamData%UAMod + DstParamData%Flookup = SrcParamData%Flookup + DstParamData%a_s = SrcParamData%a_s + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + DstParamData%Delim = SrcParamData%Delim + DstParamData%UnOutFile = SrcParamData%UnOutFile + DstParamData%ShedEffect = SrcParamData%ShedEffect + DstParamData%lin_nx = SrcParamData%lin_nx + if (allocated(SrcParamData%UA_off_forGood)) then + LB(1:2) = lbound(SrcParamData%UA_off_forGood) + UB(1:2) = ubound(SrcParamData%UA_off_forGood) + if (.not. allocated(DstParamData%UA_off_forGood)) then + allocate(DstParamData%UA_off_forGood(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%UA_off_forGood.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%UA_off_forGood = SrcParamData%UA_off_forGood + end if +end subroutine + +subroutine UA_DestroyParam(ParamData, ErrStat, ErrMsg) + type(UA_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%c)) then + deallocate(ParamData%c) + end if + if (allocated(ParamData%UA_off_forGood)) then + deallocate(ParamData%UA_off_forGood) + end if +end subroutine + +subroutine UA_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dt) + call RegPack(Buf, allocated(InData%c)) + if (allocated(InData%c)) then + call RegPackBounds(Buf, 2, lbound(InData%c), ubound(InData%c)) + call RegPack(Buf, InData%c) + end if + call RegPack(Buf, InData%numBlades) + call RegPack(Buf, InData%nNodesPerBlade) + call RegPack(Buf, InData%UAMod) + call RegPack(Buf, InData%Flookup) + call RegPack(Buf, InData%a_s) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%OutSwtch) + call RegPack(Buf, InData%OutFmt) + call RegPack(Buf, InData%OutSFmt) + call RegPack(Buf, InData%Delim) + call RegPack(Buf, InData%UnOutFile) + call RegPack(Buf, InData%ShedEffect) + call RegPack(Buf, InData%lin_nx) + call RegPack(Buf, allocated(InData%UA_off_forGood)) + if (allocated(InData%UA_off_forGood)) then + call RegPackBounds(Buf, 2, lbound(InData%UA_off_forGood), ubound(InData%UA_off_forGood)) + call RegPack(Buf, InData%UA_off_forGood) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%c)) deallocate(OutData%c) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%c(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%c) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nNodesPerBlade) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UAMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Flookup) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%a_s) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnOutFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ShedEffect) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%lin_nx) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%UA_off_forGood)) deallocate(OutData%UA_off_forGood) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UA_off_forGood(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA_off_forGood.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UA_off_forGood) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine UA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(UA_InputType), intent(in) :: SrcInputData + type(UA_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%U = SrcInputData%U + DstInputData%alpha = SrcInputData%alpha + DstInputData%Re = SrcInputData%Re + DstInputData%UserProp = SrcInputData%UserProp + DstInputData%v_ac = SrcInputData%v_ac + DstInputData%omega = SrcInputData%omega +end subroutine + +subroutine UA_DestroyInput(InputData, ErrStat, ErrMsg) + type(UA_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine UA_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%U) + call RegPack(Buf, InData%alpha) + call RegPack(Buf, InData%Re) + call RegPack(Buf, InData%UserProp) + call RegPack(Buf, InData%v_ac) + call RegPack(Buf, InData%omega) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%U) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alpha) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Re) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UserProp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%v_ac) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%omega) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(UA_OutputType), intent(in) :: SrcOutputData + type(UA_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'UA_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstOutputData%Cn = SrcOutputData%Cn + DstOutputData%Cc = SrcOutputData%Cc + DstOutputData%Cm = SrcOutputData%Cm + DstOutputData%Cl = SrcOutputData%Cl + DstOutputData%Cd = SrcOutputData%Cd + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine UA_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(UA_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine UA_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Cn) + call RegPack(Buf, InData%Cc) + call RegPack(Buf, InData%Cm) + call RegPack(Buf, InData%Cl) + call RegPack(Buf, InData%Cd) + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Cn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cd) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine UA_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(UA_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(UA_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 = 'UA_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 UA_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL UA_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 UA_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 UA_Input_ExtrapInterp - - - SUBROUTINE UA_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call UA_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call UA_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call UA_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE UA_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. @@ -6653,54 +3311,48 @@ SUBROUTINE UA_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(UA_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(UA_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(UA_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 + TYPE(UA_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(UA_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(UA_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 = 'UA_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 - 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - b = -(u1%U - u2%U) - u_out%U = u1%U + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%alpha, u2%alpha, tin, u_out%alpha, tin_out ) - b = -(u1%Re - u2%Re) - u_out%Re = u1%Re + b * ScaleFactor - b = -(u1%UserProp - u2%UserProp) - u_out%UserProp = u1%UserProp + b * ScaleFactor - DO i1 = LBOUND(u_out%v_ac,1),UBOUND(u_out%v_ac,1) - b = -(u1%v_ac(i1) - u2%v_ac(i1)) - u_out%v_ac(i1) = u1%v_ac(i1) + b * ScaleFactor - END DO - b = -(u1%omega - u2%omega) - u_out%omega = u1%omega + b * ScaleFactor - END SUBROUTINE UA_Input_ExtrapInterp1 - - - SUBROUTINE UA_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + u_out%U = a1*u1%U + a2*u2%U + CALL Angles_ExtrapInterp( u1%alpha, u2%alpha, tin, u_out%alpha, tin_out ) + u_out%Re = a1*u1%Re + a2*u2%Re + u_out%UserProp = a1*u1%UserProp + a2*u2%UserProp + u_out%v_ac = a1*u1%v_ac + a2*u2%v_ac + u_out%omega = a1*u1%omega + a2*u2%omega +END SUBROUTINE + +SUBROUTINE UA_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. @@ -6714,119 +3366,108 @@ SUBROUTINE UA_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(UA_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(UA_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(UA_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(UA_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 + TYPE(UA_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(UA_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(UA_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(UA_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 = 'UA_Input_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'UA_Input_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 + 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 + 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 + 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%U - u2%U) + t(2)**2*(-u1%U + u3%U))* scaleFactor - c = ( (t(2)-t(3))*u1%U + t(3)*u2%U - t(2)*u3%U ) * scaleFactor - u_out%U = u1%U + b + c * t_out - CALL Angles_ExtrapInterp( u1%alpha, u2%alpha, u3%alpha, tin, u_out%alpha, tin_out ) - b = (t(3)**2*(u1%Re - u2%Re) + t(2)**2*(-u1%Re + u3%Re))* scaleFactor - c = ( (t(2)-t(3))*u1%Re + t(3)*u2%Re - t(2)*u3%Re ) * scaleFactor - u_out%Re = u1%Re + b + c * t_out - b = (t(3)**2*(u1%UserProp - u2%UserProp) + t(2)**2*(-u1%UserProp + u3%UserProp))* scaleFactor - c = ( (t(2)-t(3))*u1%UserProp + t(3)*u2%UserProp - t(2)*u3%UserProp ) * scaleFactor - u_out%UserProp = u1%UserProp + b + c * t_out - DO i1 = LBOUND(u_out%v_ac,1),UBOUND(u_out%v_ac,1) - b = (t(3)**2*(u1%v_ac(i1) - u2%v_ac(i1)) + t(2)**2*(-u1%v_ac(i1) + u3%v_ac(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%v_ac(i1) + t(3)*u2%v_ac(i1) - t(2)*u3%v_ac(i1) ) * scaleFactor - u_out%v_ac(i1) = u1%v_ac(i1) + b + c * t_out - END DO - b = (t(3)**2*(u1%omega - u2%omega) + t(2)**2*(-u1%omega + u3%omega))* scaleFactor - c = ( (t(2)-t(3))*u1%omega + t(3)*u2%omega - t(2)*u3%omega ) * scaleFactor - u_out%omega = u1%omega + b + c * t_out - END SUBROUTINE UA_Input_ExtrapInterp2 - - - SUBROUTINE UA_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(UA_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(UA_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + u_out%U = a1*u1%U + a2*u2%U + a3*u3%U + CALL Angles_ExtrapInterp( u1%alpha, u2%alpha, u3%alpha, tin, u_out%alpha, tin_out ) + u_out%Re = a1*u1%Re + a2*u2%Re + a3*u3%Re + u_out%UserProp = a1*u1%UserProp + a2*u2%UserProp + a3*u3%UserProp + u_out%v_ac = a1*u1%v_ac + a2*u2%v_ac + a3*u3%v_ac + u_out%omega = a1*u1%omega + a2*u2%omega + a3*u3%omega +END SUBROUTINE + +subroutine UA_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(UA_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(UA_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 = 'UA_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 UA_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL UA_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 UA_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 UA_Output_ExtrapInterp - - - SUBROUTINE UA_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call UA_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call UA_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call UA_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE UA_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. @@ -6838,57 +3479,50 @@ SUBROUTINE UA_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(UA_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(UA_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(UA_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 + TYPE(UA_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(UA_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(UA_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 = 'UA_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - b = -(y1%Cn - y2%Cn) - y_out%Cn = y1%Cn + b * ScaleFactor - b = -(y1%Cc - y2%Cc) - y_out%Cc = y1%Cc + b * ScaleFactor - b = -(y1%Cm - y2%Cm) - y_out%Cm = y1%Cm + b * ScaleFactor - b = -(y1%Cl - y2%Cl) - y_out%Cl = y1%Cl + b * ScaleFactor - b = -(y1%Cd - y2%Cd) - y_out%Cd = y1%Cd + b * ScaleFactor -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 UA_Output_ExtrapInterp1 - - - SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + y_out%Cn = a1*y1%Cn + a2*y2%Cn + y_out%Cc = a1*y1%Cc + a2*y2%Cc + y_out%Cm = a1*y1%Cm + a2*y2%Cm + y_out%Cl = a1*y1%Cl + a2*y2%Cl + y_out%Cd = a1*y1%Cd + a2*y2%Cd + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE UA_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. @@ -6902,69 +3536,55 @@ SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(UA_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(UA_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(UA_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(UA_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 + TYPE(UA_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(UA_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(UA_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(UA_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 = 'UA_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'UA_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 + 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 + 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 + 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%Cn - y2%Cn) + t(2)**2*(-y1%Cn + y3%Cn))* scaleFactor - c = ( (t(2)-t(3))*y1%Cn + t(3)*y2%Cn - t(2)*y3%Cn ) * scaleFactor - y_out%Cn = y1%Cn + b + c * t_out - b = (t(3)**2*(y1%Cc - y2%Cc) + t(2)**2*(-y1%Cc + y3%Cc))* scaleFactor - c = ( (t(2)-t(3))*y1%Cc + t(3)*y2%Cc - t(2)*y3%Cc ) * scaleFactor - y_out%Cc = y1%Cc + b + c * t_out - b = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))* scaleFactor - c = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) * scaleFactor - y_out%Cm = y1%Cm + b + c * t_out - b = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))* scaleFactor - c = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) * scaleFactor - y_out%Cl = y1%Cl + b + c * t_out - b = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))* scaleFactor - c = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) * scaleFactor - y_out%Cd = y1%Cd + b + c * t_out -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 UA_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + y_out%Cn = a1*y1%Cn + a2*y2%Cn + a3*y3%Cn + y_out%Cc = a1*y1%Cc + a2*y2%Cc + a3*y3%Cc + y_out%Cm = a1*y1%Cm + a2*y2%Cm + a3*y3%Cm + y_out%Cl = a1*y1%Cl + a2*y2%Cl + a3*y3%Cl + y_out%Cd = a1*y1%Cd + a2*y2%Cd + a3*y3%Cd + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE UnsteadyAero_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index 2375d35c70..291c7bdd81 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -36,10 +36,10 @@ MODULE AeroDyn14_Types IMPLICIT NONE ! ========= Marker ======= TYPE, PUBLIC :: Marker - REAL(ReKi) , DIMENSION(1:3) :: Position - REAL(ReKi) , DIMENSION(1:3,1:3) :: Orientation - REAL(ReKi) , DIMENSION(1:3) :: TranslationVel - REAL(ReKi) , DIMENSION(1:3) :: RotationVel + REAL(ReKi) , DIMENSION(1:3) :: Position = 0.0 + REAL(ReKi) , DIMENSION(1:3,1:3) :: Orientation = 0.0 + REAL(ReKi) , DIMENSION(1:3) :: TranslationVel = 0.0 + REAL(ReKi) , DIMENSION(1:3) :: RotationVel = 0.0 END TYPE Marker ! ======================= ! ========= AeroConfig ======= @@ -52,7 +52,7 @@ MODULE AeroDyn14_Types TYPE(Marker) :: Tower TYPE(Marker) :: SubStructure TYPE(Marker) :: Foundation - REAL(ReKi) :: BladeLength + REAL(ReKi) :: BladeLength = 0.0_ReKi END TYPE AeroConfig ! ======================= ! ========= AirFoil ======= @@ -61,8 +61,8 @@ MODULE AeroDyn14_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CD REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CL REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CM - REAL(ReKi) :: PMC - REAL(ReKi) :: MulTabLoc + REAL(ReKi) :: PMC = 0.0_ReKi + REAL(ReKi) :: MulTabLoc = 0.0_ReKi END TYPE AirFoil ! ======================= ! ========= AirFoilParms ======= @@ -70,8 +70,8 @@ MODULE AeroDyn14_Types INTEGER(IntKi) :: MaxTable = 20 INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NTables INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NLift - INTEGER(IntKi) :: NumCL - INTEGER(IntKi) :: NumFoil + INTEGER(IntKi) :: NumCL = 0_IntKi + INTEGER(IntKi) :: NumFoil = 0_IntKi INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NFoil REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MulTabMet CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: FoilNm @@ -83,21 +83,21 @@ MODULE AeroDyn14_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ADOT1 REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AFE REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AFE1 - REAL(ReKi) :: AN + REAL(ReKi) :: AN = 0.0_ReKi REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ANE REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ANE1 REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AOD REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AOL LOGICAL , DIMENSION(:,:), ALLOCATABLE :: BEDSEP LOGICAL , DIMENSION(:,:), ALLOCATABLE :: OLDSEP - REAL(ReKi) :: CC + REAL(ReKi) :: CC = 0.0_ReKi REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CDO - REAL(ReKi) :: CMI - REAL(ReKi) :: CMQ - REAL(ReKi) :: CN + REAL(ReKi) :: CMI = 0.0_ReKi + REAL(ReKi) :: CMQ = 0.0_ReKi + REAL(ReKi) :: CN = 0.0_ReKi REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNA - REAL(ReKi) :: CNCP - REAL(ReKi) :: CNIQ + REAL(ReKi) :: CNCP = 0.0_ReKi + REAL(ReKi) :: CNIQ = 0.0_ReKi REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNP REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNP1 REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNPD @@ -118,10 +118,10 @@ MODULE AeroDyn14_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DQ REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DQP REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DQP1 - REAL(ReKi) :: DS - REAL(ReKi) :: FK - REAL(ReKi) :: FP - REAL(ReKi) :: FPC + REAL(ReKi) :: DS = 0.0_ReKi + REAL(ReKi) :: FK = 0.0_ReKi + REAL(ReKi) :: FP = 0.0_ReKi + REAL(ReKi) :: FPC = 0.0_ReKi REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FSP REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FSP1 REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FSPC @@ -142,61 +142,61 @@ MODULE AeroDyn14_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TAU REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: XN REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: YN - LOGICAL :: SHIFT - LOGICAL :: VOR + LOGICAL :: SHIFT = .false. + LOGICAL :: VOR = .false. END TYPE Beddoes ! ======================= ! ========= BeddoesParms ======= TYPE, PUBLIC :: BeddoesParms - REAL(ReKi) :: AS !< Speed of sound for mach num calc [-] - REAL(ReKi) :: TF !< Time constant applied to loc of separation pt [-] - REAL(ReKi) :: TP !< Time constant for pressure lag [-] - REAL(ReKi) :: TV !< Time constant for strength and shed of vortex [-] - REAL(ReKi) :: TVL !< Nondim time of transit of vort moving across airfoil surf [-] + REAL(ReKi) :: AS = 0.0_ReKi !< Speed of sound for mach num calc [-] + REAL(ReKi) :: TF = 0.0_ReKi !< Time constant applied to loc of separation pt [-] + REAL(ReKi) :: TP = 0.0_ReKi !< Time constant for pressure lag [-] + REAL(ReKi) :: TV = 0.0_ReKi !< Time constant for strength and shed of vortex [-] + REAL(ReKi) :: TVL = 0.0_ReKi !< Nondim time of transit of vort moving across airfoil surf [-] END TYPE BeddoesParms ! ======================= ! ========= BladeParms ======= TYPE, PUBLIC :: BladeParms REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: C !< Chord of each blade element from input file [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DR !< Span-wise width of elem (len of elem ctred at RELM(i) [-] - REAL(ReKi) :: R !< Rotor radius [-] - REAL(ReKi) :: BladeLength !< Blade Length [-] + REAL(ReKi) :: R = 0.0_ReKi !< Rotor radius [-] + REAL(ReKi) :: BladeLength = 0.0_ReKi !< Blade Length [-] END TYPE BladeParms ! ======================= ! ========= DynInflow ======= TYPE, PUBLIC :: DynInflow - REAL(ReKi) , DIMENSION(1:6,1:4) :: dAlph_dt - REAL(ReKi) , DIMENSION(3:6,1:4) :: dBeta_dt - REAL(ReKi) :: DTO - REAL(ReKi) , DIMENSION(1:6) :: old_Alph - REAL(ReKi) , DIMENSION(3:6) :: old_Beta - REAL(ReKi) :: old_LmdM - REAL(ReKi) :: oldKai - REAL(ReKi) , DIMENSION(1:6) :: PhiLqC - REAL(ReKi) , DIMENSION(3:6) :: PhiLqS - REAL(ReKi) :: Pzero + REAL(ReKi) , DIMENSION(1:6,1:4) :: dAlph_dt = 0.0_ReKi + REAL(ReKi) , DIMENSION(3:6,1:4) :: dBeta_dt = 0.0_ReKi + REAL(ReKi) :: DTO = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: old_Alph = 0.0_ReKi + REAL(ReKi) , DIMENSION(3:6) :: old_Beta = 0.0_ReKi + REAL(ReKi) :: old_LmdM = 0.0_ReKi + REAL(ReKi) :: oldKai = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: PhiLqC = 0.0_ReKi + REAL(ReKi) , DIMENSION(3:6) :: PhiLqS = 0.0_ReKi + REAL(ReKi) :: Pzero = 0.0_ReKi REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: RMC_SAVE REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: RMS_SAVE - REAL(ReKi) :: TipSpeed - REAL(ReKi) :: totalInf - REAL(ReKi) :: Vparam - REAL(ReKi) :: Vtotal - REAL(ReKi) , DIMENSION(1:6) :: xAlpha - REAL(ReKi) , DIMENSION(3:6) :: xBeta - REAL(ReKi) :: xKai - REAL(ReKi) :: XLAMBDA_M - REAL(ReKi) , DIMENSION(1:6,1:6) :: xLcos - REAL(ReKi) , DIMENSION(3:6,3:6) :: xLsin - INTEGER(IntKi) , DIMENSION(1:6,1:6) :: MminR - INTEGER(IntKi) , DIMENSION(1:6,1:6) :: MminusR - INTEGER(IntKi) , DIMENSION(1:6,1:6) :: MplusR - REAL(ReKi) , DIMENSION(1:6,1:6) :: GAMMA + REAL(ReKi) :: TipSpeed = 0.0_ReKi + REAL(ReKi) :: totalInf = 0.0_ReKi + REAL(ReKi) :: Vparam = 0.0_ReKi + REAL(ReKi) :: Vtotal = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: xAlpha = 0.0_ReKi + REAL(ReKi) , DIMENSION(3:6) :: xBeta = 0.0_ReKi + REAL(ReKi) :: xKai = 0.0_ReKi + REAL(ReKi) :: XLAMBDA_M = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6,1:6) :: xLcos = 0.0_ReKi + REAL(ReKi) , DIMENSION(3:6,3:6) :: xLsin = 0.0_ReKi + INTEGER(IntKi) , DIMENSION(1:6,1:6) :: MminR = 0_IntKi + INTEGER(IntKi) , DIMENSION(1:6,1:6) :: MminusR = 0_IntKi + INTEGER(IntKi) , DIMENSION(1:6,1:6) :: MplusR = 0_IntKi + REAL(ReKi) , DIMENSION(1:6,1:6) :: GAMMA = 0.0_ReKi END TYPE DynInflow ! ======================= ! ========= DynInflowParms ======= TYPE, PUBLIC :: DynInflowParms INTEGER(IntKi) :: MAXINFLO = 2 - REAL(ReKi) , DIMENSION(1:6) :: xMinv + REAL(ReKi) , DIMENSION(1:6) :: xMinv = 0.0_ReKi END TYPE DynInflowParms ! ======================= ! ========= Element ======= @@ -212,7 +212,7 @@ MODULE AeroDyn14_Types ! ======================= ! ========= ElementParms ======= TYPE, PUBLIC :: ElementParms - INTEGER(IntKi) :: NELM !< - [Number of elements (constant)] + INTEGER(IntKi) :: NELM = 0_IntKi !< - [Number of elements (constant)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TWIST !< - [Airfoil twist angle (constant)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RELM !< - [Radius of element (constant)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HLCNST !< - [Hub loss constant B/2*(r-rh)/rh (constant)] @@ -239,15 +239,15 @@ MODULE AeroDyn14_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SaveVX REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SaveVY REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SaveVZ - REAL(ReKi) :: VXSAV - REAL(ReKi) :: VYSAV - REAL(ReKi) :: VZSAV - INTEGER(IntKi) :: NumWndElOut !< Number of Blade Elements [-] + REAL(ReKi) :: VXSAV = 0.0_ReKi + REAL(ReKi) :: VYSAV = 0.0_ReKi + REAL(ReKi) :: VZSAV = 0.0_ReKi + INTEGER(IntKi) :: NumWndElOut = 0_IntKi !< Number of Blade Elements [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: WndElPrList INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: WndElPrNum INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ElPrList INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ElPrNum - INTEGER(IntKi) :: NumElOut !< Number of Blade Elements [-] + INTEGER(IntKi) :: NumElOut = 0_IntKi !< Number of Blade Elements [-] END TYPE ElOutParms ! ======================= ! ========= InducedVel ======= @@ -257,31 +257,31 @@ MODULE AeroDyn14_Types ! ======================= ! ========= InducedVelParms ======= TYPE, PUBLIC :: InducedVelParms - REAL(ReKi) :: AToler !< Convergence tolerance for induction factor [-] - REAL(ReKi) :: EqAIDmult !< Multiplier for drag term in axial-induction equation. [-] - LOGICAL :: EquilDA !< False unless DB or DA appended to EQUIL [-] - LOGICAL :: EquilDT !< False unless DB or DT appended to EQUIL [-] - LOGICAL :: TLoss !< Tip-loss model (EQUIL only) [PRANDtl, GTECH, or NONE] [-] - LOGICAL :: GTech !< Tip-loss model (EQUIL only) [PRANDtl, GTECH, or NONE] [-] - LOGICAL :: HLoss !< Hub-loss model (EQUIL only) [PRANDtl or NONE] [-] + REAL(ReKi) :: AToler = 0.0_ReKi !< Convergence tolerance for induction factor [-] + REAL(ReKi) :: EqAIDmult = 0.0_ReKi !< Multiplier for drag term in axial-induction equation. [-] + LOGICAL :: EquilDA = .false. !< False unless DB or DA appended to EQUIL [-] + LOGICAL :: EquilDT = .false. !< False unless DB or DT appended to EQUIL [-] + LOGICAL :: TLoss = .false. !< Tip-loss model (EQUIL only) [PRANDtl, GTECH, or NONE] [-] + LOGICAL :: GTech = .false. !< Tip-loss model (EQUIL only) [PRANDtl, GTECH, or NONE] [-] + LOGICAL :: HLoss = .false. !< Hub-loss model (EQUIL only) [PRANDtl or NONE] [-] END TYPE InducedVelParms ! ======================= ! ========= Rotor ======= TYPE, PUBLIC :: Rotor - REAL(ReKi) :: AVGINFL !< average induced velocity at the previous time [-] - REAL(ReKi) :: CTILT - REAL(ReKi) :: CYaw - REAL(ReKi) :: REVS - REAL(ReKi) :: STILT - REAL(ReKi) :: SYaw - REAL(ReKi) :: TILT - REAL(ReKi) :: YawAng - REAL(ReKi) :: YawVEL + REAL(ReKi) :: AVGINFL = 0.0_ReKi !< average induced velocity at the previous time [-] + REAL(ReKi) :: CTILT = 0.0_ReKi + REAL(ReKi) :: CYaw = 0.0_ReKi + REAL(ReKi) :: REVS = 0.0_ReKi + REAL(ReKi) :: STILT = 0.0_ReKi + REAL(ReKi) :: SYaw = 0.0_ReKi + REAL(ReKi) :: TILT = 0.0_ReKi + REAL(ReKi) :: YawAng = 0.0_ReKi + REAL(ReKi) :: YawVEL = 0.0_ReKi END TYPE Rotor ! ======================= ! ========= RotorParms ======= TYPE, PUBLIC :: RotorParms - REAL(ReKi) :: HH + REAL(ReKi) :: HH = 0.0_ReKi END TYPE RotorParms ! ======================= ! ========= TwrPropsParms ======= @@ -290,50 +290,50 @@ MODULE AeroDyn14_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrWid REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrCD REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrRe - REAL(ReKi) , DIMENSION(1:3) :: VTwr - REAL(ReKi) :: Tower_Wake_Constant + REAL(ReKi) , DIMENSION(1:3) :: VTwr = 0.0_ReKi + REAL(ReKi) :: Tower_Wake_Constant = 0.0_ReKi INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NTwrCDCol !< The tower CD column that represents a particular twr ht [-] - INTEGER(IntKi) :: NTwrHT !< The number of tower height rows in the table [-] - INTEGER(IntKi) :: NTwrRe !< The number of tower Re entry rows in the table [-] - INTEGER(IntKi) :: NTwrCD !< The number of tower CD columns in the table [-] - LOGICAL :: TwrPotent !< Tower influence model [-] - LOGICAL :: TwrShadow !< Tower shadow model [-] - REAL(ReKi) :: ShadHWid !< Tower-shadow half width [m] - REAL(ReKi) :: TShadC1 !< Tower-shadow constant [-] - REAL(ReKi) :: TShadC2 !< Tower-shadow constant [-] - REAL(ReKi) :: TwrShad !< Tower-shadow velocity deficit [-] - LOGICAL :: PJM_Version !< Only true if new tower influence model, by PJM [-] + INTEGER(IntKi) :: NTwrHT = 0_IntKi !< The number of tower height rows in the table [-] + INTEGER(IntKi) :: NTwrRe = 0_IntKi !< The number of tower Re entry rows in the table [-] + INTEGER(IntKi) :: NTwrCD = 0_IntKi !< The number of tower CD columns in the table [-] + LOGICAL :: TwrPotent = .false. !< Tower influence model [-] + LOGICAL :: TwrShadow = .false. !< Tower shadow model [-] + REAL(ReKi) :: ShadHWid = 0.0_ReKi !< Tower-shadow half width [m] + REAL(ReKi) :: TShadC1 = 0.0_ReKi !< Tower-shadow constant [-] + REAL(ReKi) :: TShadC2 = 0.0_ReKi !< Tower-shadow constant [-] + REAL(ReKi) :: TwrShad = 0.0_ReKi !< Tower-shadow velocity deficit [-] + LOGICAL :: PJM_Version = .false. !< Only true if new tower influence model, by PJM [-] CHARACTER(1024) :: TwrFile !< Tower data file name [-] - REAL(ReKi) :: T_Shad_Refpt !< Tower-shadow reference point [m] - LOGICAL :: CalcTwrAero !< Flag to tell AeroDyn to calculate drag on the tower [m] - INTEGER(IntKi) :: NumTwrNodes !< Number of ElastoDyn tower nodes. Tower drag will be computed at those points. [-] + REAL(ReKi) :: T_Shad_Refpt = 0.0_ReKi !< Tower-shadow reference point [m] + LOGICAL :: CalcTwrAero = .false. !< Flag to tell AeroDyn to calculate drag on the tower [m] + INTEGER(IntKi) :: NumTwrNodes = 0_IntKi !< Number of ElastoDyn tower nodes. Tower drag will be computed at those points. [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrNodeWidth !< The width (diameter) of the tower at the ElastoDyn node locations. [-] END TYPE TwrPropsParms ! ======================= ! ========= Wind ======= TYPE, PUBLIC :: Wind - REAL(ReKi) :: ANGFLW - REAL(ReKi) :: CDEL - REAL(ReKi) :: VROTORX - REAL(ReKi) :: VROTORY - REAL(ReKi) :: VROTORZ - REAL(ReKi) :: SDEL + REAL(ReKi) :: ANGFLW = 0.0_ReKi + REAL(ReKi) :: CDEL = 0.0_ReKi + REAL(ReKi) :: VROTORX = 0.0_ReKi + REAL(ReKi) :: VROTORY = 0.0_ReKi + REAL(ReKi) :: VROTORZ = 0.0_ReKi + REAL(ReKi) :: SDEL = 0.0_ReKi END TYPE Wind ! ======================= ! ========= WindParms ======= TYPE, PUBLIC :: WindParms - REAL(ReKi) :: Rho !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [(m^2/sec)] + REAL(ReKi) :: Rho = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [(m^2/sec)] END TYPE WindParms ! ======================= ! ========= PositionType ======= TYPE, PUBLIC :: PositionType - REAL(ReKi) , DIMENSION(1:3) :: Pos !< X,Y,Z coordinate of a point [-] + REAL(ReKi) , DIMENSION(1:3) :: Pos = 0.0_ReKi !< X,Y,Z coordinate of a point [-] END TYPE PositionType ! ======================= ! ========= OrientationType ======= TYPE, PUBLIC :: OrientationType - REAL(ReKi) , DIMENSION(1:3,1:3) :: Orient !< Direction Cosine Matrix [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: Orient = 0.0_ReKi !< Direction Cosine Matrix [-] END TYPE OrientationType ! ======================= ! ========= AD14_InitInputType ======= @@ -341,15 +341,15 @@ MODULE AeroDyn14_Types CHARACTER(1024) :: Title !< Title [-] CHARACTER(1024) :: OutRootName CHARACTER(1024) :: ADFileName !< AeroDyn file name [-] - LOGICAL :: WrSumFile !< T/F: Write an AeroDyn summary [-] - INTEGER(IntKi) :: NumBl !< Number of Blades [-] - REAL(ReKi) :: BladeLength !< Blade Length [-] - LOGICAL :: LinearizeFlag + LOGICAL :: WrSumFile = .false. !< T/F: Write an AeroDyn summary [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of Blades [-] + REAL(ReKi) :: BladeLength = 0.0_ReKi !< Blade Length [-] + LOGICAL :: LinearizeFlag = .false. LOGICAL :: UseDWM = .FALSE. !< flag to determine if DWM module should be used [-] TYPE(AeroConfig) :: TurbineComponents - INTEGER(IntKi) :: NumTwrNodes !< Number of ElastoDyn tower nodes. Tower drag will be computed at those points. [-] + INTEGER(IntKi) :: NumTwrNodes = 0_IntKi !< Number of ElastoDyn tower nodes. Tower drag will be computed at those points. [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrNodeLocs !< Location of ElastoDyn tower nodes with respect to the inertial origin. [-] - REAL(ReKi) :: HubHt !< hub height wrt inertial origin [m] + REAL(ReKi) :: HubHt = 0.0_ReKi !< hub height wrt inertial origin [m] TYPE(DWM_InitInputType) :: DWM END TYPE AD14_InitInputType ! ======================= @@ -357,7 +357,7 @@ MODULE AeroDyn14_Types TYPE, PUBLIC :: AD14_InitOutputType TYPE(ProgDesc) :: Ver !< version information [-] TYPE(DWM_InitOutputType) :: DWM - REAL(ReKi) :: AirDens !< Air density [kg/m^3] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] END TYPE AD14_InitOutputType ! ======================= ! ========= AD14_ContinuousStateType ======= @@ -385,13 +385,13 @@ MODULE AeroDyn14_Types TYPE(DWM_MiscVarType) :: DWM !< variables for DWM module [-] TYPE(DWM_InputType) :: DWM_Inputs TYPE(DWM_OutputType) :: DWM_Outputs - REAL(DbKi) :: DT !< actual Time step [seconds] + REAL(DbKi) :: DT = 0.0_R8Ki !< actual Time step [seconds] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ElPrNum - REAL(DbKi) :: OldTime + REAL(DbKi) :: OldTime = 0.0_R8Ki REAL(ReKi) :: HubLoss = 1 REAL(ReKi) :: Loss = 1 REAL(ReKi) :: TipLoss = 1 - REAL(ReKi) :: TLpt7 + REAL(ReKi) :: TLpt7 = 0.0_ReKi LOGICAL :: FirstPassGTL = .TRUE. LOGICAL :: SuperSonic = .FALSE. LOGICAL :: AFLAGVinderr = .FALSE. @@ -407,9 +407,9 @@ MODULE AeroDyn14_Types TYPE(Wind) :: Wind TYPE(InducedVel) :: InducedVel TYPE(ElOutParms) :: ElOut - LOGICAL :: Skew - LOGICAL :: DynInit !< FALSE=EQUIL, TRUE=DYNIN [-] - LOGICAL :: FirstWarn !< If it's the first warning about AeroDyn not recalculating loads [-] + LOGICAL :: Skew = .false. + LOGICAL :: DynInit = .false. !< FALSE=EQUIL, TRUE=DYNIN [-] + LOGICAL :: FirstWarn = .false. !< If it's the first warning about AeroDyn not recalculating loads [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: StoredForces REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: StoredMoments END TYPE AD14_MiscVarType @@ -417,24 +417,24 @@ MODULE AeroDyn14_Types ! ========= AD14_ParameterType ======= TYPE, PUBLIC :: AD14_ParameterType CHARACTER(1024) :: Title !< Title [-] - LOGICAL :: SIUnit + LOGICAL :: SIUnit = .false. LOGICAL :: Echo = .FALSE. - LOGICAL :: MultiTab - LOGICAL :: LinearizeFlag + LOGICAL :: MultiTab = .false. + LOGICAL :: LinearizeFlag = .false. LOGICAL :: OutputPlottingInfo = .FALSE. LOGICAL :: UseDWM = .FALSE. !< flag to determine if DWM module should be used [-] - REAL(ReKi) :: TwoPiNB !< 2*pi/num of blades [-] - INTEGER(IntKi) :: NumBl !< Number of Blades [-] - INTEGER(IntKi) :: NBlInpSt !< Number of Blade Input Stations [-] - LOGICAL :: ElemPrn - LOGICAL :: DStall !< FALSE=Steady, TRUE=BEDDOES [-] - LOGICAL :: PMoment !< FALSE=NO_CM, TRUE=USE_CM [-] - LOGICAL :: Reynolds - LOGICAL :: DynInfl !< FALSE=EQUIL, TRUE=DYNIN [-] - LOGICAL :: Wake !< False unless WAKE or SWIRL [-] - LOGICAL :: Swirl !< False unless WAKE or SWIRL [-] - REAL(DbKi) :: DtAero !< Time interval for aerodynamic calculations [-] - REAL(ReKi) :: HubRad !< Hub radius [m] + REAL(ReKi) :: TwoPiNB = 0.0_ReKi !< 2*pi/num of blades [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of Blades [-] + INTEGER(IntKi) :: NBlInpSt = 0_IntKi !< Number of Blade Input Stations [-] + LOGICAL :: ElemPrn = .false. + LOGICAL :: DStall = .false. !< FALSE=Steady, TRUE=BEDDOES [-] + LOGICAL :: PMoment = .false. !< FALSE=NO_CM, TRUE=USE_CM [-] + LOGICAL :: Reynolds = .false. + LOGICAL :: DynInfl = .false. !< FALSE=EQUIL, TRUE=DYNIN [-] + LOGICAL :: Wake = .false. !< False unless WAKE or SWIRL [-] + LOGICAL :: Swirl = .false. !< False unless WAKE or SWIRL [-] + REAL(DbKi) :: DtAero = 0.0_R8Ki !< Time interval for aerodynamic calculations [-] + REAL(ReKi) :: HubRad = 0.0_ReKi !< Hub radius [m] INTEGER(IntKi) :: UnEc = -1 INTEGER(IntKi) :: UnElem = -1 INTEGER(IntKi) :: UnWndOut = -1 @@ -460,7 +460,7 @@ MODULE AeroDyn14_Types TYPE(AeroConfig) :: TurbineComponents !< Current locations of components [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MulTabLoc REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowVelocity !< U,V,W wind inflow speeds at all locations on the Inputmarker and Twr_InputMarker meshes [m/s] - REAL(ReKi) , DIMENSION(1:3) :: AvgInfVel !< an average disk velocity (depends on wind type and should be removed) [m/s] + REAL(ReKi) , DIMENSION(1:3) :: AvgInfVel = 0.0_ReKi !< an average disk velocity (depends on wind type and should be removed) [m/s] END TYPE AD14_InputType ! ======================= ! ========= AD14_OutputType ======= @@ -470,15904 +470,6068 @@ MODULE AeroDyn14_Types END TYPE AD14_OutputType ! ======================= CONTAINS - SUBROUTINE AD14_CopyMarker( SrcMarkerData, DstMarkerData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Marker), INTENT(IN) :: SrcMarkerData - TYPE(Marker), INTENT(INOUT) :: DstMarkerData - 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 = 'AD14_CopyMarker' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMarkerData%Position = SrcMarkerData%Position - DstMarkerData%Orientation = SrcMarkerData%Orientation - DstMarkerData%TranslationVel = SrcMarkerData%TranslationVel - DstMarkerData%RotationVel = SrcMarkerData%RotationVel - END SUBROUTINE AD14_CopyMarker - - SUBROUTINE AD14_DestroyMarker( MarkerData, ErrStat, ErrMsg ) - TYPE(Marker), INTENT(INOUT) :: MarkerData - 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 = 'AD14_DestroyMarker' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyMarker - - SUBROUTINE AD14_PackMarker( 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(Marker), 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 = 'AD14_PackMarker' - ! 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 + SIZE(InData%Position) ! Position - Re_BufSz = Re_BufSz + SIZE(InData%Orientation) ! Orientation - Re_BufSz = Re_BufSz + SIZE(InData%TranslationVel) ! TranslationVel - Re_BufSz = Re_BufSz + SIZE(InData%RotationVel) ! RotationVel - 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 i1 = LBOUND(InData%Position,1), UBOUND(InData%Position,1) - ReKiBuf(Re_Xferred) = InData%Position(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%Orientation,2), UBOUND(InData%Orientation,2) - DO i1 = LBOUND(InData%Orientation,1), UBOUND(InData%Orientation,1) - ReKiBuf(Re_Xferred) = InData%Orientation(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%TranslationVel,1), UBOUND(InData%TranslationVel,1) - ReKiBuf(Re_Xferred) = InData%TranslationVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RotationVel,1), UBOUND(InData%RotationVel,1) - ReKiBuf(Re_Xferred) = InData%RotationVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_PackMarker - - SUBROUTINE AD14_UnPackMarker( 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(Marker), 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 = 'AD14_UnPackMarker' - ! 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 - i1_l = LBOUND(OutData%Position,1) - i1_u = UBOUND(OutData%Position,1) - DO i1 = LBOUND(OutData%Position,1), UBOUND(OutData%Position,1) - OutData%Position(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Orientation,1) - i1_u = UBOUND(OutData%Orientation,1) - i2_l = LBOUND(OutData%Orientation,2) - i2_u = UBOUND(OutData%Orientation,2) - DO i2 = LBOUND(OutData%Orientation,2), UBOUND(OutData%Orientation,2) - DO i1 = LBOUND(OutData%Orientation,1), UBOUND(OutData%Orientation,1) - OutData%Orientation(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%TranslationVel,1) - i1_u = UBOUND(OutData%TranslationVel,1) - DO i1 = LBOUND(OutData%TranslationVel,1), UBOUND(OutData%TranslationVel,1) - OutData%TranslationVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RotationVel,1) - i1_u = UBOUND(OutData%RotationVel,1) - DO i1 = LBOUND(OutData%RotationVel,1), UBOUND(OutData%RotationVel,1) - OutData%RotationVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_UnPackMarker - - SUBROUTINE AD14_CopyAeroConfig( SrcAeroConfigData, DstAeroConfigData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroConfig), INTENT(IN) :: SrcAeroConfigData - TYPE(AeroConfig), INTENT(INOUT) :: DstAeroConfigData - 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 = 'AD14_CopyAeroConfig' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcAeroConfigData%Blade)) THEN - i1_l = LBOUND(SrcAeroConfigData%Blade,1) - i1_u = UBOUND(SrcAeroConfigData%Blade,1) - IF (.NOT. ALLOCATED(DstAeroConfigData%Blade)) THEN - ALLOCATE(DstAeroConfigData%Blade(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroConfigData%Blade.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroConfigData%Blade,1), UBOUND(SrcAeroConfigData%Blade,1) - CALL AD14_Copymarker( SrcAeroConfigData%Blade(i1), DstAeroConfigData%Blade(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL AD14_Copymarker( SrcAeroConfigData%Hub, DstAeroConfigData%Hub, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%RotorFurl, DstAeroConfigData%RotorFurl, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%Nacelle, DstAeroConfigData%Nacelle, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%TailFin, DstAeroConfigData%TailFin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%Tower, DstAeroConfigData%Tower, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%SubStructure, DstAeroConfigData%SubStructure, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%Foundation, DstAeroConfigData%Foundation, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstAeroConfigData%BladeLength = SrcAeroConfigData%BladeLength - END SUBROUTINE AD14_CopyAeroConfig - - SUBROUTINE AD14_DestroyAeroConfig( AeroConfigData, ErrStat, ErrMsg ) - TYPE(AeroConfig), INTENT(INOUT) :: AeroConfigData - 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 = 'AD14_DestroyAeroConfig' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(AeroConfigData%Blade)) THEN -DO i1 = LBOUND(AeroConfigData%Blade,1), UBOUND(AeroConfigData%Blade,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMarker( AeroConfigData%RotorFurl, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMarker( AeroConfigData%Nacelle, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMarker( AeroConfigData%TailFin, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMarker( AeroConfigData%Tower, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMarker( AeroConfigData%SubStructure, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMarker( AeroConfigData%Foundation, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyAeroConfig - - SUBROUTINE AD14_PackAeroConfig( 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(AeroConfig), 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 = 'AD14_PackAeroConfig' - ! 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 ! Blade allocated yes/no - IF ( ALLOCATED(InData%Blade) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Blade upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Blade - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Blade - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Blade - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RotorFurl - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RotorFurl - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RotorFurl - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Nacelle - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Nacelle - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Nacelle - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TailFin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TailFin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TailFin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Tower - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Tower - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Tower - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubStructure - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubStructure - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubStructure - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Foundation - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Foundation - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Foundation - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! BladeLength - 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%Blade) ) 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%Blade,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Blade,1) - 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 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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%BladeLength - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackAeroConfig - - SUBROUTINE AD14_UnPackAeroConfig( 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(AeroConfig), 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 = 'AD14_UnPackAeroConfig' - ! 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 ! Blade 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%Blade)) DEALLOCATE(OutData%Blade) - ALLOCATE(OutData%Blade(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Blade.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Blade,1), UBOUND(OutData%Blade,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 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 - - 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 - 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 AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%Hub, ErrStat2, ErrMsg2 ) ! Hub - 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) - 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 AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%RotorFurl, ErrStat2, ErrMsg2 ) ! RotorFurl - 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) - 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 AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%Nacelle, ErrStat2, ErrMsg2 ) ! Nacelle - 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) - 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 AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%TailFin, ErrStat2, ErrMsg2 ) ! TailFin - 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) - 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 AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%Tower, ErrStat2, ErrMsg2 ) ! Tower - 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) - 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 AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure, ErrStat2, ErrMsg2 ) ! SubStructure - 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) - 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 AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%Foundation, ErrStat2, ErrMsg2 ) ! Foundation - 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%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackAeroConfig - - SUBROUTINE AD14_CopyAirFoil( SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AirFoil), INTENT(IN) :: SrcAirFoilData - TYPE(AirFoil), INTENT(INOUT) :: DstAirFoilData - 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 = 'AD14_CopyAirFoil' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcAirFoilData%AL)) THEN - i1_l = LBOUND(SrcAirFoilData%AL,1) - i1_u = UBOUND(SrcAirFoilData%AL,1) - i2_l = LBOUND(SrcAirFoilData%AL,2) - i2_u = UBOUND(SrcAirFoilData%AL,2) - IF (.NOT. ALLOCATED(DstAirFoilData%AL)) THEN - ALLOCATE(DstAirFoilData%AL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%AL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilData%AL = SrcAirFoilData%AL -ENDIF -IF (ALLOCATED(SrcAirFoilData%CD)) THEN - i1_l = LBOUND(SrcAirFoilData%CD,1) - i1_u = UBOUND(SrcAirFoilData%CD,1) - i2_l = LBOUND(SrcAirFoilData%CD,2) - i2_u = UBOUND(SrcAirFoilData%CD,2) - i3_l = LBOUND(SrcAirFoilData%CD,3) - i3_u = UBOUND(SrcAirFoilData%CD,3) - IF (.NOT. ALLOCATED(DstAirFoilData%CD)) THEN - ALLOCATE(DstAirFoilData%CD(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%CD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilData%CD = SrcAirFoilData%CD -ENDIF -IF (ALLOCATED(SrcAirFoilData%CL)) THEN - i1_l = LBOUND(SrcAirFoilData%CL,1) - i1_u = UBOUND(SrcAirFoilData%CL,1) - i2_l = LBOUND(SrcAirFoilData%CL,2) - i2_u = UBOUND(SrcAirFoilData%CL,2) - i3_l = LBOUND(SrcAirFoilData%CL,3) - i3_u = UBOUND(SrcAirFoilData%CL,3) - IF (.NOT. ALLOCATED(DstAirFoilData%CL)) THEN - ALLOCATE(DstAirFoilData%CL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%CL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilData%CL = SrcAirFoilData%CL -ENDIF -IF (ALLOCATED(SrcAirFoilData%CM)) THEN - i1_l = LBOUND(SrcAirFoilData%CM,1) - i1_u = UBOUND(SrcAirFoilData%CM,1) - i2_l = LBOUND(SrcAirFoilData%CM,2) - i2_u = UBOUND(SrcAirFoilData%CM,2) - i3_l = LBOUND(SrcAirFoilData%CM,3) - i3_u = UBOUND(SrcAirFoilData%CM,3) - IF (.NOT. ALLOCATED(DstAirFoilData%CM)) THEN - ALLOCATE(DstAirFoilData%CM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%CM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilData%CM = SrcAirFoilData%CM -ENDIF - DstAirFoilData%PMC = SrcAirFoilData%PMC - DstAirFoilData%MulTabLoc = SrcAirFoilData%MulTabLoc - END SUBROUTINE AD14_CopyAirFoil - - SUBROUTINE AD14_DestroyAirFoil( AirFoilData, ErrStat, ErrMsg ) - TYPE(AirFoil), INTENT(INOUT) :: AirFoilData - 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 = 'AD14_DestroyAirFoil' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(AirFoilData%AL)) THEN - DEALLOCATE(AirFoilData%AL) -ENDIF -IF (ALLOCATED(AirFoilData%CD)) THEN - DEALLOCATE(AirFoilData%CD) -ENDIF -IF (ALLOCATED(AirFoilData%CL)) THEN - DEALLOCATE(AirFoilData%CL) -ENDIF -IF (ALLOCATED(AirFoilData%CM)) THEN - DEALLOCATE(AirFoilData%CM) -ENDIF - END SUBROUTINE AD14_DestroyAirFoil - - SUBROUTINE AD14_PackAirFoil( 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(AirFoil), 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 = 'AD14_PackAirFoil' - ! 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 ! AL allocated yes/no - IF ( ALLOCATED(InData%AL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AL) ! AL - END IF - Int_BufSz = Int_BufSz + 1 ! CD allocated yes/no - IF ( ALLOCATED(InData%CD) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CD) ! CD - END IF - Int_BufSz = Int_BufSz + 1 ! CL allocated yes/no - IF ( ALLOCATED(InData%CL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CL) ! CL - END IF - Int_BufSz = Int_BufSz + 1 ! CM allocated yes/no - IF ( ALLOCATED(InData%CM) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CM) ! CM - END IF - Re_BufSz = Re_BufSz + 1 ! PMC - Re_BufSz = Re_BufSz + 1 ! MulTabLoc - 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%AL) ) 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%AL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AL,2), UBOUND(InData%AL,2) - DO i1 = LBOUND(InData%AL,1), UBOUND(InData%AL,1) - ReKiBuf(Re_Xferred) = InData%AL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CD) ) 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%CD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CD,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CD,3), UBOUND(InData%CD,3) - DO i2 = LBOUND(InData%CD,2), UBOUND(InData%CD,2) - DO i1 = LBOUND(InData%CD,1), UBOUND(InData%CD,1) - ReKiBuf(Re_Xferred) = InData%CD(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CL) ) 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%CL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CL,3), UBOUND(InData%CL,3) - DO i2 = LBOUND(InData%CL,2), UBOUND(InData%CL,2) - DO i1 = LBOUND(InData%CL,1), UBOUND(InData%CL,1) - ReKiBuf(Re_Xferred) = InData%CL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CM) ) 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%CM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CM,3), UBOUND(InData%CM,3) - DO i2 = LBOUND(InData%CM,2), UBOUND(InData%CM,2) - DO i1 = LBOUND(InData%CM,1), UBOUND(InData%CM,1) - ReKiBuf(Re_Xferred) = InData%CM(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PMC - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MulTabLoc - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackAirFoil - - SUBROUTINE AD14_UnPackAirFoil( 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(AirFoil), 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 = 'AD14_UnPackAirFoil' - ! 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 ! AL 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%AL)) DEALLOCATE(OutData%AL) - ALLOCATE(OutData%AL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AL,2), UBOUND(OutData%AL,2) - DO i1 = LBOUND(OutData%AL,1), UBOUND(OutData%AL,1) - OutData%AL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CD 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%CD)) DEALLOCATE(OutData%CD) - ALLOCATE(OutData%CD(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%CD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CD,3), UBOUND(OutData%CD,3) - DO i2 = LBOUND(OutData%CD,2), UBOUND(OutData%CD,2) - DO i1 = LBOUND(OutData%CD,1), UBOUND(OutData%CD,1) - OutData%CD(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CL 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%CL)) DEALLOCATE(OutData%CL) - ALLOCATE(OutData%CL(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%CL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CL,3), UBOUND(OutData%CL,3) - DO i2 = LBOUND(OutData%CL,2), UBOUND(OutData%CL,2) - DO i1 = LBOUND(OutData%CL,1), UBOUND(OutData%CL,1) - OutData%CL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CM 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%CM)) DEALLOCATE(OutData%CM) - ALLOCATE(OutData%CM(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%CM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CM,3), UBOUND(OutData%CM,3) - DO i2 = LBOUND(OutData%CM,2), UBOUND(OutData%CM,2) - DO i1 = LBOUND(OutData%CM,1), UBOUND(OutData%CM,1) - OutData%CM(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%PMC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MulTabLoc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackAirFoil - - SUBROUTINE AD14_CopyAirFoilParms( SrcAirFoilParmsData, DstAirFoilParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AirFoilParms), INTENT(IN) :: SrcAirFoilParmsData - TYPE(AirFoilParms), INTENT(INOUT) :: DstAirFoilParmsData - 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 = 'AD14_CopyAirFoilParms' -! - ErrStat = ErrID_None - ErrMsg = "" - DstAirFoilParmsData%MaxTable = SrcAirFoilParmsData%MaxTable -IF (ALLOCATED(SrcAirFoilParmsData%NTables)) THEN - i1_l = LBOUND(SrcAirFoilParmsData%NTables,1) - i1_u = UBOUND(SrcAirFoilParmsData%NTables,1) - IF (.NOT. ALLOCATED(DstAirFoilParmsData%NTables)) THEN - ALLOCATE(DstAirFoilParmsData%NTables(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%NTables.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilParmsData%NTables = SrcAirFoilParmsData%NTables -ENDIF -IF (ALLOCATED(SrcAirFoilParmsData%NLift)) THEN - i1_l = LBOUND(SrcAirFoilParmsData%NLift,1) - i1_u = UBOUND(SrcAirFoilParmsData%NLift,1) - IF (.NOT. ALLOCATED(DstAirFoilParmsData%NLift)) THEN - ALLOCATE(DstAirFoilParmsData%NLift(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%NLift.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilParmsData%NLift = SrcAirFoilParmsData%NLift -ENDIF - DstAirFoilParmsData%NumCL = SrcAirFoilParmsData%NumCL - DstAirFoilParmsData%NumFoil = SrcAirFoilParmsData%NumFoil -IF (ALLOCATED(SrcAirFoilParmsData%NFoil)) THEN - i1_l = LBOUND(SrcAirFoilParmsData%NFoil,1) - i1_u = UBOUND(SrcAirFoilParmsData%NFoil,1) - IF (.NOT. ALLOCATED(DstAirFoilParmsData%NFoil)) THEN - ALLOCATE(DstAirFoilParmsData%NFoil(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%NFoil.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilParmsData%NFoil = SrcAirFoilParmsData%NFoil -ENDIF -IF (ALLOCATED(SrcAirFoilParmsData%MulTabMet)) THEN - i1_l = LBOUND(SrcAirFoilParmsData%MulTabMet,1) - i1_u = UBOUND(SrcAirFoilParmsData%MulTabMet,1) - i2_l = LBOUND(SrcAirFoilParmsData%MulTabMet,2) - i2_u = UBOUND(SrcAirFoilParmsData%MulTabMet,2) - IF (.NOT. ALLOCATED(DstAirFoilParmsData%MulTabMet)) THEN - ALLOCATE(DstAirFoilParmsData%MulTabMet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%MulTabMet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilParmsData%MulTabMet = SrcAirFoilParmsData%MulTabMet -ENDIF -IF (ALLOCATED(SrcAirFoilParmsData%FoilNm)) THEN - i1_l = LBOUND(SrcAirFoilParmsData%FoilNm,1) - i1_u = UBOUND(SrcAirFoilParmsData%FoilNm,1) - IF (.NOT. ALLOCATED(DstAirFoilParmsData%FoilNm)) THEN - ALLOCATE(DstAirFoilParmsData%FoilNm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%FoilNm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilParmsData%FoilNm = SrcAirFoilParmsData%FoilNm -ENDIF - END SUBROUTINE AD14_CopyAirFoilParms - - SUBROUTINE AD14_DestroyAirFoilParms( AirFoilParmsData, ErrStat, ErrMsg ) - TYPE(AirFoilParms), INTENT(INOUT) :: AirFoilParmsData - 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 = 'AD14_DestroyAirFoilParms' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(AirFoilParmsData%NTables)) THEN - DEALLOCATE(AirFoilParmsData%NTables) -ENDIF -IF (ALLOCATED(AirFoilParmsData%NLift)) THEN - DEALLOCATE(AirFoilParmsData%NLift) -ENDIF -IF (ALLOCATED(AirFoilParmsData%NFoil)) THEN - DEALLOCATE(AirFoilParmsData%NFoil) -ENDIF -IF (ALLOCATED(AirFoilParmsData%MulTabMet)) THEN - DEALLOCATE(AirFoilParmsData%MulTabMet) -ENDIF -IF (ALLOCATED(AirFoilParmsData%FoilNm)) THEN - DEALLOCATE(AirFoilParmsData%FoilNm) -ENDIF - END SUBROUTINE AD14_DestroyAirFoilParms - - SUBROUTINE AD14_PackAirFoilParms( 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(AirFoilParms), 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 = 'AD14_PackAirFoilParms' - ! 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 ! MaxTable - Int_BufSz = Int_BufSz + 1 ! NTables allocated yes/no - IF ( ALLOCATED(InData%NTables) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NTables upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NTables) ! NTables - END IF - Int_BufSz = Int_BufSz + 1 ! NLift allocated yes/no - IF ( ALLOCATED(InData%NLift) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NLift upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NLift) ! NLift - END IF - Int_BufSz = Int_BufSz + 1 ! NumCL - Int_BufSz = Int_BufSz + 1 ! NumFoil - Int_BufSz = Int_BufSz + 1 ! NFoil allocated yes/no - IF ( ALLOCATED(InData%NFoil) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NFoil upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NFoil) ! NFoil - END IF - Int_BufSz = Int_BufSz + 1 ! MulTabMet allocated yes/no - IF ( ALLOCATED(InData%MulTabMet) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MulTabMet upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MulTabMet) ! MulTabMet - END IF - Int_BufSz = Int_BufSz + 1 ! FoilNm allocated yes/no - IF ( ALLOCATED(InData%FoilNm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FoilNm upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FoilNm)*LEN(InData%FoilNm) ! FoilNm - 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 - - IntKiBuf(Int_Xferred) = InData%MaxTable - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NTables) ) 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%NTables,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NTables,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NTables,1), UBOUND(InData%NTables,1) - IntKiBuf(Int_Xferred) = InData%NTables(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NLift) ) 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%NLift,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NLift,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NLift,1), UBOUND(InData%NLift,1) - IntKiBuf(Int_Xferred) = InData%NLift(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumCL - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumFoil - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NFoil) ) 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%NFoil,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NFoil,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NFoil,1), UBOUND(InData%NFoil,1) - IntKiBuf(Int_Xferred) = InData%NFoil(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MulTabMet) ) 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%MulTabMet,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabMet,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MulTabMet,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabMet,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MulTabMet,2), UBOUND(InData%MulTabMet,2) - DO i1 = LBOUND(InData%MulTabMet,1), UBOUND(InData%MulTabMet,1) - ReKiBuf(Re_Xferred) = InData%MulTabMet(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FoilNm) ) 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%FoilNm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FoilNm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FoilNm,1), UBOUND(InData%FoilNm,1) - DO I = 1, LEN(InData%FoilNm) - IntKiBuf(Int_Xferred) = ICHAR(InData%FoilNm(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE AD14_PackAirFoilParms - - SUBROUTINE AD14_UnPackAirFoilParms( 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(AirFoilParms), 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 = 'AD14_UnPackAirFoilParms' - ! 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%MaxTable = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NTables 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%NTables)) DEALLOCATE(OutData%NTables) - ALLOCATE(OutData%NTables(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTables.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NTables,1), UBOUND(OutData%NTables,1) - OutData%NTables(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NLift 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%NLift)) DEALLOCATE(OutData%NLift) - ALLOCATE(OutData%NLift(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NLift.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NLift,1), UBOUND(OutData%NLift,1) - OutData%NLift(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NumCL = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumFoil = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NFoil 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%NFoil)) DEALLOCATE(OutData%NFoil) - ALLOCATE(OutData%NFoil(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NFoil.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NFoil,1), UBOUND(OutData%NFoil,1) - OutData%NFoil(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MulTabMet 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%MulTabMet)) DEALLOCATE(OutData%MulTabMet) - ALLOCATE(OutData%MulTabMet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabMet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MulTabMet,2), UBOUND(OutData%MulTabMet,2) - DO i1 = LBOUND(OutData%MulTabMet,1), UBOUND(OutData%MulTabMet,1) - OutData%MulTabMet(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FoilNm 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%FoilNm)) DEALLOCATE(OutData%FoilNm) - ALLOCATE(OutData%FoilNm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FoilNm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FoilNm,1), UBOUND(OutData%FoilNm,1) - DO I = 1, LEN(OutData%FoilNm) - OutData%FoilNm(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE AD14_UnPackAirFoilParms - - SUBROUTINE AD14_CopyBeddoes( SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Beddoes), INTENT(IN) :: SrcBeddoesData - TYPE(Beddoes), INTENT(INOUT) :: DstBeddoesData - 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 = 'AD14_CopyBeddoes' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBeddoesData%ADOT)) THEN - i1_l = LBOUND(SrcBeddoesData%ADOT,1) - i1_u = UBOUND(SrcBeddoesData%ADOT,1) - i2_l = LBOUND(SrcBeddoesData%ADOT,2) - i2_u = UBOUND(SrcBeddoesData%ADOT,2) - IF (.NOT. ALLOCATED(DstBeddoesData%ADOT)) THEN - ALLOCATE(DstBeddoesData%ADOT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ADOT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%ADOT = SrcBeddoesData%ADOT -ENDIF -IF (ALLOCATED(SrcBeddoesData%ADOT1)) THEN - i1_l = LBOUND(SrcBeddoesData%ADOT1,1) - i1_u = UBOUND(SrcBeddoesData%ADOT1,1) - i2_l = LBOUND(SrcBeddoesData%ADOT1,2) - i2_u = UBOUND(SrcBeddoesData%ADOT1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%ADOT1)) THEN - ALLOCATE(DstBeddoesData%ADOT1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ADOT1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%ADOT1 = SrcBeddoesData%ADOT1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%AFE)) THEN - i1_l = LBOUND(SrcBeddoesData%AFE,1) - i1_u = UBOUND(SrcBeddoesData%AFE,1) - i2_l = LBOUND(SrcBeddoesData%AFE,2) - i2_u = UBOUND(SrcBeddoesData%AFE,2) - IF (.NOT. ALLOCATED(DstBeddoesData%AFE)) THEN - ALLOCATE(DstBeddoesData%AFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%AFE = SrcBeddoesData%AFE -ENDIF -IF (ALLOCATED(SrcBeddoesData%AFE1)) THEN - i1_l = LBOUND(SrcBeddoesData%AFE1,1) - i1_u = UBOUND(SrcBeddoesData%AFE1,1) - i2_l = LBOUND(SrcBeddoesData%AFE1,2) - i2_u = UBOUND(SrcBeddoesData%AFE1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%AFE1)) THEN - ALLOCATE(DstBeddoesData%AFE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AFE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%AFE1 = SrcBeddoesData%AFE1 -ENDIF - DstBeddoesData%AN = SrcBeddoesData%AN -IF (ALLOCATED(SrcBeddoesData%ANE)) THEN - i1_l = LBOUND(SrcBeddoesData%ANE,1) - i1_u = UBOUND(SrcBeddoesData%ANE,1) - i2_l = LBOUND(SrcBeddoesData%ANE,2) - i2_u = UBOUND(SrcBeddoesData%ANE,2) - IF (.NOT. ALLOCATED(DstBeddoesData%ANE)) THEN - ALLOCATE(DstBeddoesData%ANE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ANE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%ANE = SrcBeddoesData%ANE -ENDIF -IF (ALLOCATED(SrcBeddoesData%ANE1)) THEN - i1_l = LBOUND(SrcBeddoesData%ANE1,1) - i1_u = UBOUND(SrcBeddoesData%ANE1,1) - i2_l = LBOUND(SrcBeddoesData%ANE1,2) - i2_u = UBOUND(SrcBeddoesData%ANE1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%ANE1)) THEN - ALLOCATE(DstBeddoesData%ANE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ANE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%ANE1 = SrcBeddoesData%ANE1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%AOD)) THEN - i1_l = LBOUND(SrcBeddoesData%AOD,1) - i1_u = UBOUND(SrcBeddoesData%AOD,1) - i2_l = LBOUND(SrcBeddoesData%AOD,2) - i2_u = UBOUND(SrcBeddoesData%AOD,2) - IF (.NOT. ALLOCATED(DstBeddoesData%AOD)) THEN - ALLOCATE(DstBeddoesData%AOD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AOD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%AOD = SrcBeddoesData%AOD -ENDIF -IF (ALLOCATED(SrcBeddoesData%AOL)) THEN - i1_l = LBOUND(SrcBeddoesData%AOL,1) - i1_u = UBOUND(SrcBeddoesData%AOL,1) - i2_l = LBOUND(SrcBeddoesData%AOL,2) - i2_u = UBOUND(SrcBeddoesData%AOL,2) - IF (.NOT. ALLOCATED(DstBeddoesData%AOL)) THEN - ALLOCATE(DstBeddoesData%AOL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AOL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%AOL = SrcBeddoesData%AOL -ENDIF -IF (ALLOCATED(SrcBeddoesData%BEDSEP)) THEN - i1_l = LBOUND(SrcBeddoesData%BEDSEP,1) - i1_u = UBOUND(SrcBeddoesData%BEDSEP,1) - i2_l = LBOUND(SrcBeddoesData%BEDSEP,2) - i2_u = UBOUND(SrcBeddoesData%BEDSEP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%BEDSEP)) THEN - ALLOCATE(DstBeddoesData%BEDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%BEDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%BEDSEP = SrcBeddoesData%BEDSEP -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDSEP)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDSEP,1) - i1_u = UBOUND(SrcBeddoesData%OLDSEP,1) - i2_l = LBOUND(SrcBeddoesData%OLDSEP,2) - i2_u = UBOUND(SrcBeddoesData%OLDSEP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDSEP)) THEN - ALLOCATE(DstBeddoesData%OLDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDSEP = SrcBeddoesData%OLDSEP -ENDIF - DstBeddoesData%CC = SrcBeddoesData%CC -IF (ALLOCATED(SrcBeddoesData%CDO)) THEN - i1_l = LBOUND(SrcBeddoesData%CDO,1) - i1_u = UBOUND(SrcBeddoesData%CDO,1) - i2_l = LBOUND(SrcBeddoesData%CDO,2) - i2_u = UBOUND(SrcBeddoesData%CDO,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CDO)) THEN - ALLOCATE(DstBeddoesData%CDO(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CDO.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CDO = SrcBeddoesData%CDO -ENDIF - DstBeddoesData%CMI = SrcBeddoesData%CMI - DstBeddoesData%CMQ = SrcBeddoesData%CMQ - DstBeddoesData%CN = SrcBeddoesData%CN -IF (ALLOCATED(SrcBeddoesData%CNA)) THEN - i1_l = LBOUND(SrcBeddoesData%CNA,1) - i1_u = UBOUND(SrcBeddoesData%CNA,1) - i2_l = LBOUND(SrcBeddoesData%CNA,2) - i2_u = UBOUND(SrcBeddoesData%CNA,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNA)) THEN - ALLOCATE(DstBeddoesData%CNA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNA = SrcBeddoesData%CNA -ENDIF - DstBeddoesData%CNCP = SrcBeddoesData%CNCP - DstBeddoesData%CNIQ = SrcBeddoesData%CNIQ -IF (ALLOCATED(SrcBeddoesData%CNP)) THEN - i1_l = LBOUND(SrcBeddoesData%CNP,1) - i1_u = UBOUND(SrcBeddoesData%CNP,1) - i2_l = LBOUND(SrcBeddoesData%CNP,2) - i2_u = UBOUND(SrcBeddoesData%CNP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNP)) THEN - ALLOCATE(DstBeddoesData%CNP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNP = SrcBeddoesData%CNP -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNP1)) THEN - i1_l = LBOUND(SrcBeddoesData%CNP1,1) - i1_u = UBOUND(SrcBeddoesData%CNP1,1) - i2_l = LBOUND(SrcBeddoesData%CNP1,2) - i2_u = UBOUND(SrcBeddoesData%CNP1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNP1)) THEN - ALLOCATE(DstBeddoesData%CNP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNP1 = SrcBeddoesData%CNP1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNPD)) THEN - i1_l = LBOUND(SrcBeddoesData%CNPD,1) - i1_u = UBOUND(SrcBeddoesData%CNPD,1) - i2_l = LBOUND(SrcBeddoesData%CNPD,2) - i2_u = UBOUND(SrcBeddoesData%CNPD,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNPD)) THEN - ALLOCATE(DstBeddoesData%CNPD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNPD = SrcBeddoesData%CNPD -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNPD1)) THEN - i1_l = LBOUND(SrcBeddoesData%CNPD1,1) - i1_u = UBOUND(SrcBeddoesData%CNPD1,1) - i2_l = LBOUND(SrcBeddoesData%CNPD1,2) - i2_u = UBOUND(SrcBeddoesData%CNPD1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNPD1)) THEN - ALLOCATE(DstBeddoesData%CNPD1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPD1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNPD1 = SrcBeddoesData%CNPD1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNPOT)) THEN - i1_l = LBOUND(SrcBeddoesData%CNPOT,1) - i1_u = UBOUND(SrcBeddoesData%CNPOT,1) - i2_l = LBOUND(SrcBeddoesData%CNPOT,2) - i2_u = UBOUND(SrcBeddoesData%CNPOT,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNPOT)) THEN - ALLOCATE(DstBeddoesData%CNPOT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPOT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNPOT = SrcBeddoesData%CNPOT -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNPOT1)) THEN - i1_l = LBOUND(SrcBeddoesData%CNPOT1,1) - i1_u = UBOUND(SrcBeddoesData%CNPOT1,1) - i2_l = LBOUND(SrcBeddoesData%CNPOT1,2) - i2_u = UBOUND(SrcBeddoesData%CNPOT1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNPOT1)) THEN - ALLOCATE(DstBeddoesData%CNPOT1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPOT1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNPOT1 = SrcBeddoesData%CNPOT1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNS)) THEN - i1_l = LBOUND(SrcBeddoesData%CNS,1) - i1_u = UBOUND(SrcBeddoesData%CNS,1) - i2_l = LBOUND(SrcBeddoesData%CNS,2) - i2_u = UBOUND(SrcBeddoesData%CNS,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNS)) THEN - ALLOCATE(DstBeddoesData%CNS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNS = SrcBeddoesData%CNS -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNSL)) THEN - i1_l = LBOUND(SrcBeddoesData%CNSL,1) - i1_u = UBOUND(SrcBeddoesData%CNSL,1) - i2_l = LBOUND(SrcBeddoesData%CNSL,2) - i2_u = UBOUND(SrcBeddoesData%CNSL,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNSL)) THEN - ALLOCATE(DstBeddoesData%CNSL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNSL = SrcBeddoesData%CNSL -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNV)) THEN - i1_l = LBOUND(SrcBeddoesData%CNV,1) - i1_u = UBOUND(SrcBeddoesData%CNV,1) - i2_l = LBOUND(SrcBeddoesData%CNV,2) - i2_u = UBOUND(SrcBeddoesData%CNV,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNV)) THEN - ALLOCATE(DstBeddoesData%CNV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNV = SrcBeddoesData%CNV -ENDIF -IF (ALLOCATED(SrcBeddoesData%CVN)) THEN - i1_l = LBOUND(SrcBeddoesData%CVN,1) - i1_u = UBOUND(SrcBeddoesData%CVN,1) - i2_l = LBOUND(SrcBeddoesData%CVN,2) - i2_u = UBOUND(SrcBeddoesData%CVN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CVN)) THEN - ALLOCATE(DstBeddoesData%CVN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CVN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CVN = SrcBeddoesData%CVN -ENDIF -IF (ALLOCATED(SrcBeddoesData%CVN1)) THEN - i1_l = LBOUND(SrcBeddoesData%CVN1,1) - i1_u = UBOUND(SrcBeddoesData%CVN1,1) - i2_l = LBOUND(SrcBeddoesData%CVN1,2) - i2_u = UBOUND(SrcBeddoesData%CVN1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CVN1)) THEN - ALLOCATE(DstBeddoesData%CVN1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CVN1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CVN1 = SrcBeddoesData%CVN1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%DF)) THEN - i1_l = LBOUND(SrcBeddoesData%DF,1) - i1_u = UBOUND(SrcBeddoesData%DF,1) - i2_l = LBOUND(SrcBeddoesData%DF,2) - i2_u = UBOUND(SrcBeddoesData%DF,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DF)) THEN - ALLOCATE(DstBeddoesData%DF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DF = SrcBeddoesData%DF -ENDIF -IF (ALLOCATED(SrcBeddoesData%DFAFE)) THEN - i1_l = LBOUND(SrcBeddoesData%DFAFE,1) - i1_u = UBOUND(SrcBeddoesData%DFAFE,1) - i2_l = LBOUND(SrcBeddoesData%DFAFE,2) - i2_u = UBOUND(SrcBeddoesData%DFAFE,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DFAFE)) THEN - ALLOCATE(DstBeddoesData%DFAFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DFAFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DFAFE = SrcBeddoesData%DFAFE -ENDIF -IF (ALLOCATED(SrcBeddoesData%DFAFE1)) THEN - i1_l = LBOUND(SrcBeddoesData%DFAFE1,1) - i1_u = UBOUND(SrcBeddoesData%DFAFE1,1) - i2_l = LBOUND(SrcBeddoesData%DFAFE1,2) - i2_u = UBOUND(SrcBeddoesData%DFAFE1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DFAFE1)) THEN - ALLOCATE(DstBeddoesData%DFAFE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DFAFE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DFAFE1 = SrcBeddoesData%DFAFE1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%DFC)) THEN - i1_l = LBOUND(SrcBeddoesData%DFC,1) - i1_u = UBOUND(SrcBeddoesData%DFC,1) - i2_l = LBOUND(SrcBeddoesData%DFC,2) - i2_u = UBOUND(SrcBeddoesData%DFC,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DFC)) THEN - ALLOCATE(DstBeddoesData%DFC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DFC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DFC = SrcBeddoesData%DFC -ENDIF -IF (ALLOCATED(SrcBeddoesData%DN)) THEN - i1_l = LBOUND(SrcBeddoesData%DN,1) - i1_u = UBOUND(SrcBeddoesData%DN,1) - i2_l = LBOUND(SrcBeddoesData%DN,2) - i2_u = UBOUND(SrcBeddoesData%DN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DN)) THEN - ALLOCATE(DstBeddoesData%DN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DN = SrcBeddoesData%DN -ENDIF -IF (ALLOCATED(SrcBeddoesData%DPP)) THEN - i1_l = LBOUND(SrcBeddoesData%DPP,1) - i1_u = UBOUND(SrcBeddoesData%DPP,1) - i2_l = LBOUND(SrcBeddoesData%DPP,2) - i2_u = UBOUND(SrcBeddoesData%DPP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DPP)) THEN - ALLOCATE(DstBeddoesData%DPP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DPP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DPP = SrcBeddoesData%DPP -ENDIF -IF (ALLOCATED(SrcBeddoesData%DQ)) THEN - i1_l = LBOUND(SrcBeddoesData%DQ,1) - i1_u = UBOUND(SrcBeddoesData%DQ,1) - i2_l = LBOUND(SrcBeddoesData%DQ,2) - i2_u = UBOUND(SrcBeddoesData%DQ,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DQ)) THEN - ALLOCATE(DstBeddoesData%DQ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DQ = SrcBeddoesData%DQ -ENDIF -IF (ALLOCATED(SrcBeddoesData%DQP)) THEN - i1_l = LBOUND(SrcBeddoesData%DQP,1) - i1_u = UBOUND(SrcBeddoesData%DQP,1) - i2_l = LBOUND(SrcBeddoesData%DQP,2) - i2_u = UBOUND(SrcBeddoesData%DQP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DQP)) THEN - ALLOCATE(DstBeddoesData%DQP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DQP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DQP = SrcBeddoesData%DQP -ENDIF -IF (ALLOCATED(SrcBeddoesData%DQP1)) THEN - i1_l = LBOUND(SrcBeddoesData%DQP1,1) - i1_u = UBOUND(SrcBeddoesData%DQP1,1) - i2_l = LBOUND(SrcBeddoesData%DQP1,2) - i2_u = UBOUND(SrcBeddoesData%DQP1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DQP1)) THEN - ALLOCATE(DstBeddoesData%DQP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DQP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DQP1 = SrcBeddoesData%DQP1 -ENDIF - DstBeddoesData%DS = SrcBeddoesData%DS - DstBeddoesData%FK = SrcBeddoesData%FK - DstBeddoesData%FP = SrcBeddoesData%FP - DstBeddoesData%FPC = SrcBeddoesData%FPC -IF (ALLOCATED(SrcBeddoesData%FSP)) THEN - i1_l = LBOUND(SrcBeddoesData%FSP,1) - i1_u = UBOUND(SrcBeddoesData%FSP,1) - i2_l = LBOUND(SrcBeddoesData%FSP,2) - i2_u = UBOUND(SrcBeddoesData%FSP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%FSP)) THEN - ALLOCATE(DstBeddoesData%FSP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FSP = SrcBeddoesData%FSP -ENDIF -IF (ALLOCATED(SrcBeddoesData%FSP1)) THEN - i1_l = LBOUND(SrcBeddoesData%FSP1,1) - i1_u = UBOUND(SrcBeddoesData%FSP1,1) - i2_l = LBOUND(SrcBeddoesData%FSP1,2) - i2_u = UBOUND(SrcBeddoesData%FSP1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%FSP1)) THEN - ALLOCATE(DstBeddoesData%FSP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FSP1 = SrcBeddoesData%FSP1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%FSPC)) THEN - i1_l = LBOUND(SrcBeddoesData%FSPC,1) - i1_u = UBOUND(SrcBeddoesData%FSPC,1) - i2_l = LBOUND(SrcBeddoesData%FSPC,2) - i2_u = UBOUND(SrcBeddoesData%FSPC,2) - IF (.NOT. ALLOCATED(DstBeddoesData%FSPC)) THEN - ALLOCATE(DstBeddoesData%FSPC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSPC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FSPC = SrcBeddoesData%FSPC -ENDIF -IF (ALLOCATED(SrcBeddoesData%FSPC1)) THEN - i1_l = LBOUND(SrcBeddoesData%FSPC1,1) - i1_u = UBOUND(SrcBeddoesData%FSPC1,1) - i2_l = LBOUND(SrcBeddoesData%FSPC1,2) - i2_u = UBOUND(SrcBeddoesData%FSPC1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%FSPC1)) THEN - ALLOCATE(DstBeddoesData%FSPC1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSPC1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FSPC1 = SrcBeddoesData%FSPC1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%FTB)) THEN - i1_l = LBOUND(SrcBeddoesData%FTB,1) - i1_u = UBOUND(SrcBeddoesData%FTB,1) - i2_l = LBOUND(SrcBeddoesData%FTB,2) - i2_u = UBOUND(SrcBeddoesData%FTB,2) - i3_l = LBOUND(SrcBeddoesData%FTB,3) - i3_u = UBOUND(SrcBeddoesData%FTB,3) - IF (.NOT. ALLOCATED(DstBeddoesData%FTB)) THEN - ALLOCATE(DstBeddoesData%FTB(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FTB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FTB = SrcBeddoesData%FTB -ENDIF -IF (ALLOCATED(SrcBeddoesData%FTBC)) THEN - i1_l = LBOUND(SrcBeddoesData%FTBC,1) - i1_u = UBOUND(SrcBeddoesData%FTBC,1) - i2_l = LBOUND(SrcBeddoesData%FTBC,2) - i2_u = UBOUND(SrcBeddoesData%FTBC,2) - i3_l = LBOUND(SrcBeddoesData%FTBC,3) - i3_u = UBOUND(SrcBeddoesData%FTBC,3) - IF (.NOT. ALLOCATED(DstBeddoesData%FTBC)) THEN - ALLOCATE(DstBeddoesData%FTBC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FTBC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FTBC = SrcBeddoesData%FTBC -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDCNV)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDCNV,1) - i1_u = UBOUND(SrcBeddoesData%OLDCNV,1) - i2_l = LBOUND(SrcBeddoesData%OLDCNV,2) - i2_u = UBOUND(SrcBeddoesData%OLDCNV,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDCNV)) THEN - ALLOCATE(DstBeddoesData%OLDCNV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDCNV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDCNV = SrcBeddoesData%OLDCNV -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDDF)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDDF,1) - i1_u = UBOUND(SrcBeddoesData%OLDDF,1) - i2_l = LBOUND(SrcBeddoesData%OLDDF,2) - i2_u = UBOUND(SrcBeddoesData%OLDDF,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDDF)) THEN - ALLOCATE(DstBeddoesData%OLDDF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDDF = SrcBeddoesData%OLDDF -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDDFC)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDDFC,1) - i1_u = UBOUND(SrcBeddoesData%OLDDFC,1) - i2_l = LBOUND(SrcBeddoesData%OLDDFC,2) - i2_u = UBOUND(SrcBeddoesData%OLDDFC,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDDFC)) THEN - ALLOCATE(DstBeddoesData%OLDDFC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDFC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDDFC = SrcBeddoesData%OLDDFC -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDDN)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDDN,1) - i1_u = UBOUND(SrcBeddoesData%OLDDN,1) - i2_l = LBOUND(SrcBeddoesData%OLDDN,2) - i2_u = UBOUND(SrcBeddoesData%OLDDN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDDN)) THEN - ALLOCATE(DstBeddoesData%OLDDN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDDN = SrcBeddoesData%OLDDN -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDDPP)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDDPP,1) - i1_u = UBOUND(SrcBeddoesData%OLDDPP,1) - i2_l = LBOUND(SrcBeddoesData%OLDDPP,2) - i2_u = UBOUND(SrcBeddoesData%OLDDPP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDDPP)) THEN - ALLOCATE(DstBeddoesData%OLDDPP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDPP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDDPP = SrcBeddoesData%OLDDPP -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDDQ)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDDQ,1) - i1_u = UBOUND(SrcBeddoesData%OLDDQ,1) - i2_l = LBOUND(SrcBeddoesData%OLDDQ,2) - i2_u = UBOUND(SrcBeddoesData%OLDDQ,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDDQ)) THEN - ALLOCATE(DstBeddoesData%OLDDQ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDDQ = SrcBeddoesData%OLDDQ -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDTAU)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDTAU,1) - i1_u = UBOUND(SrcBeddoesData%OLDTAU,1) - i2_l = LBOUND(SrcBeddoesData%OLDTAU,2) - i2_u = UBOUND(SrcBeddoesData%OLDTAU,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDTAU)) THEN - ALLOCATE(DstBeddoesData%OLDTAU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDTAU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDTAU = SrcBeddoesData%OLDTAU -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDXN)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDXN,1) - i1_u = UBOUND(SrcBeddoesData%OLDXN,1) - i2_l = LBOUND(SrcBeddoesData%OLDXN,2) - i2_u = UBOUND(SrcBeddoesData%OLDXN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDXN)) THEN - ALLOCATE(DstBeddoesData%OLDXN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDXN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDXN = SrcBeddoesData%OLDXN -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDYN)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDYN,1) - i1_u = UBOUND(SrcBeddoesData%OLDYN,1) - i2_l = LBOUND(SrcBeddoesData%OLDYN,2) - i2_u = UBOUND(SrcBeddoesData%OLDYN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDYN)) THEN - ALLOCATE(DstBeddoesData%OLDYN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDYN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDYN = SrcBeddoesData%OLDYN -ENDIF -IF (ALLOCATED(SrcBeddoesData%QX)) THEN - i1_l = LBOUND(SrcBeddoesData%QX,1) - i1_u = UBOUND(SrcBeddoesData%QX,1) - i2_l = LBOUND(SrcBeddoesData%QX,2) - i2_u = UBOUND(SrcBeddoesData%QX,2) - IF (.NOT. ALLOCATED(DstBeddoesData%QX)) THEN - ALLOCATE(DstBeddoesData%QX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%QX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%QX = SrcBeddoesData%QX -ENDIF -IF (ALLOCATED(SrcBeddoesData%QX1)) THEN - i1_l = LBOUND(SrcBeddoesData%QX1,1) - i1_u = UBOUND(SrcBeddoesData%QX1,1) - i2_l = LBOUND(SrcBeddoesData%QX1,2) - i2_u = UBOUND(SrcBeddoesData%QX1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%QX1)) THEN - ALLOCATE(DstBeddoesData%QX1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%QX1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%QX1 = SrcBeddoesData%QX1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%TAU)) THEN - i1_l = LBOUND(SrcBeddoesData%TAU,1) - i1_u = UBOUND(SrcBeddoesData%TAU,1) - i2_l = LBOUND(SrcBeddoesData%TAU,2) - i2_u = UBOUND(SrcBeddoesData%TAU,2) - IF (.NOT. ALLOCATED(DstBeddoesData%TAU)) THEN - ALLOCATE(DstBeddoesData%TAU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%TAU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%TAU = SrcBeddoesData%TAU -ENDIF -IF (ALLOCATED(SrcBeddoesData%XN)) THEN - i1_l = LBOUND(SrcBeddoesData%XN,1) - i1_u = UBOUND(SrcBeddoesData%XN,1) - i2_l = LBOUND(SrcBeddoesData%XN,2) - i2_u = UBOUND(SrcBeddoesData%XN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%XN)) THEN - ALLOCATE(DstBeddoesData%XN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%XN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%XN = SrcBeddoesData%XN -ENDIF -IF (ALLOCATED(SrcBeddoesData%YN)) THEN - i1_l = LBOUND(SrcBeddoesData%YN,1) - i1_u = UBOUND(SrcBeddoesData%YN,1) - i2_l = LBOUND(SrcBeddoesData%YN,2) - i2_u = UBOUND(SrcBeddoesData%YN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%YN)) THEN - ALLOCATE(DstBeddoesData%YN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%YN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%YN = SrcBeddoesData%YN -ENDIF - DstBeddoesData%SHIFT = SrcBeddoesData%SHIFT - DstBeddoesData%VOR = SrcBeddoesData%VOR - END SUBROUTINE AD14_CopyBeddoes - - SUBROUTINE AD14_DestroyBeddoes( BeddoesData, ErrStat, ErrMsg ) - TYPE(Beddoes), INTENT(INOUT) :: BeddoesData - 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 = 'AD14_DestroyBeddoes' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BeddoesData%ADOT)) THEN - DEALLOCATE(BeddoesData%ADOT) -ENDIF -IF (ALLOCATED(BeddoesData%ADOT1)) THEN - DEALLOCATE(BeddoesData%ADOT1) -ENDIF -IF (ALLOCATED(BeddoesData%AFE)) THEN - DEALLOCATE(BeddoesData%AFE) -ENDIF -IF (ALLOCATED(BeddoesData%AFE1)) THEN - DEALLOCATE(BeddoesData%AFE1) -ENDIF -IF (ALLOCATED(BeddoesData%ANE)) THEN - DEALLOCATE(BeddoesData%ANE) -ENDIF -IF (ALLOCATED(BeddoesData%ANE1)) THEN - DEALLOCATE(BeddoesData%ANE1) -ENDIF -IF (ALLOCATED(BeddoesData%AOD)) THEN - DEALLOCATE(BeddoesData%AOD) -ENDIF -IF (ALLOCATED(BeddoesData%AOL)) THEN - DEALLOCATE(BeddoesData%AOL) -ENDIF -IF (ALLOCATED(BeddoesData%BEDSEP)) THEN - DEALLOCATE(BeddoesData%BEDSEP) -ENDIF -IF (ALLOCATED(BeddoesData%OLDSEP)) THEN - DEALLOCATE(BeddoesData%OLDSEP) -ENDIF -IF (ALLOCATED(BeddoesData%CDO)) THEN - DEALLOCATE(BeddoesData%CDO) -ENDIF -IF (ALLOCATED(BeddoesData%CNA)) THEN - DEALLOCATE(BeddoesData%CNA) -ENDIF -IF (ALLOCATED(BeddoesData%CNP)) THEN - DEALLOCATE(BeddoesData%CNP) -ENDIF -IF (ALLOCATED(BeddoesData%CNP1)) THEN - DEALLOCATE(BeddoesData%CNP1) -ENDIF -IF (ALLOCATED(BeddoesData%CNPD)) THEN - DEALLOCATE(BeddoesData%CNPD) -ENDIF -IF (ALLOCATED(BeddoesData%CNPD1)) THEN - DEALLOCATE(BeddoesData%CNPD1) -ENDIF -IF (ALLOCATED(BeddoesData%CNPOT)) THEN - DEALLOCATE(BeddoesData%CNPOT) -ENDIF -IF (ALLOCATED(BeddoesData%CNPOT1)) THEN - DEALLOCATE(BeddoesData%CNPOT1) -ENDIF -IF (ALLOCATED(BeddoesData%CNS)) THEN - DEALLOCATE(BeddoesData%CNS) -ENDIF -IF (ALLOCATED(BeddoesData%CNSL)) THEN - DEALLOCATE(BeddoesData%CNSL) -ENDIF -IF (ALLOCATED(BeddoesData%CNV)) THEN - DEALLOCATE(BeddoesData%CNV) -ENDIF -IF (ALLOCATED(BeddoesData%CVN)) THEN - DEALLOCATE(BeddoesData%CVN) -ENDIF -IF (ALLOCATED(BeddoesData%CVN1)) THEN - DEALLOCATE(BeddoesData%CVN1) -ENDIF -IF (ALLOCATED(BeddoesData%DF)) THEN - DEALLOCATE(BeddoesData%DF) -ENDIF -IF (ALLOCATED(BeddoesData%DFAFE)) THEN - DEALLOCATE(BeddoesData%DFAFE) -ENDIF -IF (ALLOCATED(BeddoesData%DFAFE1)) THEN - DEALLOCATE(BeddoesData%DFAFE1) -ENDIF -IF (ALLOCATED(BeddoesData%DFC)) THEN - DEALLOCATE(BeddoesData%DFC) -ENDIF -IF (ALLOCATED(BeddoesData%DN)) THEN - DEALLOCATE(BeddoesData%DN) -ENDIF -IF (ALLOCATED(BeddoesData%DPP)) THEN - DEALLOCATE(BeddoesData%DPP) -ENDIF -IF (ALLOCATED(BeddoesData%DQ)) THEN - DEALLOCATE(BeddoesData%DQ) -ENDIF -IF (ALLOCATED(BeddoesData%DQP)) THEN - DEALLOCATE(BeddoesData%DQP) -ENDIF -IF (ALLOCATED(BeddoesData%DQP1)) THEN - DEALLOCATE(BeddoesData%DQP1) -ENDIF -IF (ALLOCATED(BeddoesData%FSP)) THEN - DEALLOCATE(BeddoesData%FSP) -ENDIF -IF (ALLOCATED(BeddoesData%FSP1)) THEN - DEALLOCATE(BeddoesData%FSP1) -ENDIF -IF (ALLOCATED(BeddoesData%FSPC)) THEN - DEALLOCATE(BeddoesData%FSPC) -ENDIF -IF (ALLOCATED(BeddoesData%FSPC1)) THEN - DEALLOCATE(BeddoesData%FSPC1) -ENDIF -IF (ALLOCATED(BeddoesData%FTB)) THEN - DEALLOCATE(BeddoesData%FTB) -ENDIF -IF (ALLOCATED(BeddoesData%FTBC)) THEN - DEALLOCATE(BeddoesData%FTBC) -ENDIF -IF (ALLOCATED(BeddoesData%OLDCNV)) THEN - DEALLOCATE(BeddoesData%OLDCNV) -ENDIF -IF (ALLOCATED(BeddoesData%OLDDF)) THEN - DEALLOCATE(BeddoesData%OLDDF) -ENDIF -IF (ALLOCATED(BeddoesData%OLDDFC)) THEN - DEALLOCATE(BeddoesData%OLDDFC) -ENDIF -IF (ALLOCATED(BeddoesData%OLDDN)) THEN - DEALLOCATE(BeddoesData%OLDDN) -ENDIF -IF (ALLOCATED(BeddoesData%OLDDPP)) THEN - DEALLOCATE(BeddoesData%OLDDPP) -ENDIF -IF (ALLOCATED(BeddoesData%OLDDQ)) THEN - DEALLOCATE(BeddoesData%OLDDQ) -ENDIF -IF (ALLOCATED(BeddoesData%OLDTAU)) THEN - DEALLOCATE(BeddoesData%OLDTAU) -ENDIF -IF (ALLOCATED(BeddoesData%OLDXN)) THEN - DEALLOCATE(BeddoesData%OLDXN) -ENDIF -IF (ALLOCATED(BeddoesData%OLDYN)) THEN - DEALLOCATE(BeddoesData%OLDYN) -ENDIF -IF (ALLOCATED(BeddoesData%QX)) THEN - DEALLOCATE(BeddoesData%QX) -ENDIF -IF (ALLOCATED(BeddoesData%QX1)) THEN - DEALLOCATE(BeddoesData%QX1) -ENDIF -IF (ALLOCATED(BeddoesData%TAU)) THEN - DEALLOCATE(BeddoesData%TAU) -ENDIF -IF (ALLOCATED(BeddoesData%XN)) THEN - DEALLOCATE(BeddoesData%XN) -ENDIF -IF (ALLOCATED(BeddoesData%YN)) THEN - DEALLOCATE(BeddoesData%YN) -ENDIF - END SUBROUTINE AD14_DestroyBeddoes - - SUBROUTINE AD14_PackBeddoes( 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(Beddoes), 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 = 'AD14_PackBeddoes' - ! 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 ! ADOT allocated yes/no - IF ( ALLOCATED(InData%ADOT) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ADOT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ADOT) ! ADOT - END IF - Int_BufSz = Int_BufSz + 1 ! ADOT1 allocated yes/no - IF ( ALLOCATED(InData%ADOT1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ADOT1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ADOT1) ! ADOT1 - END IF - Int_BufSz = Int_BufSz + 1 ! AFE allocated yes/no - IF ( ALLOCATED(InData%AFE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFE) ! AFE - END IF - Int_BufSz = Int_BufSz + 1 ! AFE1 allocated yes/no - IF ( ALLOCATED(InData%AFE1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFE1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFE1) ! AFE1 - END IF - Re_BufSz = Re_BufSz + 1 ! AN - Int_BufSz = Int_BufSz + 1 ! ANE allocated yes/no - IF ( ALLOCATED(InData%ANE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ANE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ANE) ! ANE - END IF - Int_BufSz = Int_BufSz + 1 ! ANE1 allocated yes/no - IF ( ALLOCATED(InData%ANE1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ANE1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ANE1) ! ANE1 - END IF - Int_BufSz = Int_BufSz + 1 ! AOD allocated yes/no - IF ( ALLOCATED(InData%AOD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AOD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AOD) ! AOD - END IF - Int_BufSz = Int_BufSz + 1 ! AOL allocated yes/no - IF ( ALLOCATED(InData%AOL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AOL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AOL) ! AOL - END IF - Int_BufSz = Int_BufSz + 1 ! BEDSEP allocated yes/no - IF ( ALLOCATED(InData%BEDSEP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BEDSEP upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BEDSEP) ! BEDSEP - END IF - Int_BufSz = Int_BufSz + 1 ! OLDSEP allocated yes/no - IF ( ALLOCATED(InData%OLDSEP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDSEP upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OLDSEP) ! OLDSEP - END IF - Re_BufSz = Re_BufSz + 1 ! CC - Int_BufSz = Int_BufSz + 1 ! CDO allocated yes/no - IF ( ALLOCATED(InData%CDO) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CDO upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CDO) ! CDO - END IF - Re_BufSz = Re_BufSz + 1 ! CMI - Re_BufSz = Re_BufSz + 1 ! CMQ - Re_BufSz = Re_BufSz + 1 ! CN - Int_BufSz = Int_BufSz + 1 ! CNA allocated yes/no - IF ( ALLOCATED(InData%CNA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNA) ! CNA - END IF - Re_BufSz = Re_BufSz + 1 ! CNCP - Re_BufSz = Re_BufSz + 1 ! CNIQ - Int_BufSz = Int_BufSz + 1 ! CNP allocated yes/no - IF ( ALLOCATED(InData%CNP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNP) ! CNP - END IF - Int_BufSz = Int_BufSz + 1 ! CNP1 allocated yes/no - IF ( ALLOCATED(InData%CNP1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNP1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNP1) ! CNP1 - END IF - Int_BufSz = Int_BufSz + 1 ! CNPD allocated yes/no - IF ( ALLOCATED(InData%CNPD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNPD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNPD) ! CNPD - END IF - Int_BufSz = Int_BufSz + 1 ! CNPD1 allocated yes/no - IF ( ALLOCATED(InData%CNPD1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNPD1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNPD1) ! CNPD1 - END IF - Int_BufSz = Int_BufSz + 1 ! CNPOT allocated yes/no - IF ( ALLOCATED(InData%CNPOT) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNPOT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNPOT) ! CNPOT - END IF - Int_BufSz = Int_BufSz + 1 ! CNPOT1 allocated yes/no - IF ( ALLOCATED(InData%CNPOT1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNPOT1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNPOT1) ! CNPOT1 - END IF - Int_BufSz = Int_BufSz + 1 ! CNS allocated yes/no - IF ( ALLOCATED(InData%CNS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNS) ! CNS - END IF - Int_BufSz = Int_BufSz + 1 ! CNSL allocated yes/no - IF ( ALLOCATED(InData%CNSL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNSL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNSL) ! CNSL - END IF - Int_BufSz = Int_BufSz + 1 ! CNV allocated yes/no - IF ( ALLOCATED(InData%CNV) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNV) ! CNV - END IF - Int_BufSz = Int_BufSz + 1 ! CVN allocated yes/no - IF ( ALLOCATED(InData%CVN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CVN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CVN) ! CVN - END IF - Int_BufSz = Int_BufSz + 1 ! CVN1 allocated yes/no - IF ( ALLOCATED(InData%CVN1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CVN1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CVN1) ! CVN1 - END IF - Int_BufSz = Int_BufSz + 1 ! DF allocated yes/no - IF ( ALLOCATED(InData%DF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DF) ! DF - END IF - Int_BufSz = Int_BufSz + 1 ! DFAFE allocated yes/no - IF ( ALLOCATED(InData%DFAFE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DFAFE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DFAFE) ! DFAFE - END IF - Int_BufSz = Int_BufSz + 1 ! DFAFE1 allocated yes/no - IF ( ALLOCATED(InData%DFAFE1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DFAFE1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DFAFE1) ! DFAFE1 - END IF - Int_BufSz = Int_BufSz + 1 ! DFC allocated yes/no - IF ( ALLOCATED(InData%DFC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DFC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DFC) ! DFC - END IF - Int_BufSz = Int_BufSz + 1 ! DN allocated yes/no - IF ( ALLOCATED(InData%DN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DN) ! DN - END IF - Int_BufSz = Int_BufSz + 1 ! DPP allocated yes/no - IF ( ALLOCATED(InData%DPP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DPP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DPP) ! DPP - END IF - Int_BufSz = Int_BufSz + 1 ! DQ allocated yes/no - IF ( ALLOCATED(InData%DQ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DQ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DQ) ! DQ - END IF - Int_BufSz = Int_BufSz + 1 ! DQP allocated yes/no - IF ( ALLOCATED(InData%DQP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DQP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DQP) ! DQP - END IF - Int_BufSz = Int_BufSz + 1 ! DQP1 allocated yes/no - IF ( ALLOCATED(InData%DQP1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DQP1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DQP1) ! DQP1 - END IF - Re_BufSz = Re_BufSz + 1 ! DS - Re_BufSz = Re_BufSz + 1 ! FK - Re_BufSz = Re_BufSz + 1 ! FP - Re_BufSz = Re_BufSz + 1 ! FPC - Int_BufSz = Int_BufSz + 1 ! FSP allocated yes/no - IF ( ALLOCATED(InData%FSP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FSP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSP) ! FSP - END IF - Int_BufSz = Int_BufSz + 1 ! FSP1 allocated yes/no - IF ( ALLOCATED(InData%FSP1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FSP1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSP1) ! FSP1 - END IF - Int_BufSz = Int_BufSz + 1 ! FSPC allocated yes/no - IF ( ALLOCATED(InData%FSPC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FSPC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSPC) ! FSPC - END IF - Int_BufSz = Int_BufSz + 1 ! FSPC1 allocated yes/no - IF ( ALLOCATED(InData%FSPC1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FSPC1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSPC1) ! FSPC1 - END IF - Int_BufSz = Int_BufSz + 1 ! FTB allocated yes/no - IF ( ALLOCATED(InData%FTB) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! FTB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FTB) ! FTB - END IF - Int_BufSz = Int_BufSz + 1 ! FTBC allocated yes/no - IF ( ALLOCATED(InData%FTBC) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! FTBC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FTBC) ! FTBC - END IF - Int_BufSz = Int_BufSz + 1 ! OLDCNV allocated yes/no - IF ( ALLOCATED(InData%OLDCNV) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDCNV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDCNV) ! OLDCNV - END IF - Int_BufSz = Int_BufSz + 1 ! OLDDF allocated yes/no - IF ( ALLOCATED(InData%OLDDF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDDF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDDF) ! OLDDF - END IF - Int_BufSz = Int_BufSz + 1 ! OLDDFC allocated yes/no - IF ( ALLOCATED(InData%OLDDFC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDDFC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDDFC) ! OLDDFC - END IF - Int_BufSz = Int_BufSz + 1 ! OLDDN allocated yes/no - IF ( ALLOCATED(InData%OLDDN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDDN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDDN) ! OLDDN - END IF - Int_BufSz = Int_BufSz + 1 ! OLDDPP allocated yes/no - IF ( ALLOCATED(InData%OLDDPP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDDPP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDDPP) ! OLDDPP - END IF - Int_BufSz = Int_BufSz + 1 ! OLDDQ allocated yes/no - IF ( ALLOCATED(InData%OLDDQ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDDQ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDDQ) ! OLDDQ - END IF - Int_BufSz = Int_BufSz + 1 ! OLDTAU allocated yes/no - IF ( ALLOCATED(InData%OLDTAU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDTAU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDTAU) ! OLDTAU - END IF - Int_BufSz = Int_BufSz + 1 ! OLDXN allocated yes/no - IF ( ALLOCATED(InData%OLDXN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDXN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDXN) ! OLDXN - END IF - Int_BufSz = Int_BufSz + 1 ! OLDYN allocated yes/no - IF ( ALLOCATED(InData%OLDYN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDYN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDYN) ! OLDYN - END IF - Int_BufSz = Int_BufSz + 1 ! QX allocated yes/no - IF ( ALLOCATED(InData%QX) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! QX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%QX) ! QX - END IF - Int_BufSz = Int_BufSz + 1 ! QX1 allocated yes/no - IF ( ALLOCATED(InData%QX1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! QX1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%QX1) ! QX1 - END IF - Int_BufSz = Int_BufSz + 1 ! TAU allocated yes/no - IF ( ALLOCATED(InData%TAU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TAU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TAU) ! TAU - END IF - Int_BufSz = Int_BufSz + 1 ! XN allocated yes/no - IF ( ALLOCATED(InData%XN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! XN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%XN) ! XN - END IF - Int_BufSz = Int_BufSz + 1 ! YN allocated yes/no - IF ( ALLOCATED(InData%YN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! YN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%YN) ! YN - END IF - Int_BufSz = Int_BufSz + 1 ! SHIFT - Int_BufSz = Int_BufSz + 1 ! VOR - 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%ADOT) ) 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%ADOT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ADOT,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ADOT,2), UBOUND(InData%ADOT,2) - DO i1 = LBOUND(InData%ADOT,1), UBOUND(InData%ADOT,1) - ReKiBuf(Re_Xferred) = InData%ADOT(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ADOT1) ) 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%ADOT1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ADOT1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ADOT1,2), UBOUND(InData%ADOT1,2) - DO i1 = LBOUND(InData%ADOT1,1), UBOUND(InData%ADOT1,1) - ReKiBuf(Re_Xferred) = InData%ADOT1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFE) ) 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%AFE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFE,2), UBOUND(InData%AFE,2) - DO i1 = LBOUND(InData%AFE,1), UBOUND(InData%AFE,1) - ReKiBuf(Re_Xferred) = InData%AFE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFE1) ) 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%AFE1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFE1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFE1,2), UBOUND(InData%AFE1,2) - DO i1 = LBOUND(InData%AFE1,1), UBOUND(InData%AFE1,1) - ReKiBuf(Re_Xferred) = InData%AFE1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%AN - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ANE) ) 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%ANE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ANE,2), UBOUND(InData%ANE,2) - DO i1 = LBOUND(InData%ANE,1), UBOUND(InData%ANE,1) - ReKiBuf(Re_Xferred) = InData%ANE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ANE1) ) 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%ANE1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANE1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ANE1,2), UBOUND(InData%ANE1,2) - DO i1 = LBOUND(InData%ANE1,1), UBOUND(InData%ANE1,1) - ReKiBuf(Re_Xferred) = InData%ANE1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AOD) ) 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%AOD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AOD,2), UBOUND(InData%AOD,2) - DO i1 = LBOUND(InData%AOD,1), UBOUND(InData%AOD,1) - ReKiBuf(Re_Xferred) = InData%AOD(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AOL) ) 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%AOL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AOL,2), UBOUND(InData%AOL,2) - DO i1 = LBOUND(InData%AOL,1), UBOUND(InData%AOL,1) - ReKiBuf(Re_Xferred) = InData%AOL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BEDSEP) ) 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%BEDSEP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BEDSEP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BEDSEP,2), UBOUND(InData%BEDSEP,2) - DO i1 = LBOUND(InData%BEDSEP,1), UBOUND(InData%BEDSEP,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%BEDSEP(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDSEP) ) 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%OLDSEP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDSEP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDSEP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDSEP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDSEP,2), UBOUND(InData%OLDSEP,2) - DO i1 = LBOUND(InData%OLDSEP,1), UBOUND(InData%OLDSEP,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%OLDSEP(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%CC - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CDO) ) 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%CDO,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CDO,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CDO,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CDO,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CDO,2), UBOUND(InData%CDO,2) - DO i1 = LBOUND(InData%CDO,1), UBOUND(InData%CDO,1) - ReKiBuf(Re_Xferred) = InData%CDO(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%CMI - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CMQ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CN - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CNA) ) 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%CNA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNA,2), UBOUND(InData%CNA,2) - DO i1 = LBOUND(InData%CNA,1), UBOUND(InData%CNA,1) - ReKiBuf(Re_Xferred) = InData%CNA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%CNCP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CNIQ - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CNP) ) 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%CNP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNP,2), UBOUND(InData%CNP,2) - DO i1 = LBOUND(InData%CNP,1), UBOUND(InData%CNP,1) - ReKiBuf(Re_Xferred) = InData%CNP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNP1) ) 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%CNP1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNP1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNP1,2), UBOUND(InData%CNP1,2) - DO i1 = LBOUND(InData%CNP1,1), UBOUND(InData%CNP1,1) - ReKiBuf(Re_Xferred) = InData%CNP1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNPD) ) 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%CNPD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNPD,2), UBOUND(InData%CNPD,2) - DO i1 = LBOUND(InData%CNPD,1), UBOUND(InData%CNPD,1) - ReKiBuf(Re_Xferred) = InData%CNPD(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNPD1) ) 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%CNPD1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPD1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNPD1,2), UBOUND(InData%CNPD1,2) - DO i1 = LBOUND(InData%CNPD1,1), UBOUND(InData%CNPD1,1) - ReKiBuf(Re_Xferred) = InData%CNPD1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNPOT) ) 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%CNPOT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPOT,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNPOT,2), UBOUND(InData%CNPOT,2) - DO i1 = LBOUND(InData%CNPOT,1), UBOUND(InData%CNPOT,1) - ReKiBuf(Re_Xferred) = InData%CNPOT(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNPOT1) ) 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%CNPOT1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPOT1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNPOT1,2), UBOUND(InData%CNPOT1,2) - DO i1 = LBOUND(InData%CNPOT1,1), UBOUND(InData%CNPOT1,1) - ReKiBuf(Re_Xferred) = InData%CNPOT1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNS) ) 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%CNS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNS,2), UBOUND(InData%CNS,2) - DO i1 = LBOUND(InData%CNS,1), UBOUND(InData%CNS,1) - ReKiBuf(Re_Xferred) = InData%CNS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNSL) ) 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%CNSL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNSL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNSL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNSL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNSL,2), UBOUND(InData%CNSL,2) - DO i1 = LBOUND(InData%CNSL,1), UBOUND(InData%CNSL,1) - ReKiBuf(Re_Xferred) = InData%CNSL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNV) ) 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%CNV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNV,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNV,2), UBOUND(InData%CNV,2) - DO i1 = LBOUND(InData%CNV,1), UBOUND(InData%CNV,1) - ReKiBuf(Re_Xferred) = InData%CNV(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CVN) ) 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%CVN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CVN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CVN,2), UBOUND(InData%CVN,2) - DO i1 = LBOUND(InData%CVN,1), UBOUND(InData%CVN,1) - ReKiBuf(Re_Xferred) = InData%CVN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CVN1) ) 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%CVN1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CVN1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CVN1,2), UBOUND(InData%CVN1,2) - DO i1 = LBOUND(InData%CVN1,1), UBOUND(InData%CVN1,1) - ReKiBuf(Re_Xferred) = InData%CVN1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DF) ) 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%DF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DF,2), UBOUND(InData%DF,2) - DO i1 = LBOUND(InData%DF,1), UBOUND(InData%DF,1) - ReKiBuf(Re_Xferred) = InData%DF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DFAFE) ) 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%DFAFE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFAFE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DFAFE,2), UBOUND(InData%DFAFE,2) - DO i1 = LBOUND(InData%DFAFE,1), UBOUND(InData%DFAFE,1) - ReKiBuf(Re_Xferred) = InData%DFAFE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DFAFE1) ) 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%DFAFE1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFAFE1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DFAFE1,2), UBOUND(InData%DFAFE1,2) - DO i1 = LBOUND(InData%DFAFE1,1), UBOUND(InData%DFAFE1,1) - ReKiBuf(Re_Xferred) = InData%DFAFE1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DFC) ) 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%DFC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DFC,2), UBOUND(InData%DFC,2) - DO i1 = LBOUND(InData%DFC,1), UBOUND(InData%DFC,1) - ReKiBuf(Re_Xferred) = InData%DFC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DN) ) 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%DN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DN,2), UBOUND(InData%DN,2) - DO i1 = LBOUND(InData%DN,1), UBOUND(InData%DN,1) - ReKiBuf(Re_Xferred) = InData%DN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DPP) ) 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%DPP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DPP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DPP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DPP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DPP,2), UBOUND(InData%DPP,2) - DO i1 = LBOUND(InData%DPP,1), UBOUND(InData%DPP,1) - ReKiBuf(Re_Xferred) = InData%DPP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DQ) ) 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%DQ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DQ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DQ,2), UBOUND(InData%DQ,2) - DO i1 = LBOUND(InData%DQ,1), UBOUND(InData%DQ,1) - ReKiBuf(Re_Xferred) = InData%DQ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DQP) ) 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%DQP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DQP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DQP,2), UBOUND(InData%DQP,2) - DO i1 = LBOUND(InData%DQP,1), UBOUND(InData%DQP,1) - ReKiBuf(Re_Xferred) = InData%DQP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DQP1) ) 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%DQP1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DQP1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DQP1,2), UBOUND(InData%DQP1,2) - DO i1 = LBOUND(InData%DQP1,1), UBOUND(InData%DQP1,1) - ReKiBuf(Re_Xferred) = InData%DQP1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%DS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FK - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FPC - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FSP) ) 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%FSP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FSP,2), UBOUND(InData%FSP,2) - DO i1 = LBOUND(InData%FSP,1), UBOUND(InData%FSP,1) - ReKiBuf(Re_Xferred) = InData%FSP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FSP1) ) 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%FSP1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSP1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FSP1,2), UBOUND(InData%FSP1,2) - DO i1 = LBOUND(InData%FSP1,1), UBOUND(InData%FSP1,1) - ReKiBuf(Re_Xferred) = InData%FSP1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FSPC) ) 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%FSPC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSPC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FSPC,2), UBOUND(InData%FSPC,2) - DO i1 = LBOUND(InData%FSPC,1), UBOUND(InData%FSPC,1) - ReKiBuf(Re_Xferred) = InData%FSPC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FSPC1) ) 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%FSPC1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSPC1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FSPC1,2), UBOUND(InData%FSPC1,2) - DO i1 = LBOUND(InData%FSPC1,1), UBOUND(InData%FSPC1,1) - ReKiBuf(Re_Xferred) = InData%FSPC1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FTB) ) 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%FTB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTB,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTB,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTB,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%FTB,3), UBOUND(InData%FTB,3) - DO i2 = LBOUND(InData%FTB,2), UBOUND(InData%FTB,2) - DO i1 = LBOUND(InData%FTB,1), UBOUND(InData%FTB,1) - ReKiBuf(Re_Xferred) = InData%FTB(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FTBC) ) 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%FTBC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTBC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTBC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTBC,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTBC,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTBC,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%FTBC,3), UBOUND(InData%FTBC,3) - DO i2 = LBOUND(InData%FTBC,2), UBOUND(InData%FTBC,2) - DO i1 = LBOUND(InData%FTBC,1), UBOUND(InData%FTBC,1) - ReKiBuf(Re_Xferred) = InData%FTBC(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDCNV) ) 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%OLDCNV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDCNV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDCNV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDCNV,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDCNV,2), UBOUND(InData%OLDCNV,2) - DO i1 = LBOUND(InData%OLDCNV,1), UBOUND(InData%OLDCNV,1) - ReKiBuf(Re_Xferred) = InData%OLDCNV(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDDF) ) 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%OLDDF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDDF,2), UBOUND(InData%OLDDF,2) - DO i1 = LBOUND(InData%OLDDF,1), UBOUND(InData%OLDDF,1) - ReKiBuf(Re_Xferred) = InData%OLDDF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDDFC) ) 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%OLDDFC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDFC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDFC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDFC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDDFC,2), UBOUND(InData%OLDDFC,2) - DO i1 = LBOUND(InData%OLDDFC,1), UBOUND(InData%OLDDFC,1) - ReKiBuf(Re_Xferred) = InData%OLDDFC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDDN) ) 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%OLDDN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDDN,2), UBOUND(InData%OLDDN,2) - DO i1 = LBOUND(InData%OLDDN,1), UBOUND(InData%OLDDN,1) - ReKiBuf(Re_Xferred) = InData%OLDDN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDDPP) ) 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%OLDDPP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDPP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDPP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDPP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDDPP,2), UBOUND(InData%OLDDPP,2) - DO i1 = LBOUND(InData%OLDDPP,1), UBOUND(InData%OLDDPP,1) - ReKiBuf(Re_Xferred) = InData%OLDDPP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDDQ) ) 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%OLDDQ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDQ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDQ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDQ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDDQ,2), UBOUND(InData%OLDDQ,2) - DO i1 = LBOUND(InData%OLDDQ,1), UBOUND(InData%OLDDQ,1) - ReKiBuf(Re_Xferred) = InData%OLDDQ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDTAU) ) 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%OLDTAU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDTAU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDTAU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDTAU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDTAU,2), UBOUND(InData%OLDTAU,2) - DO i1 = LBOUND(InData%OLDTAU,1), UBOUND(InData%OLDTAU,1) - ReKiBuf(Re_Xferred) = InData%OLDTAU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDXN) ) 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%OLDXN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDXN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDXN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDXN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDXN,2), UBOUND(InData%OLDXN,2) - DO i1 = LBOUND(InData%OLDXN,1), UBOUND(InData%OLDXN,1) - ReKiBuf(Re_Xferred) = InData%OLDXN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDYN) ) 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%OLDYN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDYN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDYN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDYN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDYN,2), UBOUND(InData%OLDYN,2) - DO i1 = LBOUND(InData%OLDYN,1), UBOUND(InData%OLDYN,1) - ReKiBuf(Re_Xferred) = InData%OLDYN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QX) ) 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%QX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%QX,2), UBOUND(InData%QX,2) - DO i1 = LBOUND(InData%QX,1), UBOUND(InData%QX,1) - ReKiBuf(Re_Xferred) = InData%QX(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QX1) ) 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%QX1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QX1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%QX1,2), UBOUND(InData%QX1,2) - DO i1 = LBOUND(InData%QX1,1), UBOUND(InData%QX1,1) - ReKiBuf(Re_Xferred) = InData%QX1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TAU) ) 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%TAU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TAU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TAU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TAU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TAU,2), UBOUND(InData%TAU,2) - DO i1 = LBOUND(InData%TAU,1), UBOUND(InData%TAU,1) - ReKiBuf(Re_Xferred) = InData%TAU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%XN) ) 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%XN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%XN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%XN,2), UBOUND(InData%XN,2) - DO i1 = LBOUND(InData%XN,1), UBOUND(InData%XN,1) - ReKiBuf(Re_Xferred) = InData%XN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%YN) ) 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%YN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%YN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%YN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%YN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%YN,2), UBOUND(InData%YN,2) - DO i1 = LBOUND(InData%YN,1), UBOUND(InData%YN,1) - ReKiBuf(Re_Xferred) = InData%YN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%SHIFT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%VOR, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_PackBeddoes - - SUBROUTINE AD14_UnPackBeddoes( 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(Beddoes), 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 = 'AD14_UnPackBeddoes' - ! 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 ! ADOT 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%ADOT)) DEALLOCATE(OutData%ADOT) - ALLOCATE(OutData%ADOT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ADOT,2), UBOUND(OutData%ADOT,2) - DO i1 = LBOUND(OutData%ADOT,1), UBOUND(OutData%ADOT,1) - OutData%ADOT(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ADOT1 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%ADOT1)) DEALLOCATE(OutData%ADOT1) - ALLOCATE(OutData%ADOT1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ADOT1,2), UBOUND(OutData%ADOT1,2) - DO i1 = LBOUND(OutData%ADOT1,1), UBOUND(OutData%ADOT1,1) - OutData%ADOT1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFE 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%AFE)) DEALLOCATE(OutData%AFE) - ALLOCATE(OutData%AFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFE,2), UBOUND(OutData%AFE,2) - DO i1 = LBOUND(OutData%AFE,1), UBOUND(OutData%AFE,1) - OutData%AFE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFE1 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%AFE1)) DEALLOCATE(OutData%AFE1) - ALLOCATE(OutData%AFE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFE1,2), UBOUND(OutData%AFE1,2) - DO i1 = LBOUND(OutData%AFE1,1), UBOUND(OutData%AFE1,1) - OutData%AFE1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%AN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANE 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%ANE)) DEALLOCATE(OutData%ANE) - ALLOCATE(OutData%ANE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ANE,2), UBOUND(OutData%ANE,2) - DO i1 = LBOUND(OutData%ANE,1), UBOUND(OutData%ANE,1) - OutData%ANE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANE1 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%ANE1)) DEALLOCATE(OutData%ANE1) - ALLOCATE(OutData%ANE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ANE1,2), UBOUND(OutData%ANE1,2) - DO i1 = LBOUND(OutData%ANE1,1), UBOUND(OutData%ANE1,1) - OutData%ANE1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOD 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%AOD)) DEALLOCATE(OutData%AOD) - ALLOCATE(OutData%AOD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AOD,2), UBOUND(OutData%AOD,2) - DO i1 = LBOUND(OutData%AOD,1), UBOUND(OutData%AOD,1) - OutData%AOD(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOL 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%AOL)) DEALLOCATE(OutData%AOL) - ALLOCATE(OutData%AOL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AOL,2), UBOUND(OutData%AOL,2) - DO i1 = LBOUND(OutData%AOL,1), UBOUND(OutData%AOL,1) - OutData%AOL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BEDSEP 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%BEDSEP)) DEALLOCATE(OutData%BEDSEP) - ALLOCATE(OutData%BEDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BEDSEP,2), UBOUND(OutData%BEDSEP,2) - DO i1 = LBOUND(OutData%BEDSEP,1), UBOUND(OutData%BEDSEP,1) - OutData%BEDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BEDSEP(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDSEP 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%OLDSEP)) DEALLOCATE(OutData%OLDSEP) - ALLOCATE(OutData%OLDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDSEP,2), UBOUND(OutData%OLDSEP,2) - DO i1 = LBOUND(OutData%OLDSEP,1), UBOUND(OutData%OLDSEP,1) - OutData%OLDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%OLDSEP(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%CC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CDO 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%CDO)) DEALLOCATE(OutData%CDO) - ALLOCATE(OutData%CDO(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDO.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CDO,2), UBOUND(OutData%CDO,2) - DO i1 = LBOUND(OutData%CDO,1), UBOUND(OutData%CDO,1) - OutData%CDO(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%CMI = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CMQ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNA 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%CNA)) DEALLOCATE(OutData%CNA) - ALLOCATE(OutData%CNA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNA,2), UBOUND(OutData%CNA,2) - DO i1 = LBOUND(OutData%CNA,1), UBOUND(OutData%CNA,1) - OutData%CNA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%CNCP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CNIQ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNP 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%CNP)) DEALLOCATE(OutData%CNP) - ALLOCATE(OutData%CNP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNP,2), UBOUND(OutData%CNP,2) - DO i1 = LBOUND(OutData%CNP,1), UBOUND(OutData%CNP,1) - OutData%CNP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNP1 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%CNP1)) DEALLOCATE(OutData%CNP1) - ALLOCATE(OutData%CNP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNP1,2), UBOUND(OutData%CNP1,2) - DO i1 = LBOUND(OutData%CNP1,1), UBOUND(OutData%CNP1,1) - OutData%CNP1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPD 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%CNPD)) DEALLOCATE(OutData%CNPD) - ALLOCATE(OutData%CNPD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNPD,2), UBOUND(OutData%CNPD,2) - DO i1 = LBOUND(OutData%CNPD,1), UBOUND(OutData%CNPD,1) - OutData%CNPD(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPD1 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%CNPD1)) DEALLOCATE(OutData%CNPD1) - ALLOCATE(OutData%CNPD1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNPD1,2), UBOUND(OutData%CNPD1,2) - DO i1 = LBOUND(OutData%CNPD1,1), UBOUND(OutData%CNPD1,1) - OutData%CNPD1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPOT 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%CNPOT)) DEALLOCATE(OutData%CNPOT) - ALLOCATE(OutData%CNPOT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNPOT,2), UBOUND(OutData%CNPOT,2) - DO i1 = LBOUND(OutData%CNPOT,1), UBOUND(OutData%CNPOT,1) - OutData%CNPOT(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPOT1 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%CNPOT1)) DEALLOCATE(OutData%CNPOT1) - ALLOCATE(OutData%CNPOT1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNPOT1,2), UBOUND(OutData%CNPOT1,2) - DO i1 = LBOUND(OutData%CNPOT1,1), UBOUND(OutData%CNPOT1,1) - OutData%CNPOT1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNS 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%CNS)) DEALLOCATE(OutData%CNS) - ALLOCATE(OutData%CNS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNS,2), UBOUND(OutData%CNS,2) - DO i1 = LBOUND(OutData%CNS,1), UBOUND(OutData%CNS,1) - OutData%CNS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNSL 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%CNSL)) DEALLOCATE(OutData%CNSL) - ALLOCATE(OutData%CNSL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNSL,2), UBOUND(OutData%CNSL,2) - DO i1 = LBOUND(OutData%CNSL,1), UBOUND(OutData%CNSL,1) - OutData%CNSL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNV 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%CNV)) DEALLOCATE(OutData%CNV) - ALLOCATE(OutData%CNV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNV,2), UBOUND(OutData%CNV,2) - DO i1 = LBOUND(OutData%CNV,1), UBOUND(OutData%CNV,1) - OutData%CNV(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CVN 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%CVN)) DEALLOCATE(OutData%CVN) - ALLOCATE(OutData%CVN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CVN,2), UBOUND(OutData%CVN,2) - DO i1 = LBOUND(OutData%CVN,1), UBOUND(OutData%CVN,1) - OutData%CVN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CVN1 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%CVN1)) DEALLOCATE(OutData%CVN1) - ALLOCATE(OutData%CVN1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CVN1,2), UBOUND(OutData%CVN1,2) - DO i1 = LBOUND(OutData%CVN1,1), UBOUND(OutData%CVN1,1) - OutData%CVN1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DF 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%DF)) DEALLOCATE(OutData%DF) - ALLOCATE(OutData%DF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DF,2), UBOUND(OutData%DF,2) - DO i1 = LBOUND(OutData%DF,1), UBOUND(OutData%DF,1) - OutData%DF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFAFE 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%DFAFE)) DEALLOCATE(OutData%DFAFE) - ALLOCATE(OutData%DFAFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DFAFE,2), UBOUND(OutData%DFAFE,2) - DO i1 = LBOUND(OutData%DFAFE,1), UBOUND(OutData%DFAFE,1) - OutData%DFAFE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFAFE1 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%DFAFE1)) DEALLOCATE(OutData%DFAFE1) - ALLOCATE(OutData%DFAFE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DFAFE1,2), UBOUND(OutData%DFAFE1,2) - DO i1 = LBOUND(OutData%DFAFE1,1), UBOUND(OutData%DFAFE1,1) - OutData%DFAFE1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFC 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%DFC)) DEALLOCATE(OutData%DFC) - ALLOCATE(OutData%DFC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DFC,2), UBOUND(OutData%DFC,2) - DO i1 = LBOUND(OutData%DFC,1), UBOUND(OutData%DFC,1) - OutData%DFC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DN 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%DN)) DEALLOCATE(OutData%DN) - ALLOCATE(OutData%DN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DN,2), UBOUND(OutData%DN,2) - DO i1 = LBOUND(OutData%DN,1), UBOUND(OutData%DN,1) - OutData%DN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DPP 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%DPP)) DEALLOCATE(OutData%DPP) - ALLOCATE(OutData%DPP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DPP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DPP,2), UBOUND(OutData%DPP,2) - DO i1 = LBOUND(OutData%DPP,1), UBOUND(OutData%DPP,1) - OutData%DPP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQ 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%DQ)) DEALLOCATE(OutData%DQ) - ALLOCATE(OutData%DQ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DQ,2), UBOUND(OutData%DQ,2) - DO i1 = LBOUND(OutData%DQ,1), UBOUND(OutData%DQ,1) - OutData%DQ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQP 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%DQP)) DEALLOCATE(OutData%DQP) - ALLOCATE(OutData%DQP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DQP,2), UBOUND(OutData%DQP,2) - DO i1 = LBOUND(OutData%DQP,1), UBOUND(OutData%DQP,1) - OutData%DQP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQP1 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%DQP1)) DEALLOCATE(OutData%DQP1) - ALLOCATE(OutData%DQP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DQP1,2), UBOUND(OutData%DQP1,2) - DO i1 = LBOUND(OutData%DQP1,1), UBOUND(OutData%DQP1,1) - OutData%DQP1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%DS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FK = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FPC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSP 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%FSP)) DEALLOCATE(OutData%FSP) - ALLOCATE(OutData%FSP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FSP,2), UBOUND(OutData%FSP,2) - DO i1 = LBOUND(OutData%FSP,1), UBOUND(OutData%FSP,1) - OutData%FSP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSP1 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%FSP1)) DEALLOCATE(OutData%FSP1) - ALLOCATE(OutData%FSP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FSP1,2), UBOUND(OutData%FSP1,2) - DO i1 = LBOUND(OutData%FSP1,1), UBOUND(OutData%FSP1,1) - OutData%FSP1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSPC 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%FSPC)) DEALLOCATE(OutData%FSPC) - ALLOCATE(OutData%FSPC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FSPC,2), UBOUND(OutData%FSPC,2) - DO i1 = LBOUND(OutData%FSPC,1), UBOUND(OutData%FSPC,1) - OutData%FSPC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSPC1 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%FSPC1)) DEALLOCATE(OutData%FSPC1) - ALLOCATE(OutData%FSPC1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FSPC1,2), UBOUND(OutData%FSPC1,2) - DO i1 = LBOUND(OutData%FSPC1,1), UBOUND(OutData%FSPC1,1) - OutData%FSPC1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTB 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%FTB)) DEALLOCATE(OutData%FTB) - ALLOCATE(OutData%FTB(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%FTB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%FTB,3), UBOUND(OutData%FTB,3) - DO i2 = LBOUND(OutData%FTB,2), UBOUND(OutData%FTB,2) - DO i1 = LBOUND(OutData%FTB,1), UBOUND(OutData%FTB,1) - OutData%FTB(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTBC 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%FTBC)) DEALLOCATE(OutData%FTBC) - ALLOCATE(OutData%FTBC(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%FTBC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%FTBC,3), UBOUND(OutData%FTBC,3) - DO i2 = LBOUND(OutData%FTBC,2), UBOUND(OutData%FTBC,2) - DO i1 = LBOUND(OutData%FTBC,1), UBOUND(OutData%FTBC,1) - OutData%FTBC(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDCNV 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%OLDCNV)) DEALLOCATE(OutData%OLDCNV) - ALLOCATE(OutData%OLDCNV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDCNV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDCNV,2), UBOUND(OutData%OLDCNV,2) - DO i1 = LBOUND(OutData%OLDCNV,1), UBOUND(OutData%OLDCNV,1) - OutData%OLDCNV(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDF 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%OLDDF)) DEALLOCATE(OutData%OLDDF) - ALLOCATE(OutData%OLDDF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDDF,2), UBOUND(OutData%OLDDF,2) - DO i1 = LBOUND(OutData%OLDDF,1), UBOUND(OutData%OLDDF,1) - OutData%OLDDF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDFC 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%OLDDFC)) DEALLOCATE(OutData%OLDDFC) - ALLOCATE(OutData%OLDDFC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDFC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDDFC,2), UBOUND(OutData%OLDDFC,2) - DO i1 = LBOUND(OutData%OLDDFC,1), UBOUND(OutData%OLDDFC,1) - OutData%OLDDFC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDN 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%OLDDN)) DEALLOCATE(OutData%OLDDN) - ALLOCATE(OutData%OLDDN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDDN,2), UBOUND(OutData%OLDDN,2) - DO i1 = LBOUND(OutData%OLDDN,1), UBOUND(OutData%OLDDN,1) - OutData%OLDDN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDPP 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%OLDDPP)) DEALLOCATE(OutData%OLDDPP) - ALLOCATE(OutData%OLDDPP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDPP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDDPP,2), UBOUND(OutData%OLDDPP,2) - DO i1 = LBOUND(OutData%OLDDPP,1), UBOUND(OutData%OLDDPP,1) - OutData%OLDDPP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDQ 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%OLDDQ)) DEALLOCATE(OutData%OLDDQ) - ALLOCATE(OutData%OLDDQ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDDQ,2), UBOUND(OutData%OLDDQ,2) - DO i1 = LBOUND(OutData%OLDDQ,1), UBOUND(OutData%OLDDQ,1) - OutData%OLDDQ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDTAU 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%OLDTAU)) DEALLOCATE(OutData%OLDTAU) - ALLOCATE(OutData%OLDTAU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDTAU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDTAU,2), UBOUND(OutData%OLDTAU,2) - DO i1 = LBOUND(OutData%OLDTAU,1), UBOUND(OutData%OLDTAU,1) - OutData%OLDTAU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDXN 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%OLDXN)) DEALLOCATE(OutData%OLDXN) - ALLOCATE(OutData%OLDXN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDXN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDXN,2), UBOUND(OutData%OLDXN,2) - DO i1 = LBOUND(OutData%OLDXN,1), UBOUND(OutData%OLDXN,1) - OutData%OLDXN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDYN 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%OLDYN)) DEALLOCATE(OutData%OLDYN) - ALLOCATE(OutData%OLDYN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDYN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDYN,2), UBOUND(OutData%OLDYN,2) - DO i1 = LBOUND(OutData%OLDYN,1), UBOUND(OutData%OLDYN,1) - OutData%OLDYN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QX 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%QX)) DEALLOCATE(OutData%QX) - ALLOCATE(OutData%QX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%QX,2), UBOUND(OutData%QX,2) - DO i1 = LBOUND(OutData%QX,1), UBOUND(OutData%QX,1) - OutData%QX(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QX1 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%QX1)) DEALLOCATE(OutData%QX1) - ALLOCATE(OutData%QX1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%QX1,2), UBOUND(OutData%QX1,2) - DO i1 = LBOUND(OutData%QX1,1), UBOUND(OutData%QX1,1) - OutData%QX1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TAU 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%TAU)) DEALLOCATE(OutData%TAU) - ALLOCATE(OutData%TAU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TAU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TAU,2), UBOUND(OutData%TAU,2) - DO i1 = LBOUND(OutData%TAU,1), UBOUND(OutData%TAU,1) - OutData%TAU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! XN 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%XN)) DEALLOCATE(OutData%XN) - ALLOCATE(OutData%XN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%XN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%XN,2), UBOUND(OutData%XN,2) - DO i1 = LBOUND(OutData%XN,1), UBOUND(OutData%XN,1) - OutData%XN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! YN 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%YN)) DEALLOCATE(OutData%YN) - ALLOCATE(OutData%YN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%YN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%YN,2), UBOUND(OutData%YN,2) - DO i1 = LBOUND(OutData%YN,1), UBOUND(OutData%YN,1) - OutData%YN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%SHIFT = TRANSFER(IntKiBuf(Int_Xferred), OutData%SHIFT) - Int_Xferred = Int_Xferred + 1 - OutData%VOR = TRANSFER(IntKiBuf(Int_Xferred), OutData%VOR) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_UnPackBeddoes - - SUBROUTINE AD14_CopyBeddoesParms( SrcBeddoesParmsData, DstBeddoesParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BeddoesParms), INTENT(IN) :: SrcBeddoesParmsData - TYPE(BeddoesParms), INTENT(INOUT) :: DstBeddoesParmsData - 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 = 'AD14_CopyBeddoesParms' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBeddoesParmsData%AS = SrcBeddoesParmsData%AS - DstBeddoesParmsData%TF = SrcBeddoesParmsData%TF - DstBeddoesParmsData%TP = SrcBeddoesParmsData%TP - DstBeddoesParmsData%TV = SrcBeddoesParmsData%TV - DstBeddoesParmsData%TVL = SrcBeddoesParmsData%TVL - END SUBROUTINE AD14_CopyBeddoesParms - - SUBROUTINE AD14_DestroyBeddoesParms( BeddoesParmsData, ErrStat, ErrMsg ) - TYPE(BeddoesParms), INTENT(INOUT) :: BeddoesParmsData - 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 = 'AD14_DestroyBeddoesParms' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyBeddoesParms - - SUBROUTINE AD14_PackBeddoesParms( 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(BeddoesParms), 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 = 'AD14_PackBeddoesParms' - ! 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 ! AS - Re_BufSz = Re_BufSz + 1 ! TF - Re_BufSz = Re_BufSz + 1 ! TP - Re_BufSz = Re_BufSz + 1 ! TV - Re_BufSz = Re_BufSz + 1 ! TVL - 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%AS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TF - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TVL - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackBeddoesParms - - SUBROUTINE AD14_UnPackBeddoesParms( 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(BeddoesParms), 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 = 'AD14_UnPackBeddoesParms' - ! 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%AS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TF = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TVL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackBeddoesParms - - SUBROUTINE AD14_CopyBladeParms( SrcBladeParmsData, DstBladeParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladeParms), INTENT(IN) :: SrcBladeParmsData - TYPE(BladeParms), INTENT(INOUT) :: DstBladeParmsData - 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 = 'AD14_CopyBladeParms' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBladeParmsData%C)) THEN - i1_l = LBOUND(SrcBladeParmsData%C,1) - i1_u = UBOUND(SrcBladeParmsData%C,1) - IF (.NOT. ALLOCATED(DstBladeParmsData%C)) THEN - ALLOCATE(DstBladeParmsData%C(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeParmsData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeParmsData%C = SrcBladeParmsData%C -ENDIF -IF (ALLOCATED(SrcBladeParmsData%DR)) THEN - i1_l = LBOUND(SrcBladeParmsData%DR,1) - i1_u = UBOUND(SrcBladeParmsData%DR,1) - IF (.NOT. ALLOCATED(DstBladeParmsData%DR)) THEN - ALLOCATE(DstBladeParmsData%DR(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeParmsData%DR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeParmsData%DR = SrcBladeParmsData%DR -ENDIF - DstBladeParmsData%R = SrcBladeParmsData%R - DstBladeParmsData%BladeLength = SrcBladeParmsData%BladeLength - END SUBROUTINE AD14_CopyBladeParms - - SUBROUTINE AD14_DestroyBladeParms( BladeParmsData, ErrStat, ErrMsg ) - TYPE(BladeParms), INTENT(INOUT) :: BladeParmsData - 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 = 'AD14_DestroyBladeParms' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladeParmsData%C)) THEN - DEALLOCATE(BladeParmsData%C) -ENDIF -IF (ALLOCATED(BladeParmsData%DR)) THEN - DEALLOCATE(BladeParmsData%DR) -ENDIF - END SUBROUTINE AD14_DestroyBladeParms - - SUBROUTINE AD14_PackBladeParms( 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(BladeParms), 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 = 'AD14_PackBladeParms' - ! 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 ! C allocated yes/no - IF ( ALLOCATED(InData%C) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! C upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C) ! C - END IF - Int_BufSz = Int_BufSz + 1 ! DR allocated yes/no - IF ( ALLOCATED(InData%DR) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DR) ! DR - END IF - Re_BufSz = Re_BufSz + 1 ! R - Re_BufSz = Re_BufSz + 1 ! BladeLength - 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%C) ) 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%C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) - ReKiBuf(Re_Xferred) = InData%C(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DR) ) 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%DR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DR,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DR,1), UBOUND(InData%DR,1) - ReKiBuf(Re_Xferred) = InData%DR(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%R - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackBladeParms - - SUBROUTINE AD14_UnPackBladeParms( 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(BladeParms), 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 = 'AD14_UnPackBladeParms' - ! 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 ! C 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%C)) DEALLOCATE(OutData%C) - ALLOCATE(OutData%C(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) - OutData%C(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DR 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%DR)) DEALLOCATE(OutData%DR) - ALLOCATE(OutData%DR(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DR,1), UBOUND(OutData%DR,1) - OutData%DR(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%R = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackBladeParms - - SUBROUTINE AD14_CopyDynInflow( SrcDynInflowData, DstDynInflowData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DynInflow), INTENT(IN) :: SrcDynInflowData - TYPE(DynInflow), INTENT(INOUT) :: DstDynInflowData - 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 = 'AD14_CopyDynInflow' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDynInflowData%dAlph_dt = SrcDynInflowData%dAlph_dt - DstDynInflowData%dBeta_dt = SrcDynInflowData%dBeta_dt - DstDynInflowData%DTO = SrcDynInflowData%DTO - DstDynInflowData%old_Alph = SrcDynInflowData%old_Alph - DstDynInflowData%old_Beta = SrcDynInflowData%old_Beta - DstDynInflowData%old_LmdM = SrcDynInflowData%old_LmdM - DstDynInflowData%oldKai = SrcDynInflowData%oldKai - DstDynInflowData%PhiLqC = SrcDynInflowData%PhiLqC - DstDynInflowData%PhiLqS = SrcDynInflowData%PhiLqS - DstDynInflowData%Pzero = SrcDynInflowData%Pzero -IF (ALLOCATED(SrcDynInflowData%RMC_SAVE)) THEN - i1_l = LBOUND(SrcDynInflowData%RMC_SAVE,1) - i1_u = UBOUND(SrcDynInflowData%RMC_SAVE,1) - i2_l = LBOUND(SrcDynInflowData%RMC_SAVE,2) - i2_u = UBOUND(SrcDynInflowData%RMC_SAVE,2) - i3_l = LBOUND(SrcDynInflowData%RMC_SAVE,3) - i3_u = UBOUND(SrcDynInflowData%RMC_SAVE,3) - IF (.NOT. ALLOCATED(DstDynInflowData%RMC_SAVE)) THEN - ALLOCATE(DstDynInflowData%RMC_SAVE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDynInflowData%RMC_SAVE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDynInflowData%RMC_SAVE = SrcDynInflowData%RMC_SAVE -ENDIF -IF (ALLOCATED(SrcDynInflowData%RMS_SAVE)) THEN - i1_l = LBOUND(SrcDynInflowData%RMS_SAVE,1) - i1_u = UBOUND(SrcDynInflowData%RMS_SAVE,1) - i2_l = LBOUND(SrcDynInflowData%RMS_SAVE,2) - i2_u = UBOUND(SrcDynInflowData%RMS_SAVE,2) - i3_l = LBOUND(SrcDynInflowData%RMS_SAVE,3) - i3_u = UBOUND(SrcDynInflowData%RMS_SAVE,3) - IF (.NOT. ALLOCATED(DstDynInflowData%RMS_SAVE)) THEN - ALLOCATE(DstDynInflowData%RMS_SAVE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDynInflowData%RMS_SAVE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDynInflowData%RMS_SAVE = SrcDynInflowData%RMS_SAVE -ENDIF - DstDynInflowData%TipSpeed = SrcDynInflowData%TipSpeed - DstDynInflowData%totalInf = SrcDynInflowData%totalInf - DstDynInflowData%Vparam = SrcDynInflowData%Vparam - DstDynInflowData%Vtotal = SrcDynInflowData%Vtotal - DstDynInflowData%xAlpha = SrcDynInflowData%xAlpha - DstDynInflowData%xBeta = SrcDynInflowData%xBeta - DstDynInflowData%xKai = SrcDynInflowData%xKai - DstDynInflowData%XLAMBDA_M = SrcDynInflowData%XLAMBDA_M - DstDynInflowData%xLcos = SrcDynInflowData%xLcos - DstDynInflowData%xLsin = SrcDynInflowData%xLsin - DstDynInflowData%MminR = SrcDynInflowData%MminR - DstDynInflowData%MminusR = SrcDynInflowData%MminusR - DstDynInflowData%MplusR = SrcDynInflowData%MplusR - DstDynInflowData%GAMMA = SrcDynInflowData%GAMMA - END SUBROUTINE AD14_CopyDynInflow - - SUBROUTINE AD14_DestroyDynInflow( DynInflowData, ErrStat, ErrMsg ) - TYPE(DynInflow), INTENT(INOUT) :: DynInflowData - 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 = 'AD14_DestroyDynInflow' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DynInflowData%RMC_SAVE)) THEN - DEALLOCATE(DynInflowData%RMC_SAVE) -ENDIF -IF (ALLOCATED(DynInflowData%RMS_SAVE)) THEN - DEALLOCATE(DynInflowData%RMS_SAVE) -ENDIF - END SUBROUTINE AD14_DestroyDynInflow - - SUBROUTINE AD14_PackDynInflow( 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(DynInflow), 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 = 'AD14_PackDynInflow' - ! 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 + SIZE(InData%dAlph_dt) ! dAlph_dt - Re_BufSz = Re_BufSz + SIZE(InData%dBeta_dt) ! dBeta_dt - Re_BufSz = Re_BufSz + 1 ! DTO - Re_BufSz = Re_BufSz + SIZE(InData%old_Alph) ! old_Alph - Re_BufSz = Re_BufSz + SIZE(InData%old_Beta) ! old_Beta - Re_BufSz = Re_BufSz + 1 ! old_LmdM - Re_BufSz = Re_BufSz + 1 ! oldKai - Re_BufSz = Re_BufSz + SIZE(InData%PhiLqC) ! PhiLqC - Re_BufSz = Re_BufSz + SIZE(InData%PhiLqS) ! PhiLqS - Re_BufSz = Re_BufSz + 1 ! Pzero - Int_BufSz = Int_BufSz + 1 ! RMC_SAVE allocated yes/no - IF ( ALLOCATED(InData%RMC_SAVE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! RMC_SAVE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RMC_SAVE) ! RMC_SAVE - END IF - Int_BufSz = Int_BufSz + 1 ! RMS_SAVE allocated yes/no - IF ( ALLOCATED(InData%RMS_SAVE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! RMS_SAVE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RMS_SAVE) ! RMS_SAVE - END IF - Re_BufSz = Re_BufSz + 1 ! TipSpeed - Re_BufSz = Re_BufSz + 1 ! totalInf - Re_BufSz = Re_BufSz + 1 ! Vparam - Re_BufSz = Re_BufSz + 1 ! Vtotal - Re_BufSz = Re_BufSz + SIZE(InData%xAlpha) ! xAlpha - Re_BufSz = Re_BufSz + SIZE(InData%xBeta) ! xBeta - Re_BufSz = Re_BufSz + 1 ! xKai - Re_BufSz = Re_BufSz + 1 ! XLAMBDA_M - Re_BufSz = Re_BufSz + SIZE(InData%xLcos) ! xLcos - Re_BufSz = Re_BufSz + SIZE(InData%xLsin) ! xLsin - Int_BufSz = Int_BufSz + SIZE(InData%MminR) ! MminR - Int_BufSz = Int_BufSz + SIZE(InData%MminusR) ! MminusR - Int_BufSz = Int_BufSz + SIZE(InData%MplusR) ! MplusR - Re_BufSz = Re_BufSz + SIZE(InData%GAMMA) ! GAMMA - 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 i2 = LBOUND(InData%dAlph_dt,2), UBOUND(InData%dAlph_dt,2) - DO i1 = LBOUND(InData%dAlph_dt,1), UBOUND(InData%dAlph_dt,1) - ReKiBuf(Re_Xferred) = InData%dAlph_dt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%dBeta_dt,2), UBOUND(InData%dBeta_dt,2) - DO i1 = LBOUND(InData%dBeta_dt,1), UBOUND(InData%dBeta_dt,1) - ReKiBuf(Re_Xferred) = InData%dBeta_dt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - ReKiBuf(Re_Xferred) = InData%DTO - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%old_Alph,1), UBOUND(InData%old_Alph,1) - ReKiBuf(Re_Xferred) = InData%old_Alph(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%old_Beta,1), UBOUND(InData%old_Beta,1) - ReKiBuf(Re_Xferred) = InData%old_Beta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%old_LmdM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%oldKai - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%PhiLqC,1), UBOUND(InData%PhiLqC,1) - ReKiBuf(Re_Xferred) = InData%PhiLqC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PhiLqS,1), UBOUND(InData%PhiLqS,1) - ReKiBuf(Re_Xferred) = InData%PhiLqS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Pzero - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%RMC_SAVE) ) 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%RMC_SAVE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMC_SAVE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMC_SAVE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMC_SAVE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMC_SAVE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMC_SAVE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%RMC_SAVE,3), UBOUND(InData%RMC_SAVE,3) - DO i2 = LBOUND(InData%RMC_SAVE,2), UBOUND(InData%RMC_SAVE,2) - DO i1 = LBOUND(InData%RMC_SAVE,1), UBOUND(InData%RMC_SAVE,1) - ReKiBuf(Re_Xferred) = InData%RMC_SAVE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RMS_SAVE) ) 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%RMS_SAVE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMS_SAVE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMS_SAVE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMS_SAVE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMS_SAVE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMS_SAVE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%RMS_SAVE,3), UBOUND(InData%RMS_SAVE,3) - DO i2 = LBOUND(InData%RMS_SAVE,2), UBOUND(InData%RMS_SAVE,2) - DO i1 = LBOUND(InData%RMS_SAVE,1), UBOUND(InData%RMS_SAVE,1) - ReKiBuf(Re_Xferred) = InData%RMS_SAVE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TipSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%totalInf - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vparam - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vtotal - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%xAlpha,1), UBOUND(InData%xAlpha,1) - ReKiBuf(Re_Xferred) = InData%xAlpha(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%xBeta,1), UBOUND(InData%xBeta,1) - ReKiBuf(Re_Xferred) = InData%xBeta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%xKai - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%XLAMBDA_M - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%xLcos,2), UBOUND(InData%xLcos,2) - DO i1 = LBOUND(InData%xLcos,1), UBOUND(InData%xLcos,1) - ReKiBuf(Re_Xferred) = InData%xLcos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%xLsin,2), UBOUND(InData%xLsin,2) - DO i1 = LBOUND(InData%xLsin,1), UBOUND(InData%xLsin,1) - ReKiBuf(Re_Xferred) = InData%xLsin(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%MminR,2), UBOUND(InData%MminR,2) - DO i1 = LBOUND(InData%MminR,1), UBOUND(InData%MminR,1) - IntKiBuf(Int_Xferred) = InData%MminR(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%MminusR,2), UBOUND(InData%MminusR,2) - DO i1 = LBOUND(InData%MminusR,1), UBOUND(InData%MminusR,1) - IntKiBuf(Int_Xferred) = InData%MminusR(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%MplusR,2), UBOUND(InData%MplusR,2) - DO i1 = LBOUND(InData%MplusR,1), UBOUND(InData%MplusR,1) - IntKiBuf(Int_Xferred) = InData%MplusR(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%GAMMA,2), UBOUND(InData%GAMMA,2) - DO i1 = LBOUND(InData%GAMMA,1), UBOUND(InData%GAMMA,1) - ReKiBuf(Re_Xferred) = InData%GAMMA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD14_PackDynInflow - - SUBROUTINE AD14_UnPackDynInflow( 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(DynInflow), 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 = 'AD14_UnPackDynInflow' - ! 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 - i1_l = LBOUND(OutData%dAlph_dt,1) - i1_u = UBOUND(OutData%dAlph_dt,1) - i2_l = LBOUND(OutData%dAlph_dt,2) - i2_u = UBOUND(OutData%dAlph_dt,2) - DO i2 = LBOUND(OutData%dAlph_dt,2), UBOUND(OutData%dAlph_dt,2) - DO i1 = LBOUND(OutData%dAlph_dt,1), UBOUND(OutData%dAlph_dt,1) - OutData%dAlph_dt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%dBeta_dt,1) - i1_u = UBOUND(OutData%dBeta_dt,1) - i2_l = LBOUND(OutData%dBeta_dt,2) - i2_u = UBOUND(OutData%dBeta_dt,2) - DO i2 = LBOUND(OutData%dBeta_dt,2), UBOUND(OutData%dBeta_dt,2) - DO i1 = LBOUND(OutData%dBeta_dt,1), UBOUND(OutData%dBeta_dt,1) - OutData%dBeta_dt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - OutData%DTO = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%old_Alph,1) - i1_u = UBOUND(OutData%old_Alph,1) - DO i1 = LBOUND(OutData%old_Alph,1), UBOUND(OutData%old_Alph,1) - OutData%old_Alph(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%old_Beta,1) - i1_u = UBOUND(OutData%old_Beta,1) - DO i1 = LBOUND(OutData%old_Beta,1), UBOUND(OutData%old_Beta,1) - OutData%old_Beta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%old_LmdM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%oldKai = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%PhiLqC,1) - i1_u = UBOUND(OutData%PhiLqC,1) - DO i1 = LBOUND(OutData%PhiLqC,1), UBOUND(OutData%PhiLqC,1) - OutData%PhiLqC(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PhiLqS,1) - i1_u = UBOUND(OutData%PhiLqS,1) - DO i1 = LBOUND(OutData%PhiLqS,1), UBOUND(OutData%PhiLqS,1) - OutData%PhiLqS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Pzero = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RMC_SAVE 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%RMC_SAVE)) DEALLOCATE(OutData%RMC_SAVE) - ALLOCATE(OutData%RMC_SAVE(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%RMC_SAVE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%RMC_SAVE,3), UBOUND(OutData%RMC_SAVE,3) - DO i2 = LBOUND(OutData%RMC_SAVE,2), UBOUND(OutData%RMC_SAVE,2) - DO i1 = LBOUND(OutData%RMC_SAVE,1), UBOUND(OutData%RMC_SAVE,1) - OutData%RMC_SAVE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RMS_SAVE 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%RMS_SAVE)) DEALLOCATE(OutData%RMS_SAVE) - ALLOCATE(OutData%RMS_SAVE(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%RMS_SAVE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%RMS_SAVE,3), UBOUND(OutData%RMS_SAVE,3) - DO i2 = LBOUND(OutData%RMS_SAVE,2), UBOUND(OutData%RMS_SAVE,2) - DO i1 = LBOUND(OutData%RMS_SAVE,1), UBOUND(OutData%RMS_SAVE,1) - OutData%RMS_SAVE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%TipSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%totalInf = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vparam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vtotal = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%xAlpha,1) - i1_u = UBOUND(OutData%xAlpha,1) - DO i1 = LBOUND(OutData%xAlpha,1), UBOUND(OutData%xAlpha,1) - OutData%xAlpha(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%xBeta,1) - i1_u = UBOUND(OutData%xBeta,1) - DO i1 = LBOUND(OutData%xBeta,1), UBOUND(OutData%xBeta,1) - OutData%xBeta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%xKai = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%XLAMBDA_M = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%xLcos,1) - i1_u = UBOUND(OutData%xLcos,1) - i2_l = LBOUND(OutData%xLcos,2) - i2_u = UBOUND(OutData%xLcos,2) - DO i2 = LBOUND(OutData%xLcos,2), UBOUND(OutData%xLcos,2) - DO i1 = LBOUND(OutData%xLcos,1), UBOUND(OutData%xLcos,1) - OutData%xLcos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%xLsin,1) - i1_u = UBOUND(OutData%xLsin,1) - i2_l = LBOUND(OutData%xLsin,2) - i2_u = UBOUND(OutData%xLsin,2) - DO i2 = LBOUND(OutData%xLsin,2), UBOUND(OutData%xLsin,2) - DO i1 = LBOUND(OutData%xLsin,1), UBOUND(OutData%xLsin,1) - OutData%xLsin(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%MminR,1) - i1_u = UBOUND(OutData%MminR,1) - i2_l = LBOUND(OutData%MminR,2) - i2_u = UBOUND(OutData%MminR,2) - DO i2 = LBOUND(OutData%MminR,2), UBOUND(OutData%MminR,2) - DO i1 = LBOUND(OutData%MminR,1), UBOUND(OutData%MminR,1) - OutData%MminR(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%MminusR,1) - i1_u = UBOUND(OutData%MminusR,1) - i2_l = LBOUND(OutData%MminusR,2) - i2_u = UBOUND(OutData%MminusR,2) - DO i2 = LBOUND(OutData%MminusR,2), UBOUND(OutData%MminusR,2) - DO i1 = LBOUND(OutData%MminusR,1), UBOUND(OutData%MminusR,1) - OutData%MminusR(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%MplusR,1) - i1_u = UBOUND(OutData%MplusR,1) - i2_l = LBOUND(OutData%MplusR,2) - i2_u = UBOUND(OutData%MplusR,2) - DO i2 = LBOUND(OutData%MplusR,2), UBOUND(OutData%MplusR,2) - DO i1 = LBOUND(OutData%MplusR,1), UBOUND(OutData%MplusR,1) - OutData%MplusR(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%GAMMA,1) - i1_u = UBOUND(OutData%GAMMA,1) - i2_l = LBOUND(OutData%GAMMA,2) - i2_u = UBOUND(OutData%GAMMA,2) - DO i2 = LBOUND(OutData%GAMMA,2), UBOUND(OutData%GAMMA,2) - DO i1 = LBOUND(OutData%GAMMA,1), UBOUND(OutData%GAMMA,1) - OutData%GAMMA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD14_UnPackDynInflow - - SUBROUTINE AD14_CopyDynInflowParms( SrcDynInflowParmsData, DstDynInflowParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DynInflowParms), INTENT(IN) :: SrcDynInflowParmsData - TYPE(DynInflowParms), INTENT(INOUT) :: DstDynInflowParmsData - 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 = 'AD14_CopyDynInflowParms' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDynInflowParmsData%MAXINFLO = SrcDynInflowParmsData%MAXINFLO - DstDynInflowParmsData%xMinv = SrcDynInflowParmsData%xMinv - END SUBROUTINE AD14_CopyDynInflowParms - - SUBROUTINE AD14_DestroyDynInflowParms( DynInflowParmsData, ErrStat, ErrMsg ) - TYPE(DynInflowParms), INTENT(INOUT) :: DynInflowParmsData - 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 = 'AD14_DestroyDynInflowParms' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyDynInflowParms - - SUBROUTINE AD14_PackDynInflowParms( 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(DynInflowParms), 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 = 'AD14_PackDynInflowParms' - ! 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 ! MAXINFLO - Re_BufSz = Re_BufSz + SIZE(InData%xMinv) ! xMinv - 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%MAXINFLO - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%xMinv,1), UBOUND(InData%xMinv,1) - ReKiBuf(Re_Xferred) = InData%xMinv(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_PackDynInflowParms - - SUBROUTINE AD14_UnPackDynInflowParms( 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(DynInflowParms), 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 = 'AD14_UnPackDynInflowParms' - ! 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%MAXINFLO = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%xMinv,1) - i1_u = UBOUND(OutData%xMinv,1) - DO i1 = LBOUND(OutData%xMinv,1), UBOUND(OutData%xMinv,1) - OutData%xMinv(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_UnPackDynInflowParms - - SUBROUTINE AD14_CopyElement( SrcElementData, DstElementData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Element), INTENT(IN) :: SrcElementData - TYPE(Element), INTENT(INOUT) :: DstElementData - 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 = 'AD14_CopyElement' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcElementData%A)) THEN - i1_l = LBOUND(SrcElementData%A,1) - i1_u = UBOUND(SrcElementData%A,1) - i2_l = LBOUND(SrcElementData%A,2) - i2_u = UBOUND(SrcElementData%A,2) - IF (.NOT. ALLOCATED(DstElementData%A)) THEN - ALLOCATE(DstElementData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%A = SrcElementData%A -ENDIF -IF (ALLOCATED(SrcElementData%AP)) THEN - i1_l = LBOUND(SrcElementData%AP,1) - i1_u = UBOUND(SrcElementData%AP,1) - i2_l = LBOUND(SrcElementData%AP,2) - i2_u = UBOUND(SrcElementData%AP,2) - IF (.NOT. ALLOCATED(DstElementData%AP)) THEN - ALLOCATE(DstElementData%AP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%AP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%AP = SrcElementData%AP -ENDIF -IF (ALLOCATED(SrcElementData%ALPHA)) THEN - i1_l = LBOUND(SrcElementData%ALPHA,1) - i1_u = UBOUND(SrcElementData%ALPHA,1) - i2_l = LBOUND(SrcElementData%ALPHA,2) - i2_u = UBOUND(SrcElementData%ALPHA,2) - IF (.NOT. ALLOCATED(DstElementData%ALPHA)) THEN - ALLOCATE(DstElementData%ALPHA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%ALPHA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%ALPHA = SrcElementData%ALPHA -ENDIF -IF (ALLOCATED(SrcElementData%W2)) THEN - i1_l = LBOUND(SrcElementData%W2,1) - i1_u = UBOUND(SrcElementData%W2,1) - i2_l = LBOUND(SrcElementData%W2,2) - i2_u = UBOUND(SrcElementData%W2,2) - IF (.NOT. ALLOCATED(DstElementData%W2)) THEN - ALLOCATE(DstElementData%W2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%W2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%W2 = SrcElementData%W2 -ENDIF -IF (ALLOCATED(SrcElementData%OLD_A_NS)) THEN - i1_l = LBOUND(SrcElementData%OLD_A_NS,1) - i1_u = UBOUND(SrcElementData%OLD_A_NS,1) - i2_l = LBOUND(SrcElementData%OLD_A_NS,2) - i2_u = UBOUND(SrcElementData%OLD_A_NS,2) - IF (.NOT. ALLOCATED(DstElementData%OLD_A_NS)) THEN - ALLOCATE(DstElementData%OLD_A_NS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%OLD_A_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%OLD_A_NS = SrcElementData%OLD_A_NS -ENDIF -IF (ALLOCATED(SrcElementData%OLD_AP_NS)) THEN - i1_l = LBOUND(SrcElementData%OLD_AP_NS,1) - i1_u = UBOUND(SrcElementData%OLD_AP_NS,1) - i2_l = LBOUND(SrcElementData%OLD_AP_NS,2) - i2_u = UBOUND(SrcElementData%OLD_AP_NS,2) - IF (.NOT. ALLOCATED(DstElementData%OLD_AP_NS)) THEN - ALLOCATE(DstElementData%OLD_AP_NS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%OLD_AP_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%OLD_AP_NS = SrcElementData%OLD_AP_NS -ENDIF -IF (ALLOCATED(SrcElementData%PITNOW)) THEN - i1_l = LBOUND(SrcElementData%PITNOW,1) - i1_u = UBOUND(SrcElementData%PITNOW,1) - i2_l = LBOUND(SrcElementData%PITNOW,2) - i2_u = UBOUND(SrcElementData%PITNOW,2) - IF (.NOT. ALLOCATED(DstElementData%PITNOW)) THEN - ALLOCATE(DstElementData%PITNOW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%PITNOW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%PITNOW = SrcElementData%PITNOW -ENDIF - END SUBROUTINE AD14_CopyElement - - SUBROUTINE AD14_DestroyElement( ElementData, ErrStat, ErrMsg ) - TYPE(Element), INTENT(INOUT) :: ElementData - 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 = 'AD14_DestroyElement' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ElementData%A)) THEN - DEALLOCATE(ElementData%A) -ENDIF -IF (ALLOCATED(ElementData%AP)) THEN - DEALLOCATE(ElementData%AP) -ENDIF -IF (ALLOCATED(ElementData%ALPHA)) THEN - DEALLOCATE(ElementData%ALPHA) -ENDIF -IF (ALLOCATED(ElementData%W2)) THEN - DEALLOCATE(ElementData%W2) -ENDIF -IF (ALLOCATED(ElementData%OLD_A_NS)) THEN - DEALLOCATE(ElementData%OLD_A_NS) -ENDIF -IF (ALLOCATED(ElementData%OLD_AP_NS)) THEN - DEALLOCATE(ElementData%OLD_AP_NS) -ENDIF -IF (ALLOCATED(ElementData%PITNOW)) THEN - DEALLOCATE(ElementData%PITNOW) -ENDIF - END SUBROUTINE AD14_DestroyElement - - SUBROUTINE AD14_PackElement( 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(Element), 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 = 'AD14_PackElement' - ! 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 ! A allocated yes/no - IF ( ALLOCATED(InData%A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! A upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%A) ! A - END IF - Int_BufSz = Int_BufSz + 1 ! AP allocated yes/no - IF ( ALLOCATED(InData%AP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AP) ! AP - END IF - Int_BufSz = Int_BufSz + 1 ! ALPHA allocated yes/no - IF ( ALLOCATED(InData%ALPHA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ALPHA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ALPHA) ! ALPHA - END IF - Int_BufSz = Int_BufSz + 1 ! W2 allocated yes/no - IF ( ALLOCATED(InData%W2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! W2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%W2) ! W2 - END IF - Int_BufSz = Int_BufSz + 1 ! OLD_A_NS allocated yes/no - IF ( ALLOCATED(InData%OLD_A_NS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLD_A_NS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLD_A_NS) ! OLD_A_NS - END IF - Int_BufSz = Int_BufSz + 1 ! OLD_AP_NS allocated yes/no - IF ( ALLOCATED(InData%OLD_AP_NS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLD_AP_NS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLD_AP_NS) ! OLD_AP_NS - END IF - Int_BufSz = Int_BufSz + 1 ! PITNOW allocated yes/no - IF ( ALLOCATED(InData%PITNOW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PITNOW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PITNOW) ! PITNOW - 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%A) ) 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%A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) - DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) - ReKiBuf(Re_Xferred) = InData%A(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AP) ) 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%AP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AP,2), UBOUND(InData%AP,2) - DO i1 = LBOUND(InData%AP,1), UBOUND(InData%AP,1) - ReKiBuf(Re_Xferred) = InData%AP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ALPHA) ) 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%ALPHA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ALPHA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ALPHA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ALPHA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ALPHA,2), UBOUND(InData%ALPHA,2) - DO i1 = LBOUND(InData%ALPHA,1), UBOUND(InData%ALPHA,1) - ReKiBuf(Re_Xferred) = InData%ALPHA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%W2) ) 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%W2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%W2,2), UBOUND(InData%W2,2) - DO i1 = LBOUND(InData%W2,1), UBOUND(InData%W2,1) - ReKiBuf(Re_Xferred) = InData%W2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLD_A_NS) ) 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%OLD_A_NS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_A_NS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLD_A_NS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_A_NS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLD_A_NS,2), UBOUND(InData%OLD_A_NS,2) - DO i1 = LBOUND(InData%OLD_A_NS,1), UBOUND(InData%OLD_A_NS,1) - ReKiBuf(Re_Xferred) = InData%OLD_A_NS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLD_AP_NS) ) 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%OLD_AP_NS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_AP_NS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLD_AP_NS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_AP_NS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLD_AP_NS,2), UBOUND(InData%OLD_AP_NS,2) - DO i1 = LBOUND(InData%OLD_AP_NS,1), UBOUND(InData%OLD_AP_NS,1) - ReKiBuf(Re_Xferred) = InData%OLD_AP_NS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PITNOW) ) 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%PITNOW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PITNOW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PITNOW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PITNOW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PITNOW,2), UBOUND(InData%PITNOW,2) - DO i1 = LBOUND(InData%PITNOW,1), UBOUND(InData%PITNOW,1) - ReKiBuf(Re_Xferred) = InData%PITNOW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD14_PackElement - - SUBROUTINE AD14_UnPackElement( 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(Element), 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 = 'AD14_UnPackElement' - ! 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 ! A 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%A)) DEALLOCATE(OutData%A) - ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) - DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) - OutData%A(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AP 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%AP)) DEALLOCATE(OutData%AP) - ALLOCATE(OutData%AP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AP,2), UBOUND(OutData%AP,2) - DO i1 = LBOUND(OutData%AP,1), UBOUND(OutData%AP,1) - OutData%AP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ALPHA 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%ALPHA)) DEALLOCATE(OutData%ALPHA) - ALLOCATE(OutData%ALPHA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALPHA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ALPHA,2), UBOUND(OutData%ALPHA,2) - DO i1 = LBOUND(OutData%ALPHA,1), UBOUND(OutData%ALPHA,1) - OutData%ALPHA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W2 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%W2)) DEALLOCATE(OutData%W2) - ALLOCATE(OutData%W2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%W2,2), UBOUND(OutData%W2,2) - DO i1 = LBOUND(OutData%W2,1), UBOUND(OutData%W2,1) - OutData%W2(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLD_A_NS 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%OLD_A_NS)) DEALLOCATE(OutData%OLD_A_NS) - ALLOCATE(OutData%OLD_A_NS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_A_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLD_A_NS,2), UBOUND(OutData%OLD_A_NS,2) - DO i1 = LBOUND(OutData%OLD_A_NS,1), UBOUND(OutData%OLD_A_NS,1) - OutData%OLD_A_NS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLD_AP_NS 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%OLD_AP_NS)) DEALLOCATE(OutData%OLD_AP_NS) - ALLOCATE(OutData%OLD_AP_NS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_AP_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLD_AP_NS,2), UBOUND(OutData%OLD_AP_NS,2) - DO i1 = LBOUND(OutData%OLD_AP_NS,1), UBOUND(OutData%OLD_AP_NS,1) - OutData%OLD_AP_NS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PITNOW 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%PITNOW)) DEALLOCATE(OutData%PITNOW) - ALLOCATE(OutData%PITNOW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITNOW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PITNOW,2), UBOUND(OutData%PITNOW,2) - DO i1 = LBOUND(OutData%PITNOW,1), UBOUND(OutData%PITNOW,1) - OutData%PITNOW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD14_UnPackElement - - SUBROUTINE AD14_CopyElementParms( SrcElementParmsData, DstElementParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElementParms), INTENT(IN) :: SrcElementParmsData - TYPE(ElementParms), INTENT(INOUT) :: DstElementParmsData - 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 = 'AD14_CopyElementParms' -! - ErrStat = ErrID_None - ErrMsg = "" - DstElementParmsData%NELM = SrcElementParmsData%NELM -IF (ALLOCATED(SrcElementParmsData%TWIST)) THEN - i1_l = LBOUND(SrcElementParmsData%TWIST,1) - i1_u = UBOUND(SrcElementParmsData%TWIST,1) - IF (.NOT. ALLOCATED(DstElementParmsData%TWIST)) THEN - ALLOCATE(DstElementParmsData%TWIST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%TWIST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementParmsData%TWIST = SrcElementParmsData%TWIST -ENDIF -IF (ALLOCATED(SrcElementParmsData%RELM)) THEN - i1_l = LBOUND(SrcElementParmsData%RELM,1) - i1_u = UBOUND(SrcElementParmsData%RELM,1) - IF (.NOT. ALLOCATED(DstElementParmsData%RELM)) THEN - ALLOCATE(DstElementParmsData%RELM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%RELM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementParmsData%RELM = SrcElementParmsData%RELM -ENDIF -IF (ALLOCATED(SrcElementParmsData%HLCNST)) THEN - i1_l = LBOUND(SrcElementParmsData%HLCNST,1) - i1_u = UBOUND(SrcElementParmsData%HLCNST,1) - IF (.NOT. ALLOCATED(DstElementParmsData%HLCNST)) THEN - ALLOCATE(DstElementParmsData%HLCNST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%HLCNST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementParmsData%HLCNST = SrcElementParmsData%HLCNST -ENDIF -IF (ALLOCATED(SrcElementParmsData%TLCNST)) THEN - i1_l = LBOUND(SrcElementParmsData%TLCNST,1) - i1_u = UBOUND(SrcElementParmsData%TLCNST,1) - IF (.NOT. ALLOCATED(DstElementParmsData%TLCNST)) THEN - ALLOCATE(DstElementParmsData%TLCNST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%TLCNST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementParmsData%TLCNST = SrcElementParmsData%TLCNST -ENDIF - END SUBROUTINE AD14_CopyElementParms - - SUBROUTINE AD14_DestroyElementParms( ElementParmsData, ErrStat, ErrMsg ) - TYPE(ElementParms), INTENT(INOUT) :: ElementParmsData - 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 = 'AD14_DestroyElementParms' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ElementParmsData%TWIST)) THEN - DEALLOCATE(ElementParmsData%TWIST) -ENDIF -IF (ALLOCATED(ElementParmsData%RELM)) THEN - DEALLOCATE(ElementParmsData%RELM) -ENDIF -IF (ALLOCATED(ElementParmsData%HLCNST)) THEN - DEALLOCATE(ElementParmsData%HLCNST) -ENDIF -IF (ALLOCATED(ElementParmsData%TLCNST)) THEN - DEALLOCATE(ElementParmsData%TLCNST) -ENDIF - END SUBROUTINE AD14_DestroyElementParms - - SUBROUTINE AD14_PackElementParms( 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(ElementParms), 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 = 'AD14_PackElementParms' - ! 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 ! NELM - Int_BufSz = Int_BufSz + 1 ! TWIST allocated yes/no - IF ( ALLOCATED(InData%TWIST) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TWIST upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TWIST) ! TWIST - END IF - Int_BufSz = Int_BufSz + 1 ! RELM allocated yes/no - IF ( ALLOCATED(InData%RELM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RELM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RELM) ! RELM - END IF - Int_BufSz = Int_BufSz + 1 ! HLCNST allocated yes/no - IF ( ALLOCATED(InData%HLCNST) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HLCNST upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HLCNST) ! HLCNST - END IF - Int_BufSz = Int_BufSz + 1 ! TLCNST allocated yes/no - IF ( ALLOCATED(InData%TLCNST) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TLCNST upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TLCNST) ! TLCNST - 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 - - IntKiBuf(Int_Xferred) = InData%NELM - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TWIST) ) 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%TWIST,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TWIST,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TWIST,1), UBOUND(InData%TWIST,1) - ReKiBuf(Re_Xferred) = InData%TWIST(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RELM) ) 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%RELM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RELM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RELM,1), UBOUND(InData%RELM,1) - ReKiBuf(Re_Xferred) = InData%RELM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HLCNST) ) 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%HLCNST,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HLCNST,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HLCNST,1), UBOUND(InData%HLCNST,1) - ReKiBuf(Re_Xferred) = InData%HLCNST(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TLCNST) ) 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%TLCNST,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TLCNST,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TLCNST,1), UBOUND(InData%TLCNST,1) - ReKiBuf(Re_Xferred) = InData%TLCNST(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD14_PackElementParms - - SUBROUTINE AD14_UnPackElementParms( 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(ElementParms), 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 = 'AD14_UnPackElementParms' - ! 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%NELM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TWIST 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%TWIST)) DEALLOCATE(OutData%TWIST) - ALLOCATE(OutData%TWIST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TWIST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TWIST,1), UBOUND(OutData%TWIST,1) - OutData%TWIST(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RELM 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%RELM)) DEALLOCATE(OutData%RELM) - ALLOCATE(OutData%RELM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RELM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RELM,1), UBOUND(OutData%RELM,1) - OutData%RELM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HLCNST 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%HLCNST)) DEALLOCATE(OutData%HLCNST) - ALLOCATE(OutData%HLCNST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HLCNST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HLCNST,1), UBOUND(OutData%HLCNST,1) - OutData%HLCNST(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TLCNST 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%TLCNST)) DEALLOCATE(OutData%TLCNST) - ALLOCATE(OutData%TLCNST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TLCNST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TLCNST,1), UBOUND(OutData%TLCNST,1) - OutData%TLCNST(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD14_UnPackElementParms - - SUBROUTINE AD14_CopyElOutParms( SrcElOutParmsData, DstElOutParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElOutParms), INTENT(IN) :: SrcElOutParmsData - TYPE(ElOutParms), INTENT(INOUT) :: DstElOutParmsData - 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 = 'AD14_CopyElOutParms' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcElOutParmsData%AAA)) THEN - i1_l = LBOUND(SrcElOutParmsData%AAA,1) - i1_u = UBOUND(SrcElOutParmsData%AAA,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%AAA)) THEN - ALLOCATE(DstElOutParmsData%AAA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%AAA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%AAA = SrcElOutParmsData%AAA -ENDIF -IF (ALLOCATED(SrcElOutParmsData%AAP)) THEN - i1_l = LBOUND(SrcElOutParmsData%AAP,1) - i1_u = UBOUND(SrcElOutParmsData%AAP,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%AAP)) THEN - ALLOCATE(DstElOutParmsData%AAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%AAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%AAP = SrcElOutParmsData%AAP -ENDIF -IF (ALLOCATED(SrcElOutParmsData%ALF)) THEN - i1_l = LBOUND(SrcElOutParmsData%ALF,1) - i1_u = UBOUND(SrcElOutParmsData%ALF,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%ALF)) THEN - ALLOCATE(DstElOutParmsData%ALF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ALF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%ALF = SrcElOutParmsData%ALF -ENDIF -IF (ALLOCATED(SrcElOutParmsData%CDD)) THEN - i1_l = LBOUND(SrcElOutParmsData%CDD,1) - i1_u = UBOUND(SrcElOutParmsData%CDD,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%CDD)) THEN - ALLOCATE(DstElOutParmsData%CDD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CDD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%CDD = SrcElOutParmsData%CDD -ENDIF -IF (ALLOCATED(SrcElOutParmsData%CLL)) THEN - i1_l = LBOUND(SrcElOutParmsData%CLL,1) - i1_u = UBOUND(SrcElOutParmsData%CLL,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%CLL)) THEN - ALLOCATE(DstElOutParmsData%CLL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CLL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%CLL = SrcElOutParmsData%CLL -ENDIF -IF (ALLOCATED(SrcElOutParmsData%CMM)) THEN - i1_l = LBOUND(SrcElOutParmsData%CMM,1) - i1_u = UBOUND(SrcElOutParmsData%CMM,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%CMM)) THEN - ALLOCATE(DstElOutParmsData%CMM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%CMM = SrcElOutParmsData%CMM -ENDIF -IF (ALLOCATED(SrcElOutParmsData%CNN)) THEN - i1_l = LBOUND(SrcElOutParmsData%CNN,1) - i1_u = UBOUND(SrcElOutParmsData%CNN,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%CNN)) THEN - ALLOCATE(DstElOutParmsData%CNN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CNN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%CNN = SrcElOutParmsData%CNN -ENDIF -IF (ALLOCATED(SrcElOutParmsData%CTT)) THEN - i1_l = LBOUND(SrcElOutParmsData%CTT,1) - i1_u = UBOUND(SrcElOutParmsData%CTT,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%CTT)) THEN - ALLOCATE(DstElOutParmsData%CTT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CTT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%CTT = SrcElOutParmsData%CTT -ENDIF -IF (ALLOCATED(SrcElOutParmsData%DFNSAV)) THEN - i1_l = LBOUND(SrcElOutParmsData%DFNSAV,1) - i1_u = UBOUND(SrcElOutParmsData%DFNSAV,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%DFNSAV)) THEN - ALLOCATE(DstElOutParmsData%DFNSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%DFNSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%DFNSAV = SrcElOutParmsData%DFNSAV -ENDIF -IF (ALLOCATED(SrcElOutParmsData%DFTSAV)) THEN - i1_l = LBOUND(SrcElOutParmsData%DFTSAV,1) - i1_u = UBOUND(SrcElOutParmsData%DFTSAV,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%DFTSAV)) THEN - ALLOCATE(DstElOutParmsData%DFTSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%DFTSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%DFTSAV = SrcElOutParmsData%DFTSAV -ENDIF -IF (ALLOCATED(SrcElOutParmsData%DynPres)) THEN - i1_l = LBOUND(SrcElOutParmsData%DynPres,1) - i1_u = UBOUND(SrcElOutParmsData%DynPres,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%DynPres)) THEN - ALLOCATE(DstElOutParmsData%DynPres(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%DynPres.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%DynPres = SrcElOutParmsData%DynPres -ENDIF -IF (ALLOCATED(SrcElOutParmsData%PMM)) THEN - i1_l = LBOUND(SrcElOutParmsData%PMM,1) - i1_u = UBOUND(SrcElOutParmsData%PMM,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%PMM)) THEN - ALLOCATE(DstElOutParmsData%PMM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%PMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%PMM = SrcElOutParmsData%PMM -ENDIF -IF (ALLOCATED(SrcElOutParmsData%PITSAV)) THEN - i1_l = LBOUND(SrcElOutParmsData%PITSAV,1) - i1_u = UBOUND(SrcElOutParmsData%PITSAV,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%PITSAV)) THEN - ALLOCATE(DstElOutParmsData%PITSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%PITSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%PITSAV = SrcElOutParmsData%PITSAV -ENDIF -IF (ALLOCATED(SrcElOutParmsData%ReyNum)) THEN - i1_l = LBOUND(SrcElOutParmsData%ReyNum,1) - i1_u = UBOUND(SrcElOutParmsData%ReyNum,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%ReyNum)) THEN - ALLOCATE(DstElOutParmsData%ReyNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ReyNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%ReyNum = SrcElOutParmsData%ReyNum -ENDIF -IF (ALLOCATED(SrcElOutParmsData%Gamma)) THEN - i1_l = LBOUND(SrcElOutParmsData%Gamma,1) - i1_u = UBOUND(SrcElOutParmsData%Gamma,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%Gamma)) THEN - ALLOCATE(DstElOutParmsData%Gamma(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%Gamma.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%Gamma = SrcElOutParmsData%Gamma -ENDIF -IF (ALLOCATED(SrcElOutParmsData%SaveVX)) THEN - i1_l = LBOUND(SrcElOutParmsData%SaveVX,1) - i1_u = UBOUND(SrcElOutParmsData%SaveVX,1) - i2_l = LBOUND(SrcElOutParmsData%SaveVX,2) - i2_u = UBOUND(SrcElOutParmsData%SaveVX,2) - IF (.NOT. ALLOCATED(DstElOutParmsData%SaveVX)) THEN - ALLOCATE(DstElOutParmsData%SaveVX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%SaveVX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%SaveVX = SrcElOutParmsData%SaveVX -ENDIF -IF (ALLOCATED(SrcElOutParmsData%SaveVY)) THEN - i1_l = LBOUND(SrcElOutParmsData%SaveVY,1) - i1_u = UBOUND(SrcElOutParmsData%SaveVY,1) - i2_l = LBOUND(SrcElOutParmsData%SaveVY,2) - i2_u = UBOUND(SrcElOutParmsData%SaveVY,2) - IF (.NOT. ALLOCATED(DstElOutParmsData%SaveVY)) THEN - ALLOCATE(DstElOutParmsData%SaveVY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%SaveVY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%SaveVY = SrcElOutParmsData%SaveVY -ENDIF -IF (ALLOCATED(SrcElOutParmsData%SaveVZ)) THEN - i1_l = LBOUND(SrcElOutParmsData%SaveVZ,1) - i1_u = UBOUND(SrcElOutParmsData%SaveVZ,1) - i2_l = LBOUND(SrcElOutParmsData%SaveVZ,2) - i2_u = UBOUND(SrcElOutParmsData%SaveVZ,2) - IF (.NOT. ALLOCATED(DstElOutParmsData%SaveVZ)) THEN - ALLOCATE(DstElOutParmsData%SaveVZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%SaveVZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%SaveVZ = SrcElOutParmsData%SaveVZ -ENDIF - DstElOutParmsData%VXSAV = SrcElOutParmsData%VXSAV - DstElOutParmsData%VYSAV = SrcElOutParmsData%VYSAV - DstElOutParmsData%VZSAV = SrcElOutParmsData%VZSAV - DstElOutParmsData%NumWndElOut = SrcElOutParmsData%NumWndElOut -IF (ALLOCATED(SrcElOutParmsData%WndElPrList)) THEN - i1_l = LBOUND(SrcElOutParmsData%WndElPrList,1) - i1_u = UBOUND(SrcElOutParmsData%WndElPrList,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%WndElPrList)) THEN - ALLOCATE(DstElOutParmsData%WndElPrList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%WndElPrList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%WndElPrList = SrcElOutParmsData%WndElPrList -ENDIF -IF (ALLOCATED(SrcElOutParmsData%WndElPrNum)) THEN - i1_l = LBOUND(SrcElOutParmsData%WndElPrNum,1) - i1_u = UBOUND(SrcElOutParmsData%WndElPrNum,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%WndElPrNum)) THEN - ALLOCATE(DstElOutParmsData%WndElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%WndElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%WndElPrNum = SrcElOutParmsData%WndElPrNum -ENDIF -IF (ALLOCATED(SrcElOutParmsData%ElPrList)) THEN - i1_l = LBOUND(SrcElOutParmsData%ElPrList,1) - i1_u = UBOUND(SrcElOutParmsData%ElPrList,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%ElPrList)) THEN - ALLOCATE(DstElOutParmsData%ElPrList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ElPrList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%ElPrList = SrcElOutParmsData%ElPrList -ENDIF -IF (ALLOCATED(SrcElOutParmsData%ElPrNum)) THEN - i1_l = LBOUND(SrcElOutParmsData%ElPrNum,1) - i1_u = UBOUND(SrcElOutParmsData%ElPrNum,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%ElPrNum)) THEN - ALLOCATE(DstElOutParmsData%ElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%ElPrNum = SrcElOutParmsData%ElPrNum -ENDIF - DstElOutParmsData%NumElOut = SrcElOutParmsData%NumElOut - END SUBROUTINE AD14_CopyElOutParms - - SUBROUTINE AD14_DestroyElOutParms( ElOutParmsData, ErrStat, ErrMsg ) - TYPE(ElOutParms), INTENT(INOUT) :: ElOutParmsData - 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 = 'AD14_DestroyElOutParms' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ElOutParmsData%AAA)) THEN - DEALLOCATE(ElOutParmsData%AAA) -ENDIF -IF (ALLOCATED(ElOutParmsData%AAP)) THEN - DEALLOCATE(ElOutParmsData%AAP) -ENDIF -IF (ALLOCATED(ElOutParmsData%ALF)) THEN - DEALLOCATE(ElOutParmsData%ALF) -ENDIF -IF (ALLOCATED(ElOutParmsData%CDD)) THEN - DEALLOCATE(ElOutParmsData%CDD) -ENDIF -IF (ALLOCATED(ElOutParmsData%CLL)) THEN - DEALLOCATE(ElOutParmsData%CLL) -ENDIF -IF (ALLOCATED(ElOutParmsData%CMM)) THEN - DEALLOCATE(ElOutParmsData%CMM) -ENDIF -IF (ALLOCATED(ElOutParmsData%CNN)) THEN - DEALLOCATE(ElOutParmsData%CNN) -ENDIF -IF (ALLOCATED(ElOutParmsData%CTT)) THEN - DEALLOCATE(ElOutParmsData%CTT) -ENDIF -IF (ALLOCATED(ElOutParmsData%DFNSAV)) THEN - DEALLOCATE(ElOutParmsData%DFNSAV) -ENDIF -IF (ALLOCATED(ElOutParmsData%DFTSAV)) THEN - DEALLOCATE(ElOutParmsData%DFTSAV) -ENDIF -IF (ALLOCATED(ElOutParmsData%DynPres)) THEN - DEALLOCATE(ElOutParmsData%DynPres) -ENDIF -IF (ALLOCATED(ElOutParmsData%PMM)) THEN - DEALLOCATE(ElOutParmsData%PMM) -ENDIF -IF (ALLOCATED(ElOutParmsData%PITSAV)) THEN - DEALLOCATE(ElOutParmsData%PITSAV) -ENDIF -IF (ALLOCATED(ElOutParmsData%ReyNum)) THEN - DEALLOCATE(ElOutParmsData%ReyNum) -ENDIF -IF (ALLOCATED(ElOutParmsData%Gamma)) THEN - DEALLOCATE(ElOutParmsData%Gamma) -ENDIF -IF (ALLOCATED(ElOutParmsData%SaveVX)) THEN - DEALLOCATE(ElOutParmsData%SaveVX) -ENDIF -IF (ALLOCATED(ElOutParmsData%SaveVY)) THEN - DEALLOCATE(ElOutParmsData%SaveVY) -ENDIF -IF (ALLOCATED(ElOutParmsData%SaveVZ)) THEN - DEALLOCATE(ElOutParmsData%SaveVZ) -ENDIF -IF (ALLOCATED(ElOutParmsData%WndElPrList)) THEN - DEALLOCATE(ElOutParmsData%WndElPrList) -ENDIF -IF (ALLOCATED(ElOutParmsData%WndElPrNum)) THEN - DEALLOCATE(ElOutParmsData%WndElPrNum) -ENDIF -IF (ALLOCATED(ElOutParmsData%ElPrList)) THEN - DEALLOCATE(ElOutParmsData%ElPrList) -ENDIF -IF (ALLOCATED(ElOutParmsData%ElPrNum)) THEN - DEALLOCATE(ElOutParmsData%ElPrNum) -ENDIF - END SUBROUTINE AD14_DestroyElOutParms - - SUBROUTINE AD14_PackElOutParms( 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(ElOutParms), 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 = 'AD14_PackElOutParms' - ! 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 ! AAA allocated yes/no - IF ( ALLOCATED(InData%AAA) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AAA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AAA) ! AAA - END IF - Int_BufSz = Int_BufSz + 1 ! AAP allocated yes/no - IF ( ALLOCATED(InData%AAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AAP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AAP) ! AAP - END IF - Int_BufSz = Int_BufSz + 1 ! ALF allocated yes/no - IF ( ALLOCATED(InData%ALF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ALF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ALF) ! ALF - END IF - Int_BufSz = Int_BufSz + 1 ! CDD allocated yes/no - IF ( ALLOCATED(InData%CDD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CDD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CDD) ! CDD - END IF - Int_BufSz = Int_BufSz + 1 ! CLL allocated yes/no - IF ( ALLOCATED(InData%CLL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CLL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CLL) ! CLL - END IF - Int_BufSz = Int_BufSz + 1 ! CMM allocated yes/no - IF ( ALLOCATED(InData%CMM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CMM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMM) ! CMM - END IF - Int_BufSz = Int_BufSz + 1 ! CNN allocated yes/no - IF ( ALLOCATED(InData%CNN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CNN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNN) ! CNN - END IF - Int_BufSz = Int_BufSz + 1 ! CTT allocated yes/no - IF ( ALLOCATED(InData%CTT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CTT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CTT) ! CTT - END IF - Int_BufSz = Int_BufSz + 1 ! DFNSAV allocated yes/no - IF ( ALLOCATED(InData%DFNSAV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DFNSAV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DFNSAV) ! DFNSAV - END IF - Int_BufSz = Int_BufSz + 1 ! DFTSAV allocated yes/no - IF ( ALLOCATED(InData%DFTSAV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DFTSAV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DFTSAV) ! DFTSAV - END IF - Int_BufSz = Int_BufSz + 1 ! DynPres allocated yes/no - IF ( ALLOCATED(InData%DynPres) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DynPres upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DynPres) ! DynPres - END IF - Int_BufSz = Int_BufSz + 1 ! PMM allocated yes/no - IF ( ALLOCATED(InData%PMM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PMM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMM) ! PMM - END IF - Int_BufSz = Int_BufSz + 1 ! PITSAV allocated yes/no - IF ( ALLOCATED(InData%PITSAV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PITSAV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PITSAV) ! PITSAV - END IF - Int_BufSz = Int_BufSz + 1 ! ReyNum allocated yes/no - IF ( ALLOCATED(InData%ReyNum) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ReyNum upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ReyNum) ! ReyNum - END IF - Int_BufSz = Int_BufSz + 1 ! Gamma allocated yes/no - IF ( ALLOCATED(InData%Gamma) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Gamma upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma) ! Gamma - END IF - Int_BufSz = Int_BufSz + 1 ! SaveVX allocated yes/no - IF ( ALLOCATED(InData%SaveVX) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SaveVX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SaveVX) ! SaveVX - END IF - Int_BufSz = Int_BufSz + 1 ! SaveVY allocated yes/no - IF ( ALLOCATED(InData%SaveVY) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SaveVY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SaveVY) ! SaveVY - END IF - Int_BufSz = Int_BufSz + 1 ! SaveVZ allocated yes/no - IF ( ALLOCATED(InData%SaveVZ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SaveVZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SaveVZ) ! SaveVZ - END IF - Re_BufSz = Re_BufSz + 1 ! VXSAV - Re_BufSz = Re_BufSz + 1 ! VYSAV - Re_BufSz = Re_BufSz + 1 ! VZSAV - Int_BufSz = Int_BufSz + 1 ! NumWndElOut - Int_BufSz = Int_BufSz + 1 ! WndElPrList allocated yes/no - IF ( ALLOCATED(InData%WndElPrList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WndElPrList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WndElPrList) ! WndElPrList - END IF - Int_BufSz = Int_BufSz + 1 ! WndElPrNum allocated yes/no - IF ( ALLOCATED(InData%WndElPrNum) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WndElPrNum upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WndElPrNum) ! WndElPrNum - END IF - Int_BufSz = Int_BufSz + 1 ! ElPrList allocated yes/no - IF ( ALLOCATED(InData%ElPrList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElPrList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElPrList) ! ElPrList - END IF - Int_BufSz = Int_BufSz + 1 ! ElPrNum allocated yes/no - IF ( ALLOCATED(InData%ElPrNum) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElPrNum upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElPrNum) ! ElPrNum - END IF - Int_BufSz = Int_BufSz + 1 ! NumElOut - 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%AAA) ) 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%AAA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAA,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AAA,1), UBOUND(InData%AAA,1) - ReKiBuf(Re_Xferred) = InData%AAA(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AAP) ) 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%AAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AAP,1), UBOUND(InData%AAP,1) - ReKiBuf(Re_Xferred) = InData%AAP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ALF) ) 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%ALF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ALF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ALF,1), UBOUND(InData%ALF,1) - ReKiBuf(Re_Xferred) = InData%ALF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CDD) ) 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%CDD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CDD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CDD,1), UBOUND(InData%CDD,1) - ReKiBuf(Re_Xferred) = InData%CDD(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CLL) ) 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%CLL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CLL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CLL,1), UBOUND(InData%CLL,1) - ReKiBuf(Re_Xferred) = InData%CLL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMM) ) 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%CMM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CMM,1), UBOUND(InData%CMM,1) - ReKiBuf(Re_Xferred) = InData%CMM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNN) ) 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%CNN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CNN,1), UBOUND(InData%CNN,1) - ReKiBuf(Re_Xferred) = InData%CNN(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CTT) ) 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%CTT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CTT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CTT,1), UBOUND(InData%CTT,1) - ReKiBuf(Re_Xferred) = InData%CTT(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DFNSAV) ) 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%DFNSAV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFNSAV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DFNSAV,1), UBOUND(InData%DFNSAV,1) - ReKiBuf(Re_Xferred) = InData%DFNSAV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DFTSAV) ) 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%DFTSAV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFTSAV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DFTSAV,1), UBOUND(InData%DFTSAV,1) - ReKiBuf(Re_Xferred) = InData%DFTSAV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DynPres) ) 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%DynPres,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DynPres,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DynPres,1), UBOUND(InData%DynPres,1) - ReKiBuf(Re_Xferred) = InData%DynPres(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMM) ) 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%PMM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PMM,1), UBOUND(InData%PMM,1) - ReKiBuf(Re_Xferred) = InData%PMM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PITSAV) ) 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%PITSAV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PITSAV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PITSAV,1), UBOUND(InData%PITSAV,1) - ReKiBuf(Re_Xferred) = InData%PITSAV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ReyNum) ) 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%ReyNum,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ReyNum,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ReyNum,1), UBOUND(InData%ReyNum,1) - ReKiBuf(Re_Xferred) = InData%ReyNum(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gamma) ) 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%Gamma,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Gamma,1), UBOUND(InData%Gamma,1) - ReKiBuf(Re_Xferred) = InData%Gamma(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SaveVX) ) 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%SaveVX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SaveVX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVX,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SaveVX,2), UBOUND(InData%SaveVX,2) - DO i1 = LBOUND(InData%SaveVX,1), UBOUND(InData%SaveVX,1) - ReKiBuf(Re_Xferred) = InData%SaveVX(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SaveVY) ) 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%SaveVY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVY,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SaveVY,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVY,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SaveVY,2), UBOUND(InData%SaveVY,2) - DO i1 = LBOUND(InData%SaveVY,1), UBOUND(InData%SaveVY,1) - ReKiBuf(Re_Xferred) = InData%SaveVY(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SaveVZ) ) 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%SaveVZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVZ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SaveVZ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVZ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SaveVZ,2), UBOUND(InData%SaveVZ,2) - DO i1 = LBOUND(InData%SaveVZ,1), UBOUND(InData%SaveVZ,1) - ReKiBuf(Re_Xferred) = InData%SaveVZ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%VXSAV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VYSAV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VZSAV - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumWndElOut - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WndElPrList) ) 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%WndElPrList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WndElPrList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WndElPrList,1), UBOUND(InData%WndElPrList,1) - IntKiBuf(Int_Xferred) = InData%WndElPrList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WndElPrNum) ) 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%WndElPrNum,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WndElPrNum,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WndElPrNum,1), UBOUND(InData%WndElPrNum,1) - IntKiBuf(Int_Xferred) = InData%WndElPrNum(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElPrList) ) 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%ElPrList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ElPrList,1), UBOUND(InData%ElPrList,1) - IntKiBuf(Int_Xferred) = InData%ElPrList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElPrNum) ) 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%ElPrNum,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrNum,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ElPrNum,1), UBOUND(InData%ElPrNum,1) - IntKiBuf(Int_Xferred) = InData%ElPrNum(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumElOut - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_PackElOutParms - - SUBROUTINE AD14_UnPackElOutParms( 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(ElOutParms), 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 = 'AD14_UnPackElOutParms' - ! 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 ! AAA 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%AAA)) DEALLOCATE(OutData%AAA) - ALLOCATE(OutData%AAA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AAA,1), UBOUND(OutData%AAA,1) - OutData%AAA(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AAP 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%AAP)) DEALLOCATE(OutData%AAP) - ALLOCATE(OutData%AAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AAP,1), UBOUND(OutData%AAP,1) - OutData%AAP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ALF 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%ALF)) DEALLOCATE(OutData%ALF) - ALLOCATE(OutData%ALF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ALF,1), UBOUND(OutData%ALF,1) - OutData%ALF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CDD 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%CDD)) DEALLOCATE(OutData%CDD) - ALLOCATE(OutData%CDD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CDD,1), UBOUND(OutData%CDD,1) - OutData%CDD(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CLL 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%CLL)) DEALLOCATE(OutData%CLL) - ALLOCATE(OutData%CLL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CLL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CLL,1), UBOUND(OutData%CLL,1) - OutData%CLL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMM 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%CMM)) DEALLOCATE(OutData%CMM) - ALLOCATE(OutData%CMM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CMM,1), UBOUND(OutData%CMM,1) - OutData%CMM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNN 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%CNN)) DEALLOCATE(OutData%CNN) - ALLOCATE(OutData%CNN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CNN,1), UBOUND(OutData%CNN,1) - OutData%CNN(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CTT 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%CTT)) DEALLOCATE(OutData%CTT) - ALLOCATE(OutData%CTT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CTT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CTT,1), UBOUND(OutData%CTT,1) - OutData%CTT(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFNSAV 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%DFNSAV)) DEALLOCATE(OutData%DFNSAV) - ALLOCATE(OutData%DFNSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFNSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DFNSAV,1), UBOUND(OutData%DFNSAV,1) - OutData%DFNSAV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFTSAV 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%DFTSAV)) DEALLOCATE(OutData%DFTSAV) - ALLOCATE(OutData%DFTSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFTSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DFTSAV,1), UBOUND(OutData%DFTSAV,1) - OutData%DFTSAV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DynPres 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%DynPres)) DEALLOCATE(OutData%DynPres) - ALLOCATE(OutData%DynPres(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DynPres.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DynPres,1), UBOUND(OutData%DynPres,1) - OutData%DynPres(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMM 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%PMM)) DEALLOCATE(OutData%PMM) - ALLOCATE(OutData%PMM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PMM,1), UBOUND(OutData%PMM,1) - OutData%PMM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PITSAV 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%PITSAV)) DEALLOCATE(OutData%PITSAV) - ALLOCATE(OutData%PITSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PITSAV,1), UBOUND(OutData%PITSAV,1) - OutData%PITSAV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ReyNum 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%ReyNum)) DEALLOCATE(OutData%ReyNum) - ALLOCATE(OutData%ReyNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReyNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ReyNum,1), UBOUND(OutData%ReyNum,1) - OutData%ReyNum(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma 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%Gamma)) DEALLOCATE(OutData%Gamma) - ALLOCATE(OutData%Gamma(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Gamma,1), UBOUND(OutData%Gamma,1) - OutData%Gamma(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVX 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%SaveVX)) DEALLOCATE(OutData%SaveVX) - ALLOCATE(OutData%SaveVX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SaveVX,2), UBOUND(OutData%SaveVX,2) - DO i1 = LBOUND(OutData%SaveVX,1), UBOUND(OutData%SaveVX,1) - OutData%SaveVX(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVY 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%SaveVY)) DEALLOCATE(OutData%SaveVY) - ALLOCATE(OutData%SaveVY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SaveVY,2), UBOUND(OutData%SaveVY,2) - DO i1 = LBOUND(OutData%SaveVY,1), UBOUND(OutData%SaveVY,1) - OutData%SaveVY(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVZ 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%SaveVZ)) DEALLOCATE(OutData%SaveVZ) - ALLOCATE(OutData%SaveVZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SaveVZ,2), UBOUND(OutData%SaveVZ,2) - DO i1 = LBOUND(OutData%SaveVZ,1), UBOUND(OutData%SaveVZ,1) - OutData%SaveVZ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%VXSAV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VYSAV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VZSAV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumWndElOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WndElPrList 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%WndElPrList)) DEALLOCATE(OutData%WndElPrList) - ALLOCATE(OutData%WndElPrList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WndElPrList,1), UBOUND(OutData%WndElPrList,1) - OutData%WndElPrList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WndElPrNum 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%WndElPrNum)) DEALLOCATE(OutData%WndElPrNum) - ALLOCATE(OutData%WndElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WndElPrNum,1), UBOUND(OutData%WndElPrNum,1) - OutData%WndElPrNum(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrList 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%ElPrList)) DEALLOCATE(OutData%ElPrList) - ALLOCATE(OutData%ElPrList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElPrList,1), UBOUND(OutData%ElPrList,1) - OutData%ElPrList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrNum 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%ElPrNum)) DEALLOCATE(OutData%ElPrNum) - ALLOCATE(OutData%ElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElPrNum,1), UBOUND(OutData%ElPrNum,1) - OutData%ElPrNum(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NumElOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_UnPackElOutParms - SUBROUTINE AD14_CopyInducedVel( SrcInducedVelData, DstInducedVelData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InducedVel), INTENT(IN) :: SrcInducedVelData - TYPE(InducedVel), INTENT(INOUT) :: DstInducedVelData - 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 = 'AD14_CopyInducedVel' -! +subroutine AD14_CopyMarker(SrcMarkerData, DstMarkerData, CtrlCode, ErrStat, ErrMsg) + type(Marker), intent(in) :: SrcMarkerData + type(Marker), intent(inout) :: DstMarkerData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyMarker' ErrStat = ErrID_None - ErrMsg = "" - DstInducedVelData%SumInFl = SrcInducedVelData%SumInFl - END SUBROUTINE AD14_CopyInducedVel - - SUBROUTINE AD14_DestroyInducedVel( InducedVelData, ErrStat, ErrMsg ) - TYPE(InducedVel), INTENT(INOUT) :: InducedVelData - 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 = 'AD14_DestroyInducedVel' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyInducedVel - - SUBROUTINE AD14_PackInducedVel( 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(InducedVel), 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 = 'AD14_PackInducedVel' - ! 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 ! SumInFl - 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%SumInFl - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackInducedVel - - SUBROUTINE AD14_UnPackInducedVel( 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(InducedVel), 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 = 'AD14_UnPackInducedVel' - ! 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%SumInFl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackInducedVel - - SUBROUTINE AD14_CopyInducedVelParms( SrcInducedVelParmsData, DstInducedVelParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InducedVelParms), INTENT(IN) :: SrcInducedVelParmsData - TYPE(InducedVelParms), INTENT(INOUT) :: DstInducedVelParmsData - 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 = 'AD14_CopyInducedVelParms' -! + ErrMsg = '' + DstMarkerData%Position = SrcMarkerData%Position + DstMarkerData%Orientation = SrcMarkerData%Orientation + DstMarkerData%TranslationVel = SrcMarkerData%TranslationVel + DstMarkerData%RotationVel = SrcMarkerData%RotationVel +end subroutine + +subroutine AD14_DestroyMarker(MarkerData, ErrStat, ErrMsg) + type(Marker), intent(inout) :: MarkerData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyMarker' ErrStat = ErrID_None - ErrMsg = "" - DstInducedVelParmsData%AToler = SrcInducedVelParmsData%AToler - DstInducedVelParmsData%EqAIDmult = SrcInducedVelParmsData%EqAIDmult - DstInducedVelParmsData%EquilDA = SrcInducedVelParmsData%EquilDA - DstInducedVelParmsData%EquilDT = SrcInducedVelParmsData%EquilDT - DstInducedVelParmsData%TLoss = SrcInducedVelParmsData%TLoss - DstInducedVelParmsData%GTech = SrcInducedVelParmsData%GTech - DstInducedVelParmsData%HLoss = SrcInducedVelParmsData%HLoss - END SUBROUTINE AD14_CopyInducedVelParms - - SUBROUTINE AD14_DestroyInducedVelParms( InducedVelParmsData, ErrStat, ErrMsg ) - TYPE(InducedVelParms), INTENT(INOUT) :: InducedVelParmsData - 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 = 'AD14_DestroyInducedVelParms' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyInducedVelParms - - SUBROUTINE AD14_PackInducedVelParms( 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(InducedVelParms), 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 = 'AD14_PackInducedVelParms' - ! 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 ! AToler - Re_BufSz = Re_BufSz + 1 ! EqAIDmult - Int_BufSz = Int_BufSz + 1 ! EquilDA - Int_BufSz = Int_BufSz + 1 ! EquilDT - Int_BufSz = Int_BufSz + 1 ! TLoss - Int_BufSz = Int_BufSz + 1 ! GTech - Int_BufSz = Int_BufSz + 1 ! HLoss - 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%AToler - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%EqAIDmult - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilDA, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilDT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GTech, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_PackInducedVelParms - - SUBROUTINE AD14_UnPackInducedVelParms( 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(InducedVelParms), 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 = 'AD14_UnPackInducedVelParms' - ! 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%AToler = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%EqAIDmult = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%EquilDA = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilDA) - Int_Xferred = Int_Xferred + 1 - OutData%EquilDT = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilDT) - Int_Xferred = Int_Xferred + 1 - OutData%TLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%TLoss) - Int_Xferred = Int_Xferred + 1 - OutData%GTech = TRANSFER(IntKiBuf(Int_Xferred), OutData%GTech) - Int_Xferred = Int_Xferred + 1 - OutData%HLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%HLoss) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_UnPackInducedVelParms - - SUBROUTINE AD14_CopyRotor( SrcRotorData, DstRotorData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Rotor), INTENT(IN) :: SrcRotorData - TYPE(Rotor), INTENT(INOUT) :: DstRotorData - 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 = 'AD14_CopyRotor' -! + ErrMsg = '' +end subroutine + +subroutine AD14_PackMarker(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Marker), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackMarker' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Position) + call RegPack(Buf, InData%Orientation) + call RegPack(Buf, InData%TranslationVel) + call RegPack(Buf, InData%RotationVel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackMarker(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Marker), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackMarker' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Position) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Orientation) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TranslationVel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotationVel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyAeroConfig(SrcAeroConfigData, DstAeroConfigData, CtrlCode, ErrStat, ErrMsg) + type(AeroConfig), intent(in) :: SrcAeroConfigData + type(AeroConfig), intent(inout) :: DstAeroConfigData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyAeroConfig' ErrStat = ErrID_None - ErrMsg = "" - DstRotorData%AVGINFL = SrcRotorData%AVGINFL - DstRotorData%CTILT = SrcRotorData%CTILT - DstRotorData%CYaw = SrcRotorData%CYaw - DstRotorData%REVS = SrcRotorData%REVS - DstRotorData%STILT = SrcRotorData%STILT - DstRotorData%SYaw = SrcRotorData%SYaw - DstRotorData%TILT = SrcRotorData%TILT - DstRotorData%YawAng = SrcRotorData%YawAng - DstRotorData%YawVEL = SrcRotorData%YawVEL - END SUBROUTINE AD14_CopyRotor - - SUBROUTINE AD14_DestroyRotor( RotorData, ErrStat, ErrMsg ) - TYPE(Rotor), INTENT(INOUT) :: RotorData - 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 = 'AD14_DestroyRotor' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyRotor - - SUBROUTINE AD14_PackRotor( 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(Rotor), 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 = 'AD14_PackRotor' - ! 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 ! AVGINFL - Re_BufSz = Re_BufSz + 1 ! CTILT - Re_BufSz = Re_BufSz + 1 ! CYaw - Re_BufSz = Re_BufSz + 1 ! REVS - Re_BufSz = Re_BufSz + 1 ! STILT - Re_BufSz = Re_BufSz + 1 ! SYaw - Re_BufSz = Re_BufSz + 1 ! TILT - Re_BufSz = Re_BufSz + 1 ! YawAng - Re_BufSz = Re_BufSz + 1 ! YawVEL - 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%AVGINFL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CTILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%REVS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%STILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawAng - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawVEL - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackRotor - - SUBROUTINE AD14_UnPackRotor( 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(Rotor), 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 = 'AD14_UnPackRotor' - ! 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%AVGINFL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CTILT = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%REVS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%STILT = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TILT = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawAng = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawVEL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackRotor - - SUBROUTINE AD14_CopyRotorParms( SrcRotorParmsData, DstRotorParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotorParms), INTENT(IN) :: SrcRotorParmsData - TYPE(RotorParms), INTENT(INOUT) :: DstRotorParmsData - 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 = 'AD14_CopyRotorParms' -! + ErrMsg = '' + if (allocated(SrcAeroConfigData%Blade)) then + LB(1:1) = lbound(SrcAeroConfigData%Blade) + UB(1:1) = ubound(SrcAeroConfigData%Blade) + if (.not. allocated(DstAeroConfigData%Blade)) then + allocate(DstAeroConfigData%Blade(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroConfigData%Blade.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD14_CopyMarker(SrcAeroConfigData%Blade(i1), DstAeroConfigData%Blade(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call AD14_CopyMarker(SrcAeroConfigData%Hub, DstAeroConfigData%Hub, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyMarker(SrcAeroConfigData%RotorFurl, DstAeroConfigData%RotorFurl, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyMarker(SrcAeroConfigData%Nacelle, DstAeroConfigData%Nacelle, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyMarker(SrcAeroConfigData%TailFin, DstAeroConfigData%TailFin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyMarker(SrcAeroConfigData%Tower, DstAeroConfigData%Tower, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyMarker(SrcAeroConfigData%SubStructure, DstAeroConfigData%SubStructure, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyMarker(SrcAeroConfigData%Foundation, DstAeroConfigData%Foundation, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstAeroConfigData%BladeLength = SrcAeroConfigData%BladeLength +end subroutine + +subroutine AD14_DestroyAeroConfig(AeroConfigData, ErrStat, ErrMsg) + type(AeroConfig), intent(inout) :: AeroConfigData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyAeroConfig' ErrStat = ErrID_None - ErrMsg = "" - DstRotorParmsData%HH = SrcRotorParmsData%HH - END SUBROUTINE AD14_CopyRotorParms - - SUBROUTINE AD14_DestroyRotorParms( RotorParmsData, ErrStat, ErrMsg ) - TYPE(RotorParms), INTENT(INOUT) :: RotorParmsData - 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 = 'AD14_DestroyRotorParms' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyRotorParms - - SUBROUTINE AD14_PackRotorParms( 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(RotorParms), 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 = 'AD14_PackRotorParms' - ! 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 ! HH - 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%HH - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackRotorParms - - SUBROUTINE AD14_UnPackRotorParms( 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(RotorParms), 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 = 'AD14_UnPackRotorParms' - ! 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%HH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackRotorParms - - SUBROUTINE AD14_CopyTwrPropsParms( SrcTwrPropsParmsData, DstTwrPropsParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TwrPropsParms), INTENT(IN) :: SrcTwrPropsParmsData - TYPE(TwrPropsParms), INTENT(INOUT) :: DstTwrPropsParmsData - 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 = 'AD14_CopyTwrPropsParms' -! + ErrMsg = '' + if (allocated(AeroConfigData%Blade)) then + LB(1:1) = lbound(AeroConfigData%Blade) + UB(1:1) = ubound(AeroConfigData%Blade) + do i1 = LB(1), UB(1) + call AD14_DestroyMarker(AeroConfigData%Blade(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroConfigData%Blade) + end if + call AD14_DestroyMarker(AeroConfigData%Hub, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyMarker(AeroConfigData%RotorFurl, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyMarker(AeroConfigData%Nacelle, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyMarker(AeroConfigData%TailFin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyMarker(AeroConfigData%Tower, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyMarker(AeroConfigData%SubStructure, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyMarker(AeroConfigData%Foundation, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD14_PackAeroConfig(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AeroConfig), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackAeroConfig' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Blade)) + if (allocated(InData%Blade)) then + call RegPackBounds(Buf, 1, lbound(InData%Blade), ubound(InData%Blade)) + LB(1:1) = lbound(InData%Blade) + UB(1:1) = ubound(InData%Blade) + do i1 = LB(1), UB(1) + call AD14_PackMarker(Buf, InData%Blade(i1)) + end do + end if + call AD14_PackMarker(Buf, InData%Hub) + call AD14_PackMarker(Buf, InData%RotorFurl) + call AD14_PackMarker(Buf, InData%Nacelle) + call AD14_PackMarker(Buf, InData%TailFin) + call AD14_PackMarker(Buf, InData%Tower) + call AD14_PackMarker(Buf, InData%SubStructure) + call AD14_PackMarker(Buf, InData%Foundation) + call RegPack(Buf, InData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackAeroConfig(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AeroConfig), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackAeroConfig' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Blade)) deallocate(OutData%Blade) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Blade(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Blade.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD14_UnpackMarker(Buf, OutData%Blade(i1)) ! Blade + end do + end if + call AD14_UnpackMarker(Buf, OutData%Hub) ! Hub + call AD14_UnpackMarker(Buf, OutData%RotorFurl) ! RotorFurl + call AD14_UnpackMarker(Buf, OutData%Nacelle) ! Nacelle + call AD14_UnpackMarker(Buf, OutData%TailFin) ! TailFin + call AD14_UnpackMarker(Buf, OutData%Tower) ! Tower + call AD14_UnpackMarker(Buf, OutData%SubStructure) ! SubStructure + call AD14_UnpackMarker(Buf, OutData%Foundation) ! Foundation + call RegUnpack(Buf, OutData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyAirFoil(SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, ErrMsg) + type(AirFoil), intent(in) :: SrcAirFoilData + type(AirFoil), intent(inout) :: DstAirFoilData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyAirFoil' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcTwrPropsParmsData%TwrHtFr)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%TwrHtFr,1) - i1_u = UBOUND(SrcTwrPropsParmsData%TwrHtFr,1) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%TwrHtFr)) THEN - ALLOCATE(DstTwrPropsParmsData%TwrHtFr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrHtFr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%TwrHtFr = SrcTwrPropsParmsData%TwrHtFr -ENDIF -IF (ALLOCATED(SrcTwrPropsParmsData%TwrWid)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%TwrWid,1) - i1_u = UBOUND(SrcTwrPropsParmsData%TwrWid,1) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%TwrWid)) THEN - ALLOCATE(DstTwrPropsParmsData%TwrWid(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrWid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%TwrWid = SrcTwrPropsParmsData%TwrWid -ENDIF -IF (ALLOCATED(SrcTwrPropsParmsData%TwrCD)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%TwrCD,1) - i1_u = UBOUND(SrcTwrPropsParmsData%TwrCD,1) - i2_l = LBOUND(SrcTwrPropsParmsData%TwrCD,2) - i2_u = UBOUND(SrcTwrPropsParmsData%TwrCD,2) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%TwrCD)) THEN - ALLOCATE(DstTwrPropsParmsData%TwrCD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%TwrCD = SrcTwrPropsParmsData%TwrCD -ENDIF -IF (ALLOCATED(SrcTwrPropsParmsData%TwrRe)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%TwrRe,1) - i1_u = UBOUND(SrcTwrPropsParmsData%TwrRe,1) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%TwrRe)) THEN - ALLOCATE(DstTwrPropsParmsData%TwrRe(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrRe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%TwrRe = SrcTwrPropsParmsData%TwrRe -ENDIF - DstTwrPropsParmsData%VTwr = SrcTwrPropsParmsData%VTwr - DstTwrPropsParmsData%Tower_Wake_Constant = SrcTwrPropsParmsData%Tower_Wake_Constant -IF (ALLOCATED(SrcTwrPropsParmsData%NTwrCDCol)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%NTwrCDCol,1) - i1_u = UBOUND(SrcTwrPropsParmsData%NTwrCDCol,1) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%NTwrCDCol)) THEN - ALLOCATE(DstTwrPropsParmsData%NTwrCDCol(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%NTwrCDCol.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%NTwrCDCol = SrcTwrPropsParmsData%NTwrCDCol -ENDIF - DstTwrPropsParmsData%NTwrHT = SrcTwrPropsParmsData%NTwrHT - DstTwrPropsParmsData%NTwrRe = SrcTwrPropsParmsData%NTwrRe - DstTwrPropsParmsData%NTwrCD = SrcTwrPropsParmsData%NTwrCD - DstTwrPropsParmsData%TwrPotent = SrcTwrPropsParmsData%TwrPotent - DstTwrPropsParmsData%TwrShadow = SrcTwrPropsParmsData%TwrShadow - DstTwrPropsParmsData%ShadHWid = SrcTwrPropsParmsData%ShadHWid - DstTwrPropsParmsData%TShadC1 = SrcTwrPropsParmsData%TShadC1 - DstTwrPropsParmsData%TShadC2 = SrcTwrPropsParmsData%TShadC2 - DstTwrPropsParmsData%TwrShad = SrcTwrPropsParmsData%TwrShad - DstTwrPropsParmsData%PJM_Version = SrcTwrPropsParmsData%PJM_Version - DstTwrPropsParmsData%TwrFile = SrcTwrPropsParmsData%TwrFile - DstTwrPropsParmsData%T_Shad_Refpt = SrcTwrPropsParmsData%T_Shad_Refpt - DstTwrPropsParmsData%CalcTwrAero = SrcTwrPropsParmsData%CalcTwrAero - DstTwrPropsParmsData%NumTwrNodes = SrcTwrPropsParmsData%NumTwrNodes -IF (ALLOCATED(SrcTwrPropsParmsData%TwrNodeWidth)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%TwrNodeWidth,1) - i1_u = UBOUND(SrcTwrPropsParmsData%TwrNodeWidth,1) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%TwrNodeWidth)) THEN - ALLOCATE(DstTwrPropsParmsData%TwrNodeWidth(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrNodeWidth.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%TwrNodeWidth = SrcTwrPropsParmsData%TwrNodeWidth -ENDIF - END SUBROUTINE AD14_CopyTwrPropsParms - - SUBROUTINE AD14_DestroyTwrPropsParms( TwrPropsParmsData, ErrStat, ErrMsg ) - TYPE(TwrPropsParms), INTENT(INOUT) :: TwrPropsParmsData - 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 = 'AD14_DestroyTwrPropsParms' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(TwrPropsParmsData%TwrHtFr)) THEN - DEALLOCATE(TwrPropsParmsData%TwrHtFr) -ENDIF -IF (ALLOCATED(TwrPropsParmsData%TwrWid)) THEN - DEALLOCATE(TwrPropsParmsData%TwrWid) -ENDIF -IF (ALLOCATED(TwrPropsParmsData%TwrCD)) THEN - DEALLOCATE(TwrPropsParmsData%TwrCD) -ENDIF -IF (ALLOCATED(TwrPropsParmsData%TwrRe)) THEN - DEALLOCATE(TwrPropsParmsData%TwrRe) -ENDIF -IF (ALLOCATED(TwrPropsParmsData%NTwrCDCol)) THEN - DEALLOCATE(TwrPropsParmsData%NTwrCDCol) -ENDIF -IF (ALLOCATED(TwrPropsParmsData%TwrNodeWidth)) THEN - DEALLOCATE(TwrPropsParmsData%TwrNodeWidth) -ENDIF - END SUBROUTINE AD14_DestroyTwrPropsParms - - SUBROUTINE AD14_PackTwrPropsParms( 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(TwrPropsParms), 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 = 'AD14_PackTwrPropsParms' - ! 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 ! TwrHtFr allocated yes/no - IF ( ALLOCATED(InData%TwrHtFr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrHtFr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrHtFr) ! TwrHtFr - END IF - Int_BufSz = Int_BufSz + 1 ! TwrWid allocated yes/no - IF ( ALLOCATED(InData%TwrWid) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrWid upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrWid) ! TwrWid - END IF - Int_BufSz = Int_BufSz + 1 ! TwrCD allocated yes/no - IF ( ALLOCATED(InData%TwrCD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TwrCD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCD) ! TwrCD - END IF - Int_BufSz = Int_BufSz + 1 ! TwrRe allocated yes/no - IF ( ALLOCATED(InData%TwrRe) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrRe upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrRe) ! TwrRe - END IF - Re_BufSz = Re_BufSz + SIZE(InData%VTwr) ! VTwr - Re_BufSz = Re_BufSz + 1 ! Tower_Wake_Constant - Int_BufSz = Int_BufSz + 1 ! NTwrCDCol allocated yes/no - IF ( ALLOCATED(InData%NTwrCDCol) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NTwrCDCol upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NTwrCDCol) ! NTwrCDCol - END IF - Int_BufSz = Int_BufSz + 1 ! NTwrHT - Int_BufSz = Int_BufSz + 1 ! NTwrRe - Int_BufSz = Int_BufSz + 1 ! NTwrCD - Int_BufSz = Int_BufSz + 1 ! TwrPotent - Int_BufSz = Int_BufSz + 1 ! TwrShadow - Re_BufSz = Re_BufSz + 1 ! ShadHWid - Re_BufSz = Re_BufSz + 1 ! TShadC1 - Re_BufSz = Re_BufSz + 1 ! TShadC2 - Re_BufSz = Re_BufSz + 1 ! TwrShad - Int_BufSz = Int_BufSz + 1 ! PJM_Version - Int_BufSz = Int_BufSz + 1*LEN(InData%TwrFile) ! TwrFile - Re_BufSz = Re_BufSz + 1 ! T_Shad_Refpt - Int_BufSz = Int_BufSz + 1 ! CalcTwrAero - Int_BufSz = Int_BufSz + 1 ! NumTwrNodes - Int_BufSz = Int_BufSz + 1 ! TwrNodeWidth allocated yes/no - IF ( ALLOCATED(InData%TwrNodeWidth) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrNodeWidth upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrNodeWidth) ! TwrNodeWidth - 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%TwrHtFr) ) 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%TwrHtFr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrHtFr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrHtFr,1), UBOUND(InData%TwrHtFr,1) - ReKiBuf(Re_Xferred) = InData%TwrHtFr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrWid) ) 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%TwrWid,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrWid,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrWid,1), UBOUND(InData%TwrWid,1) - ReKiBuf(Re_Xferred) = InData%TwrWid(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrCD) ) 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%TwrCD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TwrCD,2), UBOUND(InData%TwrCD,2) - DO i1 = LBOUND(InData%TwrCD,1), UBOUND(InData%TwrCD,1) - ReKiBuf(Re_Xferred) = InData%TwrCD(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrRe) ) 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%TwrRe,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrRe,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrRe,1), UBOUND(InData%TwrRe,1) - ReKiBuf(Re_Xferred) = InData%TwrRe(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%VTwr,1), UBOUND(InData%VTwr,1) - ReKiBuf(Re_Xferred) = InData%VTwr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Tower_Wake_Constant - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NTwrCDCol) ) 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%NTwrCDCol,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NTwrCDCol,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NTwrCDCol,1), UBOUND(InData%NTwrCDCol,1) - IntKiBuf(Int_Xferred) = InData%NTwrCDCol(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NTwrHT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NTwrRe - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NTwrCD - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrPotent, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadow, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShadHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TShadC1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TShadC2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TwrShad - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PJM_Version, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%TwrFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%TwrFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%T_Shad_Refpt - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CalcTwrAero, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTwrNodes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TwrNodeWidth) ) 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%TwrNodeWidth,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrNodeWidth,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrNodeWidth,1), UBOUND(InData%TwrNodeWidth,1) - ReKiBuf(Re_Xferred) = InData%TwrNodeWidth(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD14_PackTwrPropsParms - - SUBROUTINE AD14_UnPackTwrPropsParms( 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(TwrPropsParms), 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 = 'AD14_UnPackTwrPropsParms' - ! 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 ! TwrHtFr 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%TwrHtFr)) DEALLOCATE(OutData%TwrHtFr) - ALLOCATE(OutData%TwrHtFr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHtFr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrHtFr,1), UBOUND(OutData%TwrHtFr,1) - OutData%TwrHtFr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrWid 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%TwrWid)) DEALLOCATE(OutData%TwrWid) - ALLOCATE(OutData%TwrWid(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrWid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrWid,1), UBOUND(OutData%TwrWid,1) - OutData%TwrWid(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCD 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%TwrCD)) DEALLOCATE(OutData%TwrCD) - ALLOCATE(OutData%TwrCD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TwrCD,2), UBOUND(OutData%TwrCD,2) - DO i1 = LBOUND(OutData%TwrCD,1), UBOUND(OutData%TwrCD,1) - OutData%TwrCD(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrRe 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%TwrRe)) DEALLOCATE(OutData%TwrRe) - ALLOCATE(OutData%TwrRe(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrRe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrRe,1), UBOUND(OutData%TwrRe,1) - OutData%TwrRe(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%VTwr,1) - i1_u = UBOUND(OutData%VTwr,1) - DO i1 = LBOUND(OutData%VTwr,1), UBOUND(OutData%VTwr,1) - OutData%VTwr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Tower_Wake_Constant = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NTwrCDCol 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%NTwrCDCol)) DEALLOCATE(OutData%NTwrCDCol) - ALLOCATE(OutData%NTwrCDCol(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTwrCDCol.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NTwrCDCol,1), UBOUND(OutData%NTwrCDCol,1) - OutData%NTwrCDCol(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NTwrHT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NTwrRe = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NTwrCD = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrPotent) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadow) - Int_Xferred = Int_Xferred + 1 - OutData%ShadHWid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TShadC1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TShadC2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TwrShad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PJM_Version = TRANSFER(IntKiBuf(Int_Xferred), OutData%PJM_Version) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%TwrFile) - OutData%TwrFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%T_Shad_Refpt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CalcTwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%CalcTwrAero) - Int_Xferred = Int_Xferred + 1 - OutData%NumTwrNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrNodeWidth 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%TwrNodeWidth)) DEALLOCATE(OutData%TwrNodeWidth) - ALLOCATE(OutData%TwrNodeWidth(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeWidth.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrNodeWidth,1), UBOUND(OutData%TwrNodeWidth,1) - OutData%TwrNodeWidth(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD14_UnPackTwrPropsParms - - SUBROUTINE AD14_CopyWind( SrcWindData, DstWindData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wind), INTENT(IN) :: SrcWindData - TYPE(Wind), INTENT(INOUT) :: DstWindData - 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 = 'AD14_CopyWind' -! + ErrMsg = '' + if (allocated(SrcAirFoilData%AL)) then + LB(1:2) = lbound(SrcAirFoilData%AL) + UB(1:2) = ubound(SrcAirFoilData%AL) + if (.not. allocated(DstAirFoilData%AL)) then + allocate(DstAirFoilData%AL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%AL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilData%AL = SrcAirFoilData%AL + end if + if (allocated(SrcAirFoilData%CD)) then + LB(1:3) = lbound(SrcAirFoilData%CD) + UB(1:3) = ubound(SrcAirFoilData%CD) + if (.not. allocated(DstAirFoilData%CD)) then + allocate(DstAirFoilData%CD(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%CD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilData%CD = SrcAirFoilData%CD + end if + if (allocated(SrcAirFoilData%CL)) then + LB(1:3) = lbound(SrcAirFoilData%CL) + UB(1:3) = ubound(SrcAirFoilData%CL) + if (.not. allocated(DstAirFoilData%CL)) then + allocate(DstAirFoilData%CL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%CL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilData%CL = SrcAirFoilData%CL + end if + if (allocated(SrcAirFoilData%CM)) then + LB(1:3) = lbound(SrcAirFoilData%CM) + UB(1:3) = ubound(SrcAirFoilData%CM) + if (.not. allocated(DstAirFoilData%CM)) then + allocate(DstAirFoilData%CM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%CM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilData%CM = SrcAirFoilData%CM + end if + DstAirFoilData%PMC = SrcAirFoilData%PMC + DstAirFoilData%MulTabLoc = SrcAirFoilData%MulTabLoc +end subroutine + +subroutine AD14_DestroyAirFoil(AirFoilData, ErrStat, ErrMsg) + type(AirFoil), intent(inout) :: AirFoilData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyAirFoil' ErrStat = ErrID_None - ErrMsg = "" - DstWindData%ANGFLW = SrcWindData%ANGFLW - DstWindData%CDEL = SrcWindData%CDEL - DstWindData%VROTORX = SrcWindData%VROTORX - DstWindData%VROTORY = SrcWindData%VROTORY - DstWindData%VROTORZ = SrcWindData%VROTORZ - DstWindData%SDEL = SrcWindData%SDEL - END SUBROUTINE AD14_CopyWind - - SUBROUTINE AD14_DestroyWind( WindData, ErrStat, ErrMsg ) - TYPE(Wind), INTENT(INOUT) :: WindData - 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 = 'AD14_DestroyWind' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyWind - - SUBROUTINE AD14_PackWind( 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(Wind), 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 = 'AD14_PackWind' - ! 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 ! ANGFLW - Re_BufSz = Re_BufSz + 1 ! CDEL - Re_BufSz = Re_BufSz + 1 ! VROTORX - Re_BufSz = Re_BufSz + 1 ! VROTORY - Re_BufSz = Re_BufSz + 1 ! VROTORZ - Re_BufSz = Re_BufSz + 1 ! SDEL - 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%ANGFLW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CDEL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VROTORX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VROTORY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VROTORZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SDEL - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackWind - - SUBROUTINE AD14_UnPackWind( 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(Wind), 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 = 'AD14_UnPackWind' - ! 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%ANGFLW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CDEL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SDEL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackWind - - SUBROUTINE AD14_CopyWindParms( SrcWindParmsData, DstWindParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WindParms), INTENT(IN) :: SrcWindParmsData - TYPE(WindParms), INTENT(INOUT) :: DstWindParmsData - 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 = 'AD14_CopyWindParms' -! + ErrMsg = '' + if (allocated(AirFoilData%AL)) then + deallocate(AirFoilData%AL) + end if + if (allocated(AirFoilData%CD)) then + deallocate(AirFoilData%CD) + end if + if (allocated(AirFoilData%CL)) then + deallocate(AirFoilData%CL) + end if + if (allocated(AirFoilData%CM)) then + deallocate(AirFoilData%CM) + end if +end subroutine + +subroutine AD14_PackAirFoil(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AirFoil), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackAirFoil' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%AL)) + if (allocated(InData%AL)) then + call RegPackBounds(Buf, 2, lbound(InData%AL), ubound(InData%AL)) + call RegPack(Buf, InData%AL) + end if + call RegPack(Buf, allocated(InData%CD)) + if (allocated(InData%CD)) then + call RegPackBounds(Buf, 3, lbound(InData%CD), ubound(InData%CD)) + call RegPack(Buf, InData%CD) + end if + call RegPack(Buf, allocated(InData%CL)) + if (allocated(InData%CL)) then + call RegPackBounds(Buf, 3, lbound(InData%CL), ubound(InData%CL)) + call RegPack(Buf, InData%CL) + end if + call RegPack(Buf, allocated(InData%CM)) + if (allocated(InData%CM)) then + call RegPackBounds(Buf, 3, lbound(InData%CM), ubound(InData%CM)) + call RegPack(Buf, InData%CM) + end if + call RegPack(Buf, InData%PMC) + call RegPack(Buf, InData%MulTabLoc) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackAirFoil(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AirFoil), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackAirFoil' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%AL)) deallocate(OutData%AL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CD)) deallocate(OutData%CD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CD(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CD) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CL)) deallocate(OutData%CL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CM)) deallocate(OutData%CM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CM) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%PMC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MulTabLoc) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyAirFoilParms(SrcAirFoilParmsData, DstAirFoilParmsData, CtrlCode, ErrStat, ErrMsg) + type(AirFoilParms), intent(in) :: SrcAirFoilParmsData + type(AirFoilParms), intent(inout) :: DstAirFoilParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyAirFoilParms' ErrStat = ErrID_None - ErrMsg = "" - DstWindParmsData%Rho = SrcWindParmsData%Rho - DstWindParmsData%KinVisc = SrcWindParmsData%KinVisc - END SUBROUTINE AD14_CopyWindParms - - SUBROUTINE AD14_DestroyWindParms( WindParmsData, ErrStat, ErrMsg ) - TYPE(WindParms), INTENT(INOUT) :: WindParmsData - 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 = 'AD14_DestroyWindParms' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyWindParms - - SUBROUTINE AD14_PackWindParms( 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(WindParms), 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 = 'AD14_PackWindParms' - ! 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 ! Rho - Re_BufSz = Re_BufSz + 1 ! KinVisc - 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%Rho - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackWindParms - - SUBROUTINE AD14_UnPackWindParms( 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(WindParms), 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 = 'AD14_UnPackWindParms' - ! 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%Rho = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackWindParms - - SUBROUTINE AD14_CopyPositionType( SrcPositionTypeData, DstPositionTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(PositionType), INTENT(IN) :: SrcPositionTypeData - TYPE(PositionType), INTENT(INOUT) :: DstPositionTypeData - 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 = 'AD14_CopyPositionType' -! + ErrMsg = '' + DstAirFoilParmsData%MaxTable = SrcAirFoilParmsData%MaxTable + if (allocated(SrcAirFoilParmsData%NTables)) then + LB(1:1) = lbound(SrcAirFoilParmsData%NTables) + UB(1:1) = ubound(SrcAirFoilParmsData%NTables) + if (.not. allocated(DstAirFoilParmsData%NTables)) then + allocate(DstAirFoilParmsData%NTables(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%NTables.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilParmsData%NTables = SrcAirFoilParmsData%NTables + end if + if (allocated(SrcAirFoilParmsData%NLift)) then + LB(1:1) = lbound(SrcAirFoilParmsData%NLift) + UB(1:1) = ubound(SrcAirFoilParmsData%NLift) + if (.not. allocated(DstAirFoilParmsData%NLift)) then + allocate(DstAirFoilParmsData%NLift(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%NLift.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilParmsData%NLift = SrcAirFoilParmsData%NLift + end if + DstAirFoilParmsData%NumCL = SrcAirFoilParmsData%NumCL + DstAirFoilParmsData%NumFoil = SrcAirFoilParmsData%NumFoil + if (allocated(SrcAirFoilParmsData%NFoil)) then + LB(1:1) = lbound(SrcAirFoilParmsData%NFoil) + UB(1:1) = ubound(SrcAirFoilParmsData%NFoil) + if (.not. allocated(DstAirFoilParmsData%NFoil)) then + allocate(DstAirFoilParmsData%NFoil(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%NFoil.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilParmsData%NFoil = SrcAirFoilParmsData%NFoil + end if + if (allocated(SrcAirFoilParmsData%MulTabMet)) then + LB(1:2) = lbound(SrcAirFoilParmsData%MulTabMet) + UB(1:2) = ubound(SrcAirFoilParmsData%MulTabMet) + if (.not. allocated(DstAirFoilParmsData%MulTabMet)) then + allocate(DstAirFoilParmsData%MulTabMet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%MulTabMet.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilParmsData%MulTabMet = SrcAirFoilParmsData%MulTabMet + end if + if (allocated(SrcAirFoilParmsData%FoilNm)) then + LB(1:1) = lbound(SrcAirFoilParmsData%FoilNm) + UB(1:1) = ubound(SrcAirFoilParmsData%FoilNm) + if (.not. allocated(DstAirFoilParmsData%FoilNm)) then + allocate(DstAirFoilParmsData%FoilNm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%FoilNm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilParmsData%FoilNm = SrcAirFoilParmsData%FoilNm + end if +end subroutine + +subroutine AD14_DestroyAirFoilParms(AirFoilParmsData, ErrStat, ErrMsg) + type(AirFoilParms), intent(inout) :: AirFoilParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyAirFoilParms' ErrStat = ErrID_None - ErrMsg = "" - DstPositionTypeData%Pos = SrcPositionTypeData%Pos - END SUBROUTINE AD14_CopyPositionType - - SUBROUTINE AD14_DestroyPositionType( PositionTypeData, ErrStat, ErrMsg ) - TYPE(PositionType), INTENT(INOUT) :: PositionTypeData - 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 = 'AD14_DestroyPositionType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyPositionType - - SUBROUTINE AD14_PackPositionType( 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(PositionType), 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 = 'AD14_PackPositionType' - ! 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 + SIZE(InData%Pos) ! Pos - 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 i1 = LBOUND(InData%Pos,1), UBOUND(InData%Pos,1) - ReKiBuf(Re_Xferred) = InData%Pos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_PackPositionType - - SUBROUTINE AD14_UnPackPositionType( 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(PositionType), 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 = 'AD14_UnPackPositionType' - ! 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 - i1_l = LBOUND(OutData%Pos,1) - i1_u = UBOUND(OutData%Pos,1) - DO i1 = LBOUND(OutData%Pos,1), UBOUND(OutData%Pos,1) - OutData%Pos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_UnPackPositionType - - SUBROUTINE AD14_CopyOrientationType( SrcOrientationTypeData, DstOrientationTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OrientationType), INTENT(IN) :: SrcOrientationTypeData - TYPE(OrientationType), INTENT(INOUT) :: DstOrientationTypeData - 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 = 'AD14_CopyOrientationType' -! + ErrMsg = '' + if (allocated(AirFoilParmsData%NTables)) then + deallocate(AirFoilParmsData%NTables) + end if + if (allocated(AirFoilParmsData%NLift)) then + deallocate(AirFoilParmsData%NLift) + end if + if (allocated(AirFoilParmsData%NFoil)) then + deallocate(AirFoilParmsData%NFoil) + end if + if (allocated(AirFoilParmsData%MulTabMet)) then + deallocate(AirFoilParmsData%MulTabMet) + end if + if (allocated(AirFoilParmsData%FoilNm)) then + deallocate(AirFoilParmsData%FoilNm) + end if +end subroutine + +subroutine AD14_PackAirFoilParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AirFoilParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackAirFoilParms' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%MaxTable) + call RegPack(Buf, allocated(InData%NTables)) + if (allocated(InData%NTables)) then + call RegPackBounds(Buf, 1, lbound(InData%NTables), ubound(InData%NTables)) + call RegPack(Buf, InData%NTables) + end if + call RegPack(Buf, allocated(InData%NLift)) + if (allocated(InData%NLift)) then + call RegPackBounds(Buf, 1, lbound(InData%NLift), ubound(InData%NLift)) + call RegPack(Buf, InData%NLift) + end if + call RegPack(Buf, InData%NumCL) + call RegPack(Buf, InData%NumFoil) + call RegPack(Buf, allocated(InData%NFoil)) + if (allocated(InData%NFoil)) then + call RegPackBounds(Buf, 1, lbound(InData%NFoil), ubound(InData%NFoil)) + call RegPack(Buf, InData%NFoil) + end if + call RegPack(Buf, allocated(InData%MulTabMet)) + if (allocated(InData%MulTabMet)) then + call RegPackBounds(Buf, 2, lbound(InData%MulTabMet), ubound(InData%MulTabMet)) + call RegPack(Buf, InData%MulTabMet) + end if + call RegPack(Buf, allocated(InData%FoilNm)) + if (allocated(InData%FoilNm)) then + call RegPackBounds(Buf, 1, lbound(InData%FoilNm), ubound(InData%FoilNm)) + call RegPack(Buf, InData%FoilNm) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackAirFoilParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AirFoilParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackAirFoilParms' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%MaxTable) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%NTables)) deallocate(OutData%NTables) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NTables(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTables.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NTables) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%NLift)) deallocate(OutData%NLift) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NLift(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NLift.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NLift) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NumCL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumFoil) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%NFoil)) deallocate(OutData%NFoil) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NFoil(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NFoil.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NFoil) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MulTabMet)) deallocate(OutData%MulTabMet) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MulTabMet(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabMet.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MulTabMet) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FoilNm)) deallocate(OutData%FoilNm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FoilNm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FoilNm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FoilNm) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, ErrMsg) + type(Beddoes), intent(in) :: SrcBeddoesData + type(Beddoes), intent(inout) :: DstBeddoesData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyBeddoes' ErrStat = ErrID_None - ErrMsg = "" - DstOrientationTypeData%Orient = SrcOrientationTypeData%Orient - END SUBROUTINE AD14_CopyOrientationType - - SUBROUTINE AD14_DestroyOrientationType( OrientationTypeData, ErrStat, ErrMsg ) - TYPE(OrientationType), INTENT(INOUT) :: OrientationTypeData - 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 = 'AD14_DestroyOrientationType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyOrientationType - - SUBROUTINE AD14_PackOrientationType( 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(OrientationType), 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 = 'AD14_PackOrientationType' - ! 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 + SIZE(InData%Orient) ! Orient - 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 i2 = LBOUND(InData%Orient,2), UBOUND(InData%Orient,2) - DO i1 = LBOUND(InData%Orient,1), UBOUND(InData%Orient,1) - ReKiBuf(Re_Xferred) = InData%Orient(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD14_PackOrientationType - - SUBROUTINE AD14_UnPackOrientationType( 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(OrientationType), 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 = 'AD14_UnPackOrientationType' - ! 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 - i1_l = LBOUND(OutData%Orient,1) - i1_u = UBOUND(OutData%Orient,1) - i2_l = LBOUND(OutData%Orient,2) - i2_u = UBOUND(OutData%Orient,2) - DO i2 = LBOUND(OutData%Orient,2), UBOUND(OutData%Orient,2) - DO i1 = LBOUND(OutData%Orient,1), UBOUND(OutData%Orient,1) - OutData%Orient(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD14_UnPackOrientationType - - SUBROUTINE AD14_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AD14_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 = 'AD14_CopyInitInput' -! + ErrMsg = '' + if (allocated(SrcBeddoesData%ADOT)) then + LB(1:2) = lbound(SrcBeddoesData%ADOT) + UB(1:2) = ubound(SrcBeddoesData%ADOT) + if (.not. allocated(DstBeddoesData%ADOT)) then + allocate(DstBeddoesData%ADOT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ADOT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%ADOT = SrcBeddoesData%ADOT + end if + if (allocated(SrcBeddoesData%ADOT1)) then + LB(1:2) = lbound(SrcBeddoesData%ADOT1) + UB(1:2) = ubound(SrcBeddoesData%ADOT1) + if (.not. allocated(DstBeddoesData%ADOT1)) then + allocate(DstBeddoesData%ADOT1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ADOT1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%ADOT1 = SrcBeddoesData%ADOT1 + end if + if (allocated(SrcBeddoesData%AFE)) then + LB(1:2) = lbound(SrcBeddoesData%AFE) + UB(1:2) = ubound(SrcBeddoesData%AFE) + if (.not. allocated(DstBeddoesData%AFE)) then + allocate(DstBeddoesData%AFE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AFE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%AFE = SrcBeddoesData%AFE + end if + if (allocated(SrcBeddoesData%AFE1)) then + LB(1:2) = lbound(SrcBeddoesData%AFE1) + UB(1:2) = ubound(SrcBeddoesData%AFE1) + if (.not. allocated(DstBeddoesData%AFE1)) then + allocate(DstBeddoesData%AFE1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AFE1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%AFE1 = SrcBeddoesData%AFE1 + end if + DstBeddoesData%AN = SrcBeddoesData%AN + if (allocated(SrcBeddoesData%ANE)) then + LB(1:2) = lbound(SrcBeddoesData%ANE) + UB(1:2) = ubound(SrcBeddoesData%ANE) + if (.not. allocated(DstBeddoesData%ANE)) then + allocate(DstBeddoesData%ANE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ANE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%ANE = SrcBeddoesData%ANE + end if + if (allocated(SrcBeddoesData%ANE1)) then + LB(1:2) = lbound(SrcBeddoesData%ANE1) + UB(1:2) = ubound(SrcBeddoesData%ANE1) + if (.not. allocated(DstBeddoesData%ANE1)) then + allocate(DstBeddoesData%ANE1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ANE1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%ANE1 = SrcBeddoesData%ANE1 + end if + if (allocated(SrcBeddoesData%AOD)) then + LB(1:2) = lbound(SrcBeddoesData%AOD) + UB(1:2) = ubound(SrcBeddoesData%AOD) + if (.not. allocated(DstBeddoesData%AOD)) then + allocate(DstBeddoesData%AOD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AOD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%AOD = SrcBeddoesData%AOD + end if + if (allocated(SrcBeddoesData%AOL)) then + LB(1:2) = lbound(SrcBeddoesData%AOL) + UB(1:2) = ubound(SrcBeddoesData%AOL) + if (.not. allocated(DstBeddoesData%AOL)) then + allocate(DstBeddoesData%AOL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AOL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%AOL = SrcBeddoesData%AOL + end if + if (allocated(SrcBeddoesData%BEDSEP)) then + LB(1:2) = lbound(SrcBeddoesData%BEDSEP) + UB(1:2) = ubound(SrcBeddoesData%BEDSEP) + if (.not. allocated(DstBeddoesData%BEDSEP)) then + allocate(DstBeddoesData%BEDSEP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%BEDSEP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%BEDSEP = SrcBeddoesData%BEDSEP + end if + if (allocated(SrcBeddoesData%OLDSEP)) then + LB(1:2) = lbound(SrcBeddoesData%OLDSEP) + UB(1:2) = ubound(SrcBeddoesData%OLDSEP) + if (.not. allocated(DstBeddoesData%OLDSEP)) then + allocate(DstBeddoesData%OLDSEP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDSEP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDSEP = SrcBeddoesData%OLDSEP + end if + DstBeddoesData%CC = SrcBeddoesData%CC + if (allocated(SrcBeddoesData%CDO)) then + LB(1:2) = lbound(SrcBeddoesData%CDO) + UB(1:2) = ubound(SrcBeddoesData%CDO) + if (.not. allocated(DstBeddoesData%CDO)) then + allocate(DstBeddoesData%CDO(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CDO.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CDO = SrcBeddoesData%CDO + end if + DstBeddoesData%CMI = SrcBeddoesData%CMI + DstBeddoesData%CMQ = SrcBeddoesData%CMQ + DstBeddoesData%CN = SrcBeddoesData%CN + if (allocated(SrcBeddoesData%CNA)) then + LB(1:2) = lbound(SrcBeddoesData%CNA) + UB(1:2) = ubound(SrcBeddoesData%CNA) + if (.not. allocated(DstBeddoesData%CNA)) then + allocate(DstBeddoesData%CNA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNA = SrcBeddoesData%CNA + end if + DstBeddoesData%CNCP = SrcBeddoesData%CNCP + DstBeddoesData%CNIQ = SrcBeddoesData%CNIQ + if (allocated(SrcBeddoesData%CNP)) then + LB(1:2) = lbound(SrcBeddoesData%CNP) + UB(1:2) = ubound(SrcBeddoesData%CNP) + if (.not. allocated(DstBeddoesData%CNP)) then + allocate(DstBeddoesData%CNP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNP = SrcBeddoesData%CNP + end if + if (allocated(SrcBeddoesData%CNP1)) then + LB(1:2) = lbound(SrcBeddoesData%CNP1) + UB(1:2) = ubound(SrcBeddoesData%CNP1) + if (.not. allocated(DstBeddoesData%CNP1)) then + allocate(DstBeddoesData%CNP1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNP1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNP1 = SrcBeddoesData%CNP1 + end if + if (allocated(SrcBeddoesData%CNPD)) then + LB(1:2) = lbound(SrcBeddoesData%CNPD) + UB(1:2) = ubound(SrcBeddoesData%CNPD) + if (.not. allocated(DstBeddoesData%CNPD)) then + allocate(DstBeddoesData%CNPD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNPD = SrcBeddoesData%CNPD + end if + if (allocated(SrcBeddoesData%CNPD1)) then + LB(1:2) = lbound(SrcBeddoesData%CNPD1) + UB(1:2) = ubound(SrcBeddoesData%CNPD1) + if (.not. allocated(DstBeddoesData%CNPD1)) then + allocate(DstBeddoesData%CNPD1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPD1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNPD1 = SrcBeddoesData%CNPD1 + end if + if (allocated(SrcBeddoesData%CNPOT)) then + LB(1:2) = lbound(SrcBeddoesData%CNPOT) + UB(1:2) = ubound(SrcBeddoesData%CNPOT) + if (.not. allocated(DstBeddoesData%CNPOT)) then + allocate(DstBeddoesData%CNPOT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPOT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNPOT = SrcBeddoesData%CNPOT + end if + if (allocated(SrcBeddoesData%CNPOT1)) then + LB(1:2) = lbound(SrcBeddoesData%CNPOT1) + UB(1:2) = ubound(SrcBeddoesData%CNPOT1) + if (.not. allocated(DstBeddoesData%CNPOT1)) then + allocate(DstBeddoesData%CNPOT1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPOT1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNPOT1 = SrcBeddoesData%CNPOT1 + end if + if (allocated(SrcBeddoesData%CNS)) then + LB(1:2) = lbound(SrcBeddoesData%CNS) + UB(1:2) = ubound(SrcBeddoesData%CNS) + if (.not. allocated(DstBeddoesData%CNS)) then + allocate(DstBeddoesData%CNS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNS = SrcBeddoesData%CNS + end if + if (allocated(SrcBeddoesData%CNSL)) then + LB(1:2) = lbound(SrcBeddoesData%CNSL) + UB(1:2) = ubound(SrcBeddoesData%CNSL) + if (.not. allocated(DstBeddoesData%CNSL)) then + allocate(DstBeddoesData%CNSL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNSL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNSL = SrcBeddoesData%CNSL + end if + if (allocated(SrcBeddoesData%CNV)) then + LB(1:2) = lbound(SrcBeddoesData%CNV) + UB(1:2) = ubound(SrcBeddoesData%CNV) + if (.not. allocated(DstBeddoesData%CNV)) then + allocate(DstBeddoesData%CNV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNV = SrcBeddoesData%CNV + end if + if (allocated(SrcBeddoesData%CVN)) then + LB(1:2) = lbound(SrcBeddoesData%CVN) + UB(1:2) = ubound(SrcBeddoesData%CVN) + if (.not. allocated(DstBeddoesData%CVN)) then + allocate(DstBeddoesData%CVN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CVN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CVN = SrcBeddoesData%CVN + end if + if (allocated(SrcBeddoesData%CVN1)) then + LB(1:2) = lbound(SrcBeddoesData%CVN1) + UB(1:2) = ubound(SrcBeddoesData%CVN1) + if (.not. allocated(DstBeddoesData%CVN1)) then + allocate(DstBeddoesData%CVN1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CVN1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CVN1 = SrcBeddoesData%CVN1 + end if + if (allocated(SrcBeddoesData%DF)) then + LB(1:2) = lbound(SrcBeddoesData%DF) + UB(1:2) = ubound(SrcBeddoesData%DF) + if (.not. allocated(DstBeddoesData%DF)) then + allocate(DstBeddoesData%DF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DF = SrcBeddoesData%DF + end if + if (allocated(SrcBeddoesData%DFAFE)) then + LB(1:2) = lbound(SrcBeddoesData%DFAFE) + UB(1:2) = ubound(SrcBeddoesData%DFAFE) + if (.not. allocated(DstBeddoesData%DFAFE)) then + allocate(DstBeddoesData%DFAFE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DFAFE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DFAFE = SrcBeddoesData%DFAFE + end if + if (allocated(SrcBeddoesData%DFAFE1)) then + LB(1:2) = lbound(SrcBeddoesData%DFAFE1) + UB(1:2) = ubound(SrcBeddoesData%DFAFE1) + if (.not. allocated(DstBeddoesData%DFAFE1)) then + allocate(DstBeddoesData%DFAFE1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DFAFE1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DFAFE1 = SrcBeddoesData%DFAFE1 + end if + if (allocated(SrcBeddoesData%DFC)) then + LB(1:2) = lbound(SrcBeddoesData%DFC) + UB(1:2) = ubound(SrcBeddoesData%DFC) + if (.not. allocated(DstBeddoesData%DFC)) then + allocate(DstBeddoesData%DFC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DFC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DFC = SrcBeddoesData%DFC + end if + if (allocated(SrcBeddoesData%DN)) then + LB(1:2) = lbound(SrcBeddoesData%DN) + UB(1:2) = ubound(SrcBeddoesData%DN) + if (.not. allocated(DstBeddoesData%DN)) then + allocate(DstBeddoesData%DN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DN = SrcBeddoesData%DN + end if + if (allocated(SrcBeddoesData%DPP)) then + LB(1:2) = lbound(SrcBeddoesData%DPP) + UB(1:2) = ubound(SrcBeddoesData%DPP) + if (.not. allocated(DstBeddoesData%DPP)) then + allocate(DstBeddoesData%DPP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DPP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DPP = SrcBeddoesData%DPP + end if + if (allocated(SrcBeddoesData%DQ)) then + LB(1:2) = lbound(SrcBeddoesData%DQ) + UB(1:2) = ubound(SrcBeddoesData%DQ) + if (.not. allocated(DstBeddoesData%DQ)) then + allocate(DstBeddoesData%DQ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DQ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DQ = SrcBeddoesData%DQ + end if + if (allocated(SrcBeddoesData%DQP)) then + LB(1:2) = lbound(SrcBeddoesData%DQP) + UB(1:2) = ubound(SrcBeddoesData%DQP) + if (.not. allocated(DstBeddoesData%DQP)) then + allocate(DstBeddoesData%DQP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DQP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DQP = SrcBeddoesData%DQP + end if + if (allocated(SrcBeddoesData%DQP1)) then + LB(1:2) = lbound(SrcBeddoesData%DQP1) + UB(1:2) = ubound(SrcBeddoesData%DQP1) + if (.not. allocated(DstBeddoesData%DQP1)) then + allocate(DstBeddoesData%DQP1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DQP1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DQP1 = SrcBeddoesData%DQP1 + end if + DstBeddoesData%DS = SrcBeddoesData%DS + DstBeddoesData%FK = SrcBeddoesData%FK + DstBeddoesData%FP = SrcBeddoesData%FP + DstBeddoesData%FPC = SrcBeddoesData%FPC + if (allocated(SrcBeddoesData%FSP)) then + LB(1:2) = lbound(SrcBeddoesData%FSP) + UB(1:2) = ubound(SrcBeddoesData%FSP) + if (.not. allocated(DstBeddoesData%FSP)) then + allocate(DstBeddoesData%FSP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%FSP = SrcBeddoesData%FSP + end if + if (allocated(SrcBeddoesData%FSP1)) then + LB(1:2) = lbound(SrcBeddoesData%FSP1) + UB(1:2) = ubound(SrcBeddoesData%FSP1) + if (.not. allocated(DstBeddoesData%FSP1)) then + allocate(DstBeddoesData%FSP1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSP1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%FSP1 = SrcBeddoesData%FSP1 + end if + if (allocated(SrcBeddoesData%FSPC)) then + LB(1:2) = lbound(SrcBeddoesData%FSPC) + UB(1:2) = ubound(SrcBeddoesData%FSPC) + if (.not. allocated(DstBeddoesData%FSPC)) then + allocate(DstBeddoesData%FSPC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSPC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%FSPC = SrcBeddoesData%FSPC + end if + if (allocated(SrcBeddoesData%FSPC1)) then + LB(1:2) = lbound(SrcBeddoesData%FSPC1) + UB(1:2) = ubound(SrcBeddoesData%FSPC1) + if (.not. allocated(DstBeddoesData%FSPC1)) then + allocate(DstBeddoesData%FSPC1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSPC1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%FSPC1 = SrcBeddoesData%FSPC1 + end if + if (allocated(SrcBeddoesData%FTB)) then + LB(1:3) = lbound(SrcBeddoesData%FTB) + UB(1:3) = ubound(SrcBeddoesData%FTB) + if (.not. allocated(DstBeddoesData%FTB)) then + allocate(DstBeddoesData%FTB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FTB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%FTB = SrcBeddoesData%FTB + end if + if (allocated(SrcBeddoesData%FTBC)) then + LB(1:3) = lbound(SrcBeddoesData%FTBC) + UB(1:3) = ubound(SrcBeddoesData%FTBC) + if (.not. allocated(DstBeddoesData%FTBC)) then + allocate(DstBeddoesData%FTBC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FTBC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%FTBC = SrcBeddoesData%FTBC + end if + if (allocated(SrcBeddoesData%OLDCNV)) then + LB(1:2) = lbound(SrcBeddoesData%OLDCNV) + UB(1:2) = ubound(SrcBeddoesData%OLDCNV) + if (.not. allocated(DstBeddoesData%OLDCNV)) then + allocate(DstBeddoesData%OLDCNV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDCNV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDCNV = SrcBeddoesData%OLDCNV + end if + if (allocated(SrcBeddoesData%OLDDF)) then + LB(1:2) = lbound(SrcBeddoesData%OLDDF) + UB(1:2) = ubound(SrcBeddoesData%OLDDF) + if (.not. allocated(DstBeddoesData%OLDDF)) then + allocate(DstBeddoesData%OLDDF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDDF = SrcBeddoesData%OLDDF + end if + if (allocated(SrcBeddoesData%OLDDFC)) then + LB(1:2) = lbound(SrcBeddoesData%OLDDFC) + UB(1:2) = ubound(SrcBeddoesData%OLDDFC) + if (.not. allocated(DstBeddoesData%OLDDFC)) then + allocate(DstBeddoesData%OLDDFC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDFC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDDFC = SrcBeddoesData%OLDDFC + end if + if (allocated(SrcBeddoesData%OLDDN)) then + LB(1:2) = lbound(SrcBeddoesData%OLDDN) + UB(1:2) = ubound(SrcBeddoesData%OLDDN) + if (.not. allocated(DstBeddoesData%OLDDN)) then + allocate(DstBeddoesData%OLDDN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDDN = SrcBeddoesData%OLDDN + end if + if (allocated(SrcBeddoesData%OLDDPP)) then + LB(1:2) = lbound(SrcBeddoesData%OLDDPP) + UB(1:2) = ubound(SrcBeddoesData%OLDDPP) + if (.not. allocated(DstBeddoesData%OLDDPP)) then + allocate(DstBeddoesData%OLDDPP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDPP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDDPP = SrcBeddoesData%OLDDPP + end if + if (allocated(SrcBeddoesData%OLDDQ)) then + LB(1:2) = lbound(SrcBeddoesData%OLDDQ) + UB(1:2) = ubound(SrcBeddoesData%OLDDQ) + if (.not. allocated(DstBeddoesData%OLDDQ)) then + allocate(DstBeddoesData%OLDDQ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDQ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDDQ = SrcBeddoesData%OLDDQ + end if + if (allocated(SrcBeddoesData%OLDTAU)) then + LB(1:2) = lbound(SrcBeddoesData%OLDTAU) + UB(1:2) = ubound(SrcBeddoesData%OLDTAU) + if (.not. allocated(DstBeddoesData%OLDTAU)) then + allocate(DstBeddoesData%OLDTAU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDTAU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDTAU = SrcBeddoesData%OLDTAU + end if + if (allocated(SrcBeddoesData%OLDXN)) then + LB(1:2) = lbound(SrcBeddoesData%OLDXN) + UB(1:2) = ubound(SrcBeddoesData%OLDXN) + if (.not. allocated(DstBeddoesData%OLDXN)) then + allocate(DstBeddoesData%OLDXN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDXN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDXN = SrcBeddoesData%OLDXN + end if + if (allocated(SrcBeddoesData%OLDYN)) then + LB(1:2) = lbound(SrcBeddoesData%OLDYN) + UB(1:2) = ubound(SrcBeddoesData%OLDYN) + if (.not. allocated(DstBeddoesData%OLDYN)) then + allocate(DstBeddoesData%OLDYN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDYN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDYN = SrcBeddoesData%OLDYN + end if + if (allocated(SrcBeddoesData%QX)) then + LB(1:2) = lbound(SrcBeddoesData%QX) + UB(1:2) = ubound(SrcBeddoesData%QX) + if (.not. allocated(DstBeddoesData%QX)) then + allocate(DstBeddoesData%QX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%QX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%QX = SrcBeddoesData%QX + end if + if (allocated(SrcBeddoesData%QX1)) then + LB(1:2) = lbound(SrcBeddoesData%QX1) + UB(1:2) = ubound(SrcBeddoesData%QX1) + if (.not. allocated(DstBeddoesData%QX1)) then + allocate(DstBeddoesData%QX1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%QX1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%QX1 = SrcBeddoesData%QX1 + end if + if (allocated(SrcBeddoesData%TAU)) then + LB(1:2) = lbound(SrcBeddoesData%TAU) + UB(1:2) = ubound(SrcBeddoesData%TAU) + if (.not. allocated(DstBeddoesData%TAU)) then + allocate(DstBeddoesData%TAU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%TAU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%TAU = SrcBeddoesData%TAU + end if + if (allocated(SrcBeddoesData%XN)) then + LB(1:2) = lbound(SrcBeddoesData%XN) + UB(1:2) = ubound(SrcBeddoesData%XN) + if (.not. allocated(DstBeddoesData%XN)) then + allocate(DstBeddoesData%XN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%XN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%XN = SrcBeddoesData%XN + end if + if (allocated(SrcBeddoesData%YN)) then + LB(1:2) = lbound(SrcBeddoesData%YN) + UB(1:2) = ubound(SrcBeddoesData%YN) + if (.not. allocated(DstBeddoesData%YN)) then + allocate(DstBeddoesData%YN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%YN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%YN = SrcBeddoesData%YN + end if + DstBeddoesData%SHIFT = SrcBeddoesData%SHIFT + DstBeddoesData%VOR = SrcBeddoesData%VOR +end subroutine + +subroutine AD14_DestroyBeddoes(BeddoesData, ErrStat, ErrMsg) + type(Beddoes), intent(inout) :: BeddoesData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyBeddoes' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%Title = SrcInitInputData%Title - DstInitInputData%OutRootName = SrcInitInputData%OutRootName - DstInitInputData%ADFileName = SrcInitInputData%ADFileName - DstInitInputData%WrSumFile = SrcInitInputData%WrSumFile - DstInitInputData%NumBl = SrcInitInputData%NumBl - DstInitInputData%BladeLength = SrcInitInputData%BladeLength - DstInitInputData%LinearizeFlag = SrcInitInputData%LinearizeFlag - DstInitInputData%UseDWM = SrcInitInputData%UseDWM - CALL AD14_Copyaeroconfig( SrcInitInputData%TurbineComponents, DstInitInputData%TurbineComponents, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%NumTwrNodes = SrcInitInputData%NumTwrNodes -IF (ALLOCATED(SrcInitInputData%TwrNodeLocs)) THEN - i1_l = LBOUND(SrcInitInputData%TwrNodeLocs,1) - i1_u = UBOUND(SrcInitInputData%TwrNodeLocs,1) - i2_l = LBOUND(SrcInitInputData%TwrNodeLocs,2) - i2_u = UBOUND(SrcInitInputData%TwrNodeLocs,2) - IF (.NOT. ALLOCATED(DstInitInputData%TwrNodeLocs)) THEN - ALLOCATE(DstInitInputData%TwrNodeLocs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TwrNodeLocs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%TwrNodeLocs = SrcInitInputData%TwrNodeLocs -ENDIF - DstInitInputData%HubHt = SrcInitInputData%HubHt - CALL DWM_CopyInitInput( SrcInitInputData%DWM, DstInitInputData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyInitInput - - SUBROUTINE AD14_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(AD14_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 = 'AD14_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyInitInput - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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%Title) ! Title - Int_BufSz = Int_BufSz + 1*LEN(InData%OutRootName) ! OutRootName - Int_BufSz = Int_BufSz + 1*LEN(InData%ADFileName) ! ADFileName - Int_BufSz = Int_BufSz + 1 ! WrSumFile - Int_BufSz = Int_BufSz + 1 ! NumBl - Re_BufSz = Re_BufSz + 1 ! BladeLength - Int_BufSz = Int_BufSz + 1 ! LinearizeFlag - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TurbineComponents - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TurbineComponents - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TurbineComponents - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! NumTwrNodes - Int_BufSz = Int_BufSz + 1 ! TwrNodeLocs allocated yes/no - IF ( ALLOCATED(InData%TwrNodeLocs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TwrNodeLocs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrNodeLocs) ! TwrNodeLocs - END IF - Re_BufSz = Re_BufSz + 1 ! HubHt - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - 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%Title) - IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%ADFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%ADFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrSumFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LinearizeFlag, IntKiBuf(1)) - 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 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%NumTwrNodes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TwrNodeLocs) ) 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%TwrNodeLocs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrNodeLocs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrNodeLocs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrNodeLocs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TwrNodeLocs,2), UBOUND(InData%TwrNodeLocs,2) - DO i1 = LBOUND(InData%TwrNodeLocs,1), UBOUND(InData%TwrNodeLocs,1) - ReKiBuf(Re_Xferred) = InData%TwrNodeLocs(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - CALL DWM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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 AD14_PackInitInput - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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%Title) - OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%ADFileName) - OutData%ADFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WrSumFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrSumFile) - Int_Xferred = Int_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LinearizeFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinearizeFlag) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) - 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 AD14_UnpackAeroConfig( Re_Buf, Db_Buf, Int_Buf, OutData%TurbineComponents, ErrStat2, ErrMsg2 ) ! TurbineComponents - 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%NumTwrNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrNodeLocs 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%TwrNodeLocs)) DEALLOCATE(OutData%TwrNodeLocs) - ALLOCATE(OutData%TwrNodeLocs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeLocs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TwrNodeLocs,2), UBOUND(OutData%TwrNodeLocs,2) - DO i1 = LBOUND(OutData%TwrNodeLocs,1), UBOUND(OutData%TwrNodeLocs,1) - OutData%TwrNodeLocs(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%HubHt = ReKiBuf(Re_Xferred) - 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 DWM_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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 AD14_UnPackInitInput - - SUBROUTINE AD14_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AD14_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyInitOutput' -! + ErrMsg = '' + if (allocated(BeddoesData%ADOT)) then + deallocate(BeddoesData%ADOT) + end if + if (allocated(BeddoesData%ADOT1)) then + deallocate(BeddoesData%ADOT1) + end if + if (allocated(BeddoesData%AFE)) then + deallocate(BeddoesData%AFE) + end if + if (allocated(BeddoesData%AFE1)) then + deallocate(BeddoesData%AFE1) + end if + if (allocated(BeddoesData%ANE)) then + deallocate(BeddoesData%ANE) + end if + if (allocated(BeddoesData%ANE1)) then + deallocate(BeddoesData%ANE1) + end if + if (allocated(BeddoesData%AOD)) then + deallocate(BeddoesData%AOD) + end if + if (allocated(BeddoesData%AOL)) then + deallocate(BeddoesData%AOL) + end if + if (allocated(BeddoesData%BEDSEP)) then + deallocate(BeddoesData%BEDSEP) + end if + if (allocated(BeddoesData%OLDSEP)) then + deallocate(BeddoesData%OLDSEP) + end if + if (allocated(BeddoesData%CDO)) then + deallocate(BeddoesData%CDO) + end if + if (allocated(BeddoesData%CNA)) then + deallocate(BeddoesData%CNA) + end if + if (allocated(BeddoesData%CNP)) then + deallocate(BeddoesData%CNP) + end if + if (allocated(BeddoesData%CNP1)) then + deallocate(BeddoesData%CNP1) + end if + if (allocated(BeddoesData%CNPD)) then + deallocate(BeddoesData%CNPD) + end if + if (allocated(BeddoesData%CNPD1)) then + deallocate(BeddoesData%CNPD1) + end if + if (allocated(BeddoesData%CNPOT)) then + deallocate(BeddoesData%CNPOT) + end if + if (allocated(BeddoesData%CNPOT1)) then + deallocate(BeddoesData%CNPOT1) + end if + if (allocated(BeddoesData%CNS)) then + deallocate(BeddoesData%CNS) + end if + if (allocated(BeddoesData%CNSL)) then + deallocate(BeddoesData%CNSL) + end if + if (allocated(BeddoesData%CNV)) then + deallocate(BeddoesData%CNV) + end if + if (allocated(BeddoesData%CVN)) then + deallocate(BeddoesData%CVN) + end if + if (allocated(BeddoesData%CVN1)) then + deallocate(BeddoesData%CVN1) + end if + if (allocated(BeddoesData%DF)) then + deallocate(BeddoesData%DF) + end if + if (allocated(BeddoesData%DFAFE)) then + deallocate(BeddoesData%DFAFE) + end if + if (allocated(BeddoesData%DFAFE1)) then + deallocate(BeddoesData%DFAFE1) + end if + if (allocated(BeddoesData%DFC)) then + deallocate(BeddoesData%DFC) + end if + if (allocated(BeddoesData%DN)) then + deallocate(BeddoesData%DN) + end if + if (allocated(BeddoesData%DPP)) then + deallocate(BeddoesData%DPP) + end if + if (allocated(BeddoesData%DQ)) then + deallocate(BeddoesData%DQ) + end if + if (allocated(BeddoesData%DQP)) then + deallocate(BeddoesData%DQP) + end if + if (allocated(BeddoesData%DQP1)) then + deallocate(BeddoesData%DQP1) + end if + if (allocated(BeddoesData%FSP)) then + deallocate(BeddoesData%FSP) + end if + if (allocated(BeddoesData%FSP1)) then + deallocate(BeddoesData%FSP1) + end if + if (allocated(BeddoesData%FSPC)) then + deallocate(BeddoesData%FSPC) + end if + if (allocated(BeddoesData%FSPC1)) then + deallocate(BeddoesData%FSPC1) + end if + if (allocated(BeddoesData%FTB)) then + deallocate(BeddoesData%FTB) + end if + if (allocated(BeddoesData%FTBC)) then + deallocate(BeddoesData%FTBC) + end if + if (allocated(BeddoesData%OLDCNV)) then + deallocate(BeddoesData%OLDCNV) + end if + if (allocated(BeddoesData%OLDDF)) then + deallocate(BeddoesData%OLDDF) + end if + if (allocated(BeddoesData%OLDDFC)) then + deallocate(BeddoesData%OLDDFC) + end if + if (allocated(BeddoesData%OLDDN)) then + deallocate(BeddoesData%OLDDN) + end if + if (allocated(BeddoesData%OLDDPP)) then + deallocate(BeddoesData%OLDDPP) + end if + if (allocated(BeddoesData%OLDDQ)) then + deallocate(BeddoesData%OLDDQ) + end if + if (allocated(BeddoesData%OLDTAU)) then + deallocate(BeddoesData%OLDTAU) + end if + if (allocated(BeddoesData%OLDXN)) then + deallocate(BeddoesData%OLDXN) + end if + if (allocated(BeddoesData%OLDYN)) then + deallocate(BeddoesData%OLDYN) + end if + if (allocated(BeddoesData%QX)) then + deallocate(BeddoesData%QX) + end if + if (allocated(BeddoesData%QX1)) then + deallocate(BeddoesData%QX1) + end if + if (allocated(BeddoesData%TAU)) then + deallocate(BeddoesData%TAU) + end if + if (allocated(BeddoesData%XN)) then + deallocate(BeddoesData%XN) + end if + if (allocated(BeddoesData%YN)) then + deallocate(BeddoesData%YN) + end if +end subroutine + +subroutine AD14_PackBeddoes(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Beddoes), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackBeddoes' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%ADOT)) + if (allocated(InData%ADOT)) then + call RegPackBounds(Buf, 2, lbound(InData%ADOT), ubound(InData%ADOT)) + call RegPack(Buf, InData%ADOT) + end if + call RegPack(Buf, allocated(InData%ADOT1)) + if (allocated(InData%ADOT1)) then + call RegPackBounds(Buf, 2, lbound(InData%ADOT1), ubound(InData%ADOT1)) + call RegPack(Buf, InData%ADOT1) + end if + call RegPack(Buf, allocated(InData%AFE)) + if (allocated(InData%AFE)) then + call RegPackBounds(Buf, 2, lbound(InData%AFE), ubound(InData%AFE)) + call RegPack(Buf, InData%AFE) + end if + call RegPack(Buf, allocated(InData%AFE1)) + if (allocated(InData%AFE1)) then + call RegPackBounds(Buf, 2, lbound(InData%AFE1), ubound(InData%AFE1)) + call RegPack(Buf, InData%AFE1) + end if + call RegPack(Buf, InData%AN) + call RegPack(Buf, allocated(InData%ANE)) + if (allocated(InData%ANE)) then + call RegPackBounds(Buf, 2, lbound(InData%ANE), ubound(InData%ANE)) + call RegPack(Buf, InData%ANE) + end if + call RegPack(Buf, allocated(InData%ANE1)) + if (allocated(InData%ANE1)) then + call RegPackBounds(Buf, 2, lbound(InData%ANE1), ubound(InData%ANE1)) + call RegPack(Buf, InData%ANE1) + end if + call RegPack(Buf, allocated(InData%AOD)) + if (allocated(InData%AOD)) then + call RegPackBounds(Buf, 2, lbound(InData%AOD), ubound(InData%AOD)) + call RegPack(Buf, InData%AOD) + end if + call RegPack(Buf, allocated(InData%AOL)) + if (allocated(InData%AOL)) then + call RegPackBounds(Buf, 2, lbound(InData%AOL), ubound(InData%AOL)) + call RegPack(Buf, InData%AOL) + end if + call RegPack(Buf, allocated(InData%BEDSEP)) + if (allocated(InData%BEDSEP)) then + call RegPackBounds(Buf, 2, lbound(InData%BEDSEP), ubound(InData%BEDSEP)) + call RegPack(Buf, InData%BEDSEP) + end if + call RegPack(Buf, allocated(InData%OLDSEP)) + if (allocated(InData%OLDSEP)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDSEP), ubound(InData%OLDSEP)) + call RegPack(Buf, InData%OLDSEP) + end if + call RegPack(Buf, InData%CC) + call RegPack(Buf, allocated(InData%CDO)) + if (allocated(InData%CDO)) then + call RegPackBounds(Buf, 2, lbound(InData%CDO), ubound(InData%CDO)) + call RegPack(Buf, InData%CDO) + end if + call RegPack(Buf, InData%CMI) + call RegPack(Buf, InData%CMQ) + call RegPack(Buf, InData%CN) + call RegPack(Buf, allocated(InData%CNA)) + if (allocated(InData%CNA)) then + call RegPackBounds(Buf, 2, lbound(InData%CNA), ubound(InData%CNA)) + call RegPack(Buf, InData%CNA) + end if + call RegPack(Buf, InData%CNCP) + call RegPack(Buf, InData%CNIQ) + call RegPack(Buf, allocated(InData%CNP)) + if (allocated(InData%CNP)) then + call RegPackBounds(Buf, 2, lbound(InData%CNP), ubound(InData%CNP)) + call RegPack(Buf, InData%CNP) + end if + call RegPack(Buf, allocated(InData%CNP1)) + if (allocated(InData%CNP1)) then + call RegPackBounds(Buf, 2, lbound(InData%CNP1), ubound(InData%CNP1)) + call RegPack(Buf, InData%CNP1) + end if + call RegPack(Buf, allocated(InData%CNPD)) + if (allocated(InData%CNPD)) then + call RegPackBounds(Buf, 2, lbound(InData%CNPD), ubound(InData%CNPD)) + call RegPack(Buf, InData%CNPD) + end if + call RegPack(Buf, allocated(InData%CNPD1)) + if (allocated(InData%CNPD1)) then + call RegPackBounds(Buf, 2, lbound(InData%CNPD1), ubound(InData%CNPD1)) + call RegPack(Buf, InData%CNPD1) + end if + call RegPack(Buf, allocated(InData%CNPOT)) + if (allocated(InData%CNPOT)) then + call RegPackBounds(Buf, 2, lbound(InData%CNPOT), ubound(InData%CNPOT)) + call RegPack(Buf, InData%CNPOT) + end if + call RegPack(Buf, allocated(InData%CNPOT1)) + if (allocated(InData%CNPOT1)) then + call RegPackBounds(Buf, 2, lbound(InData%CNPOT1), ubound(InData%CNPOT1)) + call RegPack(Buf, InData%CNPOT1) + end if + call RegPack(Buf, allocated(InData%CNS)) + if (allocated(InData%CNS)) then + call RegPackBounds(Buf, 2, lbound(InData%CNS), ubound(InData%CNS)) + call RegPack(Buf, InData%CNS) + end if + call RegPack(Buf, allocated(InData%CNSL)) + if (allocated(InData%CNSL)) then + call RegPackBounds(Buf, 2, lbound(InData%CNSL), ubound(InData%CNSL)) + call RegPack(Buf, InData%CNSL) + end if + call RegPack(Buf, allocated(InData%CNV)) + if (allocated(InData%CNV)) then + call RegPackBounds(Buf, 2, lbound(InData%CNV), ubound(InData%CNV)) + call RegPack(Buf, InData%CNV) + end if + call RegPack(Buf, allocated(InData%CVN)) + if (allocated(InData%CVN)) then + call RegPackBounds(Buf, 2, lbound(InData%CVN), ubound(InData%CVN)) + call RegPack(Buf, InData%CVN) + end if + call RegPack(Buf, allocated(InData%CVN1)) + if (allocated(InData%CVN1)) then + call RegPackBounds(Buf, 2, lbound(InData%CVN1), ubound(InData%CVN1)) + call RegPack(Buf, InData%CVN1) + end if + call RegPack(Buf, allocated(InData%DF)) + if (allocated(InData%DF)) then + call RegPackBounds(Buf, 2, lbound(InData%DF), ubound(InData%DF)) + call RegPack(Buf, InData%DF) + end if + call RegPack(Buf, allocated(InData%DFAFE)) + if (allocated(InData%DFAFE)) then + call RegPackBounds(Buf, 2, lbound(InData%DFAFE), ubound(InData%DFAFE)) + call RegPack(Buf, InData%DFAFE) + end if + call RegPack(Buf, allocated(InData%DFAFE1)) + if (allocated(InData%DFAFE1)) then + call RegPackBounds(Buf, 2, lbound(InData%DFAFE1), ubound(InData%DFAFE1)) + call RegPack(Buf, InData%DFAFE1) + end if + call RegPack(Buf, allocated(InData%DFC)) + if (allocated(InData%DFC)) then + call RegPackBounds(Buf, 2, lbound(InData%DFC), ubound(InData%DFC)) + call RegPack(Buf, InData%DFC) + end if + call RegPack(Buf, allocated(InData%DN)) + if (allocated(InData%DN)) then + call RegPackBounds(Buf, 2, lbound(InData%DN), ubound(InData%DN)) + call RegPack(Buf, InData%DN) + end if + call RegPack(Buf, allocated(InData%DPP)) + if (allocated(InData%DPP)) then + call RegPackBounds(Buf, 2, lbound(InData%DPP), ubound(InData%DPP)) + call RegPack(Buf, InData%DPP) + end if + call RegPack(Buf, allocated(InData%DQ)) + if (allocated(InData%DQ)) then + call RegPackBounds(Buf, 2, lbound(InData%DQ), ubound(InData%DQ)) + call RegPack(Buf, InData%DQ) + end if + call RegPack(Buf, allocated(InData%DQP)) + if (allocated(InData%DQP)) then + call RegPackBounds(Buf, 2, lbound(InData%DQP), ubound(InData%DQP)) + call RegPack(Buf, InData%DQP) + end if + call RegPack(Buf, allocated(InData%DQP1)) + if (allocated(InData%DQP1)) then + call RegPackBounds(Buf, 2, lbound(InData%DQP1), ubound(InData%DQP1)) + call RegPack(Buf, InData%DQP1) + end if + call RegPack(Buf, InData%DS) + call RegPack(Buf, InData%FK) + call RegPack(Buf, InData%FP) + call RegPack(Buf, InData%FPC) + call RegPack(Buf, allocated(InData%FSP)) + if (allocated(InData%FSP)) then + call RegPackBounds(Buf, 2, lbound(InData%FSP), ubound(InData%FSP)) + call RegPack(Buf, InData%FSP) + end if + call RegPack(Buf, allocated(InData%FSP1)) + if (allocated(InData%FSP1)) then + call RegPackBounds(Buf, 2, lbound(InData%FSP1), ubound(InData%FSP1)) + call RegPack(Buf, InData%FSP1) + end if + call RegPack(Buf, allocated(InData%FSPC)) + if (allocated(InData%FSPC)) then + call RegPackBounds(Buf, 2, lbound(InData%FSPC), ubound(InData%FSPC)) + call RegPack(Buf, InData%FSPC) + end if + call RegPack(Buf, allocated(InData%FSPC1)) + if (allocated(InData%FSPC1)) then + call RegPackBounds(Buf, 2, lbound(InData%FSPC1), ubound(InData%FSPC1)) + call RegPack(Buf, InData%FSPC1) + end if + call RegPack(Buf, allocated(InData%FTB)) + if (allocated(InData%FTB)) then + call RegPackBounds(Buf, 3, lbound(InData%FTB), ubound(InData%FTB)) + call RegPack(Buf, InData%FTB) + end if + call RegPack(Buf, allocated(InData%FTBC)) + if (allocated(InData%FTBC)) then + call RegPackBounds(Buf, 3, lbound(InData%FTBC), ubound(InData%FTBC)) + call RegPack(Buf, InData%FTBC) + end if + call RegPack(Buf, allocated(InData%OLDCNV)) + if (allocated(InData%OLDCNV)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDCNV), ubound(InData%OLDCNV)) + call RegPack(Buf, InData%OLDCNV) + end if + call RegPack(Buf, allocated(InData%OLDDF)) + if (allocated(InData%OLDDF)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDDF), ubound(InData%OLDDF)) + call RegPack(Buf, InData%OLDDF) + end if + call RegPack(Buf, allocated(InData%OLDDFC)) + if (allocated(InData%OLDDFC)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDDFC), ubound(InData%OLDDFC)) + call RegPack(Buf, InData%OLDDFC) + end if + call RegPack(Buf, allocated(InData%OLDDN)) + if (allocated(InData%OLDDN)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDDN), ubound(InData%OLDDN)) + call RegPack(Buf, InData%OLDDN) + end if + call RegPack(Buf, allocated(InData%OLDDPP)) + if (allocated(InData%OLDDPP)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDDPP), ubound(InData%OLDDPP)) + call RegPack(Buf, InData%OLDDPP) + end if + call RegPack(Buf, allocated(InData%OLDDQ)) + if (allocated(InData%OLDDQ)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDDQ), ubound(InData%OLDDQ)) + call RegPack(Buf, InData%OLDDQ) + end if + call RegPack(Buf, allocated(InData%OLDTAU)) + if (allocated(InData%OLDTAU)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDTAU), ubound(InData%OLDTAU)) + call RegPack(Buf, InData%OLDTAU) + end if + call RegPack(Buf, allocated(InData%OLDXN)) + if (allocated(InData%OLDXN)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDXN), ubound(InData%OLDXN)) + call RegPack(Buf, InData%OLDXN) + end if + call RegPack(Buf, allocated(InData%OLDYN)) + if (allocated(InData%OLDYN)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDYN), ubound(InData%OLDYN)) + call RegPack(Buf, InData%OLDYN) + end if + call RegPack(Buf, allocated(InData%QX)) + if (allocated(InData%QX)) then + call RegPackBounds(Buf, 2, lbound(InData%QX), ubound(InData%QX)) + call RegPack(Buf, InData%QX) + end if + call RegPack(Buf, allocated(InData%QX1)) + if (allocated(InData%QX1)) then + call RegPackBounds(Buf, 2, lbound(InData%QX1), ubound(InData%QX1)) + call RegPack(Buf, InData%QX1) + end if + call RegPack(Buf, allocated(InData%TAU)) + if (allocated(InData%TAU)) then + call RegPackBounds(Buf, 2, lbound(InData%TAU), ubound(InData%TAU)) + call RegPack(Buf, InData%TAU) + end if + call RegPack(Buf, allocated(InData%XN)) + if (allocated(InData%XN)) then + call RegPackBounds(Buf, 2, lbound(InData%XN), ubound(InData%XN)) + call RegPack(Buf, InData%XN) + end if + call RegPack(Buf, allocated(InData%YN)) + if (allocated(InData%YN)) then + call RegPackBounds(Buf, 2, lbound(InData%YN), ubound(InData%YN)) + call RegPack(Buf, InData%YN) + end if + call RegPack(Buf, InData%SHIFT) + call RegPack(Buf, InData%VOR) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackBeddoes(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Beddoes), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackBeddoes' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%ADOT)) deallocate(OutData%ADOT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ADOT(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ADOT) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ADOT1)) deallocate(OutData%ADOT1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ADOT1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ADOT1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AFE)) deallocate(OutData%AFE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AFE1)) deallocate(OutData%AFE1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFE1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFE1) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%AN) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ANE)) deallocate(OutData%ANE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ANE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ANE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ANE1)) deallocate(OutData%ANE1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ANE1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ANE1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AOD)) deallocate(OutData%AOD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AOD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AOD) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AOL)) deallocate(OutData%AOL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AOL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AOL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BEDSEP)) deallocate(OutData%BEDSEP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BEDSEP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BEDSEP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OLDSEP)) deallocate(OutData%OLDSEP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDSEP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDSEP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDSEP) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%CC) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%CDO)) deallocate(OutData%CDO) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CDO(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDO.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CDO) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%CMI) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CMQ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CN) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%CNA)) deallocate(OutData%CNA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNA(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNA) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%CNCP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CNIQ) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%CNP)) deallocate(OutData%CNP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CNP1)) deallocate(OutData%CNP1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNP1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNP1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CNPD)) deallocate(OutData%CNPD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNPD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNPD) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CNPD1)) deallocate(OutData%CNPD1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNPD1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNPD1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CNPOT)) deallocate(OutData%CNPOT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNPOT(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNPOT) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CNPOT1)) deallocate(OutData%CNPOT1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNPOT1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNPOT1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CNS)) deallocate(OutData%CNS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CNSL)) deallocate(OutData%CNSL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNSL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNSL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNSL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CNV)) deallocate(OutData%CNV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNV(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNV) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CVN)) deallocate(OutData%CVN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CVN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CVN) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CVN1)) deallocate(OutData%CVN1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CVN1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CVN1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DF)) deallocate(OutData%DF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DFAFE)) deallocate(OutData%DFAFE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DFAFE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DFAFE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DFAFE1)) deallocate(OutData%DFAFE1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DFAFE1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DFAFE1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DFC)) deallocate(OutData%DFC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DFC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DFC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DN)) deallocate(OutData%DN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DN) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DPP)) deallocate(OutData%DPP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DPP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DPP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DPP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DQ)) deallocate(OutData%DQ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DQ(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DQ) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DQP)) deallocate(OutData%DQP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DQP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DQP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DQP1)) deallocate(OutData%DQP1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DQP1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DQP1) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%DS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FPC) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%FSP)) deallocate(OutData%FSP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FSP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FSP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FSP1)) deallocate(OutData%FSP1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FSP1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FSP1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FSPC)) deallocate(OutData%FSPC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FSPC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FSPC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FSPC1)) deallocate(OutData%FSPC1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FSPC1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FSPC1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FTB)) deallocate(OutData%FTB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FTB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FTB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FTBC)) deallocate(OutData%FTBC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FTBC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTBC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FTBC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OLDCNV)) deallocate(OutData%OLDCNV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDCNV(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDCNV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDCNV) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OLDDF)) deallocate(OutData%OLDDF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDDF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDDF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OLDDFC)) deallocate(OutData%OLDDFC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDDFC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDFC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDDFC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OLDDN)) deallocate(OutData%OLDDN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDDN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDDN) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OLDDPP)) deallocate(OutData%OLDDPP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDDPP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDPP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDDPP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OLDDQ)) deallocate(OutData%OLDDQ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDDQ(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDQ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDDQ) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OLDTAU)) deallocate(OutData%OLDTAU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDTAU(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDTAU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDTAU) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OLDXN)) deallocate(OutData%OLDXN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDXN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDXN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDXN) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OLDYN)) deallocate(OutData%OLDYN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDYN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDYN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDYN) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%QX)) deallocate(OutData%QX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QX(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%QX1)) deallocate(OutData%QX1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QX1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QX1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TAU)) deallocate(OutData%TAU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TAU(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TAU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TAU) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%XN)) deallocate(OutData%XN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%XN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%XN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%XN) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%YN)) deallocate(OutData%YN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%YN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%YN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%YN) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%SHIFT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VOR) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyBeddoesParms(SrcBeddoesParmsData, DstBeddoesParmsData, CtrlCode, ErrStat, ErrMsg) + type(BeddoesParms), intent(in) :: SrcBeddoesParmsData + type(BeddoesParms), intent(inout) :: DstBeddoesParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyBeddoesParms' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_CopyInitOutput( SrcInitOutputData%DWM, DstInitOutputData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%AirDens = SrcInitOutputData%AirDens - END SUBROUTINE AD14_CopyInitOutput - - SUBROUTINE AD14_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(AD14_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 = 'AD14_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyInitOutput( InitOutputData%DWM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyInitOutput - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! AirDens - 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 - - 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 - - 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 - CALL DWM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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%AirDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackInitOutput - - SUBROUTINE AD14_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(AD14_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_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 - 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) - 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 DWM_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackInitOutput - - SUBROUTINE AD14_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(AD14_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 = 'AD14_CopyContState' -! + ErrMsg = '' + DstBeddoesParmsData%AS = SrcBeddoesParmsData%AS + DstBeddoesParmsData%TF = SrcBeddoesParmsData%TF + DstBeddoesParmsData%TP = SrcBeddoesParmsData%TP + DstBeddoesParmsData%TV = SrcBeddoesParmsData%TV + DstBeddoesParmsData%TVL = SrcBeddoesParmsData%TVL +end subroutine + +subroutine AD14_DestroyBeddoesParms(BeddoesParmsData, ErrStat, ErrMsg) + type(BeddoesParms), intent(inout) :: BeddoesParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyBeddoesParms' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD14_PackBeddoesParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BeddoesParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackBeddoesParms' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%AS) + call RegPack(Buf, InData%TF) + call RegPack(Buf, InData%TP) + call RegPack(Buf, InData%TV) + call RegPack(Buf, InData%TVL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackBeddoesParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BeddoesParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackBeddoesParms' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%AS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TVL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyBladeParms(SrcBladeParmsData, DstBladeParmsData, CtrlCode, ErrStat, ErrMsg) + type(BladeParms), intent(in) :: SrcBladeParmsData + type(BladeParms), intent(inout) :: DstBladeParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyBladeParms' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcBladeParmsData%C)) then + LB(1:1) = lbound(SrcBladeParmsData%C) + UB(1:1) = ubound(SrcBladeParmsData%C) + if (.not. allocated(DstBladeParmsData%C)) then + allocate(DstBladeParmsData%C(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeParmsData%C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeParmsData%C = SrcBladeParmsData%C + end if + if (allocated(SrcBladeParmsData%DR)) then + LB(1:1) = lbound(SrcBladeParmsData%DR) + UB(1:1) = ubound(SrcBladeParmsData%DR) + if (.not. allocated(DstBladeParmsData%DR)) then + allocate(DstBladeParmsData%DR(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeParmsData%DR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeParmsData%DR = SrcBladeParmsData%DR + end if + DstBladeParmsData%R = SrcBladeParmsData%R + DstBladeParmsData%BladeLength = SrcBladeParmsData%BladeLength +end subroutine + +subroutine AD14_DestroyBladeParms(BladeParmsData, ErrStat, ErrMsg) + type(BladeParms), intent(inout) :: BladeParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyBladeParms' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladeParmsData%C)) then + deallocate(BladeParmsData%C) + end if + if (allocated(BladeParmsData%DR)) then + deallocate(BladeParmsData%DR) + end if +end subroutine + +subroutine AD14_PackBladeParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BladeParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackBladeParms' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%C)) + if (allocated(InData%C)) then + call RegPackBounds(Buf, 1, lbound(InData%C), ubound(InData%C)) + call RegPack(Buf, InData%C) + end if + call RegPack(Buf, allocated(InData%DR)) + if (allocated(InData%DR)) then + call RegPackBounds(Buf, 1, lbound(InData%DR), ubound(InData%DR)) + call RegPack(Buf, InData%DR) + end if + call RegPack(Buf, InData%R) + call RegPack(Buf, InData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackBladeParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BladeParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackBladeParms' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%C)) deallocate(OutData%C) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DR)) deallocate(OutData%DR) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DR(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DR) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%R) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyDynInflow(SrcDynInflowData, DstDynInflowData, CtrlCode, ErrStat, ErrMsg) + type(DynInflow), intent(in) :: SrcDynInflowData + type(DynInflow), intent(inout) :: DstDynInflowData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyDynInflow' + ErrStat = ErrID_None + ErrMsg = '' + DstDynInflowData%dAlph_dt = SrcDynInflowData%dAlph_dt + DstDynInflowData%dBeta_dt = SrcDynInflowData%dBeta_dt + DstDynInflowData%DTO = SrcDynInflowData%DTO + DstDynInflowData%old_Alph = SrcDynInflowData%old_Alph + DstDynInflowData%old_Beta = SrcDynInflowData%old_Beta + DstDynInflowData%old_LmdM = SrcDynInflowData%old_LmdM + DstDynInflowData%oldKai = SrcDynInflowData%oldKai + DstDynInflowData%PhiLqC = SrcDynInflowData%PhiLqC + DstDynInflowData%PhiLqS = SrcDynInflowData%PhiLqS + DstDynInflowData%Pzero = SrcDynInflowData%Pzero + if (allocated(SrcDynInflowData%RMC_SAVE)) then + LB(1:3) = lbound(SrcDynInflowData%RMC_SAVE) + UB(1:3) = ubound(SrcDynInflowData%RMC_SAVE) + if (.not. allocated(DstDynInflowData%RMC_SAVE)) then + allocate(DstDynInflowData%RMC_SAVE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDynInflowData%RMC_SAVE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDynInflowData%RMC_SAVE = SrcDynInflowData%RMC_SAVE + end if + if (allocated(SrcDynInflowData%RMS_SAVE)) then + LB(1:3) = lbound(SrcDynInflowData%RMS_SAVE) + UB(1:3) = ubound(SrcDynInflowData%RMS_SAVE) + if (.not. allocated(DstDynInflowData%RMS_SAVE)) then + allocate(DstDynInflowData%RMS_SAVE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDynInflowData%RMS_SAVE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDynInflowData%RMS_SAVE = SrcDynInflowData%RMS_SAVE + end if + DstDynInflowData%TipSpeed = SrcDynInflowData%TipSpeed + DstDynInflowData%totalInf = SrcDynInflowData%totalInf + DstDynInflowData%Vparam = SrcDynInflowData%Vparam + DstDynInflowData%Vtotal = SrcDynInflowData%Vtotal + DstDynInflowData%xAlpha = SrcDynInflowData%xAlpha + DstDynInflowData%xBeta = SrcDynInflowData%xBeta + DstDynInflowData%xKai = SrcDynInflowData%xKai + DstDynInflowData%XLAMBDA_M = SrcDynInflowData%XLAMBDA_M + DstDynInflowData%xLcos = SrcDynInflowData%xLcos + DstDynInflowData%xLsin = SrcDynInflowData%xLsin + DstDynInflowData%MminR = SrcDynInflowData%MminR + DstDynInflowData%MminusR = SrcDynInflowData%MminusR + DstDynInflowData%MplusR = SrcDynInflowData%MplusR + DstDynInflowData%GAMMA = SrcDynInflowData%GAMMA +end subroutine + +subroutine AD14_DestroyDynInflow(DynInflowData, ErrStat, ErrMsg) + type(DynInflow), intent(inout) :: DynInflowData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyDynInflow' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DynInflowData%RMC_SAVE)) then + deallocate(DynInflowData%RMC_SAVE) + end if + if (allocated(DynInflowData%RMS_SAVE)) then + deallocate(DynInflowData%RMS_SAVE) + end if +end subroutine + +subroutine AD14_PackDynInflow(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DynInflow), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackDynInflow' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dAlph_dt) + call RegPack(Buf, InData%dBeta_dt) + call RegPack(Buf, InData%DTO) + call RegPack(Buf, InData%old_Alph) + call RegPack(Buf, InData%old_Beta) + call RegPack(Buf, InData%old_LmdM) + call RegPack(Buf, InData%oldKai) + call RegPack(Buf, InData%PhiLqC) + call RegPack(Buf, InData%PhiLqS) + call RegPack(Buf, InData%Pzero) + call RegPack(Buf, allocated(InData%RMC_SAVE)) + if (allocated(InData%RMC_SAVE)) then + call RegPackBounds(Buf, 3, lbound(InData%RMC_SAVE), ubound(InData%RMC_SAVE)) + call RegPack(Buf, InData%RMC_SAVE) + end if + call RegPack(Buf, allocated(InData%RMS_SAVE)) + if (allocated(InData%RMS_SAVE)) then + call RegPackBounds(Buf, 3, lbound(InData%RMS_SAVE), ubound(InData%RMS_SAVE)) + call RegPack(Buf, InData%RMS_SAVE) + end if + call RegPack(Buf, InData%TipSpeed) + call RegPack(Buf, InData%totalInf) + call RegPack(Buf, InData%Vparam) + call RegPack(Buf, InData%Vtotal) + call RegPack(Buf, InData%xAlpha) + call RegPack(Buf, InData%xBeta) + call RegPack(Buf, InData%xKai) + call RegPack(Buf, InData%XLAMBDA_M) + call RegPack(Buf, InData%xLcos) + call RegPack(Buf, InData%xLsin) + call RegPack(Buf, InData%MminR) + call RegPack(Buf, InData%MminusR) + call RegPack(Buf, InData%MplusR) + call RegPack(Buf, InData%GAMMA) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackDynInflow(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DynInflow), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackDynInflow' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dAlph_dt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dBeta_dt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DTO) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%old_Alph) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%old_Beta) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%old_LmdM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%oldKai) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PhiLqC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PhiLqS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Pzero) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%RMC_SAVE)) deallocate(OutData%RMC_SAVE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RMC_SAVE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMC_SAVE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RMC_SAVE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RMS_SAVE)) deallocate(OutData%RMS_SAVE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RMS_SAVE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMS_SAVE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RMS_SAVE) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%TipSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%totalInf) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Vparam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Vtotal) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%xAlpha) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%xBeta) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%xKai) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%XLAMBDA_M) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%xLcos) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%xLsin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MminR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MminusR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MplusR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GAMMA) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyDynInflowParms(SrcDynInflowParmsData, DstDynInflowParmsData, CtrlCode, ErrStat, ErrMsg) + type(DynInflowParms), intent(in) :: SrcDynInflowParmsData + type(DynInflowParms), intent(inout) :: DstDynInflowParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyDynInflowParms' + ErrStat = ErrID_None + ErrMsg = '' + DstDynInflowParmsData%MAXINFLO = SrcDynInflowParmsData%MAXINFLO + DstDynInflowParmsData%xMinv = SrcDynInflowParmsData%xMinv +end subroutine + +subroutine AD14_DestroyDynInflowParms(DynInflowParmsData, ErrStat, ErrMsg) + type(DynInflowParms), intent(inout) :: DynInflowParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyDynInflowParms' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD14_PackDynInflowParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DynInflowParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackDynInflowParms' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%MAXINFLO) + call RegPack(Buf, InData%xMinv) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackDynInflowParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DynInflowParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackDynInflowParms' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%MAXINFLO) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%xMinv) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, ErrMsg) + type(Element), intent(in) :: SrcElementData + type(Element), intent(inout) :: DstElementData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyElement' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcElementData%A)) then + LB(1:2) = lbound(SrcElementData%A) + UB(1:2) = ubound(SrcElementData%A) + if (.not. allocated(DstElementData%A)) then + allocate(DstElementData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementData%A = SrcElementData%A + end if + if (allocated(SrcElementData%AP)) then + LB(1:2) = lbound(SrcElementData%AP) + UB(1:2) = ubound(SrcElementData%AP) + if (.not. allocated(DstElementData%AP)) then + allocate(DstElementData%AP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%AP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementData%AP = SrcElementData%AP + end if + if (allocated(SrcElementData%ALPHA)) then + LB(1:2) = lbound(SrcElementData%ALPHA) + UB(1:2) = ubound(SrcElementData%ALPHA) + if (.not. allocated(DstElementData%ALPHA)) then + allocate(DstElementData%ALPHA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%ALPHA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementData%ALPHA = SrcElementData%ALPHA + end if + if (allocated(SrcElementData%W2)) then + LB(1:2) = lbound(SrcElementData%W2) + UB(1:2) = ubound(SrcElementData%W2) + if (.not. allocated(DstElementData%W2)) then + allocate(DstElementData%W2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%W2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementData%W2 = SrcElementData%W2 + end if + if (allocated(SrcElementData%OLD_A_NS)) then + LB(1:2) = lbound(SrcElementData%OLD_A_NS) + UB(1:2) = ubound(SrcElementData%OLD_A_NS) + if (.not. allocated(DstElementData%OLD_A_NS)) then + allocate(DstElementData%OLD_A_NS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%OLD_A_NS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementData%OLD_A_NS = SrcElementData%OLD_A_NS + end if + if (allocated(SrcElementData%OLD_AP_NS)) then + LB(1:2) = lbound(SrcElementData%OLD_AP_NS) + UB(1:2) = ubound(SrcElementData%OLD_AP_NS) + if (.not. allocated(DstElementData%OLD_AP_NS)) then + allocate(DstElementData%OLD_AP_NS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%OLD_AP_NS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementData%OLD_AP_NS = SrcElementData%OLD_AP_NS + end if + if (allocated(SrcElementData%PITNOW)) then + LB(1:2) = lbound(SrcElementData%PITNOW) + UB(1:2) = ubound(SrcElementData%PITNOW) + if (.not. allocated(DstElementData%PITNOW)) then + allocate(DstElementData%PITNOW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%PITNOW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementData%PITNOW = SrcElementData%PITNOW + end if +end subroutine + +subroutine AD14_DestroyElement(ElementData, ErrStat, ErrMsg) + type(Element), intent(inout) :: ElementData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyElement' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ElementData%A)) then + deallocate(ElementData%A) + end if + if (allocated(ElementData%AP)) then + deallocate(ElementData%AP) + end if + if (allocated(ElementData%ALPHA)) then + deallocate(ElementData%ALPHA) + end if + if (allocated(ElementData%W2)) then + deallocate(ElementData%W2) + end if + if (allocated(ElementData%OLD_A_NS)) then + deallocate(ElementData%OLD_A_NS) + end if + if (allocated(ElementData%OLD_AP_NS)) then + deallocate(ElementData%OLD_AP_NS) + end if + if (allocated(ElementData%PITNOW)) then + deallocate(ElementData%PITNOW) + end if +end subroutine + +subroutine AD14_PackElement(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Element), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackElement' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%A)) + if (allocated(InData%A)) then + call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) + call RegPack(Buf, InData%A) + end if + call RegPack(Buf, allocated(InData%AP)) + if (allocated(InData%AP)) then + call RegPackBounds(Buf, 2, lbound(InData%AP), ubound(InData%AP)) + call RegPack(Buf, InData%AP) + end if + call RegPack(Buf, allocated(InData%ALPHA)) + if (allocated(InData%ALPHA)) then + call RegPackBounds(Buf, 2, lbound(InData%ALPHA), ubound(InData%ALPHA)) + call RegPack(Buf, InData%ALPHA) + end if + call RegPack(Buf, allocated(InData%W2)) + if (allocated(InData%W2)) then + call RegPackBounds(Buf, 2, lbound(InData%W2), ubound(InData%W2)) + call RegPack(Buf, InData%W2) + end if + call RegPack(Buf, allocated(InData%OLD_A_NS)) + if (allocated(InData%OLD_A_NS)) then + call RegPackBounds(Buf, 2, lbound(InData%OLD_A_NS), ubound(InData%OLD_A_NS)) + call RegPack(Buf, InData%OLD_A_NS) + end if + call RegPack(Buf, allocated(InData%OLD_AP_NS)) + if (allocated(InData%OLD_AP_NS)) then + call RegPackBounds(Buf, 2, lbound(InData%OLD_AP_NS), ubound(InData%OLD_AP_NS)) + call RegPack(Buf, InData%OLD_AP_NS) + end if + call RegPack(Buf, allocated(InData%PITNOW)) + if (allocated(InData%PITNOW)) then + call RegPackBounds(Buf, 2, lbound(InData%PITNOW), ubound(InData%PITNOW)) + call RegPack(Buf, InData%PITNOW) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackElement(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Element), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackElement' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%A)) deallocate(OutData%A) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%A(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%A) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AP)) deallocate(OutData%AP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ALPHA)) deallocate(OutData%ALPHA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ALPHA(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALPHA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ALPHA) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%W2)) deallocate(OutData%W2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W2(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%W2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OLD_A_NS)) deallocate(OutData%OLD_A_NS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLD_A_NS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_A_NS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLD_A_NS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OLD_AP_NS)) deallocate(OutData%OLD_AP_NS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLD_AP_NS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_AP_NS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLD_AP_NS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PITNOW)) deallocate(OutData%PITNOW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PITNOW(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITNOW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PITNOW) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD14_CopyElementParms(SrcElementParmsData, DstElementParmsData, CtrlCode, ErrStat, ErrMsg) + type(ElementParms), intent(in) :: SrcElementParmsData + type(ElementParms), intent(inout) :: DstElementParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyElementParms' + ErrStat = ErrID_None + ErrMsg = '' + DstElementParmsData%NELM = SrcElementParmsData%NELM + if (allocated(SrcElementParmsData%TWIST)) then + LB(1:1) = lbound(SrcElementParmsData%TWIST) + UB(1:1) = ubound(SrcElementParmsData%TWIST) + if (.not. allocated(DstElementParmsData%TWIST)) then + allocate(DstElementParmsData%TWIST(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%TWIST.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementParmsData%TWIST = SrcElementParmsData%TWIST + end if + if (allocated(SrcElementParmsData%RELM)) then + LB(1:1) = lbound(SrcElementParmsData%RELM) + UB(1:1) = ubound(SrcElementParmsData%RELM) + if (.not. allocated(DstElementParmsData%RELM)) then + allocate(DstElementParmsData%RELM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%RELM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementParmsData%RELM = SrcElementParmsData%RELM + end if + if (allocated(SrcElementParmsData%HLCNST)) then + LB(1:1) = lbound(SrcElementParmsData%HLCNST) + UB(1:1) = ubound(SrcElementParmsData%HLCNST) + if (.not. allocated(DstElementParmsData%HLCNST)) then + allocate(DstElementParmsData%HLCNST(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%HLCNST.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementParmsData%HLCNST = SrcElementParmsData%HLCNST + end if + if (allocated(SrcElementParmsData%TLCNST)) then + LB(1:1) = lbound(SrcElementParmsData%TLCNST) + UB(1:1) = ubound(SrcElementParmsData%TLCNST) + if (.not. allocated(DstElementParmsData%TLCNST)) then + allocate(DstElementParmsData%TLCNST(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%TLCNST.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementParmsData%TLCNST = SrcElementParmsData%TLCNST + end if +end subroutine + +subroutine AD14_DestroyElementParms(ElementParmsData, ErrStat, ErrMsg) + type(ElementParms), intent(inout) :: ElementParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyElementParms' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ElementParmsData%TWIST)) then + deallocate(ElementParmsData%TWIST) + end if + if (allocated(ElementParmsData%RELM)) then + deallocate(ElementParmsData%RELM) + end if + if (allocated(ElementParmsData%HLCNST)) then + deallocate(ElementParmsData%HLCNST) + end if + if (allocated(ElementParmsData%TLCNST)) then + deallocate(ElementParmsData%TLCNST) + end if +end subroutine + +subroutine AD14_PackElementParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ElementParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackElementParms' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%NELM) + call RegPack(Buf, allocated(InData%TWIST)) + if (allocated(InData%TWIST)) then + call RegPackBounds(Buf, 1, lbound(InData%TWIST), ubound(InData%TWIST)) + call RegPack(Buf, InData%TWIST) + end if + call RegPack(Buf, allocated(InData%RELM)) + if (allocated(InData%RELM)) then + call RegPackBounds(Buf, 1, lbound(InData%RELM), ubound(InData%RELM)) + call RegPack(Buf, InData%RELM) + end if + call RegPack(Buf, allocated(InData%HLCNST)) + if (allocated(InData%HLCNST)) then + call RegPackBounds(Buf, 1, lbound(InData%HLCNST), ubound(InData%HLCNST)) + call RegPack(Buf, InData%HLCNST) + end if + call RegPack(Buf, allocated(InData%TLCNST)) + if (allocated(InData%TLCNST)) then + call RegPackBounds(Buf, 1, lbound(InData%TLCNST), ubound(InData%TLCNST)) + call RegPack(Buf, InData%TLCNST) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackElementParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ElementParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackElementParms' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NELM) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TWIST)) deallocate(OutData%TWIST) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TWIST(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TWIST.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TWIST) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RELM)) deallocate(OutData%RELM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RELM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RELM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RELM) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%HLCNST)) deallocate(OutData%HLCNST) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HLCNST(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HLCNST.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HLCNST) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TLCNST)) deallocate(OutData%TLCNST) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TLCNST(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TLCNST.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TLCNST) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, ErrStat, ErrMsg) + type(ElOutParms), intent(in) :: SrcElOutParmsData + type(ElOutParms), intent(inout) :: DstElOutParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyElOutParms' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcElOutParmsData%AAA)) then + LB(1:1) = lbound(SrcElOutParmsData%AAA) + UB(1:1) = ubound(SrcElOutParmsData%AAA) + if (.not. allocated(DstElOutParmsData%AAA)) then + allocate(DstElOutParmsData%AAA(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%AAA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%AAA = SrcElOutParmsData%AAA + end if + if (allocated(SrcElOutParmsData%AAP)) then + LB(1:1) = lbound(SrcElOutParmsData%AAP) + UB(1:1) = ubound(SrcElOutParmsData%AAP) + if (.not. allocated(DstElOutParmsData%AAP)) then + allocate(DstElOutParmsData%AAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%AAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%AAP = SrcElOutParmsData%AAP + end if + if (allocated(SrcElOutParmsData%ALF)) then + LB(1:1) = lbound(SrcElOutParmsData%ALF) + UB(1:1) = ubound(SrcElOutParmsData%ALF) + if (.not. allocated(DstElOutParmsData%ALF)) then + allocate(DstElOutParmsData%ALF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ALF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%ALF = SrcElOutParmsData%ALF + end if + if (allocated(SrcElOutParmsData%CDD)) then + LB(1:1) = lbound(SrcElOutParmsData%CDD) + UB(1:1) = ubound(SrcElOutParmsData%CDD) + if (.not. allocated(DstElOutParmsData%CDD)) then + allocate(DstElOutParmsData%CDD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CDD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%CDD = SrcElOutParmsData%CDD + end if + if (allocated(SrcElOutParmsData%CLL)) then + LB(1:1) = lbound(SrcElOutParmsData%CLL) + UB(1:1) = ubound(SrcElOutParmsData%CLL) + if (.not. allocated(DstElOutParmsData%CLL)) then + allocate(DstElOutParmsData%CLL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CLL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%CLL = SrcElOutParmsData%CLL + end if + if (allocated(SrcElOutParmsData%CMM)) then + LB(1:1) = lbound(SrcElOutParmsData%CMM) + UB(1:1) = ubound(SrcElOutParmsData%CMM) + if (.not. allocated(DstElOutParmsData%CMM)) then + allocate(DstElOutParmsData%CMM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CMM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%CMM = SrcElOutParmsData%CMM + end if + if (allocated(SrcElOutParmsData%CNN)) then + LB(1:1) = lbound(SrcElOutParmsData%CNN) + UB(1:1) = ubound(SrcElOutParmsData%CNN) + if (.not. allocated(DstElOutParmsData%CNN)) then + allocate(DstElOutParmsData%CNN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CNN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%CNN = SrcElOutParmsData%CNN + end if + if (allocated(SrcElOutParmsData%CTT)) then + LB(1:1) = lbound(SrcElOutParmsData%CTT) + UB(1:1) = ubound(SrcElOutParmsData%CTT) + if (.not. allocated(DstElOutParmsData%CTT)) then + allocate(DstElOutParmsData%CTT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CTT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%CTT = SrcElOutParmsData%CTT + end if + if (allocated(SrcElOutParmsData%DFNSAV)) then + LB(1:1) = lbound(SrcElOutParmsData%DFNSAV) + UB(1:1) = ubound(SrcElOutParmsData%DFNSAV) + if (.not. allocated(DstElOutParmsData%DFNSAV)) then + allocate(DstElOutParmsData%DFNSAV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%DFNSAV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%DFNSAV = SrcElOutParmsData%DFNSAV + end if + if (allocated(SrcElOutParmsData%DFTSAV)) then + LB(1:1) = lbound(SrcElOutParmsData%DFTSAV) + UB(1:1) = ubound(SrcElOutParmsData%DFTSAV) + if (.not. allocated(DstElOutParmsData%DFTSAV)) then + allocate(DstElOutParmsData%DFTSAV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%DFTSAV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%DFTSAV = SrcElOutParmsData%DFTSAV + end if + if (allocated(SrcElOutParmsData%DynPres)) then + LB(1:1) = lbound(SrcElOutParmsData%DynPres) + UB(1:1) = ubound(SrcElOutParmsData%DynPres) + if (.not. allocated(DstElOutParmsData%DynPres)) then + allocate(DstElOutParmsData%DynPres(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%DynPres.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%DynPres = SrcElOutParmsData%DynPres + end if + if (allocated(SrcElOutParmsData%PMM)) then + LB(1:1) = lbound(SrcElOutParmsData%PMM) + UB(1:1) = ubound(SrcElOutParmsData%PMM) + if (.not. allocated(DstElOutParmsData%PMM)) then + allocate(DstElOutParmsData%PMM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%PMM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%PMM = SrcElOutParmsData%PMM + end if + if (allocated(SrcElOutParmsData%PITSAV)) then + LB(1:1) = lbound(SrcElOutParmsData%PITSAV) + UB(1:1) = ubound(SrcElOutParmsData%PITSAV) + if (.not. allocated(DstElOutParmsData%PITSAV)) then + allocate(DstElOutParmsData%PITSAV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%PITSAV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%PITSAV = SrcElOutParmsData%PITSAV + end if + if (allocated(SrcElOutParmsData%ReyNum)) then + LB(1:1) = lbound(SrcElOutParmsData%ReyNum) + UB(1:1) = ubound(SrcElOutParmsData%ReyNum) + if (.not. allocated(DstElOutParmsData%ReyNum)) then + allocate(DstElOutParmsData%ReyNum(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ReyNum.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%ReyNum = SrcElOutParmsData%ReyNum + end if + if (allocated(SrcElOutParmsData%Gamma)) then + LB(1:1) = lbound(SrcElOutParmsData%Gamma) + UB(1:1) = ubound(SrcElOutParmsData%Gamma) + if (.not. allocated(DstElOutParmsData%Gamma)) then + allocate(DstElOutParmsData%Gamma(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%Gamma.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%Gamma = SrcElOutParmsData%Gamma + end if + if (allocated(SrcElOutParmsData%SaveVX)) then + LB(1:2) = lbound(SrcElOutParmsData%SaveVX) + UB(1:2) = ubound(SrcElOutParmsData%SaveVX) + if (.not. allocated(DstElOutParmsData%SaveVX)) then + allocate(DstElOutParmsData%SaveVX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%SaveVX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%SaveVX = SrcElOutParmsData%SaveVX + end if + if (allocated(SrcElOutParmsData%SaveVY)) then + LB(1:2) = lbound(SrcElOutParmsData%SaveVY) + UB(1:2) = ubound(SrcElOutParmsData%SaveVY) + if (.not. allocated(DstElOutParmsData%SaveVY)) then + allocate(DstElOutParmsData%SaveVY(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%SaveVY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%SaveVY = SrcElOutParmsData%SaveVY + end if + if (allocated(SrcElOutParmsData%SaveVZ)) then + LB(1:2) = lbound(SrcElOutParmsData%SaveVZ) + UB(1:2) = ubound(SrcElOutParmsData%SaveVZ) + if (.not. allocated(DstElOutParmsData%SaveVZ)) then + allocate(DstElOutParmsData%SaveVZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%SaveVZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%SaveVZ = SrcElOutParmsData%SaveVZ + end if + DstElOutParmsData%VXSAV = SrcElOutParmsData%VXSAV + DstElOutParmsData%VYSAV = SrcElOutParmsData%VYSAV + DstElOutParmsData%VZSAV = SrcElOutParmsData%VZSAV + DstElOutParmsData%NumWndElOut = SrcElOutParmsData%NumWndElOut + if (allocated(SrcElOutParmsData%WndElPrList)) then + LB(1:1) = lbound(SrcElOutParmsData%WndElPrList) + UB(1:1) = ubound(SrcElOutParmsData%WndElPrList) + if (.not. allocated(DstElOutParmsData%WndElPrList)) then + allocate(DstElOutParmsData%WndElPrList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%WndElPrList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%WndElPrList = SrcElOutParmsData%WndElPrList + end if + if (allocated(SrcElOutParmsData%WndElPrNum)) then + LB(1:1) = lbound(SrcElOutParmsData%WndElPrNum) + UB(1:1) = ubound(SrcElOutParmsData%WndElPrNum) + if (.not. allocated(DstElOutParmsData%WndElPrNum)) then + allocate(DstElOutParmsData%WndElPrNum(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%WndElPrNum.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%WndElPrNum = SrcElOutParmsData%WndElPrNum + end if + if (allocated(SrcElOutParmsData%ElPrList)) then + LB(1:1) = lbound(SrcElOutParmsData%ElPrList) + UB(1:1) = ubound(SrcElOutParmsData%ElPrList) + if (.not. allocated(DstElOutParmsData%ElPrList)) then + allocate(DstElOutParmsData%ElPrList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ElPrList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%ElPrList = SrcElOutParmsData%ElPrList + end if + if (allocated(SrcElOutParmsData%ElPrNum)) then + LB(1:1) = lbound(SrcElOutParmsData%ElPrNum) + UB(1:1) = ubound(SrcElOutParmsData%ElPrNum) + if (.not. allocated(DstElOutParmsData%ElPrNum)) then + allocate(DstElOutParmsData%ElPrNum(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ElPrNum.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%ElPrNum = SrcElOutParmsData%ElPrNum + end if + DstElOutParmsData%NumElOut = SrcElOutParmsData%NumElOut +end subroutine + +subroutine AD14_DestroyElOutParms(ElOutParmsData, ErrStat, ErrMsg) + type(ElOutParms), intent(inout) :: ElOutParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyElOutParms' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ElOutParmsData%AAA)) then + deallocate(ElOutParmsData%AAA) + end if + if (allocated(ElOutParmsData%AAP)) then + deallocate(ElOutParmsData%AAP) + end if + if (allocated(ElOutParmsData%ALF)) then + deallocate(ElOutParmsData%ALF) + end if + if (allocated(ElOutParmsData%CDD)) then + deallocate(ElOutParmsData%CDD) + end if + if (allocated(ElOutParmsData%CLL)) then + deallocate(ElOutParmsData%CLL) + end if + if (allocated(ElOutParmsData%CMM)) then + deallocate(ElOutParmsData%CMM) + end if + if (allocated(ElOutParmsData%CNN)) then + deallocate(ElOutParmsData%CNN) + end if + if (allocated(ElOutParmsData%CTT)) then + deallocate(ElOutParmsData%CTT) + end if + if (allocated(ElOutParmsData%DFNSAV)) then + deallocate(ElOutParmsData%DFNSAV) + end if + if (allocated(ElOutParmsData%DFTSAV)) then + deallocate(ElOutParmsData%DFTSAV) + end if + if (allocated(ElOutParmsData%DynPres)) then + deallocate(ElOutParmsData%DynPres) + end if + if (allocated(ElOutParmsData%PMM)) then + deallocate(ElOutParmsData%PMM) + end if + if (allocated(ElOutParmsData%PITSAV)) then + deallocate(ElOutParmsData%PITSAV) + end if + if (allocated(ElOutParmsData%ReyNum)) then + deallocate(ElOutParmsData%ReyNum) + end if + if (allocated(ElOutParmsData%Gamma)) then + deallocate(ElOutParmsData%Gamma) + end if + if (allocated(ElOutParmsData%SaveVX)) then + deallocate(ElOutParmsData%SaveVX) + end if + if (allocated(ElOutParmsData%SaveVY)) then + deallocate(ElOutParmsData%SaveVY) + end if + if (allocated(ElOutParmsData%SaveVZ)) then + deallocate(ElOutParmsData%SaveVZ) + end if + if (allocated(ElOutParmsData%WndElPrList)) then + deallocate(ElOutParmsData%WndElPrList) + end if + if (allocated(ElOutParmsData%WndElPrNum)) then + deallocate(ElOutParmsData%WndElPrNum) + end if + if (allocated(ElOutParmsData%ElPrList)) then + deallocate(ElOutParmsData%ElPrList) + end if + if (allocated(ElOutParmsData%ElPrNum)) then + deallocate(ElOutParmsData%ElPrNum) + end if +end subroutine + +subroutine AD14_PackElOutParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ElOutParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackElOutParms' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%AAA)) + if (allocated(InData%AAA)) then + call RegPackBounds(Buf, 1, lbound(InData%AAA), ubound(InData%AAA)) + call RegPack(Buf, InData%AAA) + end if + call RegPack(Buf, allocated(InData%AAP)) + if (allocated(InData%AAP)) then + call RegPackBounds(Buf, 1, lbound(InData%AAP), ubound(InData%AAP)) + call RegPack(Buf, InData%AAP) + end if + call RegPack(Buf, allocated(InData%ALF)) + if (allocated(InData%ALF)) then + call RegPackBounds(Buf, 1, lbound(InData%ALF), ubound(InData%ALF)) + call RegPack(Buf, InData%ALF) + end if + call RegPack(Buf, allocated(InData%CDD)) + if (allocated(InData%CDD)) then + call RegPackBounds(Buf, 1, lbound(InData%CDD), ubound(InData%CDD)) + call RegPack(Buf, InData%CDD) + end if + call RegPack(Buf, allocated(InData%CLL)) + if (allocated(InData%CLL)) then + call RegPackBounds(Buf, 1, lbound(InData%CLL), ubound(InData%CLL)) + call RegPack(Buf, InData%CLL) + end if + call RegPack(Buf, allocated(InData%CMM)) + if (allocated(InData%CMM)) then + call RegPackBounds(Buf, 1, lbound(InData%CMM), ubound(InData%CMM)) + call RegPack(Buf, InData%CMM) + end if + call RegPack(Buf, allocated(InData%CNN)) + if (allocated(InData%CNN)) then + call RegPackBounds(Buf, 1, lbound(InData%CNN), ubound(InData%CNN)) + call RegPack(Buf, InData%CNN) + end if + call RegPack(Buf, allocated(InData%CTT)) + if (allocated(InData%CTT)) then + call RegPackBounds(Buf, 1, lbound(InData%CTT), ubound(InData%CTT)) + call RegPack(Buf, InData%CTT) + end if + call RegPack(Buf, allocated(InData%DFNSAV)) + if (allocated(InData%DFNSAV)) then + call RegPackBounds(Buf, 1, lbound(InData%DFNSAV), ubound(InData%DFNSAV)) + call RegPack(Buf, InData%DFNSAV) + end if + call RegPack(Buf, allocated(InData%DFTSAV)) + if (allocated(InData%DFTSAV)) then + call RegPackBounds(Buf, 1, lbound(InData%DFTSAV), ubound(InData%DFTSAV)) + call RegPack(Buf, InData%DFTSAV) + end if + call RegPack(Buf, allocated(InData%DynPres)) + if (allocated(InData%DynPres)) then + call RegPackBounds(Buf, 1, lbound(InData%DynPres), ubound(InData%DynPres)) + call RegPack(Buf, InData%DynPres) + end if + call RegPack(Buf, allocated(InData%PMM)) + if (allocated(InData%PMM)) then + call RegPackBounds(Buf, 1, lbound(InData%PMM), ubound(InData%PMM)) + call RegPack(Buf, InData%PMM) + end if + call RegPack(Buf, allocated(InData%PITSAV)) + if (allocated(InData%PITSAV)) then + call RegPackBounds(Buf, 1, lbound(InData%PITSAV), ubound(InData%PITSAV)) + call RegPack(Buf, InData%PITSAV) + end if + call RegPack(Buf, allocated(InData%ReyNum)) + if (allocated(InData%ReyNum)) then + call RegPackBounds(Buf, 1, lbound(InData%ReyNum), ubound(InData%ReyNum)) + call RegPack(Buf, InData%ReyNum) + end if + call RegPack(Buf, allocated(InData%Gamma)) + if (allocated(InData%Gamma)) then + call RegPackBounds(Buf, 1, lbound(InData%Gamma), ubound(InData%Gamma)) + call RegPack(Buf, InData%Gamma) + end if + call RegPack(Buf, allocated(InData%SaveVX)) + if (allocated(InData%SaveVX)) then + call RegPackBounds(Buf, 2, lbound(InData%SaveVX), ubound(InData%SaveVX)) + call RegPack(Buf, InData%SaveVX) + end if + call RegPack(Buf, allocated(InData%SaveVY)) + if (allocated(InData%SaveVY)) then + call RegPackBounds(Buf, 2, lbound(InData%SaveVY), ubound(InData%SaveVY)) + call RegPack(Buf, InData%SaveVY) + end if + call RegPack(Buf, allocated(InData%SaveVZ)) + if (allocated(InData%SaveVZ)) then + call RegPackBounds(Buf, 2, lbound(InData%SaveVZ), ubound(InData%SaveVZ)) + call RegPack(Buf, InData%SaveVZ) + end if + call RegPack(Buf, InData%VXSAV) + call RegPack(Buf, InData%VYSAV) + call RegPack(Buf, InData%VZSAV) + call RegPack(Buf, InData%NumWndElOut) + call RegPack(Buf, allocated(InData%WndElPrList)) + if (allocated(InData%WndElPrList)) then + call RegPackBounds(Buf, 1, lbound(InData%WndElPrList), ubound(InData%WndElPrList)) + call RegPack(Buf, InData%WndElPrList) + end if + call RegPack(Buf, allocated(InData%WndElPrNum)) + if (allocated(InData%WndElPrNum)) then + call RegPackBounds(Buf, 1, lbound(InData%WndElPrNum), ubound(InData%WndElPrNum)) + call RegPack(Buf, InData%WndElPrNum) + end if + call RegPack(Buf, allocated(InData%ElPrList)) + if (allocated(InData%ElPrList)) then + call RegPackBounds(Buf, 1, lbound(InData%ElPrList), ubound(InData%ElPrList)) + call RegPack(Buf, InData%ElPrList) + end if + call RegPack(Buf, allocated(InData%ElPrNum)) + if (allocated(InData%ElPrNum)) then + call RegPackBounds(Buf, 1, lbound(InData%ElPrNum), ubound(InData%ElPrNum)) + call RegPack(Buf, InData%ElPrNum) + end if + call RegPack(Buf, InData%NumElOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackElOutParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ElOutParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackElOutParms' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%AAA)) deallocate(OutData%AAA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AAA(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AAA) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AAP)) deallocate(OutData%AAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AAP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ALF)) deallocate(OutData%ALF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ALF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ALF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CDD)) deallocate(OutData%CDD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CDD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CDD) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CLL)) deallocate(OutData%CLL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CLL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CLL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CLL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CMM)) deallocate(OutData%CMM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CMM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CMM) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CNN)) deallocate(OutData%CNN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNN(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNN) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CTT)) deallocate(OutData%CTT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CTT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CTT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CTT) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DFNSAV)) deallocate(OutData%DFNSAV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DFNSAV(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFNSAV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DFNSAV) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DFTSAV)) deallocate(OutData%DFTSAV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DFTSAV(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFTSAV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DFTSAV) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DynPres)) deallocate(OutData%DynPres) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DynPres(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DynPres.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DynPres) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PMM)) deallocate(OutData%PMM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMM) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PITSAV)) deallocate(OutData%PITSAV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PITSAV(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITSAV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PITSAV) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ReyNum)) deallocate(OutData%ReyNum) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ReyNum(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReyNum.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ReyNum) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Gamma)) deallocate(OutData%Gamma) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Gamma(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Gamma) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SaveVX)) deallocate(OutData%SaveVX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SaveVX(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SaveVX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SaveVY)) deallocate(OutData%SaveVY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SaveVY(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SaveVY) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SaveVZ)) deallocate(OutData%SaveVZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SaveVZ(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SaveVZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%VXSAV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VYSAV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VZSAV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumWndElOut) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WndElPrList)) deallocate(OutData%WndElPrList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WndElPrList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WndElPrList) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WndElPrNum)) deallocate(OutData%WndElPrNum) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WndElPrNum(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrNum.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WndElPrNum) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ElPrList)) deallocate(OutData%ElPrList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElPrList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElPrList) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ElPrNum)) deallocate(OutData%ElPrNum) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElPrNum(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElPrNum) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NumElOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyInducedVel(SrcInducedVelData, DstInducedVelData, CtrlCode, ErrStat, ErrMsg) + type(InducedVel), intent(in) :: SrcInducedVelData + type(InducedVel), intent(inout) :: DstInducedVelData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyInducedVel' + ErrStat = ErrID_None + ErrMsg = '' + DstInducedVelData%SumInFl = SrcInducedVelData%SumInFl +end subroutine + +subroutine AD14_DestroyInducedVel(InducedVelData, ErrStat, ErrMsg) + type(InducedVel), intent(inout) :: InducedVelData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyInducedVel' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD14_PackInducedVel(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InducedVel), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackInducedVel' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%SumInFl) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackInducedVel(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InducedVel), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackInducedVel' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%SumInFl) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyInducedVelParms(SrcInducedVelParmsData, DstInducedVelParmsData, CtrlCode, ErrStat, ErrMsg) + type(InducedVelParms), intent(in) :: SrcInducedVelParmsData + type(InducedVelParms), intent(inout) :: DstInducedVelParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyInducedVelParms' + ErrStat = ErrID_None + ErrMsg = '' + DstInducedVelParmsData%AToler = SrcInducedVelParmsData%AToler + DstInducedVelParmsData%EqAIDmult = SrcInducedVelParmsData%EqAIDmult + DstInducedVelParmsData%EquilDA = SrcInducedVelParmsData%EquilDA + DstInducedVelParmsData%EquilDT = SrcInducedVelParmsData%EquilDT + DstInducedVelParmsData%TLoss = SrcInducedVelParmsData%TLoss + DstInducedVelParmsData%GTech = SrcInducedVelParmsData%GTech + DstInducedVelParmsData%HLoss = SrcInducedVelParmsData%HLoss +end subroutine + +subroutine AD14_DestroyInducedVelParms(InducedVelParmsData, ErrStat, ErrMsg) + type(InducedVelParms), intent(inout) :: InducedVelParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyInducedVelParms' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD14_PackInducedVelParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InducedVelParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackInducedVelParms' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%AToler) + call RegPack(Buf, InData%EqAIDmult) + call RegPack(Buf, InData%EquilDA) + call RegPack(Buf, InData%EquilDT) + call RegPack(Buf, InData%TLoss) + call RegPack(Buf, InData%GTech) + call RegPack(Buf, InData%HLoss) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackInducedVelParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InducedVelParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackInducedVelParms' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%AToler) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EqAIDmult) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EquilDA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EquilDT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TLoss) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GTech) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HLoss) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyRotor(SrcRotorData, DstRotorData, CtrlCode, ErrStat, ErrMsg) + type(Rotor), intent(in) :: SrcRotorData + type(Rotor), intent(inout) :: DstRotorData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyRotor' + ErrStat = ErrID_None + ErrMsg = '' + DstRotorData%AVGINFL = SrcRotorData%AVGINFL + DstRotorData%CTILT = SrcRotorData%CTILT + DstRotorData%CYaw = SrcRotorData%CYaw + DstRotorData%REVS = SrcRotorData%REVS + DstRotorData%STILT = SrcRotorData%STILT + DstRotorData%SYaw = SrcRotorData%SYaw + DstRotorData%TILT = SrcRotorData%TILT + DstRotorData%YawAng = SrcRotorData%YawAng + DstRotorData%YawVEL = SrcRotorData%YawVEL +end subroutine + +subroutine AD14_DestroyRotor(RotorData, ErrStat, ErrMsg) + type(Rotor), intent(inout) :: RotorData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyRotor' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD14_PackRotor(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Rotor), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackRotor' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%AVGINFL) + call RegPack(Buf, InData%CTILT) + call RegPack(Buf, InData%CYaw) + call RegPack(Buf, InData%REVS) + call RegPack(Buf, InData%STILT) + call RegPack(Buf, InData%SYaw) + call RegPack(Buf, InData%TILT) + call RegPack(Buf, InData%YawAng) + call RegPack(Buf, InData%YawVEL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackRotor(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Rotor), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackRotor' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%AVGINFL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CTILT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CYaw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%REVS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%STILT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SYaw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TILT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawAng) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawVEL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyRotorParms(SrcRotorParmsData, DstRotorParmsData, CtrlCode, ErrStat, ErrMsg) + type(RotorParms), intent(in) :: SrcRotorParmsData + type(RotorParms), intent(inout) :: DstRotorParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyRotorParms' + ErrStat = ErrID_None + ErrMsg = '' + DstRotorParmsData%HH = SrcRotorParmsData%HH +end subroutine + +subroutine AD14_DestroyRotorParms(RotorParmsData, ErrStat, ErrMsg) + type(RotorParms), intent(inout) :: RotorParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyRotorParms' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD14_PackRotorParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotorParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackRotorParms' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%HH) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackRotorParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotorParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackRotorParms' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%HH) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyTwrPropsParms(SrcTwrPropsParmsData, DstTwrPropsParmsData, CtrlCode, ErrStat, ErrMsg) + type(TwrPropsParms), intent(in) :: SrcTwrPropsParmsData + type(TwrPropsParms), intent(inout) :: DstTwrPropsParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyTwrPropsParms' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcTwrPropsParmsData%TwrHtFr)) then + LB(1:1) = lbound(SrcTwrPropsParmsData%TwrHtFr) + UB(1:1) = ubound(SrcTwrPropsParmsData%TwrHtFr) + if (.not. allocated(DstTwrPropsParmsData%TwrHtFr)) then + allocate(DstTwrPropsParmsData%TwrHtFr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrHtFr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTwrPropsParmsData%TwrHtFr = SrcTwrPropsParmsData%TwrHtFr + end if + if (allocated(SrcTwrPropsParmsData%TwrWid)) then + LB(1:1) = lbound(SrcTwrPropsParmsData%TwrWid) + UB(1:1) = ubound(SrcTwrPropsParmsData%TwrWid) + if (.not. allocated(DstTwrPropsParmsData%TwrWid)) then + allocate(DstTwrPropsParmsData%TwrWid(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrWid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTwrPropsParmsData%TwrWid = SrcTwrPropsParmsData%TwrWid + end if + if (allocated(SrcTwrPropsParmsData%TwrCD)) then + LB(1:2) = lbound(SrcTwrPropsParmsData%TwrCD) + UB(1:2) = ubound(SrcTwrPropsParmsData%TwrCD) + if (.not. allocated(DstTwrPropsParmsData%TwrCD)) then + allocate(DstTwrPropsParmsData%TwrCD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrCD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTwrPropsParmsData%TwrCD = SrcTwrPropsParmsData%TwrCD + end if + if (allocated(SrcTwrPropsParmsData%TwrRe)) then + LB(1:1) = lbound(SrcTwrPropsParmsData%TwrRe) + UB(1:1) = ubound(SrcTwrPropsParmsData%TwrRe) + if (.not. allocated(DstTwrPropsParmsData%TwrRe)) then + allocate(DstTwrPropsParmsData%TwrRe(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrRe.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTwrPropsParmsData%TwrRe = SrcTwrPropsParmsData%TwrRe + end if + DstTwrPropsParmsData%VTwr = SrcTwrPropsParmsData%VTwr + DstTwrPropsParmsData%Tower_Wake_Constant = SrcTwrPropsParmsData%Tower_Wake_Constant + if (allocated(SrcTwrPropsParmsData%NTwrCDCol)) then + LB(1:1) = lbound(SrcTwrPropsParmsData%NTwrCDCol) + UB(1:1) = ubound(SrcTwrPropsParmsData%NTwrCDCol) + if (.not. allocated(DstTwrPropsParmsData%NTwrCDCol)) then + allocate(DstTwrPropsParmsData%NTwrCDCol(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%NTwrCDCol.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTwrPropsParmsData%NTwrCDCol = SrcTwrPropsParmsData%NTwrCDCol + end if + DstTwrPropsParmsData%NTwrHT = SrcTwrPropsParmsData%NTwrHT + DstTwrPropsParmsData%NTwrRe = SrcTwrPropsParmsData%NTwrRe + DstTwrPropsParmsData%NTwrCD = SrcTwrPropsParmsData%NTwrCD + DstTwrPropsParmsData%TwrPotent = SrcTwrPropsParmsData%TwrPotent + DstTwrPropsParmsData%TwrShadow = SrcTwrPropsParmsData%TwrShadow + DstTwrPropsParmsData%ShadHWid = SrcTwrPropsParmsData%ShadHWid + DstTwrPropsParmsData%TShadC1 = SrcTwrPropsParmsData%TShadC1 + DstTwrPropsParmsData%TShadC2 = SrcTwrPropsParmsData%TShadC2 + DstTwrPropsParmsData%TwrShad = SrcTwrPropsParmsData%TwrShad + DstTwrPropsParmsData%PJM_Version = SrcTwrPropsParmsData%PJM_Version + DstTwrPropsParmsData%TwrFile = SrcTwrPropsParmsData%TwrFile + DstTwrPropsParmsData%T_Shad_Refpt = SrcTwrPropsParmsData%T_Shad_Refpt + DstTwrPropsParmsData%CalcTwrAero = SrcTwrPropsParmsData%CalcTwrAero + DstTwrPropsParmsData%NumTwrNodes = SrcTwrPropsParmsData%NumTwrNodes + if (allocated(SrcTwrPropsParmsData%TwrNodeWidth)) then + LB(1:1) = lbound(SrcTwrPropsParmsData%TwrNodeWidth) + UB(1:1) = ubound(SrcTwrPropsParmsData%TwrNodeWidth) + if (.not. allocated(DstTwrPropsParmsData%TwrNodeWidth)) then + allocate(DstTwrPropsParmsData%TwrNodeWidth(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrNodeWidth.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTwrPropsParmsData%TwrNodeWidth = SrcTwrPropsParmsData%TwrNodeWidth + end if +end subroutine + +subroutine AD14_DestroyTwrPropsParms(TwrPropsParmsData, ErrStat, ErrMsg) + type(TwrPropsParms), intent(inout) :: TwrPropsParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyTwrPropsParms' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(TwrPropsParmsData%TwrHtFr)) then + deallocate(TwrPropsParmsData%TwrHtFr) + end if + if (allocated(TwrPropsParmsData%TwrWid)) then + deallocate(TwrPropsParmsData%TwrWid) + end if + if (allocated(TwrPropsParmsData%TwrCD)) then + deallocate(TwrPropsParmsData%TwrCD) + end if + if (allocated(TwrPropsParmsData%TwrRe)) then + deallocate(TwrPropsParmsData%TwrRe) + end if + if (allocated(TwrPropsParmsData%NTwrCDCol)) then + deallocate(TwrPropsParmsData%NTwrCDCol) + end if + if (allocated(TwrPropsParmsData%TwrNodeWidth)) then + deallocate(TwrPropsParmsData%TwrNodeWidth) + end if +end subroutine + +subroutine AD14_PackTwrPropsParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TwrPropsParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackTwrPropsParms' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%TwrHtFr)) + if (allocated(InData%TwrHtFr)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrHtFr), ubound(InData%TwrHtFr)) + call RegPack(Buf, InData%TwrHtFr) + end if + call RegPack(Buf, allocated(InData%TwrWid)) + if (allocated(InData%TwrWid)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrWid), ubound(InData%TwrWid)) + call RegPack(Buf, InData%TwrWid) + end if + call RegPack(Buf, allocated(InData%TwrCD)) + if (allocated(InData%TwrCD)) then + call RegPackBounds(Buf, 2, lbound(InData%TwrCD), ubound(InData%TwrCD)) + call RegPack(Buf, InData%TwrCD) + end if + call RegPack(Buf, allocated(InData%TwrRe)) + if (allocated(InData%TwrRe)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrRe), ubound(InData%TwrRe)) + call RegPack(Buf, InData%TwrRe) + end if + call RegPack(Buf, InData%VTwr) + call RegPack(Buf, InData%Tower_Wake_Constant) + call RegPack(Buf, allocated(InData%NTwrCDCol)) + if (allocated(InData%NTwrCDCol)) then + call RegPackBounds(Buf, 1, lbound(InData%NTwrCDCol), ubound(InData%NTwrCDCol)) + call RegPack(Buf, InData%NTwrCDCol) + end if + call RegPack(Buf, InData%NTwrHT) + call RegPack(Buf, InData%NTwrRe) + call RegPack(Buf, InData%NTwrCD) + call RegPack(Buf, InData%TwrPotent) + call RegPack(Buf, InData%TwrShadow) + call RegPack(Buf, InData%ShadHWid) + call RegPack(Buf, InData%TShadC1) + call RegPack(Buf, InData%TShadC2) + call RegPack(Buf, InData%TwrShad) + call RegPack(Buf, InData%PJM_Version) + call RegPack(Buf, InData%TwrFile) + call RegPack(Buf, InData%T_Shad_Refpt) + call RegPack(Buf, InData%CalcTwrAero) + call RegPack(Buf, InData%NumTwrNodes) + call RegPack(Buf, allocated(InData%TwrNodeWidth)) + if (allocated(InData%TwrNodeWidth)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrNodeWidth), ubound(InData%TwrNodeWidth)) + call RegPack(Buf, InData%TwrNodeWidth) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackTwrPropsParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TwrPropsParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackTwrPropsParms' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%TwrHtFr)) deallocate(OutData%TwrHtFr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrHtFr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHtFr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrHtFr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrWid)) deallocate(OutData%TwrWid) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrWid(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrWid.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrWid) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrCD)) deallocate(OutData%TwrCD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrCD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrCD) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrRe)) deallocate(OutData%TwrRe) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrRe(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrRe.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrRe) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%VTwr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Tower_Wake_Constant) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%NTwrCDCol)) deallocate(OutData%NTwrCDCol) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NTwrCDCol(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTwrCDCol.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NTwrCDCol) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NTwrHT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NTwrRe) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NTwrCD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrPotent) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrShadow) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ShadHWid) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TShadC1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TShadC2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrShad) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PJM_Version) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T_Shad_Refpt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CalcTwrAero) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumTwrNodes) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TwrNodeWidth)) deallocate(OutData%TwrNodeWidth) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrNodeWidth(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeWidth.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrNodeWidth) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD14_CopyWind(SrcWindData, DstWindData, CtrlCode, ErrStat, ErrMsg) + type(Wind), intent(in) :: SrcWindData + type(Wind), intent(inout) :: DstWindData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyWind' + ErrStat = ErrID_None + ErrMsg = '' + DstWindData%ANGFLW = SrcWindData%ANGFLW + DstWindData%CDEL = SrcWindData%CDEL + DstWindData%VROTORX = SrcWindData%VROTORX + DstWindData%VROTORY = SrcWindData%VROTORY + DstWindData%VROTORZ = SrcWindData%VROTORZ + DstWindData%SDEL = SrcWindData%SDEL +end subroutine + +subroutine AD14_DestroyWind(WindData, ErrStat, ErrMsg) + type(Wind), intent(inout) :: WindData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyWind' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD14_PackWind(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wind), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackWind' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%ANGFLW) + call RegPack(Buf, InData%CDEL) + call RegPack(Buf, InData%VROTORX) + call RegPack(Buf, InData%VROTORY) + call RegPack(Buf, InData%VROTORZ) + call RegPack(Buf, InData%SDEL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackWind(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wind), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackWind' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%ANGFLW) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CDEL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VROTORX) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VROTORY) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VROTORZ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SDEL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyWindParms(SrcWindParmsData, DstWindParmsData, CtrlCode, ErrStat, ErrMsg) + type(WindParms), intent(in) :: SrcWindParmsData + type(WindParms), intent(inout) :: DstWindParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyWindParms' + ErrStat = ErrID_None + ErrMsg = '' + DstWindParmsData%Rho = SrcWindParmsData%Rho + DstWindParmsData%KinVisc = SrcWindParmsData%KinVisc +end subroutine + +subroutine AD14_DestroyWindParms(WindParmsData, ErrStat, ErrMsg) + type(WindParms), intent(inout) :: WindParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyWindParms' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD14_PackWindParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WindParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackWindParms' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Rho) + call RegPack(Buf, InData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackWindParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WindParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackWindParms' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Rho) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyPositionType(SrcPositionTypeData, DstPositionTypeData, CtrlCode, ErrStat, ErrMsg) + type(PositionType), intent(in) :: SrcPositionTypeData + type(PositionType), intent(inout) :: DstPositionTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyPositionType' + ErrStat = ErrID_None + ErrMsg = '' + DstPositionTypeData%Pos = SrcPositionTypeData%Pos +end subroutine + +subroutine AD14_DestroyPositionType(PositionTypeData, ErrStat, ErrMsg) + type(PositionType), intent(inout) :: PositionTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyPositionType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD14_PackPositionType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(PositionType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackPositionType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Pos) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackPositionType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(PositionType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackPositionType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Pos) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyOrientationType(SrcOrientationTypeData, DstOrientationTypeData, CtrlCode, ErrStat, ErrMsg) + type(OrientationType), intent(in) :: SrcOrientationTypeData + type(OrientationType), intent(inout) :: DstOrientationTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyOrientationType' + ErrStat = ErrID_None + ErrMsg = '' + DstOrientationTypeData%Orient = SrcOrientationTypeData%Orient +end subroutine + +subroutine AD14_DestroyOrientationType(OrientationTypeData, ErrStat, ErrMsg) + type(OrientationType), intent(inout) :: OrientationTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyOrientationType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD14_PackOrientationType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OrientationType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackOrientationType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Orient) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackOrientationType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OrientationType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackOrientationType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Orient) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(AD14_InitInputType), intent(in) :: SrcInitInputData + type(AD14_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%Title = SrcInitInputData%Title + DstInitInputData%OutRootName = SrcInitInputData%OutRootName + DstInitInputData%ADFileName = SrcInitInputData%ADFileName + DstInitInputData%WrSumFile = SrcInitInputData%WrSumFile + DstInitInputData%NumBl = SrcInitInputData%NumBl + DstInitInputData%BladeLength = SrcInitInputData%BladeLength + DstInitInputData%LinearizeFlag = SrcInitInputData%LinearizeFlag + DstInitInputData%UseDWM = SrcInitInputData%UseDWM + call AD14_CopyAeroConfig(SrcInitInputData%TurbineComponents, DstInitInputData%TurbineComponents, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%NumTwrNodes = SrcInitInputData%NumTwrNodes + if (allocated(SrcInitInputData%TwrNodeLocs)) then + LB(1:2) = lbound(SrcInitInputData%TwrNodeLocs) + UB(1:2) = ubound(SrcInitInputData%TwrNodeLocs) + if (.not. allocated(DstInitInputData%TwrNodeLocs)) then + allocate(DstInitInputData%TwrNodeLocs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TwrNodeLocs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%TwrNodeLocs = SrcInitInputData%TwrNodeLocs + end if + DstInitInputData%HubHt = SrcInitInputData%HubHt + call DWM_CopyInitInput(SrcInitInputData%DWM, DstInitInputData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD14_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(AD14_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + call AD14_DestroyAeroConfig(InitInputData%TurbineComponents, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitInputData%TwrNodeLocs)) then + deallocate(InitInputData%TwrNodeLocs) + end if + call DWM_DestroyInitInput(InitInputData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD14_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Title) + call RegPack(Buf, InData%OutRootName) + call RegPack(Buf, InData%ADFileName) + call RegPack(Buf, InData%WrSumFile) + call RegPack(Buf, InData%NumBl) + call RegPack(Buf, InData%BladeLength) + call RegPack(Buf, InData%LinearizeFlag) + call RegPack(Buf, InData%UseDWM) + call AD14_PackAeroConfig(Buf, InData%TurbineComponents) + call RegPack(Buf, InData%NumTwrNodes) + call RegPack(Buf, allocated(InData%TwrNodeLocs)) + if (allocated(InData%TwrNodeLocs)) then + call RegPackBounds(Buf, 2, lbound(InData%TwrNodeLocs), ubound(InData%TwrNodeLocs)) + call RegPack(Buf, InData%TwrNodeLocs) + end if + call RegPack(Buf, InData%HubHt) + call DWM_PackInitInput(Buf, InData%DWM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Title) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutRootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ADFileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrSumFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinearizeFlag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UseDWM) + if (RegCheckErr(Buf, RoutineName)) return + call AD14_UnpackAeroConfig(Buf, OutData%TurbineComponents) ! TurbineComponents + call RegUnpack(Buf, OutData%NumTwrNodes) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TwrNodeLocs)) deallocate(OutData%TwrNodeLocs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrNodeLocs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeLocs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrNodeLocs) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%HubHt) + if (RegCheckErr(Buf, RoutineName)) return + call DWM_UnpackInitInput(Buf, OutData%DWM) ! DWM +end subroutine + +subroutine AD14_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(AD14_InitOutputType), intent(in) :: SrcInitOutputData + type(AD14_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_CopyContState( SrcContStateData%DWM, DstContStateData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyContState - - SUBROUTINE AD14_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(AD14_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 = 'AD14_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL DWM_DestroyContState( ContStateData%DWM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyContState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - 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 - - CALL DWM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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 AD14_PackContState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - 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 DWM_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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 AD14_UnPackContState - - SUBROUTINE AD14_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(AD14_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 = 'AD14_CopyDiscState' -! + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyInitOutput(SrcInitOutputData%DWM, DstInitOutputData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%AirDens = SrcInitOutputData%AirDens +end subroutine + +subroutine AD14_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(AD14_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_CopyDiscState( SrcDiscStateData%DWM, DstDiscStateData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyDiscState - - SUBROUTINE AD14_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(AD14_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 = 'AD14_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL DWM_DestroyDiscState( DiscStateData%DWM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyDiscState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - 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 - - CALL DWM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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 AD14_PackDiscState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - 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 DWM_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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 AD14_UnPackDiscState - - SUBROUTINE AD14_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(AD14_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 = 'AD14_CopyConstrState' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyInitOutput(InitOutputData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD14_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call DWM_PackInitOutput(Buf, InData%DWM) + call RegPack(Buf, InData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + call DWM_UnpackInitOutput(Buf, OutData%DWM) ! DWM + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(AD14_ContinuousStateType), intent(in) :: SrcContStateData + type(AD14_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_CopyConstrState( SrcConstrStateData%DWM, DstConstrStateData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyConstrState - - SUBROUTINE AD14_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(AD14_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 = 'AD14_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL DWM_DestroyConstrState( ConstrStateData%DWM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyConstrState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - 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 - - CALL DWM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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 AD14_PackConstrState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - 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 DWM_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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 AD14_UnPackConstrState - - SUBROUTINE AD14_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(AD14_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 = 'AD14_CopyOtherState' -! + ErrMsg = '' + call DWM_CopyContState(SrcContStateData%DWM, DstContStateData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD14_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(AD14_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_CopyOtherState( SrcOtherStateData%DWM, DstOtherStateData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyOtherState - - SUBROUTINE AD14_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(AD14_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 = 'AD14_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL DWM_DestroyOtherState( OtherStateData%DWM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyOtherState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - 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 - - CALL DWM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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 AD14_PackOtherState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - 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 DWM_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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 AD14_UnPackOtherState - - SUBROUTINE AD14_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(AD14_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) :: 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_CopyMisc' -! + ErrMsg = '' + call DWM_DestroyContState(ContStateData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD14_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call DWM_PackContState(Buf, InData%DWM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call DWM_UnpackContState(Buf, OutData%DWM) ! DWM +end subroutine + +subroutine AD14_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(AD14_DiscreteStateType), intent(in) :: SrcDiscStateData + type(AD14_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_CopyMisc( SrcMiscData%DWM, DstMiscData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_CopyInput( SrcMiscData%DWM_Inputs, DstMiscData%DWM_Inputs, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_CopyOutput( SrcMiscData%DWM_Outputs, DstMiscData%DWM_Outputs, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%DT = SrcMiscData%DT -IF (ALLOCATED(SrcMiscData%ElPrNum)) THEN - i1_l = LBOUND(SrcMiscData%ElPrNum,1) - i1_u = UBOUND(SrcMiscData%ElPrNum,1) - IF (.NOT. ALLOCATED(DstMiscData%ElPrNum)) THEN - ALLOCATE(DstMiscData%ElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ElPrNum = SrcMiscData%ElPrNum -ENDIF - DstMiscData%OldTime = SrcMiscData%OldTime - DstMiscData%HubLoss = SrcMiscData%HubLoss - DstMiscData%Loss = SrcMiscData%Loss - DstMiscData%TipLoss = SrcMiscData%TipLoss - DstMiscData%TLpt7 = SrcMiscData%TLpt7 - DstMiscData%FirstPassGTL = SrcMiscData%FirstPassGTL - DstMiscData%SuperSonic = SrcMiscData%SuperSonic - DstMiscData%AFLAGVinderr = SrcMiscData%AFLAGVinderr - DstMiscData%AFLAGTwrInflu = SrcMiscData%AFLAGTwrInflu - DstMiscData%OnePassDynDbg = SrcMiscData%OnePassDynDbg - DstMiscData%NoLoadsCalculated = SrcMiscData%NoLoadsCalculated - DstMiscData%NERRORS = SrcMiscData%NERRORS - CALL AD14_Copyairfoil( SrcMiscData%AirFoil, DstMiscData%AirFoil, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copybeddoes( SrcMiscData%Beddoes, DstMiscData%Beddoes, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copydyninflow( SrcMiscData%DynInflow, DstMiscData%DynInflow, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyelement( SrcMiscData%Element, DstMiscData%Element, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyrotor( SrcMiscData%Rotor, DstMiscData%Rotor, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copywind( SrcMiscData%Wind, DstMiscData%Wind, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyinducedvel( SrcMiscData%InducedVel, DstMiscData%InducedVel, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyeloutparms( SrcMiscData%ElOut, DstMiscData%ElOut, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%Skew = SrcMiscData%Skew - DstMiscData%DynInit = SrcMiscData%DynInit - DstMiscData%FirstWarn = SrcMiscData%FirstWarn -IF (ALLOCATED(SrcMiscData%StoredForces)) THEN - i1_l = LBOUND(SrcMiscData%StoredForces,1) - i1_u = UBOUND(SrcMiscData%StoredForces,1) - i2_l = LBOUND(SrcMiscData%StoredForces,2) - i2_u = UBOUND(SrcMiscData%StoredForces,2) - i3_l = LBOUND(SrcMiscData%StoredForces,3) - i3_u = UBOUND(SrcMiscData%StoredForces,3) - IF (.NOT. ALLOCATED(DstMiscData%StoredForces)) THEN - ALLOCATE(DstMiscData%StoredForces(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StoredForces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%StoredForces = SrcMiscData%StoredForces -ENDIF -IF (ALLOCATED(SrcMiscData%StoredMoments)) THEN - i1_l = LBOUND(SrcMiscData%StoredMoments,1) - i1_u = UBOUND(SrcMiscData%StoredMoments,1) - i2_l = LBOUND(SrcMiscData%StoredMoments,2) - i2_u = UBOUND(SrcMiscData%StoredMoments,2) - i3_l = LBOUND(SrcMiscData%StoredMoments,3) - i3_u = UBOUND(SrcMiscData%StoredMoments,3) - IF (.NOT. ALLOCATED(DstMiscData%StoredMoments)) THEN - ALLOCATE(DstMiscData%StoredMoments(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StoredMoments.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%StoredMoments = SrcMiscData%StoredMoments -ENDIF - END SUBROUTINE AD14_CopyMisc - - SUBROUTINE AD14_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(AD14_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 = 'AD14_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL DWM_DestroyMisc( MiscData%DWM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyInput( MiscData%DWM_Inputs, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyBeddoes( MiscData%Beddoes, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyDynInflow( MiscData%DynInflow, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyElement( MiscData%Element, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyRotor( MiscData%Rotor, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyWind( MiscData%Wind, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInducedVel( MiscData%InducedVel, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyElOutParms( MiscData%ElOut, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%StoredForces)) THEN - DEALLOCATE(MiscData%StoredForces) -ENDIF -IF (ALLOCATED(MiscData%StoredMoments)) THEN - DEALLOCATE(MiscData%StoredMoments) -ENDIF - END SUBROUTINE AD14_DestroyMisc - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DWM_Inputs: size of buffers for each call to pack subtype - CALL DWM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%DWM_Inputs, ErrStat2, ErrMsg2, .TRUE. ) ! DWM_Inputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM_Inputs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM_Inputs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM_Inputs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DWM_Outputs: size of buffers for each call to pack subtype - CALL DWM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%DWM_Outputs, ErrStat2, ErrMsg2, .TRUE. ) ! DWM_Outputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM_Outputs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM_Outputs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM_Outputs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! ElPrNum allocated yes/no - IF ( ALLOCATED(InData%ElPrNum) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElPrNum upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElPrNum) ! ElPrNum - END IF - Db_BufSz = Db_BufSz + 1 ! OldTime - Re_BufSz = Re_BufSz + 1 ! HubLoss - Re_BufSz = Re_BufSz + 1 ! Loss - Re_BufSz = Re_BufSz + 1 ! TipLoss - Re_BufSz = Re_BufSz + 1 ! TLpt7 - Int_BufSz = Int_BufSz + 1 ! FirstPassGTL - Int_BufSz = Int_BufSz + 1 ! SuperSonic - Int_BufSz = Int_BufSz + 1 ! AFLAGVinderr - Int_BufSz = Int_BufSz + 1 ! AFLAGTwrInflu - Int_BufSz = Int_BufSz + 1 ! OnePassDynDbg - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AirFoil - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AirFoil - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AirFoil - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Beddoes - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Beddoes - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Beddoes - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DynInflow - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DynInflow - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DynInflow - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Element - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Element - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Element - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Rotor - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Rotor - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Rotor - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Wind - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Wind - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Wind - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InducedVel - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InducedVel - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InducedVel - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ElOut - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ElOut - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ElOut - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Skew - Int_BufSz = Int_BufSz + 1 ! DynInit - Int_BufSz = Int_BufSz + 1 ! FirstWarn - Int_BufSz = Int_BufSz + 1 ! StoredForces allocated yes/no - IF ( ALLOCATED(InData%StoredForces) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! StoredForces upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StoredForces) ! StoredForces - END IF - Int_BufSz = Int_BufSz + 1 ! StoredMoments allocated yes/no - IF ( ALLOCATED(InData%StoredMoments) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! StoredMoments upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StoredMoments) ! StoredMoments - 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 - - CALL DWM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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 - CALL DWM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%DWM_Inputs, ErrStat2, ErrMsg2, OnlySize ) ! DWM_Inputs - 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 - CALL DWM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%DWM_Outputs, ErrStat2, ErrMsg2, OnlySize ) ! DWM_Outputs - 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 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ElPrNum) ) 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%ElPrNum,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrNum,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ElPrNum,1), UBOUND(InData%ElPrNum,1) - IntKiBuf(Int_Xferred) = InData%ElPrNum(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%OldTime - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubLoss - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Loss - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TipLoss - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TLpt7 - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstPassGTL, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SuperSonic, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%AFLAGVinderr, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%AFLAGTwrInflu, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OnePassDynDbg, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NoLoadsCalculated, IntKiBuf(1)) - 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 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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) = TRANSFER(InData%Skew, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DynInit, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%StoredForces) ) 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%StoredForces,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredForces,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredForces,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredForces,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredForces,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredForces,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%StoredForces,3), UBOUND(InData%StoredForces,3) - DO i2 = LBOUND(InData%StoredForces,2), UBOUND(InData%StoredForces,2) - DO i1 = LBOUND(InData%StoredForces,1), UBOUND(InData%StoredForces,1) - ReKiBuf(Re_Xferred) = InData%StoredForces(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StoredMoments) ) 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%StoredMoments,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredMoments,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredMoments,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredMoments,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredMoments,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredMoments,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%StoredMoments,3), UBOUND(InData%StoredMoments,3) - DO i2 = LBOUND(InData%StoredMoments,2), UBOUND(InData%StoredMoments,2) - DO i1 = LBOUND(InData%StoredMoments,1), UBOUND(InData%StoredMoments,1) - ReKiBuf(Re_Xferred) = InData%StoredMoments(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD14_PackMisc - - SUBROUTINE AD14_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(AD14_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) :: 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_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 - 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 DWM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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) - 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 DWM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%DWM_Inputs, ErrStat2, ErrMsg2 ) ! DWM_Inputs - 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) - 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 DWM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%DWM_Outputs, ErrStat2, ErrMsg2 ) ! DWM_Outputs - 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%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrNum 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%ElPrNum)) DEALLOCATE(OutData%ElPrNum) - ALLOCATE(OutData%ElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElPrNum,1), UBOUND(OutData%ElPrNum,1) - OutData%ElPrNum(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%OldTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HubLoss = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Loss = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TipLoss = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TLpt7 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FirstPassGTL = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstPassGTL) - Int_Xferred = Int_Xferred + 1 - OutData%SuperSonic = TRANSFER(IntKiBuf(Int_Xferred), OutData%SuperSonic) - Int_Xferred = Int_Xferred + 1 - OutData%AFLAGVinderr = TRANSFER(IntKiBuf(Int_Xferred), OutData%AFLAGVinderr) - Int_Xferred = Int_Xferred + 1 - OutData%AFLAGTwrInflu = TRANSFER(IntKiBuf(Int_Xferred), OutData%AFLAGTwrInflu) - Int_Xferred = Int_Xferred + 1 - OutData%OnePassDynDbg = TRANSFER(IntKiBuf(Int_Xferred), OutData%OnePassDynDbg) - Int_Xferred = Int_Xferred + 1 - OutData%NoLoadsCalculated = TRANSFER(IntKiBuf(Int_Xferred), OutData%NoLoadsCalculated) - Int_Xferred = Int_Xferred + 1 - OutData%NERRORS = 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 AD14_UnpackAirFoil( Re_Buf, Db_Buf, Int_Buf, OutData%AirFoil, ErrStat2, ErrMsg2 ) ! AirFoil - 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) - 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 AD14_UnpackBeddoes( Re_Buf, Db_Buf, Int_Buf, OutData%Beddoes, ErrStat2, ErrMsg2 ) ! Beddoes - 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) - 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 AD14_UnpackDynInflow( Re_Buf, Db_Buf, Int_Buf, OutData%DynInflow, ErrStat2, ErrMsg2 ) ! DynInflow - 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) - 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 AD14_UnpackElement( Re_Buf, Db_Buf, Int_Buf, OutData%Element, ErrStat2, ErrMsg2 ) ! Element - 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) - 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 AD14_UnpackRotor( Re_Buf, Db_Buf, Int_Buf, OutData%Rotor, ErrStat2, ErrMsg2 ) ! Rotor - 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) - 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 AD14_UnpackWind( Re_Buf, Db_Buf, Int_Buf, OutData%Wind, ErrStat2, ErrMsg2 ) ! Wind - 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) - 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 AD14_UnpackInducedVel( Re_Buf, Db_Buf, Int_Buf, OutData%InducedVel, ErrStat2, ErrMsg2 ) ! InducedVel - 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) - 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 AD14_UnpackElOutParms( Re_Buf, Db_Buf, Int_Buf, OutData%ElOut, ErrStat2, ErrMsg2 ) ! ElOut - 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%Skew = TRANSFER(IntKiBuf(Int_Xferred), OutData%Skew) - Int_Xferred = Int_Xferred + 1 - OutData%DynInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynInit) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StoredForces 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%StoredForces)) DEALLOCATE(OutData%StoredForces) - ALLOCATE(OutData%StoredForces(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%StoredForces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%StoredForces,3), UBOUND(OutData%StoredForces,3) - DO i2 = LBOUND(OutData%StoredForces,2), UBOUND(OutData%StoredForces,2) - DO i1 = LBOUND(OutData%StoredForces,1), UBOUND(OutData%StoredForces,1) - OutData%StoredForces(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StoredMoments 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%StoredMoments)) DEALLOCATE(OutData%StoredMoments) - ALLOCATE(OutData%StoredMoments(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%StoredMoments.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%StoredMoments,3), UBOUND(OutData%StoredMoments,3) - DO i2 = LBOUND(OutData%StoredMoments,2), UBOUND(OutData%StoredMoments,2) - DO i1 = LBOUND(OutData%StoredMoments,1), UBOUND(OutData%StoredMoments,1) - OutData%StoredMoments(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD14_UnPackMisc - - SUBROUTINE AD14_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AD14_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 = 'AD14_CopyParam' -! + ErrMsg = '' + call DWM_CopyDiscState(SrcDiscStateData%DWM, DstDiscStateData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD14_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(AD14_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%Title = SrcParamData%Title - DstParamData%SIUnit = SrcParamData%SIUnit - DstParamData%Echo = SrcParamData%Echo - DstParamData%MultiTab = SrcParamData%MultiTab - DstParamData%LinearizeFlag = SrcParamData%LinearizeFlag - DstParamData%OutputPlottingInfo = SrcParamData%OutputPlottingInfo - DstParamData%UseDWM = SrcParamData%UseDWM - DstParamData%TwoPiNB = SrcParamData%TwoPiNB - DstParamData%NumBl = SrcParamData%NumBl - DstParamData%NBlInpSt = SrcParamData%NBlInpSt - DstParamData%ElemPrn = SrcParamData%ElemPrn - DstParamData%DStall = SrcParamData%DStall - DstParamData%PMoment = SrcParamData%PMoment - DstParamData%Reynolds = SrcParamData%Reynolds - DstParamData%DynInfl = SrcParamData%DynInfl - DstParamData%Wake = SrcParamData%Wake - DstParamData%Swirl = SrcParamData%Swirl - DstParamData%DtAero = SrcParamData%DtAero - DstParamData%HubRad = SrcParamData%HubRad - DstParamData%UnEc = SrcParamData%UnEc - DstParamData%UnElem = SrcParamData%UnElem - DstParamData%UnWndOut = SrcParamData%UnWndOut - DstParamData%MAXICOUNT = SrcParamData%MAXICOUNT - DstParamData%WrOptFile = SrcParamData%WrOptFile - DstParamData%DEFAULT_Wind = SrcParamData%DEFAULT_Wind - CALL AD14_Copyairfoilparms( SrcParamData%AirFoil, DstParamData%AirFoil, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copybladeparms( SrcParamData%Blade, DstParamData%Blade, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copybeddoesparms( SrcParamData%Beddoes, DstParamData%Beddoes, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copydyninflowparms( SrcParamData%DynInflow, DstParamData%DynInflow, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyelementparms( SrcParamData%Element, DstParamData%Element, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copytwrpropsparms( SrcParamData%TwrProps, DstParamData%TwrProps, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyinducedvelparms( SrcParamData%InducedVel, DstParamData%InducedVel, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copywindparms( SrcParamData%Wind, DstParamData%Wind, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyrotorparms( SrcParamData%Rotor, DstParamData%Rotor, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_CopyParam( SrcParamData%DWM, DstParamData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyParam - - SUBROUTINE AD14_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(AD14_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 = 'AD14_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD14_DestroyAirFoilParms( ParamData%AirFoil, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyBladeParms( ParamData%Blade, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyBeddoesParms( ParamData%Beddoes, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyDynInflowParms( ParamData%DynInflow, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyElementParms( ParamData%Element, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyTwrPropsParms( ParamData%TwrProps, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInducedVelParms( ParamData%InducedVel, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyWindParms( ParamData%Wind, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyRotorParms( ParamData%Rotor, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyParam( ParamData%DWM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyParam - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - Int_BufSz = Int_BufSz + 1*LEN(InData%Title) ! Title - Int_BufSz = Int_BufSz + 1 ! SIUnit - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! MultiTab - Int_BufSz = Int_BufSz + 1 ! LinearizeFlag - Int_BufSz = Int_BufSz + 1 ! OutputPlottingInfo - Int_BufSz = Int_BufSz + 1 ! UseDWM - Re_BufSz = Re_BufSz + 1 ! TwoPiNB - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1 ! NBlInpSt - Int_BufSz = Int_BufSz + 1 ! ElemPrn - Int_BufSz = Int_BufSz + 1 ! DStall - Int_BufSz = Int_BufSz + 1 ! PMoment - Int_BufSz = Int_BufSz + 1 ! Reynolds - Int_BufSz = Int_BufSz + 1 ! DynInfl - Int_BufSz = Int_BufSz + 1 ! Wake - Int_BufSz = Int_BufSz + 1 ! Swirl - Db_BufSz = Db_BufSz + 1 ! DtAero - Re_BufSz = Re_BufSz + 1 ! HubRad - Int_BufSz = Int_BufSz + 1 ! UnEc - Int_BufSz = Int_BufSz + 1 ! UnElem - Int_BufSz = Int_BufSz + 1 ! UnWndOut - Int_BufSz = Int_BufSz + 1 ! MAXICOUNT - Int_BufSz = Int_BufSz + 1 ! WrOptFile - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AirFoil - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AirFoil - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AirFoil - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Blade - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Blade - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Blade - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Beddoes - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Beddoes - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Beddoes - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DynInflow - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DynInflow - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DynInflow - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Element - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Element - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Element - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TwrProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TwrProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TwrProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InducedVel - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InducedVel - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InducedVel - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Wind - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Wind - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Wind - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Rotor - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Rotor - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Rotor - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - 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%Title) - IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%SIUnit, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%MultiTab, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LinearizeFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutputPlottingInfo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TwoPiNB - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBlInpSt - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ElemPrn, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DStall, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PMoment, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Reynolds, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DynInfl, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Wake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Swirl, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DtAero - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnEc - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnElem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnWndOut - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MAXICOUNT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrOptFile, IntKiBuf(1)) - 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 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - CALL DWM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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 AD14_PackParam - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - DO I = 1, LEN(OutData%Title) - OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SIUnit = TRANSFER(IntKiBuf(Int_Xferred), OutData%SIUnit) - Int_Xferred = Int_Xferred + 1 - OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%MultiTab = TRANSFER(IntKiBuf(Int_Xferred), OutData%MultiTab) - Int_Xferred = Int_Xferred + 1 - OutData%LinearizeFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinearizeFlag) - Int_Xferred = Int_Xferred + 1 - OutData%OutputPlottingInfo = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutputPlottingInfo) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) - Int_Xferred = Int_Xferred + 1 - OutData%TwoPiNB = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBlInpSt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ElemPrn = TRANSFER(IntKiBuf(Int_Xferred), OutData%ElemPrn) - Int_Xferred = Int_Xferred + 1 - OutData%DStall = TRANSFER(IntKiBuf(Int_Xferred), OutData%DStall) - Int_Xferred = Int_Xferred + 1 - OutData%PMoment = TRANSFER(IntKiBuf(Int_Xferred), OutData%PMoment) - Int_Xferred = Int_Xferred + 1 - OutData%Reynolds = TRANSFER(IntKiBuf(Int_Xferred), OutData%Reynolds) - Int_Xferred = Int_Xferred + 1 - OutData%DynInfl = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynInfl) - Int_Xferred = Int_Xferred + 1 - OutData%Wake = TRANSFER(IntKiBuf(Int_Xferred), OutData%Wake) - Int_Xferred = Int_Xferred + 1 - OutData%Swirl = TRANSFER(IntKiBuf(Int_Xferred), OutData%Swirl) - Int_Xferred = Int_Xferred + 1 - OutData%DtAero = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HubRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UnEc = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnElem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnWndOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MAXICOUNT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrOptFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrOptFile) - Int_Xferred = Int_Xferred + 1 - OutData%DEFAULT_Wind = 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 AD14_UnpackAirFoilParms( Re_Buf, Db_Buf, Int_Buf, OutData%AirFoil, ErrStat2, ErrMsg2 ) ! AirFoil - 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) - 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 AD14_UnpackBladeParms( Re_Buf, Db_Buf, Int_Buf, OutData%Blade, ErrStat2, ErrMsg2 ) ! Blade - 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) - 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 AD14_UnpackBeddoesParms( Re_Buf, Db_Buf, Int_Buf, OutData%Beddoes, ErrStat2, ErrMsg2 ) ! Beddoes - 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) - 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 AD14_UnpackDynInflowParms( Re_Buf, Db_Buf, Int_Buf, OutData%DynInflow, ErrStat2, ErrMsg2 ) ! DynInflow - 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) - 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 AD14_UnpackElementParms( Re_Buf, Db_Buf, Int_Buf, OutData%Element, ErrStat2, ErrMsg2 ) ! Element - 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) - 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 AD14_UnpackTwrPropsParms( Re_Buf, Db_Buf, Int_Buf, OutData%TwrProps, ErrStat2, ErrMsg2 ) ! TwrProps - 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) - 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 AD14_UnpackInducedVelParms( Re_Buf, Db_Buf, Int_Buf, OutData%InducedVel, ErrStat2, ErrMsg2 ) ! InducedVel - 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) - 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 AD14_UnpackWindParms( Re_Buf, Db_Buf, Int_Buf, OutData%Wind, ErrStat2, ErrMsg2 ) ! Wind - 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) - 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 AD14_UnpackRotorParms( Re_Buf, Db_Buf, Int_Buf, OutData%Rotor, ErrStat2, ErrMsg2 ) ! Rotor - 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) - 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 DWM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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 AD14_UnPackParam - - SUBROUTINE AD14_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_InputType), INTENT(INOUT) :: SrcInputData - TYPE(AD14_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) :: 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 = 'AD14_CopyInput' -! + ErrMsg = '' + call DWM_DestroyDiscState(DiscStateData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD14_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call DWM_PackDiscState(Buf, InData%DWM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call DWM_UnpackDiscState(Buf, OutData%DWM) ! DWM +end subroutine + +subroutine AD14_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(AD14_ConstraintStateType), intent(in) :: SrcConstrStateData + type(AD14_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%InputMarkers)) THEN - i1_l = LBOUND(SrcInputData%InputMarkers,1) - i1_u = UBOUND(SrcInputData%InputMarkers,1) - IF (.NOT. ALLOCATED(DstInputData%InputMarkers)) THEN - ALLOCATE(DstInputData%InputMarkers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InputMarkers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%InputMarkers,1), UBOUND(SrcInputData%InputMarkers,1) - CALL MeshCopy( SrcInputData%InputMarkers(i1), DstInputData%InputMarkers(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcInputData%Twr_InputMarkers, DstInputData%Twr_InputMarkers, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyaeroconfig( SrcInputData%TurbineComponents, DstInputData%TurbineComponents, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputData%MulTabLoc)) THEN - i1_l = LBOUND(SrcInputData%MulTabLoc,1) - i1_u = UBOUND(SrcInputData%MulTabLoc,1) - i2_l = LBOUND(SrcInputData%MulTabLoc,2) - i2_u = UBOUND(SrcInputData%MulTabLoc,2) - IF (.NOT. ALLOCATED(DstInputData%MulTabLoc)) THEN - ALLOCATE(DstInputData%MulTabLoc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MulTabLoc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%MulTabLoc = SrcInputData%MulTabLoc -ENDIF -IF (ALLOCATED(SrcInputData%InflowVelocity)) THEN - i1_l = LBOUND(SrcInputData%InflowVelocity,1) - i1_u = UBOUND(SrcInputData%InflowVelocity,1) - i2_l = LBOUND(SrcInputData%InflowVelocity,2) - i2_u = UBOUND(SrcInputData%InflowVelocity,2) - IF (.NOT. ALLOCATED(DstInputData%InflowVelocity)) THEN - ALLOCATE(DstInputData%InflowVelocity(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InflowVelocity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%InflowVelocity = SrcInputData%InflowVelocity -ENDIF - DstInputData%AvgInfVel = SrcInputData%AvgInfVel - END SUBROUTINE AD14_CopyInput - - SUBROUTINE AD14_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(AD14_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 = 'AD14_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%InputMarkers)) THEN -DO i1 = LBOUND(InputData%InputMarkers,1), UBOUND(InputData%InputMarkers,1) - CALL MeshDestroy( InputData%InputMarkers(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%InputMarkers) -ENDIF - CALL MeshDestroy( InputData%Twr_InputMarkers, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyAeroConfig( InputData%TurbineComponents, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputData%MulTabLoc)) THEN - DEALLOCATE(InputData%MulTabLoc) -ENDIF -IF (ALLOCATED(InputData%InflowVelocity)) THEN - DEALLOCATE(InputData%InflowVelocity) -ENDIF - END SUBROUTINE AD14_DestroyInput - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - Int_BufSz = Int_BufSz + 1 ! InputMarkers allocated yes/no - IF ( ALLOCATED(InData%InputMarkers) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputMarkers upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%InputMarkers,1), UBOUND(InData%InputMarkers,1) - Int_BufSz = Int_BufSz + 3 ! InputMarkers: size of buffers for each call to pack subtype - CALL MeshPack( InData%InputMarkers(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! InputMarkers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InputMarkers - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InputMarkers - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InputMarkers - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Twr_InputMarkers: size of buffers for each call to pack subtype - CALL MeshPack( InData%Twr_InputMarkers, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Twr_InputMarkers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Twr_InputMarkers - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Twr_InputMarkers - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Twr_InputMarkers - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TurbineComponents - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TurbineComponents - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TurbineComponents - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! MulTabLoc allocated yes/no - IF ( ALLOCATED(InData%MulTabLoc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MulTabLoc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MulTabLoc) ! MulTabLoc - END IF - Int_BufSz = Int_BufSz + 1 ! InflowVelocity allocated yes/no - IF ( ALLOCATED(InData%InflowVelocity) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InflowVelocity upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InflowVelocity) ! InflowVelocity - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AvgInfVel) ! AvgInfVel - 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%InputMarkers) ) 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%InputMarkers,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputMarkers,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputMarkers,1), UBOUND(InData%InputMarkers,1) - CALL MeshPack( InData%InputMarkers(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! InputMarkers - 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 - CALL MeshPack( InData%Twr_InputMarkers, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Twr_InputMarkers - 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%MulTabLoc) ) 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%MulTabLoc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabLoc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MulTabLoc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabLoc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MulTabLoc,2), UBOUND(InData%MulTabLoc,2) - DO i1 = LBOUND(InData%MulTabLoc,1), UBOUND(InData%MulTabLoc,1) - ReKiBuf(Re_Xferred) = InData%MulTabLoc(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InflowVelocity) ) 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%InflowVelocity,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowVelocity,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowVelocity,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowVelocity,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InflowVelocity,2), UBOUND(InData%InflowVelocity,2) - DO i1 = LBOUND(InData%InflowVelocity,1), UBOUND(InData%InflowVelocity,1) - ReKiBuf(Re_Xferred) = InData%InflowVelocity(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%AvgInfVel,1), UBOUND(InData%AvgInfVel,1) - ReKiBuf(Re_Xferred) = InData%AvgInfVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_PackInput - - SUBROUTINE AD14_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(AD14_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) :: 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 = 'AD14_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputMarkers 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%InputMarkers)) DEALLOCATE(OutData%InputMarkers) - ALLOCATE(OutData%InputMarkers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputMarkers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputMarkers,1), UBOUND(OutData%InputMarkers,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 MeshUnpack( OutData%InputMarkers(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! InputMarkers - 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 - 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 MeshUnpack( OutData%Twr_InputMarkers, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Twr_InputMarkers - 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) - 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 AD14_UnpackAeroConfig( Re_Buf, Db_Buf, Int_Buf, OutData%TurbineComponents, ErrStat2, ErrMsg2 ) ! TurbineComponents - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MulTabLoc 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%MulTabLoc)) DEALLOCATE(OutData%MulTabLoc) - ALLOCATE(OutData%MulTabLoc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabLoc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MulTabLoc,2), UBOUND(OutData%MulTabLoc,2) - DO i1 = LBOUND(OutData%MulTabLoc,1), UBOUND(OutData%MulTabLoc,1) - OutData%MulTabLoc(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InflowVelocity 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%InflowVelocity)) DEALLOCATE(OutData%InflowVelocity) - ALLOCATE(OutData%InflowVelocity(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowVelocity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InflowVelocity,2), UBOUND(OutData%InflowVelocity,2) - DO i1 = LBOUND(OutData%InflowVelocity,1), UBOUND(OutData%InflowVelocity,1) - OutData%InflowVelocity(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%AvgInfVel,1) - i1_u = UBOUND(OutData%AvgInfVel,1) - DO i1 = LBOUND(OutData%AvgInfVel,1), UBOUND(OutData%AvgInfVel,1) - OutData%AvgInfVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_UnPackInput - - SUBROUTINE AD14_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(AD14_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 = 'AD14_CopyOutput' -! + ErrMsg = '' + call DWM_CopyConstrState(SrcConstrStateData%DWM, DstConstrStateData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD14_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(AD14_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%OutputLoads)) THEN - i1_l = LBOUND(SrcOutputData%OutputLoads,1) - i1_u = UBOUND(SrcOutputData%OutputLoads,1) - IF (.NOT. ALLOCATED(DstOutputData%OutputLoads)) THEN - ALLOCATE(DstOutputData%OutputLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OutputLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%OutputLoads,1), UBOUND(SrcOutputData%OutputLoads,1) - CALL MeshCopy( SrcOutputData%OutputLoads(i1), DstOutputData%OutputLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcOutputData%Twr_OutputLoads, DstOutputData%Twr_OutputLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyOutput - - SUBROUTINE AD14_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(AD14_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 = 'AD14_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%OutputLoads)) THEN -DO i1 = LBOUND(OutputData%OutputLoads,1), UBOUND(OutputData%OutputLoads,1) - CALL MeshDestroy( OutputData%OutputLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%OutputLoads) -ENDIF - CALL MeshDestroy( OutputData%Twr_OutputLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyOutput - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 ! OutputLoads allocated yes/no - IF ( ALLOCATED(InData%OutputLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutputLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%OutputLoads,1), UBOUND(InData%OutputLoads,1) - Int_BufSz = Int_BufSz + 3 ! OutputLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%OutputLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! OutputLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutputLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutputLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutputLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Twr_OutputLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%Twr_OutputLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Twr_OutputLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Twr_OutputLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Twr_OutputLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Twr_OutputLoads - 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 - - IF ( .NOT. ALLOCATED(InData%OutputLoads) ) 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%OutputLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutputLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutputLoads,1), UBOUND(InData%OutputLoads,1) - CALL MeshPack( InData%OutputLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! OutputLoads - 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 - CALL MeshPack( InData%Twr_OutputLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Twr_OutputLoads - 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 AD14_PackOutput - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 ! OutputLoads 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%OutputLoads)) DEALLOCATE(OutData%OutputLoads) - ALLOCATE(OutData%OutputLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutputLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutputLoads,1), UBOUND(OutData%OutputLoads,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 MeshUnpack( OutData%OutputLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! OutputLoads - 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 - 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 MeshUnpack( OutData%Twr_OutputLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Twr_OutputLoads - 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 AD14_UnPackOutput - - - SUBROUTINE AD14_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(AD14_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(AD14_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 + ErrMsg = '' + call DWM_DestroyConstrState(ConstrStateData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD14_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call DWM_PackConstrState(Buf, InData%DWM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call DWM_UnpackConstrState(Buf, OutData%DWM) ! DWM +end subroutine + +subroutine AD14_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(AD14_OtherStateType), intent(in) :: SrcOtherStateData + type(AD14_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call DWM_CopyOtherState(SrcOtherStateData%DWM, DstOtherStateData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD14_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(AD14_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call DWM_DestroyOtherState(OtherStateData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD14_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call DWM_PackOtherState(Buf, InData%DWM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call DWM_UnpackOtherState(Buf, OutData%DWM) ! DWM +end subroutine + +subroutine AD14_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(AD14_MiscVarType), intent(in) :: SrcMiscData + type(AD14_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call DWM_CopyMisc(SrcMiscData%DWM, DstMiscData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyInput(SrcMiscData%DWM_Inputs, DstMiscData%DWM_Inputs, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyOutput(SrcMiscData%DWM_Outputs, DstMiscData%DWM_Outputs, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%DT = SrcMiscData%DT + if (allocated(SrcMiscData%ElPrNum)) then + LB(1:1) = lbound(SrcMiscData%ElPrNum) + UB(1:1) = ubound(SrcMiscData%ElPrNum) + if (.not. allocated(DstMiscData%ElPrNum)) then + allocate(DstMiscData%ElPrNum(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ElPrNum.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ElPrNum = SrcMiscData%ElPrNum + end if + DstMiscData%OldTime = SrcMiscData%OldTime + DstMiscData%HubLoss = SrcMiscData%HubLoss + DstMiscData%Loss = SrcMiscData%Loss + DstMiscData%TipLoss = SrcMiscData%TipLoss + DstMiscData%TLpt7 = SrcMiscData%TLpt7 + DstMiscData%FirstPassGTL = SrcMiscData%FirstPassGTL + DstMiscData%SuperSonic = SrcMiscData%SuperSonic + DstMiscData%AFLAGVinderr = SrcMiscData%AFLAGVinderr + DstMiscData%AFLAGTwrInflu = SrcMiscData%AFLAGTwrInflu + DstMiscData%OnePassDynDbg = SrcMiscData%OnePassDynDbg + DstMiscData%NoLoadsCalculated = SrcMiscData%NoLoadsCalculated + DstMiscData%NERRORS = SrcMiscData%NERRORS + call AD14_CopyAirFoil(SrcMiscData%AirFoil, DstMiscData%AirFoil, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyBeddoes(SrcMiscData%Beddoes, DstMiscData%Beddoes, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyDynInflow(SrcMiscData%DynInflow, DstMiscData%DynInflow, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyElement(SrcMiscData%Element, DstMiscData%Element, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyRotor(SrcMiscData%Rotor, DstMiscData%Rotor, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyWind(SrcMiscData%Wind, DstMiscData%Wind, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyInducedVel(SrcMiscData%InducedVel, DstMiscData%InducedVel, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyElOutParms(SrcMiscData%ElOut, DstMiscData%ElOut, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%Skew = SrcMiscData%Skew + DstMiscData%DynInit = SrcMiscData%DynInit + DstMiscData%FirstWarn = SrcMiscData%FirstWarn + if (allocated(SrcMiscData%StoredForces)) then + LB(1:3) = lbound(SrcMiscData%StoredForces) + UB(1:3) = ubound(SrcMiscData%StoredForces) + if (.not. allocated(DstMiscData%StoredForces)) then + allocate(DstMiscData%StoredForces(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StoredForces.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%StoredForces = SrcMiscData%StoredForces + end if + if (allocated(SrcMiscData%StoredMoments)) then + LB(1:3) = lbound(SrcMiscData%StoredMoments) + UB(1:3) = ubound(SrcMiscData%StoredMoments) + if (.not. allocated(DstMiscData%StoredMoments)) then + allocate(DstMiscData%StoredMoments(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StoredMoments.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%StoredMoments = SrcMiscData%StoredMoments + end if +end subroutine + +subroutine AD14_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(AD14_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call DWM_DestroyMisc(MiscData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyInput(MiscData%DWM_Inputs, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyOutput(MiscData%DWM_Outputs, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%ElPrNum)) then + deallocate(MiscData%ElPrNum) + end if + call AD14_DestroyAirFoil(MiscData%AirFoil, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyBeddoes(MiscData%Beddoes, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyDynInflow(MiscData%DynInflow, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyElement(MiscData%Element, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyRotor(MiscData%Rotor, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyWind(MiscData%Wind, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyInducedVel(MiscData%InducedVel, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyElOutParms(MiscData%ElOut, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%StoredForces)) then + deallocate(MiscData%StoredForces) + end if + if (allocated(MiscData%StoredMoments)) then + deallocate(MiscData%StoredMoments) + end if +end subroutine + +subroutine AD14_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call DWM_PackMisc(Buf, InData%DWM) + call DWM_PackInput(Buf, InData%DWM_Inputs) + call DWM_PackOutput(Buf, InData%DWM_Outputs) + call RegPack(Buf, InData%DT) + call RegPack(Buf, allocated(InData%ElPrNum)) + if (allocated(InData%ElPrNum)) then + call RegPackBounds(Buf, 1, lbound(InData%ElPrNum), ubound(InData%ElPrNum)) + call RegPack(Buf, InData%ElPrNum) + end if + call RegPack(Buf, InData%OldTime) + call RegPack(Buf, InData%HubLoss) + call RegPack(Buf, InData%Loss) + call RegPack(Buf, InData%TipLoss) + call RegPack(Buf, InData%TLpt7) + call RegPack(Buf, InData%FirstPassGTL) + call RegPack(Buf, InData%SuperSonic) + call RegPack(Buf, InData%AFLAGVinderr) + call RegPack(Buf, InData%AFLAGTwrInflu) + call RegPack(Buf, InData%OnePassDynDbg) + call RegPack(Buf, InData%NoLoadsCalculated) + call RegPack(Buf, InData%NERRORS) + call AD14_PackAirFoil(Buf, InData%AirFoil) + call AD14_PackBeddoes(Buf, InData%Beddoes) + call AD14_PackDynInflow(Buf, InData%DynInflow) + call AD14_PackElement(Buf, InData%Element) + call AD14_PackRotor(Buf, InData%Rotor) + call AD14_PackWind(Buf, InData%Wind) + call AD14_PackInducedVel(Buf, InData%InducedVel) + call AD14_PackElOutParms(Buf, InData%ElOut) + call RegPack(Buf, InData%Skew) + call RegPack(Buf, InData%DynInit) + call RegPack(Buf, InData%FirstWarn) + call RegPack(Buf, allocated(InData%StoredForces)) + if (allocated(InData%StoredForces)) then + call RegPackBounds(Buf, 3, lbound(InData%StoredForces), ubound(InData%StoredForces)) + call RegPack(Buf, InData%StoredForces) + end if + call RegPack(Buf, allocated(InData%StoredMoments)) + if (allocated(InData%StoredMoments)) then + call RegPackBounds(Buf, 3, lbound(InData%StoredMoments), ubound(InData%StoredMoments)) + call RegPack(Buf, InData%StoredMoments) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackMisc' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call DWM_UnpackMisc(Buf, OutData%DWM) ! DWM + call DWM_UnpackInput(Buf, OutData%DWM_Inputs) ! DWM_Inputs + call DWM_UnpackOutput(Buf, OutData%DWM_Outputs) ! DWM_Outputs + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ElPrNum)) deallocate(OutData%ElPrNum) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElPrNum(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElPrNum) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%OldTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubLoss) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Loss) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TipLoss) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TLpt7) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FirstPassGTL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SuperSonic) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AFLAGVinderr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AFLAGTwrInflu) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OnePassDynDbg) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NoLoadsCalculated) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NERRORS) + if (RegCheckErr(Buf, RoutineName)) return + call AD14_UnpackAirFoil(Buf, OutData%AirFoil) ! AirFoil + call AD14_UnpackBeddoes(Buf, OutData%Beddoes) ! Beddoes + call AD14_UnpackDynInflow(Buf, OutData%DynInflow) ! DynInflow + call AD14_UnpackElement(Buf, OutData%Element) ! Element + call AD14_UnpackRotor(Buf, OutData%Rotor) ! Rotor + call AD14_UnpackWind(Buf, OutData%Wind) ! Wind + call AD14_UnpackInducedVel(Buf, OutData%InducedVel) ! InducedVel + call AD14_UnpackElOutParms(Buf, OutData%ElOut) ! ElOut + call RegUnpack(Buf, OutData%Skew) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DynInit) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FirstWarn) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%StoredForces)) deallocate(OutData%StoredForces) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StoredForces(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StoredForces.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StoredForces) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StoredMoments)) deallocate(OutData%StoredMoments) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StoredMoments(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StoredMoments.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StoredMoments) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AD14_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AD14_ParameterType), intent(in) :: SrcParamData + type(AD14_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%Title = SrcParamData%Title + DstParamData%SIUnit = SrcParamData%SIUnit + DstParamData%Echo = SrcParamData%Echo + DstParamData%MultiTab = SrcParamData%MultiTab + DstParamData%LinearizeFlag = SrcParamData%LinearizeFlag + DstParamData%OutputPlottingInfo = SrcParamData%OutputPlottingInfo + DstParamData%UseDWM = SrcParamData%UseDWM + DstParamData%TwoPiNB = SrcParamData%TwoPiNB + DstParamData%NumBl = SrcParamData%NumBl + DstParamData%NBlInpSt = SrcParamData%NBlInpSt + DstParamData%ElemPrn = SrcParamData%ElemPrn + DstParamData%DStall = SrcParamData%DStall + DstParamData%PMoment = SrcParamData%PMoment + DstParamData%Reynolds = SrcParamData%Reynolds + DstParamData%DynInfl = SrcParamData%DynInfl + DstParamData%Wake = SrcParamData%Wake + DstParamData%Swirl = SrcParamData%Swirl + DstParamData%DtAero = SrcParamData%DtAero + DstParamData%HubRad = SrcParamData%HubRad + DstParamData%UnEc = SrcParamData%UnEc + DstParamData%UnElem = SrcParamData%UnElem + DstParamData%UnWndOut = SrcParamData%UnWndOut + DstParamData%MAXICOUNT = SrcParamData%MAXICOUNT + DstParamData%WrOptFile = SrcParamData%WrOptFile + DstParamData%DEFAULT_Wind = SrcParamData%DEFAULT_Wind + call AD14_CopyAirFoilParms(SrcParamData%AirFoil, DstParamData%AirFoil, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyBladeParms(SrcParamData%Blade, DstParamData%Blade, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyBeddoesParms(SrcParamData%Beddoes, DstParamData%Beddoes, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyDynInflowParms(SrcParamData%DynInflow, DstParamData%DynInflow, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyElementParms(SrcParamData%Element, DstParamData%Element, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyTwrPropsParms(SrcParamData%TwrProps, DstParamData%TwrProps, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyInducedVelParms(SrcParamData%InducedVel, DstParamData%InducedVel, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyWindParms(SrcParamData%Wind, DstParamData%Wind, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyRotorParms(SrcParamData%Rotor, DstParamData%Rotor, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyParam(SrcParamData%DWM, DstParamData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD14_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AD14_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + call AD14_DestroyAirFoilParms(ParamData%AirFoil, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyBladeParms(ParamData%Blade, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyBeddoesParms(ParamData%Beddoes, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyDynInflowParms(ParamData%DynInflow, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyElementParms(ParamData%Element, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyTwrPropsParms(ParamData%TwrProps, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyInducedVelParms(ParamData%InducedVel, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyWindParms(ParamData%Wind, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyRotorParms(ParamData%Rotor, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyParam(ParamData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD14_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Title) + call RegPack(Buf, InData%SIUnit) + call RegPack(Buf, InData%Echo) + call RegPack(Buf, InData%MultiTab) + call RegPack(Buf, InData%LinearizeFlag) + call RegPack(Buf, InData%OutputPlottingInfo) + call RegPack(Buf, InData%UseDWM) + call RegPack(Buf, InData%TwoPiNB) + call RegPack(Buf, InData%NumBl) + call RegPack(Buf, InData%NBlInpSt) + call RegPack(Buf, InData%ElemPrn) + call RegPack(Buf, InData%DStall) + call RegPack(Buf, InData%PMoment) + call RegPack(Buf, InData%Reynolds) + call RegPack(Buf, InData%DynInfl) + call RegPack(Buf, InData%Wake) + call RegPack(Buf, InData%Swirl) + call RegPack(Buf, InData%DtAero) + call RegPack(Buf, InData%HubRad) + call RegPack(Buf, InData%UnEc) + call RegPack(Buf, InData%UnElem) + call RegPack(Buf, InData%UnWndOut) + call RegPack(Buf, InData%MAXICOUNT) + call RegPack(Buf, InData%WrOptFile) + call RegPack(Buf, InData%DEFAULT_Wind) + call AD14_PackAirFoilParms(Buf, InData%AirFoil) + call AD14_PackBladeParms(Buf, InData%Blade) + call AD14_PackBeddoesParms(Buf, InData%Beddoes) + call AD14_PackDynInflowParms(Buf, InData%DynInflow) + call AD14_PackElementParms(Buf, InData%Element) + call AD14_PackTwrPropsParms(Buf, InData%TwrProps) + call AD14_PackInducedVelParms(Buf, InData%InducedVel) + call AD14_PackWindParms(Buf, InData%Wind) + call AD14_PackRotorParms(Buf, InData%Rotor) + call DWM_PackParam(Buf, InData%DWM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackParam' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Title) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SIUnit) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MultiTab) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinearizeFlag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutputPlottingInfo) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UseDWM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwoPiNB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBlInpSt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ElemPrn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DStall) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PMoment) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Reynolds) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DynInfl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Wake) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Swirl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DtAero) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubRad) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnEc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnElem) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnWndOut) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MAXICOUNT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrOptFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DEFAULT_Wind) + if (RegCheckErr(Buf, RoutineName)) return + call AD14_UnpackAirFoilParms(Buf, OutData%AirFoil) ! AirFoil + call AD14_UnpackBladeParms(Buf, OutData%Blade) ! Blade + call AD14_UnpackBeddoesParms(Buf, OutData%Beddoes) ! Beddoes + call AD14_UnpackDynInflowParms(Buf, OutData%DynInflow) ! DynInflow + call AD14_UnpackElementParms(Buf, OutData%Element) ! Element + call AD14_UnpackTwrPropsParms(Buf, OutData%TwrProps) ! TwrProps + call AD14_UnpackInducedVelParms(Buf, OutData%InducedVel) ! InducedVel + call AD14_UnpackWindParms(Buf, OutData%Wind) ! Wind + call AD14_UnpackRotorParms(Buf, OutData%Rotor) ! Rotor + call DWM_UnpackParam(Buf, OutData%DWM) ! DWM +end subroutine + +subroutine AD14_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AD14_InputType), intent(inout) :: SrcInputData + type(AD14_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%InputMarkers)) then + LB(1:1) = lbound(SrcInputData%InputMarkers) + UB(1:1) = ubound(SrcInputData%InputMarkers) + if (.not. allocated(DstInputData%InputMarkers)) then + allocate(DstInputData%InputMarkers(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InputMarkers.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%InputMarkers(i1), DstInputData%InputMarkers(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcInputData%Twr_InputMarkers, DstInputData%Twr_InputMarkers, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyAeroConfig(SrcInputData%TurbineComponents, DstInputData%TurbineComponents, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%MulTabLoc)) then + LB(1:2) = lbound(SrcInputData%MulTabLoc) + UB(1:2) = ubound(SrcInputData%MulTabLoc) + if (.not. allocated(DstInputData%MulTabLoc)) then + allocate(DstInputData%MulTabLoc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MulTabLoc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%MulTabLoc = SrcInputData%MulTabLoc + end if + if (allocated(SrcInputData%InflowVelocity)) then + LB(1:2) = lbound(SrcInputData%InflowVelocity) + UB(1:2) = ubound(SrcInputData%InflowVelocity) + if (.not. allocated(DstInputData%InflowVelocity)) then + allocate(DstInputData%InflowVelocity(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InflowVelocity.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%InflowVelocity = SrcInputData%InflowVelocity + end if + DstInputData%AvgInfVel = SrcInputData%AvgInfVel +end subroutine + +subroutine AD14_DestroyInput(InputData, ErrStat, ErrMsg) + type(AD14_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%InputMarkers)) then + LB(1:1) = lbound(InputData%InputMarkers) + UB(1:1) = ubound(InputData%InputMarkers) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%InputMarkers(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%InputMarkers) + end if + call MeshDestroy( InputData%Twr_InputMarkers, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyAeroConfig(InputData%TurbineComponents, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputData%MulTabLoc)) then + deallocate(InputData%MulTabLoc) + end if + if (allocated(InputData%InflowVelocity)) then + deallocate(InputData%InflowVelocity) + end if +end subroutine + +subroutine AD14_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%InputMarkers)) + if (allocated(InData%InputMarkers)) then + call RegPackBounds(Buf, 1, lbound(InData%InputMarkers), ubound(InData%InputMarkers)) + LB(1:1) = lbound(InData%InputMarkers) + UB(1:1) = ubound(InData%InputMarkers) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%InputMarkers(i1)) + end do + end if + call MeshPack(Buf, InData%Twr_InputMarkers) + call AD14_PackAeroConfig(Buf, InData%TurbineComponents) + call RegPack(Buf, allocated(InData%MulTabLoc)) + if (allocated(InData%MulTabLoc)) then + call RegPackBounds(Buf, 2, lbound(InData%MulTabLoc), ubound(InData%MulTabLoc)) + call RegPack(Buf, InData%MulTabLoc) + end if + call RegPack(Buf, allocated(InData%InflowVelocity)) + if (allocated(InData%InflowVelocity)) then + call RegPackBounds(Buf, 2, lbound(InData%InflowVelocity), ubound(InData%InflowVelocity)) + call RegPack(Buf, InData%InflowVelocity) + end if + call RegPack(Buf, InData%AvgInfVel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%InputMarkers)) deallocate(OutData%InputMarkers) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputMarkers(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputMarkers.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%InputMarkers(i1)) ! InputMarkers + end do + end if + call MeshUnpack(Buf, OutData%Twr_InputMarkers) ! Twr_InputMarkers + call AD14_UnpackAeroConfig(Buf, OutData%TurbineComponents) ! TurbineComponents + if (allocated(OutData%MulTabLoc)) deallocate(OutData%MulTabLoc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MulTabLoc(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabLoc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MulTabLoc) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%InflowVelocity)) deallocate(OutData%InflowVelocity) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InflowVelocity(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowVelocity.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InflowVelocity) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%AvgInfVel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AD14_OutputType), intent(inout) :: SrcOutputData + type(AD14_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%OutputLoads)) then + LB(1:1) = lbound(SrcOutputData%OutputLoads) + UB(1:1) = ubound(SrcOutputData%OutputLoads) + if (.not. allocated(DstOutputData%OutputLoads)) then + allocate(DstOutputData%OutputLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OutputLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%OutputLoads(i1), DstOutputData%OutputLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcOutputData%Twr_OutputLoads, DstOutputData%Twr_OutputLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD14_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AD14_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%OutputLoads)) then + LB(1:1) = lbound(OutputData%OutputLoads) + UB(1:1) = ubound(OutputData%OutputLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%OutputLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%OutputLoads) + end if + call MeshDestroy( OutputData%Twr_OutputLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD14_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%OutputLoads)) + if (allocated(InData%OutputLoads)) then + call RegPackBounds(Buf, 1, lbound(InData%OutputLoads), ubound(InData%OutputLoads)) + LB(1:1) = lbound(InData%OutputLoads) + UB(1:1) = ubound(InData%OutputLoads) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%OutputLoads(i1)) + end do + end if + call MeshPack(Buf, InData%Twr_OutputLoads) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%OutputLoads)) deallocate(OutData%OutputLoads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutputLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutputLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%OutputLoads(i1)) ! OutputLoads + end do + end if + call MeshUnpack(Buf, OutData%Twr_OutputLoads) ! Twr_OutputLoads +end subroutine + +subroutine AD14_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(AD14_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(AD14_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 = 'AD14_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 AD14_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AD14_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 AD14_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 AD14_Input_ExtrapInterp - - - SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'AD14_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call AD14_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AD14_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AD14_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE AD14_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. @@ -16379,229 +6543,104 @@ SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(AD14_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(AD14_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(AD14_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 + TYPE(AD14_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(AD14_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(AD14_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 = 'AD14_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 - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i11 ! dim1 level 1 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i11 ! dim1 level 1 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN - DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) - CALL MeshExtrapInterp1(u1%InputMarkers(i1), u2%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp1(u1%Twr_InputMarkers, u2%Twr_InputMarkers, tin, u_out%Twr_InputMarkers, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Position,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Position,1) - b = -(u1%TurbineComponents%Blade(i11)%Position(i1) - u2%TurbineComponents%Blade(i11)%Position(i1)) - u_out%TurbineComponents%Blade(i11)%Position(i1) = u1%TurbineComponents%Blade(i11)%Position(i1) + b * ScaleFactor - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i2 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1) - b = -(u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) - u2%TurbineComponents%Blade(i11)%Orientation(i1,i2)) - u_out%TurbineComponents%Blade(i11)%Orientation(i1,i2) = u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1) - b = -(u1%TurbineComponents%Blade(i11)%TranslationVel(i1) - u2%TurbineComponents%Blade(i11)%TranslationVel(i1)) - u_out%TurbineComponents%Blade(i11)%TranslationVel(i1) = u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + b * ScaleFactor - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1) - b = -(u1%TurbineComponents%Blade(i11)%RotationVel(i1) - u2%TurbineComponents%Blade(i11)%RotationVel(i1)) - u_out%TurbineComponents%Blade(i11)%RotationVel(i1) = u1%TurbineComponents%Blade(i11)%RotationVel(i1) + b * ScaleFactor - END DO - ENDDO -END IF ! check if allocated - DO i1 = LBOUND(u_out%TurbineComponents%Hub%Position,1),UBOUND(u_out%TurbineComponents%Hub%Position,1) - b = -(u1%TurbineComponents%Hub%Position(i1) - u2%TurbineComponents%Hub%Position(i1)) - u_out%TurbineComponents%Hub%Position(i1) = u1%TurbineComponents%Hub%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Hub%Orientation,2),UBOUND(u_out%TurbineComponents%Hub%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Hub%Orientation,1),UBOUND(u_out%TurbineComponents%Hub%Orientation,1) - b = -(u1%TurbineComponents%Hub%Orientation(i1,i2) - u2%TurbineComponents%Hub%Orientation(i1,i2)) - u_out%TurbineComponents%Hub%Orientation(i1,i2) = u1%TurbineComponents%Hub%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Hub%TranslationVel,1),UBOUND(u_out%TurbineComponents%Hub%TranslationVel,1) - b = -(u1%TurbineComponents%Hub%TranslationVel(i1) - u2%TurbineComponents%Hub%TranslationVel(i1)) - u_out%TurbineComponents%Hub%TranslationVel(i1) = u1%TurbineComponents%Hub%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Hub%RotationVel,1),UBOUND(u_out%TurbineComponents%Hub%RotationVel,1) - b = -(u1%TurbineComponents%Hub%RotationVel(i1) - u2%TurbineComponents%Hub%RotationVel(i1)) - u_out%TurbineComponents%Hub%RotationVel(i1) = u1%TurbineComponents%Hub%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Position,1),UBOUND(u_out%TurbineComponents%RotorFurl%Position,1) - b = -(u1%TurbineComponents%RotorFurl%Position(i1) - u2%TurbineComponents%RotorFurl%Position(i1)) - u_out%TurbineComponents%RotorFurl%Position(i1) = u1%TurbineComponents%RotorFurl%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1) - b = -(u1%TurbineComponents%RotorFurl%Orientation(i1,i2) - u2%TurbineComponents%RotorFurl%Orientation(i1,i2)) - u_out%TurbineComponents%RotorFurl%Orientation(i1,i2) = u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1) - b = -(u1%TurbineComponents%RotorFurl%TranslationVel(i1) - u2%TurbineComponents%RotorFurl%TranslationVel(i1)) - u_out%TurbineComponents%RotorFurl%TranslationVel(i1) = u1%TurbineComponents%RotorFurl%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1) - b = -(u1%TurbineComponents%RotorFurl%RotationVel(i1) - u2%TurbineComponents%RotorFurl%RotationVel(i1)) - u_out%TurbineComponents%RotorFurl%RotationVel(i1) = u1%TurbineComponents%RotorFurl%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Position,1),UBOUND(u_out%TurbineComponents%Nacelle%Position,1) - b = -(u1%TurbineComponents%Nacelle%Position(i1) - u2%TurbineComponents%Nacelle%Position(i1)) - u_out%TurbineComponents%Nacelle%Position(i1) = u1%TurbineComponents%Nacelle%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,2),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,1),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,1) - b = -(u1%TurbineComponents%Nacelle%Orientation(i1,i2) - u2%TurbineComponents%Nacelle%Orientation(i1,i2)) - u_out%TurbineComponents%Nacelle%Orientation(i1,i2) = u1%TurbineComponents%Nacelle%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1) - b = -(u1%TurbineComponents%Nacelle%TranslationVel(i1) - u2%TurbineComponents%Nacelle%TranslationVel(i1)) - u_out%TurbineComponents%Nacelle%TranslationVel(i1) = u1%TurbineComponents%Nacelle%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1) - b = -(u1%TurbineComponents%Nacelle%RotationVel(i1) - u2%TurbineComponents%Nacelle%RotationVel(i1)) - u_out%TurbineComponents%Nacelle%RotationVel(i1) = u1%TurbineComponents%Nacelle%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Position,1),UBOUND(u_out%TurbineComponents%TailFin%Position,1) - b = -(u1%TurbineComponents%TailFin%Position(i1) - u2%TurbineComponents%TailFin%Position(i1)) - u_out%TurbineComponents%TailFin%Position(i1) = u1%TurbineComponents%TailFin%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,2),UBOUND(u_out%TurbineComponents%TailFin%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,1),UBOUND(u_out%TurbineComponents%TailFin%Orientation,1) - b = -(u1%TurbineComponents%TailFin%Orientation(i1,i2) - u2%TurbineComponents%TailFin%Orientation(i1,i2)) - u_out%TurbineComponents%TailFin%Orientation(i1,i2) = u1%TurbineComponents%TailFin%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1),UBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1) - b = -(u1%TurbineComponents%TailFin%TranslationVel(i1) - u2%TurbineComponents%TailFin%TranslationVel(i1)) - u_out%TurbineComponents%TailFin%TranslationVel(i1) = u1%TurbineComponents%TailFin%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%RotationVel,1),UBOUND(u_out%TurbineComponents%TailFin%RotationVel,1) - b = -(u1%TurbineComponents%TailFin%RotationVel(i1) - u2%TurbineComponents%TailFin%RotationVel(i1)) - u_out%TurbineComponents%TailFin%RotationVel(i1) = u1%TurbineComponents%TailFin%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%Position,1),UBOUND(u_out%TurbineComponents%Tower%Position,1) - b = -(u1%TurbineComponents%Tower%Position(i1) - u2%TurbineComponents%Tower%Position(i1)) - u_out%TurbineComponents%Tower%Position(i1) = u1%TurbineComponents%Tower%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Tower%Orientation,2),UBOUND(u_out%TurbineComponents%Tower%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Tower%Orientation,1),UBOUND(u_out%TurbineComponents%Tower%Orientation,1) - b = -(u1%TurbineComponents%Tower%Orientation(i1,i2) - u2%TurbineComponents%Tower%Orientation(i1,i2)) - u_out%TurbineComponents%Tower%Orientation(i1,i2) = u1%TurbineComponents%Tower%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%TranslationVel,1),UBOUND(u_out%TurbineComponents%Tower%TranslationVel,1) - b = -(u1%TurbineComponents%Tower%TranslationVel(i1) - u2%TurbineComponents%Tower%TranslationVel(i1)) - u_out%TurbineComponents%Tower%TranslationVel(i1) = u1%TurbineComponents%Tower%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%RotationVel,1),UBOUND(u_out%TurbineComponents%Tower%RotationVel,1) - b = -(u1%TurbineComponents%Tower%RotationVel(i1) - u2%TurbineComponents%Tower%RotationVel(i1)) - u_out%TurbineComponents%Tower%RotationVel(i1) = u1%TurbineComponents%Tower%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Position,1),UBOUND(u_out%TurbineComponents%SubStructure%Position,1) - b = -(u1%TurbineComponents%SubStructure%Position(i1) - u2%TurbineComponents%SubStructure%Position(i1)) - u_out%TurbineComponents%SubStructure%Position(i1) = u1%TurbineComponents%SubStructure%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,2),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,1),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,1) - b = -(u1%TurbineComponents%SubStructure%Orientation(i1,i2) - u2%TurbineComponents%SubStructure%Orientation(i1,i2)) - u_out%TurbineComponents%SubStructure%Orientation(i1,i2) = u1%TurbineComponents%SubStructure%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1) - b = -(u1%TurbineComponents%SubStructure%TranslationVel(i1) - u2%TurbineComponents%SubStructure%TranslationVel(i1)) - u_out%TurbineComponents%SubStructure%TranslationVel(i1) = u1%TurbineComponents%SubStructure%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1) - b = -(u1%TurbineComponents%SubStructure%RotationVel(i1) - u2%TurbineComponents%SubStructure%RotationVel(i1)) - u_out%TurbineComponents%SubStructure%RotationVel(i1) = u1%TurbineComponents%SubStructure%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Position,1),UBOUND(u_out%TurbineComponents%Foundation%Position,1) - b = -(u1%TurbineComponents%Foundation%Position(i1) - u2%TurbineComponents%Foundation%Position(i1)) - u_out%TurbineComponents%Foundation%Position(i1) = u1%TurbineComponents%Foundation%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,2),UBOUND(u_out%TurbineComponents%Foundation%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,1),UBOUND(u_out%TurbineComponents%Foundation%Orientation,1) - b = -(u1%TurbineComponents%Foundation%Orientation(i1,i2) - u2%TurbineComponents%Foundation%Orientation(i1,i2)) - u_out%TurbineComponents%Foundation%Orientation(i1,i2) = u1%TurbineComponents%Foundation%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1),UBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1) - b = -(u1%TurbineComponents%Foundation%TranslationVel(i1) - u2%TurbineComponents%Foundation%TranslationVel(i1)) - u_out%TurbineComponents%Foundation%TranslationVel(i1) = u1%TurbineComponents%Foundation%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%RotationVel,1),UBOUND(u_out%TurbineComponents%Foundation%RotationVel,1) - b = -(u1%TurbineComponents%Foundation%RotationVel(i1) - u2%TurbineComponents%Foundation%RotationVel(i1)) - u_out%TurbineComponents%Foundation%RotationVel(i1) = u1%TurbineComponents%Foundation%RotationVel(i1) + b * ScaleFactor - END DO - b = -(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength) - u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b * ScaleFactor -IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN - DO i2 = LBOUND(u_out%MulTabLoc,2),UBOUND(u_out%MulTabLoc,2) - DO i1 = LBOUND(u_out%MulTabLoc,1),UBOUND(u_out%MulTabLoc,1) - b = -(u1%MulTabLoc(i1,i2) - u2%MulTabLoc(i1,i2)) - u_out%MulTabLoc(i1,i2) = u1%MulTabLoc(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN - DO i2 = LBOUND(u_out%InflowVelocity,2),UBOUND(u_out%InflowVelocity,2) - DO i1 = LBOUND(u_out%InflowVelocity,1),UBOUND(u_out%InflowVelocity,1) - b = -(u1%InflowVelocity(i1,i2) - u2%InflowVelocity(i1,i2)) - u_out%InflowVelocity(i1,i2) = u1%InflowVelocity(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - DO i1 = LBOUND(u_out%AvgInfVel,1),UBOUND(u_out%AvgInfVel,1) - b = -(u1%AvgInfVel(i1) - u2%AvgInfVel(i1)) - u_out%AvgInfVel(i1) = u1%AvgInfVel(i1) + b * ScaleFactor - END DO - END SUBROUTINE AD14_Input_ExtrapInterp1 - - - SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN + DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) + CALL MeshExtrapInterp1(u1%InputMarkers(i1), u2%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp1(u1%Twr_InputMarkers, u2%Twr_InputMarkers, tin, u_out%Twr_InputMarkers, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%Position = a1*u1%TurbineComponents%Blade(i11)%Position + a2*u2%TurbineComponents%Blade(i11)%Position + END DO + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%Orientation = a1*u1%TurbineComponents%Blade(i11)%Orientation + a2*u2%TurbineComponents%Blade(i11)%Orientation + END DO + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%TranslationVel = a1*u1%TurbineComponents%Blade(i11)%TranslationVel + a2*u2%TurbineComponents%Blade(i11)%TranslationVel + END DO + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%RotationVel = a1*u1%TurbineComponents%Blade(i11)%RotationVel + a2*u2%TurbineComponents%Blade(i11)%RotationVel + END DO + END IF ! check if allocated + u_out%TurbineComponents%Hub%Position = a1*u1%TurbineComponents%Hub%Position + a2*u2%TurbineComponents%Hub%Position + u_out%TurbineComponents%Hub%Orientation = a1*u1%TurbineComponents%Hub%Orientation + a2*u2%TurbineComponents%Hub%Orientation + u_out%TurbineComponents%Hub%TranslationVel = a1*u1%TurbineComponents%Hub%TranslationVel + a2*u2%TurbineComponents%Hub%TranslationVel + u_out%TurbineComponents%Hub%RotationVel = a1*u1%TurbineComponents%Hub%RotationVel + a2*u2%TurbineComponents%Hub%RotationVel + u_out%TurbineComponents%RotorFurl%Position = a1*u1%TurbineComponents%RotorFurl%Position + a2*u2%TurbineComponents%RotorFurl%Position + u_out%TurbineComponents%RotorFurl%Orientation = a1*u1%TurbineComponents%RotorFurl%Orientation + a2*u2%TurbineComponents%RotorFurl%Orientation + u_out%TurbineComponents%RotorFurl%TranslationVel = a1*u1%TurbineComponents%RotorFurl%TranslationVel + a2*u2%TurbineComponents%RotorFurl%TranslationVel + u_out%TurbineComponents%RotorFurl%RotationVel = a1*u1%TurbineComponents%RotorFurl%RotationVel + a2*u2%TurbineComponents%RotorFurl%RotationVel + u_out%TurbineComponents%Nacelle%Position = a1*u1%TurbineComponents%Nacelle%Position + a2*u2%TurbineComponents%Nacelle%Position + u_out%TurbineComponents%Nacelle%Orientation = a1*u1%TurbineComponents%Nacelle%Orientation + a2*u2%TurbineComponents%Nacelle%Orientation + u_out%TurbineComponents%Nacelle%TranslationVel = a1*u1%TurbineComponents%Nacelle%TranslationVel + a2*u2%TurbineComponents%Nacelle%TranslationVel + u_out%TurbineComponents%Nacelle%RotationVel = a1*u1%TurbineComponents%Nacelle%RotationVel + a2*u2%TurbineComponents%Nacelle%RotationVel + u_out%TurbineComponents%TailFin%Position = a1*u1%TurbineComponents%TailFin%Position + a2*u2%TurbineComponents%TailFin%Position + u_out%TurbineComponents%TailFin%Orientation = a1*u1%TurbineComponents%TailFin%Orientation + a2*u2%TurbineComponents%TailFin%Orientation + u_out%TurbineComponents%TailFin%TranslationVel = a1*u1%TurbineComponents%TailFin%TranslationVel + a2*u2%TurbineComponents%TailFin%TranslationVel + u_out%TurbineComponents%TailFin%RotationVel = a1*u1%TurbineComponents%TailFin%RotationVel + a2*u2%TurbineComponents%TailFin%RotationVel + u_out%TurbineComponents%Tower%Position = a1*u1%TurbineComponents%Tower%Position + a2*u2%TurbineComponents%Tower%Position + u_out%TurbineComponents%Tower%Orientation = a1*u1%TurbineComponents%Tower%Orientation + a2*u2%TurbineComponents%Tower%Orientation + u_out%TurbineComponents%Tower%TranslationVel = a1*u1%TurbineComponents%Tower%TranslationVel + a2*u2%TurbineComponents%Tower%TranslationVel + u_out%TurbineComponents%Tower%RotationVel = a1*u1%TurbineComponents%Tower%RotationVel + a2*u2%TurbineComponents%Tower%RotationVel + u_out%TurbineComponents%SubStructure%Position = a1*u1%TurbineComponents%SubStructure%Position + a2*u2%TurbineComponents%SubStructure%Position + u_out%TurbineComponents%SubStructure%Orientation = a1*u1%TurbineComponents%SubStructure%Orientation + a2*u2%TurbineComponents%SubStructure%Orientation + u_out%TurbineComponents%SubStructure%TranslationVel = a1*u1%TurbineComponents%SubStructure%TranslationVel + a2*u2%TurbineComponents%SubStructure%TranslationVel + u_out%TurbineComponents%SubStructure%RotationVel = a1*u1%TurbineComponents%SubStructure%RotationVel + a2*u2%TurbineComponents%SubStructure%RotationVel + u_out%TurbineComponents%Foundation%Position = a1*u1%TurbineComponents%Foundation%Position + a2*u2%TurbineComponents%Foundation%Position + u_out%TurbineComponents%Foundation%Orientation = a1*u1%TurbineComponents%Foundation%Orientation + a2*u2%TurbineComponents%Foundation%Orientation + u_out%TurbineComponents%Foundation%TranslationVel = a1*u1%TurbineComponents%Foundation%TranslationVel + a2*u2%TurbineComponents%Foundation%TranslationVel + u_out%TurbineComponents%Foundation%RotationVel = a1*u1%TurbineComponents%Foundation%RotationVel + a2*u2%TurbineComponents%Foundation%RotationVel + u_out%TurbineComponents%BladeLength = a1*u1%TurbineComponents%BladeLength + a2*u2%TurbineComponents%BladeLength + IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN + u_out%MulTabLoc = a1*u1%MulTabLoc + a2*u2%MulTabLoc + END IF ! check if allocated + IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN + u_out%InflowVelocity = a1*u1%InflowVelocity + a2*u2%InflowVelocity + END IF ! check if allocated + u_out%AvgInfVel = a1*u1%AvgInfVel + a2*u2%AvgInfVel +END SUBROUTINE + +SUBROUTINE AD14_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. @@ -16615,325 +6654,164 @@ SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(AD14_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(AD14_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(AD14_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(AD14_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 + TYPE(AD14_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(AD14_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(AD14_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(AD14_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 = 'AD14_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i11 ! dim1 level 1 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i11 ! dim1 level 1 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN - DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) - CALL MeshExtrapInterp2(u1%InputMarkers(i1), u2%InputMarkers(i1), u3%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp2(u1%Twr_InputMarkers, u2%Twr_InputMarkers, u3%Twr_InputMarkers, tin, u_out%Twr_InputMarkers, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Position,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Position,1) - b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Position(i1) - u2%TurbineComponents%Blade(i11)%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Position(i1) + u3%TurbineComponents%Blade(i11)%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Position(i1) + t(3)*u2%TurbineComponents%Blade(i11)%Position(i1) - t(2)*u3%TurbineComponents%Blade(i11)%Position(i1) ) * scaleFactor - u_out%TurbineComponents%Blade(i11)%Position(i1) = u1%TurbineComponents%Blade(i11)%Position(i1) + b + c * t_out - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i2 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) - u2%TurbineComponents%Blade(i11)%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + u3%TurbineComponents%Blade(i11)%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Blade(i11)%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Blade(i11)%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%Blade(i11)%Orientation(i1,i2) = u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + b + c * t_out - END DO - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%TranslationVel(i1) - u2%TurbineComponents%Blade(i11)%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + u3%TurbineComponents%Blade(i11)%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + t(3)*u2%TurbineComponents%Blade(i11)%TranslationVel(i1) - t(2)*u3%TurbineComponents%Blade(i11)%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Blade(i11)%TranslationVel(i1) = u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + b + c * t_out - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%RotationVel(i1) - u2%TurbineComponents%Blade(i11)%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%RotationVel(i1) + u3%TurbineComponents%Blade(i11)%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%RotationVel(i1) + t(3)*u2%TurbineComponents%Blade(i11)%RotationVel(i1) - t(2)*u3%TurbineComponents%Blade(i11)%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Blade(i11)%RotationVel(i1) = u1%TurbineComponents%Blade(i11)%RotationVel(i1) + b + c * t_out - END DO - ENDDO -END IF ! check if allocated - DO i1 = LBOUND(u_out%TurbineComponents%Hub%Position,1),UBOUND(u_out%TurbineComponents%Hub%Position,1) - b = (t(3)**2*(u1%TurbineComponents%Hub%Position(i1) - u2%TurbineComponents%Hub%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%Position(i1) + u3%TurbineComponents%Hub%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Position(i1) + t(3)*u2%TurbineComponents%Hub%Position(i1) - t(2)*u3%TurbineComponents%Hub%Position(i1) ) * scaleFactor - u_out%TurbineComponents%Hub%Position(i1) = u1%TurbineComponents%Hub%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Hub%Orientation,2),UBOUND(u_out%TurbineComponents%Hub%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Hub%Orientation,1),UBOUND(u_out%TurbineComponents%Hub%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%Hub%Orientation(i1,i2) - u2%TurbineComponents%Hub%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Hub%Orientation(i1,i2) + u3%TurbineComponents%Hub%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Hub%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Hub%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%Hub%Orientation(i1,i2) = u1%TurbineComponents%Hub%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Hub%TranslationVel,1),UBOUND(u_out%TurbineComponents%Hub%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Hub%TranslationVel(i1) - u2%TurbineComponents%Hub%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%TranslationVel(i1) + u3%TurbineComponents%Hub%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%TranslationVel(i1) + t(3)*u2%TurbineComponents%Hub%TranslationVel(i1) - t(2)*u3%TurbineComponents%Hub%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Hub%TranslationVel(i1) = u1%TurbineComponents%Hub%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Hub%RotationVel,1),UBOUND(u_out%TurbineComponents%Hub%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Hub%RotationVel(i1) - u2%TurbineComponents%Hub%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%RotationVel(i1) + u3%TurbineComponents%Hub%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%RotationVel(i1) + t(3)*u2%TurbineComponents%Hub%RotationVel(i1) - t(2)*u3%TurbineComponents%Hub%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Hub%RotationVel(i1) = u1%TurbineComponents%Hub%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Position,1),UBOUND(u_out%TurbineComponents%RotorFurl%Position,1) - b = (t(3)**2*(u1%TurbineComponents%RotorFurl%Position(i1) - u2%TurbineComponents%RotorFurl%Position(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Position(i1) + u3%TurbineComponents%RotorFurl%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Position(i1) + t(3)*u2%TurbineComponents%RotorFurl%Position(i1) - t(2)*u3%TurbineComponents%RotorFurl%Position(i1) ) * scaleFactor - u_out%TurbineComponents%RotorFurl%Position(i1) = u1%TurbineComponents%RotorFurl%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%RotorFurl%Orientation(i1,i2) - u2%TurbineComponents%RotorFurl%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + u3%TurbineComponents%RotorFurl%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + t(3)*u2%TurbineComponents%RotorFurl%Orientation(i1,i2) - t(2)*u3%TurbineComponents%RotorFurl%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%RotorFurl%Orientation(i1,i2) = u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%RotorFurl%TranslationVel(i1) - u2%TurbineComponents%RotorFurl%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%TranslationVel(i1) + u3%TurbineComponents%RotorFurl%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%TranslationVel(i1) + t(3)*u2%TurbineComponents%RotorFurl%TranslationVel(i1) - t(2)*u3%TurbineComponents%RotorFurl%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%RotorFurl%TranslationVel(i1) = u1%TurbineComponents%RotorFurl%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%RotorFurl%RotationVel(i1) - u2%TurbineComponents%RotorFurl%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%RotationVel(i1) + u3%TurbineComponents%RotorFurl%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%RotationVel(i1) + t(3)*u2%TurbineComponents%RotorFurl%RotationVel(i1) - t(2)*u3%TurbineComponents%RotorFurl%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%RotorFurl%RotationVel(i1) = u1%TurbineComponents%RotorFurl%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Position,1),UBOUND(u_out%TurbineComponents%Nacelle%Position,1) - b = (t(3)**2*(u1%TurbineComponents%Nacelle%Position(i1) - u2%TurbineComponents%Nacelle%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%Position(i1) + u3%TurbineComponents%Nacelle%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Position(i1) + t(3)*u2%TurbineComponents%Nacelle%Position(i1) - t(2)*u3%TurbineComponents%Nacelle%Position(i1) ) * scaleFactor - u_out%TurbineComponents%Nacelle%Position(i1) = u1%TurbineComponents%Nacelle%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,2),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,1),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%Nacelle%Orientation(i1,i2) - u2%TurbineComponents%Nacelle%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Nacelle%Orientation(i1,i2) + u3%TurbineComponents%Nacelle%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Nacelle%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Nacelle%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%Nacelle%Orientation(i1,i2) = u1%TurbineComponents%Nacelle%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Nacelle%TranslationVel(i1) - u2%TurbineComponents%Nacelle%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%TranslationVel(i1) + u3%TurbineComponents%Nacelle%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%TranslationVel(i1) + t(3)*u2%TurbineComponents%Nacelle%TranslationVel(i1) - t(2)*u3%TurbineComponents%Nacelle%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Nacelle%TranslationVel(i1) = u1%TurbineComponents%Nacelle%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Nacelle%RotationVel(i1) - u2%TurbineComponents%Nacelle%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%RotationVel(i1) + u3%TurbineComponents%Nacelle%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%RotationVel(i1) + t(3)*u2%TurbineComponents%Nacelle%RotationVel(i1) - t(2)*u3%TurbineComponents%Nacelle%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Nacelle%RotationVel(i1) = u1%TurbineComponents%Nacelle%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Position,1),UBOUND(u_out%TurbineComponents%TailFin%Position,1) - b = (t(3)**2*(u1%TurbineComponents%TailFin%Position(i1) - u2%TurbineComponents%TailFin%Position(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%Position(i1) + u3%TurbineComponents%TailFin%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Position(i1) + t(3)*u2%TurbineComponents%TailFin%Position(i1) - t(2)*u3%TurbineComponents%TailFin%Position(i1) ) * scaleFactor - u_out%TurbineComponents%TailFin%Position(i1) = u1%TurbineComponents%TailFin%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,2),UBOUND(u_out%TurbineComponents%TailFin%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,1),UBOUND(u_out%TurbineComponents%TailFin%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%TailFin%Orientation(i1,i2) - u2%TurbineComponents%TailFin%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%TailFin%Orientation(i1,i2) + u3%TurbineComponents%TailFin%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Orientation(i1,i2) + t(3)*u2%TurbineComponents%TailFin%Orientation(i1,i2) - t(2)*u3%TurbineComponents%TailFin%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%TailFin%Orientation(i1,i2) = u1%TurbineComponents%TailFin%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1),UBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%TailFin%TranslationVel(i1) - u2%TurbineComponents%TailFin%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%TranslationVel(i1) + u3%TurbineComponents%TailFin%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%TranslationVel(i1) + t(3)*u2%TurbineComponents%TailFin%TranslationVel(i1) - t(2)*u3%TurbineComponents%TailFin%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%TailFin%TranslationVel(i1) = u1%TurbineComponents%TailFin%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%RotationVel,1),UBOUND(u_out%TurbineComponents%TailFin%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%TailFin%RotationVel(i1) - u2%TurbineComponents%TailFin%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%RotationVel(i1) + u3%TurbineComponents%TailFin%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%RotationVel(i1) + t(3)*u2%TurbineComponents%TailFin%RotationVel(i1) - t(2)*u3%TurbineComponents%TailFin%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%TailFin%RotationVel(i1) = u1%TurbineComponents%TailFin%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%Position,1),UBOUND(u_out%TurbineComponents%Tower%Position,1) - b = (t(3)**2*(u1%TurbineComponents%Tower%Position(i1) - u2%TurbineComponents%Tower%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%Position(i1) + u3%TurbineComponents%Tower%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Position(i1) + t(3)*u2%TurbineComponents%Tower%Position(i1) - t(2)*u3%TurbineComponents%Tower%Position(i1) ) * scaleFactor - u_out%TurbineComponents%Tower%Position(i1) = u1%TurbineComponents%Tower%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Tower%Orientation,2),UBOUND(u_out%TurbineComponents%Tower%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Tower%Orientation,1),UBOUND(u_out%TurbineComponents%Tower%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%Tower%Orientation(i1,i2) - u2%TurbineComponents%Tower%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Tower%Orientation(i1,i2) + u3%TurbineComponents%Tower%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Tower%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Tower%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%Tower%Orientation(i1,i2) = u1%TurbineComponents%Tower%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%TranslationVel,1),UBOUND(u_out%TurbineComponents%Tower%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Tower%TranslationVel(i1) - u2%TurbineComponents%Tower%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%TranslationVel(i1) + u3%TurbineComponents%Tower%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%TranslationVel(i1) + t(3)*u2%TurbineComponents%Tower%TranslationVel(i1) - t(2)*u3%TurbineComponents%Tower%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Tower%TranslationVel(i1) = u1%TurbineComponents%Tower%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%RotationVel,1),UBOUND(u_out%TurbineComponents%Tower%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Tower%RotationVel(i1) - u2%TurbineComponents%Tower%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%RotationVel(i1) + u3%TurbineComponents%Tower%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%RotationVel(i1) + t(3)*u2%TurbineComponents%Tower%RotationVel(i1) - t(2)*u3%TurbineComponents%Tower%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Tower%RotationVel(i1) = u1%TurbineComponents%Tower%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Position,1),UBOUND(u_out%TurbineComponents%SubStructure%Position,1) - b = (t(3)**2*(u1%TurbineComponents%SubStructure%Position(i1) - u2%TurbineComponents%SubStructure%Position(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%Position(i1) + u3%TurbineComponents%SubStructure%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Position(i1) + t(3)*u2%TurbineComponents%SubStructure%Position(i1) - t(2)*u3%TurbineComponents%SubStructure%Position(i1) ) * scaleFactor - u_out%TurbineComponents%SubStructure%Position(i1) = u1%TurbineComponents%SubStructure%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,2),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,1),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%SubStructure%Orientation(i1,i2) - u2%TurbineComponents%SubStructure%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%SubStructure%Orientation(i1,i2) + u3%TurbineComponents%SubStructure%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Orientation(i1,i2) + t(3)*u2%TurbineComponents%SubStructure%Orientation(i1,i2) - t(2)*u3%TurbineComponents%SubStructure%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%SubStructure%Orientation(i1,i2) = u1%TurbineComponents%SubStructure%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%SubStructure%TranslationVel(i1) - u2%TurbineComponents%SubStructure%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%TranslationVel(i1) + u3%TurbineComponents%SubStructure%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%TranslationVel(i1) + t(3)*u2%TurbineComponents%SubStructure%TranslationVel(i1) - t(2)*u3%TurbineComponents%SubStructure%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%SubStructure%TranslationVel(i1) = u1%TurbineComponents%SubStructure%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%SubStructure%RotationVel(i1) - u2%TurbineComponents%SubStructure%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%RotationVel(i1) + u3%TurbineComponents%SubStructure%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%RotationVel(i1) + t(3)*u2%TurbineComponents%SubStructure%RotationVel(i1) - t(2)*u3%TurbineComponents%SubStructure%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%SubStructure%RotationVel(i1) = u1%TurbineComponents%SubStructure%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Position,1),UBOUND(u_out%TurbineComponents%Foundation%Position,1) - b = (t(3)**2*(u1%TurbineComponents%Foundation%Position(i1) - u2%TurbineComponents%Foundation%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%Position(i1) + u3%TurbineComponents%Foundation%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Position(i1) + t(3)*u2%TurbineComponents%Foundation%Position(i1) - t(2)*u3%TurbineComponents%Foundation%Position(i1) ) * scaleFactor - u_out%TurbineComponents%Foundation%Position(i1) = u1%TurbineComponents%Foundation%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,2),UBOUND(u_out%TurbineComponents%Foundation%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,1),UBOUND(u_out%TurbineComponents%Foundation%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%Foundation%Orientation(i1,i2) - u2%TurbineComponents%Foundation%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Foundation%Orientation(i1,i2) + u3%TurbineComponents%Foundation%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Foundation%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Foundation%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%Foundation%Orientation(i1,i2) = u1%TurbineComponents%Foundation%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1),UBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Foundation%TranslationVel(i1) - u2%TurbineComponents%Foundation%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%TranslationVel(i1) + u3%TurbineComponents%Foundation%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%TranslationVel(i1) + t(3)*u2%TurbineComponents%Foundation%TranslationVel(i1) - t(2)*u3%TurbineComponents%Foundation%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Foundation%TranslationVel(i1) = u1%TurbineComponents%Foundation%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%RotationVel,1),UBOUND(u_out%TurbineComponents%Foundation%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Foundation%RotationVel(i1) - u2%TurbineComponents%Foundation%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%RotationVel(i1) + u3%TurbineComponents%Foundation%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%RotationVel(i1) + t(3)*u2%TurbineComponents%Foundation%RotationVel(i1) - t(2)*u3%TurbineComponents%Foundation%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Foundation%RotationVel(i1) = u1%TurbineComponents%Foundation%RotationVel(i1) + b + c * t_out - END DO - b = (t(3)**2*(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength) + t(2)**2*(-u1%TurbineComponents%BladeLength + u3%TurbineComponents%BladeLength))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%BladeLength + t(3)*u2%TurbineComponents%BladeLength - t(2)*u3%TurbineComponents%BladeLength ) * scaleFactor - u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b + c * t_out -IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN - DO i2 = LBOUND(u_out%MulTabLoc,2),UBOUND(u_out%MulTabLoc,2) - DO i1 = LBOUND(u_out%MulTabLoc,1),UBOUND(u_out%MulTabLoc,1) - b = (t(3)**2*(u1%MulTabLoc(i1,i2) - u2%MulTabLoc(i1,i2)) + t(2)**2*(-u1%MulTabLoc(i1,i2) + u3%MulTabLoc(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%MulTabLoc(i1,i2) + t(3)*u2%MulTabLoc(i1,i2) - t(2)*u3%MulTabLoc(i1,i2) ) * scaleFactor - u_out%MulTabLoc(i1,i2) = u1%MulTabLoc(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN - DO i2 = LBOUND(u_out%InflowVelocity,2),UBOUND(u_out%InflowVelocity,2) - DO i1 = LBOUND(u_out%InflowVelocity,1),UBOUND(u_out%InflowVelocity,1) - b = (t(3)**2*(u1%InflowVelocity(i1,i2) - u2%InflowVelocity(i1,i2)) + t(2)**2*(-u1%InflowVelocity(i1,i2) + u3%InflowVelocity(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%InflowVelocity(i1,i2) + t(3)*u2%InflowVelocity(i1,i2) - t(2)*u3%InflowVelocity(i1,i2) ) * scaleFactor - u_out%InflowVelocity(i1,i2) = u1%InflowVelocity(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - DO i1 = LBOUND(u_out%AvgInfVel,1),UBOUND(u_out%AvgInfVel,1) - b = (t(3)**2*(u1%AvgInfVel(i1) - u2%AvgInfVel(i1)) + t(2)**2*(-u1%AvgInfVel(i1) + u3%AvgInfVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%AvgInfVel(i1) + t(3)*u2%AvgInfVel(i1) - t(2)*u3%AvgInfVel(i1) ) * scaleFactor - u_out%AvgInfVel(i1) = u1%AvgInfVel(i1) + b + c * t_out - END DO - END SUBROUTINE AD14_Input_ExtrapInterp2 - - - SUBROUTINE AD14_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(AD14_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(AD14_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN + DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) + CALL MeshExtrapInterp2(u1%InputMarkers(i1), u2%InputMarkers(i1), u3%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp2(u1%Twr_InputMarkers, u2%Twr_InputMarkers, u3%Twr_InputMarkers, tin, u_out%Twr_InputMarkers, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%Position = a1*u1%TurbineComponents%Blade(i11)%Position + a2*u2%TurbineComponents%Blade(i11)%Position + a3*u3%TurbineComponents%Blade(i11)%Position + END DO + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%Orientation = a1*u1%TurbineComponents%Blade(i11)%Orientation + a2*u2%TurbineComponents%Blade(i11)%Orientation + a3*u3%TurbineComponents%Blade(i11)%Orientation + END DO + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%TranslationVel = a1*u1%TurbineComponents%Blade(i11)%TranslationVel + a2*u2%TurbineComponents%Blade(i11)%TranslationVel + a3*u3%TurbineComponents%Blade(i11)%TranslationVel + END DO + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%RotationVel = a1*u1%TurbineComponents%Blade(i11)%RotationVel + a2*u2%TurbineComponents%Blade(i11)%RotationVel + a3*u3%TurbineComponents%Blade(i11)%RotationVel + END DO + END IF ! check if allocated + u_out%TurbineComponents%Hub%Position = a1*u1%TurbineComponents%Hub%Position + a2*u2%TurbineComponents%Hub%Position + a3*u3%TurbineComponents%Hub%Position + u_out%TurbineComponents%Hub%Orientation = a1*u1%TurbineComponents%Hub%Orientation + a2*u2%TurbineComponents%Hub%Orientation + a3*u3%TurbineComponents%Hub%Orientation + u_out%TurbineComponents%Hub%TranslationVel = a1*u1%TurbineComponents%Hub%TranslationVel + a2*u2%TurbineComponents%Hub%TranslationVel + a3*u3%TurbineComponents%Hub%TranslationVel + u_out%TurbineComponents%Hub%RotationVel = a1*u1%TurbineComponents%Hub%RotationVel + a2*u2%TurbineComponents%Hub%RotationVel + a3*u3%TurbineComponents%Hub%RotationVel + u_out%TurbineComponents%RotorFurl%Position = a1*u1%TurbineComponents%RotorFurl%Position + a2*u2%TurbineComponents%RotorFurl%Position + a3*u3%TurbineComponents%RotorFurl%Position + u_out%TurbineComponents%RotorFurl%Orientation = a1*u1%TurbineComponents%RotorFurl%Orientation + a2*u2%TurbineComponents%RotorFurl%Orientation + a3*u3%TurbineComponents%RotorFurl%Orientation + u_out%TurbineComponents%RotorFurl%TranslationVel = a1*u1%TurbineComponents%RotorFurl%TranslationVel + a2*u2%TurbineComponents%RotorFurl%TranslationVel + a3*u3%TurbineComponents%RotorFurl%TranslationVel + u_out%TurbineComponents%RotorFurl%RotationVel = a1*u1%TurbineComponents%RotorFurl%RotationVel + a2*u2%TurbineComponents%RotorFurl%RotationVel + a3*u3%TurbineComponents%RotorFurl%RotationVel + u_out%TurbineComponents%Nacelle%Position = a1*u1%TurbineComponents%Nacelle%Position + a2*u2%TurbineComponents%Nacelle%Position + a3*u3%TurbineComponents%Nacelle%Position + u_out%TurbineComponents%Nacelle%Orientation = a1*u1%TurbineComponents%Nacelle%Orientation + a2*u2%TurbineComponents%Nacelle%Orientation + a3*u3%TurbineComponents%Nacelle%Orientation + u_out%TurbineComponents%Nacelle%TranslationVel = a1*u1%TurbineComponents%Nacelle%TranslationVel + a2*u2%TurbineComponents%Nacelle%TranslationVel + a3*u3%TurbineComponents%Nacelle%TranslationVel + u_out%TurbineComponents%Nacelle%RotationVel = a1*u1%TurbineComponents%Nacelle%RotationVel + a2*u2%TurbineComponents%Nacelle%RotationVel + a3*u3%TurbineComponents%Nacelle%RotationVel + u_out%TurbineComponents%TailFin%Position = a1*u1%TurbineComponents%TailFin%Position + a2*u2%TurbineComponents%TailFin%Position + a3*u3%TurbineComponents%TailFin%Position + u_out%TurbineComponents%TailFin%Orientation = a1*u1%TurbineComponents%TailFin%Orientation + a2*u2%TurbineComponents%TailFin%Orientation + a3*u3%TurbineComponents%TailFin%Orientation + u_out%TurbineComponents%TailFin%TranslationVel = a1*u1%TurbineComponents%TailFin%TranslationVel + a2*u2%TurbineComponents%TailFin%TranslationVel + a3*u3%TurbineComponents%TailFin%TranslationVel + u_out%TurbineComponents%TailFin%RotationVel = a1*u1%TurbineComponents%TailFin%RotationVel + a2*u2%TurbineComponents%TailFin%RotationVel + a3*u3%TurbineComponents%TailFin%RotationVel + u_out%TurbineComponents%Tower%Position = a1*u1%TurbineComponents%Tower%Position + a2*u2%TurbineComponents%Tower%Position + a3*u3%TurbineComponents%Tower%Position + u_out%TurbineComponents%Tower%Orientation = a1*u1%TurbineComponents%Tower%Orientation + a2*u2%TurbineComponents%Tower%Orientation + a3*u3%TurbineComponents%Tower%Orientation + u_out%TurbineComponents%Tower%TranslationVel = a1*u1%TurbineComponents%Tower%TranslationVel + a2*u2%TurbineComponents%Tower%TranslationVel + a3*u3%TurbineComponents%Tower%TranslationVel + u_out%TurbineComponents%Tower%RotationVel = a1*u1%TurbineComponents%Tower%RotationVel + a2*u2%TurbineComponents%Tower%RotationVel + a3*u3%TurbineComponents%Tower%RotationVel + u_out%TurbineComponents%SubStructure%Position = a1*u1%TurbineComponents%SubStructure%Position + a2*u2%TurbineComponents%SubStructure%Position + a3*u3%TurbineComponents%SubStructure%Position + u_out%TurbineComponents%SubStructure%Orientation = a1*u1%TurbineComponents%SubStructure%Orientation + a2*u2%TurbineComponents%SubStructure%Orientation + a3*u3%TurbineComponents%SubStructure%Orientation + u_out%TurbineComponents%SubStructure%TranslationVel = a1*u1%TurbineComponents%SubStructure%TranslationVel + a2*u2%TurbineComponents%SubStructure%TranslationVel + a3*u3%TurbineComponents%SubStructure%TranslationVel + u_out%TurbineComponents%SubStructure%RotationVel = a1*u1%TurbineComponents%SubStructure%RotationVel + a2*u2%TurbineComponents%SubStructure%RotationVel + a3*u3%TurbineComponents%SubStructure%RotationVel + u_out%TurbineComponents%Foundation%Position = a1*u1%TurbineComponents%Foundation%Position + a2*u2%TurbineComponents%Foundation%Position + a3*u3%TurbineComponents%Foundation%Position + u_out%TurbineComponents%Foundation%Orientation = a1*u1%TurbineComponents%Foundation%Orientation + a2*u2%TurbineComponents%Foundation%Orientation + a3*u3%TurbineComponents%Foundation%Orientation + u_out%TurbineComponents%Foundation%TranslationVel = a1*u1%TurbineComponents%Foundation%TranslationVel + a2*u2%TurbineComponents%Foundation%TranslationVel + a3*u3%TurbineComponents%Foundation%TranslationVel + u_out%TurbineComponents%Foundation%RotationVel = a1*u1%TurbineComponents%Foundation%RotationVel + a2*u2%TurbineComponents%Foundation%RotationVel + a3*u3%TurbineComponents%Foundation%RotationVel + u_out%TurbineComponents%BladeLength = a1*u1%TurbineComponents%BladeLength + a2*u2%TurbineComponents%BladeLength + a3*u3%TurbineComponents%BladeLength + IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN + u_out%MulTabLoc = a1*u1%MulTabLoc + a2*u2%MulTabLoc + a3*u3%MulTabLoc + END IF ! check if allocated + IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN + u_out%InflowVelocity = a1*u1%InflowVelocity + a2*u2%InflowVelocity + a3*u3%InflowVelocity + END IF ! check if allocated + u_out%AvgInfVel = a1*u1%AvgInfVel + a2*u2%AvgInfVel + a3*u3%AvgInfVel +END SUBROUTINE + +subroutine AD14_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(AD14_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(AD14_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 = 'AD14_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 AD14_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AD14_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 AD14_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 AD14_Output_ExtrapInterp - - - SUBROUTINE AD14_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'AD14_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call AD14_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AD14_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AD14_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE AD14_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. @@ -16945,49 +6823,50 @@ SUBROUTINE AD14_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(AD14_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(AD14_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(AD14_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 + TYPE(AD14_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(AD14_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(AD14_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 = 'AD14_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN - DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) - CALL MeshExtrapInterp1(y1%OutputLoads(i1), y2%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp1(y1%Twr_OutputLoads, y2%Twr_OutputLoads, tin, y_out%Twr_OutputLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE AD14_Output_ExtrapInterp1 - - - SUBROUTINE AD14_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN + DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) + CALL MeshExtrapInterp1(y1%OutputLoads(i1), y2%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%Twr_OutputLoads, y2%Twr_OutputLoads, tin, y_out%Twr_OutputLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE AD14_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. @@ -17001,55 +6880,55 @@ SUBROUTINE AD14_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(AD14_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(AD14_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(AD14_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(AD14_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 + TYPE(AD14_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(AD14_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(AD14_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(AD14_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 = 'AD14_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD14_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 + 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 + 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 + 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%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN - DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) - CALL MeshExtrapInterp2(y1%OutputLoads(i1), y2%OutputLoads(i1), y3%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp2(y1%Twr_OutputLoads, y2%Twr_OutputLoads, y3%Twr_OutputLoads, tin, y_out%Twr_OutputLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE AD14_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN + DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) + CALL MeshExtrapInterp2(y1%OutputLoads(i1), y2%OutputLoads(i1), y3%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%Twr_OutputLoads, y2%Twr_OutputLoads, y3%Twr_OutputLoads, tin, y_out%Twr_OutputLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE AeroDyn14_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index fc07b27626..1e9b95f7ed 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -54,30 +54,30 @@ MODULE DWM_Types ! ======================= ! ========= DWM_Wake_Deficit_Data ======= TYPE, PUBLIC :: DWM_Wake_Deficit_Data - INTEGER(IntKi) :: np_x !< point per axial distance [-] - REAL(ReKi) :: X_length !< normalized length in axial direction [-] + INTEGER(IntKi) :: np_x = 0_IntKi !< point per axial distance [-] + REAL(ReKi) :: X_length = 0.0_ReKi !< normalized length in axial direction [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Turb_Stress_DWM !< [-] - INTEGER(IntKi) :: n_x_vector !< [-] - INTEGER(IntKi) :: n_r_vector !< [-] - REAL(ReKi) :: ppR !< Point_per_R_resoulution [-] + INTEGER(IntKi) :: n_x_vector = 0_IntKi !< [-] + INTEGER(IntKi) :: n_r_vector = 0_IntKi !< [-] + REAL(ReKi) :: ppR = 0.0_ReKi !< Point_per_R_resoulution [-] END TYPE DWM_Wake_Deficit_Data ! ======================= ! ========= MeanderData ======= TYPE, PUBLIC :: MeanderData - INTEGER(IntKi) :: scale_factor !< [-] - INTEGER(IntKi) :: moving_time !< [-] + INTEGER(IntKi) :: scale_factor = 0_IntKi !< [-] + INTEGER(IntKi) :: moving_time = 0_IntKi !< [-] END TYPE MeanderData ! ======================= ! ========= read_turbine_position_data ======= TYPE, PUBLIC :: read_turbine_position_data - INTEGER(IntKi) :: SimulationOrder_index !< [-] + INTEGER(IntKi) :: SimulationOrder_index = 0_IntKi !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: Turbine_sort_order !< [-] - INTEGER(IntKi) :: WT_index !< wind turbine index in the wind farm [-] + INTEGER(IntKi) :: WT_index = 0_IntKi !< wind turbine index in the wind farm [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: TurbineInfluenceData !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: upwind_turbine_index !< the upwind turbines that affecting this turbine [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: downwind_turbine_index !< [-] - INTEGER(IntKi) :: upwindturbine_number !< the number of upwind turbines affecting the downwind turbine [-] - INTEGER(IntKi) :: downwindturbine_number !< [-] + INTEGER(IntKi) :: upwindturbine_number = 0_IntKi !< the number of upwind turbines affecting the downwind turbine [-] + INTEGER(IntKi) :: downwindturbine_number = 0_IntKi !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: turbine_windorigin_length !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: upwind_turbine_projected_distance !< the projected distance between two turbines [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: downwind_turbine_projected_distance !< [-] @@ -95,52 +95,52 @@ MODULE DWM_Types ! ========= WeiMethod ======= TYPE, PUBLIC :: WeiMethod REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: sweptarea !< [-] - REAL(ReKi) :: weighting_denominator !< [-] + REAL(ReKi) :: weighting_denominator = 0.0_ReKi !< [-] END TYPE WeiMethod ! ======================= ! ========= TIDownstream ======= TYPE, PUBLIC :: TIDownstream REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_downstream_matrix !< [-] - INTEGER(IntKi) :: i !< [-] - INTEGER(IntKi) :: j !< [-] - INTEGER(IntKi) :: k !< [-] - INTEGER(IntKi) :: cross_plane_position_ds !< the cross plane position which to be investigated in term of the flying time [-] - INTEGER(IntKi) :: cross_plane_position_TI !< the cross plane position which to be investigated in term of the n_x_vector [-] - INTEGER(IntKi) :: distance_index !< the index of the distance in the TI axisymmetric array [-] - INTEGER(IntKi) :: counter1 !< [-] - INTEGER(IntKi) :: counter2 !< [-] - INTEGER(IntKi) :: initial_timestep !< [-] - REAL(ReKi) :: y_axis_turbine !< [-] - REAL(ReKi) :: z_axis_turbine !< [-] - REAL(ReKi) :: distance !< the distance between one point to the meandered wake center [-] - REAL(ReKi) :: TI_downstream_node !< the TI at a specfic point in the inbestigated cross plane [-] - REAL(ReKi) :: TI_node_temp !< [-] - REAL(ReKi) :: TI_node !< [-] - REAL(ReKi) :: TI_accumulation !< [-] - REAL(ReKi) :: TI_apprant_accumulation !< [-] - REAL(ReKi) :: TI_average !< THE AVERAGE TI OF THE CROSS PLANE [-] - REAL(ReKi) :: TI_apprant !< The TI due to the meadering [-] - REAL(ReKi) :: HubHt !< [-] - REAL(ReKi) :: wake_center_y !< [-] - REAL(ReKi) :: wake_center_z !< [-] - REAL(ReKi) :: Rscale !< [-] - REAL(ReKi) :: y !< [-] - REAL(ReKi) :: z !< [-] - REAL(ReKi) :: zero_spacing !< [-] - REAL(ReKi) :: temp1 !< [-] - REAL(ReKi) :: temp2 !< [-] - REAL(ReKi) :: temp3 !< [-] + INTEGER(IntKi) :: i = 0_IntKi !< [-] + INTEGER(IntKi) :: j = 0_IntKi !< [-] + INTEGER(IntKi) :: k = 0_IntKi !< [-] + INTEGER(IntKi) :: cross_plane_position_ds = 0_IntKi !< the cross plane position which to be investigated in term of the flying time [-] + INTEGER(IntKi) :: cross_plane_position_TI = 0_IntKi !< the cross plane position which to be investigated in term of the n_x_vector [-] + INTEGER(IntKi) :: distance_index = 0_IntKi !< the index of the distance in the TI axisymmetric array [-] + INTEGER(IntKi) :: counter1 = 0_IntKi !< [-] + INTEGER(IntKi) :: counter2 = 0_IntKi !< [-] + INTEGER(IntKi) :: initial_timestep = 0_IntKi !< [-] + REAL(ReKi) :: y_axis_turbine = 0.0_ReKi !< [-] + REAL(ReKi) :: z_axis_turbine = 0.0_ReKi !< [-] + REAL(ReKi) :: distance = 0.0_ReKi !< the distance between one point to the meandered wake center [-] + REAL(ReKi) :: TI_downstream_node = 0.0_ReKi !< the TI at a specfic point in the inbestigated cross plane [-] + REAL(ReKi) :: TI_node_temp = 0.0_ReKi !< [-] + REAL(ReKi) :: TI_node = 0.0_ReKi !< [-] + REAL(ReKi) :: TI_accumulation = 0.0_ReKi !< [-] + REAL(ReKi) :: TI_apprant_accumulation = 0.0_ReKi !< [-] + REAL(ReKi) :: TI_average = 0.0_ReKi !< THE AVERAGE TI OF THE CROSS PLANE [-] + REAL(ReKi) :: TI_apprant = 0.0_ReKi !< The TI due to the meadering [-] + REAL(ReKi) :: HubHt = 0.0_ReKi !< [-] + REAL(ReKi) :: wake_center_y = 0.0_ReKi !< [-] + REAL(ReKi) :: wake_center_z = 0.0_ReKi !< [-] + REAL(ReKi) :: Rscale = 0.0_ReKi !< [-] + REAL(ReKi) :: y = 0.0_ReKi !< [-] + REAL(ReKi) :: z = 0.0_ReKi !< [-] + REAL(ReKi) :: zero_spacing = 0.0_ReKi !< [-] + REAL(ReKi) :: temp1 = 0.0_ReKi !< [-] + REAL(ReKi) :: temp2 = 0.0_ReKi !< [-] + REAL(ReKi) :: temp3 = 0.0_ReKi !< [-] END TYPE TIDownstream ! ======================= ! ========= TurbKaimal ======= TYPE, PUBLIC :: TurbKaimal - INTEGER(IntKi) :: fs !< sample frequency [-] - INTEGER(IntKi) :: temp_n !< [-] - INTEGER(IntKi) :: i !< [-] - REAL(ReKi) :: low_f !< lower bound of frequency range [-] - REAL(ReKi) :: high_f !< upper bound of frequency range [-] - REAL(ReKi) :: lk_facor !< turbulence length-scale [-] - REAL(ReKi) :: STD !< standard deviation of the turbulence [-] + INTEGER(IntKi) :: fs = 0_IntKi !< sample frequency [-] + INTEGER(IntKi) :: temp_n = 0_IntKi !< [-] + INTEGER(IntKi) :: i = 0_IntKi !< [-] + REAL(ReKi) :: low_f = 0.0_ReKi !< lower bound of frequency range [-] + REAL(ReKi) :: high_f = 0.0_ReKi !< upper bound of frequency range [-] + REAL(ReKi) :: lk_facor = 0.0_ReKi !< turbulence length-scale [-] + REAL(ReKi) :: STD = 0.0_ReKi !< standard deviation of the turbulence [-] END TYPE TurbKaimal ! ======================= ! ========= Shinozuka ======= @@ -150,29 +150,29 @@ MODULE DWM_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: phi !< random phase angle [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: p_k !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: a_k !< [-] - INTEGER(IntKi) :: num_points !< total number of points [-] - INTEGER(IntKi) :: ILo !< [-] - INTEGER(IntKi) :: i !< [-] - INTEGER(IntKi) :: j !< [-] - REAL(ReKi) :: dt !< time step [-] - REAL(ReKi) :: t_min !< [-] - REAL(ReKi) :: t_max !< [-] - REAL(ReKi) :: df !< frequency step [-] + INTEGER(IntKi) :: num_points = 0_IntKi !< total number of points [-] + INTEGER(IntKi) :: ILo = 0_IntKi !< [-] + INTEGER(IntKi) :: i = 0_IntKi !< [-] + INTEGER(IntKi) :: j = 0_IntKi !< [-] + REAL(ReKi) :: dt = 0.0_ReKi !< time step [-] + REAL(ReKi) :: t_min = 0.0_ReKi !< [-] + REAL(ReKi) :: t_max = 0.0_ReKi !< [-] + REAL(ReKi) :: df = 0.0_ReKi !< frequency step [-] END TYPE Shinozuka ! ======================= ! ========= smooth_out_wake_data ======= TYPE, PUBLIC :: smooth_out_wake_data - INTEGER(IntKi) :: length_velocity_array !< the length of velocity_array [-] + INTEGER(IntKi) :: length_velocity_array = 0_IntKi !< the length of velocity_array [-] END TYPE smooth_out_wake_data ! ======================= ! ========= SWSV ======= TYPE, PUBLIC :: SWSV - INTEGER(IntKi) :: p1 !< [-] - INTEGER(IntKi) :: p2 !< [-] - REAL(ReKi) :: distance !< the distance from the point to the meandered wake center [-] - REAL(ReKi) :: y0 !< wake center position on y axis [-] - REAL(ReKi) :: z0 !< wake center position on z axis [-] - REAL(ReKi) :: unit !< single unit length R/ppR [-] + INTEGER(IntKi) :: p1 = 0_IntKi !< [-] + INTEGER(IntKi) :: p2 = 0_IntKi !< [-] + REAL(ReKi) :: distance = 0.0_ReKi !< the distance from the point to the meandered wake center [-] + REAL(ReKi) :: y0 = 0.0_ReKi !< wake center position on y axis [-] + REAL(ReKi) :: z0 = 0.0_ReKi !< wake center position on z axis [-] + REAL(ReKi) :: unit = 0.0_ReKi !< single unit length R/ppR [-] END TYPE SWSV ! ======================= ! ========= read_upwind_result ======= @@ -197,9 +197,9 @@ MODULE DWM_Types ! ======================= ! ========= DWM_turbine_blade ======= TYPE, PUBLIC :: DWM_turbine_blade - INTEGER(IntKi) :: Aerodyn_turbine_num !< [-] - INTEGER(IntKi) :: Blade_index !< the index of Aerodyn Blade [-] - INTEGER(IntKi) :: Element_index !< the index of Aerodyn Element [-] + INTEGER(IntKi) :: Aerodyn_turbine_num = 0_IntKi !< [-] + INTEGER(IntKi) :: Blade_index = 0_IntKi !< the index of Aerodyn Blade [-] + INTEGER(IntKi) :: Element_index = 0_IntKi !< the index of Aerodyn Element [-] END TYPE DWM_turbine_blade ! ======================= ! ========= DWM_ParameterType ======= @@ -207,28 +207,28 @@ MODULE DWM_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: velocityU !< the wake velocity profile @ the downstream turbine plane [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: smoothed_wake !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WakePosition !< meandered wake center [-] - INTEGER(IntKi) :: WakePosition_1 !< size of the WakePosition [-] - INTEGER(IntKi) :: WakePosition_2 !< size of the WakePosition [-] - INTEGER(IntKi) :: smooth_flag !< Whether or not use the smoothed out upstream wake profile (1-yes, 0-no) [-] - INTEGER(IntKi) :: p_p_r !< [-] - INTEGER(IntKi) :: NumWT !< Number of wind turbines [-] - INTEGER(IntKi) :: Tinfluencer !< [-] - REAL(ReKi) :: RotorR !< Rotor radius [-] - REAL(ReKi) :: r_domain !< [-] - REAL(ReKi) :: x_domain !< [-] - REAL(ReKi) :: Uambient !< The ambient wind velocity [-] - REAL(ReKi) :: TI_amb !< Ambient turbulence intensity [%] - REAL(ReKi) :: TI_wake !< [-] - REAL(ReKi) :: hub_height !< [-] - REAL(ReKi) :: length_velocityU !< [-] - REAL(ReKi) :: WFLowerBd !< The lower bound height of the wind file [-] - REAL(ReKi) :: Wind_file_Mean_u !< The mean velocity of the first turbine [-] - REAL(ReKi) :: Winddir !< [-] - REAL(ReKi) :: air_density !< air density [-] - REAL(ReKi) :: RR !< [-] + INTEGER(IntKi) :: WakePosition_1 = 0_IntKi !< size of the WakePosition [-] + INTEGER(IntKi) :: WakePosition_2 = 0_IntKi !< size of the WakePosition [-] + INTEGER(IntKi) :: smooth_flag = 0_IntKi !< Whether or not use the smoothed out upstream wake profile (1-yes, 0-no) [-] + INTEGER(IntKi) :: p_p_r = 0_IntKi !< [-] + INTEGER(IntKi) :: NumWT = 0_IntKi !< Number of wind turbines [-] + INTEGER(IntKi) :: Tinfluencer = 0_IntKi !< [-] + REAL(ReKi) :: RotorR = 0.0_ReKi !< Rotor radius [-] + REAL(ReKi) :: r_domain = 0.0_ReKi !< [-] + REAL(ReKi) :: x_domain = 0.0_ReKi !< [-] + REAL(ReKi) :: Uambient = 0.0_ReKi !< The ambient wind velocity [-] + REAL(ReKi) :: TI_amb = 0.0_ReKi !< Ambient turbulence intensity [%] + REAL(ReKi) :: TI_wake = 0.0_ReKi !< [-] + REAL(ReKi) :: hub_height = 0.0_ReKi !< [-] + REAL(ReKi) :: length_velocityU = 0.0_ReKi !< [-] + REAL(ReKi) :: WFLowerBd = 0.0_ReKi !< The lower bound height of the wind file [-] + REAL(ReKi) :: Wind_file_Mean_u = 0.0_ReKi !< The mean velocity of the first turbine [-] + REAL(ReKi) :: Winddir = 0.0_ReKi !< [-] + REAL(ReKi) :: air_density = 0.0_ReKi !< air density [-] + REAL(ReKi) :: RR = 0.0_ReKi !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ElementRad !< the element node radius [-] - INTEGER(IntKi) :: Bnum !< the number of blade [-] - INTEGER(IntKi) :: ElementNum !< the number of element [-] + INTEGER(IntKi) :: Bnum = 0_IntKi !< the number of blade [-] + INTEGER(IntKi) :: ElementNum = 0_IntKi !< the number of element [-] TYPE(read_turbine_position_data) :: RTPD TYPE(InflowWind_ParameterType) :: IfW END TYPE DWM_ParameterType @@ -241,16 +241,16 @@ MODULE DWM_Types ! ========= DWM_MiscVarType ======= TYPE, PUBLIC :: DWM_MiscVarType TYPE(InflowWind_MiscVarType) :: IfW - REAL(ReKi) :: position_y !< the y position of the blade node [-] - REAL(ReKi) :: position_z !< the z position of the blade node [-] - REAL(ReKi) :: velocity_wake_mean !< [-] - REAL(ReKi) :: shifted_velocity_Aerodyn !< [-] - REAL(ReKi) :: U_velocity !< the u component velocity of blade [-] - REAL(ReKi) :: V_velocity !< the v component velocity of blade [-] + REAL(ReKi) :: position_y = 0.0_ReKi !< the y position of the blade node [-] + REAL(ReKi) :: position_z = 0.0_ReKi !< the z position of the blade node [-] + REAL(ReKi) :: velocity_wake_mean = 0.0_ReKi !< [-] + REAL(ReKi) :: shifted_velocity_Aerodyn = 0.0_ReKi !< [-] + REAL(ReKi) :: U_velocity = 0.0_ReKi !< the u component velocity of blade [-] + REAL(ReKi) :: V_velocity = 0.0_ReKi !< the v component velocity of blade [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Nforce !< the normal force [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: blade_dr !< blade dr [-] - REAL(ReKi) :: NacYaw !< [-] - REAL(ReKi) :: TI_original !< [-] + REAL(ReKi) :: NacYaw = 0.0_ReKi !< [-] + REAL(ReKi) :: TI_original = 0.0_ReKi !< [-] TYPE(turbine_average_velocity_data) :: TAVD TYPE(CVSD) :: CalVelScale_data TYPE(MeanderData) :: meandering_data @@ -261,8 +261,8 @@ MODULE DWM_Types TYPE(smooth_out_wake_data) :: SmoothOut TYPE(SWSV) :: smooth_wake_shifted_velocity_data TYPE(DWM_Wake_Deficit_Data) :: DWDD - REAL(ReKi) :: ct_tilde !< the tilde Ct [-] - REAL(ReKi) :: FAST_Time !< FAST simulation time [-] + REAL(ReKi) :: ct_tilde = 0.0_ReKi !< the tilde Ct [-] + REAL(ReKi) :: FAST_Time = 0.0_ReKi !< FAST simulation time [-] INTEGER(IntKi) :: SDtimestep = 0 !< [-] TYPE(DWM_turbine_blade) :: DWM_tb TYPE(wake_meandered_center) :: WMC @@ -281,9062 +281,3509 @@ MODULE DWM_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: r_initial !< scaled rotor radius [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_initial !< scaled velocity at the rotor [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Mean_FFWS_array !< Mean velocity of each section on the blade [-] - REAL(ReKi) :: Mean_FFWS !< Mean (total) wind speed at the hub height [m/s] - REAL(ReKi) :: TI !< the turbulence intensity of the turbine [-] - REAL(ReKi) :: TI_downstream !< the TI of a downstream turbine before normalization [-] + REAL(ReKi) :: Mean_FFWS = 0.0_ReKi !< Mean (total) wind speed at the hub height [m/s] + REAL(ReKi) :: TI = 0.0_ReKi !< the turbulence intensity of the turbine [-] + REAL(ReKi) :: TI_downstream = 0.0_ReKi !< the TI of a downstream turbine before normalization [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: wake_u !< wake velocity [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: wake_position !< wake center position [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: smoothed_velocity_array !< smoothed out upstream axisymetric wake profile [-] - REAL(ReKi) :: AtmUscale !< atmospheric velocity scale before introducing TI [-] - REAL(ReKi) :: du_dz_ABL !< atmosperic shear gradient [-] + REAL(ReKi) :: AtmUscale = 0.0_ReKi !< atmospheric velocity scale before introducing TI [-] + REAL(ReKi) :: du_dz_ABL = 0.0_ReKi !< atmosperic shear gradient [-] REAL(ReKi) :: total_SDgenpwr = 0.0 !< [-] - REAL(ReKi) :: mean_SDgenpwr !< [-] - REAL(ReKi) :: avg_ct !< average Ct over the rotor [-] + REAL(ReKi) :: mean_SDgenpwr = 0.0_ReKi !< [-] + REAL(ReKi) :: avg_ct = 0.0_ReKi !< average Ct over the rotor [-] TYPE(InflowWind_OutputType) :: IfW END TYPE DWM_OutputType ! ======================= ! ========= DWM_ContinuousStateType ======= TYPE, PUBLIC :: DWM_ContinuousStateType - REAL(ReKi) :: dummy !< [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< [-] TYPE(InflowWind_ContinuousStateType) :: IfW END TYPE DWM_ContinuousStateType ! ======================= ! ========= DWM_DiscreteStateType ======= TYPE, PUBLIC :: DWM_DiscreteStateType - REAL(ReKi) :: dummy !< [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< [-] TYPE(InflowWind_DiscreteStateType) :: IfW END TYPE DWM_DiscreteStateType ! ======================= ! ========= DWM_ConstraintStateType ======= TYPE, PUBLIC :: DWM_ConstraintStateType - REAL(ReKi) :: dummy !< [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< [-] TYPE(InflowWind_ConstraintStateType) :: IfW END TYPE DWM_ConstraintStateType ! ======================= ! ========= DWM_InitInputType ======= TYPE, PUBLIC :: DWM_InitInputType - REAL(ReKi) :: dummy !< [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< [-] TYPE(InflowWind_InitInputType) :: IfW END TYPE DWM_InitInputType ! ======================= ! ========= DWM_InitOutputType ======= TYPE, PUBLIC :: DWM_InitOutputType - REAL(ReKi) :: dummy !< [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< [-] TYPE(InflowWind_InitOutputType) :: IfW END TYPE DWM_InitOutputType ! ======================= CONTAINS - SUBROUTINE DWM_CopyCVSD( SrcCVSDData, DstCVSDData, CtrlCode, ErrStat, ErrMsg ) - TYPE(CVSD), INTENT(IN) :: SrcCVSDData - TYPE(CVSD), INTENT(INOUT) :: DstCVSDData - 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 = 'DWM_CopyCVSD' -! - ErrStat = ErrID_None - ErrMsg = "" - DstCVSDData%counter = SrcCVSDData%counter - DstCVSDData%Denominator = SrcCVSDData%Denominator - DstCVSDData%Numerator = SrcCVSDData%Numerator - END SUBROUTINE DWM_CopyCVSD - - SUBROUTINE DWM_DestroyCVSD( CVSDData, ErrStat, ErrMsg ) - TYPE(CVSD), INTENT(INOUT) :: CVSDData - 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 = 'DWM_DestroyCVSD' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DWM_DestroyCVSD - - SUBROUTINE DWM_PackCVSD( 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(CVSD), 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 = 'DWM_PackCVSD' - ! 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 ! counter - Re_BufSz = Re_BufSz + 1 ! Denominator - Re_BufSz = Re_BufSz + 1 ! Numerator - 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%counter - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Denominator - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Numerator - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackCVSD - SUBROUTINE DWM_UnPackCVSD( 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(CVSD), 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 = 'DWM_UnPackCVSD' - ! 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%counter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Denominator = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Numerator = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackCVSD - - SUBROUTINE DWM_Copyturbine_average_velocity_data( Srcturbine_average_velocity_dataData, Dstturbine_average_velocity_dataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(turbine_average_velocity_data), INTENT(IN) :: Srcturbine_average_velocity_dataData - TYPE(turbine_average_velocity_data), INTENT(INOUT) :: Dstturbine_average_velocity_dataData - 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 = 'DWM_Copyturbine_average_velocity_data' -! +subroutine DWM_CopyCVSD(SrcCVSDData, DstCVSDData, CtrlCode, ErrStat, ErrMsg) + type(CVSD), intent(in) :: SrcCVSDData + type(CVSD), intent(inout) :: DstCVSDData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_CopyCVSD' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(Srcturbine_average_velocity_dataData%average_velocity_array_temp)) THEN - i1_l = LBOUND(Srcturbine_average_velocity_dataData%average_velocity_array_temp,1) - i1_u = UBOUND(Srcturbine_average_velocity_dataData%average_velocity_array_temp,1) - IF (.NOT. ALLOCATED(Dstturbine_average_velocity_dataData%average_velocity_array_temp)) THEN - ALLOCATE(Dstturbine_average_velocity_dataData%average_velocity_array_temp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%average_velocity_array_temp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstturbine_average_velocity_dataData%average_velocity_array_temp = Srcturbine_average_velocity_dataData%average_velocity_array_temp -ENDIF -IF (ALLOCATED(Srcturbine_average_velocity_dataData%average_velocity_array)) THEN - i1_l = LBOUND(Srcturbine_average_velocity_dataData%average_velocity_array,1) - i1_u = UBOUND(Srcturbine_average_velocity_dataData%average_velocity_array,1) - IF (.NOT. ALLOCATED(Dstturbine_average_velocity_dataData%average_velocity_array)) THEN - ALLOCATE(Dstturbine_average_velocity_dataData%average_velocity_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%average_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstturbine_average_velocity_dataData%average_velocity_array = Srcturbine_average_velocity_dataData%average_velocity_array -ENDIF -IF (ALLOCATED(Srcturbine_average_velocity_dataData%swept_area)) THEN - i1_l = LBOUND(Srcturbine_average_velocity_dataData%swept_area,1) - i1_u = UBOUND(Srcturbine_average_velocity_dataData%swept_area,1) - IF (.NOT. ALLOCATED(Dstturbine_average_velocity_dataData%swept_area)) THEN - ALLOCATE(Dstturbine_average_velocity_dataData%swept_area(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%swept_area.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstturbine_average_velocity_dataData%swept_area = Srcturbine_average_velocity_dataData%swept_area -ENDIF - Dstturbine_average_velocity_dataData%time_step_velocity = Srcturbine_average_velocity_dataData%time_step_velocity -IF (ALLOCATED(Srcturbine_average_velocity_dataData%time_step_velocity_array)) THEN - i1_l = LBOUND(Srcturbine_average_velocity_dataData%time_step_velocity_array,1) - i1_u = UBOUND(Srcturbine_average_velocity_dataData%time_step_velocity_array,1) - IF (.NOT. ALLOCATED(Dstturbine_average_velocity_dataData%time_step_velocity_array)) THEN - ALLOCATE(Dstturbine_average_velocity_dataData%time_step_velocity_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%time_step_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstturbine_average_velocity_dataData%time_step_velocity_array = Srcturbine_average_velocity_dataData%time_step_velocity_array -ENDIF - Dstturbine_average_velocity_dataData%time_step_pass_velocity = Srcturbine_average_velocity_dataData%time_step_pass_velocity - 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 ) - TYPE(turbine_average_velocity_data), INTENT(INOUT) :: turbine_average_velocity_dataData - 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 = 'DWM_Destroyturbine_average_velocity_data' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(turbine_average_velocity_dataData%average_velocity_array_temp)) THEN - DEALLOCATE(turbine_average_velocity_dataData%average_velocity_array_temp) -ENDIF -IF (ALLOCATED(turbine_average_velocity_dataData%average_velocity_array)) THEN - DEALLOCATE(turbine_average_velocity_dataData%average_velocity_array) -ENDIF -IF (ALLOCATED(turbine_average_velocity_dataData%swept_area)) THEN - DEALLOCATE(turbine_average_velocity_dataData%swept_area) -ENDIF -IF (ALLOCATED(turbine_average_velocity_dataData%time_step_velocity_array)) THEN - DEALLOCATE(turbine_average_velocity_dataData%time_step_velocity_array) -ENDIF - END SUBROUTINE DWM_Destroyturbine_average_velocity_data - - SUBROUTINE DWM_Packturbine_average_velocity_data( 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(turbine_average_velocity_data), 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 = 'DWM_Packturbine_average_velocity_data' - ! 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 ! average_velocity_array_temp allocated yes/no - IF ( ALLOCATED(InData%average_velocity_array_temp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! average_velocity_array_temp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%average_velocity_array_temp) ! average_velocity_array_temp - END IF - Int_BufSz = Int_BufSz + 1 ! average_velocity_array allocated yes/no - IF ( ALLOCATED(InData%average_velocity_array) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! average_velocity_array upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%average_velocity_array) ! average_velocity_array - END IF - Int_BufSz = Int_BufSz + 1 ! swept_area allocated yes/no - IF ( ALLOCATED(InData%swept_area) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! swept_area upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%swept_area) ! swept_area - END IF - Int_BufSz = Int_BufSz + 1 ! time_step_velocity - Int_BufSz = Int_BufSz + 1 ! time_step_velocity_array allocated yes/no - IF ( ALLOCATED(InData%time_step_velocity_array) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! time_step_velocity_array upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%time_step_velocity_array) ! time_step_velocity_array - END IF - Int_BufSz = Int_BufSz + 1 ! time_step_pass_velocity - Int_BufSz = Int_BufSz + 1 ! time_step_force - 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%average_velocity_array_temp) ) 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%average_velocity_array_temp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%average_velocity_array_temp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%average_velocity_array_temp,1), UBOUND(InData%average_velocity_array_temp,1) - ReKiBuf(Re_Xferred) = InData%average_velocity_array_temp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%average_velocity_array) ) 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%average_velocity_array,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%average_velocity_array,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%average_velocity_array,1), UBOUND(InData%average_velocity_array,1) - ReKiBuf(Re_Xferred) = InData%average_velocity_array(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%swept_area) ) 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%swept_area,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%swept_area,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%swept_area,1), UBOUND(InData%swept_area,1) - ReKiBuf(Re_Xferred) = InData%swept_area(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%time_step_velocity - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%time_step_velocity_array) ) 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%time_step_velocity_array,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%time_step_velocity_array,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%time_step_velocity_array,1), UBOUND(InData%time_step_velocity_array,1) - IntKiBuf(Int_Xferred) = InData%time_step_velocity_array(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%time_step_pass_velocity - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%time_step_force - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_Packturbine_average_velocity_data - - SUBROUTINE DWM_UnPackturbine_average_velocity_data( 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(turbine_average_velocity_data), 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 = 'DWM_UnPackturbine_average_velocity_data' - ! 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 ! average_velocity_array_temp 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%average_velocity_array_temp)) DEALLOCATE(OutData%average_velocity_array_temp) - ALLOCATE(OutData%average_velocity_array_temp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array_temp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%average_velocity_array_temp,1), UBOUND(OutData%average_velocity_array_temp,1) - OutData%average_velocity_array_temp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! average_velocity_array 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%average_velocity_array)) DEALLOCATE(OutData%average_velocity_array) - ALLOCATE(OutData%average_velocity_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%average_velocity_array,1), UBOUND(OutData%average_velocity_array,1) - OutData%average_velocity_array(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! swept_area 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%swept_area)) DEALLOCATE(OutData%swept_area) - ALLOCATE(OutData%swept_area(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%swept_area.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%swept_area,1), UBOUND(OutData%swept_area,1) - OutData%swept_area(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%time_step_velocity = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! time_step_velocity_array 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%time_step_velocity_array)) DEALLOCATE(OutData%time_step_velocity_array) - ALLOCATE(OutData%time_step_velocity_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%time_step_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%time_step_velocity_array,1), UBOUND(OutData%time_step_velocity_array,1) - OutData%time_step_velocity_array(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%time_step_pass_velocity = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%time_step_force = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_UnPackturbine_average_velocity_data - - SUBROUTINE DWM_CopyWake_Deficit_Data( SrcWake_Deficit_DataData, DstWake_Deficit_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_Wake_Deficit_Data), INTENT(IN) :: SrcWake_Deficit_DataData - TYPE(DWM_Wake_Deficit_Data), INTENT(INOUT) :: DstWake_Deficit_DataData - 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 = 'DWM_CopyWake_Deficit_Data' -! + ErrMsg = '' + DstCVSDData%counter = SrcCVSDData%counter + DstCVSDData%Denominator = SrcCVSDData%Denominator + DstCVSDData%Numerator = SrcCVSDData%Numerator +end subroutine + +subroutine DWM_DestroyCVSD(CVSDData, ErrStat, ErrMsg) + type(CVSD), intent(inout) :: CVSDData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_DestroyCVSD' ErrStat = ErrID_None - ErrMsg = "" - DstWake_Deficit_DataData%np_x = SrcWake_Deficit_DataData%np_x - DstWake_Deficit_DataData%X_length = SrcWake_Deficit_DataData%X_length -IF (ALLOCATED(SrcWake_Deficit_DataData%Turb_Stress_DWM)) THEN - i1_l = LBOUND(SrcWake_Deficit_DataData%Turb_Stress_DWM,1) - i1_u = UBOUND(SrcWake_Deficit_DataData%Turb_Stress_DWM,1) - i2_l = LBOUND(SrcWake_Deficit_DataData%Turb_Stress_DWM,2) - i2_u = UBOUND(SrcWake_Deficit_DataData%Turb_Stress_DWM,2) - IF (.NOT. ALLOCATED(DstWake_Deficit_DataData%Turb_Stress_DWM)) THEN - ALLOCATE(DstWake_Deficit_DataData%Turb_Stress_DWM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWake_Deficit_DataData%Turb_Stress_DWM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWake_Deficit_DataData%Turb_Stress_DWM = SrcWake_Deficit_DataData%Turb_Stress_DWM -ENDIF - DstWake_Deficit_DataData%n_x_vector = SrcWake_Deficit_DataData%n_x_vector - DstWake_Deficit_DataData%n_r_vector = SrcWake_Deficit_DataData%n_r_vector - DstWake_Deficit_DataData%ppR = SrcWake_Deficit_DataData%ppR - END SUBROUTINE DWM_CopyWake_Deficit_Data - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyWake_Deficit_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Wake_Deficit_DataData%Turb_Stress_DWM)) THEN - DEALLOCATE(Wake_Deficit_DataData%Turb_Stress_DWM) -ENDIF - END SUBROUTINE DWM_DestroyWake_Deficit_Data - - SUBROUTINE DWM_PackWake_Deficit_Data( 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(DWM_Wake_Deficit_Data), 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 = 'DWM_PackWake_Deficit_Data' - ! 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 ! np_x - Re_BufSz = Re_BufSz + 1 ! X_length - Int_BufSz = Int_BufSz + 1 ! Turb_Stress_DWM allocated yes/no - IF ( ALLOCATED(InData%Turb_Stress_DWM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Turb_Stress_DWM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Turb_Stress_DWM) ! Turb_Stress_DWM - END IF - Int_BufSz = Int_BufSz + 1 ! n_x_vector - Int_BufSz = Int_BufSz + 1 ! n_r_vector - Re_BufSz = Re_BufSz + 1 ! ppR - 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%np_x - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X_length - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Turb_Stress_DWM) ) 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%Turb_Stress_DWM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turb_Stress_DWM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Turb_Stress_DWM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turb_Stress_DWM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Turb_Stress_DWM,2), UBOUND(InData%Turb_Stress_DWM,2) - DO i1 = LBOUND(InData%Turb_Stress_DWM,1), UBOUND(InData%Turb_Stress_DWM,1) - ReKiBuf(Re_Xferred) = InData%Turb_Stress_DWM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n_x_vector - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_r_vector - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ppR - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackWake_Deficit_Data - - SUBROUTINE DWM_UnPackWake_Deficit_Data( 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(DWM_Wake_Deficit_Data), 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 = 'DWM_UnPackWake_Deficit_Data' - ! 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%np_x = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X_length = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Turb_Stress_DWM 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%Turb_Stress_DWM)) DEALLOCATE(OutData%Turb_Stress_DWM) - ALLOCATE(OutData%Turb_Stress_DWM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turb_Stress_DWM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Turb_Stress_DWM,2), UBOUND(OutData%Turb_Stress_DWM,2) - DO i1 = LBOUND(OutData%Turb_Stress_DWM,1), UBOUND(OutData%Turb_Stress_DWM,1) - OutData%Turb_Stress_DWM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%n_x_vector = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_r_vector = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ppR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackWake_Deficit_Data - - SUBROUTINE DWM_CopyMeanderData( SrcMeanderDataData, DstMeanderDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MeanderData), INTENT(IN) :: SrcMeanderDataData - TYPE(MeanderData), INTENT(INOUT) :: DstMeanderDataData - 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 = 'DWM_CopyMeanderData' -! + ErrMsg = '' +end subroutine + +subroutine DWM_PackCVSD(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(CVSD), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackCVSD' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%counter) + call RegPack(Buf, InData%Denominator) + call RegPack(Buf, InData%Numerator) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackCVSD(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(CVSD), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackCVSD' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%counter) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Denominator) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Numerator) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_Copyturbine_average_velocity_data(Srcturbine_average_velocity_dataData, Dstturbine_average_velocity_dataData, CtrlCode, ErrStat, ErrMsg) + type(turbine_average_velocity_data), intent(in) :: Srcturbine_average_velocity_dataData + type(turbine_average_velocity_data), intent(inout) :: Dstturbine_average_velocity_dataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_Copyturbine_average_velocity_data' ErrStat = ErrID_None - ErrMsg = "" - DstMeanderDataData%scale_factor = SrcMeanderDataData%scale_factor - DstMeanderDataData%moving_time = SrcMeanderDataData%moving_time - END SUBROUTINE DWM_CopyMeanderData - - SUBROUTINE DWM_DestroyMeanderData( MeanderDataData, ErrStat, ErrMsg ) - TYPE(MeanderData), INTENT(INOUT) :: MeanderDataData - 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 = 'DWM_DestroyMeanderData' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DWM_DestroyMeanderData - - SUBROUTINE DWM_PackMeanderData( 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(MeanderData), 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 = 'DWM_PackMeanderData' - ! 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 ! scale_factor - Int_BufSz = Int_BufSz + 1 ! moving_time - 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%scale_factor - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%moving_time - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_PackMeanderData - - SUBROUTINE DWM_UnPackMeanderData( 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(MeanderData), 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 = 'DWM_UnPackMeanderData' - ! 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%scale_factor = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%moving_time = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_UnPackMeanderData - - SUBROUTINE DWM_Copyread_turbine_position_data( Srcread_turbine_position_dataData, Dstread_turbine_position_dataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(read_turbine_position_data), INTENT(IN) :: Srcread_turbine_position_dataData - TYPE(read_turbine_position_data), INTENT(INOUT) :: Dstread_turbine_position_dataData - 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 = 'DWM_Copyread_turbine_position_data' -! + ErrMsg = '' + if (allocated(Srcturbine_average_velocity_dataData%average_velocity_array_temp)) then + LB(1:1) = lbound(Srcturbine_average_velocity_dataData%average_velocity_array_temp) + UB(1:1) = ubound(Srcturbine_average_velocity_dataData%average_velocity_array_temp) + if (.not. allocated(Dstturbine_average_velocity_dataData%average_velocity_array_temp)) then + allocate(Dstturbine_average_velocity_dataData%average_velocity_array_temp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%average_velocity_array_temp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstturbine_average_velocity_dataData%average_velocity_array_temp = Srcturbine_average_velocity_dataData%average_velocity_array_temp + end if + if (allocated(Srcturbine_average_velocity_dataData%average_velocity_array)) then + LB(1:1) = lbound(Srcturbine_average_velocity_dataData%average_velocity_array) + UB(1:1) = ubound(Srcturbine_average_velocity_dataData%average_velocity_array) + if (.not. allocated(Dstturbine_average_velocity_dataData%average_velocity_array)) then + allocate(Dstturbine_average_velocity_dataData%average_velocity_array(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%average_velocity_array.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstturbine_average_velocity_dataData%average_velocity_array = Srcturbine_average_velocity_dataData%average_velocity_array + end if + if (allocated(Srcturbine_average_velocity_dataData%swept_area)) then + LB(1:1) = lbound(Srcturbine_average_velocity_dataData%swept_area) + UB(1:1) = ubound(Srcturbine_average_velocity_dataData%swept_area) + if (.not. allocated(Dstturbine_average_velocity_dataData%swept_area)) then + allocate(Dstturbine_average_velocity_dataData%swept_area(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%swept_area.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstturbine_average_velocity_dataData%swept_area = Srcturbine_average_velocity_dataData%swept_area + end if + Dstturbine_average_velocity_dataData%time_step_velocity = Srcturbine_average_velocity_dataData%time_step_velocity + if (allocated(Srcturbine_average_velocity_dataData%time_step_velocity_array)) then + LB(1:1) = lbound(Srcturbine_average_velocity_dataData%time_step_velocity_array) + UB(1:1) = ubound(Srcturbine_average_velocity_dataData%time_step_velocity_array) + if (.not. allocated(Dstturbine_average_velocity_dataData%time_step_velocity_array)) then + allocate(Dstturbine_average_velocity_dataData%time_step_velocity_array(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%time_step_velocity_array.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstturbine_average_velocity_dataData%time_step_velocity_array = Srcturbine_average_velocity_dataData%time_step_velocity_array + end if + Dstturbine_average_velocity_dataData%time_step_pass_velocity = Srcturbine_average_velocity_dataData%time_step_pass_velocity + Dstturbine_average_velocity_dataData%time_step_force = Srcturbine_average_velocity_dataData%time_step_force +end subroutine + +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 + character(*), parameter :: RoutineName = 'DWM_Destroyturbine_average_velocity_data' ErrStat = ErrID_None - ErrMsg = "" - Dstread_turbine_position_dataData%SimulationOrder_index = Srcread_turbine_position_dataData%SimulationOrder_index -IF (ALLOCATED(Srcread_turbine_position_dataData%Turbine_sort_order)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%Turbine_sort_order,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%Turbine_sort_order,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%Turbine_sort_order)) THEN - ALLOCATE(Dstread_turbine_position_dataData%Turbine_sort_order(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%Turbine_sort_order.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%Turbine_sort_order = Srcread_turbine_position_dataData%Turbine_sort_order -ENDIF - Dstread_turbine_position_dataData%WT_index = Srcread_turbine_position_dataData%WT_index -IF (ALLOCATED(Srcread_turbine_position_dataData%TurbineInfluenceData)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%TurbineInfluenceData,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%TurbineInfluenceData,1) - i2_l = LBOUND(Srcread_turbine_position_dataData%TurbineInfluenceData,2) - i2_u = UBOUND(Srcread_turbine_position_dataData%TurbineInfluenceData,2) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%TurbineInfluenceData)) THEN - ALLOCATE(Dstread_turbine_position_dataData%TurbineInfluenceData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%TurbineInfluenceData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%TurbineInfluenceData = Srcread_turbine_position_dataData%TurbineInfluenceData -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%upwind_turbine_index)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%upwind_turbine_index,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%upwind_turbine_index,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%upwind_turbine_index)) THEN - ALLOCATE(Dstread_turbine_position_dataData%upwind_turbine_index(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_index.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%upwind_turbine_index = Srcread_turbine_position_dataData%upwind_turbine_index -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%downwind_turbine_index)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%downwind_turbine_index,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%downwind_turbine_index,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%downwind_turbine_index)) THEN - ALLOCATE(Dstread_turbine_position_dataData%downwind_turbine_index(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_index.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%downwind_turbine_index = Srcread_turbine_position_dataData%downwind_turbine_index -ENDIF - Dstread_turbine_position_dataData%upwindturbine_number = Srcread_turbine_position_dataData%upwindturbine_number - Dstread_turbine_position_dataData%downwindturbine_number = Srcread_turbine_position_dataData%downwindturbine_number -IF (ALLOCATED(Srcread_turbine_position_dataData%turbine_windorigin_length)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%turbine_windorigin_length,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%turbine_windorigin_length,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%turbine_windorigin_length)) THEN - ALLOCATE(Dstread_turbine_position_dataData%turbine_windorigin_length(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%turbine_windorigin_length.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%turbine_windorigin_length = Srcread_turbine_position_dataData%turbine_windorigin_length -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%upwind_turbine_projected_distance)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%upwind_turbine_projected_distance,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%upwind_turbine_projected_distance,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%upwind_turbine_projected_distance)) THEN - ALLOCATE(Dstread_turbine_position_dataData%upwind_turbine_projected_distance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%upwind_turbine_projected_distance = Srcread_turbine_position_dataData%upwind_turbine_projected_distance -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%downwind_turbine_projected_distance)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%downwind_turbine_projected_distance,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%downwind_turbine_projected_distance,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%downwind_turbine_projected_distance)) THEN - ALLOCATE(Dstread_turbine_position_dataData%downwind_turbine_projected_distance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%downwind_turbine_projected_distance = Srcread_turbine_position_dataData%downwind_turbine_projected_distance -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%turbine_angle)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%turbine_angle,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%turbine_angle,1) - i2_l = LBOUND(Srcread_turbine_position_dataData%turbine_angle,2) - i2_u = UBOUND(Srcread_turbine_position_dataData%turbine_angle,2) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%turbine_angle)) THEN - ALLOCATE(Dstread_turbine_position_dataData%turbine_angle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%turbine_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%turbine_angle = Srcread_turbine_position_dataData%turbine_angle -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%upwind_align_angle)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%upwind_align_angle,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%upwind_align_angle,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%upwind_align_angle)) THEN - ALLOCATE(Dstread_turbine_position_dataData%upwind_align_angle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_align_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%upwind_align_angle = Srcread_turbine_position_dataData%upwind_align_angle -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%downwind_align_angle)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%downwind_align_angle,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%downwind_align_angle,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%downwind_align_angle)) THEN - ALLOCATE(Dstread_turbine_position_dataData%downwind_align_angle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_align_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%downwind_align_angle = Srcread_turbine_position_dataData%downwind_align_angle -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%upwind_turbine_Xcoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%upwind_turbine_Xcoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%upwind_turbine_Xcoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%upwind_turbine_Xcoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%upwind_turbine_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%upwind_turbine_Xcoor = Srcread_turbine_position_dataData%upwind_turbine_Xcoor -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%upwind_turbine_Ycoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%upwind_turbine_Ycoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%upwind_turbine_Ycoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%upwind_turbine_Ycoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%upwind_turbine_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%upwind_turbine_Ycoor = Srcread_turbine_position_dataData%upwind_turbine_Ycoor -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%wind_farm_Xcoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%wind_farm_Xcoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%wind_farm_Xcoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%wind_farm_Xcoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%wind_farm_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%wind_farm_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%wind_farm_Xcoor = Srcread_turbine_position_dataData%wind_farm_Xcoor -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%wind_farm_Ycoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%wind_farm_Ycoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%wind_farm_Ycoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%wind_farm_Ycoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%wind_farm_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%wind_farm_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%wind_farm_Ycoor = Srcread_turbine_position_dataData%wind_farm_Ycoor -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%downwind_turbine_Xcoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%downwind_turbine_Xcoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%downwind_turbine_Xcoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%downwind_turbine_Xcoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%downwind_turbine_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%downwind_turbine_Xcoor = Srcread_turbine_position_dataData%downwind_turbine_Xcoor -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%downwind_turbine_Ycoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%downwind_turbine_Ycoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%downwind_turbine_Ycoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%downwind_turbine_Ycoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%downwind_turbine_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%downwind_turbine_Ycoor = Srcread_turbine_position_dataData%downwind_turbine_Ycoor -ENDIF - END SUBROUTINE DWM_Copyread_turbine_position_data - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyread_turbine_position_data' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(read_turbine_position_dataData%Turbine_sort_order)) THEN - DEALLOCATE(read_turbine_position_dataData%Turbine_sort_order) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%TurbineInfluenceData)) THEN - DEALLOCATE(read_turbine_position_dataData%TurbineInfluenceData) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%upwind_turbine_index)) THEN - DEALLOCATE(read_turbine_position_dataData%upwind_turbine_index) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%downwind_turbine_index)) THEN - DEALLOCATE(read_turbine_position_dataData%downwind_turbine_index) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%turbine_windorigin_length)) THEN - DEALLOCATE(read_turbine_position_dataData%turbine_windorigin_length) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%upwind_turbine_projected_distance)) THEN - DEALLOCATE(read_turbine_position_dataData%upwind_turbine_projected_distance) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%downwind_turbine_projected_distance)) THEN - DEALLOCATE(read_turbine_position_dataData%downwind_turbine_projected_distance) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%turbine_angle)) THEN - DEALLOCATE(read_turbine_position_dataData%turbine_angle) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%upwind_align_angle)) THEN - DEALLOCATE(read_turbine_position_dataData%upwind_align_angle) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%downwind_align_angle)) THEN - DEALLOCATE(read_turbine_position_dataData%downwind_align_angle) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%upwind_turbine_Xcoor)) THEN - DEALLOCATE(read_turbine_position_dataData%upwind_turbine_Xcoor) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%upwind_turbine_Ycoor)) THEN - DEALLOCATE(read_turbine_position_dataData%upwind_turbine_Ycoor) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%wind_farm_Xcoor)) THEN - DEALLOCATE(read_turbine_position_dataData%wind_farm_Xcoor) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%wind_farm_Ycoor)) THEN - DEALLOCATE(read_turbine_position_dataData%wind_farm_Ycoor) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%downwind_turbine_Xcoor)) THEN - DEALLOCATE(read_turbine_position_dataData%downwind_turbine_Xcoor) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%downwind_turbine_Ycoor)) THEN - DEALLOCATE(read_turbine_position_dataData%downwind_turbine_Ycoor) -ENDIF - END SUBROUTINE DWM_Destroyread_turbine_position_data - - SUBROUTINE DWM_Packread_turbine_position_data( 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(read_turbine_position_data), 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 = 'DWM_Packread_turbine_position_data' - ! 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 ! SimulationOrder_index - Int_BufSz = Int_BufSz + 1 ! Turbine_sort_order allocated yes/no - IF ( ALLOCATED(InData%Turbine_sort_order) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Turbine_sort_order upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Turbine_sort_order) ! Turbine_sort_order - END IF - Int_BufSz = Int_BufSz + 1 ! WT_index - Int_BufSz = Int_BufSz + 1 ! TurbineInfluenceData allocated yes/no - IF ( ALLOCATED(InData%TurbineInfluenceData) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TurbineInfluenceData upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%TurbineInfluenceData) ! TurbineInfluenceData - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_turbine_index allocated yes/no - IF ( ALLOCATED(InData%upwind_turbine_index) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_turbine_index upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%upwind_turbine_index) ! upwind_turbine_index - END IF - Int_BufSz = Int_BufSz + 1 ! downwind_turbine_index allocated yes/no - IF ( ALLOCATED(InData%downwind_turbine_index) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! downwind_turbine_index upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%downwind_turbine_index) ! downwind_turbine_index - END IF - Int_BufSz = Int_BufSz + 1 ! upwindturbine_number - Int_BufSz = Int_BufSz + 1 ! downwindturbine_number - Int_BufSz = Int_BufSz + 1 ! turbine_windorigin_length allocated yes/no - IF ( ALLOCATED(InData%turbine_windorigin_length) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! turbine_windorigin_length upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%turbine_windorigin_length) ! turbine_windorigin_length - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_turbine_projected_distance allocated yes/no - IF ( ALLOCATED(InData%upwind_turbine_projected_distance) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_turbine_projected_distance upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_turbine_projected_distance) ! upwind_turbine_projected_distance - END IF - Int_BufSz = Int_BufSz + 1 ! downwind_turbine_projected_distance allocated yes/no - IF ( ALLOCATED(InData%downwind_turbine_projected_distance) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! downwind_turbine_projected_distance upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%downwind_turbine_projected_distance) ! downwind_turbine_projected_distance - END IF - Int_BufSz = Int_BufSz + 1 ! turbine_angle allocated yes/no - IF ( ALLOCATED(InData%turbine_angle) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! turbine_angle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%turbine_angle) ! turbine_angle - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_align_angle allocated yes/no - IF ( ALLOCATED(InData%upwind_align_angle) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_align_angle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_align_angle) ! upwind_align_angle - END IF - Int_BufSz = Int_BufSz + 1 ! downwind_align_angle allocated yes/no - IF ( ALLOCATED(InData%downwind_align_angle) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! downwind_align_angle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%downwind_align_angle) ! downwind_align_angle - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_turbine_Xcoor allocated yes/no - IF ( ALLOCATED(InData%upwind_turbine_Xcoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_turbine_Xcoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_turbine_Xcoor) ! upwind_turbine_Xcoor - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_turbine_Ycoor allocated yes/no - IF ( ALLOCATED(InData%upwind_turbine_Ycoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_turbine_Ycoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_turbine_Ycoor) ! upwind_turbine_Ycoor - END IF - Int_BufSz = Int_BufSz + 1 ! wind_farm_Xcoor allocated yes/no - IF ( ALLOCATED(InData%wind_farm_Xcoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! wind_farm_Xcoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%wind_farm_Xcoor) ! wind_farm_Xcoor - END IF - Int_BufSz = Int_BufSz + 1 ! wind_farm_Ycoor allocated yes/no - IF ( ALLOCATED(InData%wind_farm_Ycoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! wind_farm_Ycoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%wind_farm_Ycoor) ! wind_farm_Ycoor - END IF - Int_BufSz = Int_BufSz + 1 ! downwind_turbine_Xcoor allocated yes/no - IF ( ALLOCATED(InData%downwind_turbine_Xcoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! downwind_turbine_Xcoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%downwind_turbine_Xcoor) ! downwind_turbine_Xcoor - END IF - Int_BufSz = Int_BufSz + 1 ! downwind_turbine_Ycoor allocated yes/no - IF ( ALLOCATED(InData%downwind_turbine_Ycoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! downwind_turbine_Ycoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%downwind_turbine_Ycoor) ! downwind_turbine_Ycoor - 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 - - IntKiBuf(Int_Xferred) = InData%SimulationOrder_index - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Turbine_sort_order) ) 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%Turbine_sort_order,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turbine_sort_order,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Turbine_sort_order,1), UBOUND(InData%Turbine_sort_order,1) - IntKiBuf(Int_Xferred) = InData%Turbine_sort_order(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%WT_index - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TurbineInfluenceData) ) 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%TurbineInfluenceData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineInfluenceData,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineInfluenceData,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineInfluenceData,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TurbineInfluenceData,2), UBOUND(InData%TurbineInfluenceData,2) - DO i1 = LBOUND(InData%TurbineInfluenceData,1), UBOUND(InData%TurbineInfluenceData,1) - IntKiBuf(Int_Xferred) = InData%TurbineInfluenceData(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_turbine_index) ) 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%upwind_turbine_index,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_index,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_turbine_index,1), UBOUND(InData%upwind_turbine_index,1) - IntKiBuf(Int_Xferred) = InData%upwind_turbine_index(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%downwind_turbine_index) ) 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%downwind_turbine_index,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_index,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%downwind_turbine_index,1), UBOUND(InData%downwind_turbine_index,1) - IntKiBuf(Int_Xferred) = InData%downwind_turbine_index(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%upwindturbine_number - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%downwindturbine_number - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%turbine_windorigin_length) ) 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%turbine_windorigin_length,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_windorigin_length,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%turbine_windorigin_length,1), UBOUND(InData%turbine_windorigin_length,1) - ReKiBuf(Re_Xferred) = InData%turbine_windorigin_length(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_turbine_projected_distance) ) 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%upwind_turbine_projected_distance,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_projected_distance,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_turbine_projected_distance,1), UBOUND(InData%upwind_turbine_projected_distance,1) - ReKiBuf(Re_Xferred) = InData%upwind_turbine_projected_distance(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%downwind_turbine_projected_distance) ) 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%downwind_turbine_projected_distance,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_projected_distance,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%downwind_turbine_projected_distance,1), UBOUND(InData%downwind_turbine_projected_distance,1) - ReKiBuf(Re_Xferred) = InData%downwind_turbine_projected_distance(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%turbine_angle) ) 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%turbine_angle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_angle,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%turbine_angle,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_angle,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%turbine_angle,2), UBOUND(InData%turbine_angle,2) - DO i1 = LBOUND(InData%turbine_angle,1), UBOUND(InData%turbine_angle,1) - ReKiBuf(Re_Xferred) = InData%turbine_angle(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_align_angle) ) 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%upwind_align_angle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_align_angle,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_align_angle,1), UBOUND(InData%upwind_align_angle,1) - ReKiBuf(Re_Xferred) = InData%upwind_align_angle(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%downwind_align_angle) ) 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%downwind_align_angle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_align_angle,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%downwind_align_angle,1), UBOUND(InData%downwind_align_angle,1) - ReKiBuf(Re_Xferred) = InData%downwind_align_angle(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_turbine_Xcoor) ) 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%upwind_turbine_Xcoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_Xcoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_turbine_Xcoor,1), UBOUND(InData%upwind_turbine_Xcoor,1) - ReKiBuf(Re_Xferred) = InData%upwind_turbine_Xcoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_turbine_Ycoor) ) 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%upwind_turbine_Ycoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_Ycoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_turbine_Ycoor,1), UBOUND(InData%upwind_turbine_Ycoor,1) - ReKiBuf(Re_Xferred) = InData%upwind_turbine_Ycoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%wind_farm_Xcoor) ) 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%wind_farm_Xcoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wind_farm_Xcoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%wind_farm_Xcoor,1), UBOUND(InData%wind_farm_Xcoor,1) - ReKiBuf(Re_Xferred) = InData%wind_farm_Xcoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%wind_farm_Ycoor) ) 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%wind_farm_Ycoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wind_farm_Ycoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%wind_farm_Ycoor,1), UBOUND(InData%wind_farm_Ycoor,1) - ReKiBuf(Re_Xferred) = InData%wind_farm_Ycoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%downwind_turbine_Xcoor) ) 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%downwind_turbine_Xcoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_Xcoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%downwind_turbine_Xcoor,1), UBOUND(InData%downwind_turbine_Xcoor,1) - ReKiBuf(Re_Xferred) = InData%downwind_turbine_Xcoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%downwind_turbine_Ycoor) ) 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%downwind_turbine_Ycoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_Ycoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%downwind_turbine_Ycoor,1), UBOUND(InData%downwind_turbine_Ycoor,1) - ReKiBuf(Re_Xferred) = InData%downwind_turbine_Ycoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE DWM_Packread_turbine_position_data - - SUBROUTINE DWM_UnPackread_turbine_position_data( 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(read_turbine_position_data), 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 = 'DWM_UnPackread_turbine_position_data' - ! 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%SimulationOrder_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Turbine_sort_order 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%Turbine_sort_order)) DEALLOCATE(OutData%Turbine_sort_order) - ALLOCATE(OutData%Turbine_sort_order(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turbine_sort_order.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Turbine_sort_order,1), UBOUND(OutData%Turbine_sort_order,1) - OutData%Turbine_sort_order(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%WT_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TurbineInfluenceData 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%TurbineInfluenceData)) DEALLOCATE(OutData%TurbineInfluenceData) - ALLOCATE(OutData%TurbineInfluenceData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineInfluenceData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TurbineInfluenceData,2), UBOUND(OutData%TurbineInfluenceData,2) - DO i1 = LBOUND(OutData%TurbineInfluenceData,1), UBOUND(OutData%TurbineInfluenceData,1) - OutData%TurbineInfluenceData(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_index 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%upwind_turbine_index)) DEALLOCATE(OutData%upwind_turbine_index) - ALLOCATE(OutData%upwind_turbine_index(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_index.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_turbine_index,1), UBOUND(OutData%upwind_turbine_index,1) - OutData%upwind_turbine_index(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_index 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%downwind_turbine_index)) DEALLOCATE(OutData%downwind_turbine_index) - ALLOCATE(OutData%downwind_turbine_index(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_index.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%downwind_turbine_index,1), UBOUND(OutData%downwind_turbine_index,1) - OutData%downwind_turbine_index(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%upwindturbine_number = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%downwindturbine_number = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! turbine_windorigin_length 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%turbine_windorigin_length)) DEALLOCATE(OutData%turbine_windorigin_length) - ALLOCATE(OutData%turbine_windorigin_length(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_windorigin_length.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%turbine_windorigin_length,1), UBOUND(OutData%turbine_windorigin_length,1) - OutData%turbine_windorigin_length(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_projected_distance 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%upwind_turbine_projected_distance)) DEALLOCATE(OutData%upwind_turbine_projected_distance) - ALLOCATE(OutData%upwind_turbine_projected_distance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_turbine_projected_distance,1), UBOUND(OutData%upwind_turbine_projected_distance,1) - OutData%upwind_turbine_projected_distance(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_projected_distance 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%downwind_turbine_projected_distance)) DEALLOCATE(OutData%downwind_turbine_projected_distance) - ALLOCATE(OutData%downwind_turbine_projected_distance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%downwind_turbine_projected_distance,1), UBOUND(OutData%downwind_turbine_projected_distance,1) - OutData%downwind_turbine_projected_distance(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! turbine_angle 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%turbine_angle)) DEALLOCATE(OutData%turbine_angle) - ALLOCATE(OutData%turbine_angle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%turbine_angle,2), UBOUND(OutData%turbine_angle,2) - DO i1 = LBOUND(OutData%turbine_angle,1), UBOUND(OutData%turbine_angle,1) - OutData%turbine_angle(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_align_angle 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%upwind_align_angle)) DEALLOCATE(OutData%upwind_align_angle) - ALLOCATE(OutData%upwind_align_angle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_align_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_align_angle,1), UBOUND(OutData%upwind_align_angle,1) - OutData%upwind_align_angle(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_align_angle 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%downwind_align_angle)) DEALLOCATE(OutData%downwind_align_angle) - ALLOCATE(OutData%downwind_align_angle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_align_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%downwind_align_angle,1), UBOUND(OutData%downwind_align_angle,1) - OutData%downwind_align_angle(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_Xcoor 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%upwind_turbine_Xcoor)) DEALLOCATE(OutData%upwind_turbine_Xcoor) - ALLOCATE(OutData%upwind_turbine_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_turbine_Xcoor,1), UBOUND(OutData%upwind_turbine_Xcoor,1) - OutData%upwind_turbine_Xcoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_Ycoor 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%upwind_turbine_Ycoor)) DEALLOCATE(OutData%upwind_turbine_Ycoor) - ALLOCATE(OutData%upwind_turbine_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_turbine_Ycoor,1), UBOUND(OutData%upwind_turbine_Ycoor,1) - OutData%upwind_turbine_Ycoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wind_farm_Xcoor 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%wind_farm_Xcoor)) DEALLOCATE(OutData%wind_farm_Xcoor) - ALLOCATE(OutData%wind_farm_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%wind_farm_Xcoor,1), UBOUND(OutData%wind_farm_Xcoor,1) - OutData%wind_farm_Xcoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wind_farm_Ycoor 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%wind_farm_Ycoor)) DEALLOCATE(OutData%wind_farm_Ycoor) - ALLOCATE(OutData%wind_farm_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%wind_farm_Ycoor,1), UBOUND(OutData%wind_farm_Ycoor,1) - OutData%wind_farm_Ycoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_Xcoor 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%downwind_turbine_Xcoor)) DEALLOCATE(OutData%downwind_turbine_Xcoor) - ALLOCATE(OutData%downwind_turbine_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%downwind_turbine_Xcoor,1), UBOUND(OutData%downwind_turbine_Xcoor,1) - OutData%downwind_turbine_Xcoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_Ycoor 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%downwind_turbine_Ycoor)) DEALLOCATE(OutData%downwind_turbine_Ycoor) - ALLOCATE(OutData%downwind_turbine_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%downwind_turbine_Ycoor,1), UBOUND(OutData%downwind_turbine_Ycoor,1) - OutData%downwind_turbine_Ycoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE DWM_UnPackread_turbine_position_data - - SUBROUTINE DWM_CopyWeiMethod( SrcWeiMethodData, DstWeiMethodData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WeiMethod), INTENT(IN) :: SrcWeiMethodData - TYPE(WeiMethod), INTENT(INOUT) :: DstWeiMethodData - 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 = 'DWM_CopyWeiMethod' -! + ErrMsg = '' + if (allocated(turbine_average_velocity_dataData%average_velocity_array_temp)) then + deallocate(turbine_average_velocity_dataData%average_velocity_array_temp) + end if + if (allocated(turbine_average_velocity_dataData%average_velocity_array)) then + deallocate(turbine_average_velocity_dataData%average_velocity_array) + end if + if (allocated(turbine_average_velocity_dataData%swept_area)) then + deallocate(turbine_average_velocity_dataData%swept_area) + end if + if (allocated(turbine_average_velocity_dataData%time_step_velocity_array)) then + deallocate(turbine_average_velocity_dataData%time_step_velocity_array) + end if +end subroutine + +subroutine DWM_Packturbine_average_velocity_data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(turbine_average_velocity_data), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_Packturbine_average_velocity_data' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%average_velocity_array_temp)) + if (allocated(InData%average_velocity_array_temp)) then + call RegPackBounds(Buf, 1, lbound(InData%average_velocity_array_temp), ubound(InData%average_velocity_array_temp)) + call RegPack(Buf, InData%average_velocity_array_temp) + end if + call RegPack(Buf, allocated(InData%average_velocity_array)) + if (allocated(InData%average_velocity_array)) then + call RegPackBounds(Buf, 1, lbound(InData%average_velocity_array), ubound(InData%average_velocity_array)) + call RegPack(Buf, InData%average_velocity_array) + end if + call RegPack(Buf, allocated(InData%swept_area)) + if (allocated(InData%swept_area)) then + call RegPackBounds(Buf, 1, lbound(InData%swept_area), ubound(InData%swept_area)) + call RegPack(Buf, InData%swept_area) + end if + call RegPack(Buf, InData%time_step_velocity) + call RegPack(Buf, allocated(InData%time_step_velocity_array)) + if (allocated(InData%time_step_velocity_array)) then + call RegPackBounds(Buf, 1, lbound(InData%time_step_velocity_array), ubound(InData%time_step_velocity_array)) + call RegPack(Buf, InData%time_step_velocity_array) + end if + call RegPack(Buf, InData%time_step_pass_velocity) + call RegPack(Buf, InData%time_step_force) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackturbine_average_velocity_data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(turbine_average_velocity_data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackturbine_average_velocity_data' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%average_velocity_array_temp)) deallocate(OutData%average_velocity_array_temp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%average_velocity_array_temp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array_temp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%average_velocity_array_temp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%average_velocity_array)) deallocate(OutData%average_velocity_array) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%average_velocity_array(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%average_velocity_array) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%swept_area)) deallocate(OutData%swept_area) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%swept_area(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%swept_area.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%swept_area) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%time_step_velocity) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%time_step_velocity_array)) deallocate(OutData%time_step_velocity_array) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%time_step_velocity_array(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%time_step_velocity_array.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%time_step_velocity_array) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%time_step_pass_velocity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%time_step_force) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_CopyWake_Deficit_Data(SrcWake_Deficit_DataData, DstWake_Deficit_DataData, CtrlCode, ErrStat, ErrMsg) + type(DWM_Wake_Deficit_Data), intent(in) :: SrcWake_Deficit_DataData + type(DWM_Wake_Deficit_Data), intent(inout) :: DstWake_Deficit_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_CopyWake_Deficit_Data' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWeiMethodData%sweptarea)) THEN - i1_l = LBOUND(SrcWeiMethodData%sweptarea,1) - i1_u = UBOUND(SrcWeiMethodData%sweptarea,1) - IF (.NOT. ALLOCATED(DstWeiMethodData%sweptarea)) THEN - ALLOCATE(DstWeiMethodData%sweptarea(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWeiMethodData%sweptarea.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWeiMethodData%sweptarea = SrcWeiMethodData%sweptarea -ENDIF - DstWeiMethodData%weighting_denominator = SrcWeiMethodData%weighting_denominator - END SUBROUTINE DWM_CopyWeiMethod - - SUBROUTINE DWM_DestroyWeiMethod( WeiMethodData, ErrStat, ErrMsg ) - TYPE(WeiMethod), INTENT(INOUT) :: WeiMethodData - 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 = 'DWM_DestroyWeiMethod' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(WeiMethodData%sweptarea)) THEN - DEALLOCATE(WeiMethodData%sweptarea) -ENDIF - END SUBROUTINE DWM_DestroyWeiMethod - - SUBROUTINE DWM_PackWeiMethod( 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(WeiMethod), 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 = 'DWM_PackWeiMethod' - ! 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 ! sweptarea allocated yes/no - IF ( ALLOCATED(InData%sweptarea) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! sweptarea upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%sweptarea) ! sweptarea - END IF - Re_BufSz = Re_BufSz + 1 ! weighting_denominator - 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%sweptarea) ) 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%sweptarea,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sweptarea,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%sweptarea,1), UBOUND(InData%sweptarea,1) - ReKiBuf(Re_Xferred) = InData%sweptarea(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%weighting_denominator - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackWeiMethod - - SUBROUTINE DWM_UnPackWeiMethod( 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(WeiMethod), 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 = 'DWM_UnPackWeiMethod' - ! 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 ! sweptarea 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%sweptarea)) DEALLOCATE(OutData%sweptarea) - ALLOCATE(OutData%sweptarea(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sweptarea.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%sweptarea,1), UBOUND(OutData%sweptarea,1) - OutData%sweptarea(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%weighting_denominator = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackWeiMethod - - SUBROUTINE DWM_CopyTIDownstream( SrcTIDownstreamData, DstTIDownstreamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TIDownstream), INTENT(IN) :: SrcTIDownstreamData - TYPE(TIDownstream), INTENT(INOUT) :: DstTIDownstreamData - 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 = 'DWM_CopyTIDownstream' -! + ErrMsg = '' + DstWake_Deficit_DataData%np_x = SrcWake_Deficit_DataData%np_x + DstWake_Deficit_DataData%X_length = SrcWake_Deficit_DataData%X_length + if (allocated(SrcWake_Deficit_DataData%Turb_Stress_DWM)) then + LB(1:2) = lbound(SrcWake_Deficit_DataData%Turb_Stress_DWM) + UB(1:2) = ubound(SrcWake_Deficit_DataData%Turb_Stress_DWM) + if (.not. allocated(DstWake_Deficit_DataData%Turb_Stress_DWM)) then + allocate(DstWake_Deficit_DataData%Turb_Stress_DWM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWake_Deficit_DataData%Turb_Stress_DWM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWake_Deficit_DataData%Turb_Stress_DWM = SrcWake_Deficit_DataData%Turb_Stress_DWM + end if + DstWake_Deficit_DataData%n_x_vector = SrcWake_Deficit_DataData%n_x_vector + DstWake_Deficit_DataData%n_r_vector = SrcWake_Deficit_DataData%n_r_vector + DstWake_Deficit_DataData%ppR = SrcWake_Deficit_DataData%ppR +end subroutine + +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 + character(*), parameter :: RoutineName = 'DWM_DestroyWake_Deficit_Data' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcTIDownstreamData%TI_downstream_matrix)) THEN - i1_l = LBOUND(SrcTIDownstreamData%TI_downstream_matrix,1) - i1_u = UBOUND(SrcTIDownstreamData%TI_downstream_matrix,1) - i2_l = LBOUND(SrcTIDownstreamData%TI_downstream_matrix,2) - i2_u = UBOUND(SrcTIDownstreamData%TI_downstream_matrix,2) - IF (.NOT. ALLOCATED(DstTIDownstreamData%TI_downstream_matrix)) THEN - ALLOCATE(DstTIDownstreamData%TI_downstream_matrix(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTIDownstreamData%TI_downstream_matrix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTIDownstreamData%TI_downstream_matrix = SrcTIDownstreamData%TI_downstream_matrix -ENDIF - DstTIDownstreamData%i = SrcTIDownstreamData%i - DstTIDownstreamData%j = SrcTIDownstreamData%j - DstTIDownstreamData%k = SrcTIDownstreamData%k - DstTIDownstreamData%cross_plane_position_ds = SrcTIDownstreamData%cross_plane_position_ds - DstTIDownstreamData%cross_plane_position_TI = SrcTIDownstreamData%cross_plane_position_TI - DstTIDownstreamData%distance_index = SrcTIDownstreamData%distance_index - DstTIDownstreamData%counter1 = SrcTIDownstreamData%counter1 - DstTIDownstreamData%counter2 = SrcTIDownstreamData%counter2 - DstTIDownstreamData%initial_timestep = SrcTIDownstreamData%initial_timestep - DstTIDownstreamData%y_axis_turbine = SrcTIDownstreamData%y_axis_turbine - DstTIDownstreamData%z_axis_turbine = SrcTIDownstreamData%z_axis_turbine - DstTIDownstreamData%distance = SrcTIDownstreamData%distance - DstTIDownstreamData%TI_downstream_node = SrcTIDownstreamData%TI_downstream_node - DstTIDownstreamData%TI_node_temp = SrcTIDownstreamData%TI_node_temp - DstTIDownstreamData%TI_node = SrcTIDownstreamData%TI_node - DstTIDownstreamData%TI_accumulation = SrcTIDownstreamData%TI_accumulation - DstTIDownstreamData%TI_apprant_accumulation = SrcTIDownstreamData%TI_apprant_accumulation - DstTIDownstreamData%TI_average = SrcTIDownstreamData%TI_average - DstTIDownstreamData%TI_apprant = SrcTIDownstreamData%TI_apprant - DstTIDownstreamData%HubHt = SrcTIDownstreamData%HubHt - DstTIDownstreamData%wake_center_y = SrcTIDownstreamData%wake_center_y - DstTIDownstreamData%wake_center_z = SrcTIDownstreamData%wake_center_z - DstTIDownstreamData%Rscale = SrcTIDownstreamData%Rscale - DstTIDownstreamData%y = SrcTIDownstreamData%y - DstTIDownstreamData%z = SrcTIDownstreamData%z - DstTIDownstreamData%zero_spacing = SrcTIDownstreamData%zero_spacing - DstTIDownstreamData%temp1 = SrcTIDownstreamData%temp1 - DstTIDownstreamData%temp2 = SrcTIDownstreamData%temp2 - DstTIDownstreamData%temp3 = SrcTIDownstreamData%temp3 - END SUBROUTINE DWM_CopyTIDownstream - - SUBROUTINE DWM_DestroyTIDownstream( TIDownstreamData, ErrStat, ErrMsg ) - TYPE(TIDownstream), INTENT(INOUT) :: TIDownstreamData - 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 = 'DWM_DestroyTIDownstream' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(TIDownstreamData%TI_downstream_matrix)) THEN - DEALLOCATE(TIDownstreamData%TI_downstream_matrix) -ENDIF - END SUBROUTINE DWM_DestroyTIDownstream - - SUBROUTINE DWM_PackTIDownstream( 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(TIDownstream), 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 = 'DWM_PackTIDownstream' - ! 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 ! TI_downstream_matrix allocated yes/no - IF ( ALLOCATED(InData%TI_downstream_matrix) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TI_downstream_matrix upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_downstream_matrix) ! TI_downstream_matrix - END IF - Int_BufSz = Int_BufSz + 1 ! i - Int_BufSz = Int_BufSz + 1 ! j - Int_BufSz = Int_BufSz + 1 ! k - Int_BufSz = Int_BufSz + 1 ! cross_plane_position_ds - Int_BufSz = Int_BufSz + 1 ! cross_plane_position_TI - Int_BufSz = Int_BufSz + 1 ! distance_index - Int_BufSz = Int_BufSz + 1 ! counter1 - Int_BufSz = Int_BufSz + 1 ! counter2 - Int_BufSz = Int_BufSz + 1 ! initial_timestep - Re_BufSz = Re_BufSz + 1 ! y_axis_turbine - Re_BufSz = Re_BufSz + 1 ! z_axis_turbine - Re_BufSz = Re_BufSz + 1 ! distance - Re_BufSz = Re_BufSz + 1 ! TI_downstream_node - Re_BufSz = Re_BufSz + 1 ! TI_node_temp - Re_BufSz = Re_BufSz + 1 ! TI_node - Re_BufSz = Re_BufSz + 1 ! TI_accumulation - Re_BufSz = Re_BufSz + 1 ! TI_apprant_accumulation - Re_BufSz = Re_BufSz + 1 ! TI_average - Re_BufSz = Re_BufSz + 1 ! TI_apprant - Re_BufSz = Re_BufSz + 1 ! HubHt - Re_BufSz = Re_BufSz + 1 ! wake_center_y - Re_BufSz = Re_BufSz + 1 ! wake_center_z - Re_BufSz = Re_BufSz + 1 ! Rscale - Re_BufSz = Re_BufSz + 1 ! y - Re_BufSz = Re_BufSz + 1 ! z - Re_BufSz = Re_BufSz + 1 ! zero_spacing - Re_BufSz = Re_BufSz + 1 ! temp1 - Re_BufSz = Re_BufSz + 1 ! temp2 - Re_BufSz = Re_BufSz + 1 ! temp3 - 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%TI_downstream_matrix) ) 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%TI_downstream_matrix,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_downstream_matrix,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_downstream_matrix,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_downstream_matrix,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TI_downstream_matrix,2), UBOUND(InData%TI_downstream_matrix,2) - DO i1 = LBOUND(InData%TI_downstream_matrix,1), UBOUND(InData%TI_downstream_matrix,1) - ReKiBuf(Re_Xferred) = InData%TI_downstream_matrix(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%i - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%j - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%k - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%cross_plane_position_ds - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%cross_plane_position_TI - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%distance_index - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%counter1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%counter2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%initial_timestep - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%y_axis_turbine - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%z_axis_turbine - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%distance - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_downstream_node - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_node_temp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_node - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_accumulation - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_apprant_accumulation - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_average - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_apprant - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%wake_center_y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%wake_center_z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Rscale - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%zero_spacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%temp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%temp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%temp3 - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackTIDownstream - - SUBROUTINE DWM_UnPackTIDownstream( 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(TIDownstream), 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 = 'DWM_UnPackTIDownstream' - ! 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 ! TI_downstream_matrix 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%TI_downstream_matrix)) DEALLOCATE(OutData%TI_downstream_matrix) - ALLOCATE(OutData%TI_downstream_matrix(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream_matrix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TI_downstream_matrix,2), UBOUND(OutData%TI_downstream_matrix,2) - DO i1 = LBOUND(OutData%TI_downstream_matrix,1), UBOUND(OutData%TI_downstream_matrix,1) - OutData%TI_downstream_matrix(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%i = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%j = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%k = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%cross_plane_position_ds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%cross_plane_position_TI = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%distance_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%counter1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%counter2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%initial_timestep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%y_axis_turbine = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%z_axis_turbine = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%distance = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_downstream_node = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_node_temp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_node = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_accumulation = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_apprant_accumulation = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_average = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_apprant = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%wake_center_y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%wake_center_z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Rscale = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%zero_spacing = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%temp1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%temp2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%temp3 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackTIDownstream - - SUBROUTINE DWM_CopyTurbKaimal( SrcTurbKaimalData, DstTurbKaimalData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TurbKaimal), INTENT(IN) :: SrcTurbKaimalData - TYPE(TurbKaimal), INTENT(INOUT) :: DstTurbKaimalData - 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 = 'DWM_CopyTurbKaimal' -! + ErrMsg = '' + if (allocated(Wake_Deficit_DataData%Turb_Stress_DWM)) then + deallocate(Wake_Deficit_DataData%Turb_Stress_DWM) + end if +end subroutine + +subroutine DWM_PackWake_Deficit_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_Wake_Deficit_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackWake_Deficit_Data' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%np_x) + call RegPack(Buf, InData%X_length) + call RegPack(Buf, allocated(InData%Turb_Stress_DWM)) + if (allocated(InData%Turb_Stress_DWM)) then + call RegPackBounds(Buf, 2, lbound(InData%Turb_Stress_DWM), ubound(InData%Turb_Stress_DWM)) + call RegPack(Buf, InData%Turb_Stress_DWM) + end if + call RegPack(Buf, InData%n_x_vector) + call RegPack(Buf, InData%n_r_vector) + call RegPack(Buf, InData%ppR) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackWake_Deficit_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_Wake_Deficit_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackWake_Deficit_Data' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%np_x) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%X_length) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Turb_Stress_DWM)) deallocate(OutData%Turb_Stress_DWM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Turb_Stress_DWM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turb_Stress_DWM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Turb_Stress_DWM) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%n_x_vector) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_r_vector) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ppR) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_CopyMeanderData(SrcMeanderDataData, DstMeanderDataData, CtrlCode, ErrStat, ErrMsg) + type(MeanderData), intent(in) :: SrcMeanderDataData + type(MeanderData), intent(inout) :: DstMeanderDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_CopyMeanderData' ErrStat = ErrID_None - ErrMsg = "" - DstTurbKaimalData%fs = SrcTurbKaimalData%fs - DstTurbKaimalData%temp_n = SrcTurbKaimalData%temp_n - DstTurbKaimalData%i = SrcTurbKaimalData%i - DstTurbKaimalData%low_f = SrcTurbKaimalData%low_f - DstTurbKaimalData%high_f = SrcTurbKaimalData%high_f - DstTurbKaimalData%lk_facor = SrcTurbKaimalData%lk_facor - DstTurbKaimalData%STD = SrcTurbKaimalData%STD - END SUBROUTINE DWM_CopyTurbKaimal - - SUBROUTINE DWM_DestroyTurbKaimal( TurbKaimalData, ErrStat, ErrMsg ) - TYPE(TurbKaimal), INTENT(INOUT) :: TurbKaimalData - 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 = 'DWM_DestroyTurbKaimal' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DWM_DestroyTurbKaimal - - SUBROUTINE DWM_PackTurbKaimal( 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(TurbKaimal), 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 = 'DWM_PackTurbKaimal' - ! 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 ! fs - Int_BufSz = Int_BufSz + 1 ! temp_n - Int_BufSz = Int_BufSz + 1 ! i - Re_BufSz = Re_BufSz + 1 ! low_f - Re_BufSz = Re_BufSz + 1 ! high_f - Re_BufSz = Re_BufSz + 1 ! lk_facor - Re_BufSz = Re_BufSz + 1 ! STD - 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%fs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%temp_n - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%i - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%low_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%high_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%lk_facor - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%STD - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackTurbKaimal - - SUBROUTINE DWM_UnPackTurbKaimal( 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(TurbKaimal), 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 = 'DWM_UnPackTurbKaimal' - ! 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%fs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%temp_n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%i = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%low_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%high_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%lk_facor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%STD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackTurbKaimal - - SUBROUTINE DWM_CopyShinozuka( SrcShinozukaData, DstShinozukaData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Shinozuka), INTENT(IN) :: SrcShinozukaData - TYPE(Shinozuka), INTENT(INOUT) :: DstShinozukaData - 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 = 'DWM_CopyShinozuka' -! + ErrMsg = '' + DstMeanderDataData%scale_factor = SrcMeanderDataData%scale_factor + DstMeanderDataData%moving_time = SrcMeanderDataData%moving_time +end subroutine + +subroutine DWM_DestroyMeanderData(MeanderDataData, ErrStat, ErrMsg) + type(MeanderData), intent(inout) :: MeanderDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_DestroyMeanderData' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcShinozukaData%f_syn)) THEN - i1_l = LBOUND(SrcShinozukaData%f_syn,1) - i1_u = UBOUND(SrcShinozukaData%f_syn,1) - IF (.NOT. ALLOCATED(DstShinozukaData%f_syn)) THEN - ALLOCATE(DstShinozukaData%f_syn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%f_syn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstShinozukaData%f_syn = SrcShinozukaData%f_syn -ENDIF -IF (ALLOCATED(SrcShinozukaData%t_syn)) THEN - i1_l = LBOUND(SrcShinozukaData%t_syn,1) - i1_u = UBOUND(SrcShinozukaData%t_syn,1) - IF (.NOT. ALLOCATED(DstShinozukaData%t_syn)) THEN - ALLOCATE(DstShinozukaData%t_syn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%t_syn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstShinozukaData%t_syn = SrcShinozukaData%t_syn -ENDIF -IF (ALLOCATED(SrcShinozukaData%phi)) THEN - i1_l = LBOUND(SrcShinozukaData%phi,1) - i1_u = UBOUND(SrcShinozukaData%phi,1) - IF (.NOT. ALLOCATED(DstShinozukaData%phi)) THEN - ALLOCATE(DstShinozukaData%phi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstShinozukaData%phi = SrcShinozukaData%phi -ENDIF -IF (ALLOCATED(SrcShinozukaData%p_k)) THEN - i1_l = LBOUND(SrcShinozukaData%p_k,1) - i1_u = UBOUND(SrcShinozukaData%p_k,1) - IF (.NOT. ALLOCATED(DstShinozukaData%p_k)) THEN - ALLOCATE(DstShinozukaData%p_k(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%p_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstShinozukaData%p_k = SrcShinozukaData%p_k -ENDIF -IF (ALLOCATED(SrcShinozukaData%a_k)) THEN - i1_l = LBOUND(SrcShinozukaData%a_k,1) - i1_u = UBOUND(SrcShinozukaData%a_k,1) - IF (.NOT. ALLOCATED(DstShinozukaData%a_k)) THEN - ALLOCATE(DstShinozukaData%a_k(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%a_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstShinozukaData%a_k = SrcShinozukaData%a_k -ENDIF - DstShinozukaData%num_points = SrcShinozukaData%num_points - DstShinozukaData%ILo = SrcShinozukaData%ILo - DstShinozukaData%i = SrcShinozukaData%i - DstShinozukaData%j = SrcShinozukaData%j - DstShinozukaData%dt = SrcShinozukaData%dt - DstShinozukaData%t_min = SrcShinozukaData%t_min - DstShinozukaData%t_max = SrcShinozukaData%t_max - DstShinozukaData%df = SrcShinozukaData%df - END SUBROUTINE DWM_CopyShinozuka - - SUBROUTINE DWM_DestroyShinozuka( ShinozukaData, ErrStat, ErrMsg ) - TYPE(Shinozuka), INTENT(INOUT) :: ShinozukaData - 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 = 'DWM_DestroyShinozuka' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ShinozukaData%f_syn)) THEN - DEALLOCATE(ShinozukaData%f_syn) -ENDIF -IF (ALLOCATED(ShinozukaData%t_syn)) THEN - DEALLOCATE(ShinozukaData%t_syn) -ENDIF -IF (ALLOCATED(ShinozukaData%phi)) THEN - DEALLOCATE(ShinozukaData%phi) -ENDIF -IF (ALLOCATED(ShinozukaData%p_k)) THEN - DEALLOCATE(ShinozukaData%p_k) -ENDIF -IF (ALLOCATED(ShinozukaData%a_k)) THEN - DEALLOCATE(ShinozukaData%a_k) -ENDIF - END SUBROUTINE DWM_DestroyShinozuka - - SUBROUTINE DWM_PackShinozuka( 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(Shinozuka), 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 = 'DWM_PackShinozuka' - ! 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 ! f_syn allocated yes/no - IF ( ALLOCATED(InData%f_syn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! f_syn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%f_syn) ! f_syn - END IF - Int_BufSz = Int_BufSz + 1 ! t_syn allocated yes/no - IF ( ALLOCATED(InData%t_syn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! t_syn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%t_syn) ! t_syn - END IF - Int_BufSz = Int_BufSz + 1 ! phi allocated yes/no - IF ( ALLOCATED(InData%phi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%phi) ! phi - END IF - Int_BufSz = Int_BufSz + 1 ! p_k allocated yes/no - IF ( ALLOCATED(InData%p_k) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! p_k upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%p_k) ! p_k - END IF - Int_BufSz = Int_BufSz + 1 ! a_k allocated yes/no - IF ( ALLOCATED(InData%a_k) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! a_k upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%a_k) ! a_k - END IF - Int_BufSz = Int_BufSz + 1 ! num_points - Int_BufSz = Int_BufSz + 1 ! ILo - Int_BufSz = Int_BufSz + 1 ! i - Int_BufSz = Int_BufSz + 1 ! j - Re_BufSz = Re_BufSz + 1 ! dt - Re_BufSz = Re_BufSz + 1 ! t_min - Re_BufSz = Re_BufSz + 1 ! t_max - Re_BufSz = Re_BufSz + 1 ! df - 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%f_syn) ) 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%f_syn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%f_syn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%f_syn,1), UBOUND(InData%f_syn,1) - ReKiBuf(Re_Xferred) = InData%f_syn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%t_syn) ) 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%t_syn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t_syn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%t_syn,1), UBOUND(InData%t_syn,1) - ReKiBuf(Re_Xferred) = InData%t_syn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%phi) ) 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%phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) - ReKiBuf(Re_Xferred) = InData%phi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%p_k) ) 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%p_k,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_k,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%p_k,1), UBOUND(InData%p_k,1) - ReKiBuf(Re_Xferred) = InData%p_k(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%a_k) ) 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%a_k,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%a_k,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%a_k,1), UBOUND(InData%a_k,1) - ReKiBuf(Re_Xferred) = InData%a_k(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%num_points - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ILo - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%i - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%j - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%t_min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%t_max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%df - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackShinozuka - - SUBROUTINE DWM_UnPackShinozuka( 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(Shinozuka), 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 = 'DWM_UnPackShinozuka' - ! 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 ! f_syn 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%f_syn)) DEALLOCATE(OutData%f_syn) - ALLOCATE(OutData%f_syn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%f_syn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%f_syn,1), UBOUND(OutData%f_syn,1) - OutData%f_syn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t_syn 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%t_syn)) DEALLOCATE(OutData%t_syn) - ALLOCATE(OutData%t_syn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_syn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%t_syn,1), UBOUND(OutData%t_syn,1) - OutData%t_syn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi 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%phi)) DEALLOCATE(OutData%phi) - ALLOCATE(OutData%phi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) - OutData%phi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p_k 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%p_k)) DEALLOCATE(OutData%p_k) - ALLOCATE(OutData%p_k(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%p_k,1), UBOUND(OutData%p_k,1) - OutData%p_k(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! a_k 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%a_k)) DEALLOCATE(OutData%a_k) - ALLOCATE(OutData%a_k(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%a_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%a_k,1), UBOUND(OutData%a_k,1) - OutData%a_k(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%num_points = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ILo = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%i = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%j = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%t_min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%t_max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%df = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackShinozuka - - SUBROUTINE DWM_Copysmooth_out_wake_data( Srcsmooth_out_wake_dataData, Dstsmooth_out_wake_dataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(smooth_out_wake_data), INTENT(IN) :: Srcsmooth_out_wake_dataData - TYPE(smooth_out_wake_data), INTENT(INOUT) :: Dstsmooth_out_wake_dataData - 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 = 'DWM_Copysmooth_out_wake_data' -! + ErrMsg = '' +end subroutine + +subroutine DWM_PackMeanderData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MeanderData), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackMeanderData' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%scale_factor) + call RegPack(Buf, InData%moving_time) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackMeanderData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MeanderData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackMeanderData' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%scale_factor) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%moving_time) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData, CtrlCode, ErrStat, ErrMsg) + type(read_turbine_position_data), intent(in) :: Srcread_turbine_position_dataData + type(read_turbine_position_data), intent(inout) :: Dstread_turbine_position_dataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_Copyread_turbine_position_data' ErrStat = ErrID_None - ErrMsg = "" - 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 ) - TYPE(smooth_out_wake_data), INTENT(INOUT) :: smooth_out_wake_dataData - 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 = 'DWM_Destroysmooth_out_wake_data' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DWM_Destroysmooth_out_wake_data - - SUBROUTINE DWM_Packsmooth_out_wake_data( 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(smooth_out_wake_data), 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 = 'DWM_Packsmooth_out_wake_data' - ! 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 ! length_velocity_array - 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%length_velocity_array - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_Packsmooth_out_wake_data - - SUBROUTINE DWM_UnPacksmooth_out_wake_data( 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(smooth_out_wake_data), 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 = 'DWM_UnPacksmooth_out_wake_data' - ! 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%length_velocity_array = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_UnPacksmooth_out_wake_data - - SUBROUTINE DWM_CopySWSV( SrcSWSVData, DstSWSVData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SWSV), INTENT(IN) :: SrcSWSVData - TYPE(SWSV), INTENT(INOUT) :: DstSWSVData - 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 = 'DWM_CopySWSV' -! + ErrMsg = '' + Dstread_turbine_position_dataData%SimulationOrder_index = Srcread_turbine_position_dataData%SimulationOrder_index + if (allocated(Srcread_turbine_position_dataData%Turbine_sort_order)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%Turbine_sort_order) + UB(1:1) = ubound(Srcread_turbine_position_dataData%Turbine_sort_order) + if (.not. allocated(Dstread_turbine_position_dataData%Turbine_sort_order)) then + allocate(Dstread_turbine_position_dataData%Turbine_sort_order(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%Turbine_sort_order.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%Turbine_sort_order = Srcread_turbine_position_dataData%Turbine_sort_order + end if + Dstread_turbine_position_dataData%WT_index = Srcread_turbine_position_dataData%WT_index + if (allocated(Srcread_turbine_position_dataData%TurbineInfluenceData)) then + LB(1:2) = lbound(Srcread_turbine_position_dataData%TurbineInfluenceData) + UB(1:2) = ubound(Srcread_turbine_position_dataData%TurbineInfluenceData) + if (.not. allocated(Dstread_turbine_position_dataData%TurbineInfluenceData)) then + allocate(Dstread_turbine_position_dataData%TurbineInfluenceData(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%TurbineInfluenceData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%TurbineInfluenceData = Srcread_turbine_position_dataData%TurbineInfluenceData + end if + if (allocated(Srcread_turbine_position_dataData%upwind_turbine_index)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_index) + UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_index) + if (.not. allocated(Dstread_turbine_position_dataData%upwind_turbine_index)) then + allocate(Dstread_turbine_position_dataData%upwind_turbine_index(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_index.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%upwind_turbine_index = Srcread_turbine_position_dataData%upwind_turbine_index + end if + if (allocated(Srcread_turbine_position_dataData%downwind_turbine_index)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_index) + UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_index) + if (.not. allocated(Dstread_turbine_position_dataData%downwind_turbine_index)) then + allocate(Dstread_turbine_position_dataData%downwind_turbine_index(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_index.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%downwind_turbine_index = Srcread_turbine_position_dataData%downwind_turbine_index + end if + Dstread_turbine_position_dataData%upwindturbine_number = Srcread_turbine_position_dataData%upwindturbine_number + Dstread_turbine_position_dataData%downwindturbine_number = Srcread_turbine_position_dataData%downwindturbine_number + if (allocated(Srcread_turbine_position_dataData%turbine_windorigin_length)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%turbine_windorigin_length) + UB(1:1) = ubound(Srcread_turbine_position_dataData%turbine_windorigin_length) + if (.not. allocated(Dstread_turbine_position_dataData%turbine_windorigin_length)) then + allocate(Dstread_turbine_position_dataData%turbine_windorigin_length(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%turbine_windorigin_length.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%turbine_windorigin_length = Srcread_turbine_position_dataData%turbine_windorigin_length + end if + if (allocated(Srcread_turbine_position_dataData%upwind_turbine_projected_distance)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_projected_distance) + UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_projected_distance) + if (.not. allocated(Dstread_turbine_position_dataData%upwind_turbine_projected_distance)) then + allocate(Dstread_turbine_position_dataData%upwind_turbine_projected_distance(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_projected_distance.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%upwind_turbine_projected_distance = Srcread_turbine_position_dataData%upwind_turbine_projected_distance + end if + if (allocated(Srcread_turbine_position_dataData%downwind_turbine_projected_distance)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_projected_distance) + UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_projected_distance) + if (.not. allocated(Dstread_turbine_position_dataData%downwind_turbine_projected_distance)) then + allocate(Dstread_turbine_position_dataData%downwind_turbine_projected_distance(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_projected_distance.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%downwind_turbine_projected_distance = Srcread_turbine_position_dataData%downwind_turbine_projected_distance + end if + if (allocated(Srcread_turbine_position_dataData%turbine_angle)) then + LB(1:2) = lbound(Srcread_turbine_position_dataData%turbine_angle) + UB(1:2) = ubound(Srcread_turbine_position_dataData%turbine_angle) + if (.not. allocated(Dstread_turbine_position_dataData%turbine_angle)) then + allocate(Dstread_turbine_position_dataData%turbine_angle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%turbine_angle.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%turbine_angle = Srcread_turbine_position_dataData%turbine_angle + end if + if (allocated(Srcread_turbine_position_dataData%upwind_align_angle)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_align_angle) + UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_align_angle) + if (.not. allocated(Dstread_turbine_position_dataData%upwind_align_angle)) then + allocate(Dstread_turbine_position_dataData%upwind_align_angle(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_align_angle.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%upwind_align_angle = Srcread_turbine_position_dataData%upwind_align_angle + end if + if (allocated(Srcread_turbine_position_dataData%downwind_align_angle)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_align_angle) + UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_align_angle) + if (.not. allocated(Dstread_turbine_position_dataData%downwind_align_angle)) then + allocate(Dstread_turbine_position_dataData%downwind_align_angle(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_align_angle.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%downwind_align_angle = Srcread_turbine_position_dataData%downwind_align_angle + end if + if (allocated(Srcread_turbine_position_dataData%upwind_turbine_Xcoor)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_Xcoor) + UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_Xcoor) + if (.not. allocated(Dstread_turbine_position_dataData%upwind_turbine_Xcoor)) then + allocate(Dstread_turbine_position_dataData%upwind_turbine_Xcoor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_Xcoor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%upwind_turbine_Xcoor = Srcread_turbine_position_dataData%upwind_turbine_Xcoor + end if + if (allocated(Srcread_turbine_position_dataData%upwind_turbine_Ycoor)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_Ycoor) + UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_Ycoor) + if (.not. allocated(Dstread_turbine_position_dataData%upwind_turbine_Ycoor)) then + allocate(Dstread_turbine_position_dataData%upwind_turbine_Ycoor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_Ycoor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%upwind_turbine_Ycoor = Srcread_turbine_position_dataData%upwind_turbine_Ycoor + end if + if (allocated(Srcread_turbine_position_dataData%wind_farm_Xcoor)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%wind_farm_Xcoor) + UB(1:1) = ubound(Srcread_turbine_position_dataData%wind_farm_Xcoor) + if (.not. allocated(Dstread_turbine_position_dataData%wind_farm_Xcoor)) then + allocate(Dstread_turbine_position_dataData%wind_farm_Xcoor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%wind_farm_Xcoor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%wind_farm_Xcoor = Srcread_turbine_position_dataData%wind_farm_Xcoor + end if + if (allocated(Srcread_turbine_position_dataData%wind_farm_Ycoor)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%wind_farm_Ycoor) + UB(1:1) = ubound(Srcread_turbine_position_dataData%wind_farm_Ycoor) + if (.not. allocated(Dstread_turbine_position_dataData%wind_farm_Ycoor)) then + allocate(Dstread_turbine_position_dataData%wind_farm_Ycoor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%wind_farm_Ycoor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%wind_farm_Ycoor = Srcread_turbine_position_dataData%wind_farm_Ycoor + end if + if (allocated(Srcread_turbine_position_dataData%downwind_turbine_Xcoor)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_Xcoor) + UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_Xcoor) + if (.not. allocated(Dstread_turbine_position_dataData%downwind_turbine_Xcoor)) then + allocate(Dstread_turbine_position_dataData%downwind_turbine_Xcoor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_Xcoor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%downwind_turbine_Xcoor = Srcread_turbine_position_dataData%downwind_turbine_Xcoor + end if + if (allocated(Srcread_turbine_position_dataData%downwind_turbine_Ycoor)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_Ycoor) + UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_Ycoor) + if (.not. allocated(Dstread_turbine_position_dataData%downwind_turbine_Ycoor)) then + allocate(Dstread_turbine_position_dataData%downwind_turbine_Ycoor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_Ycoor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%downwind_turbine_Ycoor = Srcread_turbine_position_dataData%downwind_turbine_Ycoor + end if +end subroutine + +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 + character(*), parameter :: RoutineName = 'DWM_Destroyread_turbine_position_data' ErrStat = ErrID_None - ErrMsg = "" - DstSWSVData%p1 = SrcSWSVData%p1 - DstSWSVData%p2 = SrcSWSVData%p2 - DstSWSVData%distance = SrcSWSVData%distance - DstSWSVData%y0 = SrcSWSVData%y0 - DstSWSVData%z0 = SrcSWSVData%z0 - DstSWSVData%unit = SrcSWSVData%unit - END SUBROUTINE DWM_CopySWSV - - SUBROUTINE DWM_DestroySWSV( SWSVData, ErrStat, ErrMsg ) - TYPE(SWSV), INTENT(INOUT) :: SWSVData - 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 = 'DWM_DestroySWSV' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DWM_DestroySWSV - - SUBROUTINE DWM_PackSWSV( 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(SWSV), 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 = 'DWM_PackSWSV' - ! 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 ! p1 - Int_BufSz = Int_BufSz + 1 ! p2 - Re_BufSz = Re_BufSz + 1 ! distance - Re_BufSz = Re_BufSz + 1 ! y0 - Re_BufSz = Re_BufSz + 1 ! z0 - Re_BufSz = Re_BufSz + 1 ! unit - 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%p1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%p2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%distance - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%y0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%z0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%unit - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackSWSV - - SUBROUTINE DWM_UnPackSWSV( 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(SWSV), 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 = 'DWM_UnPackSWSV' - ! 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%p1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%p2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%distance = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%y0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%z0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%unit = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackSWSV - - SUBROUTINE DWM_Copyread_upwind_result( Srcread_upwind_resultData, Dstread_upwind_resultData, CtrlCode, ErrStat, ErrMsg ) - TYPE(read_upwind_result), INTENT(IN) :: Srcread_upwind_resultData - TYPE(read_upwind_result), INTENT(INOUT) :: Dstread_upwind_resultData - 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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Copyread_upwind_result' -! + ErrMsg = '' + if (allocated(read_turbine_position_dataData%Turbine_sort_order)) then + deallocate(read_turbine_position_dataData%Turbine_sort_order) + end if + if (allocated(read_turbine_position_dataData%TurbineInfluenceData)) then + deallocate(read_turbine_position_dataData%TurbineInfluenceData) + end if + if (allocated(read_turbine_position_dataData%upwind_turbine_index)) then + deallocate(read_turbine_position_dataData%upwind_turbine_index) + end if + if (allocated(read_turbine_position_dataData%downwind_turbine_index)) then + deallocate(read_turbine_position_dataData%downwind_turbine_index) + end if + if (allocated(read_turbine_position_dataData%turbine_windorigin_length)) then + deallocate(read_turbine_position_dataData%turbine_windorigin_length) + end if + if (allocated(read_turbine_position_dataData%upwind_turbine_projected_distance)) then + deallocate(read_turbine_position_dataData%upwind_turbine_projected_distance) + end if + if (allocated(read_turbine_position_dataData%downwind_turbine_projected_distance)) then + deallocate(read_turbine_position_dataData%downwind_turbine_projected_distance) + end if + if (allocated(read_turbine_position_dataData%turbine_angle)) then + deallocate(read_turbine_position_dataData%turbine_angle) + end if + if (allocated(read_turbine_position_dataData%upwind_align_angle)) then + deallocate(read_turbine_position_dataData%upwind_align_angle) + end if + if (allocated(read_turbine_position_dataData%downwind_align_angle)) then + deallocate(read_turbine_position_dataData%downwind_align_angle) + end if + if (allocated(read_turbine_position_dataData%upwind_turbine_Xcoor)) then + deallocate(read_turbine_position_dataData%upwind_turbine_Xcoor) + end if + if (allocated(read_turbine_position_dataData%upwind_turbine_Ycoor)) then + deallocate(read_turbine_position_dataData%upwind_turbine_Ycoor) + end if + if (allocated(read_turbine_position_dataData%wind_farm_Xcoor)) then + deallocate(read_turbine_position_dataData%wind_farm_Xcoor) + end if + if (allocated(read_turbine_position_dataData%wind_farm_Ycoor)) then + deallocate(read_turbine_position_dataData%wind_farm_Ycoor) + end if + if (allocated(read_turbine_position_dataData%downwind_turbine_Xcoor)) then + deallocate(read_turbine_position_dataData%downwind_turbine_Xcoor) + end if + if (allocated(read_turbine_position_dataData%downwind_turbine_Ycoor)) then + deallocate(read_turbine_position_dataData%downwind_turbine_Ycoor) + end if +end subroutine + +subroutine DWM_Packread_turbine_position_data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(read_turbine_position_data), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_Packread_turbine_position_data' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%SimulationOrder_index) + call RegPack(Buf, allocated(InData%Turbine_sort_order)) + if (allocated(InData%Turbine_sort_order)) then + call RegPackBounds(Buf, 1, lbound(InData%Turbine_sort_order), ubound(InData%Turbine_sort_order)) + call RegPack(Buf, InData%Turbine_sort_order) + end if + call RegPack(Buf, InData%WT_index) + call RegPack(Buf, allocated(InData%TurbineInfluenceData)) + if (allocated(InData%TurbineInfluenceData)) then + call RegPackBounds(Buf, 2, lbound(InData%TurbineInfluenceData), ubound(InData%TurbineInfluenceData)) + call RegPack(Buf, InData%TurbineInfluenceData) + end if + call RegPack(Buf, allocated(InData%upwind_turbine_index)) + if (allocated(InData%upwind_turbine_index)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_index), ubound(InData%upwind_turbine_index)) + call RegPack(Buf, InData%upwind_turbine_index) + end if + call RegPack(Buf, allocated(InData%downwind_turbine_index)) + if (allocated(InData%downwind_turbine_index)) then + call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_index), ubound(InData%downwind_turbine_index)) + call RegPack(Buf, InData%downwind_turbine_index) + end if + call RegPack(Buf, InData%upwindturbine_number) + call RegPack(Buf, InData%downwindturbine_number) + call RegPack(Buf, allocated(InData%turbine_windorigin_length)) + if (allocated(InData%turbine_windorigin_length)) then + call RegPackBounds(Buf, 1, lbound(InData%turbine_windorigin_length), ubound(InData%turbine_windorigin_length)) + call RegPack(Buf, InData%turbine_windorigin_length) + end if + call RegPack(Buf, allocated(InData%upwind_turbine_projected_distance)) + if (allocated(InData%upwind_turbine_projected_distance)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_projected_distance), ubound(InData%upwind_turbine_projected_distance)) + call RegPack(Buf, InData%upwind_turbine_projected_distance) + end if + call RegPack(Buf, allocated(InData%downwind_turbine_projected_distance)) + if (allocated(InData%downwind_turbine_projected_distance)) then + call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_projected_distance), ubound(InData%downwind_turbine_projected_distance)) + call RegPack(Buf, InData%downwind_turbine_projected_distance) + end if + call RegPack(Buf, allocated(InData%turbine_angle)) + if (allocated(InData%turbine_angle)) then + call RegPackBounds(Buf, 2, lbound(InData%turbine_angle), ubound(InData%turbine_angle)) + call RegPack(Buf, InData%turbine_angle) + end if + call RegPack(Buf, allocated(InData%upwind_align_angle)) + if (allocated(InData%upwind_align_angle)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_align_angle), ubound(InData%upwind_align_angle)) + call RegPack(Buf, InData%upwind_align_angle) + end if + call RegPack(Buf, allocated(InData%downwind_align_angle)) + if (allocated(InData%downwind_align_angle)) then + call RegPackBounds(Buf, 1, lbound(InData%downwind_align_angle), ubound(InData%downwind_align_angle)) + call RegPack(Buf, InData%downwind_align_angle) + end if + call RegPack(Buf, allocated(InData%upwind_turbine_Xcoor)) + if (allocated(InData%upwind_turbine_Xcoor)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_Xcoor), ubound(InData%upwind_turbine_Xcoor)) + call RegPack(Buf, InData%upwind_turbine_Xcoor) + end if + call RegPack(Buf, allocated(InData%upwind_turbine_Ycoor)) + if (allocated(InData%upwind_turbine_Ycoor)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_Ycoor), ubound(InData%upwind_turbine_Ycoor)) + call RegPack(Buf, InData%upwind_turbine_Ycoor) + end if + call RegPack(Buf, allocated(InData%wind_farm_Xcoor)) + if (allocated(InData%wind_farm_Xcoor)) then + call RegPackBounds(Buf, 1, lbound(InData%wind_farm_Xcoor), ubound(InData%wind_farm_Xcoor)) + call RegPack(Buf, InData%wind_farm_Xcoor) + end if + call RegPack(Buf, allocated(InData%wind_farm_Ycoor)) + if (allocated(InData%wind_farm_Ycoor)) then + call RegPackBounds(Buf, 1, lbound(InData%wind_farm_Ycoor), ubound(InData%wind_farm_Ycoor)) + call RegPack(Buf, InData%wind_farm_Ycoor) + end if + call RegPack(Buf, allocated(InData%downwind_turbine_Xcoor)) + if (allocated(InData%downwind_turbine_Xcoor)) then + call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_Xcoor), ubound(InData%downwind_turbine_Xcoor)) + call RegPack(Buf, InData%downwind_turbine_Xcoor) + end if + call RegPack(Buf, allocated(InData%downwind_turbine_Ycoor)) + if (allocated(InData%downwind_turbine_Ycoor)) then + call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_Ycoor), ubound(InData%downwind_turbine_Ycoor)) + call RegPack(Buf, InData%downwind_turbine_Ycoor) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(read_turbine_position_data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackread_turbine_position_data' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%SimulationOrder_index) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Turbine_sort_order)) deallocate(OutData%Turbine_sort_order) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Turbine_sort_order(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turbine_sort_order.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Turbine_sort_order) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%WT_index) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TurbineInfluenceData)) deallocate(OutData%TurbineInfluenceData) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TurbineInfluenceData(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineInfluenceData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TurbineInfluenceData) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%upwind_turbine_index)) deallocate(OutData%upwind_turbine_index) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_turbine_index(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_index.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_turbine_index) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%downwind_turbine_index)) deallocate(OutData%downwind_turbine_index) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%downwind_turbine_index(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_index.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%downwind_turbine_index) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%upwindturbine_number) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%downwindturbine_number) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%turbine_windorigin_length)) deallocate(OutData%turbine_windorigin_length) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%turbine_windorigin_length(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_windorigin_length.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%turbine_windorigin_length) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%upwind_turbine_projected_distance)) deallocate(OutData%upwind_turbine_projected_distance) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_turbine_projected_distance(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_projected_distance.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_turbine_projected_distance) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%downwind_turbine_projected_distance)) deallocate(OutData%downwind_turbine_projected_distance) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%downwind_turbine_projected_distance(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_projected_distance.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%downwind_turbine_projected_distance) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%turbine_angle)) deallocate(OutData%turbine_angle) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%turbine_angle(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_angle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%turbine_angle) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%upwind_align_angle)) deallocate(OutData%upwind_align_angle) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_align_angle(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_align_angle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_align_angle) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%downwind_align_angle)) deallocate(OutData%downwind_align_angle) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%downwind_align_angle(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_align_angle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%downwind_align_angle) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%upwind_turbine_Xcoor)) deallocate(OutData%upwind_turbine_Xcoor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_turbine_Xcoor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Xcoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_turbine_Xcoor) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%upwind_turbine_Ycoor)) deallocate(OutData%upwind_turbine_Ycoor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_turbine_Ycoor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Ycoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_turbine_Ycoor) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%wind_farm_Xcoor)) deallocate(OutData%wind_farm_Xcoor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%wind_farm_Xcoor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Xcoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%wind_farm_Xcoor) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%wind_farm_Ycoor)) deallocate(OutData%wind_farm_Ycoor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%wind_farm_Ycoor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Ycoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%wind_farm_Ycoor) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%downwind_turbine_Xcoor)) deallocate(OutData%downwind_turbine_Xcoor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%downwind_turbine_Xcoor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Xcoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%downwind_turbine_Xcoor) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%downwind_turbine_Ycoor)) deallocate(OutData%downwind_turbine_Ycoor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%downwind_turbine_Ycoor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Ycoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%downwind_turbine_Ycoor) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine DWM_CopyWeiMethod(SrcWeiMethodData, DstWeiMethodData, CtrlCode, ErrStat, ErrMsg) + type(WeiMethod), intent(in) :: SrcWeiMethodData + type(WeiMethod), intent(inout) :: DstWeiMethodData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_CopyWeiMethod' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(Srcread_upwind_resultData%upwind_U)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_U,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_U,1) - i2_l = LBOUND(Srcread_upwind_resultData%upwind_U,2) - i2_u = UBOUND(Srcread_upwind_resultData%upwind_U,2) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_U)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_U = Srcread_upwind_resultData%upwind_U -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%upwind_wakecenter)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_wakecenter,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_wakecenter,1) - i2_l = LBOUND(Srcread_upwind_resultData%upwind_wakecenter,2) - i2_u = UBOUND(Srcread_upwind_resultData%upwind_wakecenter,2) - i3_l = LBOUND(Srcread_upwind_resultData%upwind_wakecenter,3) - i3_u = UBOUND(Srcread_upwind_resultData%upwind_wakecenter,3) - i4_l = LBOUND(Srcread_upwind_resultData%upwind_wakecenter,4) - i4_u = UBOUND(Srcread_upwind_resultData%upwind_wakecenter,4) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_wakecenter)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_wakecenter(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 Dstread_upwind_resultData%upwind_wakecenter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_wakecenter = Srcread_upwind_resultData%upwind_wakecenter -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%upwind_meanU)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_meanU,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_meanU,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_meanU)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_meanU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_meanU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_meanU = Srcread_upwind_resultData%upwind_meanU -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%upwind_TI)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_TI,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_TI,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_TI)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_TI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_TI = Srcread_upwind_resultData%upwind_TI -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%upwind_small_TI)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_small_TI,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_small_TI,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_small_TI)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_small_TI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_small_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_small_TI = Srcread_upwind_resultData%upwind_small_TI -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%upwind_smoothWake)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_smoothWake,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_smoothWake,1) - i2_l = LBOUND(Srcread_upwind_resultData%upwind_smoothWake,2) - i2_u = UBOUND(Srcread_upwind_resultData%upwind_smoothWake,2) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_smoothWake)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_smoothWake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_smoothWake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_smoothWake = Srcread_upwind_resultData%upwind_smoothWake -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%velocity_aerodyn)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%velocity_aerodyn,1) - i1_u = UBOUND(Srcread_upwind_resultData%velocity_aerodyn,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%velocity_aerodyn)) THEN - ALLOCATE(Dstread_upwind_resultData%velocity_aerodyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%velocity_aerodyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%velocity_aerodyn = Srcread_upwind_resultData%velocity_aerodyn -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%TI_downstream)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%TI_downstream,1) - i1_u = UBOUND(Srcread_upwind_resultData%TI_downstream,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%TI_downstream)) THEN - ALLOCATE(Dstread_upwind_resultData%TI_downstream(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%TI_downstream.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%TI_downstream = Srcread_upwind_resultData%TI_downstream -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%small_scale_TI_downstream)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%small_scale_TI_downstream,1) - i1_u = UBOUND(Srcread_upwind_resultData%small_scale_TI_downstream,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%small_scale_TI_downstream)) THEN - ALLOCATE(Dstread_upwind_resultData%small_scale_TI_downstream(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%small_scale_TI_downstream.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%small_scale_TI_downstream = Srcread_upwind_resultData%small_scale_TI_downstream -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%smoothed_velocity_array)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%smoothed_velocity_array,1) - i1_u = UBOUND(Srcread_upwind_resultData%smoothed_velocity_array,1) - i2_l = LBOUND(Srcread_upwind_resultData%smoothed_velocity_array,2) - i2_u = UBOUND(Srcread_upwind_resultData%smoothed_velocity_array,2) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%smoothed_velocity_array)) THEN - ALLOCATE(Dstread_upwind_resultData%smoothed_velocity_array(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%smoothed_velocity_array = Srcread_upwind_resultData%smoothed_velocity_array -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%vel_matrix)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%vel_matrix,1) - i1_u = UBOUND(Srcread_upwind_resultData%vel_matrix,1) - i2_l = LBOUND(Srcread_upwind_resultData%vel_matrix,2) - i2_u = UBOUND(Srcread_upwind_resultData%vel_matrix,2) - i3_l = LBOUND(Srcread_upwind_resultData%vel_matrix,3) - i3_u = UBOUND(Srcread_upwind_resultData%vel_matrix,3) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%vel_matrix)) THEN - ALLOCATE(Dstread_upwind_resultData%vel_matrix(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%vel_matrix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%vel_matrix = Srcread_upwind_resultData%vel_matrix -ENDIF - END SUBROUTINE DWM_Copyread_upwind_result - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyread_upwind_result' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(read_upwind_resultData%upwind_U)) THEN - DEALLOCATE(read_upwind_resultData%upwind_U) -ENDIF -IF (ALLOCATED(read_upwind_resultData%upwind_wakecenter)) THEN - DEALLOCATE(read_upwind_resultData%upwind_wakecenter) -ENDIF -IF (ALLOCATED(read_upwind_resultData%upwind_meanU)) THEN - DEALLOCATE(read_upwind_resultData%upwind_meanU) -ENDIF -IF (ALLOCATED(read_upwind_resultData%upwind_TI)) THEN - DEALLOCATE(read_upwind_resultData%upwind_TI) -ENDIF -IF (ALLOCATED(read_upwind_resultData%upwind_small_TI)) THEN - DEALLOCATE(read_upwind_resultData%upwind_small_TI) -ENDIF -IF (ALLOCATED(read_upwind_resultData%upwind_smoothWake)) THEN - DEALLOCATE(read_upwind_resultData%upwind_smoothWake) -ENDIF -IF (ALLOCATED(read_upwind_resultData%velocity_aerodyn)) THEN - DEALLOCATE(read_upwind_resultData%velocity_aerodyn) -ENDIF -IF (ALLOCATED(read_upwind_resultData%TI_downstream)) THEN - DEALLOCATE(read_upwind_resultData%TI_downstream) -ENDIF -IF (ALLOCATED(read_upwind_resultData%small_scale_TI_downstream)) THEN - DEALLOCATE(read_upwind_resultData%small_scale_TI_downstream) -ENDIF -IF (ALLOCATED(read_upwind_resultData%smoothed_velocity_array)) THEN - DEALLOCATE(read_upwind_resultData%smoothed_velocity_array) -ENDIF -IF (ALLOCATED(read_upwind_resultData%vel_matrix)) THEN - DEALLOCATE(read_upwind_resultData%vel_matrix) -ENDIF - END SUBROUTINE DWM_Destroyread_upwind_result - - SUBROUTINE DWM_Packread_upwind_result( 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(read_upwind_result), 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 = 'DWM_Packread_upwind_result' - ! 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 ! upwind_U allocated yes/no - IF ( ALLOCATED(InData%upwind_U) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! upwind_U upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_U) ! upwind_U - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_wakecenter allocated yes/no - IF ( ALLOCATED(InData%upwind_wakecenter) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! upwind_wakecenter upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_wakecenter) ! upwind_wakecenter - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_meanU allocated yes/no - IF ( ALLOCATED(InData%upwind_meanU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_meanU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_meanU) ! upwind_meanU - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_TI allocated yes/no - IF ( ALLOCATED(InData%upwind_TI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_TI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_TI) ! upwind_TI - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_small_TI allocated yes/no - IF ( ALLOCATED(InData%upwind_small_TI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_small_TI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_small_TI) ! upwind_small_TI - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_smoothWake allocated yes/no - IF ( ALLOCATED(InData%upwind_smoothWake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! upwind_smoothWake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_smoothWake) ! upwind_smoothWake - END IF - Int_BufSz = Int_BufSz + 1 ! velocity_aerodyn allocated yes/no - IF ( ALLOCATED(InData%velocity_aerodyn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! velocity_aerodyn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%velocity_aerodyn) ! velocity_aerodyn - END IF - Int_BufSz = Int_BufSz + 1 ! TI_downstream allocated yes/no - IF ( ALLOCATED(InData%TI_downstream) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TI_downstream upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_downstream) ! TI_downstream - END IF - Int_BufSz = Int_BufSz + 1 ! small_scale_TI_downstream allocated yes/no - IF ( ALLOCATED(InData%small_scale_TI_downstream) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! small_scale_TI_downstream upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%small_scale_TI_downstream) ! small_scale_TI_downstream - END IF - Int_BufSz = Int_BufSz + 1 ! smoothed_velocity_array allocated yes/no - IF ( ALLOCATED(InData%smoothed_velocity_array) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! smoothed_velocity_array upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%smoothed_velocity_array) ! smoothed_velocity_array - END IF - Int_BufSz = Int_BufSz + 1 ! vel_matrix allocated yes/no - IF ( ALLOCATED(InData%vel_matrix) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vel_matrix upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vel_matrix) ! vel_matrix - 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%upwind_U) ) 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%upwind_U,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_U,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_U,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_U,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%upwind_U,2), UBOUND(InData%upwind_U,2) - DO i1 = LBOUND(InData%upwind_U,1), UBOUND(InData%upwind_U,1) - ReKiBuf(Re_Xferred) = InData%upwind_U(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_wakecenter) ) 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%upwind_wakecenter,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_wakecenter,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_wakecenter,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_wakecenter,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_wakecenter,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_wakecenter,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_wakecenter,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_wakecenter,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%upwind_wakecenter,4), UBOUND(InData%upwind_wakecenter,4) - DO i3 = LBOUND(InData%upwind_wakecenter,3), UBOUND(InData%upwind_wakecenter,3) - DO i2 = LBOUND(InData%upwind_wakecenter,2), UBOUND(InData%upwind_wakecenter,2) - DO i1 = LBOUND(InData%upwind_wakecenter,1), UBOUND(InData%upwind_wakecenter,1) - ReKiBuf(Re_Xferred) = InData%upwind_wakecenter(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_meanU) ) 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%upwind_meanU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_meanU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_meanU,1), UBOUND(InData%upwind_meanU,1) - ReKiBuf(Re_Xferred) = InData%upwind_meanU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_TI) ) 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%upwind_TI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_TI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_TI,1), UBOUND(InData%upwind_TI,1) - ReKiBuf(Re_Xferred) = InData%upwind_TI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_small_TI) ) 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%upwind_small_TI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_small_TI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_small_TI,1), UBOUND(InData%upwind_small_TI,1) - ReKiBuf(Re_Xferred) = InData%upwind_small_TI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_smoothWake) ) 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%upwind_smoothWake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_smoothWake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_smoothWake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_smoothWake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%upwind_smoothWake,2), UBOUND(InData%upwind_smoothWake,2) - DO i1 = LBOUND(InData%upwind_smoothWake,1), UBOUND(InData%upwind_smoothWake,1) - ReKiBuf(Re_Xferred) = InData%upwind_smoothWake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%velocity_aerodyn) ) 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%velocity_aerodyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%velocity_aerodyn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%velocity_aerodyn,1), UBOUND(InData%velocity_aerodyn,1) - ReKiBuf(Re_Xferred) = InData%velocity_aerodyn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI_downstream) ) 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%TI_downstream,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_downstream,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TI_downstream,1), UBOUND(InData%TI_downstream,1) - ReKiBuf(Re_Xferred) = InData%TI_downstream(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%small_scale_TI_downstream) ) 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%small_scale_TI_downstream,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%small_scale_TI_downstream,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%small_scale_TI_downstream,1), UBOUND(InData%small_scale_TI_downstream,1) - ReKiBuf(Re_Xferred) = InData%small_scale_TI_downstream(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%smoothed_velocity_array) ) 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%smoothed_velocity_array,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%smoothed_velocity_array,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%smoothed_velocity_array,2), UBOUND(InData%smoothed_velocity_array,2) - DO i1 = LBOUND(InData%smoothed_velocity_array,1), UBOUND(InData%smoothed_velocity_array,1) - ReKiBuf(Re_Xferred) = InData%smoothed_velocity_array(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vel_matrix) ) 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%vel_matrix,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vel_matrix,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vel_matrix,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vel_matrix,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vel_matrix,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vel_matrix,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vel_matrix,3), UBOUND(InData%vel_matrix,3) - DO i2 = LBOUND(InData%vel_matrix,2), UBOUND(InData%vel_matrix,2) - DO i1 = LBOUND(InData%vel_matrix,1), UBOUND(InData%vel_matrix,1) - ReKiBuf(Re_Xferred) = InData%vel_matrix(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE DWM_Packread_upwind_result - - SUBROUTINE DWM_UnPackread_upwind_result( 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(read_upwind_result), 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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackread_upwind_result' - ! 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 ! upwind_U 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%upwind_U)) DEALLOCATE(OutData%upwind_U) - ALLOCATE(OutData%upwind_U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%upwind_U,2), UBOUND(OutData%upwind_U,2) - DO i1 = LBOUND(OutData%upwind_U,1), UBOUND(OutData%upwind_U,1) - OutData%upwind_U(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_wakecenter 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%upwind_wakecenter)) DEALLOCATE(OutData%upwind_wakecenter) - ALLOCATE(OutData%upwind_wakecenter(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%upwind_wakecenter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%upwind_wakecenter,4), UBOUND(OutData%upwind_wakecenter,4) - DO i3 = LBOUND(OutData%upwind_wakecenter,3), UBOUND(OutData%upwind_wakecenter,3) - DO i2 = LBOUND(OutData%upwind_wakecenter,2), UBOUND(OutData%upwind_wakecenter,2) - DO i1 = LBOUND(OutData%upwind_wakecenter,1), UBOUND(OutData%upwind_wakecenter,1) - OutData%upwind_wakecenter(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_meanU 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%upwind_meanU)) DEALLOCATE(OutData%upwind_meanU) - ALLOCATE(OutData%upwind_meanU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_meanU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_meanU,1), UBOUND(OutData%upwind_meanU,1) - OutData%upwind_meanU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_TI 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%upwind_TI)) DEALLOCATE(OutData%upwind_TI) - ALLOCATE(OutData%upwind_TI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_TI,1), UBOUND(OutData%upwind_TI,1) - OutData%upwind_TI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_small_TI 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%upwind_small_TI)) DEALLOCATE(OutData%upwind_small_TI) - ALLOCATE(OutData%upwind_small_TI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_small_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_small_TI,1), UBOUND(OutData%upwind_small_TI,1) - OutData%upwind_small_TI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_smoothWake 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%upwind_smoothWake)) DEALLOCATE(OutData%upwind_smoothWake) - ALLOCATE(OutData%upwind_smoothWake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_smoothWake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%upwind_smoothWake,2), UBOUND(OutData%upwind_smoothWake,2) - DO i1 = LBOUND(OutData%upwind_smoothWake,1), UBOUND(OutData%upwind_smoothWake,1) - OutData%upwind_smoothWake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! velocity_aerodyn 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%velocity_aerodyn)) DEALLOCATE(OutData%velocity_aerodyn) - ALLOCATE(OutData%velocity_aerodyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocity_aerodyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%velocity_aerodyn,1), UBOUND(OutData%velocity_aerodyn,1) - OutData%velocity_aerodyn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_downstream 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%TI_downstream)) DEALLOCATE(OutData%TI_downstream) - ALLOCATE(OutData%TI_downstream(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TI_downstream,1), UBOUND(OutData%TI_downstream,1) - OutData%TI_downstream(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! small_scale_TI_downstream 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%small_scale_TI_downstream)) DEALLOCATE(OutData%small_scale_TI_downstream) - ALLOCATE(OutData%small_scale_TI_downstream(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%small_scale_TI_downstream.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%small_scale_TI_downstream,1), UBOUND(OutData%small_scale_TI_downstream,1) - OutData%small_scale_TI_downstream(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_velocity_array 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%smoothed_velocity_array)) DEALLOCATE(OutData%smoothed_velocity_array) - ALLOCATE(OutData%smoothed_velocity_array(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%smoothed_velocity_array,2), UBOUND(OutData%smoothed_velocity_array,2) - DO i1 = LBOUND(OutData%smoothed_velocity_array,1), UBOUND(OutData%smoothed_velocity_array,1) - OutData%smoothed_velocity_array(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vel_matrix 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%vel_matrix)) DEALLOCATE(OutData%vel_matrix) - ALLOCATE(OutData%vel_matrix(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%vel_matrix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vel_matrix,3), UBOUND(OutData%vel_matrix,3) - DO i2 = LBOUND(OutData%vel_matrix,2), UBOUND(OutData%vel_matrix,2) - DO i1 = LBOUND(OutData%vel_matrix,1), UBOUND(OutData%vel_matrix,1) - OutData%vel_matrix(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE DWM_UnPackread_upwind_result - - SUBROUTINE DWM_Copywake_meandered_center( Srcwake_meandered_centerData, Dstwake_meandered_centerData, CtrlCode, ErrStat, ErrMsg ) - TYPE(wake_meandered_center), INTENT(IN) :: Srcwake_meandered_centerData - TYPE(wake_meandered_center), INTENT(INOUT) :: Dstwake_meandered_centerData - 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 = 'DWM_Copywake_meandered_center' -! + ErrMsg = '' + if (allocated(SrcWeiMethodData%sweptarea)) then + LB(1:1) = lbound(SrcWeiMethodData%sweptarea) + UB(1:1) = ubound(SrcWeiMethodData%sweptarea) + if (.not. allocated(DstWeiMethodData%sweptarea)) then + allocate(DstWeiMethodData%sweptarea(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWeiMethodData%sweptarea.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWeiMethodData%sweptarea = SrcWeiMethodData%sweptarea + end if + DstWeiMethodData%weighting_denominator = SrcWeiMethodData%weighting_denominator +end subroutine + +subroutine DWM_DestroyWeiMethod(WeiMethodData, ErrStat, ErrMsg) + type(WeiMethod), intent(inout) :: WeiMethodData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_DestroyWeiMethod' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(Srcwake_meandered_centerData%wake_width)) THEN - i1_l = LBOUND(Srcwake_meandered_centerData%wake_width,1) - i1_u = UBOUND(Srcwake_meandered_centerData%wake_width,1) - IF (.NOT. ALLOCATED(Dstwake_meandered_centerData%wake_width)) THEN - ALLOCATE(Dstwake_meandered_centerData%wake_width(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstwake_meandered_centerData%wake_width.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstwake_meandered_centerData%wake_width = Srcwake_meandered_centerData%wake_width -ENDIF - END SUBROUTINE DWM_Copywake_meandered_center - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroywake_meandered_center' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(wake_meandered_centerData%wake_width)) THEN - DEALLOCATE(wake_meandered_centerData%wake_width) -ENDIF - END SUBROUTINE DWM_Destroywake_meandered_center - - SUBROUTINE DWM_Packwake_meandered_center( 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(wake_meandered_center), 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 = 'DWM_Packwake_meandered_center' - ! 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 ! wake_width allocated yes/no - IF ( ALLOCATED(InData%wake_width) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! wake_width upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%wake_width) ! wake_width - 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%wake_width) ) 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%wake_width,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_width,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%wake_width,1), UBOUND(InData%wake_width,1) - IntKiBuf(Int_Xferred) = InData%wake_width(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE DWM_Packwake_meandered_center - - SUBROUTINE DWM_UnPackwake_meandered_center( 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(wake_meandered_center), 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 = 'DWM_UnPackwake_meandered_center' - ! 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 ! wake_width 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%wake_width)) DEALLOCATE(OutData%wake_width) - ALLOCATE(OutData%wake_width(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_width.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%wake_width,1), UBOUND(OutData%wake_width,1) - OutData%wake_width(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE DWM_UnPackwake_meandered_center - - SUBROUTINE DWM_Copyturbine_blade( Srcturbine_bladeData, Dstturbine_bladeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_turbine_blade), INTENT(IN) :: Srcturbine_bladeData - TYPE(DWM_turbine_blade), INTENT(INOUT) :: Dstturbine_bladeData - 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 = 'DWM_Copyturbine_blade' -! + ErrMsg = '' + if (allocated(WeiMethodData%sweptarea)) then + deallocate(WeiMethodData%sweptarea) + end if +end subroutine + +subroutine DWM_PackWeiMethod(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WeiMethod), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackWeiMethod' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%sweptarea)) + if (allocated(InData%sweptarea)) then + call RegPackBounds(Buf, 1, lbound(InData%sweptarea), ubound(InData%sweptarea)) + call RegPack(Buf, InData%sweptarea) + end if + call RegPack(Buf, InData%weighting_denominator) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackWeiMethod(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WeiMethod), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackWeiMethod' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%sweptarea)) deallocate(OutData%sweptarea) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%sweptarea(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%sweptarea.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%sweptarea) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%weighting_denominator) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_CopyTIDownstream(SrcTIDownstreamData, DstTIDownstreamData, CtrlCode, ErrStat, ErrMsg) + type(TIDownstream), intent(in) :: SrcTIDownstreamData + type(TIDownstream), intent(inout) :: DstTIDownstreamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_CopyTIDownstream' ErrStat = ErrID_None - ErrMsg = "" - Dstturbine_bladeData%Aerodyn_turbine_num = Srcturbine_bladeData%Aerodyn_turbine_num - Dstturbine_bladeData%Blade_index = Srcturbine_bladeData%Blade_index - Dstturbine_bladeData%Element_index = Srcturbine_bladeData%Element_index - END SUBROUTINE DWM_Copyturbine_blade - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyturbine_blade' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DWM_Destroyturbine_blade - - SUBROUTINE DWM_Packturbine_blade( 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(DWM_turbine_blade), 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 = 'DWM_Packturbine_blade' - ! 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 ! Aerodyn_turbine_num - Int_BufSz = Int_BufSz + 1 ! Blade_index - Int_BufSz = Int_BufSz + 1 ! Element_index - 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%Aerodyn_turbine_num - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Blade_index - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Element_index - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_Packturbine_blade - - SUBROUTINE DWM_UnPackturbine_blade( 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(DWM_turbine_blade), 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 = 'DWM_UnPackturbine_blade' - ! 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%Aerodyn_turbine_num = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Blade_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Element_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_UnPackturbine_blade - - SUBROUTINE DWM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_ParameterType), INTENT(IN) :: SrcParamData - TYPE(DWM_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyParam' -! + ErrMsg = '' + if (allocated(SrcTIDownstreamData%TI_downstream_matrix)) then + LB(1:2) = lbound(SrcTIDownstreamData%TI_downstream_matrix) + UB(1:2) = ubound(SrcTIDownstreamData%TI_downstream_matrix) + if (.not. allocated(DstTIDownstreamData%TI_downstream_matrix)) then + allocate(DstTIDownstreamData%TI_downstream_matrix(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTIDownstreamData%TI_downstream_matrix.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTIDownstreamData%TI_downstream_matrix = SrcTIDownstreamData%TI_downstream_matrix + end if + DstTIDownstreamData%i = SrcTIDownstreamData%i + DstTIDownstreamData%j = SrcTIDownstreamData%j + DstTIDownstreamData%k = SrcTIDownstreamData%k + DstTIDownstreamData%cross_plane_position_ds = SrcTIDownstreamData%cross_plane_position_ds + DstTIDownstreamData%cross_plane_position_TI = SrcTIDownstreamData%cross_plane_position_TI + DstTIDownstreamData%distance_index = SrcTIDownstreamData%distance_index + DstTIDownstreamData%counter1 = SrcTIDownstreamData%counter1 + DstTIDownstreamData%counter2 = SrcTIDownstreamData%counter2 + DstTIDownstreamData%initial_timestep = SrcTIDownstreamData%initial_timestep + DstTIDownstreamData%y_axis_turbine = SrcTIDownstreamData%y_axis_turbine + DstTIDownstreamData%z_axis_turbine = SrcTIDownstreamData%z_axis_turbine + DstTIDownstreamData%distance = SrcTIDownstreamData%distance + DstTIDownstreamData%TI_downstream_node = SrcTIDownstreamData%TI_downstream_node + DstTIDownstreamData%TI_node_temp = SrcTIDownstreamData%TI_node_temp + DstTIDownstreamData%TI_node = SrcTIDownstreamData%TI_node + DstTIDownstreamData%TI_accumulation = SrcTIDownstreamData%TI_accumulation + DstTIDownstreamData%TI_apprant_accumulation = SrcTIDownstreamData%TI_apprant_accumulation + DstTIDownstreamData%TI_average = SrcTIDownstreamData%TI_average + DstTIDownstreamData%TI_apprant = SrcTIDownstreamData%TI_apprant + DstTIDownstreamData%HubHt = SrcTIDownstreamData%HubHt + DstTIDownstreamData%wake_center_y = SrcTIDownstreamData%wake_center_y + DstTIDownstreamData%wake_center_z = SrcTIDownstreamData%wake_center_z + DstTIDownstreamData%Rscale = SrcTIDownstreamData%Rscale + DstTIDownstreamData%y = SrcTIDownstreamData%y + DstTIDownstreamData%z = SrcTIDownstreamData%z + DstTIDownstreamData%zero_spacing = SrcTIDownstreamData%zero_spacing + DstTIDownstreamData%temp1 = SrcTIDownstreamData%temp1 + DstTIDownstreamData%temp2 = SrcTIDownstreamData%temp2 + DstTIDownstreamData%temp3 = SrcTIDownstreamData%temp3 +end subroutine + +subroutine DWM_DestroyTIDownstream(TIDownstreamData, ErrStat, ErrMsg) + type(TIDownstream), intent(inout) :: TIDownstreamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_DestroyTIDownstream' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcParamData%velocityU)) THEN - i1_l = LBOUND(SrcParamData%velocityU,1) - i1_u = UBOUND(SrcParamData%velocityU,1) - IF (.NOT. ALLOCATED(DstParamData%velocityU)) THEN - ALLOCATE(DstParamData%velocityU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%velocityU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%velocityU = SrcParamData%velocityU -ENDIF -IF (ALLOCATED(SrcParamData%smoothed_wake)) THEN - i1_l = LBOUND(SrcParamData%smoothed_wake,1) - i1_u = UBOUND(SrcParamData%smoothed_wake,1) - IF (.NOT. ALLOCATED(DstParamData%smoothed_wake)) THEN - ALLOCATE(DstParamData%smoothed_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%smoothed_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%smoothed_wake = SrcParamData%smoothed_wake -ENDIF -IF (ALLOCATED(SrcParamData%WakePosition)) THEN - i1_l = LBOUND(SrcParamData%WakePosition,1) - i1_u = UBOUND(SrcParamData%WakePosition,1) - i2_l = LBOUND(SrcParamData%WakePosition,2) - i2_u = UBOUND(SrcParamData%WakePosition,2) - i3_l = LBOUND(SrcParamData%WakePosition,3) - i3_u = UBOUND(SrcParamData%WakePosition,3) - IF (.NOT. ALLOCATED(DstParamData%WakePosition)) THEN - ALLOCATE(DstParamData%WakePosition(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%WakePosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WakePosition = SrcParamData%WakePosition -ENDIF - DstParamData%WakePosition_1 = SrcParamData%WakePosition_1 - DstParamData%WakePosition_2 = SrcParamData%WakePosition_2 - DstParamData%smooth_flag = SrcParamData%smooth_flag - DstParamData%p_p_r = SrcParamData%p_p_r - DstParamData%NumWT = SrcParamData%NumWT - DstParamData%Tinfluencer = SrcParamData%Tinfluencer - DstParamData%RotorR = SrcParamData%RotorR - DstParamData%r_domain = SrcParamData%r_domain - DstParamData%x_domain = SrcParamData%x_domain - DstParamData%Uambient = SrcParamData%Uambient - DstParamData%TI_amb = SrcParamData%TI_amb - DstParamData%TI_wake = SrcParamData%TI_wake - DstParamData%hub_height = SrcParamData%hub_height - DstParamData%length_velocityU = SrcParamData%length_velocityU - DstParamData%WFLowerBd = SrcParamData%WFLowerBd - DstParamData%Wind_file_Mean_u = SrcParamData%Wind_file_Mean_u - DstParamData%Winddir = SrcParamData%Winddir - DstParamData%air_density = SrcParamData%air_density - DstParamData%RR = SrcParamData%RR -IF (ALLOCATED(SrcParamData%ElementRad)) THEN - i1_l = LBOUND(SrcParamData%ElementRad,1) - i1_u = UBOUND(SrcParamData%ElementRad,1) - IF (.NOT. ALLOCATED(DstParamData%ElementRad)) THEN - ALLOCATE(DstParamData%ElementRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElementRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ElementRad = SrcParamData%ElementRad -ENDIF - DstParamData%Bnum = SrcParamData%Bnum - DstParamData%ElementNum = SrcParamData%ElementNum - CALL DWM_Copyread_turbine_position_data( SrcParamData%RTPD, DstParamData%RTPD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyParam( SrcParamData%IfW, DstParamData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyParam - - SUBROUTINE DWM_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(DWM_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 = 'DWM_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%velocityU)) THEN - DEALLOCATE(ParamData%velocityU) -ENDIF -IF (ALLOCATED(ParamData%smoothed_wake)) THEN - DEALLOCATE(ParamData%smoothed_wake) -ENDIF -IF (ALLOCATED(ParamData%WakePosition)) THEN - DEALLOCATE(ParamData%WakePosition) -ENDIF -IF (ALLOCATED(ParamData%ElementRad)) THEN - DEALLOCATE(ParamData%ElementRad) -ENDIF - CALL DWM_Destroyread_turbine_position_data( ParamData%RTPD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyParam( ParamData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyParam - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - Int_BufSz = Int_BufSz + 1 ! velocityU allocated yes/no - IF ( ALLOCATED(InData%velocityU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! velocityU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%velocityU) ! velocityU - END IF - Int_BufSz = Int_BufSz + 1 ! smoothed_wake allocated yes/no - IF ( ALLOCATED(InData%smoothed_wake) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! smoothed_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%smoothed_wake) ! smoothed_wake - END IF - Int_BufSz = Int_BufSz + 1 ! WakePosition allocated yes/no - IF ( ALLOCATED(InData%WakePosition) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WakePosition upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WakePosition) ! WakePosition - END IF - Int_BufSz = Int_BufSz + 1 ! WakePosition_1 - Int_BufSz = Int_BufSz + 1 ! WakePosition_2 - Int_BufSz = Int_BufSz + 1 ! smooth_flag - Int_BufSz = Int_BufSz + 1 ! p_p_r - Int_BufSz = Int_BufSz + 1 ! NumWT - Int_BufSz = Int_BufSz + 1 ! Tinfluencer - Re_BufSz = Re_BufSz + 1 ! RotorR - Re_BufSz = Re_BufSz + 1 ! r_domain - Re_BufSz = Re_BufSz + 1 ! x_domain - Re_BufSz = Re_BufSz + 1 ! Uambient - Re_BufSz = Re_BufSz + 1 ! TI_amb - Re_BufSz = Re_BufSz + 1 ! TI_wake - Re_BufSz = Re_BufSz + 1 ! hub_height - Re_BufSz = Re_BufSz + 1 ! length_velocityU - Re_BufSz = Re_BufSz + 1 ! WFLowerBd - Re_BufSz = Re_BufSz + 1 ! Wind_file_Mean_u - Re_BufSz = Re_BufSz + 1 ! Winddir - Re_BufSz = Re_BufSz + 1 ! air_density - Re_BufSz = Re_BufSz + 1 ! RR - Int_BufSz = Int_BufSz + 1 ! ElementRad allocated yes/no - IF ( ALLOCATED(InData%ElementRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElementRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ElementRad) ! ElementRad - END IF - Int_BufSz = Int_BufSz + 1 ! Bnum - Int_BufSz = Int_BufSz + 1 ! ElementNum - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! RTPD: size of buffers for each call to pack subtype - CALL DWM_Packread_turbine_position_data( Re_Buf, Db_Buf, Int_Buf, InData%RTPD, ErrStat2, ErrMsg2, .TRUE. ) ! RTPD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RTPD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RTPD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RTPD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 - - IF ( .NOT. ALLOCATED(InData%velocityU) ) 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%velocityU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%velocityU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%velocityU,1), UBOUND(InData%velocityU,1) - ReKiBuf(Re_Xferred) = InData%velocityU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%smoothed_wake) ) 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%smoothed_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_wake,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%smoothed_wake,1), UBOUND(InData%smoothed_wake,1) - ReKiBuf(Re_Xferred) = InData%smoothed_wake(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WakePosition) ) 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%WakePosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakePosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WakePosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakePosition,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WakePosition,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakePosition,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WakePosition,3), UBOUND(InData%WakePosition,3) - DO i2 = LBOUND(InData%WakePosition,2), UBOUND(InData%WakePosition,2) - DO i1 = LBOUND(InData%WakePosition,1), UBOUND(InData%WakePosition,1) - ReKiBuf(Re_Xferred) = InData%WakePosition(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%WakePosition_1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WakePosition_2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%smooth_flag - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%p_p_r - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumWT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Tinfluencer - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotorR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%r_domain - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%x_domain - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Uambient - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_amb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_wake - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%hub_height - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%length_velocityU - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WFLowerBd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Wind_file_Mean_u - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Winddir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%air_density - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RR - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ElementRad) ) 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%ElementRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElementRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ElementRad,1), UBOUND(InData%ElementRad,1) - ReKiBuf(Re_Xferred) = InData%ElementRad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Bnum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ElementNum - Int_Xferred = Int_Xferred + 1 - CALL DWM_Packread_turbine_position_data( Re_Buf, Db_Buf, Int_Buf, InData%RTPD, ErrStat2, ErrMsg2, OnlySize ) ! RTPD - 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 - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackParam - - SUBROUTINE DWM_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(DWM_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! velocityU 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%velocityU)) DEALLOCATE(OutData%velocityU) - ALLOCATE(OutData%velocityU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocityU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%velocityU,1), UBOUND(OutData%velocityU,1) - OutData%velocityU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_wake 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%smoothed_wake)) DEALLOCATE(OutData%smoothed_wake) - ALLOCATE(OutData%smoothed_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%smoothed_wake,1), UBOUND(OutData%smoothed_wake,1) - OutData%smoothed_wake(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WakePosition 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%WakePosition)) DEALLOCATE(OutData%WakePosition) - ALLOCATE(OutData%WakePosition(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%WakePosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WakePosition,3), UBOUND(OutData%WakePosition,3) - DO i2 = LBOUND(OutData%WakePosition,2), UBOUND(OutData%WakePosition,2) - DO i1 = LBOUND(OutData%WakePosition,1), UBOUND(OutData%WakePosition,1) - OutData%WakePosition(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%WakePosition_1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakePosition_2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%smooth_flag = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%p_p_r = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumWT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Tinfluencer = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RotorR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%r_domain = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%x_domain = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Uambient = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_amb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_wake = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%hub_height = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%length_velocityU = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WFLowerBd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Wind_file_Mean_u = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Winddir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%air_density = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElementRad 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%ElementRad)) DEALLOCATE(OutData%ElementRad) - ALLOCATE(OutData%ElementRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElementRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElementRad,1), UBOUND(OutData%ElementRad,1) - OutData%ElementRad(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Bnum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ElementNum = 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 DWM_Unpackread_turbine_position_data( Re_Buf, Db_Buf, Int_Buf, OutData%RTPD, ErrStat2, ErrMsg2 ) ! RTPD - 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) - 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 InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackParam - - SUBROUTINE DWM_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(DWM_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 = 'DWM_CopyOtherState' -! + ErrMsg = '' + if (allocated(TIDownstreamData%TI_downstream_matrix)) then + deallocate(TIDownstreamData%TI_downstream_matrix) + end if +end subroutine + +subroutine DWM_PackTIDownstream(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TIDownstream), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackTIDownstream' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%TI_downstream_matrix)) + if (allocated(InData%TI_downstream_matrix)) then + call RegPackBounds(Buf, 2, lbound(InData%TI_downstream_matrix), ubound(InData%TI_downstream_matrix)) + call RegPack(Buf, InData%TI_downstream_matrix) + end if + call RegPack(Buf, InData%i) + call RegPack(Buf, InData%j) + call RegPack(Buf, InData%k) + call RegPack(Buf, InData%cross_plane_position_ds) + call RegPack(Buf, InData%cross_plane_position_TI) + call RegPack(Buf, InData%distance_index) + call RegPack(Buf, InData%counter1) + call RegPack(Buf, InData%counter2) + call RegPack(Buf, InData%initial_timestep) + call RegPack(Buf, InData%y_axis_turbine) + call RegPack(Buf, InData%z_axis_turbine) + call RegPack(Buf, InData%distance) + call RegPack(Buf, InData%TI_downstream_node) + call RegPack(Buf, InData%TI_node_temp) + call RegPack(Buf, InData%TI_node) + call RegPack(Buf, InData%TI_accumulation) + call RegPack(Buf, InData%TI_apprant_accumulation) + call RegPack(Buf, InData%TI_average) + call RegPack(Buf, InData%TI_apprant) + call RegPack(Buf, InData%HubHt) + call RegPack(Buf, InData%wake_center_y) + call RegPack(Buf, InData%wake_center_z) + call RegPack(Buf, InData%Rscale) + call RegPack(Buf, InData%y) + call RegPack(Buf, InData%z) + call RegPack(Buf, InData%zero_spacing) + call RegPack(Buf, InData%temp1) + call RegPack(Buf, InData%temp2) + call RegPack(Buf, InData%temp3) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackTIDownstream(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TIDownstream), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackTIDownstream' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%TI_downstream_matrix)) deallocate(OutData%TI_downstream_matrix) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TI_downstream_matrix(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream_matrix.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TI_downstream_matrix) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%i) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%j) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%cross_plane_position_ds) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%cross_plane_position_TI) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%distance_index) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%counter1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%counter2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%initial_timestep) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%y_axis_turbine) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%z_axis_turbine) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%distance) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TI_downstream_node) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TI_node_temp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TI_node) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TI_accumulation) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TI_apprant_accumulation) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TI_average) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TI_apprant) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubHt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%wake_center_y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%wake_center_z) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Rscale) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%z) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%zero_spacing) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%temp1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%temp2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%temp3) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_CopyTurbKaimal(SrcTurbKaimalData, DstTurbKaimalData, CtrlCode, ErrStat, ErrMsg) + type(TurbKaimal), intent(in) :: SrcTurbKaimalData + type(TurbKaimal), intent(inout) :: DstTurbKaimalData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_CopyTurbKaimal' ErrStat = ErrID_None - ErrMsg = "" - CALL InflowWind_CopyOtherState( SrcOtherStateData%IfW, DstOtherStateData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyOtherState - - SUBROUTINE DWM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(DWM_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 = 'DWM_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL InflowWind_DestroyOtherState( OtherStateData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyOtherState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 - - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackOtherState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - 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 InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackOtherState - - SUBROUTINE DWM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(DWM_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) :: 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 = 'DWM_CopyMisc' -! + ErrMsg = '' + DstTurbKaimalData%fs = SrcTurbKaimalData%fs + DstTurbKaimalData%temp_n = SrcTurbKaimalData%temp_n + DstTurbKaimalData%i = SrcTurbKaimalData%i + DstTurbKaimalData%low_f = SrcTurbKaimalData%low_f + DstTurbKaimalData%high_f = SrcTurbKaimalData%high_f + DstTurbKaimalData%lk_facor = SrcTurbKaimalData%lk_facor + DstTurbKaimalData%STD = SrcTurbKaimalData%STD +end subroutine + +subroutine DWM_DestroyTurbKaimal(TurbKaimalData, ErrStat, ErrMsg) + type(TurbKaimal), intent(inout) :: TurbKaimalData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_DestroyTurbKaimal' ErrStat = ErrID_None - ErrMsg = "" - CALL InflowWind_CopyMisc( SrcMiscData%IfW, DstMiscData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%position_y = SrcMiscData%position_y - DstMiscData%position_z = SrcMiscData%position_z - DstMiscData%velocity_wake_mean = SrcMiscData%velocity_wake_mean - DstMiscData%shifted_velocity_Aerodyn = SrcMiscData%shifted_velocity_Aerodyn - DstMiscData%U_velocity = SrcMiscData%U_velocity - DstMiscData%V_velocity = SrcMiscData%V_velocity -IF (ALLOCATED(SrcMiscData%Nforce)) THEN - i1_l = LBOUND(SrcMiscData%Nforce,1) - i1_u = UBOUND(SrcMiscData%Nforce,1) - i2_l = LBOUND(SrcMiscData%Nforce,2) - i2_u = UBOUND(SrcMiscData%Nforce,2) - IF (.NOT. ALLOCATED(DstMiscData%Nforce)) THEN - ALLOCATE(DstMiscData%Nforce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Nforce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Nforce = SrcMiscData%Nforce -ENDIF -IF (ALLOCATED(SrcMiscData%blade_dr)) THEN - i1_l = LBOUND(SrcMiscData%blade_dr,1) - i1_u = UBOUND(SrcMiscData%blade_dr,1) - IF (.NOT. ALLOCATED(DstMiscData%blade_dr)) THEN - ALLOCATE(DstMiscData%blade_dr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%blade_dr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%blade_dr = SrcMiscData%blade_dr -ENDIF - DstMiscData%NacYaw = SrcMiscData%NacYaw - DstMiscData%TI_original = SrcMiscData%TI_original - CALL DWM_Copyturbine_average_velocity_data( SrcMiscData%TAVD, DstMiscData%TAVD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copycvsd( SrcMiscData%CalVelScale_data, DstMiscData%CalVelScale_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copymeanderdata( SrcMiscData%meandering_data, DstMiscData%meandering_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copyweimethod( SrcMiscData%weighting_method, DstMiscData%weighting_method, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copytidownstream( SrcMiscData%TI_downstream_data, DstMiscData%TI_downstream_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copyturbkaimal( SrcMiscData%Turbulence_KS, DstMiscData%Turbulence_KS, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copyshinozuka( SrcMiscData%shinozuka_data, DstMiscData%shinozuka_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copysmooth_out_wake_data( SrcMiscData%SmoothOut, DstMiscData%SmoothOut, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copyswsv( SrcMiscData%smooth_wake_shifted_velocity_data, DstMiscData%smooth_wake_shifted_velocity_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copywake_deficit_data( SrcMiscData%DWDD, DstMiscData%DWDD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%ct_tilde = SrcMiscData%ct_tilde - DstMiscData%FAST_Time = SrcMiscData%FAST_Time - DstMiscData%SDtimestep = SrcMiscData%SDtimestep - CALL DWM_Copyturbine_blade( SrcMiscData%DWM_tb, DstMiscData%DWM_tb, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copywake_meandered_center( SrcMiscData%WMC, DstMiscData%WMC, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyMisc - - SUBROUTINE DWM_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(DWM_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 = 'DWM_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL InflowWind_DestroyMisc( MiscData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%Nforce)) THEN - DEALLOCATE(MiscData%Nforce) -ENDIF -IF (ALLOCATED(MiscData%blade_dr)) THEN - DEALLOCATE(MiscData%blade_dr) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyMeanderData( MiscData%meandering_data, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyWeiMethod( MiscData%weighting_method, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyTIDownstream( MiscData%TI_downstream_data, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyTurbKaimal( MiscData%Turbulence_KS, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyMisc - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! position_y - Re_BufSz = Re_BufSz + 1 ! position_z - Re_BufSz = Re_BufSz + 1 ! velocity_wake_mean - Re_BufSz = Re_BufSz + 1 ! shifted_velocity_Aerodyn - Re_BufSz = Re_BufSz + 1 ! U_velocity - Re_BufSz = Re_BufSz + 1 ! V_velocity - Int_BufSz = Int_BufSz + 1 ! Nforce allocated yes/no - IF ( ALLOCATED(InData%Nforce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nforce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Nforce) ! Nforce - END IF - Int_BufSz = Int_BufSz + 1 ! blade_dr allocated yes/no - IF ( ALLOCATED(InData%blade_dr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! blade_dr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%blade_dr) ! blade_dr - END IF - Re_BufSz = Re_BufSz + 1 ! NacYaw - Re_BufSz = Re_BufSz + 1 ! TI_original - Int_BufSz = Int_BufSz + 3 ! TAVD: size of buffers for each call to pack subtype - CALL DWM_Packturbine_average_velocity_data( Re_Buf, Db_Buf, Int_Buf, InData%TAVD, ErrStat2, ErrMsg2, .TRUE. ) ! TAVD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TAVD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TAVD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TAVD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CalVelScale_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CalVelScale_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CalVelScale_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! meandering_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! meandering_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! meandering_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! weighting_method - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! weighting_method - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! weighting_method - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TI_downstream_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TI_downstream_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TI_downstream_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Turbulence_KS - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Turbulence_KS - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Turbulence_KS - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! shinozuka_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! shinozuka_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! shinozuka_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SmoothOut: size of buffers for each call to pack subtype - CALL DWM_Packsmooth_out_wake_data( Re_Buf, Db_Buf, Int_Buf, InData%SmoothOut, ErrStat2, ErrMsg2, .TRUE. ) ! SmoothOut - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SmoothOut - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SmoothOut - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SmoothOut - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! smooth_wake_shifted_velocity_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! smooth_wake_shifted_velocity_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! smooth_wake_shifted_velocity_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWDD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWDD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWDD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! ct_tilde - Re_BufSz = Re_BufSz + 1 ! FAST_Time - Int_BufSz = Int_BufSz + 1 ! SDtimestep - Int_BufSz = Int_BufSz + 3 ! DWM_tb: size of buffers for each call to pack subtype - CALL DWM_Packturbine_blade( Re_Buf, Db_Buf, Int_Buf, InData%DWM_tb, ErrStat2, ErrMsg2, .TRUE. ) ! DWM_tb - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM_tb - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM_tb - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM_tb - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! WMC: size of buffers for each call to pack subtype - CALL DWM_Packwake_meandered_center( Re_Buf, Db_Buf, Int_Buf, InData%WMC, ErrStat2, ErrMsg2, .TRUE. ) ! WMC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WMC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WMC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WMC - 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 - - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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%position_y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%position_z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%velocity_wake_mean - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%shifted_velocity_Aerodyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%U_velocity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%V_velocity - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Nforce) ) 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%Nforce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nforce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nforce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nforce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nforce,2), UBOUND(InData%Nforce,2) - DO i1 = LBOUND(InData%Nforce,1), UBOUND(InData%Nforce,1) - ReKiBuf(Re_Xferred) = InData%Nforce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%blade_dr) ) 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%blade_dr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%blade_dr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%blade_dr,1), UBOUND(InData%blade_dr,1) - ReKiBuf(Re_Xferred) = InData%blade_dr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%NacYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_original - Re_Xferred = Re_Xferred + 1 - CALL DWM_Packturbine_average_velocity_data( Re_Buf, Db_Buf, Int_Buf, InData%TAVD, ErrStat2, ErrMsg2, OnlySize ) ! TAVD - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - CALL DWM_Packsmooth_out_wake_data( Re_Buf, Db_Buf, Int_Buf, InData%SmoothOut, ErrStat2, ErrMsg2, OnlySize ) ! SmoothOut - 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 - 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 - - 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 - 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 - - 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%ct_tilde - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FAST_Time - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SDtimestep - Int_Xferred = Int_Xferred + 1 - CALL DWM_Packturbine_blade( Re_Buf, Db_Buf, Int_Buf, InData%DWM_tb, ErrStat2, ErrMsg2, OnlySize ) ! DWM_tb - 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 - CALL DWM_Packwake_meandered_center( Re_Buf, Db_Buf, Int_Buf, InData%WMC, ErrStat2, ErrMsg2, OnlySize ) ! WMC - 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 DWM_PackMisc - - SUBROUTINE DWM_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(DWM_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) :: 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 = 'DWM_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 - 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 InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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%position_y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%position_z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%velocity_wake_mean = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%shifted_velocity_Aerodyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%U_velocity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%V_velocity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nforce 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%Nforce)) DEALLOCATE(OutData%Nforce) - ALLOCATE(OutData%Nforce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nforce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nforce,2), UBOUND(OutData%Nforce,2) - DO i1 = LBOUND(OutData%Nforce,1), UBOUND(OutData%Nforce,1) - OutData%Nforce(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! blade_dr 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%blade_dr)) DEALLOCATE(OutData%blade_dr) - ALLOCATE(OutData%blade_dr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%blade_dr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%blade_dr,1), UBOUND(OutData%blade_dr,1) - OutData%blade_dr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NacYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_original = ReKiBuf(Re_Xferred) - 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 DWM_Unpackturbine_average_velocity_data( Re_Buf, Db_Buf, Int_Buf, OutData%TAVD, ErrStat2, ErrMsg2 ) ! TAVD - 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) - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 DWM_Unpacksmooth_out_wake_data( Re_Buf, Db_Buf, Int_Buf, OutData%SmoothOut, ErrStat2, ErrMsg2 ) ! SmoothOut - 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) - 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 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 - - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%ct_tilde = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FAST_Time = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SDtimestep = 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 DWM_Unpackturbine_blade( Re_Buf, Db_Buf, Int_Buf, OutData%DWM_tb, ErrStat2, ErrMsg2 ) ! DWM_tb - 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) - 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 DWM_Unpackwake_meandered_center( Re_Buf, Db_Buf, Int_Buf, OutData%WMC, ErrStat2, ErrMsg2 ) ! WMC - 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 DWM_UnPackMisc - - SUBROUTINE DWM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_InputType), INTENT(IN) :: SrcInputData - TYPE(DWM_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 = 'DWM_CopyInput' -! + ErrMsg = '' +end subroutine + +subroutine DWM_PackTurbKaimal(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TurbKaimal), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackTurbKaimal' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%fs) + call RegPack(Buf, InData%temp_n) + call RegPack(Buf, InData%i) + call RegPack(Buf, InData%low_f) + call RegPack(Buf, InData%high_f) + call RegPack(Buf, InData%lk_facor) + call RegPack(Buf, InData%STD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackTurbKaimal(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TurbKaimal), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackTurbKaimal' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%fs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%temp_n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%i) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%low_f) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%high_f) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%lk_facor) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%STD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_CopyShinozuka(SrcShinozukaData, DstShinozukaData, CtrlCode, ErrStat, ErrMsg) + type(Shinozuka), intent(in) :: SrcShinozukaData + type(Shinozuka), intent(inout) :: DstShinozukaData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_CopyShinozuka' ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_Copyread_upwind_result( SrcInputData%Upwind_result, DstInputData%Upwind_result, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcInputData%IfW, DstInputData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyInput - - SUBROUTINE DWM_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(DWM_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 = 'DWM_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL DWM_Destroyread_upwind_result( InputData%Upwind_result, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( InputData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyInput - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Upwind_result: size of buffers for each call to pack subtype - CALL DWM_Packread_upwind_result( Re_Buf, Db_Buf, Int_Buf, InData%Upwind_result, ErrStat2, ErrMsg2, .TRUE. ) ! Upwind_result - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Upwind_result - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Upwind_result - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Upwind_result - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 - - CALL DWM_Packread_upwind_result( Re_Buf, Db_Buf, Int_Buf, InData%Upwind_result, ErrStat2, ErrMsg2, OnlySize ) ! Upwind_result - 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 - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackInput - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - 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 DWM_Unpackread_upwind_result( Re_Buf, Db_Buf, Int_Buf, OutData%Upwind_result, ErrStat2, ErrMsg2 ) ! Upwind_result - 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) - 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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackInput - - SUBROUTINE DWM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_OutputType), INTENT(IN) :: SrcOutputData - TYPE(DWM_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) :: 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 = 'DWM_CopyOutput' -! + ErrMsg = '' + if (allocated(SrcShinozukaData%f_syn)) then + LB(1:1) = lbound(SrcShinozukaData%f_syn) + UB(1:1) = ubound(SrcShinozukaData%f_syn) + if (.not. allocated(DstShinozukaData%f_syn)) then + allocate(DstShinozukaData%f_syn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%f_syn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstShinozukaData%f_syn = SrcShinozukaData%f_syn + end if + if (allocated(SrcShinozukaData%t_syn)) then + LB(1:1) = lbound(SrcShinozukaData%t_syn) + UB(1:1) = ubound(SrcShinozukaData%t_syn) + if (.not. allocated(DstShinozukaData%t_syn)) then + allocate(DstShinozukaData%t_syn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%t_syn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstShinozukaData%t_syn = SrcShinozukaData%t_syn + end if + if (allocated(SrcShinozukaData%phi)) then + LB(1:1) = lbound(SrcShinozukaData%phi) + UB(1:1) = ubound(SrcShinozukaData%phi) + if (.not. allocated(DstShinozukaData%phi)) then + allocate(DstShinozukaData%phi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%phi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstShinozukaData%phi = SrcShinozukaData%phi + end if + if (allocated(SrcShinozukaData%p_k)) then + LB(1:1) = lbound(SrcShinozukaData%p_k) + UB(1:1) = ubound(SrcShinozukaData%p_k) + if (.not. allocated(DstShinozukaData%p_k)) then + allocate(DstShinozukaData%p_k(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%p_k.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstShinozukaData%p_k = SrcShinozukaData%p_k + end if + if (allocated(SrcShinozukaData%a_k)) then + LB(1:1) = lbound(SrcShinozukaData%a_k) + UB(1:1) = ubound(SrcShinozukaData%a_k) + if (.not. allocated(DstShinozukaData%a_k)) then + allocate(DstShinozukaData%a_k(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%a_k.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstShinozukaData%a_k = SrcShinozukaData%a_k + end if + DstShinozukaData%num_points = SrcShinozukaData%num_points + DstShinozukaData%ILo = SrcShinozukaData%ILo + DstShinozukaData%i = SrcShinozukaData%i + DstShinozukaData%j = SrcShinozukaData%j + DstShinozukaData%dt = SrcShinozukaData%dt + DstShinozukaData%t_min = SrcShinozukaData%t_min + DstShinozukaData%t_max = SrcShinozukaData%t_max + DstShinozukaData%df = SrcShinozukaData%df +end subroutine + +subroutine DWM_DestroyShinozuka(ShinozukaData, ErrStat, ErrMsg) + type(Shinozuka), intent(inout) :: ShinozukaData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_DestroyShinozuka' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%turbine_thrust_force)) THEN - i1_l = LBOUND(SrcOutputData%turbine_thrust_force,1) - i1_u = UBOUND(SrcOutputData%turbine_thrust_force,1) - IF (.NOT. ALLOCATED(DstOutputData%turbine_thrust_force)) THEN - ALLOCATE(DstOutputData%turbine_thrust_force(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%turbine_thrust_force.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%turbine_thrust_force = SrcOutputData%turbine_thrust_force -ENDIF -IF (ALLOCATED(SrcOutputData%induction_factor)) THEN - i1_l = LBOUND(SrcOutputData%induction_factor,1) - i1_u = UBOUND(SrcOutputData%induction_factor,1) - IF (.NOT. ALLOCATED(DstOutputData%induction_factor)) THEN - ALLOCATE(DstOutputData%induction_factor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%induction_factor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%induction_factor = SrcOutputData%induction_factor -ENDIF -IF (ALLOCATED(SrcOutputData%r_initial)) THEN - i1_l = LBOUND(SrcOutputData%r_initial,1) - i1_u = UBOUND(SrcOutputData%r_initial,1) - IF (.NOT. ALLOCATED(DstOutputData%r_initial)) THEN - ALLOCATE(DstOutputData%r_initial(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%r_initial.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%r_initial = SrcOutputData%r_initial -ENDIF -IF (ALLOCATED(SrcOutputData%U_initial)) THEN - i1_l = LBOUND(SrcOutputData%U_initial,1) - i1_u = UBOUND(SrcOutputData%U_initial,1) - IF (.NOT. ALLOCATED(DstOutputData%U_initial)) THEN - ALLOCATE(DstOutputData%U_initial(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%U_initial.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%U_initial = SrcOutputData%U_initial -ENDIF -IF (ALLOCATED(SrcOutputData%Mean_FFWS_array)) THEN - i1_l = LBOUND(SrcOutputData%Mean_FFWS_array,1) - i1_u = UBOUND(SrcOutputData%Mean_FFWS_array,1) - IF (.NOT. ALLOCATED(DstOutputData%Mean_FFWS_array)) THEN - ALLOCATE(DstOutputData%Mean_FFWS_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Mean_FFWS_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Mean_FFWS_array = SrcOutputData%Mean_FFWS_array -ENDIF - DstOutputData%Mean_FFWS = SrcOutputData%Mean_FFWS - DstOutputData%TI = SrcOutputData%TI - DstOutputData%TI_downstream = SrcOutputData%TI_downstream -IF (ALLOCATED(SrcOutputData%wake_u)) THEN - i1_l = LBOUND(SrcOutputData%wake_u,1) - i1_u = UBOUND(SrcOutputData%wake_u,1) - i2_l = LBOUND(SrcOutputData%wake_u,2) - i2_u = UBOUND(SrcOutputData%wake_u,2) - IF (.NOT. ALLOCATED(DstOutputData%wake_u)) THEN - ALLOCATE(DstOutputData%wake_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%wake_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%wake_u = SrcOutputData%wake_u -ENDIF -IF (ALLOCATED(SrcOutputData%wake_position)) THEN - i1_l = LBOUND(SrcOutputData%wake_position,1) - i1_u = UBOUND(SrcOutputData%wake_position,1) - i2_l = LBOUND(SrcOutputData%wake_position,2) - i2_u = UBOUND(SrcOutputData%wake_position,2) - i3_l = LBOUND(SrcOutputData%wake_position,3) - i3_u = UBOUND(SrcOutputData%wake_position,3) - IF (.NOT. ALLOCATED(DstOutputData%wake_position)) THEN - ALLOCATE(DstOutputData%wake_position(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%wake_position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%wake_position = SrcOutputData%wake_position -ENDIF -IF (ALLOCATED(SrcOutputData%smoothed_velocity_array)) THEN - i1_l = LBOUND(SrcOutputData%smoothed_velocity_array,1) - i1_u = UBOUND(SrcOutputData%smoothed_velocity_array,1) - i2_l = LBOUND(SrcOutputData%smoothed_velocity_array,2) - i2_u = UBOUND(SrcOutputData%smoothed_velocity_array,2) - IF (.NOT. ALLOCATED(DstOutputData%smoothed_velocity_array)) THEN - ALLOCATE(DstOutputData%smoothed_velocity_array(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%smoothed_velocity_array = SrcOutputData%smoothed_velocity_array -ENDIF - DstOutputData%AtmUscale = SrcOutputData%AtmUscale - DstOutputData%du_dz_ABL = SrcOutputData%du_dz_ABL - DstOutputData%total_SDgenpwr = SrcOutputData%total_SDgenpwr - DstOutputData%mean_SDgenpwr = SrcOutputData%mean_SDgenpwr - DstOutputData%avg_ct = SrcOutputData%avg_ct - CALL InflowWind_CopyOutput( SrcOutputData%IfW, DstOutputData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyOutput - - SUBROUTINE DWM_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(DWM_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 = 'DWM_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%turbine_thrust_force)) THEN - DEALLOCATE(OutputData%turbine_thrust_force) -ENDIF -IF (ALLOCATED(OutputData%induction_factor)) THEN - DEALLOCATE(OutputData%induction_factor) -ENDIF -IF (ALLOCATED(OutputData%r_initial)) THEN - DEALLOCATE(OutputData%r_initial) -ENDIF -IF (ALLOCATED(OutputData%U_initial)) THEN - DEALLOCATE(OutputData%U_initial) -ENDIF -IF (ALLOCATED(OutputData%Mean_FFWS_array)) THEN - DEALLOCATE(OutputData%Mean_FFWS_array) -ENDIF -IF (ALLOCATED(OutputData%wake_u)) THEN - DEALLOCATE(OutputData%wake_u) -ENDIF -IF (ALLOCATED(OutputData%wake_position)) THEN - DEALLOCATE(OutputData%wake_position) -ENDIF -IF (ALLOCATED(OutputData%smoothed_velocity_array)) THEN - DEALLOCATE(OutputData%smoothed_velocity_array) -ENDIF - CALL InflowWind_DestroyOutput( OutputData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyOutput - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 ! turbine_thrust_force allocated yes/no - IF ( ALLOCATED(InData%turbine_thrust_force) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! turbine_thrust_force upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%turbine_thrust_force) ! turbine_thrust_force - END IF - Int_BufSz = Int_BufSz + 1 ! induction_factor allocated yes/no - IF ( ALLOCATED(InData%induction_factor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! induction_factor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%induction_factor) ! induction_factor - END IF - Int_BufSz = Int_BufSz + 1 ! r_initial allocated yes/no - IF ( ALLOCATED(InData%r_initial) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! r_initial upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_initial) ! r_initial - END IF - Int_BufSz = Int_BufSz + 1 ! U_initial allocated yes/no - IF ( ALLOCATED(InData%U_initial) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_initial upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_initial) ! U_initial - END IF - Int_BufSz = Int_BufSz + 1 ! Mean_FFWS_array allocated yes/no - IF ( ALLOCATED(InData%Mean_FFWS_array) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Mean_FFWS_array upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Mean_FFWS_array) ! Mean_FFWS_array - END IF - Re_BufSz = Re_BufSz + 1 ! Mean_FFWS - Re_BufSz = Re_BufSz + 1 ! TI - Re_BufSz = Re_BufSz + 1 ! TI_downstream - Int_BufSz = Int_BufSz + 1 ! wake_u allocated yes/no - IF ( ALLOCATED(InData%wake_u) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! wake_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%wake_u) ! wake_u - END IF - Int_BufSz = Int_BufSz + 1 ! wake_position allocated yes/no - IF ( ALLOCATED(InData%wake_position) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! wake_position upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%wake_position) ! wake_position - END IF - Int_BufSz = Int_BufSz + 1 ! smoothed_velocity_array allocated yes/no - IF ( ALLOCATED(InData%smoothed_velocity_array) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! smoothed_velocity_array upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%smoothed_velocity_array) ! smoothed_velocity_array - END IF - Re_BufSz = Re_BufSz + 1 ! AtmUscale - Re_BufSz = Re_BufSz + 1 ! du_dz_ABL - Re_BufSz = Re_BufSz + 1 ! total_SDgenpwr - Re_BufSz = Re_BufSz + 1 ! mean_SDgenpwr - Re_BufSz = Re_BufSz + 1 ! avg_ct - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 - - IF ( .NOT. ALLOCATED(InData%turbine_thrust_force) ) 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%turbine_thrust_force,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_thrust_force,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%turbine_thrust_force,1), UBOUND(InData%turbine_thrust_force,1) - ReKiBuf(Re_Xferred) = InData%turbine_thrust_force(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%induction_factor) ) 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%induction_factor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%induction_factor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%induction_factor,1), UBOUND(InData%induction_factor,1) - ReKiBuf(Re_Xferred) = InData%induction_factor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_initial) ) 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%r_initial,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_initial,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%r_initial,1), UBOUND(InData%r_initial,1) - ReKiBuf(Re_Xferred) = InData%r_initial(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_initial) ) 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%U_initial,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_initial,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_initial,1), UBOUND(InData%U_initial,1) - ReKiBuf(Re_Xferred) = InData%U_initial(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mean_FFWS_array) ) 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%Mean_FFWS_array,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mean_FFWS_array,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Mean_FFWS_array,1), UBOUND(InData%Mean_FFWS_array,1) - ReKiBuf(Re_Xferred) = InData%Mean_FFWS_array(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Mean_FFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_downstream - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%wake_u) ) 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%wake_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_u,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wake_u,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_u,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%wake_u,2), UBOUND(InData%wake_u,2) - DO i1 = LBOUND(InData%wake_u,1), UBOUND(InData%wake_u,1) - ReKiBuf(Re_Xferred) = InData%wake_u(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%wake_position) ) 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%wake_position,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_position,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wake_position,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_position,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wake_position,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_position,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%wake_position,3), UBOUND(InData%wake_position,3) - DO i2 = LBOUND(InData%wake_position,2), UBOUND(InData%wake_position,2) - DO i1 = LBOUND(InData%wake_position,1), UBOUND(InData%wake_position,1) - ReKiBuf(Re_Xferred) = InData%wake_position(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%smoothed_velocity_array) ) 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%smoothed_velocity_array,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%smoothed_velocity_array,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%smoothed_velocity_array,2), UBOUND(InData%smoothed_velocity_array,2) - DO i1 = LBOUND(InData%smoothed_velocity_array,1), UBOUND(InData%smoothed_velocity_array,1) - ReKiBuf(Re_Xferred) = InData%smoothed_velocity_array(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%AtmUscale - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%du_dz_ABL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%total_SDgenpwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%mean_SDgenpwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%avg_ct - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackOutput - - SUBROUTINE DWM_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(DWM_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) :: 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 = 'DWM_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 ! turbine_thrust_force 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%turbine_thrust_force)) DEALLOCATE(OutData%turbine_thrust_force) - ALLOCATE(OutData%turbine_thrust_force(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_thrust_force.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%turbine_thrust_force,1), UBOUND(OutData%turbine_thrust_force,1) - OutData%turbine_thrust_force(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! induction_factor 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%induction_factor)) DEALLOCATE(OutData%induction_factor) - ALLOCATE(OutData%induction_factor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%induction_factor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%induction_factor,1), UBOUND(OutData%induction_factor,1) - OutData%induction_factor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_initial 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%r_initial)) DEALLOCATE(OutData%r_initial) - ALLOCATE(OutData%r_initial(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_initial.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%r_initial,1), UBOUND(OutData%r_initial,1) - OutData%r_initial(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_initial 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%U_initial)) DEALLOCATE(OutData%U_initial) - ALLOCATE(OutData%U_initial(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_initial.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_initial,1), UBOUND(OutData%U_initial,1) - OutData%U_initial(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mean_FFWS_array 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%Mean_FFWS_array)) DEALLOCATE(OutData%Mean_FFWS_array) - ALLOCATE(OutData%Mean_FFWS_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mean_FFWS_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Mean_FFWS_array,1), UBOUND(OutData%Mean_FFWS_array,1) - OutData%Mean_FFWS_array(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Mean_FFWS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_downstream = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wake_u 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%wake_u)) DEALLOCATE(OutData%wake_u) - ALLOCATE(OutData%wake_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%wake_u,2), UBOUND(OutData%wake_u,2) - DO i1 = LBOUND(OutData%wake_u,1), UBOUND(OutData%wake_u,1) - OutData%wake_u(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wake_position 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%wake_position)) DEALLOCATE(OutData%wake_position) - ALLOCATE(OutData%wake_position(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%wake_position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%wake_position,3), UBOUND(OutData%wake_position,3) - DO i2 = LBOUND(OutData%wake_position,2), UBOUND(OutData%wake_position,2) - DO i1 = LBOUND(OutData%wake_position,1), UBOUND(OutData%wake_position,1) - OutData%wake_position(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_velocity_array 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%smoothed_velocity_array)) DEALLOCATE(OutData%smoothed_velocity_array) - ALLOCATE(OutData%smoothed_velocity_array(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%smoothed_velocity_array,2), UBOUND(OutData%smoothed_velocity_array,2) - DO i1 = LBOUND(OutData%smoothed_velocity_array,1), UBOUND(OutData%smoothed_velocity_array,1) - OutData%smoothed_velocity_array(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%AtmUscale = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%du_dz_ABL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%total_SDgenpwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%mean_SDgenpwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%avg_ct = ReKiBuf(Re_Xferred) - 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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackOutput - - SUBROUTINE DWM_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(DWM_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 = 'DWM_CopyContState' -! + ErrMsg = '' + if (allocated(ShinozukaData%f_syn)) then + deallocate(ShinozukaData%f_syn) + end if + if (allocated(ShinozukaData%t_syn)) then + deallocate(ShinozukaData%t_syn) + end if + if (allocated(ShinozukaData%phi)) then + deallocate(ShinozukaData%phi) + end if + if (allocated(ShinozukaData%p_k)) then + deallocate(ShinozukaData%p_k) + end if + if (allocated(ShinozukaData%a_k)) then + deallocate(ShinozukaData%a_k) + end if +end subroutine + +subroutine DWM_PackShinozuka(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Shinozuka), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackShinozuka' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%f_syn)) + if (allocated(InData%f_syn)) then + call RegPackBounds(Buf, 1, lbound(InData%f_syn), ubound(InData%f_syn)) + call RegPack(Buf, InData%f_syn) + end if + call RegPack(Buf, allocated(InData%t_syn)) + if (allocated(InData%t_syn)) then + call RegPackBounds(Buf, 1, lbound(InData%t_syn), ubound(InData%t_syn)) + call RegPack(Buf, InData%t_syn) + end if + call RegPack(Buf, allocated(InData%phi)) + if (allocated(InData%phi)) then + call RegPackBounds(Buf, 1, lbound(InData%phi), ubound(InData%phi)) + call RegPack(Buf, InData%phi) + end if + call RegPack(Buf, allocated(InData%p_k)) + if (allocated(InData%p_k)) then + call RegPackBounds(Buf, 1, lbound(InData%p_k), ubound(InData%p_k)) + call RegPack(Buf, InData%p_k) + end if + call RegPack(Buf, allocated(InData%a_k)) + if (allocated(InData%a_k)) then + call RegPackBounds(Buf, 1, lbound(InData%a_k), ubound(InData%a_k)) + call RegPack(Buf, InData%a_k) + end if + call RegPack(Buf, InData%num_points) + call RegPack(Buf, InData%ILo) + call RegPack(Buf, InData%i) + call RegPack(Buf, InData%j) + call RegPack(Buf, InData%dt) + call RegPack(Buf, InData%t_min) + call RegPack(Buf, InData%t_max) + call RegPack(Buf, InData%df) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackShinozuka(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Shinozuka), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackShinozuka' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%f_syn)) deallocate(OutData%f_syn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%f_syn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%f_syn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%f_syn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%t_syn)) deallocate(OutData%t_syn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%t_syn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_syn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%t_syn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%phi)) deallocate(OutData%phi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%phi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%phi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%p_k)) deallocate(OutData%p_k) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%p_k(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_k.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%p_k) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%a_k)) deallocate(OutData%a_k) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%a_k(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%a_k.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%a_k) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%num_points) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ILo) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%i) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%j) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%t_min) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%t_max) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%df) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_Copysmooth_out_wake_data(Srcsmooth_out_wake_dataData, Dstsmooth_out_wake_dataData, CtrlCode, ErrStat, ErrMsg) + type(smooth_out_wake_data), intent(in) :: Srcsmooth_out_wake_dataData + type(smooth_out_wake_data), intent(inout) :: Dstsmooth_out_wake_dataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_Copysmooth_out_wake_data' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%dummy = SrcContStateData%dummy - CALL InflowWind_CopyContState( SrcContStateData%IfW, DstContStateData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyContState - - SUBROUTINE DWM_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(DWM_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 = 'DWM_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL InflowWind_DestroyContState( ContStateData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyContState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 ! dummy - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackContState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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%dummy = ReKiBuf(Re_Xferred) - 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 InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackContState - - SUBROUTINE DWM_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(DWM_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 = 'DWM_CopyDiscState' -! + ErrMsg = '' + Dstsmooth_out_wake_dataData%length_velocity_array = Srcsmooth_out_wake_dataData%length_velocity_array +end subroutine + +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 + character(*), parameter :: RoutineName = 'DWM_Destroysmooth_out_wake_data' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%dummy = SrcDiscStateData%dummy - CALL InflowWind_CopyDiscState( SrcDiscStateData%IfW, DstDiscStateData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyDiscState - - SUBROUTINE DWM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(DWM_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 = 'DWM_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL InflowWind_DestroyDiscState( DiscStateData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyDiscState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 ! dummy - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackDiscState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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%dummy = ReKiBuf(Re_Xferred) - 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 InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackDiscState - - SUBROUTINE DWM_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(DWM_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 = 'DWM_CopyConstrState' -! + ErrMsg = '' +end subroutine + +subroutine DWM_Packsmooth_out_wake_data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(smooth_out_wake_data), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_Packsmooth_out_wake_data' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%length_velocity_array) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPacksmooth_out_wake_data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(smooth_out_wake_data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPacksmooth_out_wake_data' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%length_velocity_array) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_CopySWSV(SrcSWSVData, DstSWSVData, CtrlCode, ErrStat, ErrMsg) + type(SWSV), intent(in) :: SrcSWSVData + type(SWSV), intent(inout) :: DstSWSVData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_CopySWSV' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%dummy = SrcConstrStateData%dummy - CALL InflowWind_CopyConstrState( SrcConstrStateData%IfW, DstConstrStateData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyConstrState - - SUBROUTINE DWM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(DWM_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 = 'DWM_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL InflowWind_DestroyConstrState( ConstrStateData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyConstrState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 ! dummy - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackConstrState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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%dummy = ReKiBuf(Re_Xferred) - 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 InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackConstrState - - SUBROUTINE DWM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(DWM_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyInitInput' -! + ErrMsg = '' + DstSWSVData%p1 = SrcSWSVData%p1 + DstSWSVData%p2 = SrcSWSVData%p2 + DstSWSVData%distance = SrcSWSVData%distance + DstSWSVData%y0 = SrcSWSVData%y0 + DstSWSVData%z0 = SrcSWSVData%z0 + DstSWSVData%unit = SrcSWSVData%unit +end subroutine + +subroutine DWM_DestroySWSV(SWSVData, ErrStat, ErrMsg) + type(SWSV), intent(inout) :: SWSVData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_DestroySWSV' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%dummy = SrcInitInputData%dummy - CALL InflowWind_CopyInitInput( SrcInitInputData%IfW, DstInitInputData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyInitInput - - SUBROUTINE DWM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(DWM_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 = 'DWM_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL InflowWind_DestroyInitInput( InitInputData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyInitInput - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 ! dummy - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackInitInput - - SUBROUTINE DWM_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(DWM_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_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%dummy = ReKiBuf(Re_Xferred) - 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 InflowWind_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackInitInput - - SUBROUTINE DWM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(DWM_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyInitOutput' -! + ErrMsg = '' +end subroutine + +subroutine DWM_PackSWSV(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SWSV), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackSWSV' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%p1) + call RegPack(Buf, InData%p2) + call RegPack(Buf, InData%distance) + call RegPack(Buf, InData%y0) + call RegPack(Buf, InData%z0) + call RegPack(Buf, InData%unit) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackSWSV(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SWSV), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackSWSV' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%p1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%p2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%distance) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%y0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%z0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%unit) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_resultData, CtrlCode, ErrStat, ErrMsg) + type(read_upwind_result), intent(in) :: Srcread_upwind_resultData + type(read_upwind_result), intent(inout) :: Dstread_upwind_resultData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_Copyread_upwind_result' ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%dummy = SrcInitOutputData%dummy - CALL InflowWind_CopyInitOutput( SrcInitOutputData%IfW, DstInitOutputData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyInitOutput - - SUBROUTINE DWM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(DWM_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 = 'DWM_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL InflowWind_DestroyInitOutput( InitOutputData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyInitOutput - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - Re_BufSz = Re_BufSz + 1 ! dummy - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackInitOutput - - SUBROUTINE DWM_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(DWM_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_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 - OutData%dummy = ReKiBuf(Re_Xferred) - 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 InflowWind_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackInitOutput - - - SUBROUTINE DWM_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(DWM_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(DWM_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 + ErrMsg = '' + if (allocated(Srcread_upwind_resultData%upwind_U)) then + LB(1:2) = lbound(Srcread_upwind_resultData%upwind_U) + UB(1:2) = ubound(Srcread_upwind_resultData%upwind_U) + if (.not. allocated(Dstread_upwind_resultData%upwind_U)) then + allocate(Dstread_upwind_resultData%upwind_U(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_U.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%upwind_U = Srcread_upwind_resultData%upwind_U + end if + if (allocated(Srcread_upwind_resultData%upwind_wakecenter)) then + LB(1:4) = lbound(Srcread_upwind_resultData%upwind_wakecenter) + UB(1:4) = ubound(Srcread_upwind_resultData%upwind_wakecenter) + if (.not. allocated(Dstread_upwind_resultData%upwind_wakecenter)) then + allocate(Dstread_upwind_resultData%upwind_wakecenter(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_wakecenter.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%upwind_wakecenter = Srcread_upwind_resultData%upwind_wakecenter + end if + if (allocated(Srcread_upwind_resultData%upwind_meanU)) then + LB(1:1) = lbound(Srcread_upwind_resultData%upwind_meanU) + UB(1:1) = ubound(Srcread_upwind_resultData%upwind_meanU) + if (.not. allocated(Dstread_upwind_resultData%upwind_meanU)) then + allocate(Dstread_upwind_resultData%upwind_meanU(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_meanU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%upwind_meanU = Srcread_upwind_resultData%upwind_meanU + end if + if (allocated(Srcread_upwind_resultData%upwind_TI)) then + LB(1:1) = lbound(Srcread_upwind_resultData%upwind_TI) + UB(1:1) = ubound(Srcread_upwind_resultData%upwind_TI) + if (.not. allocated(Dstread_upwind_resultData%upwind_TI)) then + allocate(Dstread_upwind_resultData%upwind_TI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_TI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%upwind_TI = Srcread_upwind_resultData%upwind_TI + end if + if (allocated(Srcread_upwind_resultData%upwind_small_TI)) then + LB(1:1) = lbound(Srcread_upwind_resultData%upwind_small_TI) + UB(1:1) = ubound(Srcread_upwind_resultData%upwind_small_TI) + if (.not. allocated(Dstread_upwind_resultData%upwind_small_TI)) then + allocate(Dstread_upwind_resultData%upwind_small_TI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_small_TI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%upwind_small_TI = Srcread_upwind_resultData%upwind_small_TI + end if + if (allocated(Srcread_upwind_resultData%upwind_smoothWake)) then + LB(1:2) = lbound(Srcread_upwind_resultData%upwind_smoothWake) + UB(1:2) = ubound(Srcread_upwind_resultData%upwind_smoothWake) + if (.not. allocated(Dstread_upwind_resultData%upwind_smoothWake)) then + allocate(Dstread_upwind_resultData%upwind_smoothWake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_smoothWake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%upwind_smoothWake = Srcread_upwind_resultData%upwind_smoothWake + end if + if (allocated(Srcread_upwind_resultData%velocity_aerodyn)) then + LB(1:1) = lbound(Srcread_upwind_resultData%velocity_aerodyn) + UB(1:1) = ubound(Srcread_upwind_resultData%velocity_aerodyn) + if (.not. allocated(Dstread_upwind_resultData%velocity_aerodyn)) then + allocate(Dstread_upwind_resultData%velocity_aerodyn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%velocity_aerodyn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%velocity_aerodyn = Srcread_upwind_resultData%velocity_aerodyn + end if + if (allocated(Srcread_upwind_resultData%TI_downstream)) then + LB(1:1) = lbound(Srcread_upwind_resultData%TI_downstream) + UB(1:1) = ubound(Srcread_upwind_resultData%TI_downstream) + if (.not. allocated(Dstread_upwind_resultData%TI_downstream)) then + allocate(Dstread_upwind_resultData%TI_downstream(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%TI_downstream.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%TI_downstream = Srcread_upwind_resultData%TI_downstream + end if + if (allocated(Srcread_upwind_resultData%small_scale_TI_downstream)) then + LB(1:1) = lbound(Srcread_upwind_resultData%small_scale_TI_downstream) + UB(1:1) = ubound(Srcread_upwind_resultData%small_scale_TI_downstream) + if (.not. allocated(Dstread_upwind_resultData%small_scale_TI_downstream)) then + allocate(Dstread_upwind_resultData%small_scale_TI_downstream(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%small_scale_TI_downstream.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%small_scale_TI_downstream = Srcread_upwind_resultData%small_scale_TI_downstream + end if + if (allocated(Srcread_upwind_resultData%smoothed_velocity_array)) then + LB(1:2) = lbound(Srcread_upwind_resultData%smoothed_velocity_array) + UB(1:2) = ubound(Srcread_upwind_resultData%smoothed_velocity_array) + if (.not. allocated(Dstread_upwind_resultData%smoothed_velocity_array)) then + allocate(Dstread_upwind_resultData%smoothed_velocity_array(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%smoothed_velocity_array.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%smoothed_velocity_array = Srcread_upwind_resultData%smoothed_velocity_array + end if + if (allocated(Srcread_upwind_resultData%vel_matrix)) then + LB(1:3) = lbound(Srcread_upwind_resultData%vel_matrix) + UB(1:3) = ubound(Srcread_upwind_resultData%vel_matrix) + if (.not. allocated(Dstread_upwind_resultData%vel_matrix)) then + allocate(Dstread_upwind_resultData%vel_matrix(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%vel_matrix.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%vel_matrix = Srcread_upwind_resultData%vel_matrix + end if +end subroutine + +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 + character(*), parameter :: RoutineName = 'DWM_Destroyread_upwind_result' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(read_upwind_resultData%upwind_U)) then + deallocate(read_upwind_resultData%upwind_U) + end if + if (allocated(read_upwind_resultData%upwind_wakecenter)) then + deallocate(read_upwind_resultData%upwind_wakecenter) + end if + if (allocated(read_upwind_resultData%upwind_meanU)) then + deallocate(read_upwind_resultData%upwind_meanU) + end if + if (allocated(read_upwind_resultData%upwind_TI)) then + deallocate(read_upwind_resultData%upwind_TI) + end if + if (allocated(read_upwind_resultData%upwind_small_TI)) then + deallocate(read_upwind_resultData%upwind_small_TI) + end if + if (allocated(read_upwind_resultData%upwind_smoothWake)) then + deallocate(read_upwind_resultData%upwind_smoothWake) + end if + if (allocated(read_upwind_resultData%velocity_aerodyn)) then + deallocate(read_upwind_resultData%velocity_aerodyn) + end if + if (allocated(read_upwind_resultData%TI_downstream)) then + deallocate(read_upwind_resultData%TI_downstream) + end if + if (allocated(read_upwind_resultData%small_scale_TI_downstream)) then + deallocate(read_upwind_resultData%small_scale_TI_downstream) + end if + if (allocated(read_upwind_resultData%smoothed_velocity_array)) then + deallocate(read_upwind_resultData%smoothed_velocity_array) + end if + if (allocated(read_upwind_resultData%vel_matrix)) then + deallocate(read_upwind_resultData%vel_matrix) + end if +end subroutine + +subroutine DWM_Packread_upwind_result(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(read_upwind_result), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_Packread_upwind_result' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%upwind_U)) + if (allocated(InData%upwind_U)) then + call RegPackBounds(Buf, 2, lbound(InData%upwind_U), ubound(InData%upwind_U)) + call RegPack(Buf, InData%upwind_U) + end if + call RegPack(Buf, allocated(InData%upwind_wakecenter)) + if (allocated(InData%upwind_wakecenter)) then + call RegPackBounds(Buf, 4, lbound(InData%upwind_wakecenter), ubound(InData%upwind_wakecenter)) + call RegPack(Buf, InData%upwind_wakecenter) + end if + call RegPack(Buf, allocated(InData%upwind_meanU)) + if (allocated(InData%upwind_meanU)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_meanU), ubound(InData%upwind_meanU)) + call RegPack(Buf, InData%upwind_meanU) + end if + call RegPack(Buf, allocated(InData%upwind_TI)) + if (allocated(InData%upwind_TI)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_TI), ubound(InData%upwind_TI)) + call RegPack(Buf, InData%upwind_TI) + end if + call RegPack(Buf, allocated(InData%upwind_small_TI)) + if (allocated(InData%upwind_small_TI)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_small_TI), ubound(InData%upwind_small_TI)) + call RegPack(Buf, InData%upwind_small_TI) + end if + call RegPack(Buf, allocated(InData%upwind_smoothWake)) + if (allocated(InData%upwind_smoothWake)) then + call RegPackBounds(Buf, 2, lbound(InData%upwind_smoothWake), ubound(InData%upwind_smoothWake)) + call RegPack(Buf, InData%upwind_smoothWake) + end if + call RegPack(Buf, allocated(InData%velocity_aerodyn)) + if (allocated(InData%velocity_aerodyn)) then + call RegPackBounds(Buf, 1, lbound(InData%velocity_aerodyn), ubound(InData%velocity_aerodyn)) + call RegPack(Buf, InData%velocity_aerodyn) + end if + call RegPack(Buf, allocated(InData%TI_downstream)) + if (allocated(InData%TI_downstream)) then + call RegPackBounds(Buf, 1, lbound(InData%TI_downstream), ubound(InData%TI_downstream)) + call RegPack(Buf, InData%TI_downstream) + end if + call RegPack(Buf, allocated(InData%small_scale_TI_downstream)) + if (allocated(InData%small_scale_TI_downstream)) then + call RegPackBounds(Buf, 1, lbound(InData%small_scale_TI_downstream), ubound(InData%small_scale_TI_downstream)) + call RegPack(Buf, InData%small_scale_TI_downstream) + end if + call RegPack(Buf, allocated(InData%smoothed_velocity_array)) + if (allocated(InData%smoothed_velocity_array)) then + call RegPackBounds(Buf, 2, lbound(InData%smoothed_velocity_array), ubound(InData%smoothed_velocity_array)) + call RegPack(Buf, InData%smoothed_velocity_array) + end if + call RegPack(Buf, allocated(InData%vel_matrix)) + if (allocated(InData%vel_matrix)) then + call RegPackBounds(Buf, 3, lbound(InData%vel_matrix), ubound(InData%vel_matrix)) + call RegPack(Buf, InData%vel_matrix) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackread_upwind_result(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(read_upwind_result), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackread_upwind_result' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%upwind_U)) deallocate(OutData%upwind_U) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_U(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_U.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_U) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%upwind_wakecenter)) deallocate(OutData%upwind_wakecenter) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_wakecenter(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_wakecenter.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_wakecenter) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%upwind_meanU)) deallocate(OutData%upwind_meanU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_meanU(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_meanU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_meanU) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%upwind_TI)) deallocate(OutData%upwind_TI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_TI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_TI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_TI) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%upwind_small_TI)) deallocate(OutData%upwind_small_TI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_small_TI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_small_TI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_small_TI) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%upwind_smoothWake)) deallocate(OutData%upwind_smoothWake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_smoothWake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_smoothWake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_smoothWake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%velocity_aerodyn)) deallocate(OutData%velocity_aerodyn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%velocity_aerodyn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocity_aerodyn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%velocity_aerodyn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TI_downstream)) deallocate(OutData%TI_downstream) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TI_downstream(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TI_downstream) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%small_scale_TI_downstream)) deallocate(OutData%small_scale_TI_downstream) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%small_scale_TI_downstream(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%small_scale_TI_downstream.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%small_scale_TI_downstream) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%smoothed_velocity_array)) deallocate(OutData%smoothed_velocity_array) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%smoothed_velocity_array(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%smoothed_velocity_array) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%vel_matrix)) deallocate(OutData%vel_matrix) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vel_matrix(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vel_matrix.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vel_matrix) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine DWM_Copywake_meandered_center(Srcwake_meandered_centerData, Dstwake_meandered_centerData, CtrlCode, ErrStat, ErrMsg) + type(wake_meandered_center), intent(in) :: Srcwake_meandered_centerData + type(wake_meandered_center), intent(inout) :: Dstwake_meandered_centerData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_Copywake_meandered_center' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Srcwake_meandered_centerData%wake_width)) then + LB(1:1) = lbound(Srcwake_meandered_centerData%wake_width) + UB(1:1) = ubound(Srcwake_meandered_centerData%wake_width) + if (.not. allocated(Dstwake_meandered_centerData%wake_width)) then + allocate(Dstwake_meandered_centerData%wake_width(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstwake_meandered_centerData%wake_width.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstwake_meandered_centerData%wake_width = Srcwake_meandered_centerData%wake_width + end if +end subroutine + +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 + character(*), parameter :: RoutineName = 'DWM_Destroywake_meandered_center' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(wake_meandered_centerData%wake_width)) then + deallocate(wake_meandered_centerData%wake_width) + end if +end subroutine + +subroutine DWM_Packwake_meandered_center(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(wake_meandered_center), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_Packwake_meandered_center' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%wake_width)) + if (allocated(InData%wake_width)) then + call RegPackBounds(Buf, 1, lbound(InData%wake_width), ubound(InData%wake_width)) + call RegPack(Buf, InData%wake_width) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackwake_meandered_center(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(wake_meandered_center), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackwake_meandered_center' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%wake_width)) deallocate(OutData%wake_width) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%wake_width(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_width.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%wake_width) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine DWM_Copyturbine_blade(Srcturbine_bladeData, Dstturbine_bladeData, CtrlCode, ErrStat, ErrMsg) + type(DWM_turbine_blade), intent(in) :: Srcturbine_bladeData + type(DWM_turbine_blade), intent(inout) :: Dstturbine_bladeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_Copyturbine_blade' + ErrStat = ErrID_None + ErrMsg = '' + Dstturbine_bladeData%Aerodyn_turbine_num = Srcturbine_bladeData%Aerodyn_turbine_num + Dstturbine_bladeData%Blade_index = Srcturbine_bladeData%Blade_index + Dstturbine_bladeData%Element_index = Srcturbine_bladeData%Element_index +end subroutine + +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 + character(*), parameter :: RoutineName = 'DWM_Destroyturbine_blade' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine DWM_Packturbine_blade(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_turbine_blade), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_Packturbine_blade' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Aerodyn_turbine_num) + call RegPack(Buf, InData%Blade_index) + call RegPack(Buf, InData%Element_index) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackturbine_blade(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_turbine_blade), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackturbine_blade' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Aerodyn_turbine_num) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Blade_index) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Element_index) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(DWM_ParameterType), intent(in) :: SrcParamData + type(DWM_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcParamData%velocityU)) then + LB(1:1) = lbound(SrcParamData%velocityU) + UB(1:1) = ubound(SrcParamData%velocityU) + if (.not. allocated(DstParamData%velocityU)) then + allocate(DstParamData%velocityU(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%velocityU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%velocityU = SrcParamData%velocityU + end if + if (allocated(SrcParamData%smoothed_wake)) then + LB(1:1) = lbound(SrcParamData%smoothed_wake) + UB(1:1) = ubound(SrcParamData%smoothed_wake) + if (.not. allocated(DstParamData%smoothed_wake)) then + allocate(DstParamData%smoothed_wake(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%smoothed_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%smoothed_wake = SrcParamData%smoothed_wake + end if + if (allocated(SrcParamData%WakePosition)) then + LB(1:3) = lbound(SrcParamData%WakePosition) + UB(1:3) = ubound(SrcParamData%WakePosition) + if (.not. allocated(DstParamData%WakePosition)) then + allocate(DstParamData%WakePosition(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WakePosition.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WakePosition = SrcParamData%WakePosition + end if + DstParamData%WakePosition_1 = SrcParamData%WakePosition_1 + DstParamData%WakePosition_2 = SrcParamData%WakePosition_2 + DstParamData%smooth_flag = SrcParamData%smooth_flag + DstParamData%p_p_r = SrcParamData%p_p_r + DstParamData%NumWT = SrcParamData%NumWT + DstParamData%Tinfluencer = SrcParamData%Tinfluencer + DstParamData%RotorR = SrcParamData%RotorR + DstParamData%r_domain = SrcParamData%r_domain + DstParamData%x_domain = SrcParamData%x_domain + DstParamData%Uambient = SrcParamData%Uambient + DstParamData%TI_amb = SrcParamData%TI_amb + DstParamData%TI_wake = SrcParamData%TI_wake + DstParamData%hub_height = SrcParamData%hub_height + DstParamData%length_velocityU = SrcParamData%length_velocityU + DstParamData%WFLowerBd = SrcParamData%WFLowerBd + DstParamData%Wind_file_Mean_u = SrcParamData%Wind_file_Mean_u + DstParamData%Winddir = SrcParamData%Winddir + DstParamData%air_density = SrcParamData%air_density + DstParamData%RR = SrcParamData%RR + if (allocated(SrcParamData%ElementRad)) then + LB(1:1) = lbound(SrcParamData%ElementRad) + UB(1:1) = ubound(SrcParamData%ElementRad) + if (.not. allocated(DstParamData%ElementRad)) then + allocate(DstParamData%ElementRad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElementRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ElementRad = SrcParamData%ElementRad + end if + DstParamData%Bnum = SrcParamData%Bnum + DstParamData%ElementNum = SrcParamData%ElementNum + call DWM_Copyread_turbine_position_data(SrcParamData%RTPD, DstParamData%RTPD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyParam(SrcParamData%IfW, DstParamData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine DWM_DestroyParam(ParamData, ErrStat, ErrMsg) + type(DWM_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%velocityU)) then + deallocate(ParamData%velocityU) + end if + if (allocated(ParamData%smoothed_wake)) then + deallocate(ParamData%smoothed_wake) + end if + if (allocated(ParamData%WakePosition)) then + deallocate(ParamData%WakePosition) + end if + if (allocated(ParamData%ElementRad)) then + deallocate(ParamData%ElementRad) + end if + call DWM_Destroyread_turbine_position_data(ParamData%RTPD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyParam(ParamData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine DWM_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%velocityU)) + if (allocated(InData%velocityU)) then + call RegPackBounds(Buf, 1, lbound(InData%velocityU), ubound(InData%velocityU)) + call RegPack(Buf, InData%velocityU) + end if + call RegPack(Buf, allocated(InData%smoothed_wake)) + if (allocated(InData%smoothed_wake)) then + call RegPackBounds(Buf, 1, lbound(InData%smoothed_wake), ubound(InData%smoothed_wake)) + call RegPack(Buf, InData%smoothed_wake) + end if + call RegPack(Buf, allocated(InData%WakePosition)) + if (allocated(InData%WakePosition)) then + call RegPackBounds(Buf, 3, lbound(InData%WakePosition), ubound(InData%WakePosition)) + call RegPack(Buf, InData%WakePosition) + end if + call RegPack(Buf, InData%WakePosition_1) + call RegPack(Buf, InData%WakePosition_2) + call RegPack(Buf, InData%smooth_flag) + call RegPack(Buf, InData%p_p_r) + call RegPack(Buf, InData%NumWT) + call RegPack(Buf, InData%Tinfluencer) + call RegPack(Buf, InData%RotorR) + call RegPack(Buf, InData%r_domain) + call RegPack(Buf, InData%x_domain) + call RegPack(Buf, InData%Uambient) + call RegPack(Buf, InData%TI_amb) + call RegPack(Buf, InData%TI_wake) + call RegPack(Buf, InData%hub_height) + call RegPack(Buf, InData%length_velocityU) + call RegPack(Buf, InData%WFLowerBd) + call RegPack(Buf, InData%Wind_file_Mean_u) + call RegPack(Buf, InData%Winddir) + call RegPack(Buf, InData%air_density) + call RegPack(Buf, InData%RR) + call RegPack(Buf, allocated(InData%ElementRad)) + if (allocated(InData%ElementRad)) then + call RegPackBounds(Buf, 1, lbound(InData%ElementRad), ubound(InData%ElementRad)) + call RegPack(Buf, InData%ElementRad) + end if + call RegPack(Buf, InData%Bnum) + call RegPack(Buf, InData%ElementNum) + call DWM_Packread_turbine_position_data(Buf, InData%RTPD) + call InflowWind_PackParam(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackParam' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%velocityU)) deallocate(OutData%velocityU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%velocityU(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocityU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%velocityU) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%smoothed_wake)) deallocate(OutData%smoothed_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%smoothed_wake(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%smoothed_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WakePosition)) deallocate(OutData%WakePosition) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WakePosition(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WakePosition.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WakePosition) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%WakePosition_1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WakePosition_2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%smooth_flag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%p_p_r) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumWT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Tinfluencer) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotorR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%r_domain) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%x_domain) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Uambient) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TI_amb) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TI_wake) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%hub_height) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%length_velocityU) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WFLowerBd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Wind_file_Mean_u) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Winddir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%air_density) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RR) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ElementRad)) deallocate(OutData%ElementRad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElementRad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElementRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElementRad) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Bnum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ElementNum) + if (RegCheckErr(Buf, RoutineName)) return + call DWM_Unpackread_turbine_position_data(Buf, OutData%RTPD) ! RTPD + call InflowWind_UnpackParam(Buf, OutData%IfW) ! IfW +end subroutine + +subroutine DWM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(DWM_OtherStateType), intent(in) :: SrcOtherStateData + type(DWM_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_CopyOtherState(SrcOtherStateData%IfW, DstOtherStateData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine DWM_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(DWM_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_DestroyOtherState(OtherStateData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine DWM_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call InflowWind_PackOtherState(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call InflowWind_UnpackOtherState(Buf, OutData%IfW) ! IfW +end subroutine + +subroutine DWM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(DWM_MiscVarType), intent(in) :: SrcMiscData + type(DWM_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_CopyMisc(SrcMiscData%IfW, DstMiscData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%position_y = SrcMiscData%position_y + DstMiscData%position_z = SrcMiscData%position_z + DstMiscData%velocity_wake_mean = SrcMiscData%velocity_wake_mean + DstMiscData%shifted_velocity_Aerodyn = SrcMiscData%shifted_velocity_Aerodyn + DstMiscData%U_velocity = SrcMiscData%U_velocity + DstMiscData%V_velocity = SrcMiscData%V_velocity + if (allocated(SrcMiscData%Nforce)) then + LB(1:2) = lbound(SrcMiscData%Nforce) + UB(1:2) = ubound(SrcMiscData%Nforce) + if (.not. allocated(DstMiscData%Nforce)) then + allocate(DstMiscData%Nforce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Nforce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Nforce = SrcMiscData%Nforce + end if + if (allocated(SrcMiscData%blade_dr)) then + LB(1:1) = lbound(SrcMiscData%blade_dr) + UB(1:1) = ubound(SrcMiscData%blade_dr) + if (.not. allocated(DstMiscData%blade_dr)) then + allocate(DstMiscData%blade_dr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%blade_dr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%blade_dr = SrcMiscData%blade_dr + end if + DstMiscData%NacYaw = SrcMiscData%NacYaw + DstMiscData%TI_original = SrcMiscData%TI_original + call DWM_Copyturbine_average_velocity_data(SrcMiscData%TAVD, DstMiscData%TAVD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyCVSD(SrcMiscData%CalVelScale_data, DstMiscData%CalVelScale_data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyMeanderData(SrcMiscData%meandering_data, DstMiscData%meandering_data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyWeiMethod(SrcMiscData%weighting_method, DstMiscData%weighting_method, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyTIDownstream(SrcMiscData%TI_downstream_data, DstMiscData%TI_downstream_data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyTurbKaimal(SrcMiscData%Turbulence_KS, DstMiscData%Turbulence_KS, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyShinozuka(SrcMiscData%shinozuka_data, DstMiscData%shinozuka_data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_Copysmooth_out_wake_data(SrcMiscData%SmoothOut, DstMiscData%SmoothOut, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopySWSV(SrcMiscData%smooth_wake_shifted_velocity_data, DstMiscData%smooth_wake_shifted_velocity_data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyWake_Deficit_Data(SrcMiscData%DWDD, DstMiscData%DWDD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%ct_tilde = SrcMiscData%ct_tilde + DstMiscData%FAST_Time = SrcMiscData%FAST_Time + DstMiscData%SDtimestep = SrcMiscData%SDtimestep + call DWM_Copyturbine_blade(SrcMiscData%DWM_tb, DstMiscData%DWM_tb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_Copywake_meandered_center(SrcMiscData%WMC, DstMiscData%WMC, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine DWM_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(DWM_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_DestroyMisc(MiscData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%Nforce)) then + deallocate(MiscData%Nforce) + end if + if (allocated(MiscData%blade_dr)) then + deallocate(MiscData%blade_dr) + end if + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyMeanderData(MiscData%meandering_data, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyWeiMethod(MiscData%weighting_method, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyTIDownstream(MiscData%TI_downstream_data, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyTurbKaimal(MiscData%Turbulence_KS, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine DWM_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call InflowWind_PackMisc(Buf, InData%IfW) + call RegPack(Buf, InData%position_y) + call RegPack(Buf, InData%position_z) + call RegPack(Buf, InData%velocity_wake_mean) + call RegPack(Buf, InData%shifted_velocity_Aerodyn) + call RegPack(Buf, InData%U_velocity) + call RegPack(Buf, InData%V_velocity) + call RegPack(Buf, allocated(InData%Nforce)) + if (allocated(InData%Nforce)) then + call RegPackBounds(Buf, 2, lbound(InData%Nforce), ubound(InData%Nforce)) + call RegPack(Buf, InData%Nforce) + end if + call RegPack(Buf, allocated(InData%blade_dr)) + if (allocated(InData%blade_dr)) then + call RegPackBounds(Buf, 1, lbound(InData%blade_dr), ubound(InData%blade_dr)) + call RegPack(Buf, InData%blade_dr) + end if + call RegPack(Buf, InData%NacYaw) + call RegPack(Buf, InData%TI_original) + call DWM_Packturbine_average_velocity_data(Buf, InData%TAVD) + call DWM_PackCVSD(Buf, InData%CalVelScale_data) + call DWM_PackMeanderData(Buf, InData%meandering_data) + call DWM_PackWeiMethod(Buf, InData%weighting_method) + call DWM_PackTIDownstream(Buf, InData%TI_downstream_data) + call DWM_PackTurbKaimal(Buf, InData%Turbulence_KS) + call DWM_PackShinozuka(Buf, InData%shinozuka_data) + call DWM_Packsmooth_out_wake_data(Buf, InData%SmoothOut) + call DWM_PackSWSV(Buf, InData%smooth_wake_shifted_velocity_data) + call DWM_PackWake_Deficit_Data(Buf, InData%DWDD) + call RegPack(Buf, InData%ct_tilde) + call RegPack(Buf, InData%FAST_Time) + call RegPack(Buf, InData%SDtimestep) + call DWM_Packturbine_blade(Buf, InData%DWM_tb) + call DWM_Packwake_meandered_center(Buf, InData%WMC) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackMisc' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call InflowWind_UnpackMisc(Buf, OutData%IfW) ! IfW + call RegUnpack(Buf, OutData%position_y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%position_z) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%velocity_wake_mean) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%shifted_velocity_Aerodyn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%U_velocity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%V_velocity) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Nforce)) deallocate(OutData%Nforce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nforce(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nforce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Nforce) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%blade_dr)) deallocate(OutData%blade_dr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%blade_dr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%blade_dr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%blade_dr) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NacYaw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TI_original) + if (RegCheckErr(Buf, RoutineName)) return + call DWM_Unpackturbine_average_velocity_data(Buf, OutData%TAVD) ! TAVD + call DWM_UnpackCVSD(Buf, OutData%CalVelScale_data) ! CalVelScale_data + call DWM_UnpackMeanderData(Buf, OutData%meandering_data) ! meandering_data + call DWM_UnpackWeiMethod(Buf, OutData%weighting_method) ! weighting_method + call DWM_UnpackTIDownstream(Buf, OutData%TI_downstream_data) ! TI_downstream_data + call DWM_UnpackTurbKaimal(Buf, OutData%Turbulence_KS) ! Turbulence_KS + call DWM_UnpackShinozuka(Buf, OutData%shinozuka_data) ! shinozuka_data + call DWM_Unpacksmooth_out_wake_data(Buf, OutData%SmoothOut) ! SmoothOut + call DWM_UnpackSWSV(Buf, OutData%smooth_wake_shifted_velocity_data) ! smooth_wake_shifted_velocity_data + call DWM_UnpackWake_Deficit_Data(Buf, OutData%DWDD) ! DWDD + call RegUnpack(Buf, OutData%ct_tilde) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FAST_Time) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SDtimestep) + if (RegCheckErr(Buf, RoutineName)) return + call DWM_Unpackturbine_blade(Buf, OutData%DWM_tb) ! DWM_tb + call DWM_Unpackwake_meandered_center(Buf, OutData%WMC) ! WMC +end subroutine + +subroutine DWM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(DWM_InputType), intent(in) :: SrcInputData + type(DWM_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call DWM_Copyread_upwind_result(SrcInputData%Upwind_result, DstInputData%Upwind_result, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcInputData%IfW, DstInputData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine DWM_DestroyInput(InputData, ErrStat, ErrMsg) + type(DWM_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call DWM_Destroyread_upwind_result(InputData%Upwind_result, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInput(InputData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine DWM_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call DWM_Packread_upwind_result(Buf, InData%Upwind_result) + call InflowWind_PackInput(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + call DWM_Unpackread_upwind_result(Buf, OutData%Upwind_result) ! Upwind_result + call InflowWind_UnpackInput(Buf, OutData%IfW) ! IfW +end subroutine + +subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(DWM_OutputType), intent(in) :: SrcOutputData + type(DWM_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%turbine_thrust_force)) then + LB(1:1) = lbound(SrcOutputData%turbine_thrust_force) + UB(1:1) = ubound(SrcOutputData%turbine_thrust_force) + if (.not. allocated(DstOutputData%turbine_thrust_force)) then + allocate(DstOutputData%turbine_thrust_force(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%turbine_thrust_force.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%turbine_thrust_force = SrcOutputData%turbine_thrust_force + end if + if (allocated(SrcOutputData%induction_factor)) then + LB(1:1) = lbound(SrcOutputData%induction_factor) + UB(1:1) = ubound(SrcOutputData%induction_factor) + if (.not. allocated(DstOutputData%induction_factor)) then + allocate(DstOutputData%induction_factor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%induction_factor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%induction_factor = SrcOutputData%induction_factor + end if + if (allocated(SrcOutputData%r_initial)) then + LB(1:1) = lbound(SrcOutputData%r_initial) + UB(1:1) = ubound(SrcOutputData%r_initial) + if (.not. allocated(DstOutputData%r_initial)) then + allocate(DstOutputData%r_initial(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%r_initial.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%r_initial = SrcOutputData%r_initial + end if + if (allocated(SrcOutputData%U_initial)) then + LB(1:1) = lbound(SrcOutputData%U_initial) + UB(1:1) = ubound(SrcOutputData%U_initial) + if (.not. allocated(DstOutputData%U_initial)) then + allocate(DstOutputData%U_initial(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%U_initial.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%U_initial = SrcOutputData%U_initial + end if + if (allocated(SrcOutputData%Mean_FFWS_array)) then + LB(1:1) = lbound(SrcOutputData%Mean_FFWS_array) + UB(1:1) = ubound(SrcOutputData%Mean_FFWS_array) + if (.not. allocated(DstOutputData%Mean_FFWS_array)) then + allocate(DstOutputData%Mean_FFWS_array(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Mean_FFWS_array.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Mean_FFWS_array = SrcOutputData%Mean_FFWS_array + end if + DstOutputData%Mean_FFWS = SrcOutputData%Mean_FFWS + DstOutputData%TI = SrcOutputData%TI + DstOutputData%TI_downstream = SrcOutputData%TI_downstream + if (allocated(SrcOutputData%wake_u)) then + LB(1:2) = lbound(SrcOutputData%wake_u) + UB(1:2) = ubound(SrcOutputData%wake_u) + if (.not. allocated(DstOutputData%wake_u)) then + allocate(DstOutputData%wake_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%wake_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%wake_u = SrcOutputData%wake_u + end if + if (allocated(SrcOutputData%wake_position)) then + LB(1:3) = lbound(SrcOutputData%wake_position) + UB(1:3) = ubound(SrcOutputData%wake_position) + if (.not. allocated(DstOutputData%wake_position)) then + allocate(DstOutputData%wake_position(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%wake_position.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%wake_position = SrcOutputData%wake_position + end if + if (allocated(SrcOutputData%smoothed_velocity_array)) then + LB(1:2) = lbound(SrcOutputData%smoothed_velocity_array) + UB(1:2) = ubound(SrcOutputData%smoothed_velocity_array) + if (.not. allocated(DstOutputData%smoothed_velocity_array)) then + allocate(DstOutputData%smoothed_velocity_array(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%smoothed_velocity_array.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%smoothed_velocity_array = SrcOutputData%smoothed_velocity_array + end if + DstOutputData%AtmUscale = SrcOutputData%AtmUscale + DstOutputData%du_dz_ABL = SrcOutputData%du_dz_ABL + DstOutputData%total_SDgenpwr = SrcOutputData%total_SDgenpwr + DstOutputData%mean_SDgenpwr = SrcOutputData%mean_SDgenpwr + DstOutputData%avg_ct = SrcOutputData%avg_ct + call InflowWind_CopyOutput(SrcOutputData%IfW, DstOutputData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine DWM_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(DWM_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%turbine_thrust_force)) then + deallocate(OutputData%turbine_thrust_force) + end if + if (allocated(OutputData%induction_factor)) then + deallocate(OutputData%induction_factor) + end if + if (allocated(OutputData%r_initial)) then + deallocate(OutputData%r_initial) + end if + if (allocated(OutputData%U_initial)) then + deallocate(OutputData%U_initial) + end if + if (allocated(OutputData%Mean_FFWS_array)) then + deallocate(OutputData%Mean_FFWS_array) + end if + if (allocated(OutputData%wake_u)) then + deallocate(OutputData%wake_u) + end if + if (allocated(OutputData%wake_position)) then + deallocate(OutputData%wake_position) + end if + if (allocated(OutputData%smoothed_velocity_array)) then + deallocate(OutputData%smoothed_velocity_array) + end if + call InflowWind_DestroyOutput(OutputData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine DWM_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%turbine_thrust_force)) + if (allocated(InData%turbine_thrust_force)) then + call RegPackBounds(Buf, 1, lbound(InData%turbine_thrust_force), ubound(InData%turbine_thrust_force)) + call RegPack(Buf, InData%turbine_thrust_force) + end if + call RegPack(Buf, allocated(InData%induction_factor)) + if (allocated(InData%induction_factor)) then + call RegPackBounds(Buf, 1, lbound(InData%induction_factor), ubound(InData%induction_factor)) + call RegPack(Buf, InData%induction_factor) + end if + call RegPack(Buf, allocated(InData%r_initial)) + if (allocated(InData%r_initial)) then + call RegPackBounds(Buf, 1, lbound(InData%r_initial), ubound(InData%r_initial)) + call RegPack(Buf, InData%r_initial) + end if + call RegPack(Buf, allocated(InData%U_initial)) + if (allocated(InData%U_initial)) then + call RegPackBounds(Buf, 1, lbound(InData%U_initial), ubound(InData%U_initial)) + call RegPack(Buf, InData%U_initial) + end if + call RegPack(Buf, allocated(InData%Mean_FFWS_array)) + if (allocated(InData%Mean_FFWS_array)) then + call RegPackBounds(Buf, 1, lbound(InData%Mean_FFWS_array), ubound(InData%Mean_FFWS_array)) + call RegPack(Buf, InData%Mean_FFWS_array) + end if + call RegPack(Buf, InData%Mean_FFWS) + call RegPack(Buf, InData%TI) + call RegPack(Buf, InData%TI_downstream) + call RegPack(Buf, allocated(InData%wake_u)) + if (allocated(InData%wake_u)) then + call RegPackBounds(Buf, 2, lbound(InData%wake_u), ubound(InData%wake_u)) + call RegPack(Buf, InData%wake_u) + end if + call RegPack(Buf, allocated(InData%wake_position)) + if (allocated(InData%wake_position)) then + call RegPackBounds(Buf, 3, lbound(InData%wake_position), ubound(InData%wake_position)) + call RegPack(Buf, InData%wake_position) + end if + call RegPack(Buf, allocated(InData%smoothed_velocity_array)) + if (allocated(InData%smoothed_velocity_array)) then + call RegPackBounds(Buf, 2, lbound(InData%smoothed_velocity_array), ubound(InData%smoothed_velocity_array)) + call RegPack(Buf, InData%smoothed_velocity_array) + end if + call RegPack(Buf, InData%AtmUscale) + call RegPack(Buf, InData%du_dz_ABL) + call RegPack(Buf, InData%total_SDgenpwr) + call RegPack(Buf, InData%mean_SDgenpwr) + call RegPack(Buf, InData%avg_ct) + call InflowWind_PackOutput(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackOutput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%turbine_thrust_force)) deallocate(OutData%turbine_thrust_force) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%turbine_thrust_force(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_thrust_force.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%turbine_thrust_force) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%induction_factor)) deallocate(OutData%induction_factor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%induction_factor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%induction_factor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%induction_factor) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%r_initial)) deallocate(OutData%r_initial) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_initial(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_initial.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_initial) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%U_initial)) deallocate(OutData%U_initial) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U_initial(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_initial.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U_initial) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Mean_FFWS_array)) deallocate(OutData%Mean_FFWS_array) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mean_FFWS_array(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mean_FFWS_array.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Mean_FFWS_array) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Mean_FFWS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TI) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TI_downstream) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%wake_u)) deallocate(OutData%wake_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%wake_u(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%wake_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%wake_position)) deallocate(OutData%wake_position) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%wake_position(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_position.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%wake_position) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%smoothed_velocity_array)) deallocate(OutData%smoothed_velocity_array) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%smoothed_velocity_array(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%smoothed_velocity_array) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%AtmUscale) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%du_dz_ABL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%total_SDgenpwr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%mean_SDgenpwr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%avg_ct) + if (RegCheckErr(Buf, RoutineName)) return + call InflowWind_UnpackOutput(Buf, OutData%IfW) ! IfW +end subroutine + +subroutine DWM_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(DWM_ContinuousStateType), intent(in) :: SrcContStateData + type(DWM_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%dummy = SrcContStateData%dummy + call InflowWind_CopyContState(SrcContStateData%IfW, DstContStateData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine DWM_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(DWM_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_DestroyContState(ContStateData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine DWM_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dummy) + call InflowWind_PackContState(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + call InflowWind_UnpackContState(Buf, OutData%IfW) ! IfW +end subroutine + +subroutine DWM_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(DWM_DiscreteStateType), intent(in) :: SrcDiscStateData + type(DWM_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%dummy = SrcDiscStateData%dummy + call InflowWind_CopyDiscState(SrcDiscStateData%IfW, DstDiscStateData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine DWM_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(DWM_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_DestroyDiscState(DiscStateData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine DWM_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dummy) + call InflowWind_PackDiscState(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + call InflowWind_UnpackDiscState(Buf, OutData%IfW) ! IfW +end subroutine + +subroutine DWM_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(DWM_ConstraintStateType), intent(in) :: SrcConstrStateData + type(DWM_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%dummy = SrcConstrStateData%dummy + call InflowWind_CopyConstrState(SrcConstrStateData%IfW, DstConstrStateData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine DWM_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(DWM_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_DestroyConstrState(ConstrStateData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine DWM_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dummy) + call InflowWind_PackConstrState(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + call InflowWind_UnpackConstrState(Buf, OutData%IfW) ! IfW +end subroutine + +subroutine DWM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(DWM_InitInputType), intent(in) :: SrcInitInputData + type(DWM_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%dummy = SrcInitInputData%dummy + call InflowWind_CopyInitInput(SrcInitInputData%IfW, DstInitInputData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine DWM_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(DWM_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_DestroyInitInput(InitInputData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine DWM_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dummy) + call InflowWind_PackInitInput(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + call InflowWind_UnpackInitInput(Buf, OutData%IfW) ! IfW +end subroutine + +subroutine DWM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(DWM_InitOutputType), intent(in) :: SrcInitOutputData + type(DWM_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitOutputData%dummy = SrcInitOutputData%dummy + call InflowWind_CopyInitOutput(SrcInitOutputData%IfW, DstInitOutputData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine DWM_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(DWM_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_DestroyInitOutput(InitOutputData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine DWM_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dummy) + call InflowWind_PackInitOutput(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + call InflowWind_UnpackInitOutput(Buf, OutData%IfW) ! IfW +end subroutine + +subroutine DWM_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(DWM_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(DWM_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 = 'DWM_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 DWM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL DWM_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 DWM_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 DWM_Input_ExtrapInterp - - - SUBROUTINE DWM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'DWM_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call DWM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call DWM_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call DWM_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE DWM_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. @@ -9348,131 +3795,83 @@ SUBROUTINE DWM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(DWM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(DWM_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(DWM_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 + TYPE(DWM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(DWM_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(DWM_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 = 'DWM_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 - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 counter variable for arrays - INTEGER :: i4 ! dim4 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + INTEGER :: i4 ! dim4 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(u_out%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN - DO i2 = LBOUND(u_out%Upwind_result%upwind_U,2),UBOUND(u_out%Upwind_result%upwind_U,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_U,1),UBOUND(u_out%Upwind_result%upwind_U,1) - b = -(u1%Upwind_result%upwind_U(i1,i2) - u2%Upwind_result%upwind_U(i1,i2)) - u_out%Upwind_result%upwind_U(i1,i2) = u1%Upwind_result%upwind_U(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN - DO i4 = LBOUND(u_out%Upwind_result%upwind_wakecenter,4),UBOUND(u_out%Upwind_result%upwind_wakecenter,4) - DO i3 = LBOUND(u_out%Upwind_result%upwind_wakecenter,3),UBOUND(u_out%Upwind_result%upwind_wakecenter,3) - DO i2 = LBOUND(u_out%Upwind_result%upwind_wakecenter,2),UBOUND(u_out%Upwind_result%upwind_wakecenter,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_wakecenter,1),UBOUND(u_out%Upwind_result%upwind_wakecenter,1) - b = -(u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)) - u_out%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) = u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + b * ScaleFactor - END DO - END DO - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_meanU,1),UBOUND(u_out%Upwind_result%upwind_meanU,1) - b = -(u1%Upwind_result%upwind_meanU(i1) - u2%Upwind_result%upwind_meanU(i1)) - u_out%Upwind_result%upwind_meanU(i1) = u1%Upwind_result%upwind_meanU(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_TI,1),UBOUND(u_out%Upwind_result%upwind_TI,1) - b = -(u1%Upwind_result%upwind_TI(i1) - u2%Upwind_result%upwind_TI(i1)) - u_out%Upwind_result%upwind_TI(i1) = u1%Upwind_result%upwind_TI(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_small_TI,1),UBOUND(u_out%Upwind_result%upwind_small_TI,1) - b = -(u1%Upwind_result%upwind_small_TI(i1) - u2%Upwind_result%upwind_small_TI(i1)) - u_out%Upwind_result%upwind_small_TI(i1) = u1%Upwind_result%upwind_small_TI(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN - DO i2 = LBOUND(u_out%Upwind_result%upwind_smoothWake,2),UBOUND(u_out%Upwind_result%upwind_smoothWake,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_smoothWake,1),UBOUND(u_out%Upwind_result%upwind_smoothWake,1) - b = -(u1%Upwind_result%upwind_smoothWake(i1,i2) - u2%Upwind_result%upwind_smoothWake(i1,i2)) - u_out%Upwind_result%upwind_smoothWake(i1,i2) = u1%Upwind_result%upwind_smoothWake(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN - DO i1 = LBOUND(u_out%Upwind_result%velocity_aerodyn,1),UBOUND(u_out%Upwind_result%velocity_aerodyn,1) - b = -(u1%Upwind_result%velocity_aerodyn(i1) - u2%Upwind_result%velocity_aerodyn(i1)) - u_out%Upwind_result%velocity_aerodyn(i1) = u1%Upwind_result%velocity_aerodyn(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN - DO i1 = LBOUND(u_out%Upwind_result%TI_downstream,1),UBOUND(u_out%Upwind_result%TI_downstream,1) - b = -(u1%Upwind_result%TI_downstream(i1) - u2%Upwind_result%TI_downstream(i1)) - u_out%Upwind_result%TI_downstream(i1) = u1%Upwind_result%TI_downstream(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN - DO i1 = LBOUND(u_out%Upwind_result%small_scale_TI_downstream,1),UBOUND(u_out%Upwind_result%small_scale_TI_downstream,1) - b = -(u1%Upwind_result%small_scale_TI_downstream(i1) - u2%Upwind_result%small_scale_TI_downstream(i1)) - u_out%Upwind_result%small_scale_TI_downstream(i1) = u1%Upwind_result%small_scale_TI_downstream(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN - DO i2 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,2),UBOUND(u_out%Upwind_result%smoothed_velocity_array,2) - DO i1 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,1),UBOUND(u_out%Upwind_result%smoothed_velocity_array,1) - b = -(u1%Upwind_result%smoothed_velocity_array(i1,i2) - u2%Upwind_result%smoothed_velocity_array(i1,i2)) - u_out%Upwind_result%smoothed_velocity_array(i1,i2) = u1%Upwind_result%smoothed_velocity_array(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN - DO i3 = LBOUND(u_out%Upwind_result%vel_matrix,3),UBOUND(u_out%Upwind_result%vel_matrix,3) - DO i2 = LBOUND(u_out%Upwind_result%vel_matrix,2),UBOUND(u_out%Upwind_result%vel_matrix,2) - DO i1 = LBOUND(u_out%Upwind_result%vel_matrix,1),UBOUND(u_out%Upwind_result%vel_matrix,1) - b = -(u1%Upwind_result%vel_matrix(i1,i2,i3) - u2%Upwind_result%vel_matrix(i1,i2,i3)) - u_out%Upwind_result%vel_matrix(i1,i2,i3) = u1%Upwind_result%vel_matrix(i1,i2,i3) + b * ScaleFactor - END DO - END DO - END DO -END IF ! check if allocated - CALL InflowWind_Input_ExtrapInterp1( u1%IfW, u2%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE DWM_Input_ExtrapInterp1 - - - SUBROUTINE DWM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN + u_out%Upwind_result%upwind_U = a1*u1%Upwind_result%upwind_U + a2*u2%Upwind_result%upwind_U + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN + u_out%Upwind_result%upwind_wakecenter = a1*u1%Upwind_result%upwind_wakecenter + a2*u2%Upwind_result%upwind_wakecenter + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN + u_out%Upwind_result%upwind_meanU = a1*u1%Upwind_result%upwind_meanU + a2*u2%Upwind_result%upwind_meanU + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN + u_out%Upwind_result%upwind_TI = a1*u1%Upwind_result%upwind_TI + a2*u2%Upwind_result%upwind_TI + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN + u_out%Upwind_result%upwind_small_TI = a1*u1%Upwind_result%upwind_small_TI + a2*u2%Upwind_result%upwind_small_TI + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN + u_out%Upwind_result%upwind_smoothWake = a1*u1%Upwind_result%upwind_smoothWake + a2*u2%Upwind_result%upwind_smoothWake + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN + u_out%Upwind_result%velocity_aerodyn = a1*u1%Upwind_result%velocity_aerodyn + a2*u2%Upwind_result%velocity_aerodyn + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN + u_out%Upwind_result%TI_downstream = a1*u1%Upwind_result%TI_downstream + a2*u2%Upwind_result%TI_downstream + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN + u_out%Upwind_result%small_scale_TI_downstream = a1*u1%Upwind_result%small_scale_TI_downstream + a2*u2%Upwind_result%small_scale_TI_downstream + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN + u_out%Upwind_result%smoothed_velocity_array = a1*u1%Upwind_result%smoothed_velocity_array + a2*u2%Upwind_result%smoothed_velocity_array + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN + u_out%Upwind_result%vel_matrix = a1*u1%Upwind_result%vel_matrix + a2*u2%Upwind_result%vel_matrix + END IF ! check if allocated + CALL InflowWind_Input_ExtrapInterp1( u1%IfW, u2%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE DWM_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. @@ -9486,202 +3885,143 @@ SUBROUTINE DWM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(DWM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(DWM_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(DWM_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(DWM_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 + TYPE(DWM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(DWM_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(DWM_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(DWM_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 = 'DWM_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 counter variable for arrays - INTEGER :: i4 ! dim4 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + INTEGER :: i4 ! dim4 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 + 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 + 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 + 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(u_out%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN - DO i2 = LBOUND(u_out%Upwind_result%upwind_U,2),UBOUND(u_out%Upwind_result%upwind_U,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_U,1),UBOUND(u_out%Upwind_result%upwind_U,1) - b = (t(3)**2*(u1%Upwind_result%upwind_U(i1,i2) - u2%Upwind_result%upwind_U(i1,i2)) + t(2)**2*(-u1%Upwind_result%upwind_U(i1,i2) + u3%Upwind_result%upwind_U(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_U(i1,i2) + t(3)*u2%Upwind_result%upwind_U(i1,i2) - t(2)*u3%Upwind_result%upwind_U(i1,i2) ) * scaleFactor - u_out%Upwind_result%upwind_U(i1,i2) = u1%Upwind_result%upwind_U(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN - DO i4 = LBOUND(u_out%Upwind_result%upwind_wakecenter,4),UBOUND(u_out%Upwind_result%upwind_wakecenter,4) - DO i3 = LBOUND(u_out%Upwind_result%upwind_wakecenter,3),UBOUND(u_out%Upwind_result%upwind_wakecenter,3) - DO i2 = LBOUND(u_out%Upwind_result%upwind_wakecenter,2),UBOUND(u_out%Upwind_result%upwind_wakecenter,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_wakecenter,1),UBOUND(u_out%Upwind_result%upwind_wakecenter,1) - b = (t(3)**2*(u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)) + t(2)**2*(-u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + u3%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + t(3)*u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - t(2)*u3%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) ) * scaleFactor - u_out%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) = u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + b + c * t_out - END DO - END DO - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_meanU,1),UBOUND(u_out%Upwind_result%upwind_meanU,1) - b = (t(3)**2*(u1%Upwind_result%upwind_meanU(i1) - u2%Upwind_result%upwind_meanU(i1)) + t(2)**2*(-u1%Upwind_result%upwind_meanU(i1) + u3%Upwind_result%upwind_meanU(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_meanU(i1) + t(3)*u2%Upwind_result%upwind_meanU(i1) - t(2)*u3%Upwind_result%upwind_meanU(i1) ) * scaleFactor - u_out%Upwind_result%upwind_meanU(i1) = u1%Upwind_result%upwind_meanU(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_TI,1),UBOUND(u_out%Upwind_result%upwind_TI,1) - b = (t(3)**2*(u1%Upwind_result%upwind_TI(i1) - u2%Upwind_result%upwind_TI(i1)) + t(2)**2*(-u1%Upwind_result%upwind_TI(i1) + u3%Upwind_result%upwind_TI(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_TI(i1) + t(3)*u2%Upwind_result%upwind_TI(i1) - t(2)*u3%Upwind_result%upwind_TI(i1) ) * scaleFactor - u_out%Upwind_result%upwind_TI(i1) = u1%Upwind_result%upwind_TI(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_small_TI,1),UBOUND(u_out%Upwind_result%upwind_small_TI,1) - b = (t(3)**2*(u1%Upwind_result%upwind_small_TI(i1) - u2%Upwind_result%upwind_small_TI(i1)) + t(2)**2*(-u1%Upwind_result%upwind_small_TI(i1) + u3%Upwind_result%upwind_small_TI(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_small_TI(i1) + t(3)*u2%Upwind_result%upwind_small_TI(i1) - t(2)*u3%Upwind_result%upwind_small_TI(i1) ) * scaleFactor - u_out%Upwind_result%upwind_small_TI(i1) = u1%Upwind_result%upwind_small_TI(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN - DO i2 = LBOUND(u_out%Upwind_result%upwind_smoothWake,2),UBOUND(u_out%Upwind_result%upwind_smoothWake,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_smoothWake,1),UBOUND(u_out%Upwind_result%upwind_smoothWake,1) - b = (t(3)**2*(u1%Upwind_result%upwind_smoothWake(i1,i2) - u2%Upwind_result%upwind_smoothWake(i1,i2)) + t(2)**2*(-u1%Upwind_result%upwind_smoothWake(i1,i2) + u3%Upwind_result%upwind_smoothWake(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_smoothWake(i1,i2) + t(3)*u2%Upwind_result%upwind_smoothWake(i1,i2) - t(2)*u3%Upwind_result%upwind_smoothWake(i1,i2) ) * scaleFactor - u_out%Upwind_result%upwind_smoothWake(i1,i2) = u1%Upwind_result%upwind_smoothWake(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN - DO i1 = LBOUND(u_out%Upwind_result%velocity_aerodyn,1),UBOUND(u_out%Upwind_result%velocity_aerodyn,1) - b = (t(3)**2*(u1%Upwind_result%velocity_aerodyn(i1) - u2%Upwind_result%velocity_aerodyn(i1)) + t(2)**2*(-u1%Upwind_result%velocity_aerodyn(i1) + u3%Upwind_result%velocity_aerodyn(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%velocity_aerodyn(i1) + t(3)*u2%Upwind_result%velocity_aerodyn(i1) - t(2)*u3%Upwind_result%velocity_aerodyn(i1) ) * scaleFactor - u_out%Upwind_result%velocity_aerodyn(i1) = u1%Upwind_result%velocity_aerodyn(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN - DO i1 = LBOUND(u_out%Upwind_result%TI_downstream,1),UBOUND(u_out%Upwind_result%TI_downstream,1) - b = (t(3)**2*(u1%Upwind_result%TI_downstream(i1) - u2%Upwind_result%TI_downstream(i1)) + t(2)**2*(-u1%Upwind_result%TI_downstream(i1) + u3%Upwind_result%TI_downstream(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%TI_downstream(i1) + t(3)*u2%Upwind_result%TI_downstream(i1) - t(2)*u3%Upwind_result%TI_downstream(i1) ) * scaleFactor - u_out%Upwind_result%TI_downstream(i1) = u1%Upwind_result%TI_downstream(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN - DO i1 = LBOUND(u_out%Upwind_result%small_scale_TI_downstream,1),UBOUND(u_out%Upwind_result%small_scale_TI_downstream,1) - b = (t(3)**2*(u1%Upwind_result%small_scale_TI_downstream(i1) - u2%Upwind_result%small_scale_TI_downstream(i1)) + t(2)**2*(-u1%Upwind_result%small_scale_TI_downstream(i1) + u3%Upwind_result%small_scale_TI_downstream(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%small_scale_TI_downstream(i1) + t(3)*u2%Upwind_result%small_scale_TI_downstream(i1) - t(2)*u3%Upwind_result%small_scale_TI_downstream(i1) ) * scaleFactor - u_out%Upwind_result%small_scale_TI_downstream(i1) = u1%Upwind_result%small_scale_TI_downstream(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN - DO i2 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,2),UBOUND(u_out%Upwind_result%smoothed_velocity_array,2) - DO i1 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,1),UBOUND(u_out%Upwind_result%smoothed_velocity_array,1) - b = (t(3)**2*(u1%Upwind_result%smoothed_velocity_array(i1,i2) - u2%Upwind_result%smoothed_velocity_array(i1,i2)) + t(2)**2*(-u1%Upwind_result%smoothed_velocity_array(i1,i2) + u3%Upwind_result%smoothed_velocity_array(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%smoothed_velocity_array(i1,i2) + t(3)*u2%Upwind_result%smoothed_velocity_array(i1,i2) - t(2)*u3%Upwind_result%smoothed_velocity_array(i1,i2) ) * scaleFactor - u_out%Upwind_result%smoothed_velocity_array(i1,i2) = u1%Upwind_result%smoothed_velocity_array(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN - DO i3 = LBOUND(u_out%Upwind_result%vel_matrix,3),UBOUND(u_out%Upwind_result%vel_matrix,3) - DO i2 = LBOUND(u_out%Upwind_result%vel_matrix,2),UBOUND(u_out%Upwind_result%vel_matrix,2) - DO i1 = LBOUND(u_out%Upwind_result%vel_matrix,1),UBOUND(u_out%Upwind_result%vel_matrix,1) - b = (t(3)**2*(u1%Upwind_result%vel_matrix(i1,i2,i3) - u2%Upwind_result%vel_matrix(i1,i2,i3)) + t(2)**2*(-u1%Upwind_result%vel_matrix(i1,i2,i3) + u3%Upwind_result%vel_matrix(i1,i2,i3)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%vel_matrix(i1,i2,i3) + t(3)*u2%Upwind_result%vel_matrix(i1,i2,i3) - t(2)*u3%Upwind_result%vel_matrix(i1,i2,i3) ) * scaleFactor - u_out%Upwind_result%vel_matrix(i1,i2,i3) = u1%Upwind_result%vel_matrix(i1,i2,i3) + b + c * t_out - END DO - END DO - END DO -END IF ! check if allocated - CALL InflowWind_Input_ExtrapInterp2( u1%IfW, u2%IfW, u3%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE DWM_Input_ExtrapInterp2 - - - SUBROUTINE DWM_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(DWM_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(DWM_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN + u_out%Upwind_result%upwind_U = a1*u1%Upwind_result%upwind_U + a2*u2%Upwind_result%upwind_U + a3*u3%Upwind_result%upwind_U + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN + u_out%Upwind_result%upwind_wakecenter = a1*u1%Upwind_result%upwind_wakecenter + a2*u2%Upwind_result%upwind_wakecenter + a3*u3%Upwind_result%upwind_wakecenter + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN + u_out%Upwind_result%upwind_meanU = a1*u1%Upwind_result%upwind_meanU + a2*u2%Upwind_result%upwind_meanU + a3*u3%Upwind_result%upwind_meanU + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN + u_out%Upwind_result%upwind_TI = a1*u1%Upwind_result%upwind_TI + a2*u2%Upwind_result%upwind_TI + a3*u3%Upwind_result%upwind_TI + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN + u_out%Upwind_result%upwind_small_TI = a1*u1%Upwind_result%upwind_small_TI + a2*u2%Upwind_result%upwind_small_TI + a3*u3%Upwind_result%upwind_small_TI + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN + u_out%Upwind_result%upwind_smoothWake = a1*u1%Upwind_result%upwind_smoothWake + a2*u2%Upwind_result%upwind_smoothWake + a3*u3%Upwind_result%upwind_smoothWake + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN + u_out%Upwind_result%velocity_aerodyn = a1*u1%Upwind_result%velocity_aerodyn + a2*u2%Upwind_result%velocity_aerodyn + a3*u3%Upwind_result%velocity_aerodyn + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN + u_out%Upwind_result%TI_downstream = a1*u1%Upwind_result%TI_downstream + a2*u2%Upwind_result%TI_downstream + a3*u3%Upwind_result%TI_downstream + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN + u_out%Upwind_result%small_scale_TI_downstream = a1*u1%Upwind_result%small_scale_TI_downstream + a2*u2%Upwind_result%small_scale_TI_downstream + a3*u3%Upwind_result%small_scale_TI_downstream + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN + u_out%Upwind_result%smoothed_velocity_array = a1*u1%Upwind_result%smoothed_velocity_array + a2*u2%Upwind_result%smoothed_velocity_array + a3*u3%Upwind_result%smoothed_velocity_array + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN + u_out%Upwind_result%vel_matrix = a1*u1%Upwind_result%vel_matrix + a2*u2%Upwind_result%vel_matrix + a3*u3%Upwind_result%vel_matrix + END IF ! check if allocated + CALL InflowWind_Input_ExtrapInterp2( u1%IfW, u2%IfW, u3%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine DWM_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(DWM_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(DWM_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 = 'DWM_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 DWM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL DWM_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 DWM_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 DWM_Output_ExtrapInterp - - - SUBROUTINE DWM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'DWM_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call DWM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call DWM_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call DWM_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE DWM_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. @@ -9693,119 +4033,80 @@ SUBROUTINE DWM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(DWM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(DWM_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(DWM_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 + TYPE(DWM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(DWM_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(DWM_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 = 'DWM_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 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%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN - DO i1 = LBOUND(y_out%turbine_thrust_force,1),UBOUND(y_out%turbine_thrust_force,1) - b = -(y1%turbine_thrust_force(i1) - y2%turbine_thrust_force(i1)) - y_out%turbine_thrust_force(i1) = y1%turbine_thrust_force(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN - DO i1 = LBOUND(y_out%induction_factor,1),UBOUND(y_out%induction_factor,1) - b = -(y1%induction_factor(i1) - y2%induction_factor(i1)) - y_out%induction_factor(i1) = y1%induction_factor(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN - DO i1 = LBOUND(y_out%r_initial,1),UBOUND(y_out%r_initial,1) - b = -(y1%r_initial(i1) - y2%r_initial(i1)) - y_out%r_initial(i1) = y1%r_initial(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN - DO i1 = LBOUND(y_out%U_initial,1),UBOUND(y_out%U_initial,1) - b = -(y1%U_initial(i1) - y2%U_initial(i1)) - y_out%U_initial(i1) = y1%U_initial(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN - DO i1 = LBOUND(y_out%Mean_FFWS_array,1),UBOUND(y_out%Mean_FFWS_array,1) - b = -(y1%Mean_FFWS_array(i1) - y2%Mean_FFWS_array(i1)) - y_out%Mean_FFWS_array(i1) = y1%Mean_FFWS_array(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - b = -(y1%Mean_FFWS - y2%Mean_FFWS) - y_out%Mean_FFWS = y1%Mean_FFWS + b * ScaleFactor - b = -(y1%TI - y2%TI) - y_out%TI = y1%TI + b * ScaleFactor - b = -(y1%TI_downstream - y2%TI_downstream) - y_out%TI_downstream = y1%TI_downstream + b * ScaleFactor -IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN - DO i2 = LBOUND(y_out%wake_u,2),UBOUND(y_out%wake_u,2) - DO i1 = LBOUND(y_out%wake_u,1),UBOUND(y_out%wake_u,1) - b = -(y1%wake_u(i1,i2) - y2%wake_u(i1,i2)) - y_out%wake_u(i1,i2) = y1%wake_u(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN - DO i3 = LBOUND(y_out%wake_position,3),UBOUND(y_out%wake_position,3) - DO i2 = LBOUND(y_out%wake_position,2),UBOUND(y_out%wake_position,2) - DO i1 = LBOUND(y_out%wake_position,1),UBOUND(y_out%wake_position,1) - b = -(y1%wake_position(i1,i2,i3) - y2%wake_position(i1,i2,i3)) - y_out%wake_position(i1,i2,i3) = y1%wake_position(i1,i2,i3) + b * ScaleFactor - END DO - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN - DO i2 = LBOUND(y_out%smoothed_velocity_array,2),UBOUND(y_out%smoothed_velocity_array,2) - DO i1 = LBOUND(y_out%smoothed_velocity_array,1),UBOUND(y_out%smoothed_velocity_array,1) - b = -(y1%smoothed_velocity_array(i1,i2) - y2%smoothed_velocity_array(i1,i2)) - y_out%smoothed_velocity_array(i1,i2) = y1%smoothed_velocity_array(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - b = -(y1%AtmUscale - y2%AtmUscale) - y_out%AtmUscale = y1%AtmUscale + b * ScaleFactor - b = -(y1%du_dz_ABL - y2%du_dz_ABL) - y_out%du_dz_ABL = y1%du_dz_ABL + b * ScaleFactor - b = -(y1%total_SDgenpwr - y2%total_SDgenpwr) - y_out%total_SDgenpwr = y1%total_SDgenpwr + b * ScaleFactor - b = -(y1%mean_SDgenpwr - y2%mean_SDgenpwr) - y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b * ScaleFactor - b = -(y1%avg_ct - y2%avg_ct) - y_out%avg_ct = y1%avg_ct + b * ScaleFactor - CALL InflowWind_Output_ExtrapInterp1( y1%IfW, y2%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE DWM_Output_ExtrapInterp1 - - - SUBROUTINE DWM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN + y_out%turbine_thrust_force = a1*y1%turbine_thrust_force + a2*y2%turbine_thrust_force + END IF ! check if allocated + IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN + y_out%induction_factor = a1*y1%induction_factor + a2*y2%induction_factor + END IF ! check if allocated + IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN + y_out%r_initial = a1*y1%r_initial + a2*y2%r_initial + END IF ! check if allocated + IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN + y_out%U_initial = a1*y1%U_initial + a2*y2%U_initial + END IF ! check if allocated + IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN + y_out%Mean_FFWS_array = a1*y1%Mean_FFWS_array + a2*y2%Mean_FFWS_array + END IF ! check if allocated + y_out%Mean_FFWS = a1*y1%Mean_FFWS + a2*y2%Mean_FFWS + y_out%TI = a1*y1%TI + a2*y2%TI + y_out%TI_downstream = a1*y1%TI_downstream + a2*y2%TI_downstream + IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN + y_out%wake_u = a1*y1%wake_u + a2*y2%wake_u + END IF ! check if allocated + IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN + y_out%wake_position = a1*y1%wake_position + a2*y2%wake_position + END IF ! check if allocated + IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN + y_out%smoothed_velocity_array = a1*y1%smoothed_velocity_array + a2*y2%smoothed_velocity_array + END IF ! check if allocated + y_out%AtmUscale = a1*y1%AtmUscale + a2*y2%AtmUscale + y_out%du_dz_ABL = a1*y1%du_dz_ABL + a2*y2%du_dz_ABL + y_out%total_SDgenpwr = a1*y1%total_SDgenpwr + a2*y2%total_SDgenpwr + y_out%mean_SDgenpwr = a1*y1%mean_SDgenpwr + a2*y2%mean_SDgenpwr + y_out%avg_ct = a1*y1%avg_ct + a2*y2%avg_ct + CALL InflowWind_Output_ExtrapInterp1( y1%IfW, y2%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE DWM_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. @@ -9819,141 +4120,85 @@ SUBROUTINE DWM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(DWM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(DWM_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(DWM_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(DWM_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 + TYPE(DWM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(DWM_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(DWM_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(DWM_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 = 'DWM_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 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 + 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 + 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 + 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%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN - DO i1 = LBOUND(y_out%turbine_thrust_force,1),UBOUND(y_out%turbine_thrust_force,1) - b = (t(3)**2*(y1%turbine_thrust_force(i1) - y2%turbine_thrust_force(i1)) + t(2)**2*(-y1%turbine_thrust_force(i1) + y3%turbine_thrust_force(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%turbine_thrust_force(i1) + t(3)*y2%turbine_thrust_force(i1) - t(2)*y3%turbine_thrust_force(i1) ) * scaleFactor - y_out%turbine_thrust_force(i1) = y1%turbine_thrust_force(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN - DO i1 = LBOUND(y_out%induction_factor,1),UBOUND(y_out%induction_factor,1) - b = (t(3)**2*(y1%induction_factor(i1) - y2%induction_factor(i1)) + t(2)**2*(-y1%induction_factor(i1) + y3%induction_factor(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%induction_factor(i1) + t(3)*y2%induction_factor(i1) - t(2)*y3%induction_factor(i1) ) * scaleFactor - y_out%induction_factor(i1) = y1%induction_factor(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN - DO i1 = LBOUND(y_out%r_initial,1),UBOUND(y_out%r_initial,1) - b = (t(3)**2*(y1%r_initial(i1) - y2%r_initial(i1)) + t(2)**2*(-y1%r_initial(i1) + y3%r_initial(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%r_initial(i1) + t(3)*y2%r_initial(i1) - t(2)*y3%r_initial(i1) ) * scaleFactor - y_out%r_initial(i1) = y1%r_initial(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN - DO i1 = LBOUND(y_out%U_initial,1),UBOUND(y_out%U_initial,1) - b = (t(3)**2*(y1%U_initial(i1) - y2%U_initial(i1)) + t(2)**2*(-y1%U_initial(i1) + y3%U_initial(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%U_initial(i1) + t(3)*y2%U_initial(i1) - t(2)*y3%U_initial(i1) ) * scaleFactor - y_out%U_initial(i1) = y1%U_initial(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN - DO i1 = LBOUND(y_out%Mean_FFWS_array,1),UBOUND(y_out%Mean_FFWS_array,1) - b = (t(3)**2*(y1%Mean_FFWS_array(i1) - y2%Mean_FFWS_array(i1)) + t(2)**2*(-y1%Mean_FFWS_array(i1) + y3%Mean_FFWS_array(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%Mean_FFWS_array(i1) + t(3)*y2%Mean_FFWS_array(i1) - t(2)*y3%Mean_FFWS_array(i1) ) * scaleFactor - y_out%Mean_FFWS_array(i1) = y1%Mean_FFWS_array(i1) + b + c * t_out - END DO -END IF ! check if allocated - b = (t(3)**2*(y1%Mean_FFWS - y2%Mean_FFWS) + t(2)**2*(-y1%Mean_FFWS + y3%Mean_FFWS))* scaleFactor - c = ( (t(2)-t(3))*y1%Mean_FFWS + t(3)*y2%Mean_FFWS - t(2)*y3%Mean_FFWS ) * scaleFactor - y_out%Mean_FFWS = y1%Mean_FFWS + b + c * t_out - b = (t(3)**2*(y1%TI - y2%TI) + t(2)**2*(-y1%TI + y3%TI))* scaleFactor - c = ( (t(2)-t(3))*y1%TI + t(3)*y2%TI - t(2)*y3%TI ) * scaleFactor - y_out%TI = y1%TI + b + c * t_out - b = (t(3)**2*(y1%TI_downstream - y2%TI_downstream) + t(2)**2*(-y1%TI_downstream + y3%TI_downstream))* scaleFactor - c = ( (t(2)-t(3))*y1%TI_downstream + t(3)*y2%TI_downstream - t(2)*y3%TI_downstream ) * scaleFactor - y_out%TI_downstream = y1%TI_downstream + b + c * t_out -IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN - DO i2 = LBOUND(y_out%wake_u,2),UBOUND(y_out%wake_u,2) - DO i1 = LBOUND(y_out%wake_u,1),UBOUND(y_out%wake_u,1) - b = (t(3)**2*(y1%wake_u(i1,i2) - y2%wake_u(i1,i2)) + t(2)**2*(-y1%wake_u(i1,i2) + y3%wake_u(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%wake_u(i1,i2) + t(3)*y2%wake_u(i1,i2) - t(2)*y3%wake_u(i1,i2) ) * scaleFactor - y_out%wake_u(i1,i2) = y1%wake_u(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN - DO i3 = LBOUND(y_out%wake_position,3),UBOUND(y_out%wake_position,3) - DO i2 = LBOUND(y_out%wake_position,2),UBOUND(y_out%wake_position,2) - DO i1 = LBOUND(y_out%wake_position,1),UBOUND(y_out%wake_position,1) - b = (t(3)**2*(y1%wake_position(i1,i2,i3) - y2%wake_position(i1,i2,i3)) + t(2)**2*(-y1%wake_position(i1,i2,i3) + y3%wake_position(i1,i2,i3)))* scaleFactor - c = ( (t(2)-t(3))*y1%wake_position(i1,i2,i3) + t(3)*y2%wake_position(i1,i2,i3) - t(2)*y3%wake_position(i1,i2,i3) ) * scaleFactor - y_out%wake_position(i1,i2,i3) = y1%wake_position(i1,i2,i3) + b + c * t_out - END DO - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN - DO i2 = LBOUND(y_out%smoothed_velocity_array,2),UBOUND(y_out%smoothed_velocity_array,2) - DO i1 = LBOUND(y_out%smoothed_velocity_array,1),UBOUND(y_out%smoothed_velocity_array,1) - b = (t(3)**2*(y1%smoothed_velocity_array(i1,i2) - y2%smoothed_velocity_array(i1,i2)) + t(2)**2*(-y1%smoothed_velocity_array(i1,i2) + y3%smoothed_velocity_array(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%smoothed_velocity_array(i1,i2) + t(3)*y2%smoothed_velocity_array(i1,i2) - t(2)*y3%smoothed_velocity_array(i1,i2) ) * scaleFactor - y_out%smoothed_velocity_array(i1,i2) = y1%smoothed_velocity_array(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - b = (t(3)**2*(y1%AtmUscale - y2%AtmUscale) + t(2)**2*(-y1%AtmUscale + y3%AtmUscale))* scaleFactor - c = ( (t(2)-t(3))*y1%AtmUscale + t(3)*y2%AtmUscale - t(2)*y3%AtmUscale ) * scaleFactor - y_out%AtmUscale = y1%AtmUscale + b + c * t_out - b = (t(3)**2*(y1%du_dz_ABL - y2%du_dz_ABL) + t(2)**2*(-y1%du_dz_ABL + y3%du_dz_ABL))* scaleFactor - c = ( (t(2)-t(3))*y1%du_dz_ABL + t(3)*y2%du_dz_ABL - t(2)*y3%du_dz_ABL ) * scaleFactor - y_out%du_dz_ABL = y1%du_dz_ABL + b + c * t_out - b = (t(3)**2*(y1%total_SDgenpwr - y2%total_SDgenpwr) + t(2)**2*(-y1%total_SDgenpwr + y3%total_SDgenpwr))* scaleFactor - c = ( (t(2)-t(3))*y1%total_SDgenpwr + t(3)*y2%total_SDgenpwr - t(2)*y3%total_SDgenpwr ) * scaleFactor - y_out%total_SDgenpwr = y1%total_SDgenpwr + b + c * t_out - b = (t(3)**2*(y1%mean_SDgenpwr - y2%mean_SDgenpwr) + t(2)**2*(-y1%mean_SDgenpwr + y3%mean_SDgenpwr))* scaleFactor - c = ( (t(2)-t(3))*y1%mean_SDgenpwr + t(3)*y2%mean_SDgenpwr - t(2)*y3%mean_SDgenpwr ) * scaleFactor - y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b + c * t_out - b = (t(3)**2*(y1%avg_ct - y2%avg_ct) + t(2)**2*(-y1%avg_ct + y3%avg_ct))* scaleFactor - c = ( (t(2)-t(3))*y1%avg_ct + t(3)*y2%avg_ct - t(2)*y3%avg_ct ) * scaleFactor - y_out%avg_ct = y1%avg_ct + b + c * t_out - CALL InflowWind_Output_ExtrapInterp2( y1%IfW, y2%IfW, y3%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE DWM_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN + y_out%turbine_thrust_force = a1*y1%turbine_thrust_force + a2*y2%turbine_thrust_force + a3*y3%turbine_thrust_force + END IF ! check if allocated + IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN + y_out%induction_factor = a1*y1%induction_factor + a2*y2%induction_factor + a3*y3%induction_factor + END IF ! check if allocated + IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN + y_out%r_initial = a1*y1%r_initial + a2*y2%r_initial + a3*y3%r_initial + END IF ! check if allocated + IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN + y_out%U_initial = a1*y1%U_initial + a2*y2%U_initial + a3*y3%U_initial + END IF ! check if allocated + IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN + y_out%Mean_FFWS_array = a1*y1%Mean_FFWS_array + a2*y2%Mean_FFWS_array + a3*y3%Mean_FFWS_array + END IF ! check if allocated + y_out%Mean_FFWS = a1*y1%Mean_FFWS + a2*y2%Mean_FFWS + a3*y3%Mean_FFWS + y_out%TI = a1*y1%TI + a2*y2%TI + a3*y3%TI + y_out%TI_downstream = a1*y1%TI_downstream + a2*y2%TI_downstream + a3*y3%TI_downstream + IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN + y_out%wake_u = a1*y1%wake_u + a2*y2%wake_u + a3*y3%wake_u + END IF ! check if allocated + IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN + y_out%wake_position = a1*y1%wake_position + a2*y2%wake_position + a3*y3%wake_position + END IF ! check if allocated + IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN + y_out%smoothed_velocity_array = a1*y1%smoothed_velocity_array + a2*y2%smoothed_velocity_array + a3*y3%smoothed_velocity_array + END IF ! check if allocated + y_out%AtmUscale = a1*y1%AtmUscale + a2*y2%AtmUscale + a3*y3%AtmUscale + y_out%du_dz_ABL = a1*y1%du_dz_ABL + a2*y2%du_dz_ABL + a3*y3%du_dz_ABL + y_out%total_SDgenpwr = a1*y1%total_SDgenpwr + a2*y2%total_SDgenpwr + a3*y3%total_SDgenpwr + y_out%mean_SDgenpwr = a1*y1%mean_SDgenpwr + a2*y2%mean_SDgenpwr + a3*y3%mean_SDgenpwr + y_out%avg_ct = a1*y1%avg_ct + a2*y2%avg_ct + a3*y3%avg_ct + CALL InflowWind_Output_ExtrapInterp2( y1%IfW, y2%IfW, y3%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE DWM_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index 4ca953b3b8..d01c244767 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -52,53 +52,53 @@ MODULE AWAE_Types ! ======================= ! ========= AWAE_InputFileType ======= TYPE, PUBLIC :: AWAE_InputFileType - REAL(ReKi) :: dr !< Radial increment of radial finite-difference grid [>0.0] [m] - REAL(DbKi) :: dt_low !< Low-resolution (FAST.Farm driver/glue code) time step [s] - INTEGER(IntKi) :: NumTurbines !< Number of wind turbines in the farm [>=1] [-] - INTEGER(IntKi) :: NumRadii !< Number of radii in the radial finite-difference grid [>=2] [-] - INTEGER(IntKi) :: NumPlanes !< Number of wake planes downwind of the rotor where the wake is propagated [>=2] [-] + REAL(ReKi) :: dr = 0.0_ReKi !< Radial increment of radial finite-difference grid [>0.0] [m] + REAL(DbKi) :: dt_low = 0.0_R8Ki !< Low-resolution (FAST.Farm driver/glue code) time step [s] + INTEGER(IntKi) :: NumTurbines = 0_IntKi !< Number of wind turbines in the farm [>=1] [-] + INTEGER(IntKi) :: NumRadii = 0_IntKi !< Number of radii in the radial finite-difference grid [>=2] [-] + INTEGER(IntKi) :: NumPlanes = 0_IntKi !< Number of wake planes downwind of the rotor where the wake is propagated [>=2] [-] CHARACTER(1024) :: WindFilePath !< Path name to the Root folder containing the wind data files from ABLSolver precursor [-] - LOGICAL :: WrDisWind !< Write disturbed wind data to /Low/Dis.t.vtk etc.? [-] - INTEGER(IntKi) :: NOutDisWindXY !< Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9] [-] + LOGICAL :: WrDisWind = .false. !< Write disturbed wind data to /Low/Dis.t.vtk etc.? [-] + INTEGER(IntKi) :: NOutDisWindXY = 0_IntKi !< Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindZ !< Z coordinates of XY planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXY] [meters] - INTEGER(IntKi) :: NOutDisWindYZ !< Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9] [-] + INTEGER(IntKi) :: NOutDisWindYZ = 0_IntKi !< Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindX !< X coordinates of YZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindYZ] [meters] - INTEGER(IntKi) :: NOutDisWindXZ !< Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9] [-] + INTEGER(IntKi) :: NOutDisWindXZ = 0_IntKi !< Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindY !< Y coordinates of XZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXZ] [meters] - REAL(DbKi) :: WrDisDT !< The time between vtk outputs [must be a multiple of the low resolution time step] [s] - LOGICAL :: ChkWndFiles !< Check all the ambient wind files for data consistency (flag) [-] - INTEGER(IntKi) :: Mod_Meander !< Spatial filter model for wake meandering {1: uniform, 2: truncated jinc, 3: windowed jinc} [DEFAULT=2] [-] - REAL(ReKi) :: C_Meander !< Calibrated parameter for wake meandering [>=1.0] [DEFAULT=1.9] [-] - INTEGER(IntKi) :: Mod_AmbWind !< Ambient wind model {1: high-fidelity precursor in VTK format, 2: InflowWind module} [-] + REAL(DbKi) :: WrDisDT = 0.0_R8Ki !< The time between vtk outputs [must be a multiple of the low resolution time step] [s] + LOGICAL :: ChkWndFiles = .false. !< Check all the ambient wind files for data consistency (flag) [-] + INTEGER(IntKi) :: Mod_Meander = 0_IntKi !< Spatial filter model for wake meandering {1: uniform, 2: truncated jinc, 3: windowed jinc} [DEFAULT=2] [-] + REAL(ReKi) :: C_Meander = 0.0_ReKi !< Calibrated parameter for wake meandering [>=1.0] [DEFAULT=1.9] [-] + INTEGER(IntKi) :: Mod_AmbWind = 0_IntKi !< Ambient wind model {1: high-fidelity precursor in VTK format, 2: InflowWind module} [-] CHARACTER(1024) :: InflowFile !< Name of file containing InflowWind module input parameters [-] - REAL(DbKi) :: dt_high !< High-resolution (FAST) time step [s] + REAL(DbKi) :: dt_high = 0.0_R8Ki !< High-resolution (FAST) time step [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X0_high !< X-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y0_high !< Y-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Z0_high !< Z-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dX_high !< X-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dY_high !< Y-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dZ_high !< Z-component of the spatial increment of the high-resolution spatial domain for each turbine [m] - INTEGER(IntKi) :: nX_high !< Number of high-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_high !< Number of high-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_high !< Number of high-resolution spatial nodes in Z direction [-] - 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] - REAL(ReKi) :: dZ_low !< The spacing of the low-resolution nodes in Z direction [m] - INTEGER(IntKi) :: nX_low !< Number of low-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_low !< Number of low-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_low !< Number of low-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: X0_low !< X-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Y0_low !< Y-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Z0_low !< Z-component of the origin of the low-resolution spatial domain [m] + INTEGER(IntKi) :: nX_high = 0_IntKi !< Number of high-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_high = 0_IntKi !< Number of high-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_high = 0_IntKi !< Number of high-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: dX_low = 0.0_ReKi !< The spacing of the low-resolution nodes in X direction [m] + REAL(ReKi) :: dY_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Y direction [m] + REAL(ReKi) :: dZ_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Z direction [m] + INTEGER(IntKi) :: nX_low = 0_IntKi !< Number of low-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_low = 0_IntKi !< Number of low-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_low = 0_IntKi !< Number of low-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: X0_low = 0.0_ReKi !< X-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Y0_low = 0.0_ReKi !< Y-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Z0_low = 0.0_ReKi !< Z-component of the origin of the low-resolution spatial domain [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WT_Position !< X-Y-Z position of each wind turbine; index 1 = XYZ; index 2 = turbine number [meters] - INTEGER(IntKi) :: Mod_Projection !< Switch to select how the wake plane velocity is projected in AWAE {1: keep all components, 2: project against plane normal} or DEFAULT [DEFAULT=1: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wake is 2] [-] + INTEGER(IntKi) :: Mod_Projection = 0_IntKi !< Switch to select how the wake plane velocity is projected in AWAE {1: keep all components, 2: project against plane normal} or DEFAULT [DEFAULT=1: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wake is 2] [-] END TYPE AWAE_InputFileType ! ======================= ! ========= AWAE_InitInputType ======= TYPE, PUBLIC :: AWAE_InitInputType TYPE(AWAE_InputFileType) :: InputFileData !< FAST.Farm input-file data for AWAE module [-] - INTEGER(IntKi) :: n_high_low !< Number of high-resolution time steps per low [-] - INTEGER(IntKi) :: NumDT !< Number of low-resolution (FAST.Farm driver/glue code) time steps [-] + INTEGER(IntKi) :: n_high_low = 0_IntKi !< Number of high-resolution time steps per low [-] + INTEGER(IntKi) :: NumDT = 0_IntKi !< Number of low-resolution (FAST.Farm driver/glue code) time steps [-] CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] END TYPE AWAE_InitInputType ! ======================= @@ -111,18 +111,18 @@ MODULE AWAE_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dX_high !< X-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dY_high !< Y-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dZ_high !< Z-component of the spatial increment of the high-resolution spatial domain for each turbine [m] - INTEGER(IntKi) :: nX_high !< Number of high-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_high !< Number of high-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_high !< Number of high-resolution spatial nodes in Z direction [-] - 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] - REAL(ReKi) :: dZ_low !< The spacing of the low-resolution nodes in Z direction [m] - INTEGER(IntKi) :: nX_low !< Number of low-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_low !< Number of low-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_low !< Number of low-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: X0_low !< X-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Y0_low !< Y-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Z0_low !< Z-component of the origin of the low-resolution spatial domain [m] + INTEGER(IntKi) :: nX_high = 0_IntKi !< Number of high-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_high = 0_IntKi !< Number of high-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_high = 0_IntKi !< Number of high-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: dX_low = 0.0_ReKi !< The spacing of the low-resolution nodes in X direction [m] + REAL(ReKi) :: dY_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Y direction [m] + REAL(ReKi) :: dZ_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Z direction [m] + INTEGER(IntKi) :: nX_low = 0_IntKi !< Number of low-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_low = 0_IntKi !< Number of low-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_low = 0_IntKi !< Number of low-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: X0_low = 0.0_ReKi !< X-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Y0_low = 0.0_ReKi !< Y-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Z0_low = 0.0_ReKi !< Z-component of the origin of the low-resolution spatial domain [m] TYPE(AWAE_HighWindGridPtr) , DIMENSION(:), ALLOCATABLE :: Vdist_High !< Pointers to Wind velocity of disturbed wind (ambient + wakes) across each high-resolution domain around a turbine for each high-resolution step within a low-resolution step [m/s] END TYPE AWAE_InitOutputType ! ======================= @@ -173,57 +173,57 @@ MODULE AWAE_Types ! ========= AWAE_ParameterType ======= TYPE, PUBLIC :: AWAE_ParameterType CHARACTER(1024) :: WindFilePath !< Path name to the Root folder containing the wind data files from ABLSolver precursor [-] - INTEGER(IntKi) :: NumTurbines !< Number of wind turbines in the farm [>=1] [-] - INTEGER(IntKi) :: NumRadii !< Number of radii in the radial finite-difference grid [>=2] [-] - INTEGER(IntKi) :: NumPlanes !< Number of wake planes downwind of the rotor where the wake is propagated [>=2] [-] + INTEGER(IntKi) :: NumTurbines = 0_IntKi !< Number of wind turbines in the farm [>=1] [-] + INTEGER(IntKi) :: NumRadii = 0_IntKi !< Number of radii in the radial finite-difference grid [>=2] [-] + INTEGER(IntKi) :: NumPlanes = 0_IntKi !< Number of wake planes downwind of the rotor where the wake is propagated [>=2] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y !< Horizontal discretization of the wake planes [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: z !< Vertical discretization of the wake planes [m] - INTEGER(IntKi) :: Mod_AmbWind !< Ambient wind model {1: high-fidelity precursor in VTK format, 2: InflowWind module} [-] - INTEGER(IntKi) :: nX_low !< Number of low-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_low !< Number of low-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_low !< Number of low-resolution spatial nodes in Z direction [-] - INTEGER(IntKi) :: NumGrid_low !< Total number of low-resolution spatial nodes [-] - INTEGER(IntKi) :: n_rp_max !< Maximum possible number of points in the polar grid for the wake plane at each rotor [-] - REAL(ReKi) :: dpol !< Spatial resolution of the polar grid for each wake plane of each turbine [m] - REAL(ReKi) , DIMENSION(1:3) :: dXYZ_low !< XYZ-components of the spatial increment of the low-resolution domain [m] - 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] - REAL(ReKi) :: dZ_low !< The spacing of the low-resolution nodes in Z direction [m] - REAL(ReKi) :: X0_low !< X-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Y0_low !< Y-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Z0_low !< Z-component of the origin of the low-resolution spatial domain [m] + INTEGER(IntKi) :: Mod_AmbWind = 0_IntKi !< Ambient wind model {1: high-fidelity precursor in VTK format, 2: InflowWind module} [-] + INTEGER(IntKi) :: nX_low = 0_IntKi !< Number of low-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_low = 0_IntKi !< Number of low-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_low = 0_IntKi !< Number of low-resolution spatial nodes in Z direction [-] + INTEGER(IntKi) :: NumGrid_low = 0_IntKi !< Total number of low-resolution spatial nodes [-] + INTEGER(IntKi) :: n_rp_max = 0_IntKi !< Maximum possible number of points in the polar grid for the wake plane at each rotor [-] + REAL(ReKi) :: dpol = 0.0_ReKi !< Spatial resolution of the polar grid for each wake plane of each turbine [m] + REAL(ReKi) , DIMENSION(1:3) :: dXYZ_low = 0.0_ReKi !< XYZ-components of the spatial increment of the low-resolution domain [m] + REAL(ReKi) :: dX_low = 0.0_ReKi !< The spacing of the low-resolution nodes in X direction [m] + REAL(ReKi) :: dY_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Y direction [m] + REAL(ReKi) :: dZ_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Z direction [m] + REAL(ReKi) :: X0_low = 0.0_ReKi !< X-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Y0_low = 0.0_ReKi !< Y-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Z0_low = 0.0_ReKi !< Z-component of the origin of the low-resolution spatial domain [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X0_high !< X-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y0_high !< Y-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Z0_high !< Z-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dX_high !< X-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dY_high !< Y-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dZ_high !< Z-component of the spatial increment of the high-resolution spatial domain for each turbine [m] - INTEGER(IntKi) :: nX_high !< Number of high-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_high !< Number of high-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_high !< Number of high-resolution spatial nodes in Z direction [-] + INTEGER(IntKi) :: nX_high = 0_IntKi !< Number of high-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_high = 0_IntKi !< Number of high-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_high = 0_IntKi !< Number of high-resolution spatial nodes in Z direction [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Grid_low !< XYZ components (global positions) of the spatial discretization of the low-resolution spatial domain [m] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Grid_high !< XYZ components (global positions) of the spatial discretization of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WT_Position !< X-Y-Z position of each wind turbine; index 1 = XYZ; index 2 = turbine number [meters] - INTEGER(IntKi) :: n_high_low !< Number of high-resolution time steps per low [-] - REAL(DbKi) :: dt_low !< Low-resolution (FAST.Farm driver/glue code) time step [s] - REAL(DbKi) :: dt_high !< High-resolution (FAST) time step [s] - INTEGER(IntKi) :: NumDT !< Number of low-resolution (FAST.Farm driver/glue code) time steps [-] - INTEGER(IntKi) :: Mod_Meander !< Spatial filter model for wake meandering [-] - REAL(ReKi) :: C_Meander !< Calibrated parameter for wake meandering [-] - REAL(ReKi) :: C_ScaleDiam !< Normalized wake volume radius for wake meandering (normalized by the wake diameter) [-] - INTEGER(IntKi) :: Mod_Projection !< Switch to select how the wake plane velocity is projected in AWAE {1: keep all components, 2: project against plane normal} or DEFAULT [DEFAULT=1: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wake is 2] [-] + INTEGER(IntKi) :: n_high_low = 0_IntKi !< Number of high-resolution time steps per low [-] + REAL(DbKi) :: dt_low = 0.0_R8Ki !< Low-resolution (FAST.Farm driver/glue code) time step [s] + REAL(DbKi) :: dt_high = 0.0_R8Ki !< High-resolution (FAST) time step [s] + INTEGER(IntKi) :: NumDT = 0_IntKi !< Number of low-resolution (FAST.Farm driver/glue code) time steps [-] + INTEGER(IntKi) :: Mod_Meander = 0_IntKi !< Spatial filter model for wake meandering [-] + REAL(ReKi) :: C_Meander = 0.0_ReKi !< Calibrated parameter for wake meandering [-] + REAL(ReKi) :: C_ScaleDiam = 0.0_ReKi !< Normalized wake volume radius for wake meandering (normalized by the wake diameter) [-] + INTEGER(IntKi) :: Mod_Projection = 0_IntKi !< Switch to select how the wake plane velocity is projected in AWAE {1: keep all components, 2: project against plane normal} or DEFAULT [DEFAULT=1: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wake is 2] [-] TYPE(InflowWind_ParameterType) , DIMENSION(:), ALLOCATABLE :: IfW !< InflowWind module parameters [-] - INTEGER(IntKi) :: WrDisSkp1 !< Number of time steps to skip plus one [-] - LOGICAL :: WrDisWind !< Write disturbed wind data to /Low/Dis.t.vtk etc.? [-] - INTEGER(IntKi) :: NOutDisWindXY !< Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9] [-] + INTEGER(IntKi) :: WrDisSkp1 = 0_IntKi !< Number of time steps to skip plus one [-] + LOGICAL :: WrDisWind = .false. !< Write disturbed wind data to /Low/Dis.t.vtk etc.? [-] + INTEGER(IntKi) :: NOutDisWindXY = 0_IntKi !< Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindZ !< Z coordinates of XY planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXY] [meters] - INTEGER(IntKi) :: NOutDisWindYZ !< Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9] [-] + INTEGER(IntKi) :: NOutDisWindYZ = 0_IntKi !< Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindX !< X coordinates of YZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindYZ] [meters] - INTEGER(IntKi) :: NOutDisWindXZ !< Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9] [-] + INTEGER(IntKi) :: NOutDisWindXZ = 0_IntKi !< Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindY !< Y coordinates of XZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXZ] [meters] CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] CHARACTER(1024) :: OutFileVTKRoot !< The root name for VTK outputs [-] - INTEGER(IntKi) :: VTK_tWidth !< Number of characters for VTK timestamp outputs [-] + INTEGER(IntKi) :: VTK_tWidth = 0_IntKi !< Number of characters for VTK timestamp outputs [-] END TYPE AWAE_ParameterType ! ======================= ! ========= AWAE_OutputType ======= @@ -246,7627 +246,3331 @@ MODULE AWAE_Types END TYPE AWAE_InputType ! ======================= CONTAINS - SUBROUTINE AWAE_CopyHighWindGrid( SrcHighWindGridData, DstHighWindGridData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_HighWindGrid), INTENT(IN) :: SrcHighWindGridData - TYPE(AWAE_HighWindGrid), INTENT(INOUT) :: DstHighWindGridData - 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 = 'AWAE_CopyHighWindGrid' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcHighWindGridData%data)) THEN - i1_l = LBOUND(SrcHighWindGridData%data,1) - i1_u = UBOUND(SrcHighWindGridData%data,1) - i2_l = LBOUND(SrcHighWindGridData%data,2) - i2_u = UBOUND(SrcHighWindGridData%data,2) - i3_l = LBOUND(SrcHighWindGridData%data,3) - i3_u = UBOUND(SrcHighWindGridData%data,3) - i4_l = LBOUND(SrcHighWindGridData%data,4) - i4_u = UBOUND(SrcHighWindGridData%data,4) - i5_l = LBOUND(SrcHighWindGridData%data,5) - i5_u = UBOUND(SrcHighWindGridData%data,5) - IF (.NOT. ASSOCIATED(DstHighWindGridData%data)) THEN - ALLOCATE(DstHighWindGridData%data(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 DstHighWindGridData%data.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstHighWindGridData%data = SrcHighWindGridData%data -ENDIF - END SUBROUTINE AWAE_CopyHighWindGrid - - SUBROUTINE AWAE_DestroyHighWindGrid( HighWindGridData, ErrStat, ErrMsg ) - TYPE(AWAE_HighWindGrid), INTENT(INOUT) :: HighWindGridData - 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 = 'AWAE_DestroyHighWindGrid' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(HighWindGridData%data)) THEN - DEALLOCATE(HighWindGridData%data) - HighWindGridData%data => NULL() -ENDIF - END SUBROUTINE AWAE_DestroyHighWindGrid - - SUBROUTINE AWAE_PackHighWindGrid( 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(AWAE_HighWindGrid), 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 = 'AWAE_PackHighWindGrid' - ! 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 ! data allocated yes/no - IF ( ASSOCIATED(InData%data) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! data upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%data) ! data - 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. ASSOCIATED(InData%data) ) 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%data,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%data,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%data,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%data,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%data,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%data,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%data,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%data,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%data,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%data,5) - Int_Xferred = Int_Xferred + 2 - DO i5 = LBOUND(InData%data,5), UBOUND(InData%data,5) - DO i4 = LBOUND(InData%data,4), UBOUND(InData%data,4) - DO i3 = LBOUND(InData%data,3), UBOUND(InData%data,3) - DO i2 = LBOUND(InData%data,2), UBOUND(InData%data,2) - DO i1 = LBOUND(InData%data,1), UBOUND(InData%data,1) - ReKiBuf(Re_Xferred) = InData%data(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - END SUBROUTINE AWAE_PackHighWindGrid - - SUBROUTINE AWAE_UnPackHighWindGrid( 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(AWAE_HighWindGrid), 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 = 'AWAE_UnPackHighWindGrid' - ! 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 ! data 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%data)) DEALLOCATE(OutData%data) - ALLOCATE(OutData%data(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%data.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%data,5), UBOUND(OutData%data,5) - DO i4 = LBOUND(OutData%data,4), UBOUND(OutData%data,4) - DO i3 = LBOUND(OutData%data,3), UBOUND(OutData%data,3) - DO i2 = LBOUND(OutData%data,2), UBOUND(OutData%data,2) - DO i1 = LBOUND(OutData%data,1), UBOUND(OutData%data,1) - OutData%data(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 - END SUBROUTINE AWAE_UnPackHighWindGrid - - SUBROUTINE AWAE_CopyHighWindGridPtr( SrcHighWindGridPtrData, DstHighWindGridPtrData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_HighWindGridPtr), INTENT(IN) :: SrcHighWindGridPtrData - TYPE(AWAE_HighWindGridPtr), INTENT(INOUT) :: DstHighWindGridPtrData - 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 = 'AWAE_CopyHighWindGridPtr' -! +subroutine AWAE_CopyHighWindGrid(SrcHighWindGridData, DstHighWindGridData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_HighWindGrid), intent(in) :: SrcHighWindGridData + type(AWAE_HighWindGrid), intent(inout) :: DstHighWindGridData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AWAE_CopyHighWindGrid' ErrStat = ErrID_None - ErrMsg = "" - DstHighWindGridPtrData%data => SrcHighWindGridPtrData%data - END SUBROUTINE AWAE_CopyHighWindGridPtr - - SUBROUTINE AWAE_DestroyHighWindGridPtr( HighWindGridPtrData, ErrStat, ErrMsg ) - TYPE(AWAE_HighWindGridPtr), INTENT(INOUT) :: HighWindGridPtrData - 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 = 'AWAE_DestroyHighWindGridPtr' - - ErrStat = ErrID_None - ErrMsg = "" - -NULLIFY(HighWindGridPtrData%data) - END SUBROUTINE AWAE_DestroyHighWindGridPtr - - SUBROUTINE AWAE_PackHighWindGridPtr( 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(AWAE_HighWindGridPtr), 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 = 'AWAE_PackHighWindGridPtr' - ! 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 - 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 - - END SUBROUTINE AWAE_PackHighWindGridPtr - - SUBROUTINE AWAE_UnPackHighWindGridPtr( 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(AWAE_HighWindGridPtr), 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 = 'AWAE_UnPackHighWindGridPtr' - ! 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 - NULLIFY(OutData%data) - END SUBROUTINE AWAE_UnPackHighWindGridPtr - - SUBROUTINE AWAE_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_InputFileType), INTENT(IN) :: SrcInputFileTypeData - TYPE(AWAE_InputFileType), INTENT(INOUT) :: DstInputFileTypeData - 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 = 'AWAE_CopyInputFileType' -! + ErrMsg = '' + if (associated(SrcHighWindGridData%data)) then + LB(1:5) = lbound(SrcHighWindGridData%data) + UB(1:5) = ubound(SrcHighWindGridData%data) + if (.not. associated(DstHighWindGridData%data)) then + allocate(DstHighWindGridData%data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHighWindGridData%data.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstHighWindGridData%data = SrcHighWindGridData%data + end if +end subroutine + +subroutine AWAE_DestroyHighWindGrid(HighWindGridData, ErrStat, ErrMsg) + type(AWAE_HighWindGrid), intent(inout) :: HighWindGridData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AWAE_DestroyHighWindGrid' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileTypeData%dr = SrcInputFileTypeData%dr - DstInputFileTypeData%dt_low = SrcInputFileTypeData%dt_low - DstInputFileTypeData%NumTurbines = SrcInputFileTypeData%NumTurbines - DstInputFileTypeData%NumRadii = SrcInputFileTypeData%NumRadii - DstInputFileTypeData%NumPlanes = SrcInputFileTypeData%NumPlanes - DstInputFileTypeData%WindFilePath = SrcInputFileTypeData%WindFilePath - DstInputFileTypeData%WrDisWind = SrcInputFileTypeData%WrDisWind - DstInputFileTypeData%NOutDisWindXY = SrcInputFileTypeData%NOutDisWindXY -IF (ALLOCATED(SrcInputFileTypeData%OutDisWindZ)) THEN - i1_l = LBOUND(SrcInputFileTypeData%OutDisWindZ,1) - i1_u = UBOUND(SrcInputFileTypeData%OutDisWindZ,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%OutDisWindZ)) THEN - ALLOCATE(DstInputFileTypeData%OutDisWindZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%OutDisWindZ = SrcInputFileTypeData%OutDisWindZ -ENDIF - DstInputFileTypeData%NOutDisWindYZ = SrcInputFileTypeData%NOutDisWindYZ -IF (ALLOCATED(SrcInputFileTypeData%OutDisWindX)) THEN - i1_l = LBOUND(SrcInputFileTypeData%OutDisWindX,1) - i1_u = UBOUND(SrcInputFileTypeData%OutDisWindX,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%OutDisWindX)) THEN - ALLOCATE(DstInputFileTypeData%OutDisWindX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%OutDisWindX = SrcInputFileTypeData%OutDisWindX -ENDIF - DstInputFileTypeData%NOutDisWindXZ = SrcInputFileTypeData%NOutDisWindXZ -IF (ALLOCATED(SrcInputFileTypeData%OutDisWindY)) THEN - i1_l = LBOUND(SrcInputFileTypeData%OutDisWindY,1) - i1_u = UBOUND(SrcInputFileTypeData%OutDisWindY,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%OutDisWindY)) THEN - ALLOCATE(DstInputFileTypeData%OutDisWindY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%OutDisWindY = SrcInputFileTypeData%OutDisWindY -ENDIF - DstInputFileTypeData%WrDisDT = SrcInputFileTypeData%WrDisDT - DstInputFileTypeData%ChkWndFiles = SrcInputFileTypeData%ChkWndFiles - DstInputFileTypeData%Mod_Meander = SrcInputFileTypeData%Mod_Meander - DstInputFileTypeData%C_Meander = SrcInputFileTypeData%C_Meander - DstInputFileTypeData%Mod_AmbWind = SrcInputFileTypeData%Mod_AmbWind - DstInputFileTypeData%InflowFile = SrcInputFileTypeData%InflowFile - DstInputFileTypeData%dt_high = SrcInputFileTypeData%dt_high -IF (ALLOCATED(SrcInputFileTypeData%X0_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%X0_high,1) - i1_u = UBOUND(SrcInputFileTypeData%X0_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%X0_high)) THEN - ALLOCATE(DstInputFileTypeData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%X0_high = SrcInputFileTypeData%X0_high -ENDIF -IF (ALLOCATED(SrcInputFileTypeData%Y0_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%Y0_high,1) - i1_u = UBOUND(SrcInputFileTypeData%Y0_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%Y0_high)) THEN - ALLOCATE(DstInputFileTypeData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%Y0_high = SrcInputFileTypeData%Y0_high -ENDIF -IF (ALLOCATED(SrcInputFileTypeData%Z0_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%Z0_high,1) - i1_u = UBOUND(SrcInputFileTypeData%Z0_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%Z0_high)) THEN - ALLOCATE(DstInputFileTypeData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%Z0_high = SrcInputFileTypeData%Z0_high -ENDIF -IF (ALLOCATED(SrcInputFileTypeData%dX_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%dX_high,1) - i1_u = UBOUND(SrcInputFileTypeData%dX_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%dX_high)) THEN - ALLOCATE(DstInputFileTypeData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%dX_high = SrcInputFileTypeData%dX_high -ENDIF -IF (ALLOCATED(SrcInputFileTypeData%dY_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%dY_high,1) - i1_u = UBOUND(SrcInputFileTypeData%dY_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%dY_high)) THEN - ALLOCATE(DstInputFileTypeData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%dY_high = SrcInputFileTypeData%dY_high -ENDIF -IF (ALLOCATED(SrcInputFileTypeData%dZ_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%dZ_high,1) - i1_u = UBOUND(SrcInputFileTypeData%dZ_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%dZ_high)) THEN - ALLOCATE(DstInputFileTypeData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%dZ_high = SrcInputFileTypeData%dZ_high -ENDIF - DstInputFileTypeData%nX_high = SrcInputFileTypeData%nX_high - DstInputFileTypeData%nY_high = SrcInputFileTypeData%nY_high - DstInputFileTypeData%nZ_high = SrcInputFileTypeData%nZ_high - DstInputFileTypeData%dX_low = SrcInputFileTypeData%dX_low - DstInputFileTypeData%dY_low = SrcInputFileTypeData%dY_low - DstInputFileTypeData%dZ_low = SrcInputFileTypeData%dZ_low - DstInputFileTypeData%nX_low = SrcInputFileTypeData%nX_low - DstInputFileTypeData%nY_low = SrcInputFileTypeData%nY_low - DstInputFileTypeData%nZ_low = SrcInputFileTypeData%nZ_low - DstInputFileTypeData%X0_low = SrcInputFileTypeData%X0_low - DstInputFileTypeData%Y0_low = SrcInputFileTypeData%Y0_low - DstInputFileTypeData%Z0_low = SrcInputFileTypeData%Z0_low -IF (ALLOCATED(SrcInputFileTypeData%WT_Position)) THEN - i1_l = LBOUND(SrcInputFileTypeData%WT_Position,1) - i1_u = UBOUND(SrcInputFileTypeData%WT_Position,1) - i2_l = LBOUND(SrcInputFileTypeData%WT_Position,2) - i2_u = UBOUND(SrcInputFileTypeData%WT_Position,2) - IF (.NOT. ALLOCATED(DstInputFileTypeData%WT_Position)) THEN - ALLOCATE(DstInputFileTypeData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%WT_Position = SrcInputFileTypeData%WT_Position -ENDIF - DstInputFileTypeData%Mod_Projection = SrcInputFileTypeData%Mod_Projection - END SUBROUTINE AWAE_CopyInputFileType - - SUBROUTINE AWAE_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) - TYPE(AWAE_InputFileType), INTENT(INOUT) :: InputFileTypeData - 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 = 'AWAE_DestroyInputFileType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileTypeData%OutDisWindZ)) THEN - DEALLOCATE(InputFileTypeData%OutDisWindZ) -ENDIF -IF (ALLOCATED(InputFileTypeData%OutDisWindX)) THEN - DEALLOCATE(InputFileTypeData%OutDisWindX) -ENDIF -IF (ALLOCATED(InputFileTypeData%OutDisWindY)) THEN - DEALLOCATE(InputFileTypeData%OutDisWindY) -ENDIF -IF (ALLOCATED(InputFileTypeData%X0_high)) THEN - DEALLOCATE(InputFileTypeData%X0_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%Y0_high)) THEN - DEALLOCATE(InputFileTypeData%Y0_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%Z0_high)) THEN - DEALLOCATE(InputFileTypeData%Z0_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%dX_high)) THEN - DEALLOCATE(InputFileTypeData%dX_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%dY_high)) THEN - DEALLOCATE(InputFileTypeData%dY_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%dZ_high)) THEN - DEALLOCATE(InputFileTypeData%dZ_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%WT_Position)) THEN - DEALLOCATE(InputFileTypeData%WT_Position) -ENDIF - END SUBROUTINE AWAE_DestroyInputFileType - - SUBROUTINE AWAE_PackInputFileType( 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(AWAE_InputFileType), 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 = 'AWAE_PackInputFileType' - ! 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 ! dr - Db_BufSz = Db_BufSz + 1 ! dt_low - Int_BufSz = Int_BufSz + 1 ! NumTurbines - Int_BufSz = Int_BufSz + 1 ! NumRadii - Int_BufSz = Int_BufSz + 1 ! NumPlanes - Int_BufSz = Int_BufSz + 1*LEN(InData%WindFilePath) ! WindFilePath - Int_BufSz = Int_BufSz + 1 ! WrDisWind - Int_BufSz = Int_BufSz + 1 ! NOutDisWindXY - Int_BufSz = Int_BufSz + 1 ! OutDisWindZ allocated yes/no - IF ( ALLOCATED(InData%OutDisWindZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindZ) ! OutDisWindZ - END IF - Int_BufSz = Int_BufSz + 1 ! NOutDisWindYZ - Int_BufSz = Int_BufSz + 1 ! OutDisWindX allocated yes/no - IF ( ALLOCATED(InData%OutDisWindX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindX) ! OutDisWindX - END IF - Int_BufSz = Int_BufSz + 1 ! NOutDisWindXZ - Int_BufSz = Int_BufSz + 1 ! OutDisWindY allocated yes/no - IF ( ALLOCATED(InData%OutDisWindY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindY) ! OutDisWindY - END IF - Db_BufSz = Db_BufSz + 1 ! WrDisDT - Int_BufSz = Int_BufSz + 1 ! ChkWndFiles - Int_BufSz = Int_BufSz + 1 ! Mod_Meander - Re_BufSz = Re_BufSz + 1 ! C_Meander - Int_BufSz = Int_BufSz + 1 ! Mod_AmbWind - Int_BufSz = Int_BufSz + 1*LEN(InData%InflowFile) ! InflowFile - Db_BufSz = Db_BufSz + 1 ! dt_high - Int_BufSz = Int_BufSz + 1 ! X0_high allocated yes/no - IF ( ALLOCATED(InData%X0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! X0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X0_high) ! X0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Y0_high allocated yes/no - IF ( ALLOCATED(InData%Y0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y0_high) ! Y0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Z0_high allocated yes/no - IF ( ALLOCATED(InData%Z0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Z0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Z0_high) ! Z0_high - END IF - Int_BufSz = Int_BufSz + 1 ! dX_high allocated yes/no - IF ( ALLOCATED(InData%dX_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dX_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dX_high) ! dX_high - END IF - Int_BufSz = Int_BufSz + 1 ! dY_high allocated yes/no - IF ( ALLOCATED(InData%dY_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dY_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dY_high) ! dY_high - END IF - Int_BufSz = Int_BufSz + 1 ! dZ_high allocated yes/no - IF ( ALLOCATED(InData%dZ_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dZ_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dZ_high) ! dZ_high - END IF - Int_BufSz = Int_BufSz + 1 ! nX_high - Int_BufSz = Int_BufSz + 1 ! nY_high - Int_BufSz = Int_BufSz + 1 ! nZ_high - Re_BufSz = Re_BufSz + 1 ! dX_low - Re_BufSz = Re_BufSz + 1 ! dY_low - Re_BufSz = Re_BufSz + 1 ! dZ_low - Int_BufSz = Int_BufSz + 1 ! nX_low - Int_BufSz = Int_BufSz + 1 ! nY_low - Int_BufSz = Int_BufSz + 1 ! nZ_low - Re_BufSz = Re_BufSz + 1 ! X0_low - Re_BufSz = Re_BufSz + 1 ! Y0_low - Re_BufSz = Re_BufSz + 1 ! Z0_low - Int_BufSz = Int_BufSz + 1 ! WT_Position allocated yes/no - IF ( ALLOCATED(InData%WT_Position) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WT_Position upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WT_Position) ! WT_Position - END IF - Int_BufSz = Int_BufSz + 1 ! Mod_Projection - 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%dr - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dt_low - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTurbines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumRadii - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPlanes - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WindFilePath) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFilePath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrDisWind, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutDisWindXY - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindZ) ) 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%OutDisWindZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindZ,1), UBOUND(InData%OutDisWindZ,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NOutDisWindYZ - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindX) ) 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%OutDisWindX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindX,1), UBOUND(InData%OutDisWindX,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NOutDisWindXZ - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindY) ) 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%OutDisWindY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindY,1), UBOUND(InData%OutDisWindY,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%WrDisDT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ChkWndFiles, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_Meander - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_Meander - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_AmbWind - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%InflowFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InflowFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%dt_high - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%X0_high) ) 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%X0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%X0_high,1), UBOUND(InData%X0_high,1) - ReKiBuf(Re_Xferred) = InData%X0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y0_high) ) 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%Y0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y0_high,1), UBOUND(InData%Y0_high,1) - ReKiBuf(Re_Xferred) = InData%Y0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Z0_high) ) 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%Z0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Z0_high,1), UBOUND(InData%Z0_high,1) - ReKiBuf(Re_Xferred) = InData%Z0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dX_high) ) 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%dX_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dX_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dX_high,1), UBOUND(InData%dX_high,1) - ReKiBuf(Re_Xferred) = InData%dX_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dY_high) ) 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%dY_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dY_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dY_high,1), UBOUND(InData%dY_high,1) - ReKiBuf(Re_Xferred) = InData%dY_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dZ_high) ) 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%dZ_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dZ_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dZ_high,1), UBOUND(InData%dZ_high,1) - ReKiBuf(Re_Xferred) = InData%dZ_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nX_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_high - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dX_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dY_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dZ_low - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nX_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_low - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0_low - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WT_Position) ) 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%WT_Position,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_Position,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WT_Position,2), UBOUND(InData%WT_Position,2) - DO i1 = LBOUND(InData%WT_Position,1), UBOUND(InData%WT_Position,1) - ReKiBuf(Re_Xferred) = InData%WT_Position(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Mod_Projection - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AWAE_PackInputFileType - - SUBROUTINE AWAE_UnPackInputFileType( 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(AWAE_InputFileType), 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 = 'AWAE_UnPackInputFileType' - ! 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%dr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dt_low = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumRadii = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPlanes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WindFilePath) - OutData%WindFilePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WrDisWind = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrDisWind) - Int_Xferred = Int_Xferred + 1 - OutData%NOutDisWindXY = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindZ 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%OutDisWindZ)) DEALLOCATE(OutData%OutDisWindZ) - ALLOCATE(OutData%OutDisWindZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindZ,1), UBOUND(OutData%OutDisWindZ,1) - OutData%OutDisWindZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NOutDisWindYZ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindX 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%OutDisWindX)) DEALLOCATE(OutData%OutDisWindX) - ALLOCATE(OutData%OutDisWindX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindX,1), UBOUND(OutData%OutDisWindX,1) - OutData%OutDisWindX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NOutDisWindXZ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindY 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%OutDisWindY)) DEALLOCATE(OutData%OutDisWindY) - ALLOCATE(OutData%OutDisWindY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindY,1), UBOUND(OutData%OutDisWindY,1) - OutData%OutDisWindY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WrDisDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%ChkWndFiles = TRANSFER(IntKiBuf(Int_Xferred), OutData%ChkWndFiles) - Int_Xferred = Int_Xferred + 1 - OutData%Mod_Meander = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_Meander = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Mod_AmbWind = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%InflowFile) - OutData%InflowFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%dt_high = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X0_high 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%X0_high)) DEALLOCATE(OutData%X0_high) - ALLOCATE(OutData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%X0_high,1), UBOUND(OutData%X0_high,1) - OutData%X0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y0_high 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%Y0_high)) DEALLOCATE(OutData%Y0_high) - ALLOCATE(OutData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y0_high,1), UBOUND(OutData%Y0_high,1) - OutData%Y0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Z0_high 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%Z0_high)) DEALLOCATE(OutData%Z0_high) - ALLOCATE(OutData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Z0_high,1), UBOUND(OutData%Z0_high,1) - OutData%Z0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dX_high 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%dX_high)) DEALLOCATE(OutData%dX_high) - ALLOCATE(OutData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dX_high,1), UBOUND(OutData%dX_high,1) - OutData%dX_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dY_high 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%dY_high)) DEALLOCATE(OutData%dY_high) - ALLOCATE(OutData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dY_high,1), UBOUND(OutData%dY_high,1) - OutData%dY_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dZ_high 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%dZ_high)) DEALLOCATE(OutData%dZ_high) - ALLOCATE(OutData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dZ_high,1), UBOUND(OutData%dZ_high,1) - OutData%dZ_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%nX_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dX_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dY_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dZ_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nX_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT_Position 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%WT_Position)) DEALLOCATE(OutData%WT_Position) - ALLOCATE(OutData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WT_Position,2), UBOUND(OutData%WT_Position,2) - DO i1 = LBOUND(OutData%WT_Position,1), UBOUND(OutData%WT_Position,1) - OutData%WT_Position(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%Mod_Projection = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AWAE_UnPackInputFileType - - SUBROUTINE AWAE_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AWAE_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyInitInput' -! + ErrMsg = '' + if (associated(HighWindGridData%data)) then + deallocate(HighWindGridData%data) + HighWindGridData%data => null() + end if +end subroutine + +subroutine AWAE_PackHighWindGrid(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_HighWindGrid), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackHighWindGrid' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, associated(InData%data)) + if (associated(InData%data)) then + call RegPackBounds(Buf, 5, lbound(InData%data), ubound(InData%data)) + call RegPackPointer(Buf, c_loc(InData%data), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%data) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackHighWindGrid(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_HighWindGrid), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackHighWindGrid' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%data)) deallocate(OutData%data) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%data, UB(1:5)-LB(1:5)) + OutData%data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%data + else + allocate(OutData%data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%data.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%data) + call RegUnpack(Buf, OutData%data) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%data => null() + end if +end subroutine + +subroutine AWAE_CopyHighWindGridPtr(SrcHighWindGridPtrData, DstHighWindGridPtrData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_HighWindGridPtr), intent(in) :: SrcHighWindGridPtrData + type(AWAE_HighWindGridPtr), intent(inout) :: DstHighWindGridPtrData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AWAE_CopyHighWindGridPtr' ErrStat = ErrID_None - ErrMsg = "" - CALL AWAE_Copyinputfiletype( SrcInitInputData%InputFileData, DstInitInputData%InputFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%n_high_low = SrcInitInputData%n_high_low - DstInitInputData%NumDT = SrcInitInputData%NumDT - DstInitInputData%OutFileRoot = SrcInitInputData%OutFileRoot - END SUBROUTINE AWAE_CopyInitInput - - SUBROUTINE AWAE_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(AWAE_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 = 'AWAE_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AWAE_DestroyInputFileType( InitInputData%InputFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AWAE_DestroyInitInput - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InputFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InputFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InputFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! n_high_low - Int_BufSz = Int_BufSz + 1 ! NumDT - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - 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 - - 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 - - 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%n_high_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumDT - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AWAE_PackInitInput - - SUBROUTINE AWAE_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(AWAE_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_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 - 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 AWAE_UnpackInputFileType( Re_Buf, Db_Buf, Int_Buf, OutData%InputFileData, ErrStat2, ErrMsg2 ) ! InputFileData - 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%n_high_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumDT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AWAE_UnPackInitInput - - SUBROUTINE AWAE_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AWAE_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 = 'AWAE_CopyInitOutput' -! + ErrMsg = '' + DstHighWindGridPtrData%data => SrcHighWindGridPtrData%data +end subroutine + +subroutine AWAE_DestroyHighWindGridPtr(HighWindGridPtrData, ErrStat, ErrMsg) + type(AWAE_HighWindGridPtr), intent(inout) :: HighWindGridPtrData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AWAE_DestroyHighWindGridPtr' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%X0_high)) THEN - i1_l = LBOUND(SrcInitOutputData%X0_high,1) - i1_u = UBOUND(SrcInitOutputData%X0_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%X0_high)) THEN - ALLOCATE(DstInitOutputData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%X0_high = SrcInitOutputData%X0_high -ENDIF -IF (ALLOCATED(SrcInitOutputData%Y0_high)) THEN - i1_l = LBOUND(SrcInitOutputData%Y0_high,1) - i1_u = UBOUND(SrcInitOutputData%Y0_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%Y0_high)) THEN - ALLOCATE(DstInitOutputData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%Y0_high = SrcInitOutputData%Y0_high -ENDIF -IF (ALLOCATED(SrcInitOutputData%Z0_high)) THEN - i1_l = LBOUND(SrcInitOutputData%Z0_high,1) - i1_u = UBOUND(SrcInitOutputData%Z0_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%Z0_high)) THEN - ALLOCATE(DstInitOutputData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%Z0_high = SrcInitOutputData%Z0_high -ENDIF -IF (ALLOCATED(SrcInitOutputData%dX_high)) THEN - i1_l = LBOUND(SrcInitOutputData%dX_high,1) - i1_u = UBOUND(SrcInitOutputData%dX_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%dX_high)) THEN - ALLOCATE(DstInitOutputData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%dX_high = SrcInitOutputData%dX_high -ENDIF -IF (ALLOCATED(SrcInitOutputData%dY_high)) THEN - i1_l = LBOUND(SrcInitOutputData%dY_high,1) - i1_u = UBOUND(SrcInitOutputData%dY_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%dY_high)) THEN - ALLOCATE(DstInitOutputData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%dY_high = SrcInitOutputData%dY_high -ENDIF -IF (ALLOCATED(SrcInitOutputData%dZ_high)) THEN - i1_l = LBOUND(SrcInitOutputData%dZ_high,1) - i1_u = UBOUND(SrcInitOutputData%dZ_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%dZ_high)) THEN - ALLOCATE(DstInitOutputData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%dZ_high = SrcInitOutputData%dZ_high -ENDIF - DstInitOutputData%nX_high = SrcInitOutputData%nX_high - DstInitOutputData%nY_high = SrcInitOutputData%nY_high - DstInitOutputData%nZ_high = SrcInitOutputData%nZ_high - DstInitOutputData%dX_low = SrcInitOutputData%dX_low - DstInitOutputData%dY_low = SrcInitOutputData%dY_low - DstInitOutputData%dZ_low = SrcInitOutputData%dZ_low - DstInitOutputData%nX_low = SrcInitOutputData%nX_low - DstInitOutputData%nY_low = SrcInitOutputData%nY_low - DstInitOutputData%nZ_low = SrcInitOutputData%nZ_low - DstInitOutputData%X0_low = SrcInitOutputData%X0_low - DstInitOutputData%Y0_low = SrcInitOutputData%Y0_low - DstInitOutputData%Z0_low = SrcInitOutputData%Z0_low -IF (ALLOCATED(SrcInitOutputData%Vdist_High)) THEN - i1_l = LBOUND(SrcInitOutputData%Vdist_High,1) - i1_u = UBOUND(SrcInitOutputData%Vdist_High,1) - IF (.NOT. ALLOCATED(DstInitOutputData%Vdist_High)) THEN - ALLOCATE(DstInitOutputData%Vdist_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Vdist_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitOutputData%Vdist_High,1), UBOUND(SrcInitOutputData%Vdist_High,1) - CALL AWAE_Copyhighwindgridptr( SrcInitOutputData%Vdist_High(i1), DstInitOutputData%Vdist_High(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AWAE_CopyInitOutput - - SUBROUTINE AWAE_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(AWAE_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 = 'AWAE_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - 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) -ENDIF -IF (ALLOCATED(InitOutputData%Y0_high)) THEN - DEALLOCATE(InitOutputData%Y0_high) -ENDIF -IF (ALLOCATED(InitOutputData%Z0_high)) THEN - DEALLOCATE(InitOutputData%Z0_high) -ENDIF -IF (ALLOCATED(InitOutputData%dX_high)) THEN - DEALLOCATE(InitOutputData%dX_high) -ENDIF -IF (ALLOCATED(InitOutputData%dY_high)) THEN - DEALLOCATE(InitOutputData%dY_high) -ENDIF -IF (ALLOCATED(InitOutputData%dZ_high)) THEN - DEALLOCATE(InitOutputData%dZ_high) -ENDIF -IF (ALLOCATED(InitOutputData%Vdist_High)) THEN -DO i1 = LBOUND(InitOutputData%Vdist_High,1), UBOUND(InitOutputData%Vdist_High,1) - CALL AWAE_DestroyHighWindGridPtr( InitOutputData%Vdist_High(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitOutputData%Vdist_High) -ENDIF - END SUBROUTINE AWAE_DestroyInitOutput - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! X0_high allocated yes/no - IF ( ALLOCATED(InData%X0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! X0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X0_high) ! X0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Y0_high allocated yes/no - IF ( ALLOCATED(InData%Y0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y0_high) ! Y0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Z0_high allocated yes/no - IF ( ALLOCATED(InData%Z0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Z0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Z0_high) ! Z0_high - END IF - Int_BufSz = Int_BufSz + 1 ! dX_high allocated yes/no - IF ( ALLOCATED(InData%dX_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dX_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dX_high) ! dX_high - END IF - Int_BufSz = Int_BufSz + 1 ! dY_high allocated yes/no - IF ( ALLOCATED(InData%dY_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dY_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dY_high) ! dY_high - END IF - Int_BufSz = Int_BufSz + 1 ! dZ_high allocated yes/no - IF ( ALLOCATED(InData%dZ_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dZ_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dZ_high) ! dZ_high - END IF - Int_BufSz = Int_BufSz + 1 ! nX_high - Int_BufSz = Int_BufSz + 1 ! nY_high - Int_BufSz = Int_BufSz + 1 ! nZ_high - Re_BufSz = Re_BufSz + 1 ! dX_low - Re_BufSz = Re_BufSz + 1 ! dY_low - Re_BufSz = Re_BufSz + 1 ! dZ_low - Int_BufSz = Int_BufSz + 1 ! nX_low - Int_BufSz = Int_BufSz + 1 ! nY_low - Int_BufSz = Int_BufSz + 1 ! nZ_low - Re_BufSz = Re_BufSz + 1 ! X0_low - Re_BufSz = Re_BufSz + 1 ! Y0_low - Re_BufSz = Re_BufSz + 1 ! Z0_low - Int_BufSz = Int_BufSz + 1 ! Vdist_High allocated yes/no - IF ( ALLOCATED(InData%Vdist_High) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vdist_High upper/lower bounds for each dimension - 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_PackHighWindGridPtr( 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 - - IF(ALLOCATED(Re_Buf)) THEN ! Vdist_High - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Vdist_High - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Vdist_High - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%X0_high) ) 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%X0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%X0_high,1), UBOUND(InData%X0_high,1) - ReKiBuf(Re_Xferred) = InData%X0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y0_high) ) 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%Y0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y0_high,1), UBOUND(InData%Y0_high,1) - ReKiBuf(Re_Xferred) = InData%Y0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Z0_high) ) 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%Z0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Z0_high,1), UBOUND(InData%Z0_high,1) - ReKiBuf(Re_Xferred) = InData%Z0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dX_high) ) 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%dX_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dX_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dX_high,1), UBOUND(InData%dX_high,1) - ReKiBuf(Re_Xferred) = InData%dX_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dY_high) ) 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%dY_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dY_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dY_high,1), UBOUND(InData%dY_high,1) - ReKiBuf(Re_Xferred) = InData%dY_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dZ_high) ) 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%dZ_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dZ_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dZ_high,1), UBOUND(InData%dZ_high,1) - ReKiBuf(Re_Xferred) = InData%dZ_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nX_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_high - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dX_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dY_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dZ_low - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nX_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_low - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0_low - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Vdist_High) ) 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%Vdist_High,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vdist_High,1), UBOUND(InData%Vdist_High,1) - CALL AWAE_PackHighWindGridPtr( 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 - - 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 - END SUBROUTINE AWAE_PackInitOutput - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X0_high 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%X0_high)) DEALLOCATE(OutData%X0_high) - ALLOCATE(OutData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%X0_high,1), UBOUND(OutData%X0_high,1) - OutData%X0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y0_high 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%Y0_high)) DEALLOCATE(OutData%Y0_high) - ALLOCATE(OutData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y0_high,1), UBOUND(OutData%Y0_high,1) - OutData%Y0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Z0_high 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%Z0_high)) DEALLOCATE(OutData%Z0_high) - ALLOCATE(OutData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Z0_high,1), UBOUND(OutData%Z0_high,1) - OutData%Z0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dX_high 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%dX_high)) DEALLOCATE(OutData%dX_high) - ALLOCATE(OutData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dX_high,1), UBOUND(OutData%dX_high,1) - OutData%dX_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dY_high 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%dY_high)) DEALLOCATE(OutData%dY_high) - ALLOCATE(OutData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dY_high,1), UBOUND(OutData%dY_high,1) - OutData%dY_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dZ_high 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%dZ_high)) DEALLOCATE(OutData%dZ_high) - ALLOCATE(OutData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dZ_high,1), UBOUND(OutData%dZ_high,1) - OutData%dZ_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%nX_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dX_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dY_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dZ_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nX_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vdist_High 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%Vdist_High)) DEALLOCATE(OutData%Vdist_High) - ALLOCATE(OutData%Vdist_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vdist_High,1), UBOUND(OutData%Vdist_High,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 AWAE_UnpackHighWindGridPtr( 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 - - 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 - END SUBROUTINE AWAE_UnPackInitOutput - - SUBROUTINE AWAE_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(AWAE_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyContState' -! + ErrMsg = '' + nullify(HighWindGridPtrData%data) +end subroutine + +subroutine AWAE_PackHighWindGridPtr(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_HighWindGridPtr), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackHighWindGridPtr' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, associated(InData%data)) + if (associated(InData%data)) then + call RegPackBounds(Buf, 5, lbound(InData%data), ubound(InData%data)) + call RegPackPointer(Buf, c_loc(InData%data), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%data) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackHighWindGridPtr(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_HighWindGridPtr), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackHighWindGridPtr' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%data)) deallocate(OutData%data) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%data, UB(1:5)-LB(1:5)) + OutData%data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%data + else + allocate(OutData%data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%data.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%data) + call RegUnpack(Buf, OutData%data) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%data => null() + end if +end subroutine + +subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_InputFileType), intent(in) :: SrcInputFileTypeData + type(AWAE_InputFileType), intent(inout) :: DstInputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AWAE_CopyInputFileType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%IfW)) THEN - i1_l = LBOUND(SrcContStateData%IfW,1) - i1_u = UBOUND(SrcContStateData%IfW,1) - IF (.NOT. ALLOCATED(DstContStateData%IfW)) THEN - ALLOCATE(DstContStateData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%IfW,1), UBOUND(SrcContStateData%IfW,1) - CALL InflowWind_CopyContState( SrcContStateData%IfW(i1), DstContStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AWAE_CopyContState - - SUBROUTINE AWAE_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(AWAE_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 = 'AWAE_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%IfW)) THEN -DO i1 = LBOUND(ContStateData%IfW,1), UBOUND(ContStateData%IfW,1) - CALL InflowWind_DestroyContState( ContStateData%IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%IfW) -ENDIF - END SUBROUTINE AWAE_DestroyContState - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 - Int_BufSz = Int_BufSz + 1 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%IfW) ) 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%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 - END SUBROUTINE AWAE_PackContState - - SUBROUTINE AWAE_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(AWAE_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IfW 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%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,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 InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - 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 - END SUBROUTINE AWAE_UnPackContState - - SUBROUTINE AWAE_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(AWAE_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyDiscState' -! + ErrMsg = '' + DstInputFileTypeData%dr = SrcInputFileTypeData%dr + DstInputFileTypeData%dt_low = SrcInputFileTypeData%dt_low + DstInputFileTypeData%NumTurbines = SrcInputFileTypeData%NumTurbines + DstInputFileTypeData%NumRadii = SrcInputFileTypeData%NumRadii + DstInputFileTypeData%NumPlanes = SrcInputFileTypeData%NumPlanes + DstInputFileTypeData%WindFilePath = SrcInputFileTypeData%WindFilePath + DstInputFileTypeData%WrDisWind = SrcInputFileTypeData%WrDisWind + DstInputFileTypeData%NOutDisWindXY = SrcInputFileTypeData%NOutDisWindXY + if (allocated(SrcInputFileTypeData%OutDisWindZ)) then + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindZ) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindZ) + if (.not. allocated(DstInputFileTypeData%OutDisWindZ)) then + allocate(DstInputFileTypeData%OutDisWindZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%OutDisWindZ = SrcInputFileTypeData%OutDisWindZ + end if + DstInputFileTypeData%NOutDisWindYZ = SrcInputFileTypeData%NOutDisWindYZ + if (allocated(SrcInputFileTypeData%OutDisWindX)) then + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindX) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindX) + if (.not. allocated(DstInputFileTypeData%OutDisWindX)) then + allocate(DstInputFileTypeData%OutDisWindX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%OutDisWindX = SrcInputFileTypeData%OutDisWindX + end if + DstInputFileTypeData%NOutDisWindXZ = SrcInputFileTypeData%NOutDisWindXZ + if (allocated(SrcInputFileTypeData%OutDisWindY)) then + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindY) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindY) + if (.not. allocated(DstInputFileTypeData%OutDisWindY)) then + allocate(DstInputFileTypeData%OutDisWindY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%OutDisWindY = SrcInputFileTypeData%OutDisWindY + end if + DstInputFileTypeData%WrDisDT = SrcInputFileTypeData%WrDisDT + DstInputFileTypeData%ChkWndFiles = SrcInputFileTypeData%ChkWndFiles + DstInputFileTypeData%Mod_Meander = SrcInputFileTypeData%Mod_Meander + DstInputFileTypeData%C_Meander = SrcInputFileTypeData%C_Meander + DstInputFileTypeData%Mod_AmbWind = SrcInputFileTypeData%Mod_AmbWind + DstInputFileTypeData%InflowFile = SrcInputFileTypeData%InflowFile + DstInputFileTypeData%dt_high = SrcInputFileTypeData%dt_high + if (allocated(SrcInputFileTypeData%X0_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%X0_high) + UB(1:1) = ubound(SrcInputFileTypeData%X0_high) + if (.not. allocated(DstInputFileTypeData%X0_high)) then + allocate(DstInputFileTypeData%X0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%X0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%X0_high = SrcInputFileTypeData%X0_high + end if + if (allocated(SrcInputFileTypeData%Y0_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%Y0_high) + UB(1:1) = ubound(SrcInputFileTypeData%Y0_high) + if (.not. allocated(DstInputFileTypeData%Y0_high)) then + allocate(DstInputFileTypeData%Y0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%Y0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%Y0_high = SrcInputFileTypeData%Y0_high + end if + if (allocated(SrcInputFileTypeData%Z0_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%Z0_high) + UB(1:1) = ubound(SrcInputFileTypeData%Z0_high) + if (.not. allocated(DstInputFileTypeData%Z0_high)) then + allocate(DstInputFileTypeData%Z0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%Z0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%Z0_high = SrcInputFileTypeData%Z0_high + end if + if (allocated(SrcInputFileTypeData%dX_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%dX_high) + UB(1:1) = ubound(SrcInputFileTypeData%dX_high) + if (.not. allocated(DstInputFileTypeData%dX_high)) then + allocate(DstInputFileTypeData%dX_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dX_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%dX_high = SrcInputFileTypeData%dX_high + end if + if (allocated(SrcInputFileTypeData%dY_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%dY_high) + UB(1:1) = ubound(SrcInputFileTypeData%dY_high) + if (.not. allocated(DstInputFileTypeData%dY_high)) then + allocate(DstInputFileTypeData%dY_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dY_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%dY_high = SrcInputFileTypeData%dY_high + end if + if (allocated(SrcInputFileTypeData%dZ_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%dZ_high) + UB(1:1) = ubound(SrcInputFileTypeData%dZ_high) + if (.not. allocated(DstInputFileTypeData%dZ_high)) then + allocate(DstInputFileTypeData%dZ_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dZ_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%dZ_high = SrcInputFileTypeData%dZ_high + end if + DstInputFileTypeData%nX_high = SrcInputFileTypeData%nX_high + DstInputFileTypeData%nY_high = SrcInputFileTypeData%nY_high + DstInputFileTypeData%nZ_high = SrcInputFileTypeData%nZ_high + DstInputFileTypeData%dX_low = SrcInputFileTypeData%dX_low + DstInputFileTypeData%dY_low = SrcInputFileTypeData%dY_low + DstInputFileTypeData%dZ_low = SrcInputFileTypeData%dZ_low + DstInputFileTypeData%nX_low = SrcInputFileTypeData%nX_low + DstInputFileTypeData%nY_low = SrcInputFileTypeData%nY_low + DstInputFileTypeData%nZ_low = SrcInputFileTypeData%nZ_low + DstInputFileTypeData%X0_low = SrcInputFileTypeData%X0_low + DstInputFileTypeData%Y0_low = SrcInputFileTypeData%Y0_low + DstInputFileTypeData%Z0_low = SrcInputFileTypeData%Z0_low + if (allocated(SrcInputFileTypeData%WT_Position)) then + LB(1:2) = lbound(SrcInputFileTypeData%WT_Position) + UB(1:2) = ubound(SrcInputFileTypeData%WT_Position) + if (.not. allocated(DstInputFileTypeData%WT_Position)) then + allocate(DstInputFileTypeData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%WT_Position.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%WT_Position = SrcInputFileTypeData%WT_Position + end if + DstInputFileTypeData%Mod_Projection = SrcInputFileTypeData%Mod_Projection +end subroutine + +subroutine AWAE_DestroyInputFileType(InputFileTypeData, ErrStat, ErrMsg) + type(AWAE_InputFileType), intent(inout) :: InputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AWAE_DestroyInputFileType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%IfW)) THEN - i1_l = LBOUND(SrcDiscStateData%IfW,1) - i1_u = UBOUND(SrcDiscStateData%IfW,1) - IF (.NOT. ALLOCATED(DstDiscStateData%IfW)) THEN - ALLOCATE(DstDiscStateData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%IfW,1), UBOUND(SrcDiscStateData%IfW,1) - CALL InflowWind_CopyDiscState( SrcDiscStateData%IfW(i1), DstDiscStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AWAE_CopyDiscState - - SUBROUTINE AWAE_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(AWAE_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 = 'AWAE_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%IfW)) THEN -DO i1 = LBOUND(DiscStateData%IfW,1), UBOUND(DiscStateData%IfW,1) - CALL InflowWind_DestroyDiscState( DiscStateData%IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%IfW) -ENDIF - END SUBROUTINE AWAE_DestroyDiscState - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 - Int_BufSz = Int_BufSz + 1 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%IfW) ) 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%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 - END SUBROUTINE AWAE_PackDiscState - - SUBROUTINE AWAE_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(AWAE_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IfW 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%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,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 InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - 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 - END SUBROUTINE AWAE_UnPackDiscState - - SUBROUTINE AWAE_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(AWAE_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyConstrState' -! + ErrMsg = '' + if (allocated(InputFileTypeData%OutDisWindZ)) then + deallocate(InputFileTypeData%OutDisWindZ) + end if + if (allocated(InputFileTypeData%OutDisWindX)) then + deallocate(InputFileTypeData%OutDisWindX) + end if + if (allocated(InputFileTypeData%OutDisWindY)) then + deallocate(InputFileTypeData%OutDisWindY) + end if + if (allocated(InputFileTypeData%X0_high)) then + deallocate(InputFileTypeData%X0_high) + end if + if (allocated(InputFileTypeData%Y0_high)) then + deallocate(InputFileTypeData%Y0_high) + end if + if (allocated(InputFileTypeData%Z0_high)) then + deallocate(InputFileTypeData%Z0_high) + end if + if (allocated(InputFileTypeData%dX_high)) then + deallocate(InputFileTypeData%dX_high) + end if + if (allocated(InputFileTypeData%dY_high)) then + deallocate(InputFileTypeData%dY_high) + end if + if (allocated(InputFileTypeData%dZ_high)) then + deallocate(InputFileTypeData%dZ_high) + end if + if (allocated(InputFileTypeData%WT_Position)) then + deallocate(InputFileTypeData%WT_Position) + end if +end subroutine + +subroutine AWAE_PackInputFileType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackInputFileType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dr) + call RegPack(Buf, InData%dt_low) + call RegPack(Buf, InData%NumTurbines) + call RegPack(Buf, InData%NumRadii) + call RegPack(Buf, InData%NumPlanes) + call RegPack(Buf, InData%WindFilePath) + call RegPack(Buf, InData%WrDisWind) + call RegPack(Buf, InData%NOutDisWindXY) + call RegPack(Buf, allocated(InData%OutDisWindZ)) + if (allocated(InData%OutDisWindZ)) then + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindZ), ubound(InData%OutDisWindZ)) + call RegPack(Buf, InData%OutDisWindZ) + end if + call RegPack(Buf, InData%NOutDisWindYZ) + call RegPack(Buf, allocated(InData%OutDisWindX)) + if (allocated(InData%OutDisWindX)) then + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindX), ubound(InData%OutDisWindX)) + call RegPack(Buf, InData%OutDisWindX) + end if + call RegPack(Buf, InData%NOutDisWindXZ) + call RegPack(Buf, allocated(InData%OutDisWindY)) + if (allocated(InData%OutDisWindY)) then + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindY), ubound(InData%OutDisWindY)) + call RegPack(Buf, InData%OutDisWindY) + end if + call RegPack(Buf, InData%WrDisDT) + call RegPack(Buf, InData%ChkWndFiles) + call RegPack(Buf, InData%Mod_Meander) + call RegPack(Buf, InData%C_Meander) + call RegPack(Buf, InData%Mod_AmbWind) + call RegPack(Buf, InData%InflowFile) + call RegPack(Buf, InData%dt_high) + call RegPack(Buf, allocated(InData%X0_high)) + if (allocated(InData%X0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%X0_high), ubound(InData%X0_high)) + call RegPack(Buf, InData%X0_high) + end if + call RegPack(Buf, allocated(InData%Y0_high)) + if (allocated(InData%Y0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%Y0_high), ubound(InData%Y0_high)) + call RegPack(Buf, InData%Y0_high) + end if + call RegPack(Buf, allocated(InData%Z0_high)) + if (allocated(InData%Z0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%Z0_high), ubound(InData%Z0_high)) + call RegPack(Buf, InData%Z0_high) + end if + call RegPack(Buf, allocated(InData%dX_high)) + if (allocated(InData%dX_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dX_high), ubound(InData%dX_high)) + call RegPack(Buf, InData%dX_high) + end if + call RegPack(Buf, allocated(InData%dY_high)) + if (allocated(InData%dY_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dY_high), ubound(InData%dY_high)) + call RegPack(Buf, InData%dY_high) + end if + call RegPack(Buf, allocated(InData%dZ_high)) + if (allocated(InData%dZ_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dZ_high), ubound(InData%dZ_high)) + call RegPack(Buf, InData%dZ_high) + end if + call RegPack(Buf, InData%nX_high) + call RegPack(Buf, InData%nY_high) + call RegPack(Buf, InData%nZ_high) + call RegPack(Buf, InData%dX_low) + call RegPack(Buf, InData%dY_low) + call RegPack(Buf, InData%dZ_low) + call RegPack(Buf, InData%nX_low) + call RegPack(Buf, InData%nY_low) + call RegPack(Buf, InData%nZ_low) + call RegPack(Buf, InData%X0_low) + call RegPack(Buf, InData%Y0_low) + call RegPack(Buf, InData%Z0_low) + call RegPack(Buf, allocated(InData%WT_Position)) + if (allocated(InData%WT_Position)) then + call RegPackBounds(Buf, 2, lbound(InData%WT_Position), ubound(InData%WT_Position)) + call RegPack(Buf, InData%WT_Position) + end if + call RegPack(Buf, InData%Mod_Projection) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackInputFileType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackInputFileType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dt_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumTurbines) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumRadii) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumPlanes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WindFilePath) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrDisWind) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NOutDisWindXY) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutDisWindZ)) deallocate(OutData%OutDisWindZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutDisWindZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutDisWindZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NOutDisWindYZ) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutDisWindX)) deallocate(OutData%OutDisWindX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutDisWindX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutDisWindX) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NOutDisWindXZ) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutDisWindY)) deallocate(OutData%OutDisWindY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutDisWindY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutDisWindY) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%WrDisDT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ChkWndFiles) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Mod_Meander) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_Meander) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Mod_AmbWind) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InflowFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dt_high) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%X0_high)) deallocate(OutData%X0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Y0_high)) deallocate(OutData%Y0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Z0_high)) deallocate(OutData%Z0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Z0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Z0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dX_high)) deallocate(OutData%dX_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dX_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dX_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dY_high)) deallocate(OutData%dY_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dY_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dY_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dZ_high)) deallocate(OutData%dZ_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dZ_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dZ_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%nX_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nY_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nZ_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dX_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dY_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dZ_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nX_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nY_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nZ_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%X0_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Y0_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Z0_low) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WT_Position)) deallocate(OutData%WT_Position) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WT_Position(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WT_Position) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Mod_Projection) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_InitInputType), intent(in) :: SrcInitInputData + type(AWAE_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcConstrStateData%IfW)) THEN - i1_l = LBOUND(SrcConstrStateData%IfW,1) - i1_u = UBOUND(SrcConstrStateData%IfW,1) - IF (.NOT. ALLOCATED(DstConstrStateData%IfW)) THEN - ALLOCATE(DstConstrStateData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%IfW,1), UBOUND(SrcConstrStateData%IfW,1) - CALL InflowWind_CopyConstrState( SrcConstrStateData%IfW(i1), DstConstrStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AWAE_CopyConstrState - - SUBROUTINE AWAE_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(AWAE_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 = 'AWAE_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ConstrStateData%IfW)) THEN -DO i1 = LBOUND(ConstrStateData%IfW,1), UBOUND(ConstrStateData%IfW,1) - CALL InflowWind_DestroyConstrState( ConstrStateData%IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ConstrStateData%IfW) -ENDIF - END SUBROUTINE AWAE_DestroyConstrState - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 - Int_BufSz = Int_BufSz + 1 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%IfW) ) 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%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 - END SUBROUTINE AWAE_PackConstrState - - SUBROUTINE AWAE_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(AWAE_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IfW 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%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,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 InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - 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 - END SUBROUTINE AWAE_UnPackConstrState - - SUBROUTINE AWAE_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(AWAE_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyOtherState' -! + ErrMsg = '' + call AWAE_CopyInputFileType(SrcInitInputData%InputFileData, DstInitInputData%InputFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%n_high_low = SrcInitInputData%n_high_low + DstInitInputData%NumDT = SrcInitInputData%NumDT + DstInitInputData%OutFileRoot = SrcInitInputData%OutFileRoot +end subroutine + +subroutine AWAE_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(AWAE_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%IfW)) THEN - i1_l = LBOUND(SrcOtherStateData%IfW,1) - i1_u = UBOUND(SrcOtherStateData%IfW,1) - IF (.NOT. ALLOCATED(DstOtherStateData%IfW)) THEN - ALLOCATE(DstOtherStateData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%IfW,1), UBOUND(SrcOtherStateData%IfW,1) - CALL InflowWind_CopyOtherState( SrcOtherStateData%IfW(i1), DstOtherStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AWAE_CopyOtherState - - SUBROUTINE AWAE_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(AWAE_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 = 'AWAE_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%IfW)) THEN -DO i1 = LBOUND(OtherStateData%IfW,1), UBOUND(OtherStateData%IfW,1) - CALL InflowWind_DestroyOtherState( OtherStateData%IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%IfW) -ENDIF - END SUBROUTINE AWAE_DestroyOtherState - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%IfW) ) 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%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 - END SUBROUTINE AWAE_PackOtherState - - SUBROUTINE AWAE_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(AWAE_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IfW 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%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,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 InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - 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 - END SUBROUTINE AWAE_UnPackOtherState - - SUBROUTINE AWAE_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(AWAE_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) :: 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 = 'AWAE_CopyMisc' -! + ErrMsg = '' + call AWAE_DestroyInputFileType(InitInputData%InputFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AWAE_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call AWAE_PackInputFileType(Buf, InData%InputFileData) + call RegPack(Buf, InData%n_high_low) + call RegPack(Buf, InData%NumDT) + call RegPack(Buf, InData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call AWAE_UnpackInputFileType(Buf, OutData%InputFileData) ! InputFileData + call RegUnpack(Buf, OutData%n_high_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumDT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_InitOutputType), intent(in) :: SrcInitOutputData + type(AWAE_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%Vamb_low)) THEN - i1_l = LBOUND(SrcMiscData%Vamb_low,1) - i1_u = UBOUND(SrcMiscData%Vamb_low,1) - i2_l = LBOUND(SrcMiscData%Vamb_low,2) - i2_u = UBOUND(SrcMiscData%Vamb_low,2) - i3_l = LBOUND(SrcMiscData%Vamb_low,3) - i3_u = UBOUND(SrcMiscData%Vamb_low,3) - i4_l = LBOUND(SrcMiscData%Vamb_low,4) - i4_u = UBOUND(SrcMiscData%Vamb_low,4) - IF (.NOT. ALLOCATED(DstMiscData%Vamb_low)) THEN - ALLOCATE(DstMiscData%Vamb_low(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 DstMiscData%Vamb_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vamb_low = SrcMiscData%Vamb_low -ENDIF -IF (ALLOCATED(SrcMiscData%Vamb_lowpol)) THEN - i1_l = LBOUND(SrcMiscData%Vamb_lowpol,1) - i1_u = UBOUND(SrcMiscData%Vamb_lowpol,1) - i2_l = LBOUND(SrcMiscData%Vamb_lowpol,2) - i2_u = UBOUND(SrcMiscData%Vamb_lowpol,2) - IF (.NOT. ALLOCATED(DstMiscData%Vamb_lowpol)) THEN - ALLOCATE(DstMiscData%Vamb_lowpol(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_lowpol.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vamb_lowpol = SrcMiscData%Vamb_lowpol -ENDIF -IF (ALLOCATED(SrcMiscData%Vdist_low)) THEN - i1_l = LBOUND(SrcMiscData%Vdist_low,1) - i1_u = UBOUND(SrcMiscData%Vdist_low,1) - i2_l = LBOUND(SrcMiscData%Vdist_low,2) - i2_u = UBOUND(SrcMiscData%Vdist_low,2) - i3_l = LBOUND(SrcMiscData%Vdist_low,3) - i3_u = UBOUND(SrcMiscData%Vdist_low,3) - i4_l = LBOUND(SrcMiscData%Vdist_low,4) - i4_u = UBOUND(SrcMiscData%Vdist_low,4) - IF (.NOT. ALLOCATED(DstMiscData%Vdist_low)) THEN - ALLOCATE(DstMiscData%Vdist_low(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 DstMiscData%Vdist_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vdist_low = SrcMiscData%Vdist_low -ENDIF -IF (ALLOCATED(SrcMiscData%Vdist_low_full)) THEN - i1_l = LBOUND(SrcMiscData%Vdist_low_full,1) - i1_u = UBOUND(SrcMiscData%Vdist_low_full,1) - i2_l = LBOUND(SrcMiscData%Vdist_low_full,2) - i2_u = UBOUND(SrcMiscData%Vdist_low_full,2) - i3_l = LBOUND(SrcMiscData%Vdist_low_full,3) - i3_u = UBOUND(SrcMiscData%Vdist_low_full,3) - i4_l = LBOUND(SrcMiscData%Vdist_low_full,4) - i4_u = UBOUND(SrcMiscData%Vdist_low_full,4) - IF (.NOT. ALLOCATED(DstMiscData%Vdist_low_full)) THEN - ALLOCATE(DstMiscData%Vdist_low_full(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 DstMiscData%Vdist_low_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vdist_low_full = SrcMiscData%Vdist_low_full -ENDIF -IF (ALLOCATED(SrcMiscData%Vamb_High)) THEN - i1_l = LBOUND(SrcMiscData%Vamb_High,1) - i1_u = UBOUND(SrcMiscData%Vamb_High,1) - IF (.NOT. ALLOCATED(DstMiscData%Vamb_High)) THEN - ALLOCATE(DstMiscData%Vamb_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%Vamb_High,1), UBOUND(SrcMiscData%Vamb_High,1) - CALL AWAE_Copyhighwindgrid( SrcMiscData%Vamb_High(i1), DstMiscData%Vamb_High(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%parallelFlag)) THEN - i1_l = LBOUND(SrcMiscData%parallelFlag,1) - i1_u = UBOUND(SrcMiscData%parallelFlag,1) - i2_l = LBOUND(SrcMiscData%parallelFlag,2) - i2_u = UBOUND(SrcMiscData%parallelFlag,2) - IF (.NOT. ALLOCATED(DstMiscData%parallelFlag)) THEN - ALLOCATE(DstMiscData%parallelFlag(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%parallelFlag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%parallelFlag = SrcMiscData%parallelFlag -ENDIF -IF (ALLOCATED(SrcMiscData%r_s)) THEN - i1_l = LBOUND(SrcMiscData%r_s,1) - i1_u = UBOUND(SrcMiscData%r_s,1) - i2_l = LBOUND(SrcMiscData%r_s,2) - i2_u = UBOUND(SrcMiscData%r_s,2) - IF (.NOT. ALLOCATED(DstMiscData%r_s)) THEN - ALLOCATE(DstMiscData%r_s(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%r_s = SrcMiscData%r_s -ENDIF -IF (ALLOCATED(SrcMiscData%r_e)) THEN - i1_l = LBOUND(SrcMiscData%r_e,1) - i1_u = UBOUND(SrcMiscData%r_e,1) - i2_l = LBOUND(SrcMiscData%r_e,2) - i2_u = UBOUND(SrcMiscData%r_e,2) - IF (.NOT. ALLOCATED(DstMiscData%r_e)) THEN - ALLOCATE(DstMiscData%r_e(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_e.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%r_e = SrcMiscData%r_e -ENDIF -IF (ALLOCATED(SrcMiscData%rhat_s)) THEN - i1_l = LBOUND(SrcMiscData%rhat_s,1) - i1_u = UBOUND(SrcMiscData%rhat_s,1) - i2_l = LBOUND(SrcMiscData%rhat_s,2) - i2_u = UBOUND(SrcMiscData%rhat_s,2) - i3_l = LBOUND(SrcMiscData%rhat_s,3) - i3_u = UBOUND(SrcMiscData%rhat_s,3) - IF (.NOT. ALLOCATED(DstMiscData%rhat_s)) THEN - ALLOCATE(DstMiscData%rhat_s(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rhat_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rhat_s = SrcMiscData%rhat_s -ENDIF -IF (ALLOCATED(SrcMiscData%rhat_e)) THEN - i1_l = LBOUND(SrcMiscData%rhat_e,1) - i1_u = UBOUND(SrcMiscData%rhat_e,1) - i2_l = LBOUND(SrcMiscData%rhat_e,2) - i2_u = UBOUND(SrcMiscData%rhat_e,2) - i3_l = LBOUND(SrcMiscData%rhat_e,3) - i3_u = UBOUND(SrcMiscData%rhat_e,3) - IF (.NOT. ALLOCATED(DstMiscData%rhat_e)) THEN - ALLOCATE(DstMiscData%rhat_e(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rhat_e.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rhat_e = SrcMiscData%rhat_e -ENDIF -IF (ALLOCATED(SrcMiscData%pvec_cs)) THEN - i1_l = LBOUND(SrcMiscData%pvec_cs,1) - i1_u = UBOUND(SrcMiscData%pvec_cs,1) - i2_l = LBOUND(SrcMiscData%pvec_cs,2) - i2_u = UBOUND(SrcMiscData%pvec_cs,2) - i3_l = LBOUND(SrcMiscData%pvec_cs,3) - i3_u = UBOUND(SrcMiscData%pvec_cs,3) - IF (.NOT. ALLOCATED(DstMiscData%pvec_cs)) THEN - ALLOCATE(DstMiscData%pvec_cs(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%pvec_cs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%pvec_cs = SrcMiscData%pvec_cs -ENDIF -IF (ALLOCATED(SrcMiscData%pvec_ce)) THEN - i1_l = LBOUND(SrcMiscData%pvec_ce,1) - i1_u = UBOUND(SrcMiscData%pvec_ce,1) - i2_l = LBOUND(SrcMiscData%pvec_ce,2) - i2_u = UBOUND(SrcMiscData%pvec_ce,2) - i3_l = LBOUND(SrcMiscData%pvec_ce,3) - i3_u = UBOUND(SrcMiscData%pvec_ce,3) - IF (.NOT. ALLOCATED(DstMiscData%pvec_ce)) THEN - ALLOCATE(DstMiscData%pvec_ce(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%pvec_ce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%pvec_ce = SrcMiscData%pvec_ce -ENDIF -IF (ALLOCATED(SrcMiscData%outVizXYPlane)) THEN - i1_l = LBOUND(SrcMiscData%outVizXYPlane,1) - i1_u = UBOUND(SrcMiscData%outVizXYPlane,1) - i2_l = LBOUND(SrcMiscData%outVizXYPlane,2) - i2_u = UBOUND(SrcMiscData%outVizXYPlane,2) - i3_l = LBOUND(SrcMiscData%outVizXYPlane,3) - i3_u = UBOUND(SrcMiscData%outVizXYPlane,3) - i4_l = LBOUND(SrcMiscData%outVizXYPlane,4) - i4_u = UBOUND(SrcMiscData%outVizXYPlane,4) - IF (.NOT. ALLOCATED(DstMiscData%outVizXYPlane)) THEN - ALLOCATE(DstMiscData%outVizXYPlane(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 DstMiscData%outVizXYPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%outVizXYPlane = SrcMiscData%outVizXYPlane -ENDIF -IF (ALLOCATED(SrcMiscData%outVizYZPlane)) THEN - i1_l = LBOUND(SrcMiscData%outVizYZPlane,1) - i1_u = UBOUND(SrcMiscData%outVizYZPlane,1) - i2_l = LBOUND(SrcMiscData%outVizYZPlane,2) - i2_u = UBOUND(SrcMiscData%outVizYZPlane,2) - i3_l = LBOUND(SrcMiscData%outVizYZPlane,3) - i3_u = UBOUND(SrcMiscData%outVizYZPlane,3) - i4_l = LBOUND(SrcMiscData%outVizYZPlane,4) - i4_u = UBOUND(SrcMiscData%outVizYZPlane,4) - IF (.NOT. ALLOCATED(DstMiscData%outVizYZPlane)) THEN - ALLOCATE(DstMiscData%outVizYZPlane(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 DstMiscData%outVizYZPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%outVizYZPlane = SrcMiscData%outVizYZPlane -ENDIF -IF (ALLOCATED(SrcMiscData%outVizXZPlane)) THEN - i1_l = LBOUND(SrcMiscData%outVizXZPlane,1) - i1_u = UBOUND(SrcMiscData%outVizXZPlane,1) - i2_l = LBOUND(SrcMiscData%outVizXZPlane,2) - i2_u = UBOUND(SrcMiscData%outVizXZPlane,2) - i3_l = LBOUND(SrcMiscData%outVizXZPlane,3) - i3_u = UBOUND(SrcMiscData%outVizXZPlane,3) - i4_l = LBOUND(SrcMiscData%outVizXZPlane,4) - i4_u = UBOUND(SrcMiscData%outVizXZPlane,4) - IF (.NOT. ALLOCATED(DstMiscData%outVizXZPlane)) THEN - ALLOCATE(DstMiscData%outVizXZPlane(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 DstMiscData%outVizXZPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%outVizXZPlane = SrcMiscData%outVizXZPlane -ENDIF -IF (ALLOCATED(SrcMiscData%IfW)) THEN - i1_l = LBOUND(SrcMiscData%IfW,1) - i1_u = UBOUND(SrcMiscData%IfW,1) - IF (.NOT. ALLOCATED(DstMiscData%IfW)) THEN - ALLOCATE(DstMiscData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%IfW,1), UBOUND(SrcMiscData%IfW,1) - CALL InflowWind_CopyMisc( SrcMiscData%IfW(i1), DstMiscData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL InflowWind_CopyInput( SrcMiscData%u_IfW_Low, DstMiscData%u_IfW_Low, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcMiscData%u_IfW_High, DstMiscData%u_IfW_High, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcMiscData%y_IfW_Low, DstMiscData%y_IfW_Low, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcMiscData%y_IfW_High, DstMiscData%y_IfW_High, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AWAE_CopyMisc - - SUBROUTINE AWAE_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(AWAE_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 = 'AWAE_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%Vamb_low)) THEN - DEALLOCATE(MiscData%Vamb_low) -ENDIF -IF (ALLOCATED(MiscData%Vamb_lowpol)) THEN - DEALLOCATE(MiscData%Vamb_lowpol) -ENDIF -IF (ALLOCATED(MiscData%Vdist_low)) THEN - DEALLOCATE(MiscData%Vdist_low) -ENDIF -IF (ALLOCATED(MiscData%Vdist_low_full)) THEN - DEALLOCATE(MiscData%Vdist_low_full) -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%Vamb_High) -ENDIF -IF (ALLOCATED(MiscData%parallelFlag)) THEN - DEALLOCATE(MiscData%parallelFlag) -ENDIF -IF (ALLOCATED(MiscData%r_s)) THEN - DEALLOCATE(MiscData%r_s) -ENDIF -IF (ALLOCATED(MiscData%r_e)) THEN - DEALLOCATE(MiscData%r_e) -ENDIF -IF (ALLOCATED(MiscData%rhat_s)) THEN - DEALLOCATE(MiscData%rhat_s) -ENDIF -IF (ALLOCATED(MiscData%rhat_e)) THEN - DEALLOCATE(MiscData%rhat_e) -ENDIF -IF (ALLOCATED(MiscData%pvec_cs)) THEN - DEALLOCATE(MiscData%pvec_cs) -ENDIF -IF (ALLOCATED(MiscData%pvec_ce)) THEN - DEALLOCATE(MiscData%pvec_ce) -ENDIF -IF (ALLOCATED(MiscData%outVizXYPlane)) THEN - DEALLOCATE(MiscData%outVizXYPlane) -ENDIF -IF (ALLOCATED(MiscData%outVizYZPlane)) THEN - DEALLOCATE(MiscData%outVizYZPlane) -ENDIF -IF (ALLOCATED(MiscData%outVizXZPlane)) THEN - DEALLOCATE(MiscData%outVizXZPlane) -ENDIF -IF (ALLOCATED(MiscData%IfW)) THEN -DO i1 = LBOUND(MiscData%IfW,1), UBOUND(MiscData%IfW,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( MiscData%y_IfW_High, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AWAE_DestroyMisc - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 ! Vamb_low allocated yes/no - IF ( ALLOCATED(InData%Vamb_low) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vamb_low upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vamb_low) ! Vamb_low - END IF - Int_BufSz = Int_BufSz + 1 ! Vamb_lowpol allocated yes/no - IF ( ALLOCATED(InData%Vamb_lowpol) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vamb_lowpol upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vamb_lowpol) ! Vamb_lowpol - END IF - Int_BufSz = Int_BufSz + 1 ! Vdist_low allocated yes/no - IF ( ALLOCATED(InData%Vdist_low) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vdist_low upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vdist_low) ! Vdist_low - END IF - Int_BufSz = Int_BufSz + 1 ! Vdist_low_full allocated yes/no - IF ( ALLOCATED(InData%Vdist_low_full) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vdist_low_full upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vdist_low_full) ! Vdist_low_full - END IF - Int_BufSz = Int_BufSz + 1 ! Vamb_High allocated yes/no - IF ( ALLOCATED(InData%Vamb_High) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vamb_High upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Vamb_High - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Vamb_High - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Vamb_High - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! parallelFlag allocated yes/no - IF ( ALLOCATED(InData%parallelFlag) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! parallelFlag upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%parallelFlag) ! parallelFlag - END IF - Int_BufSz = Int_BufSz + 1 ! r_s allocated yes/no - IF ( ALLOCATED(InData%r_s) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r_s upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_s) ! r_s - END IF - Int_BufSz = Int_BufSz + 1 ! r_e allocated yes/no - IF ( ALLOCATED(InData%r_e) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r_e upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_e) ! r_e - END IF - Int_BufSz = Int_BufSz + 1 ! rhat_s allocated yes/no - IF ( ALLOCATED(InData%rhat_s) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rhat_s upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rhat_s) ! rhat_s - END IF - Int_BufSz = Int_BufSz + 1 ! rhat_e allocated yes/no - IF ( ALLOCATED(InData%rhat_e) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rhat_e upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rhat_e) ! rhat_e - END IF - Int_BufSz = Int_BufSz + 1 ! pvec_cs allocated yes/no - IF ( ALLOCATED(InData%pvec_cs) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! pvec_cs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pvec_cs) ! pvec_cs - END IF - Int_BufSz = Int_BufSz + 1 ! pvec_ce allocated yes/no - IF ( ALLOCATED(InData%pvec_ce) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! pvec_ce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pvec_ce) ! pvec_ce - END IF - Int_BufSz = Int_BufSz + 1 ! outVizXYPlane allocated yes/no - IF ( ALLOCATED(InData%outVizXYPlane) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! outVizXYPlane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%outVizXYPlane) ! outVizXYPlane - END IF - Int_BufSz = Int_BufSz + 1 ! outVizYZPlane allocated yes/no - IF ( ALLOCATED(InData%outVizYZPlane) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! outVizYZPlane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%outVizYZPlane) ! outVizYZPlane - END IF - Int_BufSz = Int_BufSz + 1 ! outVizXZPlane allocated yes/no - IF ( ALLOCATED(InData%outVizXZPlane) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! outVizXZPlane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%outVizXZPlane) ! outVizXZPlane - END IF - Int_BufSz = Int_BufSz + 1 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! u_IfW_Low: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW_Low, ErrStat2, ErrMsg2, .TRUE. ) ! u_IfW_Low - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_IfW_Low - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_IfW_Low - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_IfW_Low - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_IfW_High: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW_High, ErrStat2, ErrMsg2, .TRUE. ) ! u_IfW_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_IfW_High - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_IfW_High - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_IfW_High - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_IfW_Low: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_IfW_Low, ErrStat2, ErrMsg2, .TRUE. ) ! y_IfW_Low - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_IfW_Low - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_IfW_Low - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_IfW_Low - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_IfW_High: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_IfW_High, ErrStat2, ErrMsg2, .TRUE. ) ! y_IfW_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_IfW_High - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_IfW_High - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_IfW_High - 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 - - IF ( .NOT. ALLOCATED(InData%Vamb_low) ) 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%Vamb_low,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_low,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_low,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_low,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_low,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_low,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_low,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_low,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vamb_low,4), UBOUND(InData%Vamb_low,4) - DO i3 = LBOUND(InData%Vamb_low,3), UBOUND(InData%Vamb_low,3) - DO i2 = LBOUND(InData%Vamb_low,2), UBOUND(InData%Vamb_low,2) - DO i1 = LBOUND(InData%Vamb_low,1), UBOUND(InData%Vamb_low,1) - ReKiBuf(Re_Xferred) = InData%Vamb_low(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vamb_lowpol) ) 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%Vamb_lowpol,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_lowpol,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_lowpol,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_lowpol,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vamb_lowpol,2), UBOUND(InData%Vamb_lowpol,2) - DO i1 = LBOUND(InData%Vamb_lowpol,1), UBOUND(InData%Vamb_lowpol,1) - ReKiBuf(Re_Xferred) = InData%Vamb_lowpol(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vdist_low) ) 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%Vdist_low,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vdist_low,4), UBOUND(InData%Vdist_low,4) - DO i3 = LBOUND(InData%Vdist_low,3), UBOUND(InData%Vdist_low,3) - DO i2 = LBOUND(InData%Vdist_low,2), UBOUND(InData%Vdist_low,2) - DO i1 = LBOUND(InData%Vdist_low,1), UBOUND(InData%Vdist_low,1) - ReKiBuf(Re_Xferred) = InData%Vdist_low(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vdist_low_full) ) 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%Vdist_low_full,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low_full,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low_full,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low_full,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low_full,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low_full,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low_full,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low_full,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vdist_low_full,4), UBOUND(InData%Vdist_low_full,4) - DO i3 = LBOUND(InData%Vdist_low_full,3), UBOUND(InData%Vdist_low_full,3) - DO i2 = LBOUND(InData%Vdist_low_full,2), UBOUND(InData%Vdist_low_full,2) - DO i1 = LBOUND(InData%Vdist_low_full,1), UBOUND(InData%Vdist_low_full,1) - ReKiBuf(Re_Xferred) = InData%Vdist_low_full(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vamb_High) ) 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%Vamb_High,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_High,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%parallelFlag) ) 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%parallelFlag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%parallelFlag,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%parallelFlag,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%parallelFlag,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%parallelFlag,2), UBOUND(InData%parallelFlag,2) - DO i1 = LBOUND(InData%parallelFlag,1), UBOUND(InData%parallelFlag,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%parallelFlag(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_s) ) 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%r_s,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_s,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_s,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_s,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r_s,2), UBOUND(InData%r_s,2) - DO i1 = LBOUND(InData%r_s,1), UBOUND(InData%r_s,1) - ReKiBuf(Re_Xferred) = InData%r_s(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_e) ) 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%r_e,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_e,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_e,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_e,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r_e,2), UBOUND(InData%r_e,2) - DO i1 = LBOUND(InData%r_e,1), UBOUND(InData%r_e,1) - ReKiBuf(Re_Xferred) = InData%r_e(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rhat_s) ) 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%rhat_s,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_s,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_s,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_s,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_s,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_s,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rhat_s,3), UBOUND(InData%rhat_s,3) - DO i2 = LBOUND(InData%rhat_s,2), UBOUND(InData%rhat_s,2) - DO i1 = LBOUND(InData%rhat_s,1), UBOUND(InData%rhat_s,1) - ReKiBuf(Re_Xferred) = InData%rhat_s(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rhat_e) ) 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%rhat_e,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_e,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_e,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_e,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_e,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_e,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rhat_e,3), UBOUND(InData%rhat_e,3) - DO i2 = LBOUND(InData%rhat_e,2), UBOUND(InData%rhat_e,2) - DO i1 = LBOUND(InData%rhat_e,1), UBOUND(InData%rhat_e,1) - ReKiBuf(Re_Xferred) = InData%rhat_e(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%pvec_cs) ) 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%pvec_cs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_cs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_cs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_cs,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_cs,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_cs,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%pvec_cs,3), UBOUND(InData%pvec_cs,3) - DO i2 = LBOUND(InData%pvec_cs,2), UBOUND(InData%pvec_cs,2) - DO i1 = LBOUND(InData%pvec_cs,1), UBOUND(InData%pvec_cs,1) - ReKiBuf(Re_Xferred) = InData%pvec_cs(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%pvec_ce) ) 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%pvec_ce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_ce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_ce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_ce,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_ce,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_ce,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%pvec_ce,3), UBOUND(InData%pvec_ce,3) - DO i2 = LBOUND(InData%pvec_ce,2), UBOUND(InData%pvec_ce,2) - DO i1 = LBOUND(InData%pvec_ce,1), UBOUND(InData%pvec_ce,1) - ReKiBuf(Re_Xferred) = InData%pvec_ce(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%outVizXYPlane) ) 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%outVizXYPlane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXYPlane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXYPlane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXYPlane,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXYPlane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXYPlane,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXYPlane,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXYPlane,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%outVizXYPlane,4), UBOUND(InData%outVizXYPlane,4) - DO i3 = LBOUND(InData%outVizXYPlane,3), UBOUND(InData%outVizXYPlane,3) - DO i2 = LBOUND(InData%outVizXYPlane,2), UBOUND(InData%outVizXYPlane,2) - DO i1 = LBOUND(InData%outVizXYPlane,1), UBOUND(InData%outVizXYPlane,1) - ReKiBuf(Re_Xferred) = InData%outVizXYPlane(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%outVizYZPlane) ) 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%outVizYZPlane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizYZPlane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizYZPlane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizYZPlane,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizYZPlane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizYZPlane,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizYZPlane,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizYZPlane,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%outVizYZPlane,4), UBOUND(InData%outVizYZPlane,4) - DO i3 = LBOUND(InData%outVizYZPlane,3), UBOUND(InData%outVizYZPlane,3) - DO i2 = LBOUND(InData%outVizYZPlane,2), UBOUND(InData%outVizYZPlane,2) - DO i1 = LBOUND(InData%outVizYZPlane,1), UBOUND(InData%outVizYZPlane,1) - ReKiBuf(Re_Xferred) = InData%outVizYZPlane(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%outVizXZPlane) ) 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%outVizXZPlane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXZPlane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXZPlane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXZPlane,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXZPlane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXZPlane,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXZPlane,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXZPlane,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%outVizXZPlane,4), UBOUND(InData%outVizXZPlane,4) - DO i3 = LBOUND(InData%outVizXZPlane,3), UBOUND(InData%outVizXZPlane,3) - DO i2 = LBOUND(InData%outVizXZPlane,2), UBOUND(InData%outVizXZPlane,2) - DO i1 = LBOUND(InData%outVizXZPlane,1), UBOUND(InData%outVizXZPlane,1) - ReKiBuf(Re_Xferred) = InData%outVizXZPlane(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IfW) ) 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%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW_Low, ErrStat2, ErrMsg2, OnlySize ) ! u_IfW_Low - 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 - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW_High, ErrStat2, ErrMsg2, OnlySize ) ! u_IfW_High - 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 - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_IfW_Low, ErrStat2, ErrMsg2, OnlySize ) ! y_IfW_Low - 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 - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_IfW_High, ErrStat2, ErrMsg2, OnlySize ) ! y_IfW_High - 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 AWAE_PackMisc - - SUBROUTINE AWAE_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(AWAE_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) :: 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 = 'AWAE_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vamb_low 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%Vamb_low)) DEALLOCATE(OutData%Vamb_low) - ALLOCATE(OutData%Vamb_low(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%Vamb_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vamb_low,4), UBOUND(OutData%Vamb_low,4) - DO i3 = LBOUND(OutData%Vamb_low,3), UBOUND(OutData%Vamb_low,3) - DO i2 = LBOUND(OutData%Vamb_low,2), UBOUND(OutData%Vamb_low,2) - DO i1 = LBOUND(OutData%Vamb_low,1), UBOUND(OutData%Vamb_low,1) - OutData%Vamb_low(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 ! Vamb_lowpol 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%Vamb_lowpol)) DEALLOCATE(OutData%Vamb_lowpol) - ALLOCATE(OutData%Vamb_lowpol(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_lowpol.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vamb_lowpol,2), UBOUND(OutData%Vamb_lowpol,2) - DO i1 = LBOUND(OutData%Vamb_lowpol,1), UBOUND(OutData%Vamb_lowpol,1) - OutData%Vamb_lowpol(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vdist_low 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%Vdist_low)) DEALLOCATE(OutData%Vdist_low) - ALLOCATE(OutData%Vdist_low(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%Vdist_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vdist_low,4), UBOUND(OutData%Vdist_low,4) - DO i3 = LBOUND(OutData%Vdist_low,3), UBOUND(OutData%Vdist_low,3) - DO i2 = LBOUND(OutData%Vdist_low,2), UBOUND(OutData%Vdist_low,2) - DO i1 = LBOUND(OutData%Vdist_low,1), UBOUND(OutData%Vdist_low,1) - OutData%Vdist_low(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 ! Vdist_low_full 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%Vdist_low_full)) DEALLOCATE(OutData%Vdist_low_full) - ALLOCATE(OutData%Vdist_low_full(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%Vdist_low_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vdist_low_full,4), UBOUND(OutData%Vdist_low_full,4) - DO i3 = LBOUND(OutData%Vdist_low_full,3), UBOUND(OutData%Vdist_low_full,3) - DO i2 = LBOUND(OutData%Vdist_low_full,2), UBOUND(OutData%Vdist_low_full,2) - DO i1 = LBOUND(OutData%Vdist_low_full,1), UBOUND(OutData%Vdist_low_full,1) - OutData%Vdist_low_full(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 ! Vamb_High 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%Vamb_High)) DEALLOCATE(OutData%Vamb_High) - ALLOCATE(OutData%Vamb_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vamb_High,1), UBOUND(OutData%Vamb_High,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 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 - - 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 ! parallelFlag 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%parallelFlag)) DEALLOCATE(OutData%parallelFlag) - ALLOCATE(OutData%parallelFlag(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%parallelFlag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%parallelFlag,2), UBOUND(OutData%parallelFlag,2) - DO i1 = LBOUND(OutData%parallelFlag,1), UBOUND(OutData%parallelFlag,1) - OutData%parallelFlag(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%parallelFlag(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_s 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%r_s)) DEALLOCATE(OutData%r_s) - ALLOCATE(OutData%r_s(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r_s,2), UBOUND(OutData%r_s,2) - DO i1 = LBOUND(OutData%r_s,1), UBOUND(OutData%r_s,1) - OutData%r_s(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_e 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%r_e)) DEALLOCATE(OutData%r_e) - ALLOCATE(OutData%r_e(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_e.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r_e,2), UBOUND(OutData%r_e,2) - DO i1 = LBOUND(OutData%r_e,1), UBOUND(OutData%r_e,1) - OutData%r_e(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rhat_s 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%rhat_s)) DEALLOCATE(OutData%rhat_s) - ALLOCATE(OutData%rhat_s(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%rhat_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rhat_s,3), UBOUND(OutData%rhat_s,3) - DO i2 = LBOUND(OutData%rhat_s,2), UBOUND(OutData%rhat_s,2) - DO i1 = LBOUND(OutData%rhat_s,1), UBOUND(OutData%rhat_s,1) - OutData%rhat_s(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rhat_e 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%rhat_e)) DEALLOCATE(OutData%rhat_e) - ALLOCATE(OutData%rhat_e(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%rhat_e.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rhat_e,3), UBOUND(OutData%rhat_e,3) - DO i2 = LBOUND(OutData%rhat_e,2), UBOUND(OutData%rhat_e,2) - DO i1 = LBOUND(OutData%rhat_e,1), UBOUND(OutData%rhat_e,1) - OutData%rhat_e(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pvec_cs 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%pvec_cs)) DEALLOCATE(OutData%pvec_cs) - ALLOCATE(OutData%pvec_cs(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%pvec_cs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%pvec_cs,3), UBOUND(OutData%pvec_cs,3) - DO i2 = LBOUND(OutData%pvec_cs,2), UBOUND(OutData%pvec_cs,2) - DO i1 = LBOUND(OutData%pvec_cs,1), UBOUND(OutData%pvec_cs,1) - OutData%pvec_cs(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pvec_ce 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%pvec_ce)) DEALLOCATE(OutData%pvec_ce) - ALLOCATE(OutData%pvec_ce(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%pvec_ce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%pvec_ce,3), UBOUND(OutData%pvec_ce,3) - DO i2 = LBOUND(OutData%pvec_ce,2), UBOUND(OutData%pvec_ce,2) - DO i1 = LBOUND(OutData%pvec_ce,1), UBOUND(OutData%pvec_ce,1) - OutData%pvec_ce(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! outVizXYPlane 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%outVizXYPlane)) DEALLOCATE(OutData%outVizXYPlane) - ALLOCATE(OutData%outVizXYPlane(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%outVizXYPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%outVizXYPlane,4), UBOUND(OutData%outVizXYPlane,4) - DO i3 = LBOUND(OutData%outVizXYPlane,3), UBOUND(OutData%outVizXYPlane,3) - DO i2 = LBOUND(OutData%outVizXYPlane,2), UBOUND(OutData%outVizXYPlane,2) - DO i1 = LBOUND(OutData%outVizXYPlane,1), UBOUND(OutData%outVizXYPlane,1) - OutData%outVizXYPlane(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 ! outVizYZPlane 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%outVizYZPlane)) DEALLOCATE(OutData%outVizYZPlane) - ALLOCATE(OutData%outVizYZPlane(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%outVizYZPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%outVizYZPlane,4), UBOUND(OutData%outVizYZPlane,4) - DO i3 = LBOUND(OutData%outVizYZPlane,3), UBOUND(OutData%outVizYZPlane,3) - DO i2 = LBOUND(OutData%outVizYZPlane,2), UBOUND(OutData%outVizYZPlane,2) - DO i1 = LBOUND(OutData%outVizYZPlane,1), UBOUND(OutData%outVizYZPlane,1) - OutData%outVizYZPlane(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 ! outVizXZPlane 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%outVizXZPlane)) DEALLOCATE(OutData%outVizXZPlane) - ALLOCATE(OutData%outVizXZPlane(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%outVizXZPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%outVizXZPlane,4), UBOUND(OutData%outVizXZPlane,4) - DO i3 = LBOUND(OutData%outVizXZPlane,3), UBOUND(OutData%outVizXZPlane,3) - DO i2 = LBOUND(OutData%outVizXZPlane,2), UBOUND(OutData%outVizXZPlane,2) - DO i1 = LBOUND(OutData%outVizXZPlane,1), UBOUND(OutData%outVizXZPlane,1) - OutData%outVizXZPlane(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 ! IfW 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%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,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 InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - 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 - 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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IfW_Low, ErrStat2, ErrMsg2 ) ! u_IfW_Low - 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) - 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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IfW_High, ErrStat2, ErrMsg2 ) ! u_IfW_High - 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) - 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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_IfW_Low, ErrStat2, ErrMsg2 ) ! y_IfW_Low - 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) - 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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_IfW_High, ErrStat2, ErrMsg2 ) ! y_IfW_High - 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 AWAE_UnPackMisc - - SUBROUTINE AWAE_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AWAE_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyParam' -! + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%X0_high)) then + LB(1:1) = lbound(SrcInitOutputData%X0_high) + UB(1:1) = ubound(SrcInitOutputData%X0_high) + if (.not. allocated(DstInitOutputData%X0_high)) then + allocate(DstInitOutputData%X0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%X0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%X0_high = SrcInitOutputData%X0_high + end if + if (allocated(SrcInitOutputData%Y0_high)) then + LB(1:1) = lbound(SrcInitOutputData%Y0_high) + UB(1:1) = ubound(SrcInitOutputData%Y0_high) + if (.not. allocated(DstInitOutputData%Y0_high)) then + allocate(DstInitOutputData%Y0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Y0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%Y0_high = SrcInitOutputData%Y0_high + end if + if (allocated(SrcInitOutputData%Z0_high)) then + LB(1:1) = lbound(SrcInitOutputData%Z0_high) + UB(1:1) = ubound(SrcInitOutputData%Z0_high) + if (.not. allocated(DstInitOutputData%Z0_high)) then + allocate(DstInitOutputData%Z0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Z0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%Z0_high = SrcInitOutputData%Z0_high + end if + if (allocated(SrcInitOutputData%dX_high)) then + LB(1:1) = lbound(SrcInitOutputData%dX_high) + UB(1:1) = ubound(SrcInitOutputData%dX_high) + if (.not. allocated(DstInitOutputData%dX_high)) then + allocate(DstInitOutputData%dX_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dX_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%dX_high = SrcInitOutputData%dX_high + end if + if (allocated(SrcInitOutputData%dY_high)) then + LB(1:1) = lbound(SrcInitOutputData%dY_high) + UB(1:1) = ubound(SrcInitOutputData%dY_high) + if (.not. allocated(DstInitOutputData%dY_high)) then + allocate(DstInitOutputData%dY_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dY_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%dY_high = SrcInitOutputData%dY_high + end if + if (allocated(SrcInitOutputData%dZ_high)) then + LB(1:1) = lbound(SrcInitOutputData%dZ_high) + UB(1:1) = ubound(SrcInitOutputData%dZ_high) + if (.not. allocated(DstInitOutputData%dZ_high)) then + allocate(DstInitOutputData%dZ_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dZ_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%dZ_high = SrcInitOutputData%dZ_high + end if + DstInitOutputData%nX_high = SrcInitOutputData%nX_high + DstInitOutputData%nY_high = SrcInitOutputData%nY_high + DstInitOutputData%nZ_high = SrcInitOutputData%nZ_high + DstInitOutputData%dX_low = SrcInitOutputData%dX_low + DstInitOutputData%dY_low = SrcInitOutputData%dY_low + DstInitOutputData%dZ_low = SrcInitOutputData%dZ_low + DstInitOutputData%nX_low = SrcInitOutputData%nX_low + DstInitOutputData%nY_low = SrcInitOutputData%nY_low + DstInitOutputData%nZ_low = SrcInitOutputData%nZ_low + DstInitOutputData%X0_low = SrcInitOutputData%X0_low + DstInitOutputData%Y0_low = SrcInitOutputData%Y0_low + DstInitOutputData%Z0_low = SrcInitOutputData%Z0_low + if (allocated(SrcInitOutputData%Vdist_High)) then + LB(1:1) = lbound(SrcInitOutputData%Vdist_High) + UB(1:1) = ubound(SrcInitOutputData%Vdist_High) + if (.not. allocated(DstInitOutputData%Vdist_High)) then + allocate(DstInitOutputData%Vdist_High(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Vdist_High.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AWAE_CopyHighWindGridPtr(SrcInitOutputData%Vdist_High(i1), DstInitOutputData%Vdist_High(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AWAE_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(AWAE_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%WindFilePath = SrcParamData%WindFilePath - DstParamData%NumTurbines = SrcParamData%NumTurbines - DstParamData%NumRadii = SrcParamData%NumRadii - DstParamData%NumPlanes = SrcParamData%NumPlanes -IF (ALLOCATED(SrcParamData%y)) THEN - i1_l = LBOUND(SrcParamData%y,1) - i1_u = UBOUND(SrcParamData%y,1) - IF (.NOT. ALLOCATED(DstParamData%y)) THEN - ALLOCATE(DstParamData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%y = SrcParamData%y -ENDIF -IF (ALLOCATED(SrcParamData%z)) THEN - i1_l = LBOUND(SrcParamData%z,1) - i1_u = UBOUND(SrcParamData%z,1) - IF (.NOT. ALLOCATED(DstParamData%z)) THEN - ALLOCATE(DstParamData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%z = SrcParamData%z -ENDIF - DstParamData%Mod_AmbWind = SrcParamData%Mod_AmbWind - DstParamData%nX_low = SrcParamData%nX_low - DstParamData%nY_low = SrcParamData%nY_low - DstParamData%nZ_low = SrcParamData%nZ_low - DstParamData%NumGrid_low = SrcParamData%NumGrid_low - DstParamData%n_rp_max = SrcParamData%n_rp_max - DstParamData%dpol = SrcParamData%dpol - DstParamData%dXYZ_low = SrcParamData%dXYZ_low - DstParamData%dX_low = SrcParamData%dX_low - DstParamData%dY_low = SrcParamData%dY_low - DstParamData%dZ_low = SrcParamData%dZ_low - DstParamData%X0_low = SrcParamData%X0_low - DstParamData%Y0_low = SrcParamData%Y0_low - DstParamData%Z0_low = SrcParamData%Z0_low -IF (ALLOCATED(SrcParamData%X0_high)) THEN - i1_l = LBOUND(SrcParamData%X0_high,1) - i1_u = UBOUND(SrcParamData%X0_high,1) - IF (.NOT. ALLOCATED(DstParamData%X0_high)) THEN - ALLOCATE(DstParamData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%X0_high = SrcParamData%X0_high -ENDIF -IF (ALLOCATED(SrcParamData%Y0_high)) THEN - i1_l = LBOUND(SrcParamData%Y0_high,1) - i1_u = UBOUND(SrcParamData%Y0_high,1) - IF (.NOT. ALLOCATED(DstParamData%Y0_high)) THEN - ALLOCATE(DstParamData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Y0_high = SrcParamData%Y0_high -ENDIF -IF (ALLOCATED(SrcParamData%Z0_high)) THEN - i1_l = LBOUND(SrcParamData%Z0_high,1) - i1_u = UBOUND(SrcParamData%Z0_high,1) - IF (.NOT. ALLOCATED(DstParamData%Z0_high)) THEN - ALLOCATE(DstParamData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Z0_high = SrcParamData%Z0_high -ENDIF -IF (ALLOCATED(SrcParamData%dX_high)) THEN - i1_l = LBOUND(SrcParamData%dX_high,1) - i1_u = UBOUND(SrcParamData%dX_high,1) - IF (.NOT. ALLOCATED(DstParamData%dX_high)) THEN - ALLOCATE(DstParamData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dX_high = SrcParamData%dX_high -ENDIF -IF (ALLOCATED(SrcParamData%dY_high)) THEN - i1_l = LBOUND(SrcParamData%dY_high,1) - i1_u = UBOUND(SrcParamData%dY_high,1) - IF (.NOT. ALLOCATED(DstParamData%dY_high)) THEN - ALLOCATE(DstParamData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dY_high = SrcParamData%dY_high -ENDIF -IF (ALLOCATED(SrcParamData%dZ_high)) THEN - i1_l = LBOUND(SrcParamData%dZ_high,1) - i1_u = UBOUND(SrcParamData%dZ_high,1) - IF (.NOT. ALLOCATED(DstParamData%dZ_high)) THEN - ALLOCATE(DstParamData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dZ_high = SrcParamData%dZ_high -ENDIF - DstParamData%nX_high = SrcParamData%nX_high - DstParamData%nY_high = SrcParamData%nY_high - DstParamData%nZ_high = SrcParamData%nZ_high -IF (ALLOCATED(SrcParamData%Grid_low)) THEN - i1_l = LBOUND(SrcParamData%Grid_low,1) - i1_u = UBOUND(SrcParamData%Grid_low,1) - i2_l = LBOUND(SrcParamData%Grid_low,2) - i2_u = UBOUND(SrcParamData%Grid_low,2) - IF (.NOT. ALLOCATED(DstParamData%Grid_low)) THEN - ALLOCATE(DstParamData%Grid_low(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Grid_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Grid_low = SrcParamData%Grid_low -ENDIF -IF (ALLOCATED(SrcParamData%Grid_high)) THEN - i1_l = LBOUND(SrcParamData%Grid_high,1) - i1_u = UBOUND(SrcParamData%Grid_high,1) - i2_l = LBOUND(SrcParamData%Grid_high,2) - i2_u = UBOUND(SrcParamData%Grid_high,2) - i3_l = LBOUND(SrcParamData%Grid_high,3) - i3_u = UBOUND(SrcParamData%Grid_high,3) - IF (.NOT. ALLOCATED(DstParamData%Grid_high)) THEN - ALLOCATE(DstParamData%Grid_high(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%Grid_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Grid_high = SrcParamData%Grid_high -ENDIF -IF (ALLOCATED(SrcParamData%WT_Position)) THEN - i1_l = LBOUND(SrcParamData%WT_Position,1) - i1_u = UBOUND(SrcParamData%WT_Position,1) - i2_l = LBOUND(SrcParamData%WT_Position,2) - i2_u = UBOUND(SrcParamData%WT_Position,2) - IF (.NOT. ALLOCATED(DstParamData%WT_Position)) THEN - ALLOCATE(DstParamData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WT_Position = SrcParamData%WT_Position -ENDIF - DstParamData%n_high_low = SrcParamData%n_high_low - DstParamData%dt_low = SrcParamData%dt_low - DstParamData%dt_high = SrcParamData%dt_high - DstParamData%NumDT = SrcParamData%NumDT - DstParamData%Mod_Meander = SrcParamData%Mod_Meander - DstParamData%C_Meander = SrcParamData%C_Meander - DstParamData%C_ScaleDiam = SrcParamData%C_ScaleDiam - DstParamData%Mod_Projection = SrcParamData%Mod_Projection -IF (ALLOCATED(SrcParamData%IfW)) THEN - i1_l = LBOUND(SrcParamData%IfW,1) - i1_u = UBOUND(SrcParamData%IfW,1) - IF (.NOT. ALLOCATED(DstParamData%IfW)) THEN - ALLOCATE(DstParamData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%IfW,1), UBOUND(SrcParamData%IfW,1) - CALL InflowWind_CopyParam( SrcParamData%IfW(i1), DstParamData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%WrDisSkp1 = SrcParamData%WrDisSkp1 - DstParamData%WrDisWind = SrcParamData%WrDisWind - DstParamData%NOutDisWindXY = SrcParamData%NOutDisWindXY -IF (ALLOCATED(SrcParamData%OutDisWindZ)) THEN - i1_l = LBOUND(SrcParamData%OutDisWindZ,1) - i1_u = UBOUND(SrcParamData%OutDisWindZ,1) - IF (.NOT. ALLOCATED(DstParamData%OutDisWindZ)) THEN - ALLOCATE(DstParamData%OutDisWindZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutDisWindZ = SrcParamData%OutDisWindZ -ENDIF - DstParamData%NOutDisWindYZ = SrcParamData%NOutDisWindYZ -IF (ALLOCATED(SrcParamData%OutDisWindX)) THEN - i1_l = LBOUND(SrcParamData%OutDisWindX,1) - i1_u = UBOUND(SrcParamData%OutDisWindX,1) - IF (.NOT. ALLOCATED(DstParamData%OutDisWindX)) THEN - ALLOCATE(DstParamData%OutDisWindX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutDisWindX = SrcParamData%OutDisWindX -ENDIF - DstParamData%NOutDisWindXZ = SrcParamData%NOutDisWindXZ -IF (ALLOCATED(SrcParamData%OutDisWindY)) THEN - i1_l = LBOUND(SrcParamData%OutDisWindY,1) - i1_u = UBOUND(SrcParamData%OutDisWindY,1) - IF (.NOT. ALLOCATED(DstParamData%OutDisWindY)) THEN - ALLOCATE(DstParamData%OutDisWindY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutDisWindY = SrcParamData%OutDisWindY -ENDIF - DstParamData%OutFileRoot = SrcParamData%OutFileRoot - DstParamData%OutFileVTKRoot = SrcParamData%OutFileVTKRoot - DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth - END SUBROUTINE AWAE_CopyParam - - SUBROUTINE AWAE_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(AWAE_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 = 'AWAE_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%y)) THEN - DEALLOCATE(ParamData%y) -ENDIF -IF (ALLOCATED(ParamData%z)) THEN - DEALLOCATE(ParamData%z) -ENDIF -IF (ALLOCATED(ParamData%X0_high)) THEN - DEALLOCATE(ParamData%X0_high) -ENDIF -IF (ALLOCATED(ParamData%Y0_high)) THEN - DEALLOCATE(ParamData%Y0_high) -ENDIF -IF (ALLOCATED(ParamData%Z0_high)) THEN - DEALLOCATE(ParamData%Z0_high) -ENDIF -IF (ALLOCATED(ParamData%dX_high)) THEN - DEALLOCATE(ParamData%dX_high) -ENDIF -IF (ALLOCATED(ParamData%dY_high)) THEN - DEALLOCATE(ParamData%dY_high) -ENDIF -IF (ALLOCATED(ParamData%dZ_high)) THEN - DEALLOCATE(ParamData%dZ_high) -ENDIF -IF (ALLOCATED(ParamData%Grid_low)) THEN - DEALLOCATE(ParamData%Grid_low) -ENDIF -IF (ALLOCATED(ParamData%Grid_high)) THEN - DEALLOCATE(ParamData%Grid_high) -ENDIF -IF (ALLOCATED(ParamData%WT_Position)) THEN - DEALLOCATE(ParamData%WT_Position) -ENDIF -IF (ALLOCATED(ParamData%IfW)) THEN -DO i1 = LBOUND(ParamData%IfW,1), UBOUND(ParamData%IfW,1) - CALL InflowWind_DestroyParam( ParamData%IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%IfW) -ENDIF -IF (ALLOCATED(ParamData%OutDisWindZ)) THEN - DEALLOCATE(ParamData%OutDisWindZ) -ENDIF -IF (ALLOCATED(ParamData%OutDisWindX)) THEN - DEALLOCATE(ParamData%OutDisWindX) -ENDIF -IF (ALLOCATED(ParamData%OutDisWindY)) THEN - DEALLOCATE(ParamData%OutDisWindY) -ENDIF - END SUBROUTINE AWAE_DestroyParam - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 - Int_BufSz = Int_BufSz + 1*LEN(InData%WindFilePath) ! WindFilePath - Int_BufSz = Int_BufSz + 1 ! NumTurbines - Int_BufSz = Int_BufSz + 1 ! NumRadii - Int_BufSz = Int_BufSz + 1 ! NumPlanes - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%z) ! z - END IF - Int_BufSz = Int_BufSz + 1 ! Mod_AmbWind - Int_BufSz = Int_BufSz + 1 ! nX_low - Int_BufSz = Int_BufSz + 1 ! nY_low - Int_BufSz = Int_BufSz + 1 ! nZ_low - Int_BufSz = Int_BufSz + 1 ! NumGrid_low - Int_BufSz = Int_BufSz + 1 ! n_rp_max - Re_BufSz = Re_BufSz + 1 ! dpol - Re_BufSz = Re_BufSz + SIZE(InData%dXYZ_low) ! dXYZ_low - Re_BufSz = Re_BufSz + 1 ! dX_low - Re_BufSz = Re_BufSz + 1 ! dY_low - Re_BufSz = Re_BufSz + 1 ! dZ_low - Re_BufSz = Re_BufSz + 1 ! X0_low - Re_BufSz = Re_BufSz + 1 ! Y0_low - Re_BufSz = Re_BufSz + 1 ! Z0_low - Int_BufSz = Int_BufSz + 1 ! X0_high allocated yes/no - IF ( ALLOCATED(InData%X0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! X0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X0_high) ! X0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Y0_high allocated yes/no - IF ( ALLOCATED(InData%Y0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y0_high) ! Y0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Z0_high allocated yes/no - IF ( ALLOCATED(InData%Z0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Z0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Z0_high) ! Z0_high - END IF - Int_BufSz = Int_BufSz + 1 ! dX_high allocated yes/no - IF ( ALLOCATED(InData%dX_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dX_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dX_high) ! dX_high - END IF - Int_BufSz = Int_BufSz + 1 ! dY_high allocated yes/no - IF ( ALLOCATED(InData%dY_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dY_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dY_high) ! dY_high - END IF - Int_BufSz = Int_BufSz + 1 ! dZ_high allocated yes/no - IF ( ALLOCATED(InData%dZ_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dZ_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dZ_high) ! dZ_high - END IF - Int_BufSz = Int_BufSz + 1 ! nX_high - Int_BufSz = Int_BufSz + 1 ! nY_high - Int_BufSz = Int_BufSz + 1 ! nZ_high - Int_BufSz = Int_BufSz + 1 ! Grid_low allocated yes/no - IF ( ALLOCATED(InData%Grid_low) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Grid_low upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Grid_low) ! Grid_low - END IF - Int_BufSz = Int_BufSz + 1 ! Grid_high allocated yes/no - IF ( ALLOCATED(InData%Grid_high) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Grid_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Grid_high) ! Grid_high - END IF - Int_BufSz = Int_BufSz + 1 ! WT_Position allocated yes/no - IF ( ALLOCATED(InData%WT_Position) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WT_Position upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WT_Position) ! WT_Position - END IF - Int_BufSz = Int_BufSz + 1 ! n_high_low - Db_BufSz = Db_BufSz + 1 ! dt_low - Db_BufSz = Db_BufSz + 1 ! dt_high - Int_BufSz = Int_BufSz + 1 ! NumDT - Int_BufSz = Int_BufSz + 1 ! Mod_Meander - Re_BufSz = Re_BufSz + 1 ! C_Meander - Re_BufSz = Re_BufSz + 1 ! C_ScaleDiam - Int_BufSz = Int_BufSz + 1 ! Mod_Projection - Int_BufSz = Int_BufSz + 1 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WrDisSkp1 - Int_BufSz = Int_BufSz + 1 ! WrDisWind - Int_BufSz = Int_BufSz + 1 ! NOutDisWindXY - Int_BufSz = Int_BufSz + 1 ! OutDisWindZ allocated yes/no - IF ( ALLOCATED(InData%OutDisWindZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindZ) ! OutDisWindZ - END IF - Int_BufSz = Int_BufSz + 1 ! NOutDisWindYZ - Int_BufSz = Int_BufSz + 1 ! OutDisWindX allocated yes/no - IF ( ALLOCATED(InData%OutDisWindX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindX) ! OutDisWindX - END IF - Int_BufSz = Int_BufSz + 1 ! NOutDisWindXZ - Int_BufSz = Int_BufSz + 1 ! OutDisWindY allocated yes/no - IF ( ALLOCATED(InData%OutDisWindY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindY) ! OutDisWindY - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileVTKRoot) ! OutFileVTKRoot - Int_BufSz = Int_BufSz + 1 ! VTK_tWidth - 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%WindFilePath) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFilePath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NumTurbines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumRadii - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPlanes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%y) ) 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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - ReKiBuf(Re_Xferred) = InData%y(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z) ) 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%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - ReKiBuf(Re_Xferred) = InData%z(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Mod_AmbWind - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nX_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumGrid_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_rp_max - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dpol - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%dXYZ_low,1), UBOUND(InData%dXYZ_low,1) - ReKiBuf(Re_Xferred) = InData%dXYZ_low(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%dX_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dY_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dZ_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0_low - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%X0_high) ) 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%X0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%X0_high,1), UBOUND(InData%X0_high,1) - ReKiBuf(Re_Xferred) = InData%X0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y0_high) ) 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%Y0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y0_high,1), UBOUND(InData%Y0_high,1) - ReKiBuf(Re_Xferred) = InData%Y0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Z0_high) ) 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%Z0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Z0_high,1), UBOUND(InData%Z0_high,1) - ReKiBuf(Re_Xferred) = InData%Z0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dX_high) ) 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%dX_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dX_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dX_high,1), UBOUND(InData%dX_high,1) - ReKiBuf(Re_Xferred) = InData%dX_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dY_high) ) 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%dY_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dY_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dY_high,1), UBOUND(InData%dY_high,1) - ReKiBuf(Re_Xferred) = InData%dY_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dZ_high) ) 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%dZ_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dZ_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dZ_high,1), UBOUND(InData%dZ_high,1) - ReKiBuf(Re_Xferred) = InData%dZ_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nX_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_high - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Grid_low) ) 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%Grid_low,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Grid_low,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Grid_low,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Grid_low,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Grid_low,2), UBOUND(InData%Grid_low,2) - DO i1 = LBOUND(InData%Grid_low,1), UBOUND(InData%Grid_low,1) - ReKiBuf(Re_Xferred) = InData%Grid_low(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Grid_high) ) 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%Grid_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Grid_high,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Grid_high,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Grid_high,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Grid_high,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Grid_high,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Grid_high,3), UBOUND(InData%Grid_high,3) - DO i2 = LBOUND(InData%Grid_high,2), UBOUND(InData%Grid_high,2) - DO i1 = LBOUND(InData%Grid_high,1), UBOUND(InData%Grid_high,1) - ReKiBuf(Re_Xferred) = InData%Grid_high(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WT_Position) ) 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%WT_Position,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_Position,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WT_Position,2), UBOUND(InData%WT_Position,2) - DO i1 = LBOUND(InData%WT_Position,1), UBOUND(InData%WT_Position,1) - ReKiBuf(Re_Xferred) = InData%WT_Position(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n_high_low - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dt_low - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dt_high - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumDT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_Meander - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_Meander - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_ScaleDiam - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_Projection - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%IfW) ) 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%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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%WrDisSkp1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrDisWind, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutDisWindXY - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindZ) ) 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%OutDisWindZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindZ,1), UBOUND(InData%OutDisWindZ,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NOutDisWindYZ - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindX) ) 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%OutDisWindX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindX,1), UBOUND(InData%OutDisWindX,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NOutDisWindXZ - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindY) ) 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%OutDisWindY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindY,1), UBOUND(InData%OutDisWindY,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFileVTKRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileVTKRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%VTK_tWidth - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AWAE_PackParam - - SUBROUTINE AWAE_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(AWAE_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_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 - DO I = 1, LEN(OutData%WindFilePath) - OutData%WindFilePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumRadii = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPlanes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z 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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - OutData%z(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Mod_AmbWind = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nX_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumGrid_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_rp_max = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dpol = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%dXYZ_low,1) - i1_u = UBOUND(OutData%dXYZ_low,1) - DO i1 = LBOUND(OutData%dXYZ_low,1), UBOUND(OutData%dXYZ_low,1) - OutData%dXYZ_low(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%dX_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dY_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dZ_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X0_high 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%X0_high)) DEALLOCATE(OutData%X0_high) - ALLOCATE(OutData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%X0_high,1), UBOUND(OutData%X0_high,1) - OutData%X0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y0_high 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%Y0_high)) DEALLOCATE(OutData%Y0_high) - ALLOCATE(OutData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y0_high,1), UBOUND(OutData%Y0_high,1) - OutData%Y0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Z0_high 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%Z0_high)) DEALLOCATE(OutData%Z0_high) - ALLOCATE(OutData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Z0_high,1), UBOUND(OutData%Z0_high,1) - OutData%Z0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dX_high 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%dX_high)) DEALLOCATE(OutData%dX_high) - ALLOCATE(OutData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dX_high,1), UBOUND(OutData%dX_high,1) - OutData%dX_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dY_high 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%dY_high)) DEALLOCATE(OutData%dY_high) - ALLOCATE(OutData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dY_high,1), UBOUND(OutData%dY_high,1) - OutData%dY_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dZ_high 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%dZ_high)) DEALLOCATE(OutData%dZ_high) - ALLOCATE(OutData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dZ_high,1), UBOUND(OutData%dZ_high,1) - OutData%dZ_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%nX_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Grid_low 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%Grid_low)) DEALLOCATE(OutData%Grid_low) - ALLOCATE(OutData%Grid_low(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Grid_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Grid_low,2), UBOUND(OutData%Grid_low,2) - DO i1 = LBOUND(OutData%Grid_low,1), UBOUND(OutData%Grid_low,1) - OutData%Grid_low(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Grid_high 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%Grid_high)) DEALLOCATE(OutData%Grid_high) - ALLOCATE(OutData%Grid_high(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%Grid_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Grid_high,3), UBOUND(OutData%Grid_high,3) - DO i2 = LBOUND(OutData%Grid_high,2), UBOUND(OutData%Grid_high,2) - DO i1 = LBOUND(OutData%Grid_high,1), UBOUND(OutData%Grid_high,1) - OutData%Grid_high(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT_Position 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%WT_Position)) DEALLOCATE(OutData%WT_Position) - ALLOCATE(OutData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WT_Position,2), UBOUND(OutData%WT_Position,2) - DO i1 = LBOUND(OutData%WT_Position,1), UBOUND(OutData%WT_Position,1) - OutData%WT_Position(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%n_high_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dt_low = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%dt_high = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumDT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Mod_Meander = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_Meander = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_ScaleDiam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Mod_Projection = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IfW 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%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,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 InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - 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%WrDisSkp1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrDisWind = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrDisWind) - Int_Xferred = Int_Xferred + 1 - OutData%NOutDisWindXY = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindZ 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%OutDisWindZ)) DEALLOCATE(OutData%OutDisWindZ) - ALLOCATE(OutData%OutDisWindZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindZ,1), UBOUND(OutData%OutDisWindZ,1) - OutData%OutDisWindZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NOutDisWindYZ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindX 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%OutDisWindX)) DEALLOCATE(OutData%OutDisWindX) - ALLOCATE(OutData%OutDisWindX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindX,1), UBOUND(OutData%OutDisWindX,1) - OutData%OutDisWindX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NOutDisWindXZ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindY 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%OutDisWindY)) DEALLOCATE(OutData%OutDisWindY) - ALLOCATE(OutData%OutDisWindY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindY,1), UBOUND(OutData%OutDisWindY,1) - OutData%OutDisWindY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFileVTKRoot) - OutData%OutFileVTKRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%VTK_tWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AWAE_UnPackParam - - SUBROUTINE AWAE_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_OutputType), INTENT(IN) :: SrcOutputData - TYPE(AWAE_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) :: 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 = 'AWAE_CopyOutput' -! + ErrMsg = '' + 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) + end if + if (allocated(InitOutputData%Y0_high)) then + deallocate(InitOutputData%Y0_high) + end if + if (allocated(InitOutputData%Z0_high)) then + deallocate(InitOutputData%Z0_high) + end if + if (allocated(InitOutputData%dX_high)) then + deallocate(InitOutputData%dX_high) + end if + if (allocated(InitOutputData%dY_high)) then + deallocate(InitOutputData%dY_high) + end if + if (allocated(InitOutputData%dZ_high)) then + deallocate(InitOutputData%dZ_high) + end if + if (allocated(InitOutputData%Vdist_High)) then + LB(1:1) = lbound(InitOutputData%Vdist_High) + UB(1:1) = ubound(InitOutputData%Vdist_High) + do i1 = LB(1), UB(1) + call AWAE_DestroyHighWindGridPtr(InitOutputData%Vdist_High(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitOutputData%Vdist_High) + end if +end subroutine + +subroutine AWAE_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackInitOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, allocated(InData%X0_high)) + if (allocated(InData%X0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%X0_high), ubound(InData%X0_high)) + call RegPack(Buf, InData%X0_high) + end if + call RegPack(Buf, allocated(InData%Y0_high)) + if (allocated(InData%Y0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%Y0_high), ubound(InData%Y0_high)) + call RegPack(Buf, InData%Y0_high) + end if + call RegPack(Buf, allocated(InData%Z0_high)) + if (allocated(InData%Z0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%Z0_high), ubound(InData%Z0_high)) + call RegPack(Buf, InData%Z0_high) + end if + call RegPack(Buf, allocated(InData%dX_high)) + if (allocated(InData%dX_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dX_high), ubound(InData%dX_high)) + call RegPack(Buf, InData%dX_high) + end if + call RegPack(Buf, allocated(InData%dY_high)) + if (allocated(InData%dY_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dY_high), ubound(InData%dY_high)) + call RegPack(Buf, InData%dY_high) + end if + call RegPack(Buf, allocated(InData%dZ_high)) + if (allocated(InData%dZ_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dZ_high), ubound(InData%dZ_high)) + call RegPack(Buf, InData%dZ_high) + end if + call RegPack(Buf, InData%nX_high) + call RegPack(Buf, InData%nY_high) + call RegPack(Buf, InData%nZ_high) + call RegPack(Buf, InData%dX_low) + call RegPack(Buf, InData%dY_low) + call RegPack(Buf, InData%dZ_low) + call RegPack(Buf, InData%nX_low) + call RegPack(Buf, InData%nY_low) + call RegPack(Buf, InData%nZ_low) + call RegPack(Buf, InData%X0_low) + call RegPack(Buf, InData%Y0_low) + call RegPack(Buf, InData%Z0_low) + call RegPack(Buf, allocated(InData%Vdist_High)) + if (allocated(InData%Vdist_High)) then + call RegPackBounds(Buf, 1, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) + LB(1:1) = lbound(InData%Vdist_High) + UB(1:1) = ubound(InData%Vdist_High) + do i1 = LB(1), UB(1) + call AWAE_PackHighWindGridPtr(Buf, InData%Vdist_High(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackInitOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (allocated(OutData%X0_high)) deallocate(OutData%X0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Y0_high)) deallocate(OutData%Y0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Z0_high)) deallocate(OutData%Z0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Z0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Z0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dX_high)) deallocate(OutData%dX_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dX_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dX_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dY_high)) deallocate(OutData%dY_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dY_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dY_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dZ_high)) deallocate(OutData%dZ_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dZ_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dZ_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%nX_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nY_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nZ_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dX_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dY_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dZ_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nX_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nY_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nZ_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%X0_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Y0_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Z0_low) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Vdist_High)) deallocate(OutData%Vdist_High) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vdist_High(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AWAE_UnpackHighWindGridPtr(Buf, OutData%Vdist_High(i1)) ! Vdist_High + end do + end if +end subroutine + +subroutine AWAE_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_ContinuousStateType), intent(in) :: SrcContStateData + type(AWAE_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%Vdist_High)) THEN - i1_l = LBOUND(SrcOutputData%Vdist_High,1) - i1_u = UBOUND(SrcOutputData%Vdist_High,1) - IF (.NOT. ALLOCATED(DstOutputData%Vdist_High)) THEN - ALLOCATE(DstOutputData%Vdist_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vdist_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%Vdist_High,1), UBOUND(SrcOutputData%Vdist_High,1) - CALL AWAE_Copyhighwindgrid( SrcOutputData%Vdist_High(i1), DstOutputData%Vdist_High(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%V_plane)) THEN - i1_l = LBOUND(SrcOutputData%V_plane,1) - i1_u = UBOUND(SrcOutputData%V_plane,1) - i2_l = LBOUND(SrcOutputData%V_plane,2) - i2_u = UBOUND(SrcOutputData%V_plane,2) - i3_l = LBOUND(SrcOutputData%V_plane,3) - i3_u = UBOUND(SrcOutputData%V_plane,3) - IF (.NOT. ALLOCATED(DstOutputData%V_plane)) THEN - ALLOCATE(DstOutputData%V_plane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%V_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%V_plane = SrcOutputData%V_plane -ENDIF -IF (ALLOCATED(SrcOutputData%TI_amb)) THEN - i1_l = LBOUND(SrcOutputData%TI_amb,1) - i1_u = UBOUND(SrcOutputData%TI_amb,1) - IF (.NOT. ALLOCATED(DstOutputData%TI_amb)) THEN - ALLOCATE(DstOutputData%TI_amb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TI_amb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%TI_amb = SrcOutputData%TI_amb -ENDIF -IF (ALLOCATED(SrcOutputData%Vx_wind_disk)) THEN - i1_l = LBOUND(SrcOutputData%Vx_wind_disk,1) - i1_u = UBOUND(SrcOutputData%Vx_wind_disk,1) - IF (.NOT. ALLOCATED(DstOutputData%Vx_wind_disk)) THEN - ALLOCATE(DstOutputData%Vx_wind_disk(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wind_disk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vx_wind_disk = SrcOutputData%Vx_wind_disk -ENDIF - END SUBROUTINE AWAE_CopyOutput - - SUBROUTINE AWAE_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(AWAE_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 = 'AWAE_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%Vdist_High) -ENDIF -IF (ALLOCATED(OutputData%V_plane)) THEN - DEALLOCATE(OutputData%V_plane) -ENDIF -IF (ALLOCATED(OutputData%TI_amb)) THEN - DEALLOCATE(OutputData%TI_amb) -ENDIF -IF (ALLOCATED(OutputData%Vx_wind_disk)) THEN - DEALLOCATE(OutputData%Vx_wind_disk) -ENDIF - END SUBROUTINE AWAE_DestroyOutput - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 ! Vdist_High allocated yes/no - IF ( ALLOCATED(InData%Vdist_High) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vdist_High upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Vdist_High - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Vdist_High - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Vdist_High - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! V_plane allocated yes/no - IF ( ALLOCATED(InData%V_plane) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! V_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_plane) ! V_plane - END IF - Int_BufSz = Int_BufSz + 1 ! TI_amb allocated yes/no - IF ( ALLOCATED(InData%TI_amb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TI_amb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_amb) ! TI_amb - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wind_disk allocated yes/no - IF ( ALLOCATED(InData%Vx_wind_disk) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vx_wind_disk upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wind_disk) ! Vx_wind_disk - 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%Vdist_High) ) 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%Vdist_High,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%V_plane) ) 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%V_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%V_plane,3), UBOUND(InData%V_plane,3) - DO i2 = LBOUND(InData%V_plane,2), UBOUND(InData%V_plane,2) - DO i1 = LBOUND(InData%V_plane,1), UBOUND(InData%V_plane,1) - ReKiBuf(Re_Xferred) = InData%V_plane(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI_amb) ) 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%TI_amb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_amb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TI_amb,1), UBOUND(InData%TI_amb,1) - ReKiBuf(Re_Xferred) = InData%TI_amb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wind_disk) ) 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%Vx_wind_disk,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wind_disk,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vx_wind_disk,1), UBOUND(InData%Vx_wind_disk,1) - ReKiBuf(Re_Xferred) = InData%Vx_wind_disk(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AWAE_PackOutput - - SUBROUTINE AWAE_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(AWAE_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) :: 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 = 'AWAE_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 ! Vdist_High 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%Vdist_High)) DEALLOCATE(OutData%Vdist_High) - ALLOCATE(OutData%Vdist_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vdist_High,1), UBOUND(OutData%Vdist_High,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 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 - - 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 ! V_plane 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%V_plane)) DEALLOCATE(OutData%V_plane) - ALLOCATE(OutData%V_plane(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%V_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%V_plane,3), UBOUND(OutData%V_plane,3) - DO i2 = LBOUND(OutData%V_plane,2), UBOUND(OutData%V_plane,2) - DO i1 = LBOUND(OutData%V_plane,1), UBOUND(OutData%V_plane,1) - OutData%V_plane(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_amb 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%TI_amb)) DEALLOCATE(OutData%TI_amb) - ALLOCATE(OutData%TI_amb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_amb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TI_amb,1), UBOUND(OutData%TI_amb,1) - OutData%TI_amb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wind_disk 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%Vx_wind_disk)) DEALLOCATE(OutData%Vx_wind_disk) - ALLOCATE(OutData%Vx_wind_disk(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wind_disk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vx_wind_disk,1), UBOUND(OutData%Vx_wind_disk,1) - OutData%Vx_wind_disk(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AWAE_UnPackOutput - - SUBROUTINE AWAE_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_InputType), INTENT(IN) :: SrcInputData - TYPE(AWAE_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) :: 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 = 'AWAE_CopyInput' -! + ErrMsg = '' + if (allocated(SrcContStateData%IfW)) then + LB(1:1) = lbound(SrcContStateData%IfW) + UB(1:1) = ubound(SrcContStateData%IfW) + if (.not. allocated(DstContStateData%IfW)) then + allocate(DstContStateData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyContState(SrcContStateData%IfW(i1), DstContStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AWAE_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(AWAE_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%xhat_plane)) THEN - i1_l = LBOUND(SrcInputData%xhat_plane,1) - i1_u = UBOUND(SrcInputData%xhat_plane,1) - i2_l = LBOUND(SrcInputData%xhat_plane,2) - i2_u = UBOUND(SrcInputData%xhat_plane,2) - i3_l = LBOUND(SrcInputData%xhat_plane,3) - i3_u = UBOUND(SrcInputData%xhat_plane,3) - IF (.NOT. ALLOCATED(DstInputData%xhat_plane)) THEN - ALLOCATE(DstInputData%xhat_plane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%xhat_plane = SrcInputData%xhat_plane -ENDIF -IF (ALLOCATED(SrcInputData%p_plane)) THEN - i1_l = LBOUND(SrcInputData%p_plane,1) - i1_u = UBOUND(SrcInputData%p_plane,1) - i2_l = LBOUND(SrcInputData%p_plane,2) - i2_u = UBOUND(SrcInputData%p_plane,2) - i3_l = LBOUND(SrcInputData%p_plane,3) - i3_u = UBOUND(SrcInputData%p_plane,3) - IF (.NOT. ALLOCATED(DstInputData%p_plane)) THEN - ALLOCATE(DstInputData%p_plane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%p_plane = SrcInputData%p_plane -ENDIF -IF (ALLOCATED(SrcInputData%Vx_wake)) THEN - i1_l = LBOUND(SrcInputData%Vx_wake,1) - i1_u = UBOUND(SrcInputData%Vx_wake,1) - i2_l = LBOUND(SrcInputData%Vx_wake,2) - i2_u = UBOUND(SrcInputData%Vx_wake,2) - i3_l = LBOUND(SrcInputData%Vx_wake,3) - i3_u = UBOUND(SrcInputData%Vx_wake,3) - i4_l = LBOUND(SrcInputData%Vx_wake,4) - i4_u = UBOUND(SrcInputData%Vx_wake,4) - IF (.NOT. ALLOCATED(DstInputData%Vx_wake)) THEN - ALLOCATE(DstInputData%Vx_wake(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 DstInputData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vx_wake = SrcInputData%Vx_wake -ENDIF -IF (ALLOCATED(SrcInputData%Vy_wake)) THEN - i1_l = LBOUND(SrcInputData%Vy_wake,1) - i1_u = UBOUND(SrcInputData%Vy_wake,1) - i2_l = LBOUND(SrcInputData%Vy_wake,2) - i2_u = UBOUND(SrcInputData%Vy_wake,2) - i3_l = LBOUND(SrcInputData%Vy_wake,3) - i3_u = UBOUND(SrcInputData%Vy_wake,3) - i4_l = LBOUND(SrcInputData%Vy_wake,4) - i4_u = UBOUND(SrcInputData%Vy_wake,4) - IF (.NOT. ALLOCATED(DstInputData%Vy_wake)) THEN - ALLOCATE(DstInputData%Vy_wake(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 DstInputData%Vy_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vy_wake = SrcInputData%Vy_wake -ENDIF -IF (ALLOCATED(SrcInputData%Vz_wake)) THEN - i1_l = LBOUND(SrcInputData%Vz_wake,1) - i1_u = UBOUND(SrcInputData%Vz_wake,1) - i2_l = LBOUND(SrcInputData%Vz_wake,2) - i2_u = UBOUND(SrcInputData%Vz_wake,2) - i3_l = LBOUND(SrcInputData%Vz_wake,3) - i3_u = UBOUND(SrcInputData%Vz_wake,3) - i4_l = LBOUND(SrcInputData%Vz_wake,4) - i4_u = UBOUND(SrcInputData%Vz_wake,4) - IF (.NOT. ALLOCATED(DstInputData%Vz_wake)) THEN - ALLOCATE(DstInputData%Vz_wake(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 DstInputData%Vz_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vz_wake = SrcInputData%Vz_wake -ENDIF -IF (ALLOCATED(SrcInputData%D_wake)) THEN - i1_l = LBOUND(SrcInputData%D_wake,1) - i1_u = UBOUND(SrcInputData%D_wake,1) - i2_l = LBOUND(SrcInputData%D_wake,2) - i2_u = UBOUND(SrcInputData%D_wake,2) - IF (.NOT. ALLOCATED(DstInputData%D_wake)) THEN - ALLOCATE(DstInputData%D_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%D_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%D_wake = SrcInputData%D_wake -ENDIF -IF (ALLOCATED(SrcInputData%WAT_k_mt)) THEN - i1_l = LBOUND(SrcInputData%WAT_k_mt,1) - i1_u = UBOUND(SrcInputData%WAT_k_mt,1) - i2_l = LBOUND(SrcInputData%WAT_k_mt,2) - i2_u = UBOUND(SrcInputData%WAT_k_mt,2) - i3_l = LBOUND(SrcInputData%WAT_k_mt,3) - i3_u = UBOUND(SrcInputData%WAT_k_mt,3) - IF (.NOT. ALLOCATED(DstInputData%WAT_k_mt)) THEN - ALLOCATE(DstInputData%WAT_k_mt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%WAT_k_mt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%WAT_k_mt = SrcInputData%WAT_k_mt -ENDIF - END SUBROUTINE AWAE_CopyInput - - SUBROUTINE AWAE_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(AWAE_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 = 'AWAE_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%xhat_plane)) THEN - DEALLOCATE(InputData%xhat_plane) -ENDIF -IF (ALLOCATED(InputData%p_plane)) THEN - DEALLOCATE(InputData%p_plane) -ENDIF -IF (ALLOCATED(InputData%Vx_wake)) THEN - DEALLOCATE(InputData%Vx_wake) -ENDIF -IF (ALLOCATED(InputData%Vy_wake)) THEN - DEALLOCATE(InputData%Vy_wake) -ENDIF -IF (ALLOCATED(InputData%Vz_wake)) THEN - DEALLOCATE(InputData%Vz_wake) -ENDIF -IF (ALLOCATED(InputData%D_wake)) THEN - DEALLOCATE(InputData%D_wake) -ENDIF -IF (ALLOCATED(InputData%WAT_k_mt)) THEN - DEALLOCATE(InputData%WAT_k_mt) -ENDIF - END SUBROUTINE AWAE_DestroyInput - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 - Int_BufSz = Int_BufSz + 1 ! xhat_plane allocated yes/no - IF ( ALLOCATED(InData%xhat_plane) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! xhat_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xhat_plane) ! xhat_plane - END IF - Int_BufSz = Int_BufSz + 1 ! p_plane allocated yes/no - IF ( ALLOCATED(InData%p_plane) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! p_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%p_plane) ! p_plane - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wake allocated yes/no - IF ( ALLOCATED(InData%Vx_wake) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vx_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wake) ! Vx_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vy_wake allocated yes/no - IF ( ALLOCATED(InData%Vy_wake) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vy_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vy_wake) ! Vy_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vz_wake allocated yes/no - IF ( ALLOCATED(InData%Vz_wake) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vz_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vz_wake) ! Vz_wake - END IF - Int_BufSz = Int_BufSz + 1 ! D_wake allocated yes/no - IF ( ALLOCATED(InData%D_wake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D_wake) ! D_wake - END IF - Int_BufSz = Int_BufSz + 1 ! WAT_k_mt allocated yes/no - IF ( ALLOCATED(InData%WAT_k_mt) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WAT_k_mt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WAT_k_mt) ! WAT_k_mt - 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%xhat_plane) ) 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%xhat_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%xhat_plane,3), UBOUND(InData%xhat_plane,3) - DO i2 = LBOUND(InData%xhat_plane,2), UBOUND(InData%xhat_plane,2) - DO i1 = LBOUND(InData%xhat_plane,1), UBOUND(InData%xhat_plane,1) - ReKiBuf(Re_Xferred) = InData%xhat_plane(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%p_plane) ) 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%p_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%p_plane,3), UBOUND(InData%p_plane,3) - DO i2 = LBOUND(InData%p_plane,2), UBOUND(InData%p_plane,2) - DO i1 = LBOUND(InData%p_plane,1), UBOUND(InData%p_plane,1) - ReKiBuf(Re_Xferred) = InData%p_plane(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wake) ) 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%Vx_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vx_wake,4), UBOUND(InData%Vx_wake,4) - DO i3 = LBOUND(InData%Vx_wake,3), UBOUND(InData%Vx_wake,3) - DO i2 = LBOUND(InData%Vx_wake,2), UBOUND(InData%Vx_wake,2) - DO i1 = LBOUND(InData%Vx_wake,1), UBOUND(InData%Vx_wake,1) - ReKiBuf(Re_Xferred) = InData%Vx_wake(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vy_wake) ) 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%Vy_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vy_wake,4), UBOUND(InData%Vy_wake,4) - DO i3 = LBOUND(InData%Vy_wake,3), UBOUND(InData%Vy_wake,3) - DO i2 = LBOUND(InData%Vy_wake,2), UBOUND(InData%Vy_wake,2) - DO i1 = LBOUND(InData%Vy_wake,1), UBOUND(InData%Vy_wake,1) - ReKiBuf(Re_Xferred) = InData%Vy_wake(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vz_wake) ) 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%Vz_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vz_wake,4), UBOUND(InData%Vz_wake,4) - DO i3 = LBOUND(InData%Vz_wake,3), UBOUND(InData%Vz_wake,3) - DO i2 = LBOUND(InData%Vz_wake,2), UBOUND(InData%Vz_wake,2) - DO i1 = LBOUND(InData%Vz_wake,1), UBOUND(InData%Vz_wake,1) - ReKiBuf(Re_Xferred) = InData%Vz_wake(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D_wake) ) 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%D_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_wake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D_wake,2), UBOUND(InData%D_wake,2) - DO i1 = LBOUND(InData%D_wake,1), UBOUND(InData%D_wake,1) - ReKiBuf(Re_Xferred) = InData%D_wake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WAT_k_mt) ) 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%WAT_k_mt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WAT_k_mt,3), UBOUND(InData%WAT_k_mt,3) - DO i2 = LBOUND(InData%WAT_k_mt,2), UBOUND(InData%WAT_k_mt,2) - DO i1 = LBOUND(InData%WAT_k_mt,1), UBOUND(InData%WAT_k_mt,1) - ReKiBuf(Re_Xferred) = InData%WAT_k_mt(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AWAE_PackInput - - SUBROUTINE AWAE_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(AWAE_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) :: 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 = 'AWAE_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xhat_plane 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%xhat_plane)) DEALLOCATE(OutData%xhat_plane) - ALLOCATE(OutData%xhat_plane(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%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%xhat_plane,3), UBOUND(OutData%xhat_plane,3) - DO i2 = LBOUND(OutData%xhat_plane,2), UBOUND(OutData%xhat_plane,2) - DO i1 = LBOUND(OutData%xhat_plane,1), UBOUND(OutData%xhat_plane,1) - OutData%xhat_plane(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p_plane 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%p_plane)) DEALLOCATE(OutData%p_plane) - ALLOCATE(OutData%p_plane(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%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%p_plane,3), UBOUND(OutData%p_plane,3) - DO i2 = LBOUND(OutData%p_plane,2), UBOUND(OutData%p_plane,2) - DO i1 = LBOUND(OutData%p_plane,1), UBOUND(OutData%p_plane,1) - OutData%p_plane(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wake 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%Vx_wake)) DEALLOCATE(OutData%Vx_wake) - ALLOCATE(OutData%Vx_wake(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%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vx_wake,4), UBOUND(OutData%Vx_wake,4) - DO i3 = LBOUND(OutData%Vx_wake,3), UBOUND(OutData%Vx_wake,3) - DO i2 = LBOUND(OutData%Vx_wake,2), UBOUND(OutData%Vx_wake,2) - DO i1 = LBOUND(OutData%Vx_wake,1), UBOUND(OutData%Vx_wake,1) - OutData%Vx_wake(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vy_wake 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%Vy_wake)) DEALLOCATE(OutData%Vy_wake) - ALLOCATE(OutData%Vy_wake(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%Vy_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vy_wake,4), UBOUND(OutData%Vy_wake,4) - DO i3 = LBOUND(OutData%Vy_wake,3), UBOUND(OutData%Vy_wake,3) - DO i2 = LBOUND(OutData%Vy_wake,2), UBOUND(OutData%Vy_wake,2) - DO i1 = LBOUND(OutData%Vy_wake,1), UBOUND(OutData%Vy_wake,1) - OutData%Vy_wake(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vz_wake 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%Vz_wake)) DEALLOCATE(OutData%Vz_wake) - ALLOCATE(OutData%Vz_wake(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%Vz_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vz_wake,4), UBOUND(OutData%Vz_wake,4) - DO i3 = LBOUND(OutData%Vz_wake,3), UBOUND(OutData%Vz_wake,3) - DO i2 = LBOUND(OutData%Vz_wake,2), UBOUND(OutData%Vz_wake,2) - DO i1 = LBOUND(OutData%Vz_wake,1), UBOUND(OutData%Vz_wake,1) - OutData%Vz_wake(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_wake 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%D_wake)) DEALLOCATE(OutData%D_wake) - ALLOCATE(OutData%D_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D_wake,2), UBOUND(OutData%D_wake,2) - DO i1 = LBOUND(OutData%D_wake,1), UBOUND(OutData%D_wake,1) - OutData%D_wake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAT_k_mt 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%WAT_k_mt)) DEALLOCATE(OutData%WAT_k_mt) - ALLOCATE(OutData%WAT_k_mt(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%WAT_k_mt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WAT_k_mt,3), UBOUND(OutData%WAT_k_mt,3) - DO i2 = LBOUND(OutData%WAT_k_mt,2), UBOUND(OutData%WAT_k_mt,2) - DO i1 = LBOUND(OutData%WAT_k_mt,1), UBOUND(OutData%WAT_k_mt,1) - OutData%WAT_k_mt(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AWAE_UnPackInput - + ErrMsg = '' + if (allocated(ContStateData%IfW)) then + LB(1:1) = lbound(ContStateData%IfW) + UB(1:1) = ubound(ContStateData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyContState(ContStateData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%IfW) + end if +end subroutine + +subroutine AWAE_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackContState(Buf, InData%IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackContState(Buf, OutData%IfW(i1)) ! IfW + end do + end if +end subroutine + +subroutine AWAE_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_DiscreteStateType), intent(in) :: SrcDiscStateData + type(AWAE_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDiscStateData%IfW)) then + LB(1:1) = lbound(SrcDiscStateData%IfW) + UB(1:1) = ubound(SrcDiscStateData%IfW) + if (.not. allocated(DstDiscStateData%IfW)) then + allocate(DstDiscStateData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyDiscState(SrcDiscStateData%IfW(i1), DstDiscStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AWAE_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(AWAE_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%IfW)) then + LB(1:1) = lbound(DiscStateData%IfW) + UB(1:1) = ubound(DiscStateData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyDiscState(DiscStateData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%IfW) + end if +end subroutine + +subroutine AWAE_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackDiscState(Buf, InData%IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackDiscState(Buf, OutData%IfW(i1)) ! IfW + end do + end if +end subroutine + +subroutine AWAE_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_ConstraintStateType), intent(in) :: SrcConstrStateData + type(AWAE_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcConstrStateData%IfW)) then + LB(1:1) = lbound(SrcConstrStateData%IfW) + UB(1:1) = ubound(SrcConstrStateData%IfW) + if (.not. allocated(DstConstrStateData%IfW)) then + allocate(DstConstrStateData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyConstrState(SrcConstrStateData%IfW(i1), DstConstrStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AWAE_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(AWAE_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConstrStateData%IfW)) then + LB(1:1) = lbound(ConstrStateData%IfW) + UB(1:1) = ubound(ConstrStateData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyConstrState(ConstrStateData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%IfW) + end if +end subroutine + +subroutine AWAE_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackConstrState(Buf, InData%IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackConstrState(Buf, OutData%IfW(i1)) ! IfW + end do + end if +end subroutine + +subroutine AWAE_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_OtherStateType), intent(in) :: SrcOtherStateData + type(AWAE_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%IfW)) then + LB(1:1) = lbound(SrcOtherStateData%IfW) + UB(1:1) = ubound(SrcOtherStateData%IfW) + if (.not. allocated(DstOtherStateData%IfW)) then + allocate(DstOtherStateData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyOtherState(SrcOtherStateData%IfW(i1), DstOtherStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AWAE_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(AWAE_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%IfW)) then + LB(1:1) = lbound(OtherStateData%IfW) + UB(1:1) = ubound(OtherStateData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyOtherState(OtherStateData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%IfW) + end if +end subroutine + +subroutine AWAE_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackOtherState(Buf, InData%IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackOtherState(Buf, OutData%IfW(i1)) ! IfW + end do + end if +end subroutine + +subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_MiscVarType), intent(in) :: SrcMiscData + type(AWAE_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%Vamb_low)) then + LB(1:4) = lbound(SrcMiscData%Vamb_low) + UB(1:4) = ubound(SrcMiscData%Vamb_low) + if (.not. allocated(DstMiscData%Vamb_low)) then + allocate(DstMiscData%Vamb_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_low.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vamb_low = SrcMiscData%Vamb_low + end if + if (allocated(SrcMiscData%Vamb_lowpol)) then + LB(1:2) = lbound(SrcMiscData%Vamb_lowpol) + UB(1:2) = ubound(SrcMiscData%Vamb_lowpol) + if (.not. allocated(DstMiscData%Vamb_lowpol)) then + allocate(DstMiscData%Vamb_lowpol(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_lowpol.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vamb_lowpol = SrcMiscData%Vamb_lowpol + end if + if (allocated(SrcMiscData%Vdist_low)) then + LB(1:4) = lbound(SrcMiscData%Vdist_low) + UB(1:4) = ubound(SrcMiscData%Vdist_low) + if (.not. allocated(DstMiscData%Vdist_low)) then + allocate(DstMiscData%Vdist_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vdist_low.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vdist_low = SrcMiscData%Vdist_low + end if + if (allocated(SrcMiscData%Vdist_low_full)) then + LB(1:4) = lbound(SrcMiscData%Vdist_low_full) + UB(1:4) = ubound(SrcMiscData%Vdist_low_full) + if (.not. allocated(DstMiscData%Vdist_low_full)) then + allocate(DstMiscData%Vdist_low_full(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vdist_low_full.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vdist_low_full = SrcMiscData%Vdist_low_full + end if + if (allocated(SrcMiscData%Vamb_High)) then + LB(1:1) = lbound(SrcMiscData%Vamb_High) + UB(1:1) = ubound(SrcMiscData%Vamb_High) + if (.not. allocated(DstMiscData%Vamb_High)) then + allocate(DstMiscData%Vamb_High(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_High.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AWAE_CopyHighWindGrid(SrcMiscData%Vamb_High(i1), DstMiscData%Vamb_High(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%parallelFlag)) then + LB(1:2) = lbound(SrcMiscData%parallelFlag) + UB(1:2) = ubound(SrcMiscData%parallelFlag) + if (.not. allocated(DstMiscData%parallelFlag)) then + allocate(DstMiscData%parallelFlag(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%parallelFlag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%parallelFlag = SrcMiscData%parallelFlag + end if + if (allocated(SrcMiscData%r_s)) then + LB(1:2) = lbound(SrcMiscData%r_s) + UB(1:2) = ubound(SrcMiscData%r_s) + if (.not. allocated(DstMiscData%r_s)) then + allocate(DstMiscData%r_s(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_s.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%r_s = SrcMiscData%r_s + end if + if (allocated(SrcMiscData%r_e)) then + LB(1:2) = lbound(SrcMiscData%r_e) + UB(1:2) = ubound(SrcMiscData%r_e) + if (.not. allocated(DstMiscData%r_e)) then + allocate(DstMiscData%r_e(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_e.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%r_e = SrcMiscData%r_e + end if + if (allocated(SrcMiscData%rhat_s)) then + LB(1:3) = lbound(SrcMiscData%rhat_s) + UB(1:3) = ubound(SrcMiscData%rhat_s) + if (.not. allocated(DstMiscData%rhat_s)) then + allocate(DstMiscData%rhat_s(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rhat_s.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rhat_s = SrcMiscData%rhat_s + end if + if (allocated(SrcMiscData%rhat_e)) then + LB(1:3) = lbound(SrcMiscData%rhat_e) + UB(1:3) = ubound(SrcMiscData%rhat_e) + if (.not. allocated(DstMiscData%rhat_e)) then + allocate(DstMiscData%rhat_e(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rhat_e.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rhat_e = SrcMiscData%rhat_e + end if + if (allocated(SrcMiscData%pvec_cs)) then + LB(1:3) = lbound(SrcMiscData%pvec_cs) + UB(1:3) = ubound(SrcMiscData%pvec_cs) + if (.not. allocated(DstMiscData%pvec_cs)) then + allocate(DstMiscData%pvec_cs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%pvec_cs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%pvec_cs = SrcMiscData%pvec_cs + end if + if (allocated(SrcMiscData%pvec_ce)) then + LB(1:3) = lbound(SrcMiscData%pvec_ce) + UB(1:3) = ubound(SrcMiscData%pvec_ce) + if (.not. allocated(DstMiscData%pvec_ce)) then + allocate(DstMiscData%pvec_ce(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%pvec_ce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%pvec_ce = SrcMiscData%pvec_ce + end if + if (allocated(SrcMiscData%outVizXYPlane)) then + LB(1:4) = lbound(SrcMiscData%outVizXYPlane) + UB(1:4) = ubound(SrcMiscData%outVizXYPlane) + if (.not. allocated(DstMiscData%outVizXYPlane)) then + allocate(DstMiscData%outVizXYPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%outVizXYPlane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%outVizXYPlane = SrcMiscData%outVizXYPlane + end if + if (allocated(SrcMiscData%outVizYZPlane)) then + LB(1:4) = lbound(SrcMiscData%outVizYZPlane) + UB(1:4) = ubound(SrcMiscData%outVizYZPlane) + if (.not. allocated(DstMiscData%outVizYZPlane)) then + allocate(DstMiscData%outVizYZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%outVizYZPlane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%outVizYZPlane = SrcMiscData%outVizYZPlane + end if + if (allocated(SrcMiscData%outVizXZPlane)) then + LB(1:4) = lbound(SrcMiscData%outVizXZPlane) + UB(1:4) = ubound(SrcMiscData%outVizXZPlane) + if (.not. allocated(DstMiscData%outVizXZPlane)) then + allocate(DstMiscData%outVizXZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%outVizXZPlane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%outVizXZPlane = SrcMiscData%outVizXZPlane + end if + if (allocated(SrcMiscData%IfW)) then + LB(1:1) = lbound(SrcMiscData%IfW) + UB(1:1) = ubound(SrcMiscData%IfW) + if (.not. allocated(DstMiscData%IfW)) then + allocate(DstMiscData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyMisc(SrcMiscData%IfW(i1), DstMiscData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call InflowWind_CopyInput(SrcMiscData%u_IfW_Low, DstMiscData%u_IfW_Low, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcMiscData%u_IfW_High, DstMiscData%u_IfW_High, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcMiscData%y_IfW_Low, DstMiscData%y_IfW_Low, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcMiscData%y_IfW_High, DstMiscData%y_IfW_High, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(AWAE_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%Vamb_low)) then + deallocate(MiscData%Vamb_low) + end if + if (allocated(MiscData%Vamb_lowpol)) then + deallocate(MiscData%Vamb_lowpol) + end if + if (allocated(MiscData%Vdist_low)) then + deallocate(MiscData%Vdist_low) + end if + if (allocated(MiscData%Vdist_low_full)) then + deallocate(MiscData%Vdist_low_full) + end if + if (allocated(MiscData%Vamb_High)) then + LB(1:1) = lbound(MiscData%Vamb_High) + UB(1:1) = ubound(MiscData%Vamb_High) + do i1 = LB(1), UB(1) + call AWAE_DestroyHighWindGrid(MiscData%Vamb_High(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%Vamb_High) + end if + if (allocated(MiscData%parallelFlag)) then + deallocate(MiscData%parallelFlag) + end if + if (allocated(MiscData%r_s)) then + deallocate(MiscData%r_s) + end if + if (allocated(MiscData%r_e)) then + deallocate(MiscData%r_e) + end if + if (allocated(MiscData%rhat_s)) then + deallocate(MiscData%rhat_s) + end if + if (allocated(MiscData%rhat_e)) then + deallocate(MiscData%rhat_e) + end if + if (allocated(MiscData%pvec_cs)) then + deallocate(MiscData%pvec_cs) + end if + if (allocated(MiscData%pvec_ce)) then + deallocate(MiscData%pvec_ce) + end if + if (allocated(MiscData%outVizXYPlane)) then + deallocate(MiscData%outVizXYPlane) + end if + if (allocated(MiscData%outVizYZPlane)) then + deallocate(MiscData%outVizYZPlane) + end if + if (allocated(MiscData%outVizXZPlane)) then + deallocate(MiscData%outVizXZPlane) + end if + if (allocated(MiscData%IfW)) then + LB(1:1) = lbound(MiscData%IfW) + UB(1:1) = ubound(MiscData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyMisc(MiscData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%IfW) + end if + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AWAE_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackMisc' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Vamb_low)) + if (allocated(InData%Vamb_low)) then + call RegPackBounds(Buf, 4, lbound(InData%Vamb_low), ubound(InData%Vamb_low)) + call RegPack(Buf, InData%Vamb_low) + end if + call RegPack(Buf, allocated(InData%Vamb_lowpol)) + if (allocated(InData%Vamb_lowpol)) then + call RegPackBounds(Buf, 2, lbound(InData%Vamb_lowpol), ubound(InData%Vamb_lowpol)) + call RegPack(Buf, InData%Vamb_lowpol) + end if + call RegPack(Buf, allocated(InData%Vdist_low)) + if (allocated(InData%Vdist_low)) then + call RegPackBounds(Buf, 4, lbound(InData%Vdist_low), ubound(InData%Vdist_low)) + call RegPack(Buf, InData%Vdist_low) + end if + call RegPack(Buf, allocated(InData%Vdist_low_full)) + if (allocated(InData%Vdist_low_full)) then + call RegPackBounds(Buf, 4, lbound(InData%Vdist_low_full), ubound(InData%Vdist_low_full)) + call RegPack(Buf, InData%Vdist_low_full) + end if + call RegPack(Buf, allocated(InData%Vamb_High)) + if (allocated(InData%Vamb_High)) then + call RegPackBounds(Buf, 1, lbound(InData%Vamb_High), ubound(InData%Vamb_High)) + LB(1:1) = lbound(InData%Vamb_High) + UB(1:1) = ubound(InData%Vamb_High) + do i1 = LB(1), UB(1) + call AWAE_PackHighWindGrid(Buf, InData%Vamb_High(i1)) + end do + end if + call RegPack(Buf, allocated(InData%parallelFlag)) + if (allocated(InData%parallelFlag)) then + call RegPackBounds(Buf, 2, lbound(InData%parallelFlag), ubound(InData%parallelFlag)) + call RegPack(Buf, InData%parallelFlag) + end if + call RegPack(Buf, allocated(InData%r_s)) + if (allocated(InData%r_s)) then + call RegPackBounds(Buf, 2, lbound(InData%r_s), ubound(InData%r_s)) + call RegPack(Buf, InData%r_s) + end if + call RegPack(Buf, allocated(InData%r_e)) + if (allocated(InData%r_e)) then + call RegPackBounds(Buf, 2, lbound(InData%r_e), ubound(InData%r_e)) + call RegPack(Buf, InData%r_e) + end if + call RegPack(Buf, allocated(InData%rhat_s)) + if (allocated(InData%rhat_s)) then + call RegPackBounds(Buf, 3, lbound(InData%rhat_s), ubound(InData%rhat_s)) + call RegPack(Buf, InData%rhat_s) + end if + call RegPack(Buf, allocated(InData%rhat_e)) + if (allocated(InData%rhat_e)) then + call RegPackBounds(Buf, 3, lbound(InData%rhat_e), ubound(InData%rhat_e)) + call RegPack(Buf, InData%rhat_e) + end if + call RegPack(Buf, allocated(InData%pvec_cs)) + if (allocated(InData%pvec_cs)) then + call RegPackBounds(Buf, 3, lbound(InData%pvec_cs), ubound(InData%pvec_cs)) + call RegPack(Buf, InData%pvec_cs) + end if + call RegPack(Buf, allocated(InData%pvec_ce)) + if (allocated(InData%pvec_ce)) then + call RegPackBounds(Buf, 3, lbound(InData%pvec_ce), ubound(InData%pvec_ce)) + call RegPack(Buf, InData%pvec_ce) + end if + call RegPack(Buf, allocated(InData%outVizXYPlane)) + if (allocated(InData%outVizXYPlane)) then + call RegPackBounds(Buf, 4, lbound(InData%outVizXYPlane), ubound(InData%outVizXYPlane)) + call RegPack(Buf, InData%outVizXYPlane) + end if + call RegPack(Buf, allocated(InData%outVizYZPlane)) + if (allocated(InData%outVizYZPlane)) then + call RegPackBounds(Buf, 4, lbound(InData%outVizYZPlane), ubound(InData%outVizYZPlane)) + call RegPack(Buf, InData%outVizYZPlane) + end if + call RegPack(Buf, allocated(InData%outVizXZPlane)) + if (allocated(InData%outVizXZPlane)) then + call RegPackBounds(Buf, 4, lbound(InData%outVizXZPlane), ubound(InData%outVizXZPlane)) + call RegPack(Buf, InData%outVizXZPlane) + end if + call RegPack(Buf, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackMisc(Buf, InData%IfW(i1)) + end do + end if + call InflowWind_PackInput(Buf, InData%u_IfW_Low) + call InflowWind_PackInput(Buf, InData%u_IfW_High) + call InflowWind_PackOutput(Buf, InData%y_IfW_Low) + call InflowWind_PackOutput(Buf, InData%y_IfW_High) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackMisc' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Vamb_low)) deallocate(OutData%Vamb_low) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vamb_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_low.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vamb_low) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vamb_lowpol)) deallocate(OutData%Vamb_lowpol) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vamb_lowpol(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_lowpol.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vamb_lowpol) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vdist_low)) deallocate(OutData%Vdist_low) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vdist_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_low.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vdist_low) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vdist_low_full)) deallocate(OutData%Vdist_low_full) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vdist_low_full(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_low_full.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vdist_low_full) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vamb_High)) deallocate(OutData%Vamb_High) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vamb_High(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_High.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AWAE_UnpackHighWindGrid(Buf, OutData%Vamb_High(i1)) ! Vamb_High + end do + end if + if (allocated(OutData%parallelFlag)) deallocate(OutData%parallelFlag) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%parallelFlag(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%parallelFlag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%parallelFlag) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%r_s)) deallocate(OutData%r_s) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_s(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_s.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_s) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%r_e)) deallocate(OutData%r_e) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_e(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_e.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_e) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rhat_s)) deallocate(OutData%rhat_s) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rhat_s(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rhat_s.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rhat_s) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rhat_e)) deallocate(OutData%rhat_e) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rhat_e(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rhat_e.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rhat_e) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%pvec_cs)) deallocate(OutData%pvec_cs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%pvec_cs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pvec_cs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%pvec_cs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%pvec_ce)) deallocate(OutData%pvec_ce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%pvec_ce(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pvec_ce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%pvec_ce) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%outVizXYPlane)) deallocate(OutData%outVizXYPlane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%outVizXYPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%outVizXYPlane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%outVizXYPlane) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%outVizYZPlane)) deallocate(OutData%outVizYZPlane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%outVizYZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%outVizYZPlane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%outVizYZPlane) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%outVizXZPlane)) deallocate(OutData%outVizXZPlane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%outVizXZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%outVizXZPlane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%outVizXZPlane) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackMisc(Buf, OutData%IfW(i1)) ! IfW + end do + end if + call InflowWind_UnpackInput(Buf, OutData%u_IfW_Low) ! u_IfW_Low + call InflowWind_UnpackInput(Buf, OutData%u_IfW_High) ! u_IfW_High + call InflowWind_UnpackOutput(Buf, OutData%y_IfW_Low) ! y_IfW_Low + call InflowWind_UnpackOutput(Buf, OutData%y_IfW_High) ! y_IfW_High +end subroutine + +subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_ParameterType), intent(in) :: SrcParamData + type(AWAE_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%WindFilePath = SrcParamData%WindFilePath + DstParamData%NumTurbines = SrcParamData%NumTurbines + DstParamData%NumRadii = SrcParamData%NumRadii + DstParamData%NumPlanes = SrcParamData%NumPlanes + if (allocated(SrcParamData%y)) then + LB(1:1) = lbound(SrcParamData%y) + UB(1:1) = ubound(SrcParamData%y) + if (.not. allocated(DstParamData%y)) then + allocate(DstParamData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%y = SrcParamData%y + end if + if (allocated(SrcParamData%z)) then + LB(1:1) = lbound(SrcParamData%z) + UB(1:1) = ubound(SrcParamData%z) + if (.not. allocated(DstParamData%z)) then + allocate(DstParamData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%z = SrcParamData%z + end if + DstParamData%Mod_AmbWind = SrcParamData%Mod_AmbWind + DstParamData%nX_low = SrcParamData%nX_low + DstParamData%nY_low = SrcParamData%nY_low + DstParamData%nZ_low = SrcParamData%nZ_low + DstParamData%NumGrid_low = SrcParamData%NumGrid_low + DstParamData%n_rp_max = SrcParamData%n_rp_max + DstParamData%dpol = SrcParamData%dpol + DstParamData%dXYZ_low = SrcParamData%dXYZ_low + DstParamData%dX_low = SrcParamData%dX_low + DstParamData%dY_low = SrcParamData%dY_low + DstParamData%dZ_low = SrcParamData%dZ_low + DstParamData%X0_low = SrcParamData%X0_low + DstParamData%Y0_low = SrcParamData%Y0_low + DstParamData%Z0_low = SrcParamData%Z0_low + if (allocated(SrcParamData%X0_high)) then + LB(1:1) = lbound(SrcParamData%X0_high) + UB(1:1) = ubound(SrcParamData%X0_high) + if (.not. allocated(DstParamData%X0_high)) then + allocate(DstParamData%X0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%X0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%X0_high = SrcParamData%X0_high + end if + if (allocated(SrcParamData%Y0_high)) then + LB(1:1) = lbound(SrcParamData%Y0_high) + UB(1:1) = ubound(SrcParamData%Y0_high) + if (.not. allocated(DstParamData%Y0_high)) then + allocate(DstParamData%Y0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Y0_high = SrcParamData%Y0_high + end if + if (allocated(SrcParamData%Z0_high)) then + LB(1:1) = lbound(SrcParamData%Z0_high) + UB(1:1) = ubound(SrcParamData%Z0_high) + if (.not. allocated(DstParamData%Z0_high)) then + allocate(DstParamData%Z0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Z0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Z0_high = SrcParamData%Z0_high + end if + if (allocated(SrcParamData%dX_high)) then + LB(1:1) = lbound(SrcParamData%dX_high) + UB(1:1) = ubound(SrcParamData%dX_high) + if (.not. allocated(DstParamData%dX_high)) then + allocate(DstParamData%dX_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dX_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dX_high = SrcParamData%dX_high + end if + if (allocated(SrcParamData%dY_high)) then + LB(1:1) = lbound(SrcParamData%dY_high) + UB(1:1) = ubound(SrcParamData%dY_high) + if (.not. allocated(DstParamData%dY_high)) then + allocate(DstParamData%dY_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dY_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dY_high = SrcParamData%dY_high + end if + if (allocated(SrcParamData%dZ_high)) then + LB(1:1) = lbound(SrcParamData%dZ_high) + UB(1:1) = ubound(SrcParamData%dZ_high) + if (.not. allocated(DstParamData%dZ_high)) then + allocate(DstParamData%dZ_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dZ_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dZ_high = SrcParamData%dZ_high + end if + DstParamData%nX_high = SrcParamData%nX_high + DstParamData%nY_high = SrcParamData%nY_high + DstParamData%nZ_high = SrcParamData%nZ_high + if (allocated(SrcParamData%Grid_low)) then + LB(1:2) = lbound(SrcParamData%Grid_low) + UB(1:2) = ubound(SrcParamData%Grid_low) + if (.not. allocated(DstParamData%Grid_low)) then + allocate(DstParamData%Grid_low(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Grid_low.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Grid_low = SrcParamData%Grid_low + end if + if (allocated(SrcParamData%Grid_high)) then + LB(1:3) = lbound(SrcParamData%Grid_high) + UB(1:3) = ubound(SrcParamData%Grid_high) + if (.not. allocated(DstParamData%Grid_high)) then + allocate(DstParamData%Grid_high(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Grid_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Grid_high = SrcParamData%Grid_high + end if + if (allocated(SrcParamData%WT_Position)) then + LB(1:2) = lbound(SrcParamData%WT_Position) + UB(1:2) = ubound(SrcParamData%WT_Position) + if (.not. allocated(DstParamData%WT_Position)) then + allocate(DstParamData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_Position.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WT_Position = SrcParamData%WT_Position + end if + DstParamData%n_high_low = SrcParamData%n_high_low + DstParamData%dt_low = SrcParamData%dt_low + DstParamData%dt_high = SrcParamData%dt_high + DstParamData%NumDT = SrcParamData%NumDT + DstParamData%Mod_Meander = SrcParamData%Mod_Meander + DstParamData%C_Meander = SrcParamData%C_Meander + DstParamData%C_ScaleDiam = SrcParamData%C_ScaleDiam + DstParamData%Mod_Projection = SrcParamData%Mod_Projection + if (allocated(SrcParamData%IfW)) then + LB(1:1) = lbound(SrcParamData%IfW) + UB(1:1) = ubound(SrcParamData%IfW) + if (.not. allocated(DstParamData%IfW)) then + allocate(DstParamData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyParam(SrcParamData%IfW(i1), DstParamData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%WrDisSkp1 = SrcParamData%WrDisSkp1 + DstParamData%WrDisWind = SrcParamData%WrDisWind + DstParamData%NOutDisWindXY = SrcParamData%NOutDisWindXY + if (allocated(SrcParamData%OutDisWindZ)) then + LB(1:1) = lbound(SrcParamData%OutDisWindZ) + UB(1:1) = ubound(SrcParamData%OutDisWindZ) + if (.not. allocated(DstParamData%OutDisWindZ)) then + allocate(DstParamData%OutDisWindZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutDisWindZ = SrcParamData%OutDisWindZ + end if + DstParamData%NOutDisWindYZ = SrcParamData%NOutDisWindYZ + if (allocated(SrcParamData%OutDisWindX)) then + LB(1:1) = lbound(SrcParamData%OutDisWindX) + UB(1:1) = ubound(SrcParamData%OutDisWindX) + if (.not. allocated(DstParamData%OutDisWindX)) then + allocate(DstParamData%OutDisWindX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutDisWindX = SrcParamData%OutDisWindX + end if + DstParamData%NOutDisWindXZ = SrcParamData%NOutDisWindXZ + if (allocated(SrcParamData%OutDisWindY)) then + LB(1:1) = lbound(SrcParamData%OutDisWindY) + UB(1:1) = ubound(SrcParamData%OutDisWindY) + if (.not. allocated(DstParamData%OutDisWindY)) then + allocate(DstParamData%OutDisWindY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutDisWindY = SrcParamData%OutDisWindY + end if + DstParamData%OutFileRoot = SrcParamData%OutFileRoot + DstParamData%OutFileVTKRoot = SrcParamData%OutFileVTKRoot + DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth +end subroutine + +subroutine AWAE_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AWAE_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%y)) then + deallocate(ParamData%y) + end if + if (allocated(ParamData%z)) then + deallocate(ParamData%z) + end if + if (allocated(ParamData%X0_high)) then + deallocate(ParamData%X0_high) + end if + if (allocated(ParamData%Y0_high)) then + deallocate(ParamData%Y0_high) + end if + if (allocated(ParamData%Z0_high)) then + deallocate(ParamData%Z0_high) + end if + if (allocated(ParamData%dX_high)) then + deallocate(ParamData%dX_high) + end if + if (allocated(ParamData%dY_high)) then + deallocate(ParamData%dY_high) + end if + if (allocated(ParamData%dZ_high)) then + deallocate(ParamData%dZ_high) + end if + if (allocated(ParamData%Grid_low)) then + deallocate(ParamData%Grid_low) + end if + if (allocated(ParamData%Grid_high)) then + deallocate(ParamData%Grid_high) + end if + if (allocated(ParamData%WT_Position)) then + deallocate(ParamData%WT_Position) + end if + if (allocated(ParamData%IfW)) then + LB(1:1) = lbound(ParamData%IfW) + UB(1:1) = ubound(ParamData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyParam(ParamData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%IfW) + end if + if (allocated(ParamData%OutDisWindZ)) then + deallocate(ParamData%OutDisWindZ) + end if + if (allocated(ParamData%OutDisWindX)) then + deallocate(ParamData%OutDisWindX) + end if + if (allocated(ParamData%OutDisWindY)) then + deallocate(ParamData%OutDisWindY) + end if +end subroutine + +subroutine AWAE_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%WindFilePath) + call RegPack(Buf, InData%NumTurbines) + call RegPack(Buf, InData%NumRadii) + call RegPack(Buf, InData%NumPlanes) + call RegPack(Buf, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPack(Buf, InData%y) + end if + call RegPack(Buf, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + call RegPack(Buf, InData%z) + end if + call RegPack(Buf, InData%Mod_AmbWind) + call RegPack(Buf, InData%nX_low) + call RegPack(Buf, InData%nY_low) + call RegPack(Buf, InData%nZ_low) + call RegPack(Buf, InData%NumGrid_low) + call RegPack(Buf, InData%n_rp_max) + call RegPack(Buf, InData%dpol) + call RegPack(Buf, InData%dXYZ_low) + call RegPack(Buf, InData%dX_low) + call RegPack(Buf, InData%dY_low) + call RegPack(Buf, InData%dZ_low) + call RegPack(Buf, InData%X0_low) + call RegPack(Buf, InData%Y0_low) + call RegPack(Buf, InData%Z0_low) + call RegPack(Buf, allocated(InData%X0_high)) + if (allocated(InData%X0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%X0_high), ubound(InData%X0_high)) + call RegPack(Buf, InData%X0_high) + end if + call RegPack(Buf, allocated(InData%Y0_high)) + if (allocated(InData%Y0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%Y0_high), ubound(InData%Y0_high)) + call RegPack(Buf, InData%Y0_high) + end if + call RegPack(Buf, allocated(InData%Z0_high)) + if (allocated(InData%Z0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%Z0_high), ubound(InData%Z0_high)) + call RegPack(Buf, InData%Z0_high) + end if + call RegPack(Buf, allocated(InData%dX_high)) + if (allocated(InData%dX_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dX_high), ubound(InData%dX_high)) + call RegPack(Buf, InData%dX_high) + end if + call RegPack(Buf, allocated(InData%dY_high)) + if (allocated(InData%dY_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dY_high), ubound(InData%dY_high)) + call RegPack(Buf, InData%dY_high) + end if + call RegPack(Buf, allocated(InData%dZ_high)) + if (allocated(InData%dZ_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dZ_high), ubound(InData%dZ_high)) + call RegPack(Buf, InData%dZ_high) + end if + call RegPack(Buf, InData%nX_high) + call RegPack(Buf, InData%nY_high) + call RegPack(Buf, InData%nZ_high) + call RegPack(Buf, allocated(InData%Grid_low)) + if (allocated(InData%Grid_low)) then + call RegPackBounds(Buf, 2, lbound(InData%Grid_low), ubound(InData%Grid_low)) + call RegPack(Buf, InData%Grid_low) + end if + call RegPack(Buf, allocated(InData%Grid_high)) + if (allocated(InData%Grid_high)) then + call RegPackBounds(Buf, 3, lbound(InData%Grid_high), ubound(InData%Grid_high)) + call RegPack(Buf, InData%Grid_high) + end if + call RegPack(Buf, allocated(InData%WT_Position)) + if (allocated(InData%WT_Position)) then + call RegPackBounds(Buf, 2, lbound(InData%WT_Position), ubound(InData%WT_Position)) + call RegPack(Buf, InData%WT_Position) + end if + call RegPack(Buf, InData%n_high_low) + call RegPack(Buf, InData%dt_low) + call RegPack(Buf, InData%dt_high) + call RegPack(Buf, InData%NumDT) + call RegPack(Buf, InData%Mod_Meander) + call RegPack(Buf, InData%C_Meander) + call RegPack(Buf, InData%C_ScaleDiam) + call RegPack(Buf, InData%Mod_Projection) + call RegPack(Buf, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackParam(Buf, InData%IfW(i1)) + end do + end if + call RegPack(Buf, InData%WrDisSkp1) + call RegPack(Buf, InData%WrDisWind) + call RegPack(Buf, InData%NOutDisWindXY) + call RegPack(Buf, allocated(InData%OutDisWindZ)) + if (allocated(InData%OutDisWindZ)) then + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindZ), ubound(InData%OutDisWindZ)) + call RegPack(Buf, InData%OutDisWindZ) + end if + call RegPack(Buf, InData%NOutDisWindYZ) + call RegPack(Buf, allocated(InData%OutDisWindX)) + if (allocated(InData%OutDisWindX)) then + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindX), ubound(InData%OutDisWindX)) + call RegPack(Buf, InData%OutDisWindX) + end if + call RegPack(Buf, InData%NOutDisWindXZ) + call RegPack(Buf, allocated(InData%OutDisWindY)) + if (allocated(InData%OutDisWindY)) then + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindY), ubound(InData%OutDisWindY)) + call RegPack(Buf, InData%OutDisWindY) + end if + call RegPack(Buf, InData%OutFileRoot) + call RegPack(Buf, InData%OutFileVTKRoot) + call RegPack(Buf, InData%VTK_tWidth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%WindFilePath) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumTurbines) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumRadii) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumPlanes) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%z) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Mod_AmbWind) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nX_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nY_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nZ_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumGrid_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_rp_max) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dpol) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dXYZ_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dX_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dY_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dZ_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%X0_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Y0_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Z0_low) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%X0_high)) deallocate(OutData%X0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Y0_high)) deallocate(OutData%Y0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Z0_high)) deallocate(OutData%Z0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Z0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Z0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dX_high)) deallocate(OutData%dX_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dX_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dX_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dY_high)) deallocate(OutData%dY_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dY_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dY_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dZ_high)) deallocate(OutData%dZ_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dZ_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dZ_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%nX_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nY_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nZ_high) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Grid_low)) deallocate(OutData%Grid_low) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Grid_low(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Grid_low.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Grid_low) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Grid_high)) deallocate(OutData%Grid_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Grid_high(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Grid_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Grid_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WT_Position)) deallocate(OutData%WT_Position) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WT_Position(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WT_Position) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%n_high_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dt_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dt_high) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumDT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Mod_Meander) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_Meander) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_ScaleDiam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Mod_Projection) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackParam(Buf, OutData%IfW(i1)) ! IfW + end do + end if + call RegUnpack(Buf, OutData%WrDisSkp1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrDisWind) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NOutDisWindXY) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutDisWindZ)) deallocate(OutData%OutDisWindZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutDisWindZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutDisWindZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NOutDisWindYZ) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutDisWindX)) deallocate(OutData%OutDisWindX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutDisWindX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutDisWindX) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NOutDisWindXZ) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutDisWindY)) deallocate(OutData%OutDisWindY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutDisWindY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutDisWindY) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFileVTKRoot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTK_tWidth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_OutputType), intent(in) :: SrcOutputData + type(AWAE_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%Vdist_High)) then + LB(1:1) = lbound(SrcOutputData%Vdist_High) + UB(1:1) = ubound(SrcOutputData%Vdist_High) + if (.not. allocated(DstOutputData%Vdist_High)) then + allocate(DstOutputData%Vdist_High(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vdist_High.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AWAE_CopyHighWindGrid(SrcOutputData%Vdist_High(i1), DstOutputData%Vdist_High(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%V_plane)) then + LB(1:3) = lbound(SrcOutputData%V_plane) + UB(1:3) = ubound(SrcOutputData%V_plane) + if (.not. allocated(DstOutputData%V_plane)) then + allocate(DstOutputData%V_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%V_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%V_plane = SrcOutputData%V_plane + end if + if (allocated(SrcOutputData%TI_amb)) then + LB(1:1) = lbound(SrcOutputData%TI_amb) + UB(1:1) = ubound(SrcOutputData%TI_amb) + if (.not. allocated(DstOutputData%TI_amb)) then + allocate(DstOutputData%TI_amb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TI_amb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%TI_amb = SrcOutputData%TI_amb + end if + if (allocated(SrcOutputData%Vx_wind_disk)) then + LB(1:1) = lbound(SrcOutputData%Vx_wind_disk) + UB(1:1) = ubound(SrcOutputData%Vx_wind_disk) + if (.not. allocated(DstOutputData%Vx_wind_disk)) then + allocate(DstOutputData%Vx_wind_disk(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wind_disk.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vx_wind_disk = SrcOutputData%Vx_wind_disk + end if +end subroutine + +subroutine AWAE_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AWAE_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%Vdist_High)) then + LB(1:1) = lbound(OutputData%Vdist_High) + UB(1:1) = ubound(OutputData%Vdist_High) + do i1 = LB(1), UB(1) + call AWAE_DestroyHighWindGrid(OutputData%Vdist_High(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%Vdist_High) + end if + if (allocated(OutputData%V_plane)) then + deallocate(OutputData%V_plane) + end if + if (allocated(OutputData%TI_amb)) then + deallocate(OutputData%TI_amb) + end if + if (allocated(OutputData%Vx_wind_disk)) then + deallocate(OutputData%Vx_wind_disk) + end if +end subroutine + +subroutine AWAE_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackOutput' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Vdist_High)) + if (allocated(InData%Vdist_High)) then + call RegPackBounds(Buf, 1, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) + LB(1:1) = lbound(InData%Vdist_High) + UB(1:1) = ubound(InData%Vdist_High) + do i1 = LB(1), UB(1) + call AWAE_PackHighWindGrid(Buf, InData%Vdist_High(i1)) + end do + end if + call RegPack(Buf, allocated(InData%V_plane)) + if (allocated(InData%V_plane)) then + call RegPackBounds(Buf, 3, lbound(InData%V_plane), ubound(InData%V_plane)) + call RegPack(Buf, InData%V_plane) + end if + call RegPack(Buf, allocated(InData%TI_amb)) + if (allocated(InData%TI_amb)) then + call RegPackBounds(Buf, 1, lbound(InData%TI_amb), ubound(InData%TI_amb)) + call RegPack(Buf, InData%TI_amb) + end if + call RegPack(Buf, allocated(InData%Vx_wind_disk)) + if (allocated(InData%Vx_wind_disk)) then + call RegPackBounds(Buf, 1, lbound(InData%Vx_wind_disk), ubound(InData%Vx_wind_disk)) + call RegPack(Buf, InData%Vx_wind_disk) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackOutput' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Vdist_High)) deallocate(OutData%Vdist_High) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vdist_High(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AWAE_UnpackHighWindGrid(Buf, OutData%Vdist_High(i1)) ! Vdist_High + end do + end if + if (allocated(OutData%V_plane)) deallocate(OutData%V_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TI_amb)) deallocate(OutData%TI_amb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TI_amb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_amb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TI_amb) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vx_wind_disk)) deallocate(OutData%Vx_wind_disk) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_wind_disk(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wind_disk.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_wind_disk) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_InputType), intent(in) :: SrcInputData + type(AWAE_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AWAE_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%xhat_plane)) then + LB(1:3) = lbound(SrcInputData%xhat_plane) + UB(1:3) = ubound(SrcInputData%xhat_plane) + if (.not. allocated(DstInputData%xhat_plane)) then + allocate(DstInputData%xhat_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xhat_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%xhat_plane = SrcInputData%xhat_plane + end if + if (allocated(SrcInputData%p_plane)) then + LB(1:3) = lbound(SrcInputData%p_plane) + UB(1:3) = ubound(SrcInputData%p_plane) + if (.not. allocated(DstInputData%p_plane)) then + allocate(DstInputData%p_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%p_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%p_plane = SrcInputData%p_plane + end if + if (allocated(SrcInputData%Vx_wake)) then + LB(1:4) = lbound(SrcInputData%Vx_wake) + UB(1:4) = ubound(SrcInputData%Vx_wake) + if (.not. allocated(DstInputData%Vx_wake)) then + allocate(DstInputData%Vx_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vx_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vx_wake = SrcInputData%Vx_wake + end if + if (allocated(SrcInputData%Vy_wake)) then + LB(1:4) = lbound(SrcInputData%Vy_wake) + UB(1:4) = ubound(SrcInputData%Vy_wake) + if (.not. allocated(DstInputData%Vy_wake)) then + allocate(DstInputData%Vy_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vy_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vy_wake = SrcInputData%Vy_wake + end if + if (allocated(SrcInputData%Vz_wake)) then + LB(1:4) = lbound(SrcInputData%Vz_wake) + UB(1:4) = ubound(SrcInputData%Vz_wake) + if (.not. allocated(DstInputData%Vz_wake)) then + allocate(DstInputData%Vz_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vz_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vz_wake = SrcInputData%Vz_wake + end if + if (allocated(SrcInputData%D_wake)) then + LB(1:2) = lbound(SrcInputData%D_wake) + UB(1:2) = ubound(SrcInputData%D_wake) + if (.not. allocated(DstInputData%D_wake)) then + allocate(DstInputData%D_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%D_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%D_wake = SrcInputData%D_wake + end if + if (allocated(SrcInputData%WAT_k_mt)) then + LB(1:3) = lbound(SrcInputData%WAT_k_mt) + UB(1:3) = ubound(SrcInputData%WAT_k_mt) + if (.not. allocated(DstInputData%WAT_k_mt)) then + allocate(DstInputData%WAT_k_mt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%WAT_k_mt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%WAT_k_mt = SrcInputData%WAT_k_mt + end if +end subroutine + +subroutine AWAE_DestroyInput(InputData, ErrStat, ErrMsg) + type(AWAE_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AWAE_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%xhat_plane)) then + deallocate(InputData%xhat_plane) + end if + if (allocated(InputData%p_plane)) then + deallocate(InputData%p_plane) + end if + if (allocated(InputData%Vx_wake)) then + deallocate(InputData%Vx_wake) + end if + if (allocated(InputData%Vy_wake)) then + deallocate(InputData%Vy_wake) + end if + if (allocated(InputData%Vz_wake)) then + deallocate(InputData%Vz_wake) + end if + if (allocated(InputData%D_wake)) then + deallocate(InputData%D_wake) + end if + if (allocated(InputData%WAT_k_mt)) then + deallocate(InputData%WAT_k_mt) + end if +end subroutine + +subroutine AWAE_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%xhat_plane)) + if (allocated(InData%xhat_plane)) then + call RegPackBounds(Buf, 3, lbound(InData%xhat_plane), ubound(InData%xhat_plane)) + call RegPack(Buf, InData%xhat_plane) + end if + call RegPack(Buf, allocated(InData%p_plane)) + if (allocated(InData%p_plane)) then + call RegPackBounds(Buf, 3, lbound(InData%p_plane), ubound(InData%p_plane)) + call RegPack(Buf, InData%p_plane) + end if + call RegPack(Buf, allocated(InData%Vx_wake)) + if (allocated(InData%Vx_wake)) then + call RegPackBounds(Buf, 4, lbound(InData%Vx_wake), ubound(InData%Vx_wake)) + call RegPack(Buf, InData%Vx_wake) + end if + call RegPack(Buf, allocated(InData%Vy_wake)) + if (allocated(InData%Vy_wake)) then + call RegPackBounds(Buf, 4, lbound(InData%Vy_wake), ubound(InData%Vy_wake)) + call RegPack(Buf, InData%Vy_wake) + end if + call RegPack(Buf, allocated(InData%Vz_wake)) + if (allocated(InData%Vz_wake)) then + call RegPackBounds(Buf, 4, lbound(InData%Vz_wake), ubound(InData%Vz_wake)) + call RegPack(Buf, InData%Vz_wake) + end if + call RegPack(Buf, allocated(InData%D_wake)) + if (allocated(InData%D_wake)) then + call RegPackBounds(Buf, 2, lbound(InData%D_wake), ubound(InData%D_wake)) + call RegPack(Buf, InData%D_wake) + end if + call RegPack(Buf, allocated(InData%WAT_k_mt)) + if (allocated(InData%WAT_k_mt)) then + call RegPackBounds(Buf, 3, lbound(InData%WAT_k_mt), ubound(InData%WAT_k_mt)) + call RegPack(Buf, InData%WAT_k_mt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackInput' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%xhat_plane)) deallocate(OutData%xhat_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xhat_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xhat_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%p_plane)) deallocate(OutData%p_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%p_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%p_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vx_wake)) deallocate(OutData%Vx_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vy_wake)) deallocate(OutData%Vy_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vy_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vy_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vz_wake)) deallocate(OutData%Vz_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vz_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vz_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%D_wake)) deallocate(OutData%D_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D_wake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WAT_k_mt)) deallocate(OutData%WAT_k_mt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAT_k_mt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAT_k_mt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WAT_k_mt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine END MODULE AWAE_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index c560461ac2..226c4a5137 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -43,14 +43,14 @@ MODULE BeamDyn_Types TYPE, PUBLIC :: BD_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) , DIMENSION(1:3) :: gravity !< Gravitational acceleration [m/s^2] - REAL(ReKi) , DIMENSION(1:3) :: GlbPos !< Initial Position Vector of the local blade coordinate system [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot !< Initial direction cosine matrix of the local blade coordinate system -- in BD coords [-] - REAL(R8Ki) , DIMENSION(1:3) :: RootDisp !< Initial root displacement [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: RootOri !< Initial root orientation [-] - REAL(ReKi) , DIMENSION(1:6) :: RootVel !< Initial root velocities and angular veolcities [-] - REAL(ReKi) , DIMENSION(1:3) :: HubPos !< Initial Hub position vector [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: HubRot !< Initial Hub direction cosine matrix [-] + REAL(ReKi) , DIMENSION(1:3) :: gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + REAL(ReKi) , DIMENSION(1:3) :: GlbPos = 0.0_ReKi !< Initial Position Vector of the local blade coordinate system [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot = 0.0_R8Ki !< Initial direction cosine matrix of the local blade coordinate system -- in BD coords [-] + REAL(R8Ki) , DIMENSION(1:3) :: RootDisp = 0.0_R8Ki !< Initial root displacement [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: RootOri = 0.0_R8Ki !< Initial root orientation [-] + REAL(ReKi) , DIMENSION(1:6) :: RootVel = 0.0_ReKi !< Initial root velocities and angular veolcities [-] + REAL(ReKi) , DIMENSION(1:3) :: HubPos = 0.0_ReKi !< Initial Hub position vector [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: HubRot = 0.0_R8Ki !< Initial Hub direction cosine matrix [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] LOGICAL :: DynamicSolve = .TRUE. !< Use dynamic solve option. Set to False for static solving (handled by glue code or driver code). [-] END TYPE BD_InitInputType @@ -61,7 +61,7 @@ MODULE BeamDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: kp_coordinate !< Key point coordinates array [-] - INTEGER(IntKi) :: kp_total !< Total number of key points [-] + INTEGER(IntKi) :: kp_total = 0_IntKi !< Total number of key points [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] @@ -74,51 +74,51 @@ MODULE BeamDyn_Types ! ======================= ! ========= BladeInputData ======= TYPE, PUBLIC :: BladeInputData - INTEGER(IntKi) :: station_total !< Number of blade input stations [-] - INTEGER(IntKi) :: format_index !< Number of blade input stations [-] + INTEGER(IntKi) :: station_total = 0_IntKi !< Number of blade input stations [-] + INTEGER(IntKi) :: format_index = 0_IntKi !< Number of blade input stations [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: station_eta !< Station location in eta [0,1] [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: stiff0 !< C/S stiffness matrix arrays [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: mass0 !< C/S mass matrix arrays [-] - REAL(R8Ki) , DIMENSION(1:6) :: beta !< Damping Coefficient [-] - INTEGER(IntKi) :: damp_flag !< Damping Flag: 0-No Damping, 1-Damped [-] + REAL(R8Ki) , DIMENSION(1:6) :: beta = 0.0_R8Ki !< Damping Coefficient [-] + INTEGER(IntKi) :: damp_flag = 0_IntKi !< Damping Flag: 0-No Damping, 1-Damped [-] END TYPE BladeInputData ! ======================= ! ========= BD_InputFile ======= TYPE, PUBLIC :: BD_InputFile - INTEGER(IntKi) :: member_total !< Total number of members [-] - INTEGER(IntKi) :: kp_total !< Total number of key point [-] + INTEGER(IntKi) :: member_total = 0_IntKi !< Total number of members [-] + INTEGER(IntKi) :: kp_total = 0_IntKi !< Total number of key point [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: kp_member !< Number of key points in each member [-] - INTEGER(IntKi) :: order_elem !< Order of interpolation (basis) function [-] - INTEGER(IntKi) :: load_retries !< Maximum Number of factored load retries [-] - INTEGER(IntKi) :: NRMax !< Max number of iterations in Newton Raphson algorithm [-] - INTEGER(IntKi) :: quadrature !< Quadrature: 1: Gauss; 2: Trapezoidal [-] - INTEGER(IntKi) :: n_fact !< Factorization frequency [-] - INTEGER(IntKi) :: refine !< FE mesh refinement factor for trapezoidal quadrature [-] - REAL(DbKi) :: rhoinf !< Numerical damping parameter for generalized-alpha integrator [-] - REAL(DbKi) :: DTBeam !< Time interval for BeamDyn calculations {or default} (s) [-] + INTEGER(IntKi) :: order_elem = 0_IntKi !< Order of interpolation (basis) function [-] + INTEGER(IntKi) :: load_retries = 0_IntKi !< Maximum Number of factored load retries [-] + INTEGER(IntKi) :: NRMax = 0_IntKi !< Max number of iterations in Newton Raphson algorithm [-] + INTEGER(IntKi) :: quadrature = 0_IntKi !< Quadrature: 1: Gauss; 2: Trapezoidal [-] + INTEGER(IntKi) :: n_fact = 0_IntKi !< Factorization frequency [-] + INTEGER(IntKi) :: refine = 0_IntKi !< FE mesh refinement factor for trapezoidal quadrature [-] + REAL(DbKi) :: rhoinf = 0.0_R8Ki !< Numerical damping parameter for generalized-alpha integrator [-] + REAL(DbKi) :: DTBeam = 0.0_R8Ki !< Time interval for BeamDyn calculations {or default} (s) [-] TYPE(BladeInputData) :: InpBl !< Input data for individual blades [see BladeInputData Type] CHARACTER(1024) :: BldFile !< Name of blade input file [-] - LOGICAL :: UsePitchAct !< Whether to use a pitch actuator inside BeamDyn [(flag)] - LOGICAL :: QuasiStaticInit !< Use quasistatic pre-conditioning with centripetal accelerations in initialization (flag) [dynamic solve and enFAST only] [-] - REAL(R8Ki) :: stop_tol !< Tolerance for stopping criterion [-] - REAL(R8Ki) :: tngt_stf_pert !< Perturbation size for computing finite differenced tangent stiffness [-] - REAL(R8Ki) :: tngt_stf_difftol !< When comparing tangent stiffness matrix, stop simulation if error greater than this [-] + LOGICAL :: UsePitchAct = .false. !< Whether to use a pitch actuator inside BeamDyn [(flag)] + LOGICAL :: QuasiStaticInit = .false. !< Use quasistatic pre-conditioning with centripetal accelerations in initialization (flag) [dynamic solve and enFAST only] [-] + REAL(R8Ki) :: stop_tol = 0.0_R8Ki !< Tolerance for stopping criterion [-] + REAL(R8Ki) :: tngt_stf_pert = 0.0_R8Ki !< Perturbation size for computing finite differenced tangent stiffness [-] + REAL(R8Ki) :: tngt_stf_difftol = 0.0_R8Ki !< When comparing tangent stiffness matrix, stop simulation if error greater than this [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: kp_coordinate !< Key point coordinates array [-] - REAL(R8Ki) :: pitchJ !< Pitch actuator inertia [(kg-m^2)] - REAL(R8Ki) :: pitchK !< Pitch actuator stiffness [(kg-m^2/s^2)] - REAL(R8Ki) :: pitchC !< Pitch actuator damping [-] - LOGICAL :: Echo !< Echo [-] + REAL(R8Ki) :: pitchJ = 0.0_R8Ki !< Pitch actuator inertia [(kg-m^2)] + REAL(R8Ki) :: pitchK = 0.0_R8Ki !< Pitch actuator stiffness [(kg-m^2/s^2)] + REAL(R8Ki) :: pitchC = 0.0_R8Ki !< Pitch actuator damping [-] + LOGICAL :: Echo = .false. !< Echo [-] LOGICAL :: RotStates = .TRUE. !< Orient states in rotating frame during linearization? (flag) [-] LOGICAL :: RelStates = .FALSE. !< Define states relative to root motion during linearization? (flag) [-] - LOGICAL :: tngt_stf_fd !< Flag to compute tangent stifness matrix via finite difference [-] - LOGICAL :: tngt_stf_comp !< Flag to compare finite differenced and analytical tangent stifness [-] - INTEGER(IntKi) :: NNodeOuts !< Number of node outputs [0 - 9] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: OutNd !< Nodes whose values will be output [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + LOGICAL :: tngt_stf_fd = .false. !< Flag to compute tangent stifness matrix via finite difference [-] + LOGICAL :: tngt_stf_comp = .false. !< Flag to compare finite differenced and analytical tangent stifness [-] + INTEGER(IntKi) :: NNodeOuts = 0_IntKi !< Number of node outputs [0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: OutNd = 0_IntKi !< Nodes whose values will be output [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - LOGICAL :: SumPrint !< Print summary data to file? (.sum) [-] + LOGICAL :: SumPrint = .false. !< Print summary data to file? (.sum) [-] CHARACTER(20) :: OutFmt !< Format specifier [-] - INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (BD_BldNdOuts) [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (BD_BldNdOuts) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (BD_BldNdOuts) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< The blade nodes to actually output (BD_BldNdOuts) [-] CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (BD_BldNdOuts) [-] @@ -132,21 +132,21 @@ MODULE BeamDyn_Types ! ======================= ! ========= BD_DiscreteStateType ======= TYPE, PUBLIC :: BD_DiscreteStateType - REAL(ReKi) :: thetaP !< Pitch angle state [-] - REAL(ReKi) :: thetaPD !< Pitch rate state [-] + REAL(ReKi) :: thetaP = 0.0_ReKi !< Pitch angle state [-] + REAL(ReKi) :: thetaPD = 0.0_ReKi !< Pitch rate state [-] END TYPE BD_DiscreteStateType ! ======================= ! ========= BD_ConstraintStateType ======= TYPE, PUBLIC :: BD_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< A variable, Replace if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< A variable, Replace if you have constraint states [-] END TYPE BD_ConstraintStateType ! ======================= ! ========= BD_OtherStateType ======= TYPE, PUBLIC :: BD_OtherStateType REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: acc !< Acceleration (dqdtdt) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: xcc !< Algorithm acceleration in GA2: (1-alpha_m)*xcc_(n+1) = (1-alpha_f)*Acc_(n+1) + alpha_f*Acc_n - alpha_m*xcc_n [-] - LOGICAL :: InitAcc !< flag to determine if accerlerations have been initialized in updateStates [-] - LOGICAL :: RunQuasiStaticInit !< flag to determine if quasi-static solution initialization should be run again (with load inputs) [-] + LOGICAL :: InitAcc = .false. !< flag to determine if accerlerations have been initialized in updateStates [-] + LOGICAL :: RunQuasiStaticInit = .false. !< flag to determine if quasi-static solution initialization should be run again (with load inputs) [-] END TYPE BD_OtherStateType ! ======================= ! ========= qpParam ======= @@ -157,24 +157,24 @@ MODULE BeamDyn_Types ! ======================= ! ========= BD_ParameterType ======= TYPE, PUBLIC :: BD_ParameterType - REAL(DbKi) :: dt !< module dt [s] - REAL(DbKi) , DIMENSION(1:9) :: coef !< GA2 Coefficient [-] - REAL(DbKi) :: rhoinf !< Numerical Damping Coefficient for GA2 [-] + REAL(DbKi) :: dt = 0.0_R8Ki !< module dt [s] + REAL(DbKi) , DIMENSION(1:9) :: coef = 0.0_R8Ki !< GA2 Coefficient [-] + REAL(DbKi) :: rhoinf = 0.0_R8Ki !< Numerical Damping Coefficient for GA2 [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: uuN0 !< Initial Postion Vector of GLL (FE) nodes (index 1=DOF; index 2=FE nodes; index 3=element) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Stif0_QP !< Sectional Stiffness Properties at quadrature points (6x6xqp) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Mass0_QP !< Sectional Mass Properties at quadrature points (6x6xqp) [-] - REAL(R8Ki) , DIMENSION(1:3) :: gravity !< Gravitational acceleration [m/s^2] + REAL(R8Ki) , DIMENSION(1:3) :: gravity = 0.0_R8Ki !< Gravitational acceleration [m/s^2] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: segment_eta !< Array stored length ratio of each segment w.r.t. member it lies in [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: member_eta !< Array stored length ratio of each member w.r.t. entire blade [-] - REAL(R8Ki) :: blade_length !< Blade Length [-] - REAL(R8Ki) :: blade_mass !< Blade mass [-] - REAL(R8Ki) , DIMENSION(1:3) :: blade_CG !< Blade center of gravity [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: blade_IN !< Blade Length [-] - REAL(R8Ki) , DIMENSION(1:6) :: beta !< Damping Coefficient [-] - REAL(R8Ki) :: tol !< Tolerance used in stopping criterion [-] - REAL(R8Ki) , DIMENSION(1:3) :: GlbPos !< Initial Position Vector between origins of Global and blade frames (BD coordinates) [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot !< Initial Rotation Tensor between Global and Blade frames (BD coordinates; transfers local to global) [-] - REAL(R8Ki) , DIMENSION(1:3) :: Glb_crv !< CRV parameters of GlbRot [-] + REAL(R8Ki) :: blade_length = 0.0_R8Ki !< Blade Length [-] + REAL(R8Ki) :: blade_mass = 0.0_R8Ki !< Blade mass [-] + REAL(R8Ki) , DIMENSION(1:3) :: blade_CG = 0.0_R8Ki !< Blade center of gravity [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: blade_IN = 0.0_R8Ki !< Blade Length [-] + REAL(R8Ki) , DIMENSION(1:6) :: beta = 0.0_R8Ki !< Damping Coefficient [-] + REAL(R8Ki) :: tol = 0.0_R8Ki !< Tolerance used in stopping criterion [-] + REAL(R8Ki) , DIMENSION(1:3) :: GlbPos = 0.0_R8Ki !< Initial Position Vector between origins of Global and blade frames (BD coordinates) [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot = 0.0_R8Ki !< Initial Rotation Tensor between Global and Blade frames (BD coordinates; transfers local to global) [-] + REAL(R8Ki) , DIMENSION(1:3) :: Glb_crv = 0.0_R8Ki !< CRV parameters of GlbRot [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QPtN !< Quadrature (QuadPt) point locations in natural frame [-1, 1] [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QPtWeight !< Weights at each quadrature point (QuadPt) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Shp !< Shape function matrix (index 1 = FE nodes; index 2=quadrature points) [-] @@ -183,45 +183,45 @@ MODULE BeamDyn_Types REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: uu0 !< Initial Disp/Rot value at quadrature point (at T=0) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: rrN0 !< Initial relative rotation array, relative to root (at T=0) (index 1=rot DOF; index 2=FE nodes; index 3=element) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: E10 !< Initial E10 at quadrature point [-] - INTEGER(IntKi) :: nodes_per_elem !< Finite element (GLL) nodes per element [-] + INTEGER(IntKi) :: nodes_per_elem = 0_IntKi !< Finite element (GLL) nodes per element [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: node_elem_idx !< Index to first and last nodes of element in p%node_total sized arrays [-] - INTEGER(IntKi) :: refine !< FE mesh refinement factor for trapezoidal quadrature [-] - INTEGER(IntKi) :: dof_node !< dof per node [-] - INTEGER(IntKi) :: dof_elem !< dof per element [-] - INTEGER(IntKi) :: rot_elem !< rotational dof per element [-] - INTEGER(IntKi) :: elem_total !< Total number of elements [-] - INTEGER(IntKi) :: node_total !< Total number of finite element (GLL) nodes [-] - INTEGER(IntKi) :: dof_total !< Total number of dofs [-] - INTEGER(IntKi) :: nqp !< Number of quadrature points (per element) [-] - INTEGER(IntKi) :: analysis_type !< analysis_type flag [-] - INTEGER(IntKi) :: damp_flag !< damping flag [-] - INTEGER(IntKi) :: ld_retries !< Maximum Number of factored load retries [-] - INTEGER(IntKi) :: niter !< Maximum number of iterations in Newton-Raphson algorithm [-] - INTEGER(IntKi) :: quadrature !< Quadrature method: 1 Gauss 2 Trapezoidal [-] - INTEGER(IntKi) :: n_fact !< Factorization frequency [-] - LOGICAL :: OutInputs !< Determines if we've asked to output the inputs (do we need mesh transfer?) [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: refine = 0_IntKi !< FE mesh refinement factor for trapezoidal quadrature [-] + INTEGER(IntKi) :: dof_node = 0_IntKi !< dof per node [-] + INTEGER(IntKi) :: dof_elem = 0_IntKi !< dof per element [-] + INTEGER(IntKi) :: rot_elem = 0_IntKi !< rotational dof per element [-] + INTEGER(IntKi) :: elem_total = 0_IntKi !< Total number of elements [-] + INTEGER(IntKi) :: node_total = 0_IntKi !< Total number of finite element (GLL) nodes [-] + INTEGER(IntKi) :: dof_total = 0_IntKi !< Total number of dofs [-] + INTEGER(IntKi) :: nqp = 0_IntKi !< Number of quadrature points (per element) [-] + INTEGER(IntKi) :: analysis_type = 0_IntKi !< analysis_type flag [-] + INTEGER(IntKi) :: damp_flag = 0_IntKi !< damping flag [-] + INTEGER(IntKi) :: ld_retries = 0_IntKi !< Maximum Number of factored load retries [-] + INTEGER(IntKi) :: niter = 0_IntKi !< Maximum number of iterations in Newton-Raphson algorithm [-] + INTEGER(IntKi) :: quadrature = 0_IntKi !< Quadrature method: 1 Gauss 2 Trapezoidal [-] + INTEGER(IntKi) :: n_fact = 0_IntKi !< Factorization frequency [-] + LOGICAL :: OutInputs = .false. !< Determines if we've asked to output the inputs (do we need mesh transfer?) [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - INTEGER(IntKi) :: NNodeOuts !< Number of nodes to output data to a file[0 - 9] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: OutNd !< Nodes whose values will be output [-] + INTEGER(IntKi) :: NNodeOuts = 0_IntKi !< Number of nodes to output data to a file[0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: OutNd = 0_IntKi !< Nodes whose values will be output [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NdIndx !< Index into BldMotion mesh (to number the nodes for output without using collocated nodes) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NdIndxInverse !< Index from BldMotion mesh to unique nodes (to number the nodes for output without using collocated nodes) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutNd2NdElem !< To go from an output node number to a node/elem pair [-] CHARACTER(20) :: OutFmt !< Format specifier [-] - LOGICAL :: UsePitchAct !< Whether to use a pitch actuator inside BeamDyn [(flag)] - REAL(ReKi) :: pitchJ !< Pitch actuator inertia [(kg-m^2)] - REAL(ReKi) :: pitchK !< Pitch actuator stiffness [(kg-m^2/s^2)] - REAL(ReKi) :: pitchC !< Pitch actuator damping [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: torqM !< Pitch actuator matrix: (I-hA)^-1 [-] + LOGICAL :: UsePitchAct = .false. !< Whether to use a pitch actuator inside BeamDyn [(flag)] + REAL(ReKi) :: pitchJ = 0.0_ReKi !< Pitch actuator inertia [(kg-m^2)] + REAL(ReKi) :: pitchK = 0.0_ReKi !< Pitch actuator stiffness [(kg-m^2/s^2)] + REAL(ReKi) :: pitchC = 0.0_ReKi !< Pitch actuator damping [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: torqM = 0.0_ReKi !< Pitch actuator matrix: (I-hA)^-1 [-] TYPE(qpParam) :: qp !< Quadrature point info that does not change during simulation [-] - INTEGER(IntKi) :: qp_indx_offset !< Offset for computing index of the quadrature arrays (gauss skips the first [end-point] node) [-] - INTEGER(IntKi) :: BldMotionNodeLoc !< switch to determine where the nodes on the blade motion mesh should be located 1=FE (GLL) nodes; 2=quadrature nodes; 3=blade input stations [-] - LOGICAL :: tngt_stf_fd !< Flag to compute tangent stifness matrix via finite difference [-] - LOGICAL :: tngt_stf_comp !< Flag to compare finite differenced and analytical tangent stifness [-] - REAL(R8Ki) :: tngt_stf_pert !< Perturbation size for computing finite differenced tangent stiffness [-] - REAL(R8Ki) :: tngt_stf_difftol !< When comparing tangent stiffness matrix, stop simulation if error greater than this [-] - INTEGER(IntKi) :: BldNd_NumOuts !< [BD_BldNdOuts] Number of requested output channels per blade node [-] - INTEGER(IntKi) :: BldNd_TotNumOuts !< [BD_BldNdOuts] Total number of requested output channels of blade node information (equal to BldNd_NumOuts * BldNd_BlOutNd) [-] + INTEGER(IntKi) :: qp_indx_offset = 0_IntKi !< Offset for computing index of the quadrature arrays (gauss skips the first [end-point] node) [-] + INTEGER(IntKi) :: BldMotionNodeLoc = 0_IntKi !< switch to determine where the nodes on the blade motion mesh should be located 1=FE (GLL) nodes; 2=quadrature nodes; 3=blade input stations [-] + LOGICAL :: tngt_stf_fd = .false. !< Flag to compute tangent stifness matrix via finite difference [-] + LOGICAL :: tngt_stf_comp = .false. !< Flag to compare finite differenced and analytical tangent stifness [-] + REAL(R8Ki) :: tngt_stf_pert = 0.0_R8Ki !< Perturbation size for computing finite differenced tangent stiffness [-] + REAL(R8Ki) :: tngt_stf_difftol = 0.0_R8Ki !< When comparing tangent stiffness matrix, stop simulation if error greater than this [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< [BD_BldNdOuts] Number of requested output channels per blade node [-] + INTEGER(IntKi) :: BldNd_TotNumOuts = 0_IntKi !< [BD_BldNdOuts] Total number of requested output channels of blade node information (equal to BldNd_NumOuts * BldNd_BlOutNd) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< [BD_BldNdOuts] Names and units (and other characteristics) of all requested output parameters [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< [BD_BldNdOuts] The blade nodes to actually output [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: QPtw_Shp_Shp_Jac !< optimization variable: QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem) = p%Shp(i,idx_qp)*p%Shp(j,idx_qp)*p%QPtWeight(idx_qp)*p%Jacobian(idx_qp,nelem) [-] @@ -232,11 +232,11 @@ MODULE BeamDyn_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: FEweight !< weighting factors for integrating local sectional loads [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] - REAL(R8Ki) , DIMENSION(1:6) :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_nx !< half the number of continuous states in jacobian matrix [-] - LOGICAL :: RotStates !< Orient states in rotating frame during linearization? (flag) [-] - LOGICAL :: RelStates !< Define states relative to root motion during linearization? (flag) [-] + REAL(R8Ki) , DIMENSION(1:6) :: dx = 0.0_R8Ki !< vector that determines size of perturbation for x (continuous states) [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nx = 0_IntKi !< half the number of continuous states in jacobian matrix [-] + LOGICAL :: RotStates = .false. !< Orient states in rotating frame during linearization? (flag) [-] + LOGICAL :: RelStates = .false. !< Define states relative to root motion during linearization? (flag) [-] END TYPE BD_ParameterType ! ======================= ! ========= BD_InputType ======= @@ -251,8 +251,8 @@ MODULE BeamDyn_Types TYPE, PUBLIC :: BD_OutputType TYPE(MeshType) :: ReactionForce !< contains force and moments [-] TYPE(MeshType) :: BldMotion !< Motion (disp,rot,vel, acc) along beam axis [-] - REAL(ReKi) :: RootMxr !< x-component of the root reaction moment expressed in r (used for ServoDyn Bladed DLL Interface) [Nm] - REAL(ReKi) :: RootMyr !< y-component of the root reaction moment expressed in r (used for ServoDyn Bladed DLL Interface) [Nm] + REAL(ReKi) :: RootMxr = 0.0_ReKi !< x-component of the root reaction moment expressed in r (used for ServoDyn Bladed DLL Interface) [Nm] + REAL(ReKi) :: RootMyr = 0.0_ReKi !< y-component of the root reaction moment expressed in r (used for ServoDyn Bladed DLL Interface) [Nm] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] END TYPE BD_OutputType ! ======================= @@ -297,7 +297,7 @@ MODULE BeamDyn_Types TYPE(MeshType) :: y_BldMotion_at_u !< output motions at input node locations (displacements necessary for mapping loads) [-] TYPE(MeshMapType) :: Map_u_DistrLoad_to_y !< mapping of input loads to output node locations [-] TYPE(MeshMapType) :: Map_y_BldMotion_to_u !< mapping of output motions to input node locations (for load transfer) [-] - INTEGER(IntKi) :: Un_Sum !< unit number of summary file [-] + INTEGER(IntKi) :: Un_Sum = 0_IntKi !< unit number of summary file [-] TYPE(EqMotionQP) :: qp !< Quadrature point calculation info [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: lin_A !< A (dXdx) matrix used in linearization (before RotState is applied) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: lin_C !< C (dYdx) matrix used in linearization (before RotState is applied) [-] @@ -334,12444 +334,5105 @@ MODULE BeamDyn_Types END TYPE BD_MiscVarType ! ======================= CONTAINS - SUBROUTINE BD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(BD_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 = 'BD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%gravity = SrcInitInputData%gravity - DstInitInputData%GlbPos = SrcInitInputData%GlbPos - DstInitInputData%GlbRot = SrcInitInputData%GlbRot - DstInitInputData%RootDisp = SrcInitInputData%RootDisp - DstInitInputData%RootOri = SrcInitInputData%RootOri - DstInitInputData%RootVel = SrcInitInputData%RootVel - DstInitInputData%HubPos = SrcInitInputData%HubPos - DstInitInputData%HubRot = SrcInitInputData%HubRot - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%DynamicSolve = SrcInitInputData%DynamicSolve - END SUBROUTINE BD_CopyInitInput - - SUBROUTINE BD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(BD_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 = 'BD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE BD_DestroyInitInput - - SUBROUTINE BD_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(BD_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 = 'BD_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%RootName) ! RootName - Re_BufSz = Re_BufSz + SIZE(InData%gravity) ! gravity - Re_BufSz = Re_BufSz + SIZE(InData%GlbPos) ! GlbPos - Db_BufSz = Db_BufSz + SIZE(InData%GlbRot) ! GlbRot - Db_BufSz = Db_BufSz + SIZE(InData%RootDisp) ! RootDisp - Db_BufSz = Db_BufSz + SIZE(InData%RootOri) ! RootOri - Re_BufSz = Re_BufSz + SIZE(InData%RootVel) ! RootVel - Re_BufSz = Re_BufSz + SIZE(InData%HubPos) ! HubPos - Db_BufSz = Db_BufSz + SIZE(InData%HubRot) ! HubRot - Int_BufSz = Int_BufSz + 1 ! Linearize - Int_BufSz = Int_BufSz + 1 ! DynamicSolve - 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%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%gravity,1), UBOUND(InData%gravity,1) - ReKiBuf(Re_Xferred) = InData%gravity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%GlbPos,1), UBOUND(InData%GlbPos,1) - ReKiBuf(Re_Xferred) = InData%GlbPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%GlbRot,2), UBOUND(InData%GlbRot,2) - DO i1 = LBOUND(InData%GlbRot,1), UBOUND(InData%GlbRot,1) - DbKiBuf(Db_Xferred) = InData%GlbRot(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%RootDisp,1), UBOUND(InData%RootDisp,1) - DbKiBuf(Db_Xferred) = InData%RootDisp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%RootOri,2), UBOUND(InData%RootOri,2) - DO i1 = LBOUND(InData%RootOri,1), UBOUND(InData%RootOri,1) - DbKiBuf(Db_Xferred) = InData%RootOri(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%RootVel,1), UBOUND(InData%RootVel,1) - ReKiBuf(Re_Xferred) = InData%RootVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%HubPos,1), UBOUND(InData%HubPos,1) - ReKiBuf(Re_Xferred) = InData%HubPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%HubRot,2), UBOUND(InData%HubRot,2) - DO i1 = LBOUND(InData%HubRot,1), UBOUND(InData%HubRot,1) - DbKiBuf(Db_Xferred) = InData%HubRot(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DynamicSolve, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_PackInitInput - SUBROUTINE BD_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(BD_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 = 'BD_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%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%gravity,1) - i1_u = UBOUND(OutData%gravity,1) - DO i1 = LBOUND(OutData%gravity,1), UBOUND(OutData%gravity,1) - OutData%gravity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%GlbPos,1) - i1_u = UBOUND(OutData%GlbPos,1) - DO i1 = LBOUND(OutData%GlbPos,1), UBOUND(OutData%GlbPos,1) - OutData%GlbPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%GlbRot,1) - i1_u = UBOUND(OutData%GlbRot,1) - i2_l = LBOUND(OutData%GlbRot,2) - i2_u = UBOUND(OutData%GlbRot,2) - DO i2 = LBOUND(OutData%GlbRot,2), UBOUND(OutData%GlbRot,2) - DO i1 = LBOUND(OutData%GlbRot,1), UBOUND(OutData%GlbRot,1) - OutData%GlbRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%RootDisp,1) - i1_u = UBOUND(OutData%RootDisp,1) - DO i1 = LBOUND(OutData%RootDisp,1), UBOUND(OutData%RootDisp,1) - OutData%RootDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RootOri,1) - i1_u = UBOUND(OutData%RootOri,1) - i2_l = LBOUND(OutData%RootOri,2) - i2_u = UBOUND(OutData%RootOri,2) - DO i2 = LBOUND(OutData%RootOri,2), UBOUND(OutData%RootOri,2) - DO i1 = LBOUND(OutData%RootOri,1), UBOUND(OutData%RootOri,1) - OutData%RootOri(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%RootVel,1) - i1_u = UBOUND(OutData%RootVel,1) - DO i1 = LBOUND(OutData%RootVel,1), UBOUND(OutData%RootVel,1) - OutData%RootVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubPos,1) - i1_u = UBOUND(OutData%HubPos,1) - DO i1 = LBOUND(OutData%HubPos,1), UBOUND(OutData%HubPos,1) - OutData%HubPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubRot,1) - i1_u = UBOUND(OutData%HubRot,1) - i2_l = LBOUND(OutData%HubRot,2) - i2_u = UBOUND(OutData%HubRot,2) - DO i2 = LBOUND(OutData%HubRot,2), UBOUND(OutData%HubRot,2) - DO i1 = LBOUND(OutData%HubRot,1), UBOUND(OutData%HubRot,1) - OutData%HubRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%DynamicSolve = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynamicSolve) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_UnPackInitInput - - SUBROUTINE BD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(BD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyInitOutput' -! +subroutine BD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(BD_InitInputType), intent(in) :: SrcInitInputData + type(BD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_CopyInitInput' 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 - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%kp_coordinate)) THEN - i1_l = LBOUND(SrcInitOutputData%kp_coordinate,1) - i1_u = UBOUND(SrcInitOutputData%kp_coordinate,1) - i2_l = LBOUND(SrcInitOutputData%kp_coordinate,2) - i2_u = UBOUND(SrcInitOutputData%kp_coordinate,2) - IF (.NOT. ALLOCATED(DstInitOutputData%kp_coordinate)) THEN - ALLOCATE(DstInitOutputData%kp_coordinate(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%kp_coordinate = SrcInitOutputData%kp_coordinate -ENDIF - DstInitOutputData%kp_total = SrcInitOutputData%kp_total -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN - ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF - END SUBROUTINE BD_CopyInitOutput - - SUBROUTINE BD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(BD_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 = 'BD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%kp_coordinate)) THEN - DEALLOCATE(InitOutputData%kp_coordinate) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN - DEALLOCATE(InitOutputData%RotFrame_x) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF - END SUBROUTINE BD_DestroyInitOutput - - SUBROUTINE BD_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(BD_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 = 'BD_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! kp_coordinate allocated yes/no - IF ( ALLOCATED(InData%kp_coordinate) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! kp_coordinate upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%kp_coordinate) ! kp_coordinate - END IF - Int_BufSz = Int_BufSz + 1 ! kp_total - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%kp_coordinate) ) 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%kp_coordinate,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kp_coordinate,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%kp_coordinate,2), UBOUND(InData%kp_coordinate,2) - DO i1 = LBOUND(InData%kp_coordinate,1), UBOUND(InData%kp_coordinate,1) - DbKiBuf(Db_Xferred) = InData%kp_coordinate(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%kp_total - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) 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%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) 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%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) 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%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) 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%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) 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%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) 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%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) 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%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) 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%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE BD_PackInitOutput - - SUBROUTINE BD_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(BD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kp_coordinate 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%kp_coordinate)) DEALLOCATE(OutData%kp_coordinate) - ALLOCATE(OutData%kp_coordinate(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%kp_coordinate,2), UBOUND(OutData%kp_coordinate,2) - DO i1 = LBOUND(OutData%kp_coordinate,1), UBOUND(OutData%kp_coordinate,1) - OutData%kp_coordinate(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - OutData%kp_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y 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%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(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 ! LinNames_x 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%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(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 ! LinNames_u 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%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(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 ! RotFrame_y 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%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x 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%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u 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%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u 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%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x 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%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE BD_UnPackInitOutput - - SUBROUTINE BD_CopyBladeInputData( SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladeInputData), INTENT(IN) :: SrcBladeInputDataData - TYPE(BladeInputData), INTENT(INOUT) :: DstBladeInputDataData - 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 = 'BD_CopyBladeInputData' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%gravity = SrcInitInputData%gravity + DstInitInputData%GlbPos = SrcInitInputData%GlbPos + DstInitInputData%GlbRot = SrcInitInputData%GlbRot + DstInitInputData%RootDisp = SrcInitInputData%RootDisp + DstInitInputData%RootOri = SrcInitInputData%RootOri + DstInitInputData%RootVel = SrcInitInputData%RootVel + DstInitInputData%HubPos = SrcInitInputData%HubPos + DstInitInputData%HubRot = SrcInitInputData%HubRot + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%DynamicSolve = SrcInitInputData%DynamicSolve +end subroutine + +subroutine BD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(BD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstBladeInputDataData%station_total = SrcBladeInputDataData%station_total - DstBladeInputDataData%format_index = SrcBladeInputDataData%format_index -IF (ALLOCATED(SrcBladeInputDataData%station_eta)) THEN - i1_l = LBOUND(SrcBladeInputDataData%station_eta,1) - i1_u = UBOUND(SrcBladeInputDataData%station_eta,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%station_eta)) THEN - ALLOCATE(DstBladeInputDataData%station_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%station_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%station_eta = SrcBladeInputDataData%station_eta -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%stiff0)) THEN - i1_l = LBOUND(SrcBladeInputDataData%stiff0,1) - i1_u = UBOUND(SrcBladeInputDataData%stiff0,1) - i2_l = LBOUND(SrcBladeInputDataData%stiff0,2) - i2_u = UBOUND(SrcBladeInputDataData%stiff0,2) - i3_l = LBOUND(SrcBladeInputDataData%stiff0,3) - i3_u = UBOUND(SrcBladeInputDataData%stiff0,3) - IF (.NOT. ALLOCATED(DstBladeInputDataData%stiff0)) THEN - ALLOCATE(DstBladeInputDataData%stiff0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%stiff0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%stiff0 = SrcBladeInputDataData%stiff0 -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%mass0)) THEN - i1_l = LBOUND(SrcBladeInputDataData%mass0,1) - i1_u = UBOUND(SrcBladeInputDataData%mass0,1) - i2_l = LBOUND(SrcBladeInputDataData%mass0,2) - i2_u = UBOUND(SrcBladeInputDataData%mass0,2) - i3_l = LBOUND(SrcBladeInputDataData%mass0,3) - i3_u = UBOUND(SrcBladeInputDataData%mass0,3) - IF (.NOT. ALLOCATED(DstBladeInputDataData%mass0)) THEN - ALLOCATE(DstBladeInputDataData%mass0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%mass0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%mass0 = SrcBladeInputDataData%mass0 -ENDIF - DstBladeInputDataData%beta = SrcBladeInputDataData%beta - DstBladeInputDataData%damp_flag = SrcBladeInputDataData%damp_flag - END SUBROUTINE BD_CopyBladeInputData - - SUBROUTINE BD_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg ) - TYPE(BladeInputData), INTENT(INOUT) :: BladeInputDataData - 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 = 'BD_DestroyBladeInputData' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladeInputDataData%station_eta)) THEN - DEALLOCATE(BladeInputDataData%station_eta) -ENDIF -IF (ALLOCATED(BladeInputDataData%stiff0)) THEN - DEALLOCATE(BladeInputDataData%stiff0) -ENDIF -IF (ALLOCATED(BladeInputDataData%mass0)) THEN - DEALLOCATE(BladeInputDataData%mass0) -ENDIF - END SUBROUTINE BD_DestroyBladeInputData - - SUBROUTINE BD_PackBladeInputData( 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(BladeInputData), 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 = 'BD_PackBladeInputData' - ! 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 ! station_total - Int_BufSz = Int_BufSz + 1 ! format_index - Int_BufSz = Int_BufSz + 1 ! station_eta allocated yes/no - IF ( ALLOCATED(InData%station_eta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! station_eta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%station_eta) ! station_eta - END IF - Int_BufSz = Int_BufSz + 1 ! stiff0 allocated yes/no - IF ( ALLOCATED(InData%stiff0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! stiff0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%stiff0) ! stiff0 - END IF - Int_BufSz = Int_BufSz + 1 ! mass0 allocated yes/no - IF ( ALLOCATED(InData%mass0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! mass0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%mass0) ! mass0 - END IF - Db_BufSz = Db_BufSz + SIZE(InData%beta) ! beta - Int_BufSz = Int_BufSz + 1 ! damp_flag - 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%station_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%format_index - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%station_eta) ) 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%station_eta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%station_eta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%station_eta,1), UBOUND(InData%station_eta,1) - DbKiBuf(Db_Xferred) = InData%station_eta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%stiff0) ) 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%stiff0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%stiff0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%stiff0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%stiff0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%stiff0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%stiff0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%stiff0,3), UBOUND(InData%stiff0,3) - DO i2 = LBOUND(InData%stiff0,2), UBOUND(InData%stiff0,2) - DO i1 = LBOUND(InData%stiff0,1), UBOUND(InData%stiff0,1) - DbKiBuf(Db_Xferred) = InData%stiff0(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%mass0) ) 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%mass0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mass0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mass0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mass0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mass0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mass0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%mass0,3), UBOUND(InData%mass0,3) - DO i2 = LBOUND(InData%mass0,2), UBOUND(InData%mass0,2) - DO i1 = LBOUND(InData%mass0,1), UBOUND(InData%mass0,1) - DbKiBuf(Db_Xferred) = InData%mass0(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%beta,1), UBOUND(InData%beta,1) - DbKiBuf(Db_Xferred) = InData%beta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%damp_flag - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_PackBladeInputData - - SUBROUTINE BD_UnPackBladeInputData( 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(BladeInputData), 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 = 'BD_UnPackBladeInputData' - ! 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%station_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%format_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! station_eta 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%station_eta)) DEALLOCATE(OutData%station_eta) - ALLOCATE(OutData%station_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%station_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%station_eta,1), UBOUND(OutData%station_eta,1) - OutData%station_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! stiff0 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%stiff0)) DEALLOCATE(OutData%stiff0) - ALLOCATE(OutData%stiff0(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%stiff0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%stiff0,3), UBOUND(OutData%stiff0,3) - DO i2 = LBOUND(OutData%stiff0,2), UBOUND(OutData%stiff0,2) - DO i1 = LBOUND(OutData%stiff0,1), UBOUND(OutData%stiff0,1) - OutData%stiff0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! mass0 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%mass0)) DEALLOCATE(OutData%mass0) - ALLOCATE(OutData%mass0(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%mass0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%mass0,3), UBOUND(OutData%mass0,3) - DO i2 = LBOUND(OutData%mass0,2), UBOUND(OutData%mass0,2) - DO i1 = LBOUND(OutData%mass0,1), UBOUND(OutData%mass0,1) - OutData%mass0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%beta,1) - i1_u = UBOUND(OutData%beta,1) - DO i1 = LBOUND(OutData%beta,1), UBOUND(OutData%beta,1) - OutData%beta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%damp_flag = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_UnPackBladeInputData - - SUBROUTINE BD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(BD_InputFile), INTENT(INOUT) :: DstInputFileData - 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 = 'BD_CopyInputFile' -! + ErrMsg = '' +end subroutine + +subroutine BD_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%gravity) + call RegPack(Buf, InData%GlbPos) + call RegPack(Buf, InData%GlbRot) + call RegPack(Buf, InData%RootDisp) + call RegPack(Buf, InData%RootOri) + call RegPack(Buf, InData%RootVel) + call RegPack(Buf, InData%HubPos) + call RegPack(Buf, InData%HubRot) + call RegPack(Buf, InData%Linearize) + call RegPack(Buf, InData%DynamicSolve) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GlbPos) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GlbRot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootDisp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootOri) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootVel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubPos) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubRot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DynamicSolve) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(BD_InitOutputType), intent(in) :: SrcInitOutputData + type(BD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%member_total = SrcInputFileData%member_total - DstInputFileData%kp_total = SrcInputFileData%kp_total -IF (ALLOCATED(SrcInputFileData%kp_member)) THEN - i1_l = LBOUND(SrcInputFileData%kp_member,1) - i1_u = UBOUND(SrcInputFileData%kp_member,1) - IF (.NOT. ALLOCATED(DstInputFileData%kp_member)) THEN - ALLOCATE(DstInputFileData%kp_member(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%kp_member.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%kp_member = SrcInputFileData%kp_member -ENDIF - DstInputFileData%order_elem = SrcInputFileData%order_elem - DstInputFileData%load_retries = SrcInputFileData%load_retries - DstInputFileData%NRMax = SrcInputFileData%NRMax - DstInputFileData%quadrature = SrcInputFileData%quadrature - DstInputFileData%n_fact = SrcInputFileData%n_fact - DstInputFileData%refine = SrcInputFileData%refine - DstInputFileData%rhoinf = SrcInputFileData%rhoinf - DstInputFileData%DTBeam = SrcInputFileData%DTBeam - CALL BD_Copybladeinputdata( SrcInputFileData%InpBl, DstInputFileData%InpBl, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInputFileData%BldFile = SrcInputFileData%BldFile - DstInputFileData%UsePitchAct = SrcInputFileData%UsePitchAct - DstInputFileData%QuasiStaticInit = SrcInputFileData%QuasiStaticInit - DstInputFileData%stop_tol = SrcInputFileData%stop_tol - DstInputFileData%tngt_stf_pert = SrcInputFileData%tngt_stf_pert - DstInputFileData%tngt_stf_difftol = SrcInputFileData%tngt_stf_difftol -IF (ALLOCATED(SrcInputFileData%kp_coordinate)) THEN - i1_l = LBOUND(SrcInputFileData%kp_coordinate,1) - i1_u = UBOUND(SrcInputFileData%kp_coordinate,1) - i2_l = LBOUND(SrcInputFileData%kp_coordinate,2) - i2_u = UBOUND(SrcInputFileData%kp_coordinate,2) - IF (.NOT. ALLOCATED(DstInputFileData%kp_coordinate)) THEN - ALLOCATE(DstInputFileData%kp_coordinate(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%kp_coordinate = SrcInputFileData%kp_coordinate -ENDIF - DstInputFileData%pitchJ = SrcInputFileData%pitchJ - DstInputFileData%pitchK = SrcInputFileData%pitchK - DstInputFileData%pitchC = SrcInputFileData%pitchC - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%RotStates = SrcInputFileData%RotStates - DstInputFileData%RelStates = SrcInputFileData%RelStates - DstInputFileData%tngt_stf_fd = SrcInputFileData%tngt_stf_fd - DstInputFileData%tngt_stf_comp = SrcInputFileData%tngt_stf_comp - DstInputFileData%NNodeOuts = SrcInputFileData%NNodeOuts - DstInputFileData%OutNd = SrcInputFileData%OutNd - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts -IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN - i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) - i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN - ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList -ENDIF -IF (ALLOCATED(SrcInputFileData%BldNd_BlOutNd)) THEN - i1_l = LBOUND(SrcInputFileData%BldNd_BlOutNd,1) - i1_u = UBOUND(SrcInputFileData%BldNd_BlOutNd,1) - IF (.NOT. ALLOCATED(DstInputFileData%BldNd_BlOutNd)) THEN - ALLOCATE(DstInputFileData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BldNd_BlOutNd = SrcInputFileData%BldNd_BlOutNd -ENDIF - DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str - END SUBROUTINE BD_CopyInputFile - - SUBROUTINE BD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(BD_InputFile), INTENT(INOUT) :: InputFileData - 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 = 'BD_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%kp_member)) THEN - DEALLOCATE(InputFileData%kp_member) -ENDIF - CALL BD_DestroyBladeInputData( InputFileData%InpBl, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputFileData%kp_coordinate)) THEN - DEALLOCATE(InputFileData%kp_coordinate) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF -IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN - DEALLOCATE(InputFileData%BldNd_OutList) -ENDIF -IF (ALLOCATED(InputFileData%BldNd_BlOutNd)) THEN - DEALLOCATE(InputFileData%BldNd_BlOutNd) -ENDIF - END SUBROUTINE BD_DestroyInputFile - - SUBROUTINE BD_PackInputFile( 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(BD_InputFile), 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 = 'BD_PackInputFile' - ! 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 ! member_total - Int_BufSz = Int_BufSz + 1 ! kp_total - Int_BufSz = Int_BufSz + 1 ! kp_member allocated yes/no - IF ( ALLOCATED(InData%kp_member) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! kp_member upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%kp_member) ! kp_member - END IF - Int_BufSz = Int_BufSz + 1 ! order_elem - Int_BufSz = Int_BufSz + 1 ! load_retries - Int_BufSz = Int_BufSz + 1 ! NRMax - Int_BufSz = Int_BufSz + 1 ! quadrature - Int_BufSz = Int_BufSz + 1 ! n_fact - Int_BufSz = Int_BufSz + 1 ! refine - Db_BufSz = Db_BufSz + 1 ! rhoinf - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InpBl - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InpBl - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InpBl - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%BldFile) ! BldFile - Int_BufSz = Int_BufSz + 1 ! UsePitchAct - Int_BufSz = Int_BufSz + 1 ! QuasiStaticInit - Db_BufSz = Db_BufSz + 1 ! stop_tol - Db_BufSz = Db_BufSz + 1 ! tngt_stf_pert - Db_BufSz = Db_BufSz + 1 ! tngt_stf_difftol - Int_BufSz = Int_BufSz + 1 ! kp_coordinate allocated yes/no - IF ( ALLOCATED(InData%kp_coordinate) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! kp_coordinate upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%kp_coordinate) ! kp_coordinate - END IF - Db_BufSz = Db_BufSz + 1 ! pitchJ - Db_BufSz = Db_BufSz + 1 ! pitchK - Db_BufSz = Db_BufSz + 1 ! pitchC - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! RotStates - Int_BufSz = Int_BufSz + 1 ! RelStates - Int_BufSz = Int_BufSz + 1 ! tngt_stf_fd - Int_BufSz = Int_BufSz + 1 ! tngt_stf_comp - Int_BufSz = Int_BufSz + 1 ! NNodeOuts - Int_BufSz = Int_BufSz + SIZE(InData%OutNd) ! OutNd - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList - END IF - Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no - IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str - 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%member_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%kp_total - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%kp_member) ) 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%kp_member,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_member,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%kp_member,1), UBOUND(InData%kp_member,1) - IntKiBuf(Int_Xferred) = InData%kp_member(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%order_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%load_retries - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NRMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%quadrature - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_fact - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%refine - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rhoinf - 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 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 - DO I = 1, LEN(InData%BldFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePitchAct, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%QuasiStaticInit, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%stop_tol - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tngt_stf_pert - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tngt_stf_difftol - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%kp_coordinate) ) 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%kp_coordinate,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kp_coordinate,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%kp_coordinate,2), UBOUND(InData%kp_coordinate,2) - DO i1 = LBOUND(InData%kp_coordinate,1), UBOUND(InData%kp_coordinate,1) - DbKiBuf(Db_Xferred) = InData%kp_coordinate(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%pitchJ - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pitchK - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pitchC - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RelStates, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_fd, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_comp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NNodeOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%OutNd,1), UBOUND(InData%OutNd,1) - IntKiBuf(Int_Xferred) = InData%OutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) 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%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - 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 - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - 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 - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_OutList) ) 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%BldNd_OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) - DO I = 1, LEN(InData%BldNd_OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) 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%BldNd_BlOutNd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) - IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(InData%BldNd_BlOutNd_Str) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE BD_PackInputFile - - SUBROUTINE BD_UnPackInputFile( 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(BD_InputFile), 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 = 'BD_UnPackInputFile' - ! 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%member_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%kp_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kp_member 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%kp_member)) DEALLOCATE(OutData%kp_member) - ALLOCATE(OutData%kp_member(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_member.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%kp_member,1), UBOUND(OutData%kp_member,1) - OutData%kp_member(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%order_elem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%load_retries = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NRMax = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%quadrature = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_fact = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%refine = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%rhoinf = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DTBeam = DbKiBuf(Db_Xferred) - Db_Xferred = Db_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 BD_UnpackBladeInputData( Re_Buf, Db_Buf, Int_Buf, OutData%InpBl, ErrStat2, ErrMsg2 ) ! InpBl - 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%BldFile) - OutData%BldFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePitchAct = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePitchAct) - Int_Xferred = Int_Xferred + 1 - OutData%QuasiStaticInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%QuasiStaticInit) - Int_Xferred = Int_Xferred + 1 - OutData%stop_tol = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_pert = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_difftol = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kp_coordinate 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%kp_coordinate)) DEALLOCATE(OutData%kp_coordinate) - ALLOCATE(OutData%kp_coordinate(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%kp_coordinate,2), UBOUND(OutData%kp_coordinate,2) - DO i1 = LBOUND(OutData%kp_coordinate,1), UBOUND(OutData%kp_coordinate,1) - OutData%kp_coordinate(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - OutData%pitchJ = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%pitchK = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%pitchC = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) - Int_Xferred = Int_Xferred + 1 - OutData%RelStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RelStates) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_fd = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_fd) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_comp = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_comp) - Int_Xferred = Int_Xferred + 1 - OutData%NNodeOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%OutNd,1) - i1_u = UBOUND(OutData%OutNd,1) - DO i1 = LBOUND(OutData%OutNd,1), UBOUND(OutData%OutNd,1) - OutData%OutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - 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 - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_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%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) - ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) - DO I = 1, LEN(OutData%BldNd_OutList) - OutData%BldNd_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 ! BldNd_BlOutNd 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%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) - ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) - OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) - OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE BD_UnPackInputFile - - SUBROUTINE BD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(BD_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) :: 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 = 'BD_CopyContState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%kp_coordinate)) then + LB(1:2) = lbound(SrcInitOutputData%kp_coordinate) + UB(1:2) = ubound(SrcInitOutputData%kp_coordinate) + if (.not. allocated(DstInitOutputData%kp_coordinate)) then + allocate(DstInitOutputData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%kp_coordinate.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%kp_coordinate = SrcInitOutputData%kp_coordinate + end if + DstInitOutputData%kp_total = SrcInitOutputData%kp_total + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x + end if +end subroutine + +subroutine BD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(BD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%q)) THEN - i1_l = LBOUND(SrcContStateData%q,1) - i1_u = UBOUND(SrcContStateData%q,1) - i2_l = LBOUND(SrcContStateData%q,2) - i2_u = UBOUND(SrcContStateData%q,2) - IF (.NOT. ALLOCATED(DstContStateData%q)) THEN - ALLOCATE(DstContStateData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%q.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%q = SrcContStateData%q -ENDIF -IF (ALLOCATED(SrcContStateData%dqdt)) THEN - i1_l = LBOUND(SrcContStateData%dqdt,1) - i1_u = UBOUND(SrcContStateData%dqdt,1) - i2_l = LBOUND(SrcContStateData%dqdt,2) - i2_u = UBOUND(SrcContStateData%dqdt,2) - IF (.NOT. ALLOCATED(DstContStateData%dqdt)) THEN - ALLOCATE(DstContStateData%dqdt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%dqdt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%dqdt = SrcContStateData%dqdt -ENDIF - END SUBROUTINE BD_CopyContState - - SUBROUTINE BD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(BD_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 = 'BD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%q)) THEN - DEALLOCATE(ContStateData%q) -ENDIF -IF (ALLOCATED(ContStateData%dqdt)) THEN - DEALLOCATE(ContStateData%dqdt) -ENDIF - END SUBROUTINE BD_DestroyContState - - SUBROUTINE BD_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(BD_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 = 'BD_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 - Int_BufSz = Int_BufSz + 1 ! q allocated yes/no - IF ( ALLOCATED(InData%q) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! q upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%q) ! q - END IF - Int_BufSz = Int_BufSz + 1 ! dqdt allocated yes/no - IF ( ALLOCATED(InData%dqdt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! dqdt upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dqdt) ! dqdt - 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%q) ) 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%q,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%q,2), UBOUND(InData%q,2) - DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) - DbKiBuf(Db_Xferred) = InData%q(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dqdt) ) 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%dqdt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dqdt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dqdt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dqdt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%dqdt,2), UBOUND(InData%dqdt,2) - DO i1 = LBOUND(InData%dqdt,1), UBOUND(InData%dqdt,1) - DbKiBuf(Db_Xferred) = InData%dqdt(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BD_PackContState - - SUBROUTINE BD_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(BD_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) :: 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 = 'BD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q 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%q)) DEALLOCATE(OutData%q) - ALLOCATE(OutData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%q,2), UBOUND(OutData%q,2) - DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) - OutData%q(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dqdt 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%dqdt)) DEALLOCATE(OutData%dqdt) - ALLOCATE(OutData%dqdt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dqdt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%dqdt,2), UBOUND(OutData%dqdt,2) - DO i1 = LBOUND(OutData%dqdt,1), UBOUND(OutData%dqdt,1) - OutData%dqdt(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BD_UnPackContState - - SUBROUTINE BD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(BD_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 = 'BD_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + 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) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if +end subroutine + +subroutine BD_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, allocated(InData%kp_coordinate)) + if (allocated(InData%kp_coordinate)) then + call RegPackBounds(Buf, 2, lbound(InData%kp_coordinate), ubound(InData%kp_coordinate)) + call RegPack(Buf, InData%kp_coordinate) + end if + call RegPack(Buf, InData%kp_total) + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackInitOutput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (allocated(OutData%kp_coordinate)) deallocate(OutData%kp_coordinate) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%kp_coordinate) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%kp_total) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) + type(BladeInputData), intent(in) :: SrcBladeInputDataData + type(BladeInputData), intent(inout) :: DstBladeInputDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BD_CopyBladeInputData' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%thetaP = SrcDiscStateData%thetaP - DstDiscStateData%thetaPD = SrcDiscStateData%thetaPD - END SUBROUTINE BD_CopyDiscState - - SUBROUTINE BD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(BD_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 = 'BD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE BD_DestroyDiscState - - SUBROUTINE BD_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(BD_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 = 'BD_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 ! thetaP - Re_BufSz = Re_BufSz + 1 ! thetaPD - 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%thetaP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%thetaPD - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BD_PackDiscState - - SUBROUTINE BD_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(BD_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 = 'BD_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%thetaP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%thetaPD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BD_UnPackDiscState - - SUBROUTINE BD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(BD_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 = 'BD_CopyConstrState' -! + ErrMsg = '' + DstBladeInputDataData%station_total = SrcBladeInputDataData%station_total + DstBladeInputDataData%format_index = SrcBladeInputDataData%format_index + if (allocated(SrcBladeInputDataData%station_eta)) then + LB(1:1) = lbound(SrcBladeInputDataData%station_eta) + UB(1:1) = ubound(SrcBladeInputDataData%station_eta) + if (.not. allocated(DstBladeInputDataData%station_eta)) then + allocate(DstBladeInputDataData%station_eta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%station_eta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%station_eta = SrcBladeInputDataData%station_eta + end if + if (allocated(SrcBladeInputDataData%stiff0)) then + LB(1:3) = lbound(SrcBladeInputDataData%stiff0) + UB(1:3) = ubound(SrcBladeInputDataData%stiff0) + if (.not. allocated(DstBladeInputDataData%stiff0)) then + allocate(DstBladeInputDataData%stiff0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%stiff0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%stiff0 = SrcBladeInputDataData%stiff0 + end if + if (allocated(SrcBladeInputDataData%mass0)) then + LB(1:3) = lbound(SrcBladeInputDataData%mass0) + UB(1:3) = ubound(SrcBladeInputDataData%mass0) + if (.not. allocated(DstBladeInputDataData%mass0)) then + allocate(DstBladeInputDataData%mass0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%mass0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%mass0 = SrcBladeInputDataData%mass0 + end if + DstBladeInputDataData%beta = SrcBladeInputDataData%beta + DstBladeInputDataData%damp_flag = SrcBladeInputDataData%damp_flag +end subroutine + +subroutine BD_DestroyBladeInputData(BladeInputDataData, ErrStat, ErrMsg) + type(BladeInputData), intent(inout) :: BladeInputDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyBladeInputData' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE BD_CopyConstrState - - SUBROUTINE BD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(BD_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 = 'BD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE BD_DestroyConstrState - - SUBROUTINE BD_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(BD_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 = 'BD_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 BD_PackConstrState - - SUBROUTINE BD_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(BD_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 = 'BD_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BD_UnPackConstrState - - SUBROUTINE BD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(BD_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) :: 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 = 'BD_CopyOtherState' -! + ErrMsg = '' + if (allocated(BladeInputDataData%station_eta)) then + deallocate(BladeInputDataData%station_eta) + end if + if (allocated(BladeInputDataData%stiff0)) then + deallocate(BladeInputDataData%stiff0) + end if + if (allocated(BladeInputDataData%mass0)) then + deallocate(BladeInputDataData%mass0) + end if +end subroutine + +subroutine BD_PackBladeInputData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BladeInputData), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackBladeInputData' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%station_total) + call RegPack(Buf, InData%format_index) + call RegPack(Buf, allocated(InData%station_eta)) + if (allocated(InData%station_eta)) then + call RegPackBounds(Buf, 1, lbound(InData%station_eta), ubound(InData%station_eta)) + call RegPack(Buf, InData%station_eta) + end if + call RegPack(Buf, allocated(InData%stiff0)) + if (allocated(InData%stiff0)) then + call RegPackBounds(Buf, 3, lbound(InData%stiff0), ubound(InData%stiff0)) + call RegPack(Buf, InData%stiff0) + end if + call RegPack(Buf, allocated(InData%mass0)) + if (allocated(InData%mass0)) then + call RegPackBounds(Buf, 3, lbound(InData%mass0), ubound(InData%mass0)) + call RegPack(Buf, InData%mass0) + end if + call RegPack(Buf, InData%beta) + call RegPack(Buf, InData%damp_flag) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackBladeInputData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BladeInputData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackBladeInputData' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%station_total) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%format_index) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%station_eta)) deallocate(OutData%station_eta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%station_eta(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%station_eta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%station_eta) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%stiff0)) deallocate(OutData%stiff0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%stiff0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%stiff0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%stiff0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%mass0)) deallocate(OutData%mass0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%mass0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%mass0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%mass0) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%beta) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%damp_flag) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(BD_InputFile), intent(in) :: SrcInputFileData + type(BD_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%acc)) THEN - i1_l = LBOUND(SrcOtherStateData%acc,1) - i1_u = UBOUND(SrcOtherStateData%acc,1) - i2_l = LBOUND(SrcOtherStateData%acc,2) - i2_u = UBOUND(SrcOtherStateData%acc,2) - IF (.NOT. ALLOCATED(DstOtherStateData%acc)) THEN - ALLOCATE(DstOtherStateData%acc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%acc = SrcOtherStateData%acc -ENDIF -IF (ALLOCATED(SrcOtherStateData%xcc)) THEN - i1_l = LBOUND(SrcOtherStateData%xcc,1) - i1_u = UBOUND(SrcOtherStateData%xcc,1) - i2_l = LBOUND(SrcOtherStateData%xcc,2) - i2_u = UBOUND(SrcOtherStateData%xcc,2) - IF (.NOT. ALLOCATED(DstOtherStateData%xcc)) THEN - ALLOCATE(DstOtherStateData%xcc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%xcc = SrcOtherStateData%xcc -ENDIF - DstOtherStateData%InitAcc = SrcOtherStateData%InitAcc - DstOtherStateData%RunQuasiStaticInit = SrcOtherStateData%RunQuasiStaticInit - END SUBROUTINE BD_CopyOtherState - - SUBROUTINE BD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(BD_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 = 'BD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%acc)) THEN - DEALLOCATE(OtherStateData%acc) -ENDIF -IF (ALLOCATED(OtherStateData%xcc)) THEN - DEALLOCATE(OtherStateData%xcc) -ENDIF - END SUBROUTINE BD_DestroyOtherState - - SUBROUTINE BD_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(BD_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 = 'BD_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 ! acc allocated yes/no - IF ( ALLOCATED(InData%acc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! acc upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%acc) ! acc - END IF - Int_BufSz = Int_BufSz + 1 ! xcc allocated yes/no - IF ( ALLOCATED(InData%xcc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xcc upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%xcc) ! xcc - END IF - Int_BufSz = Int_BufSz + 1 ! InitAcc - Int_BufSz = Int_BufSz + 1 ! RunQuasiStaticInit - 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%acc) ) 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%acc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%acc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%acc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%acc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%acc,2), UBOUND(InData%acc,2) - DO i1 = LBOUND(InData%acc,1), UBOUND(InData%acc,1) - DbKiBuf(Db_Xferred) = InData%acc(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xcc) ) 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%xcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xcc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xcc,2), UBOUND(InData%xcc,2) - DO i1 = LBOUND(InData%xcc,1), UBOUND(InData%xcc,1) - DbKiBuf(Db_Xferred) = InData%xcc(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%InitAcc, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RunQuasiStaticInit, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_PackOtherState - - SUBROUTINE BD_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(BD_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) :: 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 = 'BD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! acc 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%acc)) DEALLOCATE(OutData%acc) - ALLOCATE(OutData%acc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%acc,2), UBOUND(OutData%acc,2) - DO i1 = LBOUND(OutData%acc,1), UBOUND(OutData%acc,1) - OutData%acc(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xcc 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%xcc)) DEALLOCATE(OutData%xcc) - ALLOCATE(OutData%xcc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xcc,2), UBOUND(OutData%xcc,2) - DO i1 = LBOUND(OutData%xcc,1), UBOUND(OutData%xcc,1) - OutData%xcc(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - OutData%InitAcc = TRANSFER(IntKiBuf(Int_Xferred), OutData%InitAcc) - Int_Xferred = Int_Xferred + 1 - OutData%RunQuasiStaticInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%RunQuasiStaticInit) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_UnPackOtherState - - SUBROUTINE BD_CopyqpParam( SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(qpParam), INTENT(IN) :: SrcqpParamData - TYPE(qpParam), INTENT(INOUT) :: DstqpParamData - 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 = 'BD_CopyqpParam' -! + ErrMsg = '' + DstInputFileData%member_total = SrcInputFileData%member_total + DstInputFileData%kp_total = SrcInputFileData%kp_total + if (allocated(SrcInputFileData%kp_member)) then + LB(1:1) = lbound(SrcInputFileData%kp_member) + UB(1:1) = ubound(SrcInputFileData%kp_member) + if (.not. allocated(DstInputFileData%kp_member)) then + allocate(DstInputFileData%kp_member(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%kp_member.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%kp_member = SrcInputFileData%kp_member + end if + DstInputFileData%order_elem = SrcInputFileData%order_elem + DstInputFileData%load_retries = SrcInputFileData%load_retries + DstInputFileData%NRMax = SrcInputFileData%NRMax + DstInputFileData%quadrature = SrcInputFileData%quadrature + DstInputFileData%n_fact = SrcInputFileData%n_fact + DstInputFileData%refine = SrcInputFileData%refine + DstInputFileData%rhoinf = SrcInputFileData%rhoinf + DstInputFileData%DTBeam = SrcInputFileData%DTBeam + call BD_CopyBladeInputData(SrcInputFileData%InpBl, DstInputFileData%InpBl, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputFileData%BldFile = SrcInputFileData%BldFile + DstInputFileData%UsePitchAct = SrcInputFileData%UsePitchAct + DstInputFileData%QuasiStaticInit = SrcInputFileData%QuasiStaticInit + DstInputFileData%stop_tol = SrcInputFileData%stop_tol + DstInputFileData%tngt_stf_pert = SrcInputFileData%tngt_stf_pert + DstInputFileData%tngt_stf_difftol = SrcInputFileData%tngt_stf_difftol + if (allocated(SrcInputFileData%kp_coordinate)) then + LB(1:2) = lbound(SrcInputFileData%kp_coordinate) + UB(1:2) = ubound(SrcInputFileData%kp_coordinate) + if (.not. allocated(DstInputFileData%kp_coordinate)) then + allocate(DstInputFileData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%kp_coordinate.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%kp_coordinate = SrcInputFileData%kp_coordinate + end if + DstInputFileData%pitchJ = SrcInputFileData%pitchJ + DstInputFileData%pitchK = SrcInputFileData%pitchK + DstInputFileData%pitchC = SrcInputFileData%pitchC + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%RotStates = SrcInputFileData%RotStates + DstInputFileData%RelStates = SrcInputFileData%RelStates + DstInputFileData%tngt_stf_fd = SrcInputFileData%tngt_stf_fd + DstInputFileData%tngt_stf_comp = SrcInputFileData%tngt_stf_comp + DstInputFileData%NNodeOuts = SrcInputFileData%NNodeOuts + DstInputFileData%OutNd = SrcInputFileData%OutNd + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + end if + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts + if (allocated(SrcInputFileData%BldNd_OutList)) then + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) + if (.not. allocated(DstInputFileData%BldNd_OutList)) then + allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList + end if + if (allocated(SrcInputFileData%BldNd_BlOutNd)) then + LB(1:1) = lbound(SrcInputFileData%BldNd_BlOutNd) + UB(1:1) = ubound(SrcInputFileData%BldNd_BlOutNd) + if (.not. allocated(DstInputFileData%BldNd_BlOutNd)) then + allocate(DstInputFileData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_BlOutNd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BldNd_BlOutNd = SrcInputFileData%BldNd_BlOutNd + end if + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str +end subroutine + +subroutine BD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(BD_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyInputFile' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcqpParamData%mmm)) THEN - i1_l = LBOUND(SrcqpParamData%mmm,1) - i1_u = UBOUND(SrcqpParamData%mmm,1) - i2_l = LBOUND(SrcqpParamData%mmm,2) - i2_u = UBOUND(SrcqpParamData%mmm,2) - IF (.NOT. ALLOCATED(DstqpParamData%mmm)) THEN - ALLOCATE(DstqpParamData%mmm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstqpParamData%mmm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstqpParamData%mmm = SrcqpParamData%mmm -ENDIF -IF (ALLOCATED(SrcqpParamData%mEta)) THEN - i1_l = LBOUND(SrcqpParamData%mEta,1) - i1_u = UBOUND(SrcqpParamData%mEta,1) - i2_l = LBOUND(SrcqpParamData%mEta,2) - i2_u = UBOUND(SrcqpParamData%mEta,2) - i3_l = LBOUND(SrcqpParamData%mEta,3) - i3_u = UBOUND(SrcqpParamData%mEta,3) - IF (.NOT. ALLOCATED(DstqpParamData%mEta)) THEN - ALLOCATE(DstqpParamData%mEta(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstqpParamData%mEta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstqpParamData%mEta = SrcqpParamData%mEta -ENDIF - END SUBROUTINE BD_CopyqpParam - - SUBROUTINE BD_DestroyqpParam( qpParamData, ErrStat, ErrMsg ) - TYPE(qpParam), INTENT(INOUT) :: qpParamData - 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 = 'BD_DestroyqpParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(qpParamData%mmm)) THEN - DEALLOCATE(qpParamData%mmm) -ENDIF -IF (ALLOCATED(qpParamData%mEta)) THEN - DEALLOCATE(qpParamData%mEta) -ENDIF - END SUBROUTINE BD_DestroyqpParam - - SUBROUTINE BD_PackqpParam( 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(qpParam), 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 = 'BD_PackqpParam' - ! 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 ! mmm allocated yes/no - IF ( ALLOCATED(InData%mmm) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! mmm upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%mmm) ! mmm - END IF - Int_BufSz = Int_BufSz + 1 ! mEta allocated yes/no - IF ( ALLOCATED(InData%mEta) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! mEta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%mEta) ! mEta - 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%mmm) ) 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%mmm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mmm,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mmm,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mmm,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%mmm,2), UBOUND(InData%mmm,2) - DO i1 = LBOUND(InData%mmm,1), UBOUND(InData%mmm,1) - DbKiBuf(Db_Xferred) = InData%mmm(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%mEta) ) 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%mEta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mEta,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mEta,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mEta,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mEta,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mEta,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%mEta,3), UBOUND(InData%mEta,3) - DO i2 = LBOUND(InData%mEta,2), UBOUND(InData%mEta,2) - DO i1 = LBOUND(InData%mEta,1), UBOUND(InData%mEta,1) - DbKiBuf(Db_Xferred) = InData%mEta(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE BD_PackqpParam - - SUBROUTINE BD_UnPackqpParam( 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(qpParam), 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 = 'BD_UnPackqpParam' - ! 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 ! mmm 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%mmm)) DEALLOCATE(OutData%mmm) - ALLOCATE(OutData%mmm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mmm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%mmm,2), UBOUND(OutData%mmm,2) - DO i1 = LBOUND(OutData%mmm,1), UBOUND(OutData%mmm,1) - OutData%mmm(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! mEta 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%mEta)) DEALLOCATE(OutData%mEta) - ALLOCATE(OutData%mEta(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%mEta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%mEta,3), UBOUND(OutData%mEta,3) - DO i2 = LBOUND(OutData%mEta,2), UBOUND(OutData%mEta,2) - DO i1 = LBOUND(OutData%mEta,1), UBOUND(OutData%mEta,1) - OutData%mEta(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE BD_UnPackqpParam - - SUBROUTINE BD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(BD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyParam' -! + ErrMsg = '' + if (allocated(InputFileData%kp_member)) then + deallocate(InputFileData%kp_member) + end if + call BD_DestroyBladeInputData(InputFileData%InpBl, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputFileData%kp_coordinate)) then + deallocate(InputFileData%kp_coordinate) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%BldNd_OutList)) then + deallocate(InputFileData%BldNd_OutList) + end if + if (allocated(InputFileData%BldNd_BlOutNd)) then + deallocate(InputFileData%BldNd_BlOutNd) + end if +end subroutine + +subroutine BD_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%member_total) + call RegPack(Buf, InData%kp_total) + call RegPack(Buf, allocated(InData%kp_member)) + if (allocated(InData%kp_member)) then + call RegPackBounds(Buf, 1, lbound(InData%kp_member), ubound(InData%kp_member)) + call RegPack(Buf, InData%kp_member) + end if + call RegPack(Buf, InData%order_elem) + call RegPack(Buf, InData%load_retries) + call RegPack(Buf, InData%NRMax) + call RegPack(Buf, InData%quadrature) + call RegPack(Buf, InData%n_fact) + call RegPack(Buf, InData%refine) + call RegPack(Buf, InData%rhoinf) + call RegPack(Buf, InData%DTBeam) + call BD_PackBladeInputData(Buf, InData%InpBl) + call RegPack(Buf, InData%BldFile) + call RegPack(Buf, InData%UsePitchAct) + call RegPack(Buf, InData%QuasiStaticInit) + call RegPack(Buf, InData%stop_tol) + call RegPack(Buf, InData%tngt_stf_pert) + call RegPack(Buf, InData%tngt_stf_difftol) + call RegPack(Buf, allocated(InData%kp_coordinate)) + if (allocated(InData%kp_coordinate)) then + call RegPackBounds(Buf, 2, lbound(InData%kp_coordinate), ubound(InData%kp_coordinate)) + call RegPack(Buf, InData%kp_coordinate) + end if + call RegPack(Buf, InData%pitchJ) + call RegPack(Buf, InData%pitchK) + call RegPack(Buf, InData%pitchC) + call RegPack(Buf, InData%Echo) + call RegPack(Buf, InData%RotStates) + call RegPack(Buf, InData%RelStates) + call RegPack(Buf, InData%tngt_stf_fd) + call RegPack(Buf, InData%tngt_stf_comp) + call RegPack(Buf, InData%NNodeOuts) + call RegPack(Buf, InData%OutNd) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + call RegPack(Buf, InData%SumPrint) + call RegPack(Buf, InData%OutFmt) + call RegPack(Buf, InData%BldNd_NumOuts) + call RegPack(Buf, allocated(InData%BldNd_OutList)) + if (allocated(InData%BldNd_OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList), ubound(InData%BldNd_OutList)) + call RegPack(Buf, InData%BldNd_OutList) + end if + call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) + if (allocated(InData%BldNd_BlOutNd)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd), ubound(InData%BldNd_BlOutNd)) + call RegPack(Buf, InData%BldNd_BlOutNd) + end if + call RegPack(Buf, InData%BldNd_BlOutNd_Str) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackInputFile' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%member_total) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%kp_total) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%kp_member)) deallocate(OutData%kp_member) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%kp_member(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_member.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%kp_member) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%order_elem) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%load_retries) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NRMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%quadrature) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_fact) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%refine) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rhoinf) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DTBeam) + if (RegCheckErr(Buf, RoutineName)) return + call BD_UnpackBladeInputData(Buf, OutData%InpBl) ! InpBl + call RegUnpack(Buf, OutData%BldFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UsePitchAct) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%QuasiStaticInit) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%stop_tol) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tngt_stf_pert) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tngt_stf_difftol) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%kp_coordinate)) deallocate(OutData%kp_coordinate) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%kp_coordinate) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%pitchJ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%pitchK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%pitchC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotStates) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RelStates) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tngt_stf_fd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tngt_stf_comp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NNodeOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutNd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BldNd_OutList)) deallocate(OutData%BldNd_OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldNd_OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BldNd_BlOutNd)) deallocate(OutData%BldNd_BlOutNd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_BlOutNd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldNd_BlOutNd) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%BldNd_BlOutNd_Str) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(BD_ContinuousStateType), intent(in) :: SrcContStateData + type(BD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BD_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%dt = SrcParamData%dt - DstParamData%coef = SrcParamData%coef - DstParamData%rhoinf = SrcParamData%rhoinf -IF (ALLOCATED(SrcParamData%uuN0)) THEN - i1_l = LBOUND(SrcParamData%uuN0,1) - i1_u = UBOUND(SrcParamData%uuN0,1) - i2_l = LBOUND(SrcParamData%uuN0,2) - i2_u = UBOUND(SrcParamData%uuN0,2) - i3_l = LBOUND(SrcParamData%uuN0,3) - i3_u = UBOUND(SrcParamData%uuN0,3) - IF (.NOT. ALLOCATED(DstParamData%uuN0)) THEN - ALLOCATE(DstParamData%uuN0(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%uuN0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uuN0 = SrcParamData%uuN0 -ENDIF -IF (ALLOCATED(SrcParamData%Stif0_QP)) THEN - i1_l = LBOUND(SrcParamData%Stif0_QP,1) - i1_u = UBOUND(SrcParamData%Stif0_QP,1) - i2_l = LBOUND(SrcParamData%Stif0_QP,2) - i2_u = UBOUND(SrcParamData%Stif0_QP,2) - i3_l = LBOUND(SrcParamData%Stif0_QP,3) - i3_u = UBOUND(SrcParamData%Stif0_QP,3) - IF (.NOT. ALLOCATED(DstParamData%Stif0_QP)) THEN - ALLOCATE(DstParamData%Stif0_QP(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%Stif0_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Stif0_QP = SrcParamData%Stif0_QP -ENDIF -IF (ALLOCATED(SrcParamData%Mass0_QP)) THEN - i1_l = LBOUND(SrcParamData%Mass0_QP,1) - i1_u = UBOUND(SrcParamData%Mass0_QP,1) - i2_l = LBOUND(SrcParamData%Mass0_QP,2) - i2_u = UBOUND(SrcParamData%Mass0_QP,2) - i3_l = LBOUND(SrcParamData%Mass0_QP,3) - i3_u = UBOUND(SrcParamData%Mass0_QP,3) - IF (.NOT. ALLOCATED(DstParamData%Mass0_QP)) THEN - ALLOCATE(DstParamData%Mass0_QP(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%Mass0_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Mass0_QP = SrcParamData%Mass0_QP -ENDIF - DstParamData%gravity = SrcParamData%gravity -IF (ALLOCATED(SrcParamData%segment_eta)) THEN - i1_l = LBOUND(SrcParamData%segment_eta,1) - i1_u = UBOUND(SrcParamData%segment_eta,1) - IF (.NOT. ALLOCATED(DstParamData%segment_eta)) THEN - ALLOCATE(DstParamData%segment_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%segment_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%segment_eta = SrcParamData%segment_eta -ENDIF -IF (ALLOCATED(SrcParamData%member_eta)) THEN - i1_l = LBOUND(SrcParamData%member_eta,1) - i1_u = UBOUND(SrcParamData%member_eta,1) - IF (.NOT. ALLOCATED(DstParamData%member_eta)) THEN - ALLOCATE(DstParamData%member_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%member_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%member_eta = SrcParamData%member_eta -ENDIF - DstParamData%blade_length = SrcParamData%blade_length - DstParamData%blade_mass = SrcParamData%blade_mass - DstParamData%blade_CG = SrcParamData%blade_CG - DstParamData%blade_IN = SrcParamData%blade_IN - DstParamData%beta = SrcParamData%beta - DstParamData%tol = SrcParamData%tol - DstParamData%GlbPos = SrcParamData%GlbPos - DstParamData%GlbRot = SrcParamData%GlbRot - DstParamData%Glb_crv = SrcParamData%Glb_crv -IF (ALLOCATED(SrcParamData%QPtN)) THEN - i1_l = LBOUND(SrcParamData%QPtN,1) - i1_u = UBOUND(SrcParamData%QPtN,1) - IF (.NOT. ALLOCATED(DstParamData%QPtN)) THEN - ALLOCATE(DstParamData%QPtN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtN = SrcParamData%QPtN -ENDIF -IF (ALLOCATED(SrcParamData%QPtWeight)) THEN - i1_l = LBOUND(SrcParamData%QPtWeight,1) - i1_u = UBOUND(SrcParamData%QPtWeight,1) - IF (.NOT. ALLOCATED(DstParamData%QPtWeight)) THEN - ALLOCATE(DstParamData%QPtWeight(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtWeight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtWeight = SrcParamData%QPtWeight -ENDIF -IF (ALLOCATED(SrcParamData%Shp)) THEN - i1_l = LBOUND(SrcParamData%Shp,1) - i1_u = UBOUND(SrcParamData%Shp,1) - i2_l = LBOUND(SrcParamData%Shp,2) - i2_u = UBOUND(SrcParamData%Shp,2) - IF (.NOT. ALLOCATED(DstParamData%Shp)) THEN - ALLOCATE(DstParamData%Shp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Shp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Shp = SrcParamData%Shp -ENDIF -IF (ALLOCATED(SrcParamData%ShpDer)) THEN - i1_l = LBOUND(SrcParamData%ShpDer,1) - i1_u = UBOUND(SrcParamData%ShpDer,1) - i2_l = LBOUND(SrcParamData%ShpDer,2) - i2_u = UBOUND(SrcParamData%ShpDer,2) - IF (.NOT. ALLOCATED(DstParamData%ShpDer)) THEN - ALLOCATE(DstParamData%ShpDer(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ShpDer = SrcParamData%ShpDer -ENDIF -IF (ALLOCATED(SrcParamData%Jacobian)) THEN - i1_l = LBOUND(SrcParamData%Jacobian,1) - i1_u = UBOUND(SrcParamData%Jacobian,1) - i2_l = LBOUND(SrcParamData%Jacobian,2) - i2_u = UBOUND(SrcParamData%Jacobian,2) - IF (.NOT. ALLOCATED(DstParamData%Jacobian)) THEN - ALLOCATE(DstParamData%Jacobian(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jacobian.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jacobian = SrcParamData%Jacobian -ENDIF -IF (ALLOCATED(SrcParamData%uu0)) THEN - i1_l = LBOUND(SrcParamData%uu0,1) - i1_u = UBOUND(SrcParamData%uu0,1) - i2_l = LBOUND(SrcParamData%uu0,2) - i2_u = UBOUND(SrcParamData%uu0,2) - i3_l = LBOUND(SrcParamData%uu0,3) - i3_u = UBOUND(SrcParamData%uu0,3) - IF (.NOT. ALLOCATED(DstParamData%uu0)) THEN - ALLOCATE(DstParamData%uu0(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%uu0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uu0 = SrcParamData%uu0 -ENDIF -IF (ALLOCATED(SrcParamData%rrN0)) THEN - i1_l = LBOUND(SrcParamData%rrN0,1) - i1_u = UBOUND(SrcParamData%rrN0,1) - i2_l = LBOUND(SrcParamData%rrN0,2) - i2_u = UBOUND(SrcParamData%rrN0,2) - i3_l = LBOUND(SrcParamData%rrN0,3) - i3_u = UBOUND(SrcParamData%rrN0,3) - IF (.NOT. ALLOCATED(DstParamData%rrN0)) THEN - ALLOCATE(DstParamData%rrN0(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%rrN0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rrN0 = SrcParamData%rrN0 -ENDIF -IF (ALLOCATED(SrcParamData%E10)) THEN - i1_l = LBOUND(SrcParamData%E10,1) - i1_u = UBOUND(SrcParamData%E10,1) - i2_l = LBOUND(SrcParamData%E10,2) - i2_u = UBOUND(SrcParamData%E10,2) - i3_l = LBOUND(SrcParamData%E10,3) - i3_u = UBOUND(SrcParamData%E10,3) - IF (.NOT. ALLOCATED(DstParamData%E10)) THEN - ALLOCATE(DstParamData%E10(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%E10.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%E10 = SrcParamData%E10 -ENDIF - DstParamData%nodes_per_elem = SrcParamData%nodes_per_elem -IF (ALLOCATED(SrcParamData%node_elem_idx)) THEN - i1_l = LBOUND(SrcParamData%node_elem_idx,1) - i1_u = UBOUND(SrcParamData%node_elem_idx,1) - i2_l = LBOUND(SrcParamData%node_elem_idx,2) - i2_u = UBOUND(SrcParamData%node_elem_idx,2) - IF (.NOT. ALLOCATED(DstParamData%node_elem_idx)) THEN - ALLOCATE(DstParamData%node_elem_idx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%node_elem_idx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%node_elem_idx = SrcParamData%node_elem_idx -ENDIF - DstParamData%refine = SrcParamData%refine - DstParamData%dof_node = SrcParamData%dof_node - DstParamData%dof_elem = SrcParamData%dof_elem - DstParamData%rot_elem = SrcParamData%rot_elem - DstParamData%elem_total = SrcParamData%elem_total - DstParamData%node_total = SrcParamData%node_total - DstParamData%dof_total = SrcParamData%dof_total - DstParamData%nqp = SrcParamData%nqp - DstParamData%analysis_type = SrcParamData%analysis_type - DstParamData%damp_flag = SrcParamData%damp_flag - DstParamData%ld_retries = SrcParamData%ld_retries - DstParamData%niter = SrcParamData%niter - DstParamData%quadrature = SrcParamData%quadrature - DstParamData%n_fact = SrcParamData%n_fact - DstParamData%OutInputs = SrcParamData%OutInputs - DstParamData%NumOuts = SrcParamData%NumOuts -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%NNodeOuts = SrcParamData%NNodeOuts - DstParamData%OutNd = SrcParamData%OutNd -IF (ALLOCATED(SrcParamData%NdIndx)) THEN - i1_l = LBOUND(SrcParamData%NdIndx,1) - i1_u = UBOUND(SrcParamData%NdIndx,1) - IF (.NOT. ALLOCATED(DstParamData%NdIndx)) THEN - ALLOCATE(DstParamData%NdIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NdIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NdIndx = SrcParamData%NdIndx -ENDIF -IF (ALLOCATED(SrcParamData%NdIndxInverse)) THEN - i1_l = LBOUND(SrcParamData%NdIndxInverse,1) - i1_u = UBOUND(SrcParamData%NdIndxInverse,1) - IF (.NOT. ALLOCATED(DstParamData%NdIndxInverse)) THEN - ALLOCATE(DstParamData%NdIndxInverse(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NdIndxInverse.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NdIndxInverse = SrcParamData%NdIndxInverse -ENDIF -IF (ALLOCATED(SrcParamData%OutNd2NdElem)) THEN - i1_l = LBOUND(SrcParamData%OutNd2NdElem,1) - i1_u = UBOUND(SrcParamData%OutNd2NdElem,1) - i2_l = LBOUND(SrcParamData%OutNd2NdElem,2) - i2_u = UBOUND(SrcParamData%OutNd2NdElem,2) - IF (.NOT. ALLOCATED(DstParamData%OutNd2NdElem)) THEN - ALLOCATE(DstParamData%OutNd2NdElem(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutNd2NdElem.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutNd2NdElem = SrcParamData%OutNd2NdElem -ENDIF - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%UsePitchAct = SrcParamData%UsePitchAct - DstParamData%pitchJ = SrcParamData%pitchJ - DstParamData%pitchK = SrcParamData%pitchK - DstParamData%pitchC = SrcParamData%pitchC - DstParamData%torqM = SrcParamData%torqM - CALL BD_Copyqpparam( SrcParamData%qp, DstParamData%qp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%qp_indx_offset = SrcParamData%qp_indx_offset - DstParamData%BldMotionNodeLoc = SrcParamData%BldMotionNodeLoc - DstParamData%tngt_stf_fd = SrcParamData%tngt_stf_fd - DstParamData%tngt_stf_comp = SrcParamData%tngt_stf_comp - DstParamData%tngt_stf_pert = SrcParamData%tngt_stf_pert - DstParamData%tngt_stf_difftol = SrcParamData%tngt_stf_difftol - DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts - DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts -IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN - i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) - i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN - ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%BldNd_BlOutNd)) THEN - i1_l = LBOUND(SrcParamData%BldNd_BlOutNd,1) - i1_u = UBOUND(SrcParamData%BldNd_BlOutNd,1) - IF (.NOT. ALLOCATED(DstParamData%BldNd_BlOutNd)) THEN - ALLOCATE(DstParamData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd -ENDIF -IF (ALLOCATED(SrcParamData%QPtw_Shp_Shp_Jac)) THEN - i1_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,1) - i1_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,1) - i2_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,2) - i2_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,2) - i3_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,3) - i3_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,3) - i4_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,4) - i4_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,4) - IF (.NOT. ALLOCATED(DstParamData%QPtw_Shp_Shp_Jac)) THEN - ALLOCATE(DstParamData%QPtw_Shp_Shp_Jac(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%QPtw_Shp_Shp_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtw_Shp_Shp_Jac = SrcParamData%QPtw_Shp_Shp_Jac -ENDIF -IF (ALLOCATED(SrcParamData%QPtw_Shp_ShpDer)) THEN - i1_l = LBOUND(SrcParamData%QPtw_Shp_ShpDer,1) - i1_u = UBOUND(SrcParamData%QPtw_Shp_ShpDer,1) - i2_l = LBOUND(SrcParamData%QPtw_Shp_ShpDer,2) - i2_u = UBOUND(SrcParamData%QPtw_Shp_ShpDer,2) - i3_l = LBOUND(SrcParamData%QPtw_Shp_ShpDer,3) - i3_u = UBOUND(SrcParamData%QPtw_Shp_ShpDer,3) - IF (.NOT. ALLOCATED(DstParamData%QPtw_Shp_ShpDer)) THEN - ALLOCATE(DstParamData%QPtw_Shp_ShpDer(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%QPtw_Shp_ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtw_Shp_ShpDer = SrcParamData%QPtw_Shp_ShpDer -ENDIF -IF (ALLOCATED(SrcParamData%QPtw_ShpDer_ShpDer_Jac)) THEN - i1_l = LBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,1) - i1_u = UBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,1) - i2_l = LBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,2) - i2_u = UBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,2) - i3_l = LBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,3) - i3_u = UBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,3) - i4_l = LBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,4) - i4_u = UBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,4) - IF (.NOT. ALLOCATED(DstParamData%QPtw_ShpDer_ShpDer_Jac)) THEN - ALLOCATE(DstParamData%QPtw_ShpDer_ShpDer_Jac(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%QPtw_ShpDer_ShpDer_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtw_ShpDer_ShpDer_Jac = SrcParamData%QPtw_ShpDer_ShpDer_Jac -ENDIF -IF (ALLOCATED(SrcParamData%QPtw_Shp_Jac)) THEN - i1_l = LBOUND(SrcParamData%QPtw_Shp_Jac,1) - i1_u = UBOUND(SrcParamData%QPtw_Shp_Jac,1) - i2_l = LBOUND(SrcParamData%QPtw_Shp_Jac,2) - i2_u = UBOUND(SrcParamData%QPtw_Shp_Jac,2) - i3_l = LBOUND(SrcParamData%QPtw_Shp_Jac,3) - i3_u = UBOUND(SrcParamData%QPtw_Shp_Jac,3) - IF (.NOT. ALLOCATED(DstParamData%QPtw_Shp_Jac)) THEN - ALLOCATE(DstParamData%QPtw_Shp_Jac(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%QPtw_Shp_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtw_Shp_Jac = SrcParamData%QPtw_Shp_Jac -ENDIF -IF (ALLOCATED(SrcParamData%QPtw_ShpDer)) THEN - i1_l = LBOUND(SrcParamData%QPtw_ShpDer,1) - i1_u = UBOUND(SrcParamData%QPtw_ShpDer,1) - i2_l = LBOUND(SrcParamData%QPtw_ShpDer,2) - i2_u = UBOUND(SrcParamData%QPtw_ShpDer,2) - IF (.NOT. ALLOCATED(DstParamData%QPtw_ShpDer)) THEN - ALLOCATE(DstParamData%QPtw_ShpDer(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtw_ShpDer = SrcParamData%QPtw_ShpDer -ENDIF -IF (ALLOCATED(SrcParamData%FEweight)) THEN - i1_l = LBOUND(SrcParamData%FEweight,1) - i1_u = UBOUND(SrcParamData%FEweight,1) - i2_l = LBOUND(SrcParamData%FEweight,2) - i2_u = UBOUND(SrcParamData%FEweight,2) - IF (.NOT. ALLOCATED(DstParamData%FEweight)) THEN - ALLOCATE(DstParamData%FEweight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FEweight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FEweight = SrcParamData%FEweight -ENDIF -IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_u_indx,1) - i1_u = UBOUND(SrcParamData%Jac_u_indx,1) - i2_l = LBOUND(SrcParamData%Jac_u_indx,2) - i2_u = UBOUND(SrcParamData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN - ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcParamData%du)) THEN - i1_l = LBOUND(SrcParamData%du,1) - i1_u = UBOUND(SrcParamData%du,1) - IF (.NOT. ALLOCATED(DstParamData%du)) THEN - ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%du = SrcParamData%du -ENDIF - DstParamData%dx = SrcParamData%dx - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx - DstParamData%RotStates = SrcParamData%RotStates - DstParamData%RelStates = SrcParamData%RelStates - END SUBROUTINE BD_CopyParam - - SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(BD_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 = 'BD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%uuN0)) THEN - DEALLOCATE(ParamData%uuN0) -ENDIF -IF (ALLOCATED(ParamData%Stif0_QP)) THEN - DEALLOCATE(ParamData%Stif0_QP) -ENDIF -IF (ALLOCATED(ParamData%Mass0_QP)) THEN - DEALLOCATE(ParamData%Mass0_QP) -ENDIF -IF (ALLOCATED(ParamData%segment_eta)) THEN - DEALLOCATE(ParamData%segment_eta) -ENDIF -IF (ALLOCATED(ParamData%member_eta)) THEN - DEALLOCATE(ParamData%member_eta) -ENDIF -IF (ALLOCATED(ParamData%QPtN)) THEN - DEALLOCATE(ParamData%QPtN) -ENDIF -IF (ALLOCATED(ParamData%QPtWeight)) THEN - DEALLOCATE(ParamData%QPtWeight) -ENDIF -IF (ALLOCATED(ParamData%Shp)) THEN - DEALLOCATE(ParamData%Shp) -ENDIF -IF (ALLOCATED(ParamData%ShpDer)) THEN - DEALLOCATE(ParamData%ShpDer) -ENDIF -IF (ALLOCATED(ParamData%Jacobian)) THEN - DEALLOCATE(ParamData%Jacobian) -ENDIF -IF (ALLOCATED(ParamData%uu0)) THEN - DEALLOCATE(ParamData%uu0) -ENDIF -IF (ALLOCATED(ParamData%rrN0)) THEN - DEALLOCATE(ParamData%rrN0) -ENDIF -IF (ALLOCATED(ParamData%E10)) THEN - DEALLOCATE(ParamData%E10) -ENDIF -IF (ALLOCATED(ParamData%node_elem_idx)) THEN - DEALLOCATE(ParamData%node_elem_idx) -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 -IF (ALLOCATED(ParamData%NdIndx)) THEN - DEALLOCATE(ParamData%NdIndx) -ENDIF -IF (ALLOCATED(ParamData%NdIndxInverse)) THEN - DEALLOCATE(ParamData%NdIndxInverse) -ENDIF -IF (ALLOCATED(ParamData%OutNd2NdElem)) THEN - DEALLOCATE(ParamData%OutNd2NdElem) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%BldNd_OutParam) -ENDIF -IF (ALLOCATED(ParamData%BldNd_BlOutNd)) THEN - DEALLOCATE(ParamData%BldNd_BlOutNd) -ENDIF -IF (ALLOCATED(ParamData%QPtw_Shp_Shp_Jac)) THEN - DEALLOCATE(ParamData%QPtw_Shp_Shp_Jac) -ENDIF -IF (ALLOCATED(ParamData%QPtw_Shp_ShpDer)) THEN - DEALLOCATE(ParamData%QPtw_Shp_ShpDer) -ENDIF -IF (ALLOCATED(ParamData%QPtw_ShpDer_ShpDer_Jac)) THEN - DEALLOCATE(ParamData%QPtw_ShpDer_ShpDer_Jac) -ENDIF -IF (ALLOCATED(ParamData%QPtw_Shp_Jac)) THEN - DEALLOCATE(ParamData%QPtw_Shp_Jac) -ENDIF -IF (ALLOCATED(ParamData%QPtw_ShpDer)) THEN - DEALLOCATE(ParamData%QPtw_ShpDer) -ENDIF -IF (ALLOCATED(ParamData%FEweight)) THEN - DEALLOCATE(ParamData%FEweight) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF - END SUBROUTINE BD_DestroyParam - - SUBROUTINE BD_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(BD_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 = 'BD_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 + SIZE(InData%coef) ! coef - Db_BufSz = Db_BufSz + 1 ! rhoinf - Int_BufSz = Int_BufSz + 1 ! uuN0 allocated yes/no - IF ( ALLOCATED(InData%uuN0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! uuN0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%uuN0) ! uuN0 - END IF - Int_BufSz = Int_BufSz + 1 ! Stif0_QP allocated yes/no - IF ( ALLOCATED(InData%Stif0_QP) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Stif0_QP upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Stif0_QP) ! Stif0_QP - END IF - Int_BufSz = Int_BufSz + 1 ! Mass0_QP allocated yes/no - IF ( ALLOCATED(InData%Mass0_QP) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Mass0_QP upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Mass0_QP) ! Mass0_QP - END IF - Db_BufSz = Db_BufSz + SIZE(InData%gravity) ! gravity - Int_BufSz = Int_BufSz + 1 ! segment_eta allocated yes/no - IF ( ALLOCATED(InData%segment_eta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! segment_eta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%segment_eta) ! segment_eta - END IF - Int_BufSz = Int_BufSz + 1 ! member_eta allocated yes/no - IF ( ALLOCATED(InData%member_eta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! member_eta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%member_eta) ! member_eta - END IF - Db_BufSz = Db_BufSz + 1 ! blade_length - Db_BufSz = Db_BufSz + 1 ! blade_mass - Db_BufSz = Db_BufSz + SIZE(InData%blade_CG) ! blade_CG - Db_BufSz = Db_BufSz + SIZE(InData%blade_IN) ! blade_IN - Db_BufSz = Db_BufSz + SIZE(InData%beta) ! beta - Db_BufSz = Db_BufSz + 1 ! tol - Db_BufSz = Db_BufSz + SIZE(InData%GlbPos) ! GlbPos - Db_BufSz = Db_BufSz + SIZE(InData%GlbRot) ! GlbRot - Db_BufSz = Db_BufSz + SIZE(InData%Glb_crv) ! Glb_crv - Int_BufSz = Int_BufSz + 1 ! QPtN allocated yes/no - IF ( ALLOCATED(InData%QPtN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QPtN upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtN) ! QPtN - END IF - Int_BufSz = Int_BufSz + 1 ! QPtWeight allocated yes/no - IF ( ALLOCATED(InData%QPtWeight) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QPtWeight upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtWeight) ! QPtWeight - END IF - Int_BufSz = Int_BufSz + 1 ! Shp allocated yes/no - IF ( ALLOCATED(InData%Shp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Shp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Shp) ! Shp - END IF - Int_BufSz = Int_BufSz + 1 ! ShpDer allocated yes/no - IF ( ALLOCATED(InData%ShpDer) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ShpDer upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ShpDer) ! ShpDer - END IF - Int_BufSz = Int_BufSz + 1 ! Jacobian allocated yes/no - IF ( ALLOCATED(InData%Jacobian) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jacobian upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Jacobian) ! Jacobian - END IF - Int_BufSz = Int_BufSz + 1 ! uu0 allocated yes/no - IF ( ALLOCATED(InData%uu0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! uu0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%uu0) ! uu0 - END IF - Int_BufSz = Int_BufSz + 1 ! rrN0 allocated yes/no - IF ( ALLOCATED(InData%rrN0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rrN0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rrN0) ! rrN0 - END IF - Int_BufSz = Int_BufSz + 1 ! E10 allocated yes/no - IF ( ALLOCATED(InData%E10) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! E10 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%E10) ! E10 - END IF - Int_BufSz = Int_BufSz + 1 ! nodes_per_elem - Int_BufSz = Int_BufSz + 1 ! node_elem_idx allocated yes/no - IF ( ALLOCATED(InData%node_elem_idx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! node_elem_idx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%node_elem_idx) ! node_elem_idx - END IF - Int_BufSz = Int_BufSz + 1 ! refine - Int_BufSz = Int_BufSz + 1 ! dof_node - Int_BufSz = Int_BufSz + 1 ! dof_elem - Int_BufSz = Int_BufSz + 1 ! rot_elem - Int_BufSz = Int_BufSz + 1 ! elem_total - Int_BufSz = Int_BufSz + 1 ! node_total - Int_BufSz = Int_BufSz + 1 ! dof_total - Int_BufSz = Int_BufSz + 1 ! nqp - Int_BufSz = Int_BufSz + 1 ! analysis_type - Int_BufSz = Int_BufSz + 1 ! damp_flag - Int_BufSz = Int_BufSz + 1 ! ld_retries - Int_BufSz = Int_BufSz + 1 ! niter - Int_BufSz = Int_BufSz + 1 ! quadrature - Int_BufSz = Int_BufSz + 1 ! n_fact - Int_BufSz = Int_BufSz + 1 ! OutInputs - Int_BufSz = Int_BufSz + 1 ! NumOuts - 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 ! NNodeOuts - Int_BufSz = Int_BufSz + SIZE(InData%OutNd) ! OutNd - Int_BufSz = Int_BufSz + 1 ! NdIndx allocated yes/no - IF ( ALLOCATED(InData%NdIndx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NdIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NdIndx) ! NdIndx - END IF - Int_BufSz = Int_BufSz + 1 ! NdIndxInverse allocated yes/no - IF ( ALLOCATED(InData%NdIndxInverse) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NdIndxInverse upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NdIndxInverse) ! NdIndxInverse - END IF - Int_BufSz = Int_BufSz + 1 ! OutNd2NdElem allocated yes/no - IF ( ALLOCATED(InData%OutNd2NdElem) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OutNd2NdElem upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutNd2NdElem) ! OutNd2NdElem - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1 ! UsePitchAct - Re_BufSz = Re_BufSz + 1 ! pitchJ - Re_BufSz = Re_BufSz + 1 ! pitchK - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! qp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! qp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! qp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! qp_indx_offset - Int_BufSz = Int_BufSz + 1 ! BldMotionNodeLoc - Int_BufSz = Int_BufSz + 1 ! tngt_stf_fd - Int_BufSz = Int_BufSz + 1 ! tngt_stf_comp - Db_BufSz = Db_BufSz + 1 ! tngt_stf_pert - Db_BufSz = Db_BufSz + 1 ! tngt_stf_difftol - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no - IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd - END IF - Int_BufSz = Int_BufSz + 1 ! QPtw_Shp_Shp_Jac allocated yes/no - IF ( ALLOCATED(InData%QPtw_Shp_Shp_Jac) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! QPtw_Shp_Shp_Jac upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtw_Shp_Shp_Jac) ! QPtw_Shp_Shp_Jac - END IF - Int_BufSz = Int_BufSz + 1 ! QPtw_Shp_ShpDer allocated yes/no - IF ( ALLOCATED(InData%QPtw_Shp_ShpDer) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! QPtw_Shp_ShpDer upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtw_Shp_ShpDer) ! QPtw_Shp_ShpDer - END IF - Int_BufSz = Int_BufSz + 1 ! QPtw_ShpDer_ShpDer_Jac allocated yes/no - IF ( ALLOCATED(InData%QPtw_ShpDer_ShpDer_Jac) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! QPtw_ShpDer_ShpDer_Jac upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtw_ShpDer_ShpDer_Jac) ! QPtw_ShpDer_ShpDer_Jac - END IF - Int_BufSz = Int_BufSz + 1 ! QPtw_Shp_Jac allocated yes/no - IF ( ALLOCATED(InData%QPtw_Shp_Jac) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! QPtw_Shp_Jac upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtw_Shp_Jac) ! QPtw_Shp_Jac - END IF - Int_BufSz = Int_BufSz + 1 ! QPtw_ShpDer allocated yes/no - IF ( ALLOCATED(InData%QPtw_ShpDer) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! QPtw_ShpDer upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtw_ShpDer) ! QPtw_ShpDer - END IF - Int_BufSz = Int_BufSz + 1 ! FEweight allocated yes/no - IF ( ALLOCATED(InData%FEweight) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FEweight upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%FEweight) ! FEweight - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%du) ! du - END IF - Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! Jac_nx - Int_BufSz = Int_BufSz + 1 ! RotStates - Int_BufSz = Int_BufSz + 1 ! RelStates - 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 - DO i1 = LBOUND(InData%coef,1), UBOUND(InData%coef,1) - DbKiBuf(Db_Xferred) = InData%coef(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%rhoinf - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%uuN0) ) 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%uuN0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuN0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuN0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuN0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuN0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuN0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%uuN0,3), UBOUND(InData%uuN0,3) - DO i2 = LBOUND(InData%uuN0,2), UBOUND(InData%uuN0,2) - DO i1 = LBOUND(InData%uuN0,1), UBOUND(InData%uuN0,1) - DbKiBuf(Db_Xferred) = InData%uuN0(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Stif0_QP) ) 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%Stif0_QP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif0_QP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif0_QP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif0_QP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif0_QP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif0_QP,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Stif0_QP,3), UBOUND(InData%Stif0_QP,3) - DO i2 = LBOUND(InData%Stif0_QP,2), UBOUND(InData%Stif0_QP,2) - DO i1 = LBOUND(InData%Stif0_QP,1), UBOUND(InData%Stif0_QP,1) - DbKiBuf(Db_Xferred) = InData%Stif0_QP(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mass0_QP) ) 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%Mass0_QP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass0_QP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass0_QP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass0_QP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass0_QP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass0_QP,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Mass0_QP,3), UBOUND(InData%Mass0_QP,3) - DO i2 = LBOUND(InData%Mass0_QP,2), UBOUND(InData%Mass0_QP,2) - DO i1 = LBOUND(InData%Mass0_QP,1), UBOUND(InData%Mass0_QP,1) - DbKiBuf(Db_Xferred) = InData%Mass0_QP(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%gravity,1), UBOUND(InData%gravity,1) - DbKiBuf(Db_Xferred) = InData%gravity(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%segment_eta) ) 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%segment_eta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%segment_eta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%segment_eta,1), UBOUND(InData%segment_eta,1) - DbKiBuf(Db_Xferred) = InData%segment_eta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%member_eta) ) 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%member_eta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%member_eta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%member_eta,1), UBOUND(InData%member_eta,1) - DbKiBuf(Db_Xferred) = InData%member_eta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%blade_length - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%blade_mass - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%blade_CG,1), UBOUND(InData%blade_CG,1) - DbKiBuf(Db_Xferred) = InData%blade_CG(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%blade_IN,2), UBOUND(InData%blade_IN,2) - DO i1 = LBOUND(InData%blade_IN,1), UBOUND(InData%blade_IN,1) - DbKiBuf(Db_Xferred) = InData%blade_IN(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%beta,1), UBOUND(InData%beta,1) - DbKiBuf(Db_Xferred) = InData%beta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%tol - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%GlbPos,1), UBOUND(InData%GlbPos,1) - DbKiBuf(Db_Xferred) = InData%GlbPos(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%GlbRot,2), UBOUND(InData%GlbRot,2) - DO i1 = LBOUND(InData%GlbRot,1), UBOUND(InData%GlbRot,1) - DbKiBuf(Db_Xferred) = InData%GlbRot(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%Glb_crv,1), UBOUND(InData%Glb_crv,1) - DbKiBuf(Db_Xferred) = InData%Glb_crv(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%QPtN) ) 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%QPtN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QPtN,1), UBOUND(InData%QPtN,1) - DbKiBuf(Db_Xferred) = InData%QPtN(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtWeight) ) 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%QPtWeight,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtWeight,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QPtWeight,1), UBOUND(InData%QPtWeight,1) - DbKiBuf(Db_Xferred) = InData%QPtWeight(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Shp) ) 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%Shp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Shp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Shp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Shp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Shp,2), UBOUND(InData%Shp,2) - DO i1 = LBOUND(InData%Shp,1), UBOUND(InData%Shp,1) - DbKiBuf(Db_Xferred) = InData%Shp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ShpDer) ) 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%ShpDer,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShpDer,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ShpDer,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShpDer,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ShpDer,2), UBOUND(InData%ShpDer,2) - DO i1 = LBOUND(InData%ShpDer,1), UBOUND(InData%ShpDer,1) - DbKiBuf(Db_Xferred) = InData%ShpDer(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jacobian) ) 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%Jacobian,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jacobian,2), UBOUND(InData%Jacobian,2) - DO i1 = LBOUND(InData%Jacobian,1), UBOUND(InData%Jacobian,1) - DbKiBuf(Db_Xferred) = InData%Jacobian(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uu0) ) 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%uu0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uu0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uu0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uu0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uu0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uu0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%uu0,3), UBOUND(InData%uu0,3) - DO i2 = LBOUND(InData%uu0,2), UBOUND(InData%uu0,2) - DO i1 = LBOUND(InData%uu0,1), UBOUND(InData%uu0,1) - DbKiBuf(Db_Xferred) = InData%uu0(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rrN0) ) 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%rrN0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rrN0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rrN0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rrN0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rrN0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rrN0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rrN0,3), UBOUND(InData%rrN0,3) - DO i2 = LBOUND(InData%rrN0,2), UBOUND(InData%rrN0,2) - DO i1 = LBOUND(InData%rrN0,1), UBOUND(InData%rrN0,1) - DbKiBuf(Db_Xferred) = InData%rrN0(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%E10) ) 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%E10,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E10,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E10,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E10,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E10,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E10,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%E10,3), UBOUND(InData%E10,3) - DO i2 = LBOUND(InData%E10,2), UBOUND(InData%E10,2) - DO i1 = LBOUND(InData%E10,1), UBOUND(InData%E10,1) - DbKiBuf(Db_Xferred) = InData%E10(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nodes_per_elem - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%node_elem_idx) ) 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%node_elem_idx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%node_elem_idx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%node_elem_idx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%node_elem_idx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%node_elem_idx,2), UBOUND(InData%node_elem_idx,2) - DO i1 = LBOUND(InData%node_elem_idx,1), UBOUND(InData%node_elem_idx,1) - IntKiBuf(Int_Xferred) = InData%node_elem_idx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%refine - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%dof_node - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%dof_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%rot_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%elem_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%node_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%dof_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nqp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%analysis_type - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%damp_flag - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ld_retries - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%niter - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%quadrature - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_fact - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutInputs, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - 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%NNodeOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%OutNd,1), UBOUND(InData%OutNd,1) - IntKiBuf(Int_Xferred) = InData%OutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%NdIndx) ) 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%NdIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NdIndx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NdIndx,1), UBOUND(InData%NdIndx,1) - IntKiBuf(Int_Xferred) = InData%NdIndx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NdIndxInverse) ) 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%NdIndxInverse,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NdIndxInverse,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NdIndxInverse,1), UBOUND(InData%NdIndxInverse,1) - IntKiBuf(Int_Xferred) = InData%NdIndxInverse(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutNd2NdElem) ) 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%OutNd2NdElem,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutNd2NdElem,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutNd2NdElem,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutNd2NdElem,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OutNd2NdElem,2), UBOUND(InData%OutNd2NdElem,2) - DO i1 = LBOUND(InData%OutNd2NdElem,1), UBOUND(InData%OutNd2NdElem,1) - IntKiBuf(Int_Xferred) = InData%OutNd2NdElem(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePitchAct, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%pitchJ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%pitchK - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%pitchC - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%torqM,2), UBOUND(InData%torqM,2) - DO i1 = LBOUND(InData%torqM,1), UBOUND(InData%torqM,1) - ReKiBuf(Re_Xferred) = InData%torqM(i1,i2) - 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 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%qp_indx_offset - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldMotionNodeLoc - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_fd, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_comp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tngt_stf_pert - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tngt_stf_difftol - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_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%BldNd_OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) 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%BldNd_BlOutNd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) - IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtw_Shp_Shp_Jac) ) 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%QPtw_Shp_Shp_Jac,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Shp_Jac,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Shp_Jac,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Shp_Jac,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Shp_Jac,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Shp_Jac,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Shp_Jac,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Shp_Jac,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%QPtw_Shp_Shp_Jac,4), UBOUND(InData%QPtw_Shp_Shp_Jac,4) - DO i3 = LBOUND(InData%QPtw_Shp_Shp_Jac,3), UBOUND(InData%QPtw_Shp_Shp_Jac,3) - DO i2 = LBOUND(InData%QPtw_Shp_Shp_Jac,2), UBOUND(InData%QPtw_Shp_Shp_Jac,2) - DO i1 = LBOUND(InData%QPtw_Shp_Shp_Jac,1), UBOUND(InData%QPtw_Shp_Shp_Jac,1) - DbKiBuf(Db_Xferred) = InData%QPtw_Shp_Shp_Jac(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtw_Shp_ShpDer) ) 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%QPtw_Shp_ShpDer,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_ShpDer,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_ShpDer,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_ShpDer,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_ShpDer,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_ShpDer,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%QPtw_Shp_ShpDer,3), UBOUND(InData%QPtw_Shp_ShpDer,3) - DO i2 = LBOUND(InData%QPtw_Shp_ShpDer,2), UBOUND(InData%QPtw_Shp_ShpDer,2) - DO i1 = LBOUND(InData%QPtw_Shp_ShpDer,1), UBOUND(InData%QPtw_Shp_ShpDer,1) - DbKiBuf(Db_Xferred) = InData%QPtw_Shp_ShpDer(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtw_ShpDer_ShpDer_Jac) ) 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%QPtw_ShpDer_ShpDer_Jac,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4) - DO i3 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3) - DO i2 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2) - DO i1 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1) - DbKiBuf(Db_Xferred) = InData%QPtw_ShpDer_ShpDer_Jac(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtw_Shp_Jac) ) 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%QPtw_Shp_Jac,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Jac,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Jac,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Jac,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Jac,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Jac,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%QPtw_Shp_Jac,3), UBOUND(InData%QPtw_Shp_Jac,3) - DO i2 = LBOUND(InData%QPtw_Shp_Jac,2), UBOUND(InData%QPtw_Shp_Jac,2) - DO i1 = LBOUND(InData%QPtw_Shp_Jac,1), UBOUND(InData%QPtw_Shp_Jac,1) - DbKiBuf(Db_Xferred) = InData%QPtw_Shp_Jac(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtw_ShpDer) ) 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%QPtw_ShpDer,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%QPtw_ShpDer,2), UBOUND(InData%QPtw_ShpDer,2) - DO i1 = LBOUND(InData%QPtw_ShpDer,1), UBOUND(InData%QPtw_ShpDer,1) - DbKiBuf(Db_Xferred) = InData%QPtw_ShpDer(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FEweight) ) 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%FEweight,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FEweight,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FEweight,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FEweight,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FEweight,2), UBOUND(InData%FEweight,2) - DO i1 = LBOUND(InData%FEweight,1), UBOUND(InData%FEweight,1) - DbKiBuf(Db_Xferred) = InData%FEweight(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) 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%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%du) ) 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%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - DbKiBuf(Db_Xferred) = InData%du(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - DbKiBuf(Db_Xferred) = InData%dx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RelStates, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_PackParam - - SUBROUTINE BD_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(BD_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) :: 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_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 - i1_l = LBOUND(OutData%coef,1) - i1_u = UBOUND(OutData%coef,1) - DO i1 = LBOUND(OutData%coef,1), UBOUND(OutData%coef,1) - OutData%coef(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%rhoinf = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uuN0 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%uuN0)) DEALLOCATE(OutData%uuN0) - ALLOCATE(OutData%uuN0(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%uuN0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%uuN0,3), UBOUND(OutData%uuN0,3) - DO i2 = LBOUND(OutData%uuN0,2), UBOUND(OutData%uuN0,2) - DO i1 = LBOUND(OutData%uuN0,1), UBOUND(OutData%uuN0,1) - OutData%uuN0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stif0_QP 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%Stif0_QP)) DEALLOCATE(OutData%Stif0_QP) - ALLOCATE(OutData%Stif0_QP(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%Stif0_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Stif0_QP,3), UBOUND(OutData%Stif0_QP,3) - DO i2 = LBOUND(OutData%Stif0_QP,2), UBOUND(OutData%Stif0_QP,2) - DO i1 = LBOUND(OutData%Stif0_QP,1), UBOUND(OutData%Stif0_QP,1) - OutData%Stif0_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mass0_QP 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%Mass0_QP)) DEALLOCATE(OutData%Mass0_QP) - ALLOCATE(OutData%Mass0_QP(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%Mass0_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Mass0_QP,3), UBOUND(OutData%Mass0_QP,3) - DO i2 = LBOUND(OutData%Mass0_QP,2), UBOUND(OutData%Mass0_QP,2) - DO i1 = LBOUND(OutData%Mass0_QP,1), UBOUND(OutData%Mass0_QP,1) - OutData%Mass0_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%gravity,1) - i1_u = UBOUND(OutData%gravity,1) - DO i1 = LBOUND(OutData%gravity,1), UBOUND(OutData%gravity,1) - OutData%gravity(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! segment_eta 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%segment_eta)) DEALLOCATE(OutData%segment_eta) - ALLOCATE(OutData%segment_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%segment_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%segment_eta,1), UBOUND(OutData%segment_eta,1) - OutData%segment_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! member_eta 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%member_eta)) DEALLOCATE(OutData%member_eta) - ALLOCATE(OutData%member_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%member_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%member_eta,1), UBOUND(OutData%member_eta,1) - OutData%member_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%blade_length = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%blade_mass = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%blade_CG,1) - i1_u = UBOUND(OutData%blade_CG,1) - DO i1 = LBOUND(OutData%blade_CG,1), UBOUND(OutData%blade_CG,1) - OutData%blade_CG(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%blade_IN,1) - i1_u = UBOUND(OutData%blade_IN,1) - i2_l = LBOUND(OutData%blade_IN,2) - i2_u = UBOUND(OutData%blade_IN,2) - DO i2 = LBOUND(OutData%blade_IN,2), UBOUND(OutData%blade_IN,2) - DO i1 = LBOUND(OutData%blade_IN,1), UBOUND(OutData%blade_IN,1) - OutData%blade_IN(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%beta,1) - i1_u = UBOUND(OutData%beta,1) - DO i1 = LBOUND(OutData%beta,1), UBOUND(OutData%beta,1) - OutData%beta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%tol = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%GlbPos,1) - i1_u = UBOUND(OutData%GlbPos,1) - DO i1 = LBOUND(OutData%GlbPos,1), UBOUND(OutData%GlbPos,1) - OutData%GlbPos(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%GlbRot,1) - i1_u = UBOUND(OutData%GlbRot,1) - i2_l = LBOUND(OutData%GlbRot,2) - i2_u = UBOUND(OutData%GlbRot,2) - DO i2 = LBOUND(OutData%GlbRot,2), UBOUND(OutData%GlbRot,2) - DO i1 = LBOUND(OutData%GlbRot,1), UBOUND(OutData%GlbRot,1) - OutData%GlbRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%Glb_crv,1) - i1_u = UBOUND(OutData%Glb_crv,1) - DO i1 = LBOUND(OutData%Glb_crv,1), UBOUND(OutData%Glb_crv,1) - OutData%Glb_crv(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtN 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%QPtN)) DEALLOCATE(OutData%QPtN) - ALLOCATE(OutData%QPtN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QPtN,1), UBOUND(OutData%QPtN,1) - OutData%QPtN(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtWeight 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%QPtWeight)) DEALLOCATE(OutData%QPtWeight) - ALLOCATE(OutData%QPtWeight(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtWeight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QPtWeight,1), UBOUND(OutData%QPtWeight,1) - OutData%QPtWeight(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Shp 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%Shp)) DEALLOCATE(OutData%Shp) - ALLOCATE(OutData%Shp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Shp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Shp,2), UBOUND(OutData%Shp,2) - DO i1 = LBOUND(OutData%Shp,1), UBOUND(OutData%Shp,1) - OutData%Shp(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShpDer 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%ShpDer)) DEALLOCATE(OutData%ShpDer) - ALLOCATE(OutData%ShpDer(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ShpDer,2), UBOUND(OutData%ShpDer,2) - DO i1 = LBOUND(OutData%ShpDer,1), UBOUND(OutData%ShpDer,1) - OutData%ShpDer(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian 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%Jacobian)) DEALLOCATE(OutData%Jacobian) - ALLOCATE(OutData%Jacobian(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jacobian,2), UBOUND(OutData%Jacobian,2) - DO i1 = LBOUND(OutData%Jacobian,1), UBOUND(OutData%Jacobian,1) - OutData%Jacobian(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uu0 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%uu0)) DEALLOCATE(OutData%uu0) - ALLOCATE(OutData%uu0(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%uu0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%uu0,3), UBOUND(OutData%uu0,3) - DO i2 = LBOUND(OutData%uu0,2), UBOUND(OutData%uu0,2) - DO i1 = LBOUND(OutData%uu0,1), UBOUND(OutData%uu0,1) - OutData%uu0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rrN0 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%rrN0)) DEALLOCATE(OutData%rrN0) - ALLOCATE(OutData%rrN0(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%rrN0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rrN0,3), UBOUND(OutData%rrN0,3) - DO i2 = LBOUND(OutData%rrN0,2), UBOUND(OutData%rrN0,2) - DO i1 = LBOUND(OutData%rrN0,1), UBOUND(OutData%rrN0,1) - OutData%rrN0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! E10 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%E10)) DEALLOCATE(OutData%E10) - ALLOCATE(OutData%E10(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%E10.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%E10,3), UBOUND(OutData%E10,3) - DO i2 = LBOUND(OutData%E10,2), UBOUND(OutData%E10,2) - DO i1 = LBOUND(OutData%E10,1), UBOUND(OutData%E10,1) - OutData%E10(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%nodes_per_elem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! node_elem_idx 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%node_elem_idx)) DEALLOCATE(OutData%node_elem_idx) - ALLOCATE(OutData%node_elem_idx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%node_elem_idx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%node_elem_idx,2), UBOUND(OutData%node_elem_idx,2) - DO i1 = LBOUND(OutData%node_elem_idx,1), UBOUND(OutData%node_elem_idx,1) - OutData%node_elem_idx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%refine = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dof_node = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dof_elem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%rot_elem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%elem_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%node_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dof_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nqp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%analysis_type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%damp_flag = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ld_retries = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%niter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%quadrature = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_fact = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutInputs = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutInputs) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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%NNodeOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%OutNd,1) - i1_u = UBOUND(OutData%OutNd,1) - DO i1 = LBOUND(OutData%OutNd,1), UBOUND(OutData%OutNd,1) - OutData%OutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NdIndx 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%NdIndx)) DEALLOCATE(OutData%NdIndx) - ALLOCATE(OutData%NdIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NdIndx,1), UBOUND(OutData%NdIndx,1) - OutData%NdIndx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NdIndxInverse 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%NdIndxInverse)) DEALLOCATE(OutData%NdIndxInverse) - ALLOCATE(OutData%NdIndxInverse(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndxInverse.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NdIndxInverse,1), UBOUND(OutData%NdIndxInverse,1) - OutData%NdIndxInverse(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutNd2NdElem 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%OutNd2NdElem)) DEALLOCATE(OutData%OutNd2NdElem) - ALLOCATE(OutData%OutNd2NdElem(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutNd2NdElem.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OutNd2NdElem,2), UBOUND(OutData%OutNd2NdElem,2) - DO i1 = LBOUND(OutData%OutNd2NdElem,1), UBOUND(OutData%OutNd2NdElem,1) - OutData%OutNd2NdElem(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePitchAct = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePitchAct) - Int_Xferred = Int_Xferred + 1 - OutData%pitchJ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%pitchK = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%pitchC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%torqM,1) - i1_u = UBOUND(OutData%torqM,1) - i2_l = LBOUND(OutData%torqM,2) - i2_u = UBOUND(OutData%torqM,2) - DO i2 = LBOUND(OutData%torqM,2), UBOUND(OutData%torqM,2) - DO i1 = LBOUND(OutData%torqM,1), UBOUND(OutData%torqM,1) - OutData%torqM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 BD_UnpackqpParam( Re_Buf, Db_Buf, Int_Buf, OutData%qp, ErrStat2, ErrMsg2 ) ! qp - 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%qp_indx_offset = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldMotionNodeLoc = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_fd = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_fd) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_comp = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_comp) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_pert = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_difftol = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_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%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) - ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_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%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_BlOutNd 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%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) - ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) - OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_Shp_Jac 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%QPtw_Shp_Shp_Jac)) DEALLOCATE(OutData%QPtw_Shp_Shp_Jac) - ALLOCATE(OutData%QPtw_Shp_Shp_Jac(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%QPtw_Shp_Shp_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%QPtw_Shp_Shp_Jac,4), UBOUND(OutData%QPtw_Shp_Shp_Jac,4) - DO i3 = LBOUND(OutData%QPtw_Shp_Shp_Jac,3), UBOUND(OutData%QPtw_Shp_Shp_Jac,3) - DO i2 = LBOUND(OutData%QPtw_Shp_Shp_Jac,2), UBOUND(OutData%QPtw_Shp_Shp_Jac,2) - DO i1 = LBOUND(OutData%QPtw_Shp_Shp_Jac,1), UBOUND(OutData%QPtw_Shp_Shp_Jac,1) - OutData%QPtw_Shp_Shp_Jac(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_ShpDer 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%QPtw_Shp_ShpDer)) DEALLOCATE(OutData%QPtw_Shp_ShpDer) - ALLOCATE(OutData%QPtw_Shp_ShpDer(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%QPtw_Shp_ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%QPtw_Shp_ShpDer,3), UBOUND(OutData%QPtw_Shp_ShpDer,3) - DO i2 = LBOUND(OutData%QPtw_Shp_ShpDer,2), UBOUND(OutData%QPtw_Shp_ShpDer,2) - DO i1 = LBOUND(OutData%QPtw_Shp_ShpDer,1), UBOUND(OutData%QPtw_Shp_ShpDer,1) - OutData%QPtw_Shp_ShpDer(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_ShpDer_ShpDer_Jac 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%QPtw_ShpDer_ShpDer_Jac)) DEALLOCATE(OutData%QPtw_ShpDer_ShpDer_Jac) - ALLOCATE(OutData%QPtw_ShpDer_ShpDer_Jac(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%QPtw_ShpDer_ShpDer_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,4), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,4) - DO i3 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,3), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,3) - DO i2 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,2), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,2) - DO i1 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,1), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,1) - OutData%QPtw_ShpDer_ShpDer_Jac(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_Jac 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%QPtw_Shp_Jac)) DEALLOCATE(OutData%QPtw_Shp_Jac) - ALLOCATE(OutData%QPtw_Shp_Jac(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%QPtw_Shp_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%QPtw_Shp_Jac,3), UBOUND(OutData%QPtw_Shp_Jac,3) - DO i2 = LBOUND(OutData%QPtw_Shp_Jac,2), UBOUND(OutData%QPtw_Shp_Jac,2) - DO i1 = LBOUND(OutData%QPtw_Shp_Jac,1), UBOUND(OutData%QPtw_Shp_Jac,1) - OutData%QPtw_Shp_Jac(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_ShpDer 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%QPtw_ShpDer)) DEALLOCATE(OutData%QPtw_ShpDer) - ALLOCATE(OutData%QPtw_ShpDer(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%QPtw_ShpDer,2), UBOUND(OutData%QPtw_ShpDer,2) - DO i1 = LBOUND(OutData%QPtw_ShpDer,1), UBOUND(OutData%QPtw_ShpDer,1) - OutData%QPtw_ShpDer(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FEweight 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%FEweight)) DEALLOCATE(OutData%FEweight) - ALLOCATE(OutData%FEweight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FEweight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FEweight,2), UBOUND(OutData%FEweight,2) - DO i1 = LBOUND(OutData%FEweight,1), UBOUND(OutData%FEweight,1) - OutData%FEweight(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx 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%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du 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%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%dx,1) - i1_u = UBOUND(OutData%dx,1) - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) - Int_Xferred = Int_Xferred + 1 - OutData%RelStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RelStates) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_UnPackParam - - SUBROUTINE BD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(BD_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 = 'BD_CopyInput' -! + ErrMsg = '' + if (allocated(SrcContStateData%q)) then + LB(1:2) = lbound(SrcContStateData%q) + UB(1:2) = ubound(SrcContStateData%q) + if (.not. allocated(DstContStateData%q)) then + allocate(DstContStateData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%q.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%q = SrcContStateData%q + end if + if (allocated(SrcContStateData%dqdt)) then + LB(1:2) = lbound(SrcContStateData%dqdt) + UB(1:2) = ubound(SrcContStateData%dqdt) + if (.not. allocated(DstContStateData%dqdt)) then + allocate(DstContStateData%dqdt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%dqdt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%dqdt = SrcContStateData%dqdt + end if +end subroutine + +subroutine BD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(BD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%RootMotion, DstInputData%RootMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%PointLoad, DstInputData%PointLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%DistrLoad, DstInputData%DistrLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%HubMotion, DstInputData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE BD_CopyInput - - SUBROUTINE BD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(BD_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 = 'BD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( InputData%RootMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%PointLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%DistrLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%HubMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE BD_DestroyInput - - SUBROUTINE BD_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(BD_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 = 'BD_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! RootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%RootMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! RootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RootMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RootMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RootMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! PointLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%PointLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PointLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PointLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PointLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PointLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DistrLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%DistrLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DistrLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DistrLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DistrLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DistrLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubMotion - 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 - - CALL MeshPack( InData%RootMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! RootMotion - 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 - CALL MeshPack( InData%PointLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PointLoad - 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 - CALL MeshPack( InData%DistrLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DistrLoad - 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 - CALL MeshPack( InData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubMotion - 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 BD_PackInput - - SUBROUTINE BD_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(BD_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 = 'BD_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 - 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 MeshUnpack( OutData%RootMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! RootMotion - 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) - 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 MeshUnpack( OutData%PointLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PointLoad - 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) - 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 MeshUnpack( OutData%DistrLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! DistrLoad - 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) - 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 MeshUnpack( OutData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubMotion - 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 BD_UnPackInput - - SUBROUTINE BD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(BD_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 = 'BD_CopyOutput' -! + ErrMsg = '' + if (allocated(ContStateData%q)) then + deallocate(ContStateData%q) + end if + if (allocated(ContStateData%dqdt)) then + deallocate(ContStateData%dqdt) + end if +end subroutine + +subroutine BD_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%q)) + if (allocated(InData%q)) then + call RegPackBounds(Buf, 2, lbound(InData%q), ubound(InData%q)) + call RegPack(Buf, InData%q) + end if + call RegPack(Buf, allocated(InData%dqdt)) + if (allocated(InData%dqdt)) then + call RegPackBounds(Buf, 2, lbound(InData%dqdt), ubound(InData%dqdt)) + call RegPack(Buf, InData%dqdt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackContState' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%q)) deallocate(OutData%q) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%q(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%q) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dqdt)) deallocate(OutData%dqdt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dqdt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dqdt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dqdt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine BD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(BD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(BD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%ReactionForce, DstOutputData%ReactionForce, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%BldMotion, DstOutputData%BldMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstOutputData%RootMxr = SrcOutputData%RootMxr - DstOutputData%RootMyr = SrcOutputData%RootMyr -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 BD_CopyOutput - - SUBROUTINE BD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(BD_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 = 'BD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%ReactionForce, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%BldMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE BD_DestroyOutput - - SUBROUTINE BD_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(BD_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 = 'BD_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! ReactionForce: size of buffers for each call to pack subtype - CALL MeshPack( InData%ReactionForce, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ReactionForce - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ReactionForce - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ReactionForce - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ReactionForce - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! BldMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%BldMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BldMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BldMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BldMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BldMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! RootMxr - Re_BufSz = Re_BufSz + 1 ! RootMyr - 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 - - CALL MeshPack( InData%ReactionForce, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ReactionForce - 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 - CALL MeshPack( InData%BldMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BldMotion - 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%RootMxr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RootMyr - Re_Xferred = Re_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 BD_PackOutput - - SUBROUTINE BD_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(BD_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 = 'BD_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 - 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 MeshUnpack( OutData%ReactionForce, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ReactionForce - 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) - 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 MeshUnpack( OutData%BldMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BldMotion - 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%RootMxr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RootMyr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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 BD_UnPackOutput - - SUBROUTINE BD_CopyEqMotionQP( SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, ErrStat, ErrMsg ) - TYPE(EqMotionQP), INTENT(IN) :: SrcEqMotionQPData - TYPE(EqMotionQP), INTENT(INOUT) :: DstEqMotionQPData - 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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyEqMotionQP' -! + ErrMsg = '' + DstDiscStateData%thetaP = SrcDiscStateData%thetaP + DstDiscStateData%thetaPD = SrcDiscStateData%thetaPD +end subroutine + +subroutine BD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(BD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcEqMotionQPData%uuu)) THEN - i1_l = LBOUND(SrcEqMotionQPData%uuu,1) - i1_u = UBOUND(SrcEqMotionQPData%uuu,1) - i2_l = LBOUND(SrcEqMotionQPData%uuu,2) - i2_u = UBOUND(SrcEqMotionQPData%uuu,2) - i3_l = LBOUND(SrcEqMotionQPData%uuu,3) - i3_u = UBOUND(SrcEqMotionQPData%uuu,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%uuu)) THEN - ALLOCATE(DstEqMotionQPData%uuu(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%uuu.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%uuu = SrcEqMotionQPData%uuu -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%uup)) THEN - i1_l = LBOUND(SrcEqMotionQPData%uup,1) - i1_u = UBOUND(SrcEqMotionQPData%uup,1) - i2_l = LBOUND(SrcEqMotionQPData%uup,2) - i2_u = UBOUND(SrcEqMotionQPData%uup,2) - i3_l = LBOUND(SrcEqMotionQPData%uup,3) - i3_u = UBOUND(SrcEqMotionQPData%uup,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%uup)) THEN - ALLOCATE(DstEqMotionQPData%uup(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%uup.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%uup = SrcEqMotionQPData%uup -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%vvv)) THEN - i1_l = LBOUND(SrcEqMotionQPData%vvv,1) - i1_u = UBOUND(SrcEqMotionQPData%vvv,1) - i2_l = LBOUND(SrcEqMotionQPData%vvv,2) - i2_u = UBOUND(SrcEqMotionQPData%vvv,2) - i3_l = LBOUND(SrcEqMotionQPData%vvv,3) - i3_u = UBOUND(SrcEqMotionQPData%vvv,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%vvv)) THEN - ALLOCATE(DstEqMotionQPData%vvv(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%vvv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%vvv = SrcEqMotionQPData%vvv -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%vvp)) THEN - i1_l = LBOUND(SrcEqMotionQPData%vvp,1) - i1_u = UBOUND(SrcEqMotionQPData%vvp,1) - i2_l = LBOUND(SrcEqMotionQPData%vvp,2) - i2_u = UBOUND(SrcEqMotionQPData%vvp,2) - i3_l = LBOUND(SrcEqMotionQPData%vvp,3) - i3_u = UBOUND(SrcEqMotionQPData%vvp,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%vvp)) THEN - ALLOCATE(DstEqMotionQPData%vvp(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%vvp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%vvp = SrcEqMotionQPData%vvp -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%aaa)) THEN - i1_l = LBOUND(SrcEqMotionQPData%aaa,1) - i1_u = UBOUND(SrcEqMotionQPData%aaa,1) - i2_l = LBOUND(SrcEqMotionQPData%aaa,2) - i2_u = UBOUND(SrcEqMotionQPData%aaa,2) - i3_l = LBOUND(SrcEqMotionQPData%aaa,3) - i3_u = UBOUND(SrcEqMotionQPData%aaa,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%aaa)) THEN - ALLOCATE(DstEqMotionQPData%aaa(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%aaa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%aaa = SrcEqMotionQPData%aaa -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%RR0)) THEN - i1_l = LBOUND(SrcEqMotionQPData%RR0,1) - i1_u = UBOUND(SrcEqMotionQPData%RR0,1) - i2_l = LBOUND(SrcEqMotionQPData%RR0,2) - i2_u = UBOUND(SrcEqMotionQPData%RR0,2) - i3_l = LBOUND(SrcEqMotionQPData%RR0,3) - i3_u = UBOUND(SrcEqMotionQPData%RR0,3) - i4_l = LBOUND(SrcEqMotionQPData%RR0,4) - i4_u = UBOUND(SrcEqMotionQPData%RR0,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%RR0)) THEN - ALLOCATE(DstEqMotionQPData%RR0(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 DstEqMotionQPData%RR0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%RR0 = SrcEqMotionQPData%RR0 -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%kappa)) THEN - i1_l = LBOUND(SrcEqMotionQPData%kappa,1) - i1_u = UBOUND(SrcEqMotionQPData%kappa,1) - i2_l = LBOUND(SrcEqMotionQPData%kappa,2) - i2_u = UBOUND(SrcEqMotionQPData%kappa,2) - i3_l = LBOUND(SrcEqMotionQPData%kappa,3) - i3_u = UBOUND(SrcEqMotionQPData%kappa,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%kappa)) THEN - ALLOCATE(DstEqMotionQPData%kappa(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%kappa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%kappa = SrcEqMotionQPData%kappa -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%E1)) THEN - i1_l = LBOUND(SrcEqMotionQPData%E1,1) - i1_u = UBOUND(SrcEqMotionQPData%E1,1) - i2_l = LBOUND(SrcEqMotionQPData%E1,2) - i2_u = UBOUND(SrcEqMotionQPData%E1,2) - i3_l = LBOUND(SrcEqMotionQPData%E1,3) - i3_u = UBOUND(SrcEqMotionQPData%E1,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%E1)) THEN - ALLOCATE(DstEqMotionQPData%E1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%E1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%E1 = SrcEqMotionQPData%E1 -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Stif)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Stif,1) - i1_u = UBOUND(SrcEqMotionQPData%Stif,1) - i2_l = LBOUND(SrcEqMotionQPData%Stif,2) - i2_u = UBOUND(SrcEqMotionQPData%Stif,2) - i3_l = LBOUND(SrcEqMotionQPData%Stif,3) - i3_u = UBOUND(SrcEqMotionQPData%Stif,3) - i4_l = LBOUND(SrcEqMotionQPData%Stif,4) - i4_u = UBOUND(SrcEqMotionQPData%Stif,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Stif)) THEN - ALLOCATE(DstEqMotionQPData%Stif(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 DstEqMotionQPData%Stif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Stif = SrcEqMotionQPData%Stif -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Fb)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Fb,1) - i1_u = UBOUND(SrcEqMotionQPData%Fb,1) - i2_l = LBOUND(SrcEqMotionQPData%Fb,2) - i2_u = UBOUND(SrcEqMotionQPData%Fb,2) - i3_l = LBOUND(SrcEqMotionQPData%Fb,3) - i3_u = UBOUND(SrcEqMotionQPData%Fb,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Fb)) THEN - ALLOCATE(DstEqMotionQPData%Fb(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Fb = SrcEqMotionQPData%Fb -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Fc)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Fc,1) - i1_u = UBOUND(SrcEqMotionQPData%Fc,1) - i2_l = LBOUND(SrcEqMotionQPData%Fc,2) - i2_u = UBOUND(SrcEqMotionQPData%Fc,2) - i3_l = LBOUND(SrcEqMotionQPData%Fc,3) - i3_u = UBOUND(SrcEqMotionQPData%Fc,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Fc)) THEN - ALLOCATE(DstEqMotionQPData%Fc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Fc = SrcEqMotionQPData%Fc -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Fd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Fd,1) - i1_u = UBOUND(SrcEqMotionQPData%Fd,1) - i2_l = LBOUND(SrcEqMotionQPData%Fd,2) - i2_u = UBOUND(SrcEqMotionQPData%Fd,2) - i3_l = LBOUND(SrcEqMotionQPData%Fd,3) - i3_u = UBOUND(SrcEqMotionQPData%Fd,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Fd)) THEN - ALLOCATE(DstEqMotionQPData%Fd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Fd = SrcEqMotionQPData%Fd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Fg)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Fg,1) - i1_u = UBOUND(SrcEqMotionQPData%Fg,1) - i2_l = LBOUND(SrcEqMotionQPData%Fg,2) - i2_u = UBOUND(SrcEqMotionQPData%Fg,2) - i3_l = LBOUND(SrcEqMotionQPData%Fg,3) - i3_u = UBOUND(SrcEqMotionQPData%Fg,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Fg)) THEN - ALLOCATE(DstEqMotionQPData%Fg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Fg = SrcEqMotionQPData%Fg -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Fi)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Fi,1) - i1_u = UBOUND(SrcEqMotionQPData%Fi,1) - i2_l = LBOUND(SrcEqMotionQPData%Fi,2) - i2_u = UBOUND(SrcEqMotionQPData%Fi,2) - i3_l = LBOUND(SrcEqMotionQPData%Fi,3) - i3_u = UBOUND(SrcEqMotionQPData%Fi,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Fi)) THEN - ALLOCATE(DstEqMotionQPData%Fi(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Fi = SrcEqMotionQPData%Fi -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Ftemp)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Ftemp,1) - i1_u = UBOUND(SrcEqMotionQPData%Ftemp,1) - i2_l = LBOUND(SrcEqMotionQPData%Ftemp,2) - i2_u = UBOUND(SrcEqMotionQPData%Ftemp,2) - i3_l = LBOUND(SrcEqMotionQPData%Ftemp,3) - i3_u = UBOUND(SrcEqMotionQPData%Ftemp,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Ftemp)) THEN - ALLOCATE(DstEqMotionQPData%Ftemp(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Ftemp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Ftemp = SrcEqMotionQPData%Ftemp -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%RR0mEta)) THEN - i1_l = LBOUND(SrcEqMotionQPData%RR0mEta,1) - i1_u = UBOUND(SrcEqMotionQPData%RR0mEta,1) - i2_l = LBOUND(SrcEqMotionQPData%RR0mEta,2) - i2_u = UBOUND(SrcEqMotionQPData%RR0mEta,2) - i3_l = LBOUND(SrcEqMotionQPData%RR0mEta,3) - i3_u = UBOUND(SrcEqMotionQPData%RR0mEta,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%RR0mEta)) THEN - ALLOCATE(DstEqMotionQPData%RR0mEta(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%RR0mEta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%RR0mEta = SrcEqMotionQPData%RR0mEta -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%rho)) THEN - i1_l = LBOUND(SrcEqMotionQPData%rho,1) - i1_u = UBOUND(SrcEqMotionQPData%rho,1) - i2_l = LBOUND(SrcEqMotionQPData%rho,2) - i2_u = UBOUND(SrcEqMotionQPData%rho,2) - i3_l = LBOUND(SrcEqMotionQPData%rho,3) - i3_u = UBOUND(SrcEqMotionQPData%rho,3) - i4_l = LBOUND(SrcEqMotionQPData%rho,4) - i4_u = UBOUND(SrcEqMotionQPData%rho,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%rho)) THEN - ALLOCATE(DstEqMotionQPData%rho(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 DstEqMotionQPData%rho.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%rho = SrcEqMotionQPData%rho -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%betaC)) THEN - i1_l = LBOUND(SrcEqMotionQPData%betaC,1) - i1_u = UBOUND(SrcEqMotionQPData%betaC,1) - i2_l = LBOUND(SrcEqMotionQPData%betaC,2) - i2_u = UBOUND(SrcEqMotionQPData%betaC,2) - i3_l = LBOUND(SrcEqMotionQPData%betaC,3) - i3_u = UBOUND(SrcEqMotionQPData%betaC,3) - i4_l = LBOUND(SrcEqMotionQPData%betaC,4) - i4_u = UBOUND(SrcEqMotionQPData%betaC,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%betaC)) THEN - ALLOCATE(DstEqMotionQPData%betaC(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 DstEqMotionQPData%betaC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%betaC = SrcEqMotionQPData%betaC -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Gi)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Gi,1) - i1_u = UBOUND(SrcEqMotionQPData%Gi,1) - i2_l = LBOUND(SrcEqMotionQPData%Gi,2) - i2_u = UBOUND(SrcEqMotionQPData%Gi,2) - i3_l = LBOUND(SrcEqMotionQPData%Gi,3) - i3_u = UBOUND(SrcEqMotionQPData%Gi,3) - i4_l = LBOUND(SrcEqMotionQPData%Gi,4) - i4_u = UBOUND(SrcEqMotionQPData%Gi,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Gi)) THEN - ALLOCATE(DstEqMotionQPData%Gi(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 DstEqMotionQPData%Gi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Gi = SrcEqMotionQPData%Gi -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Ki)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Ki,1) - i1_u = UBOUND(SrcEqMotionQPData%Ki,1) - i2_l = LBOUND(SrcEqMotionQPData%Ki,2) - i2_u = UBOUND(SrcEqMotionQPData%Ki,2) - i3_l = LBOUND(SrcEqMotionQPData%Ki,3) - i3_u = UBOUND(SrcEqMotionQPData%Ki,3) - i4_l = LBOUND(SrcEqMotionQPData%Ki,4) - i4_u = UBOUND(SrcEqMotionQPData%Ki,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Ki)) THEN - ALLOCATE(DstEqMotionQPData%Ki(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 DstEqMotionQPData%Ki.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Ki = SrcEqMotionQPData%Ki -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Mi)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Mi,1) - i1_u = UBOUND(SrcEqMotionQPData%Mi,1) - i2_l = LBOUND(SrcEqMotionQPData%Mi,2) - i2_u = UBOUND(SrcEqMotionQPData%Mi,2) - i3_l = LBOUND(SrcEqMotionQPData%Mi,3) - i3_u = UBOUND(SrcEqMotionQPData%Mi,3) - i4_l = LBOUND(SrcEqMotionQPData%Mi,4) - i4_u = UBOUND(SrcEqMotionQPData%Mi,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Mi)) THEN - ALLOCATE(DstEqMotionQPData%Mi(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 DstEqMotionQPData%Mi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Mi = SrcEqMotionQPData%Mi -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Oe)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Oe,1) - i1_u = UBOUND(SrcEqMotionQPData%Oe,1) - i2_l = LBOUND(SrcEqMotionQPData%Oe,2) - i2_u = UBOUND(SrcEqMotionQPData%Oe,2) - i3_l = LBOUND(SrcEqMotionQPData%Oe,3) - i3_u = UBOUND(SrcEqMotionQPData%Oe,3) - i4_l = LBOUND(SrcEqMotionQPData%Oe,4) - i4_u = UBOUND(SrcEqMotionQPData%Oe,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Oe)) THEN - ALLOCATE(DstEqMotionQPData%Oe(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 DstEqMotionQPData%Oe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Oe = SrcEqMotionQPData%Oe -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Pe)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Pe,1) - i1_u = UBOUND(SrcEqMotionQPData%Pe,1) - i2_l = LBOUND(SrcEqMotionQPData%Pe,2) - i2_u = UBOUND(SrcEqMotionQPData%Pe,2) - i3_l = LBOUND(SrcEqMotionQPData%Pe,3) - i3_u = UBOUND(SrcEqMotionQPData%Pe,3) - i4_l = LBOUND(SrcEqMotionQPData%Pe,4) - i4_u = UBOUND(SrcEqMotionQPData%Pe,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Pe)) THEN - ALLOCATE(DstEqMotionQPData%Pe(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 DstEqMotionQPData%Pe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Pe = SrcEqMotionQPData%Pe -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Qe)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Qe,1) - i1_u = UBOUND(SrcEqMotionQPData%Qe,1) - i2_l = LBOUND(SrcEqMotionQPData%Qe,2) - i2_u = UBOUND(SrcEqMotionQPData%Qe,2) - i3_l = LBOUND(SrcEqMotionQPData%Qe,3) - i3_u = UBOUND(SrcEqMotionQPData%Qe,3) - i4_l = LBOUND(SrcEqMotionQPData%Qe,4) - i4_u = UBOUND(SrcEqMotionQPData%Qe,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Qe)) THEN - ALLOCATE(DstEqMotionQPData%Qe(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 DstEqMotionQPData%Qe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Qe = SrcEqMotionQPData%Qe -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Gd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Gd,1) - i1_u = UBOUND(SrcEqMotionQPData%Gd,1) - i2_l = LBOUND(SrcEqMotionQPData%Gd,2) - i2_u = UBOUND(SrcEqMotionQPData%Gd,2) - i3_l = LBOUND(SrcEqMotionQPData%Gd,3) - i3_u = UBOUND(SrcEqMotionQPData%Gd,3) - i4_l = LBOUND(SrcEqMotionQPData%Gd,4) - i4_u = UBOUND(SrcEqMotionQPData%Gd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Gd)) THEN - ALLOCATE(DstEqMotionQPData%Gd(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 DstEqMotionQPData%Gd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Gd = SrcEqMotionQPData%Gd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Od)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Od,1) - i1_u = UBOUND(SrcEqMotionQPData%Od,1) - i2_l = LBOUND(SrcEqMotionQPData%Od,2) - i2_u = UBOUND(SrcEqMotionQPData%Od,2) - i3_l = LBOUND(SrcEqMotionQPData%Od,3) - i3_u = UBOUND(SrcEqMotionQPData%Od,3) - i4_l = LBOUND(SrcEqMotionQPData%Od,4) - i4_u = UBOUND(SrcEqMotionQPData%Od,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Od)) THEN - ALLOCATE(DstEqMotionQPData%Od(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 DstEqMotionQPData%Od.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Od = SrcEqMotionQPData%Od -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Pd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Pd,1) - i1_u = UBOUND(SrcEqMotionQPData%Pd,1) - i2_l = LBOUND(SrcEqMotionQPData%Pd,2) - i2_u = UBOUND(SrcEqMotionQPData%Pd,2) - i3_l = LBOUND(SrcEqMotionQPData%Pd,3) - i3_u = UBOUND(SrcEqMotionQPData%Pd,3) - i4_l = LBOUND(SrcEqMotionQPData%Pd,4) - i4_u = UBOUND(SrcEqMotionQPData%Pd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Pd)) THEN - ALLOCATE(DstEqMotionQPData%Pd(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 DstEqMotionQPData%Pd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Pd = SrcEqMotionQPData%Pd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Qd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Qd,1) - i1_u = UBOUND(SrcEqMotionQPData%Qd,1) - i2_l = LBOUND(SrcEqMotionQPData%Qd,2) - i2_u = UBOUND(SrcEqMotionQPData%Qd,2) - i3_l = LBOUND(SrcEqMotionQPData%Qd,3) - i3_u = UBOUND(SrcEqMotionQPData%Qd,3) - i4_l = LBOUND(SrcEqMotionQPData%Qd,4) - i4_u = UBOUND(SrcEqMotionQPData%Qd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Qd)) THEN - ALLOCATE(DstEqMotionQPData%Qd(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 DstEqMotionQPData%Qd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Qd = SrcEqMotionQPData%Qd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Sd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Sd,1) - i1_u = UBOUND(SrcEqMotionQPData%Sd,1) - i2_l = LBOUND(SrcEqMotionQPData%Sd,2) - i2_u = UBOUND(SrcEqMotionQPData%Sd,2) - i3_l = LBOUND(SrcEqMotionQPData%Sd,3) - i3_u = UBOUND(SrcEqMotionQPData%Sd,3) - i4_l = LBOUND(SrcEqMotionQPData%Sd,4) - i4_u = UBOUND(SrcEqMotionQPData%Sd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Sd)) THEN - ALLOCATE(DstEqMotionQPData%Sd(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 DstEqMotionQPData%Sd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Sd = SrcEqMotionQPData%Sd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Xd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Xd,1) - i1_u = UBOUND(SrcEqMotionQPData%Xd,1) - i2_l = LBOUND(SrcEqMotionQPData%Xd,2) - i2_u = UBOUND(SrcEqMotionQPData%Xd,2) - i3_l = LBOUND(SrcEqMotionQPData%Xd,3) - i3_u = UBOUND(SrcEqMotionQPData%Xd,3) - i4_l = LBOUND(SrcEqMotionQPData%Xd,4) - i4_u = UBOUND(SrcEqMotionQPData%Xd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Xd)) THEN - ALLOCATE(DstEqMotionQPData%Xd(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 DstEqMotionQPData%Xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Xd = SrcEqMotionQPData%Xd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Yd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Yd,1) - i1_u = UBOUND(SrcEqMotionQPData%Yd,1) - i2_l = LBOUND(SrcEqMotionQPData%Yd,2) - i2_u = UBOUND(SrcEqMotionQPData%Yd,2) - i3_l = LBOUND(SrcEqMotionQPData%Yd,3) - i3_u = UBOUND(SrcEqMotionQPData%Yd,3) - i4_l = LBOUND(SrcEqMotionQPData%Yd,4) - i4_u = UBOUND(SrcEqMotionQPData%Yd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Yd)) THEN - ALLOCATE(DstEqMotionQPData%Yd(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 DstEqMotionQPData%Yd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Yd = SrcEqMotionQPData%Yd -ENDIF - END SUBROUTINE BD_CopyEqMotionQP - - SUBROUTINE BD_DestroyEqMotionQP( EqMotionQPData, ErrStat, ErrMsg ) - TYPE(EqMotionQP), INTENT(INOUT) :: EqMotionQPData - 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 = 'BD_DestroyEqMotionQP' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(EqMotionQPData%uuu)) THEN - DEALLOCATE(EqMotionQPData%uuu) -ENDIF -IF (ALLOCATED(EqMotionQPData%uup)) THEN - DEALLOCATE(EqMotionQPData%uup) -ENDIF -IF (ALLOCATED(EqMotionQPData%vvv)) THEN - DEALLOCATE(EqMotionQPData%vvv) -ENDIF -IF (ALLOCATED(EqMotionQPData%vvp)) THEN - DEALLOCATE(EqMotionQPData%vvp) -ENDIF -IF (ALLOCATED(EqMotionQPData%aaa)) THEN - DEALLOCATE(EqMotionQPData%aaa) -ENDIF -IF (ALLOCATED(EqMotionQPData%RR0)) THEN - DEALLOCATE(EqMotionQPData%RR0) -ENDIF -IF (ALLOCATED(EqMotionQPData%kappa)) THEN - DEALLOCATE(EqMotionQPData%kappa) -ENDIF -IF (ALLOCATED(EqMotionQPData%E1)) THEN - DEALLOCATE(EqMotionQPData%E1) -ENDIF -IF (ALLOCATED(EqMotionQPData%Stif)) THEN - DEALLOCATE(EqMotionQPData%Stif) -ENDIF -IF (ALLOCATED(EqMotionQPData%Fb)) THEN - DEALLOCATE(EqMotionQPData%Fb) -ENDIF -IF (ALLOCATED(EqMotionQPData%Fc)) THEN - DEALLOCATE(EqMotionQPData%Fc) -ENDIF -IF (ALLOCATED(EqMotionQPData%Fd)) THEN - DEALLOCATE(EqMotionQPData%Fd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Fg)) THEN - DEALLOCATE(EqMotionQPData%Fg) -ENDIF -IF (ALLOCATED(EqMotionQPData%Fi)) THEN - DEALLOCATE(EqMotionQPData%Fi) -ENDIF -IF (ALLOCATED(EqMotionQPData%Ftemp)) THEN - DEALLOCATE(EqMotionQPData%Ftemp) -ENDIF -IF (ALLOCATED(EqMotionQPData%RR0mEta)) THEN - DEALLOCATE(EqMotionQPData%RR0mEta) -ENDIF -IF (ALLOCATED(EqMotionQPData%rho)) THEN - DEALLOCATE(EqMotionQPData%rho) -ENDIF -IF (ALLOCATED(EqMotionQPData%betaC)) THEN - DEALLOCATE(EqMotionQPData%betaC) -ENDIF -IF (ALLOCATED(EqMotionQPData%Gi)) THEN - DEALLOCATE(EqMotionQPData%Gi) -ENDIF -IF (ALLOCATED(EqMotionQPData%Ki)) THEN - DEALLOCATE(EqMotionQPData%Ki) -ENDIF -IF (ALLOCATED(EqMotionQPData%Mi)) THEN - DEALLOCATE(EqMotionQPData%Mi) -ENDIF -IF (ALLOCATED(EqMotionQPData%Oe)) THEN - DEALLOCATE(EqMotionQPData%Oe) -ENDIF -IF (ALLOCATED(EqMotionQPData%Pe)) THEN - DEALLOCATE(EqMotionQPData%Pe) -ENDIF -IF (ALLOCATED(EqMotionQPData%Qe)) THEN - DEALLOCATE(EqMotionQPData%Qe) -ENDIF -IF (ALLOCATED(EqMotionQPData%Gd)) THEN - DEALLOCATE(EqMotionQPData%Gd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Od)) THEN - DEALLOCATE(EqMotionQPData%Od) -ENDIF -IF (ALLOCATED(EqMotionQPData%Pd)) THEN - DEALLOCATE(EqMotionQPData%Pd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Qd)) THEN - DEALLOCATE(EqMotionQPData%Qd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Sd)) THEN - DEALLOCATE(EqMotionQPData%Sd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Xd)) THEN - DEALLOCATE(EqMotionQPData%Xd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Yd)) THEN - DEALLOCATE(EqMotionQPData%Yd) -ENDIF - END SUBROUTINE BD_DestroyEqMotionQP - - SUBROUTINE BD_PackEqMotionQP( 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(EqMotionQP), 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 = 'BD_PackEqMotionQP' - ! 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 ! uuu allocated yes/no - IF ( ALLOCATED(InData%uuu) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! uuu upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%uuu) ! uuu - END IF - Int_BufSz = Int_BufSz + 1 ! uup allocated yes/no - IF ( ALLOCATED(InData%uup) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! uup upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%uup) ! uup - END IF - Int_BufSz = Int_BufSz + 1 ! vvv allocated yes/no - IF ( ALLOCATED(InData%vvv) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vvv upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%vvv) ! vvv - END IF - Int_BufSz = Int_BufSz + 1 ! vvp allocated yes/no - IF ( ALLOCATED(InData%vvp) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vvp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%vvp) ! vvp - END IF - Int_BufSz = Int_BufSz + 1 ! aaa allocated yes/no - IF ( ALLOCATED(InData%aaa) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! aaa upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%aaa) ! aaa - END IF - Int_BufSz = Int_BufSz + 1 ! RR0 allocated yes/no - IF ( ALLOCATED(InData%RR0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! RR0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RR0) ! RR0 - END IF - Int_BufSz = Int_BufSz + 1 ! kappa allocated yes/no - IF ( ALLOCATED(InData%kappa) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! kappa upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%kappa) ! kappa - END IF - Int_BufSz = Int_BufSz + 1 ! E1 allocated yes/no - IF ( ALLOCATED(InData%E1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! E1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%E1) ! E1 - END IF - Int_BufSz = Int_BufSz + 1 ! Stif allocated yes/no - IF ( ALLOCATED(InData%Stif) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Stif upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Stif) ! Stif - END IF - Int_BufSz = Int_BufSz + 1 ! Fb allocated yes/no - IF ( ALLOCATED(InData%Fb) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fb upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fb) ! Fb - END IF - Int_BufSz = Int_BufSz + 1 ! Fc allocated yes/no - IF ( ALLOCATED(InData%Fc) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fc upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fc) ! Fc - END IF - Int_BufSz = Int_BufSz + 1 ! Fd allocated yes/no - IF ( ALLOCATED(InData%Fd) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fd) ! Fd - END IF - Int_BufSz = Int_BufSz + 1 ! Fg allocated yes/no - IF ( ALLOCATED(InData%Fg) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fg upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fg) ! Fg - END IF - Int_BufSz = Int_BufSz + 1 ! Fi allocated yes/no - IF ( ALLOCATED(InData%Fi) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fi upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fi) ! Fi - END IF - Int_BufSz = Int_BufSz + 1 ! Ftemp allocated yes/no - IF ( ALLOCATED(InData%Ftemp) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Ftemp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ftemp) ! Ftemp - END IF - Int_BufSz = Int_BufSz + 1 ! RR0mEta allocated yes/no - IF ( ALLOCATED(InData%RR0mEta) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! RR0mEta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RR0mEta) ! RR0mEta - END IF - Int_BufSz = Int_BufSz + 1 ! rho allocated yes/no - IF ( ALLOCATED(InData%rho) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! rho upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rho) ! rho - END IF - Int_BufSz = Int_BufSz + 1 ! betaC allocated yes/no - IF ( ALLOCATED(InData%betaC) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! betaC upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%betaC) ! betaC - END IF - Int_BufSz = Int_BufSz + 1 ! Gi allocated yes/no - IF ( ALLOCATED(InData%Gi) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Gi upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Gi) ! Gi - END IF - Int_BufSz = Int_BufSz + 1 ! Ki allocated yes/no - IF ( ALLOCATED(InData%Ki) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Ki upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ki) ! Ki - END IF - Int_BufSz = Int_BufSz + 1 ! Mi allocated yes/no - IF ( ALLOCATED(InData%Mi) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Mi upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Mi) ! Mi - END IF - Int_BufSz = Int_BufSz + 1 ! Oe allocated yes/no - IF ( ALLOCATED(InData%Oe) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Oe upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Oe) ! Oe - END IF - Int_BufSz = Int_BufSz + 1 ! Pe allocated yes/no - IF ( ALLOCATED(InData%Pe) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Pe upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Pe) ! Pe - END IF - Int_BufSz = Int_BufSz + 1 ! Qe allocated yes/no - IF ( ALLOCATED(InData%Qe) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Qe upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Qe) ! Qe - END IF - Int_BufSz = Int_BufSz + 1 ! Gd allocated yes/no - IF ( ALLOCATED(InData%Gd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Gd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Gd) ! Gd - END IF - Int_BufSz = Int_BufSz + 1 ! Od allocated yes/no - IF ( ALLOCATED(InData%Od) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Od upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Od) ! Od - END IF - Int_BufSz = Int_BufSz + 1 ! Pd allocated yes/no - IF ( ALLOCATED(InData%Pd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Pd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Pd) ! Pd - END IF - Int_BufSz = Int_BufSz + 1 ! Qd allocated yes/no - IF ( ALLOCATED(InData%Qd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Qd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Qd) ! Qd - END IF - Int_BufSz = Int_BufSz + 1 ! Sd allocated yes/no - IF ( ALLOCATED(InData%Sd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Sd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Sd) ! Sd - END IF - Int_BufSz = Int_BufSz + 1 ! Xd allocated yes/no - IF ( ALLOCATED(InData%Xd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Xd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Xd) ! Xd - END IF - Int_BufSz = Int_BufSz + 1 ! Yd allocated yes/no - IF ( ALLOCATED(InData%Yd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Yd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Yd) ! Yd - 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%uuu) ) 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%uuu,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuu,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuu,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuu,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuu,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuu,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%uuu,3), UBOUND(InData%uuu,3) - DO i2 = LBOUND(InData%uuu,2), UBOUND(InData%uuu,2) - DO i1 = LBOUND(InData%uuu,1), UBOUND(InData%uuu,1) - DbKiBuf(Db_Xferred) = InData%uuu(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uup) ) 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%uup,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uup,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uup,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uup,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uup,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uup,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%uup,3), UBOUND(InData%uup,3) - DO i2 = LBOUND(InData%uup,2), UBOUND(InData%uup,2) - DO i1 = LBOUND(InData%uup,1), UBOUND(InData%uup,1) - DbKiBuf(Db_Xferred) = InData%uup(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vvv) ) 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%vvv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvv,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvv,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvv,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvv,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvv,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vvv,3), UBOUND(InData%vvv,3) - DO i2 = LBOUND(InData%vvv,2), UBOUND(InData%vvv,2) - DO i1 = LBOUND(InData%vvv,1), UBOUND(InData%vvv,1) - DbKiBuf(Db_Xferred) = InData%vvv(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vvp) ) 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%vvp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvp,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvp,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvp,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vvp,3), UBOUND(InData%vvp,3) - DO i2 = LBOUND(InData%vvp,2), UBOUND(InData%vvp,2) - DO i1 = LBOUND(InData%vvp,1), UBOUND(InData%vvp,1) - DbKiBuf(Db_Xferred) = InData%vvp(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%aaa) ) 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%aaa,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%aaa,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%aaa,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%aaa,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%aaa,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%aaa,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%aaa,3), UBOUND(InData%aaa,3) - DO i2 = LBOUND(InData%aaa,2), UBOUND(InData%aaa,2) - DO i1 = LBOUND(InData%aaa,1), UBOUND(InData%aaa,1) - DbKiBuf(Db_Xferred) = InData%aaa(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RR0) ) 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%RR0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%RR0,4), UBOUND(InData%RR0,4) - DO i3 = LBOUND(InData%RR0,3), UBOUND(InData%RR0,3) - DO i2 = LBOUND(InData%RR0,2), UBOUND(InData%RR0,2) - DO i1 = LBOUND(InData%RR0,1), UBOUND(InData%RR0,1) - DbKiBuf(Db_Xferred) = InData%RR0(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%kappa) ) 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%kappa,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kappa,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kappa,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kappa,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kappa,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kappa,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%kappa,3), UBOUND(InData%kappa,3) - DO i2 = LBOUND(InData%kappa,2), UBOUND(InData%kappa,2) - DO i1 = LBOUND(InData%kappa,1), UBOUND(InData%kappa,1) - DbKiBuf(Db_Xferred) = InData%kappa(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%E1) ) 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%E1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%E1,3), UBOUND(InData%E1,3) - DO i2 = LBOUND(InData%E1,2), UBOUND(InData%E1,2) - DO i1 = LBOUND(InData%E1,1), UBOUND(InData%E1,1) - DbKiBuf(Db_Xferred) = InData%E1(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Stif) ) 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%Stif,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Stif,4), UBOUND(InData%Stif,4) - DO i3 = LBOUND(InData%Stif,3), UBOUND(InData%Stif,3) - DO i2 = LBOUND(InData%Stif,2), UBOUND(InData%Stif,2) - DO i1 = LBOUND(InData%Stif,1), UBOUND(InData%Stif,1) - DbKiBuf(Db_Xferred) = InData%Stif(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fb) ) 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%Fb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fb,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fb,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fb,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fb,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fb,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fb,3), UBOUND(InData%Fb,3) - DO i2 = LBOUND(InData%Fb,2), UBOUND(InData%Fb,2) - DO i1 = LBOUND(InData%Fb,1), UBOUND(InData%Fb,1) - DbKiBuf(Db_Xferred) = InData%Fb(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fc) ) 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%Fc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fc,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fc,3), UBOUND(InData%Fc,3) - DO i2 = LBOUND(InData%Fc,2), UBOUND(InData%Fc,2) - DO i1 = LBOUND(InData%Fc,1), UBOUND(InData%Fc,1) - DbKiBuf(Db_Xferred) = InData%Fc(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fd) ) 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%Fd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fd,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fd,3), UBOUND(InData%Fd,3) - DO i2 = LBOUND(InData%Fd,2), UBOUND(InData%Fd,2) - DO i1 = LBOUND(InData%Fd,1), UBOUND(InData%Fd,1) - DbKiBuf(Db_Xferred) = InData%Fd(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fg) ) 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%Fg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fg,3), UBOUND(InData%Fg,3) - DO i2 = LBOUND(InData%Fg,2), UBOUND(InData%Fg,2) - DO i1 = LBOUND(InData%Fg,1), UBOUND(InData%Fg,1) - DbKiBuf(Db_Xferred) = InData%Fg(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fi) ) 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%Fi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fi,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fi,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fi,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fi,3), UBOUND(InData%Fi,3) - DO i2 = LBOUND(InData%Fi,2), UBOUND(InData%Fi,2) - DO i1 = LBOUND(InData%Fi,1), UBOUND(InData%Fi,1) - DbKiBuf(Db_Xferred) = InData%Fi(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ftemp) ) 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%Ftemp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ftemp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ftemp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ftemp,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ftemp,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ftemp,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Ftemp,3), UBOUND(InData%Ftemp,3) - DO i2 = LBOUND(InData%Ftemp,2), UBOUND(InData%Ftemp,2) - DO i1 = LBOUND(InData%Ftemp,1), UBOUND(InData%Ftemp,1) - DbKiBuf(Db_Xferred) = InData%Ftemp(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RR0mEta) ) 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%RR0mEta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0mEta,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0mEta,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0mEta,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0mEta,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0mEta,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%RR0mEta,3), UBOUND(InData%RR0mEta,3) - DO i2 = LBOUND(InData%RR0mEta,2), UBOUND(InData%RR0mEta,2) - DO i1 = LBOUND(InData%RR0mEta,1), UBOUND(InData%RR0mEta,1) - DbKiBuf(Db_Xferred) = InData%RR0mEta(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rho) ) 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%rho,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rho,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rho,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rho,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rho,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rho,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rho,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rho,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%rho,4), UBOUND(InData%rho,4) - DO i3 = LBOUND(InData%rho,3), UBOUND(InData%rho,3) - DO i2 = LBOUND(InData%rho,2), UBOUND(InData%rho,2) - DO i1 = LBOUND(InData%rho,1), UBOUND(InData%rho,1) - DbKiBuf(Db_Xferred) = InData%rho(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%betaC) ) 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%betaC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%betaC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%betaC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%betaC,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%betaC,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%betaC,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%betaC,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%betaC,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%betaC,4), UBOUND(InData%betaC,4) - DO i3 = LBOUND(InData%betaC,3), UBOUND(InData%betaC,3) - DO i2 = LBOUND(InData%betaC,2), UBOUND(InData%betaC,2) - DO i1 = LBOUND(InData%betaC,1), UBOUND(InData%betaC,1) - DbKiBuf(Db_Xferred) = InData%betaC(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gi) ) 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%Gi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gi,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gi,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gi,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gi,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gi,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Gi,4), UBOUND(InData%Gi,4) - DO i3 = LBOUND(InData%Gi,3), UBOUND(InData%Gi,3) - DO i2 = LBOUND(InData%Gi,2), UBOUND(InData%Gi,2) - DO i1 = LBOUND(InData%Gi,1), UBOUND(InData%Gi,1) - DbKiBuf(Db_Xferred) = InData%Gi(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ki) ) 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%Ki,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ki,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ki,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ki,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ki,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ki,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ki,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ki,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Ki,4), UBOUND(InData%Ki,4) - DO i3 = LBOUND(InData%Ki,3), UBOUND(InData%Ki,3) - DO i2 = LBOUND(InData%Ki,2), UBOUND(InData%Ki,2) - DO i1 = LBOUND(InData%Ki,1), UBOUND(InData%Ki,1) - DbKiBuf(Db_Xferred) = InData%Ki(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mi) ) 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%Mi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mi,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mi,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mi,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mi,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mi,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Mi,4), UBOUND(InData%Mi,4) - DO i3 = LBOUND(InData%Mi,3), UBOUND(InData%Mi,3) - DO i2 = LBOUND(InData%Mi,2), UBOUND(InData%Mi,2) - DO i1 = LBOUND(InData%Mi,1), UBOUND(InData%Mi,1) - DbKiBuf(Db_Xferred) = InData%Mi(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Oe) ) 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%Oe,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Oe,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Oe,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Oe,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Oe,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Oe,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Oe,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Oe,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Oe,4), UBOUND(InData%Oe,4) - DO i3 = LBOUND(InData%Oe,3), UBOUND(InData%Oe,3) - DO i2 = LBOUND(InData%Oe,2), UBOUND(InData%Oe,2) - DO i1 = LBOUND(InData%Oe,1), UBOUND(InData%Oe,1) - DbKiBuf(Db_Xferred) = InData%Oe(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pe) ) 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%Pe,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pe,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pe,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pe,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pe,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pe,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pe,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pe,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Pe,4), UBOUND(InData%Pe,4) - DO i3 = LBOUND(InData%Pe,3), UBOUND(InData%Pe,3) - DO i2 = LBOUND(InData%Pe,2), UBOUND(InData%Pe,2) - DO i1 = LBOUND(InData%Pe,1), UBOUND(InData%Pe,1) - DbKiBuf(Db_Xferred) = InData%Pe(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Qe) ) 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%Qe,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qe,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qe,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qe,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qe,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qe,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qe,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qe,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Qe,4), UBOUND(InData%Qe,4) - DO i3 = LBOUND(InData%Qe,3), UBOUND(InData%Qe,3) - DO i2 = LBOUND(InData%Qe,2), UBOUND(InData%Qe,2) - DO i1 = LBOUND(InData%Qe,1), UBOUND(InData%Qe,1) - DbKiBuf(Db_Xferred) = InData%Qe(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gd) ) 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%Gd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Gd,4), UBOUND(InData%Gd,4) - DO i3 = LBOUND(InData%Gd,3), UBOUND(InData%Gd,3) - DO i2 = LBOUND(InData%Gd,2), UBOUND(InData%Gd,2) - DO i1 = LBOUND(InData%Gd,1), UBOUND(InData%Gd,1) - DbKiBuf(Db_Xferred) = InData%Gd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Od) ) 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%Od,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Od,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Od,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Od,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Od,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Od,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Od,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Od,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Od,4), UBOUND(InData%Od,4) - DO i3 = LBOUND(InData%Od,3), UBOUND(InData%Od,3) - DO i2 = LBOUND(InData%Od,2), UBOUND(InData%Od,2) - DO i1 = LBOUND(InData%Od,1), UBOUND(InData%Od,1) - DbKiBuf(Db_Xferred) = InData%Od(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pd) ) 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%Pd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Pd,4), UBOUND(InData%Pd,4) - DO i3 = LBOUND(InData%Pd,3), UBOUND(InData%Pd,3) - DO i2 = LBOUND(InData%Pd,2), UBOUND(InData%Pd,2) - DO i1 = LBOUND(InData%Pd,1), UBOUND(InData%Pd,1) - DbKiBuf(Db_Xferred) = InData%Pd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Qd) ) 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%Qd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Qd,4), UBOUND(InData%Qd,4) - DO i3 = LBOUND(InData%Qd,3), UBOUND(InData%Qd,3) - DO i2 = LBOUND(InData%Qd,2), UBOUND(InData%Qd,2) - DO i1 = LBOUND(InData%Qd,1), UBOUND(InData%Qd,1) - DbKiBuf(Db_Xferred) = InData%Qd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Sd) ) 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%Sd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Sd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Sd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Sd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Sd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Sd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Sd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Sd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Sd,4), UBOUND(InData%Sd,4) - DO i3 = LBOUND(InData%Sd,3), UBOUND(InData%Sd,3) - DO i2 = LBOUND(InData%Sd,2), UBOUND(InData%Sd,2) - DO i1 = LBOUND(InData%Sd,1), UBOUND(InData%Sd,1) - DbKiBuf(Db_Xferred) = InData%Sd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Xd) ) 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%Xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Xd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Xd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Xd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Xd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Xd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Xd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Xd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Xd,4), UBOUND(InData%Xd,4) - DO i3 = LBOUND(InData%Xd,3), UBOUND(InData%Xd,3) - DO i2 = LBOUND(InData%Xd,2), UBOUND(InData%Xd,2) - DO i1 = LBOUND(InData%Xd,1), UBOUND(InData%Xd,1) - DbKiBuf(Db_Xferred) = InData%Xd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Yd) ) 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%Yd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Yd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Yd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Yd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Yd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Yd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Yd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Yd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Yd,4), UBOUND(InData%Yd,4) - DO i3 = LBOUND(InData%Yd,3), UBOUND(InData%Yd,3) - DO i2 = LBOUND(InData%Yd,2), UBOUND(InData%Yd,2) - DO i1 = LBOUND(InData%Yd,1), UBOUND(InData%Yd,1) - DbKiBuf(Db_Xferred) = InData%Yd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - END SUBROUTINE BD_PackEqMotionQP - - SUBROUTINE BD_UnPackEqMotionQP( 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(EqMotionQP), 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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackEqMotionQP' - ! 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 ! uuu 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%uuu)) DEALLOCATE(OutData%uuu) - ALLOCATE(OutData%uuu(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%uuu.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%uuu,3), UBOUND(OutData%uuu,3) - DO i2 = LBOUND(OutData%uuu,2), UBOUND(OutData%uuu,2) - DO i1 = LBOUND(OutData%uuu,1), UBOUND(OutData%uuu,1) - OutData%uuu(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uup 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%uup)) DEALLOCATE(OutData%uup) - ALLOCATE(OutData%uup(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%uup.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%uup,3), UBOUND(OutData%uup,3) - DO i2 = LBOUND(OutData%uup,2), UBOUND(OutData%uup,2) - DO i1 = LBOUND(OutData%uup,1), UBOUND(OutData%uup,1) - OutData%uup(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vvv 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%vvv)) DEALLOCATE(OutData%vvv) - ALLOCATE(OutData%vvv(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%vvv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vvv,3), UBOUND(OutData%vvv,3) - DO i2 = LBOUND(OutData%vvv,2), UBOUND(OutData%vvv,2) - DO i1 = LBOUND(OutData%vvv,1), UBOUND(OutData%vvv,1) - OutData%vvv(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vvp 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%vvp)) DEALLOCATE(OutData%vvp) - ALLOCATE(OutData%vvp(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%vvp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vvp,3), UBOUND(OutData%vvp,3) - DO i2 = LBOUND(OutData%vvp,2), UBOUND(OutData%vvp,2) - DO i1 = LBOUND(OutData%vvp,1), UBOUND(OutData%vvp,1) - OutData%vvp(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! aaa 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%aaa)) DEALLOCATE(OutData%aaa) - ALLOCATE(OutData%aaa(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%aaa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%aaa,3), UBOUND(OutData%aaa,3) - DO i2 = LBOUND(OutData%aaa,2), UBOUND(OutData%aaa,2) - DO i1 = LBOUND(OutData%aaa,1), UBOUND(OutData%aaa,1) - OutData%aaa(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RR0 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%RR0)) DEALLOCATE(OutData%RR0) - ALLOCATE(OutData%RR0(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%RR0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%RR0,4), UBOUND(OutData%RR0,4) - DO i3 = LBOUND(OutData%RR0,3), UBOUND(OutData%RR0,3) - DO i2 = LBOUND(OutData%RR0,2), UBOUND(OutData%RR0,2) - DO i1 = LBOUND(OutData%RR0,1), UBOUND(OutData%RR0,1) - OutData%RR0(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kappa 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%kappa)) DEALLOCATE(OutData%kappa) - ALLOCATE(OutData%kappa(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%kappa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%kappa,3), UBOUND(OutData%kappa,3) - DO i2 = LBOUND(OutData%kappa,2), UBOUND(OutData%kappa,2) - DO i1 = LBOUND(OutData%kappa,1), UBOUND(OutData%kappa,1) - OutData%kappa(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! E1 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%E1)) DEALLOCATE(OutData%E1) - ALLOCATE(OutData%E1(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%E1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%E1,3), UBOUND(OutData%E1,3) - DO i2 = LBOUND(OutData%E1,2), UBOUND(OutData%E1,2) - DO i1 = LBOUND(OutData%E1,1), UBOUND(OutData%E1,1) - OutData%E1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stif 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%Stif)) DEALLOCATE(OutData%Stif) - ALLOCATE(OutData%Stif(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%Stif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Stif,4), UBOUND(OutData%Stif,4) - DO i3 = LBOUND(OutData%Stif,3), UBOUND(OutData%Stif,3) - DO i2 = LBOUND(OutData%Stif,2), UBOUND(OutData%Stif,2) - DO i1 = LBOUND(OutData%Stif,1), UBOUND(OutData%Stif,1) - OutData%Stif(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fb 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%Fb)) DEALLOCATE(OutData%Fb) - ALLOCATE(OutData%Fb(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%Fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fb,3), UBOUND(OutData%Fb,3) - DO i2 = LBOUND(OutData%Fb,2), UBOUND(OutData%Fb,2) - DO i1 = LBOUND(OutData%Fb,1), UBOUND(OutData%Fb,1) - OutData%Fb(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fc 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%Fc)) DEALLOCATE(OutData%Fc) - ALLOCATE(OutData%Fc(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%Fc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fc,3), UBOUND(OutData%Fc,3) - DO i2 = LBOUND(OutData%Fc,2), UBOUND(OutData%Fc,2) - DO i1 = LBOUND(OutData%Fc,1), UBOUND(OutData%Fc,1) - OutData%Fc(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fd 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%Fd)) DEALLOCATE(OutData%Fd) - ALLOCATE(OutData%Fd(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%Fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fd,3), UBOUND(OutData%Fd,3) - DO i2 = LBOUND(OutData%Fd,2), UBOUND(OutData%Fd,2) - DO i1 = LBOUND(OutData%Fd,1), UBOUND(OutData%Fd,1) - OutData%Fd(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fg 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%Fg)) DEALLOCATE(OutData%Fg) - ALLOCATE(OutData%Fg(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%Fg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fg,3), UBOUND(OutData%Fg,3) - DO i2 = LBOUND(OutData%Fg,2), UBOUND(OutData%Fg,2) - DO i1 = LBOUND(OutData%Fg,1), UBOUND(OutData%Fg,1) - OutData%Fg(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fi 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%Fi)) DEALLOCATE(OutData%Fi) - ALLOCATE(OutData%Fi(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%Fi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fi,3), UBOUND(OutData%Fi,3) - DO i2 = LBOUND(OutData%Fi,2), UBOUND(OutData%Fi,2) - DO i1 = LBOUND(OutData%Fi,1), UBOUND(OutData%Fi,1) - OutData%Fi(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ftemp 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%Ftemp)) DEALLOCATE(OutData%Ftemp) - ALLOCATE(OutData%Ftemp(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%Ftemp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Ftemp,3), UBOUND(OutData%Ftemp,3) - DO i2 = LBOUND(OutData%Ftemp,2), UBOUND(OutData%Ftemp,2) - DO i1 = LBOUND(OutData%Ftemp,1), UBOUND(OutData%Ftemp,1) - OutData%Ftemp(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RR0mEta 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%RR0mEta)) DEALLOCATE(OutData%RR0mEta) - ALLOCATE(OutData%RR0mEta(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%RR0mEta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%RR0mEta,3), UBOUND(OutData%RR0mEta,3) - DO i2 = LBOUND(OutData%RR0mEta,2), UBOUND(OutData%RR0mEta,2) - DO i1 = LBOUND(OutData%RR0mEta,1), UBOUND(OutData%RR0mEta,1) - OutData%RR0mEta(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rho 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%rho)) DEALLOCATE(OutData%rho) - ALLOCATE(OutData%rho(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%rho.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%rho,4), UBOUND(OutData%rho,4) - DO i3 = LBOUND(OutData%rho,3), UBOUND(OutData%rho,3) - DO i2 = LBOUND(OutData%rho,2), UBOUND(OutData%rho,2) - DO i1 = LBOUND(OutData%rho,1), UBOUND(OutData%rho,1) - OutData%rho(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! betaC 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%betaC)) DEALLOCATE(OutData%betaC) - ALLOCATE(OutData%betaC(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%betaC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%betaC,4), UBOUND(OutData%betaC,4) - DO i3 = LBOUND(OutData%betaC,3), UBOUND(OutData%betaC,3) - DO i2 = LBOUND(OutData%betaC,2), UBOUND(OutData%betaC,2) - DO i1 = LBOUND(OutData%betaC,1), UBOUND(OutData%betaC,1) - OutData%betaC(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gi 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%Gi)) DEALLOCATE(OutData%Gi) - ALLOCATE(OutData%Gi(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%Gi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Gi,4), UBOUND(OutData%Gi,4) - DO i3 = LBOUND(OutData%Gi,3), UBOUND(OutData%Gi,3) - DO i2 = LBOUND(OutData%Gi,2), UBOUND(OutData%Gi,2) - DO i1 = LBOUND(OutData%Gi,1), UBOUND(OutData%Gi,1) - OutData%Gi(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ki 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%Ki)) DEALLOCATE(OutData%Ki) - ALLOCATE(OutData%Ki(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%Ki.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Ki,4), UBOUND(OutData%Ki,4) - DO i3 = LBOUND(OutData%Ki,3), UBOUND(OutData%Ki,3) - DO i2 = LBOUND(OutData%Ki,2), UBOUND(OutData%Ki,2) - DO i1 = LBOUND(OutData%Ki,1), UBOUND(OutData%Ki,1) - OutData%Ki(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mi 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%Mi)) DEALLOCATE(OutData%Mi) - ALLOCATE(OutData%Mi(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%Mi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Mi,4), UBOUND(OutData%Mi,4) - DO i3 = LBOUND(OutData%Mi,3), UBOUND(OutData%Mi,3) - DO i2 = LBOUND(OutData%Mi,2), UBOUND(OutData%Mi,2) - DO i1 = LBOUND(OutData%Mi,1), UBOUND(OutData%Mi,1) - OutData%Mi(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Oe 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%Oe)) DEALLOCATE(OutData%Oe) - ALLOCATE(OutData%Oe(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%Oe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Oe,4), UBOUND(OutData%Oe,4) - DO i3 = LBOUND(OutData%Oe,3), UBOUND(OutData%Oe,3) - DO i2 = LBOUND(OutData%Oe,2), UBOUND(OutData%Oe,2) - DO i1 = LBOUND(OutData%Oe,1), UBOUND(OutData%Oe,1) - OutData%Oe(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pe 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%Pe)) DEALLOCATE(OutData%Pe) - ALLOCATE(OutData%Pe(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%Pe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Pe,4), UBOUND(OutData%Pe,4) - DO i3 = LBOUND(OutData%Pe,3), UBOUND(OutData%Pe,3) - DO i2 = LBOUND(OutData%Pe,2), UBOUND(OutData%Pe,2) - DO i1 = LBOUND(OutData%Pe,1), UBOUND(OutData%Pe,1) - OutData%Pe(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Qe 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%Qe)) DEALLOCATE(OutData%Qe) - ALLOCATE(OutData%Qe(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%Qe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Qe,4), UBOUND(OutData%Qe,4) - DO i3 = LBOUND(OutData%Qe,3), UBOUND(OutData%Qe,3) - DO i2 = LBOUND(OutData%Qe,2), UBOUND(OutData%Qe,2) - DO i1 = LBOUND(OutData%Qe,1), UBOUND(OutData%Qe,1) - OutData%Qe(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gd 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%Gd)) DEALLOCATE(OutData%Gd) - ALLOCATE(OutData%Gd(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%Gd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Gd,4), UBOUND(OutData%Gd,4) - DO i3 = LBOUND(OutData%Gd,3), UBOUND(OutData%Gd,3) - DO i2 = LBOUND(OutData%Gd,2), UBOUND(OutData%Gd,2) - DO i1 = LBOUND(OutData%Gd,1), UBOUND(OutData%Gd,1) - OutData%Gd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Od 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%Od)) DEALLOCATE(OutData%Od) - ALLOCATE(OutData%Od(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%Od.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Od,4), UBOUND(OutData%Od,4) - DO i3 = LBOUND(OutData%Od,3), UBOUND(OutData%Od,3) - DO i2 = LBOUND(OutData%Od,2), UBOUND(OutData%Od,2) - DO i1 = LBOUND(OutData%Od,1), UBOUND(OutData%Od,1) - OutData%Od(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pd 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%Pd)) DEALLOCATE(OutData%Pd) - ALLOCATE(OutData%Pd(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%Pd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Pd,4), UBOUND(OutData%Pd,4) - DO i3 = LBOUND(OutData%Pd,3), UBOUND(OutData%Pd,3) - DO i2 = LBOUND(OutData%Pd,2), UBOUND(OutData%Pd,2) - DO i1 = LBOUND(OutData%Pd,1), UBOUND(OutData%Pd,1) - OutData%Pd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Qd 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%Qd)) DEALLOCATE(OutData%Qd) - ALLOCATE(OutData%Qd(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%Qd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Qd,4), UBOUND(OutData%Qd,4) - DO i3 = LBOUND(OutData%Qd,3), UBOUND(OutData%Qd,3) - DO i2 = LBOUND(OutData%Qd,2), UBOUND(OutData%Qd,2) - DO i1 = LBOUND(OutData%Qd,1), UBOUND(OutData%Qd,1) - OutData%Qd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Sd 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%Sd)) DEALLOCATE(OutData%Sd) - ALLOCATE(OutData%Sd(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%Sd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Sd,4), UBOUND(OutData%Sd,4) - DO i3 = LBOUND(OutData%Sd,3), UBOUND(OutData%Sd,3) - DO i2 = LBOUND(OutData%Sd,2), UBOUND(OutData%Sd,2) - DO i1 = LBOUND(OutData%Sd,1), UBOUND(OutData%Sd,1) - OutData%Sd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Xd 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%Xd)) DEALLOCATE(OutData%Xd) - ALLOCATE(OutData%Xd(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%Xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Xd,4), UBOUND(OutData%Xd,4) - DO i3 = LBOUND(OutData%Xd,3), UBOUND(OutData%Xd,3) - DO i2 = LBOUND(OutData%Xd,2), UBOUND(OutData%Xd,2) - DO i1 = LBOUND(OutData%Xd,1), UBOUND(OutData%Xd,1) - OutData%Xd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Yd 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%Yd)) DEALLOCATE(OutData%Yd) - ALLOCATE(OutData%Yd(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%Yd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Yd,4), UBOUND(OutData%Yd,4) - DO i3 = LBOUND(OutData%Yd,3), UBOUND(OutData%Yd,3) - DO i2 = LBOUND(OutData%Yd,2), UBOUND(OutData%Yd,2) - DO i1 = LBOUND(OutData%Yd,1), UBOUND(OutData%Yd,1) - OutData%Yd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - END SUBROUTINE BD_UnPackEqMotionQP - - SUBROUTINE BD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(BD_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) :: 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_CopyMisc' -! + ErrMsg = '' +end subroutine + +subroutine BD_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%thetaP) + call RegPack(Buf, InData%thetaPD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%thetaP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%thetaPD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(BD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(BD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcMiscData%u_DistrLoad_at_y, DstMiscData%u_DistrLoad_at_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcMiscData%y_BldMotion_at_u, DstMiscData%y_BldMotion_at_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%Map_u_DistrLoad_to_y, DstMiscData%Map_u_DistrLoad_to_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%Map_y_BldMotion_to_u, DstMiscData%Map_y_BldMotion_to_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%Un_Sum = SrcMiscData%Un_Sum - CALL BD_Copyeqmotionqp( SrcMiscData%qp, DstMiscData%qp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%lin_A)) THEN - i1_l = LBOUND(SrcMiscData%lin_A,1) - i1_u = UBOUND(SrcMiscData%lin_A,1) - i2_l = LBOUND(SrcMiscData%lin_A,2) - i2_u = UBOUND(SrcMiscData%lin_A,2) - IF (.NOT. ALLOCATED(DstMiscData%lin_A)) THEN - ALLOCATE(DstMiscData%lin_A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%lin_A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%lin_A = SrcMiscData%lin_A -ENDIF -IF (ALLOCATED(SrcMiscData%lin_C)) THEN - i1_l = LBOUND(SrcMiscData%lin_C,1) - i1_u = UBOUND(SrcMiscData%lin_C,1) - i2_l = LBOUND(SrcMiscData%lin_C,2) - i2_u = UBOUND(SrcMiscData%lin_C,2) - IF (.NOT. ALLOCATED(DstMiscData%lin_C)) THEN - ALLOCATE(DstMiscData%lin_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%lin_C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%lin_C = SrcMiscData%lin_C -ENDIF -IF (ALLOCATED(SrcMiscData%Nrrr)) THEN - i1_l = LBOUND(SrcMiscData%Nrrr,1) - i1_u = UBOUND(SrcMiscData%Nrrr,1) - i2_l = LBOUND(SrcMiscData%Nrrr,2) - i2_u = UBOUND(SrcMiscData%Nrrr,2) - i3_l = LBOUND(SrcMiscData%Nrrr,3) - i3_u = UBOUND(SrcMiscData%Nrrr,3) - IF (.NOT. ALLOCATED(DstMiscData%Nrrr)) THEN - ALLOCATE(DstMiscData%Nrrr(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Nrrr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Nrrr = SrcMiscData%Nrrr -ENDIF -IF (ALLOCATED(SrcMiscData%elf)) THEN - i1_l = LBOUND(SrcMiscData%elf,1) - i1_u = UBOUND(SrcMiscData%elf,1) - i2_l = LBOUND(SrcMiscData%elf,2) - i2_u = UBOUND(SrcMiscData%elf,2) - IF (.NOT. ALLOCATED(DstMiscData%elf)) THEN - ALLOCATE(DstMiscData%elf(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%elf = SrcMiscData%elf -ENDIF -IF (ALLOCATED(SrcMiscData%EFint)) THEN - i1_l = LBOUND(SrcMiscData%EFint,1) - i1_u = UBOUND(SrcMiscData%EFint,1) - i2_l = LBOUND(SrcMiscData%EFint,2) - i2_u = UBOUND(SrcMiscData%EFint,2) - i3_l = LBOUND(SrcMiscData%EFint,3) - i3_u = UBOUND(SrcMiscData%EFint,3) - IF (.NOT. ALLOCATED(DstMiscData%EFint)) THEN - ALLOCATE(DstMiscData%EFint(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%EFint.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%EFint = SrcMiscData%EFint -ENDIF -IF (ALLOCATED(SrcMiscData%elk)) THEN - i1_l = LBOUND(SrcMiscData%elk,1) - i1_u = UBOUND(SrcMiscData%elk,1) - i2_l = LBOUND(SrcMiscData%elk,2) - i2_u = UBOUND(SrcMiscData%elk,2) - i3_l = LBOUND(SrcMiscData%elk,3) - i3_u = UBOUND(SrcMiscData%elk,3) - i4_l = LBOUND(SrcMiscData%elk,4) - i4_u = UBOUND(SrcMiscData%elk,4) - IF (.NOT. ALLOCATED(DstMiscData%elk)) THEN - ALLOCATE(DstMiscData%elk(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 DstMiscData%elk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%elk = SrcMiscData%elk -ENDIF -IF (ALLOCATED(SrcMiscData%elg)) THEN - i1_l = LBOUND(SrcMiscData%elg,1) - i1_u = UBOUND(SrcMiscData%elg,1) - i2_l = LBOUND(SrcMiscData%elg,2) - i2_u = UBOUND(SrcMiscData%elg,2) - i3_l = LBOUND(SrcMiscData%elg,3) - i3_u = UBOUND(SrcMiscData%elg,3) - i4_l = LBOUND(SrcMiscData%elg,4) - i4_u = UBOUND(SrcMiscData%elg,4) - IF (.NOT. ALLOCATED(DstMiscData%elg)) THEN - ALLOCATE(DstMiscData%elg(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 DstMiscData%elg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%elg = SrcMiscData%elg -ENDIF -IF (ALLOCATED(SrcMiscData%elm)) THEN - i1_l = LBOUND(SrcMiscData%elm,1) - i1_u = UBOUND(SrcMiscData%elm,1) - i2_l = LBOUND(SrcMiscData%elm,2) - i2_u = UBOUND(SrcMiscData%elm,2) - i3_l = LBOUND(SrcMiscData%elm,3) - i3_u = UBOUND(SrcMiscData%elm,3) - i4_l = LBOUND(SrcMiscData%elm,4) - i4_u = UBOUND(SrcMiscData%elm,4) - IF (.NOT. ALLOCATED(DstMiscData%elm)) THEN - ALLOCATE(DstMiscData%elm(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 DstMiscData%elm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%elm = SrcMiscData%elm -ENDIF -IF (ALLOCATED(SrcMiscData%DistrLoad_QP)) THEN - i1_l = LBOUND(SrcMiscData%DistrLoad_QP,1) - i1_u = UBOUND(SrcMiscData%DistrLoad_QP,1) - i2_l = LBOUND(SrcMiscData%DistrLoad_QP,2) - i2_u = UBOUND(SrcMiscData%DistrLoad_QP,2) - i3_l = LBOUND(SrcMiscData%DistrLoad_QP,3) - i3_u = UBOUND(SrcMiscData%DistrLoad_QP,3) - IF (.NOT. ALLOCATED(DstMiscData%DistrLoad_QP)) THEN - ALLOCATE(DstMiscData%DistrLoad_QP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DistrLoad_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DistrLoad_QP = SrcMiscData%DistrLoad_QP -ENDIF -IF (ALLOCATED(SrcMiscData%PointLoadLcl)) THEN - i1_l = LBOUND(SrcMiscData%PointLoadLcl,1) - i1_u = UBOUND(SrcMiscData%PointLoadLcl,1) - i2_l = LBOUND(SrcMiscData%PointLoadLcl,2) - i2_u = UBOUND(SrcMiscData%PointLoadLcl,2) - IF (.NOT. ALLOCATED(DstMiscData%PointLoadLcl)) THEN - ALLOCATE(DstMiscData%PointLoadLcl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointLoadLcl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%PointLoadLcl = SrcMiscData%PointLoadLcl -ENDIF -IF (ALLOCATED(SrcMiscData%StifK)) THEN - i1_l = LBOUND(SrcMiscData%StifK,1) - i1_u = UBOUND(SrcMiscData%StifK,1) - i2_l = LBOUND(SrcMiscData%StifK,2) - i2_u = UBOUND(SrcMiscData%StifK,2) - i3_l = LBOUND(SrcMiscData%StifK,3) - i3_u = UBOUND(SrcMiscData%StifK,3) - i4_l = LBOUND(SrcMiscData%StifK,4) - i4_u = UBOUND(SrcMiscData%StifK,4) - IF (.NOT. ALLOCATED(DstMiscData%StifK)) THEN - ALLOCATE(DstMiscData%StifK(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 DstMiscData%StifK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%StifK = SrcMiscData%StifK -ENDIF -IF (ALLOCATED(SrcMiscData%MassM)) THEN - i1_l = LBOUND(SrcMiscData%MassM,1) - i1_u = UBOUND(SrcMiscData%MassM,1) - i2_l = LBOUND(SrcMiscData%MassM,2) - i2_u = UBOUND(SrcMiscData%MassM,2) - i3_l = LBOUND(SrcMiscData%MassM,3) - i3_u = UBOUND(SrcMiscData%MassM,3) - i4_l = LBOUND(SrcMiscData%MassM,4) - i4_u = UBOUND(SrcMiscData%MassM,4) - IF (.NOT. ALLOCATED(DstMiscData%MassM)) THEN - ALLOCATE(DstMiscData%MassM(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 DstMiscData%MassM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%MassM = SrcMiscData%MassM -ENDIF -IF (ALLOCATED(SrcMiscData%DampG)) THEN - i1_l = LBOUND(SrcMiscData%DampG,1) - i1_u = UBOUND(SrcMiscData%DampG,1) - i2_l = LBOUND(SrcMiscData%DampG,2) - i2_u = UBOUND(SrcMiscData%DampG,2) - i3_l = LBOUND(SrcMiscData%DampG,3) - i3_u = UBOUND(SrcMiscData%DampG,3) - i4_l = LBOUND(SrcMiscData%DampG,4) - i4_u = UBOUND(SrcMiscData%DampG,4) - IF (.NOT. ALLOCATED(DstMiscData%DampG)) THEN - ALLOCATE(DstMiscData%DampG(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 DstMiscData%DampG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DampG = SrcMiscData%DampG -ENDIF -IF (ALLOCATED(SrcMiscData%StifK_fd)) THEN - i1_l = LBOUND(SrcMiscData%StifK_fd,1) - i1_u = UBOUND(SrcMiscData%StifK_fd,1) - i2_l = LBOUND(SrcMiscData%StifK_fd,2) - i2_u = UBOUND(SrcMiscData%StifK_fd,2) - i3_l = LBOUND(SrcMiscData%StifK_fd,3) - i3_u = UBOUND(SrcMiscData%StifK_fd,3) - i4_l = LBOUND(SrcMiscData%StifK_fd,4) - i4_u = UBOUND(SrcMiscData%StifK_fd,4) - IF (.NOT. ALLOCATED(DstMiscData%StifK_fd)) THEN - ALLOCATE(DstMiscData%StifK_fd(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 DstMiscData%StifK_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%StifK_fd = SrcMiscData%StifK_fd -ENDIF -IF (ALLOCATED(SrcMiscData%MassM_fd)) THEN - i1_l = LBOUND(SrcMiscData%MassM_fd,1) - i1_u = UBOUND(SrcMiscData%MassM_fd,1) - i2_l = LBOUND(SrcMiscData%MassM_fd,2) - i2_u = UBOUND(SrcMiscData%MassM_fd,2) - i3_l = LBOUND(SrcMiscData%MassM_fd,3) - i3_u = UBOUND(SrcMiscData%MassM_fd,3) - i4_l = LBOUND(SrcMiscData%MassM_fd,4) - i4_u = UBOUND(SrcMiscData%MassM_fd,4) - IF (.NOT. ALLOCATED(DstMiscData%MassM_fd)) THEN - ALLOCATE(DstMiscData%MassM_fd(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 DstMiscData%MassM_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%MassM_fd = SrcMiscData%MassM_fd -ENDIF -IF (ALLOCATED(SrcMiscData%DampG_fd)) THEN - i1_l = LBOUND(SrcMiscData%DampG_fd,1) - i1_u = UBOUND(SrcMiscData%DampG_fd,1) - i2_l = LBOUND(SrcMiscData%DampG_fd,2) - i2_u = UBOUND(SrcMiscData%DampG_fd,2) - i3_l = LBOUND(SrcMiscData%DampG_fd,3) - i3_u = UBOUND(SrcMiscData%DampG_fd,3) - i4_l = LBOUND(SrcMiscData%DampG_fd,4) - i4_u = UBOUND(SrcMiscData%DampG_fd,4) - IF (.NOT. ALLOCATED(DstMiscData%DampG_fd)) THEN - ALLOCATE(DstMiscData%DampG_fd(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 DstMiscData%DampG_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DampG_fd = SrcMiscData%DampG_fd -ENDIF -IF (ALLOCATED(SrcMiscData%RHS)) THEN - i1_l = LBOUND(SrcMiscData%RHS,1) - i1_u = UBOUND(SrcMiscData%RHS,1) - i2_l = LBOUND(SrcMiscData%RHS,2) - i2_u = UBOUND(SrcMiscData%RHS,2) - IF (.NOT. ALLOCATED(DstMiscData%RHS)) THEN - ALLOCATE(DstMiscData%RHS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RHS = SrcMiscData%RHS -ENDIF -IF (ALLOCATED(SrcMiscData%RHS_p)) THEN - i1_l = LBOUND(SrcMiscData%RHS_p,1) - i1_u = UBOUND(SrcMiscData%RHS_p,1) - i2_l = LBOUND(SrcMiscData%RHS_p,2) - i2_u = UBOUND(SrcMiscData%RHS_p,2) - IF (.NOT. ALLOCATED(DstMiscData%RHS_p)) THEN - ALLOCATE(DstMiscData%RHS_p(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS_p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RHS_p = SrcMiscData%RHS_p -ENDIF -IF (ALLOCATED(SrcMiscData%RHS_m)) THEN - i1_l = LBOUND(SrcMiscData%RHS_m,1) - i1_u = UBOUND(SrcMiscData%RHS_m,1) - i2_l = LBOUND(SrcMiscData%RHS_m,2) - i2_u = UBOUND(SrcMiscData%RHS_m,2) - IF (.NOT. ALLOCATED(DstMiscData%RHS_m)) THEN - ALLOCATE(DstMiscData%RHS_m(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS_m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RHS_m = SrcMiscData%RHS_m -ENDIF -IF (ALLOCATED(SrcMiscData%BldInternalForceFE)) THEN - i1_l = LBOUND(SrcMiscData%BldInternalForceFE,1) - i1_u = UBOUND(SrcMiscData%BldInternalForceFE,1) - i2_l = LBOUND(SrcMiscData%BldInternalForceFE,2) - i2_u = UBOUND(SrcMiscData%BldInternalForceFE,2) - IF (.NOT. ALLOCATED(DstMiscData%BldInternalForceFE)) THEN - ALLOCATE(DstMiscData%BldInternalForceFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BldInternalForceFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BldInternalForceFE = SrcMiscData%BldInternalForceFE -ENDIF -IF (ALLOCATED(SrcMiscData%BldInternalForceQP)) THEN - i1_l = LBOUND(SrcMiscData%BldInternalForceQP,1) - i1_u = UBOUND(SrcMiscData%BldInternalForceQP,1) - i2_l = LBOUND(SrcMiscData%BldInternalForceQP,2) - i2_u = UBOUND(SrcMiscData%BldInternalForceQP,2) - IF (.NOT. ALLOCATED(DstMiscData%BldInternalForceQP)) THEN - ALLOCATE(DstMiscData%BldInternalForceQP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BldInternalForceQP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BldInternalForceQP = SrcMiscData%BldInternalForceQP -ENDIF -IF (ALLOCATED(SrcMiscData%FirstNodeReactionLclForceMoment)) THEN - i1_l = LBOUND(SrcMiscData%FirstNodeReactionLclForceMoment,1) - i1_u = UBOUND(SrcMiscData%FirstNodeReactionLclForceMoment,1) - IF (.NOT. ALLOCATED(DstMiscData%FirstNodeReactionLclForceMoment)) THEN - ALLOCATE(DstMiscData%FirstNodeReactionLclForceMoment(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FirstNodeReactionLclForceMoment.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FirstNodeReactionLclForceMoment = SrcMiscData%FirstNodeReactionLclForceMoment -ENDIF -IF (ALLOCATED(SrcMiscData%Solution)) THEN - i1_l = LBOUND(SrcMiscData%Solution,1) - i1_u = UBOUND(SrcMiscData%Solution,1) - i2_l = LBOUND(SrcMiscData%Solution,2) - i2_u = UBOUND(SrcMiscData%Solution,2) - IF (.NOT. ALLOCATED(DstMiscData%Solution)) THEN - ALLOCATE(DstMiscData%Solution(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Solution.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Solution = SrcMiscData%Solution -ENDIF -IF (ALLOCATED(SrcMiscData%LP_StifK)) THEN - i1_l = LBOUND(SrcMiscData%LP_StifK,1) - i1_u = UBOUND(SrcMiscData%LP_StifK,1) - i2_l = LBOUND(SrcMiscData%LP_StifK,2) - i2_u = UBOUND(SrcMiscData%LP_StifK,2) - IF (.NOT. ALLOCATED(DstMiscData%LP_StifK)) THEN - ALLOCATE(DstMiscData%LP_StifK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_StifK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_StifK = SrcMiscData%LP_StifK -ENDIF -IF (ALLOCATED(SrcMiscData%LP_MassM)) THEN - i1_l = LBOUND(SrcMiscData%LP_MassM,1) - i1_u = UBOUND(SrcMiscData%LP_MassM,1) - i2_l = LBOUND(SrcMiscData%LP_MassM,2) - i2_u = UBOUND(SrcMiscData%LP_MassM,2) - IF (.NOT. ALLOCATED(DstMiscData%LP_MassM)) THEN - ALLOCATE(DstMiscData%LP_MassM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_MassM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_MassM = SrcMiscData%LP_MassM -ENDIF -IF (ALLOCATED(SrcMiscData%LP_MassM_LU)) THEN - i1_l = LBOUND(SrcMiscData%LP_MassM_LU,1) - i1_u = UBOUND(SrcMiscData%LP_MassM_LU,1) - i2_l = LBOUND(SrcMiscData%LP_MassM_LU,2) - i2_u = UBOUND(SrcMiscData%LP_MassM_LU,2) - IF (.NOT. ALLOCATED(DstMiscData%LP_MassM_LU)) THEN - ALLOCATE(DstMiscData%LP_MassM_LU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_MassM_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_MassM_LU = SrcMiscData%LP_MassM_LU -ENDIF -IF (ALLOCATED(SrcMiscData%LP_RHS)) THEN - i1_l = LBOUND(SrcMiscData%LP_RHS,1) - i1_u = UBOUND(SrcMiscData%LP_RHS,1) - IF (.NOT. ALLOCATED(DstMiscData%LP_RHS)) THEN - ALLOCATE(DstMiscData%LP_RHS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_RHS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_RHS = SrcMiscData%LP_RHS -ENDIF -IF (ALLOCATED(SrcMiscData%LP_StifK_LU)) THEN - i1_l = LBOUND(SrcMiscData%LP_StifK_LU,1) - i1_u = UBOUND(SrcMiscData%LP_StifK_LU,1) - i2_l = LBOUND(SrcMiscData%LP_StifK_LU,2) - i2_u = UBOUND(SrcMiscData%LP_StifK_LU,2) - IF (.NOT. ALLOCATED(DstMiscData%LP_StifK_LU)) THEN - ALLOCATE(DstMiscData%LP_StifK_LU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_StifK_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_StifK_LU = SrcMiscData%LP_StifK_LU -ENDIF -IF (ALLOCATED(SrcMiscData%LP_RHS_LU)) THEN - i1_l = LBOUND(SrcMiscData%LP_RHS_LU,1) - i1_u = UBOUND(SrcMiscData%LP_RHS_LU,1) - IF (.NOT. ALLOCATED(DstMiscData%LP_RHS_LU)) THEN - ALLOCATE(DstMiscData%LP_RHS_LU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_RHS_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_RHS_LU = SrcMiscData%LP_RHS_LU -ENDIF -IF (ALLOCATED(SrcMiscData%LP_indx)) THEN - i1_l = LBOUND(SrcMiscData%LP_indx,1) - i1_u = UBOUND(SrcMiscData%LP_indx,1) - IF (.NOT. ALLOCATED(DstMiscData%LP_indx)) THEN - ALLOCATE(DstMiscData%LP_indx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_indx = SrcMiscData%LP_indx -ENDIF - CALL BD_CopyInput( SrcMiscData%u, DstMiscData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL BD_CopyInput( SrcMiscData%u2, DstMiscData%u2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE BD_CopyMisc - - SUBROUTINE BD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(BD_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 = 'BD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%lin_A)) THEN - DEALLOCATE(MiscData%lin_A) -ENDIF -IF (ALLOCATED(MiscData%lin_C)) THEN - DEALLOCATE(MiscData%lin_C) -ENDIF -IF (ALLOCATED(MiscData%Nrrr)) THEN - DEALLOCATE(MiscData%Nrrr) -ENDIF -IF (ALLOCATED(MiscData%elf)) THEN - DEALLOCATE(MiscData%elf) -ENDIF -IF (ALLOCATED(MiscData%EFint)) THEN - DEALLOCATE(MiscData%EFint) -ENDIF -IF (ALLOCATED(MiscData%elk)) THEN - DEALLOCATE(MiscData%elk) -ENDIF -IF (ALLOCATED(MiscData%elg)) THEN - DEALLOCATE(MiscData%elg) -ENDIF -IF (ALLOCATED(MiscData%elm)) THEN - DEALLOCATE(MiscData%elm) -ENDIF -IF (ALLOCATED(MiscData%DistrLoad_QP)) THEN - DEALLOCATE(MiscData%DistrLoad_QP) -ENDIF -IF (ALLOCATED(MiscData%PointLoadLcl)) THEN - DEALLOCATE(MiscData%PointLoadLcl) -ENDIF -IF (ALLOCATED(MiscData%StifK)) THEN - DEALLOCATE(MiscData%StifK) -ENDIF -IF (ALLOCATED(MiscData%MassM)) THEN - DEALLOCATE(MiscData%MassM) -ENDIF -IF (ALLOCATED(MiscData%DampG)) THEN - DEALLOCATE(MiscData%DampG) -ENDIF -IF (ALLOCATED(MiscData%StifK_fd)) THEN - DEALLOCATE(MiscData%StifK_fd) -ENDIF -IF (ALLOCATED(MiscData%MassM_fd)) THEN - DEALLOCATE(MiscData%MassM_fd) -ENDIF -IF (ALLOCATED(MiscData%DampG_fd)) THEN - DEALLOCATE(MiscData%DampG_fd) -ENDIF -IF (ALLOCATED(MiscData%RHS)) THEN - DEALLOCATE(MiscData%RHS) -ENDIF -IF (ALLOCATED(MiscData%RHS_p)) THEN - DEALLOCATE(MiscData%RHS_p) -ENDIF -IF (ALLOCATED(MiscData%RHS_m)) THEN - DEALLOCATE(MiscData%RHS_m) -ENDIF -IF (ALLOCATED(MiscData%BldInternalForceFE)) THEN - DEALLOCATE(MiscData%BldInternalForceFE) -ENDIF -IF (ALLOCATED(MiscData%BldInternalForceQP)) THEN - DEALLOCATE(MiscData%BldInternalForceQP) -ENDIF -IF (ALLOCATED(MiscData%FirstNodeReactionLclForceMoment)) THEN - DEALLOCATE(MiscData%FirstNodeReactionLclForceMoment) -ENDIF -IF (ALLOCATED(MiscData%Solution)) THEN - DEALLOCATE(MiscData%Solution) -ENDIF -IF (ALLOCATED(MiscData%LP_StifK)) THEN - DEALLOCATE(MiscData%LP_StifK) -ENDIF -IF (ALLOCATED(MiscData%LP_MassM)) THEN - DEALLOCATE(MiscData%LP_MassM) -ENDIF -IF (ALLOCATED(MiscData%LP_MassM_LU)) THEN - DEALLOCATE(MiscData%LP_MassM_LU) -ENDIF -IF (ALLOCATED(MiscData%LP_RHS)) THEN - DEALLOCATE(MiscData%LP_RHS) -ENDIF -IF (ALLOCATED(MiscData%LP_StifK_LU)) THEN - DEALLOCATE(MiscData%LP_StifK_LU) -ENDIF -IF (ALLOCATED(MiscData%LP_RHS_LU)) THEN - DEALLOCATE(MiscData%LP_RHS_LU) -ENDIF -IF (ALLOCATED(MiscData%LP_indx)) THEN - DEALLOCATE(MiscData%LP_indx) -ENDIF - CALL BD_DestroyInput( MiscData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL BD_DestroyInput( MiscData%u2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE BD_DestroyMisc - - SUBROUTINE BD_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(BD_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 = 'BD_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! u_DistrLoad_at_y: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_DistrLoad_at_y, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_DistrLoad_at_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_DistrLoad_at_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_DistrLoad_at_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_DistrLoad_at_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_BldMotion_at_u: size of buffers for each call to pack subtype - CALL MeshPack( InData%y_BldMotion_at_u, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! y_BldMotion_at_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_BldMotion_at_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_BldMotion_at_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_BldMotion_at_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Map_u_DistrLoad_to_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Map_u_DistrLoad_to_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Map_u_DistrLoad_to_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Map_y_BldMotion_to_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Map_y_BldMotion_to_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Map_y_BldMotion_to_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! qp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! qp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! qp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! lin_A allocated yes/no - IF ( ALLOCATED(InData%lin_A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! lin_A upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lin_A) ! lin_A - END IF - Int_BufSz = Int_BufSz + 1 ! lin_C allocated yes/no - IF ( ALLOCATED(InData%lin_C) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! lin_C upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lin_C) ! lin_C - END IF - Int_BufSz = Int_BufSz + 1 ! Nrrr allocated yes/no - IF ( ALLOCATED(InData%Nrrr) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Nrrr upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Nrrr) ! Nrrr - END IF - Int_BufSz = Int_BufSz + 1 ! elf allocated yes/no - IF ( ALLOCATED(InData%elf) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! elf upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%elf) ! elf - END IF - Int_BufSz = Int_BufSz + 1 ! EFint allocated yes/no - IF ( ALLOCATED(InData%EFint) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! EFint upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%EFint) ! EFint - END IF - Int_BufSz = Int_BufSz + 1 ! elk allocated yes/no - IF ( ALLOCATED(InData%elk) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! elk upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%elk) ! elk - END IF - Int_BufSz = Int_BufSz + 1 ! elg allocated yes/no - IF ( ALLOCATED(InData%elg) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! elg upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%elg) ! elg - END IF - Int_BufSz = Int_BufSz + 1 ! elm allocated yes/no - IF ( ALLOCATED(InData%elm) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! elm upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%elm) ! elm - END IF - Int_BufSz = Int_BufSz + 1 ! DistrLoad_QP allocated yes/no - IF ( ALLOCATED(InData%DistrLoad_QP) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! DistrLoad_QP upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DistrLoad_QP) ! DistrLoad_QP - END IF - Int_BufSz = Int_BufSz + 1 ! PointLoadLcl allocated yes/no - IF ( ALLOCATED(InData%PointLoadLcl) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PointLoadLcl upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PointLoadLcl) ! PointLoadLcl - END IF - Int_BufSz = Int_BufSz + 1 ! StifK allocated yes/no - IF ( ALLOCATED(InData%StifK) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! StifK upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StifK) ! StifK - END IF - Int_BufSz = Int_BufSz + 1 ! MassM allocated yes/no - IF ( ALLOCATED(InData%MassM) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! MassM upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MassM) ! MassM - END IF - Int_BufSz = Int_BufSz + 1 ! DampG allocated yes/no - IF ( ALLOCATED(InData%DampG) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! DampG upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DampG) ! DampG - END IF - Int_BufSz = Int_BufSz + 1 ! StifK_fd allocated yes/no - IF ( ALLOCATED(InData%StifK_fd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! StifK_fd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StifK_fd) ! StifK_fd - END IF - Int_BufSz = Int_BufSz + 1 ! MassM_fd allocated yes/no - IF ( ALLOCATED(InData%MassM_fd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! MassM_fd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MassM_fd) ! MassM_fd - END IF - Int_BufSz = Int_BufSz + 1 ! DampG_fd allocated yes/no - IF ( ALLOCATED(InData%DampG_fd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! DampG_fd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DampG_fd) ! DampG_fd - END IF - Int_BufSz = Int_BufSz + 1 ! RHS allocated yes/no - IF ( ALLOCATED(InData%RHS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! RHS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RHS) ! RHS - END IF - Int_BufSz = Int_BufSz + 1 ! RHS_p allocated yes/no - IF ( ALLOCATED(InData%RHS_p) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! RHS_p upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RHS_p) ! RHS_p - END IF - Int_BufSz = Int_BufSz + 1 ! RHS_m allocated yes/no - IF ( ALLOCATED(InData%RHS_m) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! RHS_m upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RHS_m) ! RHS_m - END IF - Int_BufSz = Int_BufSz + 1 ! BldInternalForceFE allocated yes/no - IF ( ALLOCATED(InData%BldInternalForceFE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldInternalForceFE upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BldInternalForceFE) ! BldInternalForceFE - END IF - Int_BufSz = Int_BufSz + 1 ! BldInternalForceQP allocated yes/no - IF ( ALLOCATED(InData%BldInternalForceQP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldInternalForceQP upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BldInternalForceQP) ! BldInternalForceQP - END IF - Int_BufSz = Int_BufSz + 1 ! FirstNodeReactionLclForceMoment allocated yes/no - IF ( ALLOCATED(InData%FirstNodeReactionLclForceMoment) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FirstNodeReactionLclForceMoment upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%FirstNodeReactionLclForceMoment) ! FirstNodeReactionLclForceMoment - END IF - Int_BufSz = Int_BufSz + 1 ! Solution allocated yes/no - IF ( ALLOCATED(InData%Solution) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Solution upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Solution) ! Solution - END IF - Int_BufSz = Int_BufSz + 1 ! LP_StifK allocated yes/no - IF ( ALLOCATED(InData%LP_StifK) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LP_StifK upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_StifK) ! LP_StifK - END IF - Int_BufSz = Int_BufSz + 1 ! LP_MassM allocated yes/no - IF ( ALLOCATED(InData%LP_MassM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LP_MassM upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_MassM) ! LP_MassM - END IF - Int_BufSz = Int_BufSz + 1 ! LP_MassM_LU allocated yes/no - IF ( ALLOCATED(InData%LP_MassM_LU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LP_MassM_LU upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_MassM_LU) ! LP_MassM_LU - END IF - Int_BufSz = Int_BufSz + 1 ! LP_RHS allocated yes/no - IF ( ALLOCATED(InData%LP_RHS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LP_RHS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_RHS) ! LP_RHS - END IF - Int_BufSz = Int_BufSz + 1 ! LP_StifK_LU allocated yes/no - IF ( ALLOCATED(InData%LP_StifK_LU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LP_StifK_LU upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_StifK_LU) ! LP_StifK_LU - END IF - Int_BufSz = Int_BufSz + 1 ! LP_RHS_LU allocated yes/no - IF ( ALLOCATED(InData%LP_RHS_LU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LP_RHS_LU upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_RHS_LU) ! LP_RHS_LU - END IF - Int_BufSz = Int_BufSz + 1 ! LP_indx allocated yes/no - IF ( ALLOCATED(InData%LP_indx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LP_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LP_indx) ! LP_indx - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u2: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u2, ErrStat2, ErrMsg2, .TRUE. ) ! u2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u2 - 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 - - CALL MeshPack( InData%u_DistrLoad_at_y, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_DistrLoad_at_y - 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 - CALL MeshPack( InData%y_BldMotion_at_u, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! y_BldMotion_at_u - 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 - 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 - - 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 - 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 - - 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%Un_Sum - Int_Xferred = Int_Xferred + 1 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%lin_A) ) 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%lin_A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lin_A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%lin_A,2), UBOUND(InData%lin_A,2) - DO i1 = LBOUND(InData%lin_A,1), UBOUND(InData%lin_A,1) - DbKiBuf(Db_Xferred) = InData%lin_A(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%lin_C) ) 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%lin_C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_C,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lin_C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%lin_C,2), UBOUND(InData%lin_C,2) - DO i1 = LBOUND(InData%lin_C,1), UBOUND(InData%lin_C,1) - DbKiBuf(Db_Xferred) = InData%lin_C(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Nrrr) ) 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%Nrrr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nrrr,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nrrr,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nrrr,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nrrr,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nrrr,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Nrrr,3), UBOUND(InData%Nrrr,3) - DO i2 = LBOUND(InData%Nrrr,2), UBOUND(InData%Nrrr,2) - DO i1 = LBOUND(InData%Nrrr,1), UBOUND(InData%Nrrr,1) - DbKiBuf(Db_Xferred) = InData%Nrrr(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%elf) ) 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%elf,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elf,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elf,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elf,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%elf,2), UBOUND(InData%elf,2) - DO i1 = LBOUND(InData%elf,1), UBOUND(InData%elf,1) - DbKiBuf(Db_Xferred) = InData%elf(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%EFint) ) 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%EFint,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EFint,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EFint,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EFint,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EFint,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EFint,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%EFint,3), UBOUND(InData%EFint,3) - DO i2 = LBOUND(InData%EFint,2), UBOUND(InData%EFint,2) - DO i1 = LBOUND(InData%EFint,1), UBOUND(InData%EFint,1) - DbKiBuf(Db_Xferred) = InData%EFint(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%elk) ) 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%elk,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elk,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elk,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elk,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elk,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elk,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elk,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elk,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%elk,4), UBOUND(InData%elk,4) - DO i3 = LBOUND(InData%elk,3), UBOUND(InData%elk,3) - DO i2 = LBOUND(InData%elk,2), UBOUND(InData%elk,2) - DO i1 = LBOUND(InData%elk,1), UBOUND(InData%elk,1) - DbKiBuf(Db_Xferred) = InData%elk(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%elg) ) 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%elg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elg,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elg,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elg,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elg,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elg,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%elg,4), UBOUND(InData%elg,4) - DO i3 = LBOUND(InData%elg,3), UBOUND(InData%elg,3) - DO i2 = LBOUND(InData%elg,2), UBOUND(InData%elg,2) - DO i1 = LBOUND(InData%elg,1), UBOUND(InData%elg,1) - DbKiBuf(Db_Xferred) = InData%elg(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%elm) ) 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%elm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elm,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elm,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elm,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elm,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elm,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elm,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elm,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%elm,4), UBOUND(InData%elm,4) - DO i3 = LBOUND(InData%elm,3), UBOUND(InData%elm,3) - DO i2 = LBOUND(InData%elm,2), UBOUND(InData%elm,2) - DO i1 = LBOUND(InData%elm,1), UBOUND(InData%elm,1) - DbKiBuf(Db_Xferred) = InData%elm(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DistrLoad_QP) ) 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%DistrLoad_QP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DistrLoad_QP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DistrLoad_QP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DistrLoad_QP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DistrLoad_QP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DistrLoad_QP,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%DistrLoad_QP,3), UBOUND(InData%DistrLoad_QP,3) - DO i2 = LBOUND(InData%DistrLoad_QP,2), UBOUND(InData%DistrLoad_QP,2) - DO i1 = LBOUND(InData%DistrLoad_QP,1), UBOUND(InData%DistrLoad_QP,1) - DbKiBuf(Db_Xferred) = InData%DistrLoad_QP(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PointLoadLcl) ) 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%PointLoadLcl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PointLoadLcl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PointLoadLcl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PointLoadLcl,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PointLoadLcl,2), UBOUND(InData%PointLoadLcl,2) - DO i1 = LBOUND(InData%PointLoadLcl,1), UBOUND(InData%PointLoadLcl,1) - DbKiBuf(Db_Xferred) = InData%PointLoadLcl(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StifK) ) 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%StifK,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%StifK,4), UBOUND(InData%StifK,4) - DO i3 = LBOUND(InData%StifK,3), UBOUND(InData%StifK,3) - DO i2 = LBOUND(InData%StifK,2), UBOUND(InData%StifK,2) - DO i1 = LBOUND(InData%StifK,1), UBOUND(InData%StifK,1) - DbKiBuf(Db_Xferred) = InData%StifK(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MassM) ) 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%MassM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%MassM,4), UBOUND(InData%MassM,4) - DO i3 = LBOUND(InData%MassM,3), UBOUND(InData%MassM,3) - DO i2 = LBOUND(InData%MassM,2), UBOUND(InData%MassM,2) - DO i1 = LBOUND(InData%MassM,1), UBOUND(InData%MassM,1) - DbKiBuf(Db_Xferred) = InData%MassM(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DampG) ) 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%DampG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%DampG,4), UBOUND(InData%DampG,4) - DO i3 = LBOUND(InData%DampG,3), UBOUND(InData%DampG,3) - DO i2 = LBOUND(InData%DampG,2), UBOUND(InData%DampG,2) - DO i1 = LBOUND(InData%DampG,1), UBOUND(InData%DampG,1) - DbKiBuf(Db_Xferred) = InData%DampG(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StifK_fd) ) 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%StifK_fd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK_fd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK_fd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK_fd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK_fd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK_fd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK_fd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK_fd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%StifK_fd,4), UBOUND(InData%StifK_fd,4) - DO i3 = LBOUND(InData%StifK_fd,3), UBOUND(InData%StifK_fd,3) - DO i2 = LBOUND(InData%StifK_fd,2), UBOUND(InData%StifK_fd,2) - DO i1 = LBOUND(InData%StifK_fd,1), UBOUND(InData%StifK_fd,1) - DbKiBuf(Db_Xferred) = InData%StifK_fd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MassM_fd) ) 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%MassM_fd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM_fd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM_fd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM_fd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM_fd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM_fd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM_fd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM_fd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%MassM_fd,4), UBOUND(InData%MassM_fd,4) - DO i3 = LBOUND(InData%MassM_fd,3), UBOUND(InData%MassM_fd,3) - DO i2 = LBOUND(InData%MassM_fd,2), UBOUND(InData%MassM_fd,2) - DO i1 = LBOUND(InData%MassM_fd,1), UBOUND(InData%MassM_fd,1) - DbKiBuf(Db_Xferred) = InData%MassM_fd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DampG_fd) ) 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%DampG_fd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG_fd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG_fd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG_fd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG_fd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG_fd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG_fd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG_fd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%DampG_fd,4), UBOUND(InData%DampG_fd,4) - DO i3 = LBOUND(InData%DampG_fd,3), UBOUND(InData%DampG_fd,3) - DO i2 = LBOUND(InData%DampG_fd,2), UBOUND(InData%DampG_fd,2) - DO i1 = LBOUND(InData%DampG_fd,1), UBOUND(InData%DampG_fd,1) - DbKiBuf(Db_Xferred) = InData%DampG_fd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RHS) ) 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%RHS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RHS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%RHS,2), UBOUND(InData%RHS,2) - DO i1 = LBOUND(InData%RHS,1), UBOUND(InData%RHS,1) - DbKiBuf(Db_Xferred) = InData%RHS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RHS_p) ) 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%RHS_p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_p,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RHS_p,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_p,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%RHS_p,2), UBOUND(InData%RHS_p,2) - DO i1 = LBOUND(InData%RHS_p,1), UBOUND(InData%RHS_p,1) - DbKiBuf(Db_Xferred) = InData%RHS_p(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RHS_m) ) 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%RHS_m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_m,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RHS_m,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_m,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%RHS_m,2), UBOUND(InData%RHS_m,2) - DO i1 = LBOUND(InData%RHS_m,1), UBOUND(InData%RHS_m,1) - DbKiBuf(Db_Xferred) = InData%RHS_m(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldInternalForceFE) ) 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%BldInternalForceFE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceFE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldInternalForceFE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceFE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldInternalForceFE,2), UBOUND(InData%BldInternalForceFE,2) - DO i1 = LBOUND(InData%BldInternalForceFE,1), UBOUND(InData%BldInternalForceFE,1) - DbKiBuf(Db_Xferred) = InData%BldInternalForceFE(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldInternalForceQP) ) 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%BldInternalForceQP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceQP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldInternalForceQP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceQP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldInternalForceQP,2), UBOUND(InData%BldInternalForceQP,2) - DO i1 = LBOUND(InData%BldInternalForceQP,1), UBOUND(InData%BldInternalForceQP,1) - DbKiBuf(Db_Xferred) = InData%BldInternalForceQP(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FirstNodeReactionLclForceMoment) ) 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%FirstNodeReactionLclForceMoment,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstNodeReactionLclForceMoment,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FirstNodeReactionLclForceMoment,1), UBOUND(InData%FirstNodeReactionLclForceMoment,1) - DbKiBuf(Db_Xferred) = InData%FirstNodeReactionLclForceMoment(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Solution) ) 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%Solution,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Solution,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Solution,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Solution,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Solution,2), UBOUND(InData%Solution,2) - DO i1 = LBOUND(InData%Solution,1), UBOUND(InData%Solution,1) - DbKiBuf(Db_Xferred) = InData%Solution(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_StifK) ) 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%LP_StifK,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_StifK,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LP_StifK,2), UBOUND(InData%LP_StifK,2) - DO i1 = LBOUND(InData%LP_StifK,1), UBOUND(InData%LP_StifK,1) - DbKiBuf(Db_Xferred) = InData%LP_StifK(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_MassM) ) 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%LP_MassM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_MassM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LP_MassM,2), UBOUND(InData%LP_MassM,2) - DO i1 = LBOUND(InData%LP_MassM,1), UBOUND(InData%LP_MassM,1) - DbKiBuf(Db_Xferred) = InData%LP_MassM(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_MassM_LU) ) 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%LP_MassM_LU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM_LU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_MassM_LU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM_LU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LP_MassM_LU,2), UBOUND(InData%LP_MassM_LU,2) - DO i1 = LBOUND(InData%LP_MassM_LU,1), UBOUND(InData%LP_MassM_LU,1) - DbKiBuf(Db_Xferred) = InData%LP_MassM_LU(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_RHS) ) 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%LP_RHS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_RHS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LP_RHS,1), UBOUND(InData%LP_RHS,1) - DbKiBuf(Db_Xferred) = InData%LP_RHS(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_StifK_LU) ) 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%LP_StifK_LU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK_LU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_StifK_LU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK_LU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LP_StifK_LU,2), UBOUND(InData%LP_StifK_LU,2) - DO i1 = LBOUND(InData%LP_StifK_LU,1), UBOUND(InData%LP_StifK_LU,1) - DbKiBuf(Db_Xferred) = InData%LP_StifK_LU(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_RHS_LU) ) 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%LP_RHS_LU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_RHS_LU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LP_RHS_LU,1), UBOUND(InData%LP_RHS_LU,1) - DbKiBuf(Db_Xferred) = InData%LP_RHS_LU(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_indx) ) 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%LP_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_indx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LP_indx,1), UBOUND(InData%LP_indx,1) - IntKiBuf(Int_Xferred) = InData%LP_indx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u2, ErrStat2, ErrMsg2, OnlySize ) ! u2 - 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 BD_PackMisc - - SUBROUTINE BD_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(BD_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) :: 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_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 - 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 MeshUnpack( OutData%u_DistrLoad_at_y, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_DistrLoad_at_y - 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) - 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 MeshUnpack( OutData%y_BldMotion_at_u, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! y_BldMotion_at_u - 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) - 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_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 - - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Un_Sum = 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 BD_UnpackEqMotionQP( Re_Buf, Db_Buf, Int_Buf, OutData%qp, ErrStat2, ErrMsg2 ) ! qp - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lin_A 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%lin_A)) DEALLOCATE(OutData%lin_A) - ALLOCATE(OutData%lin_A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%lin_A,2), UBOUND(OutData%lin_A,2) - DO i1 = LBOUND(OutData%lin_A,1), UBOUND(OutData%lin_A,1) - OutData%lin_A(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lin_C 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%lin_C)) DEALLOCATE(OutData%lin_C) - ALLOCATE(OutData%lin_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%lin_C,2), UBOUND(OutData%lin_C,2) - DO i1 = LBOUND(OutData%lin_C,1), UBOUND(OutData%lin_C,1) - OutData%lin_C(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nrrr 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%Nrrr)) DEALLOCATE(OutData%Nrrr) - ALLOCATE(OutData%Nrrr(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%Nrrr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Nrrr,3), UBOUND(OutData%Nrrr,3) - DO i2 = LBOUND(OutData%Nrrr,2), UBOUND(OutData%Nrrr,2) - DO i1 = LBOUND(OutData%Nrrr,1), UBOUND(OutData%Nrrr,1) - OutData%Nrrr(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elf 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%elf)) DEALLOCATE(OutData%elf) - ALLOCATE(OutData%elf(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%elf,2), UBOUND(OutData%elf,2) - DO i1 = LBOUND(OutData%elf,1), UBOUND(OutData%elf,1) - OutData%elf(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EFint 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%EFint)) DEALLOCATE(OutData%EFint) - ALLOCATE(OutData%EFint(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%EFint.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%EFint,3), UBOUND(OutData%EFint,3) - DO i2 = LBOUND(OutData%EFint,2), UBOUND(OutData%EFint,2) - DO i1 = LBOUND(OutData%EFint,1), UBOUND(OutData%EFint,1) - OutData%EFint(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elk 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%elk)) DEALLOCATE(OutData%elk) - ALLOCATE(OutData%elk(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%elk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%elk,4), UBOUND(OutData%elk,4) - DO i3 = LBOUND(OutData%elk,3), UBOUND(OutData%elk,3) - DO i2 = LBOUND(OutData%elk,2), UBOUND(OutData%elk,2) - DO i1 = LBOUND(OutData%elk,1), UBOUND(OutData%elk,1) - OutData%elk(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elg 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%elg)) DEALLOCATE(OutData%elg) - ALLOCATE(OutData%elg(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%elg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%elg,4), UBOUND(OutData%elg,4) - DO i3 = LBOUND(OutData%elg,3), UBOUND(OutData%elg,3) - DO i2 = LBOUND(OutData%elg,2), UBOUND(OutData%elg,2) - DO i1 = LBOUND(OutData%elg,1), UBOUND(OutData%elg,1) - OutData%elg(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elm 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%elm)) DEALLOCATE(OutData%elm) - ALLOCATE(OutData%elm(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%elm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%elm,4), UBOUND(OutData%elm,4) - DO i3 = LBOUND(OutData%elm,3), UBOUND(OutData%elm,3) - DO i2 = LBOUND(OutData%elm,2), UBOUND(OutData%elm,2) - DO i1 = LBOUND(OutData%elm,1), UBOUND(OutData%elm,1) - OutData%elm(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DistrLoad_QP 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%DistrLoad_QP)) DEALLOCATE(OutData%DistrLoad_QP) - ALLOCATE(OutData%DistrLoad_QP(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%DistrLoad_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%DistrLoad_QP,3), UBOUND(OutData%DistrLoad_QP,3) - DO i2 = LBOUND(OutData%DistrLoad_QP,2), UBOUND(OutData%DistrLoad_QP,2) - DO i1 = LBOUND(OutData%DistrLoad_QP,1), UBOUND(OutData%DistrLoad_QP,1) - OutData%DistrLoad_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PointLoadLcl 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%PointLoadLcl)) DEALLOCATE(OutData%PointLoadLcl) - ALLOCATE(OutData%PointLoadLcl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointLoadLcl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PointLoadLcl,2), UBOUND(OutData%PointLoadLcl,2) - DO i1 = LBOUND(OutData%PointLoadLcl,1), UBOUND(OutData%PointLoadLcl,1) - OutData%PointLoadLcl(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StifK 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%StifK)) DEALLOCATE(OutData%StifK) - ALLOCATE(OutData%StifK(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%StifK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%StifK,4), UBOUND(OutData%StifK,4) - DO i3 = LBOUND(OutData%StifK,3), UBOUND(OutData%StifK,3) - DO i2 = LBOUND(OutData%StifK,2), UBOUND(OutData%StifK,2) - DO i1 = LBOUND(OutData%StifK,1), UBOUND(OutData%StifK,1) - OutData%StifK(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassM 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%MassM)) DEALLOCATE(OutData%MassM) - ALLOCATE(OutData%MassM(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%MassM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%MassM,4), UBOUND(OutData%MassM,4) - DO i3 = LBOUND(OutData%MassM,3), UBOUND(OutData%MassM,3) - DO i2 = LBOUND(OutData%MassM,2), UBOUND(OutData%MassM,2) - DO i1 = LBOUND(OutData%MassM,1), UBOUND(OutData%MassM,1) - OutData%MassM(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampG 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%DampG)) DEALLOCATE(OutData%DampG) - ALLOCATE(OutData%DampG(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%DampG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%DampG,4), UBOUND(OutData%DampG,4) - DO i3 = LBOUND(OutData%DampG,3), UBOUND(OutData%DampG,3) - DO i2 = LBOUND(OutData%DampG,2), UBOUND(OutData%DampG,2) - DO i1 = LBOUND(OutData%DampG,1), UBOUND(OutData%DampG,1) - OutData%DampG(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StifK_fd 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%StifK_fd)) DEALLOCATE(OutData%StifK_fd) - ALLOCATE(OutData%StifK_fd(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%StifK_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%StifK_fd,4), UBOUND(OutData%StifK_fd,4) - DO i3 = LBOUND(OutData%StifK_fd,3), UBOUND(OutData%StifK_fd,3) - DO i2 = LBOUND(OutData%StifK_fd,2), UBOUND(OutData%StifK_fd,2) - DO i1 = LBOUND(OutData%StifK_fd,1), UBOUND(OutData%StifK_fd,1) - OutData%StifK_fd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassM_fd 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%MassM_fd)) DEALLOCATE(OutData%MassM_fd) - ALLOCATE(OutData%MassM_fd(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%MassM_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%MassM_fd,4), UBOUND(OutData%MassM_fd,4) - DO i3 = LBOUND(OutData%MassM_fd,3), UBOUND(OutData%MassM_fd,3) - DO i2 = LBOUND(OutData%MassM_fd,2), UBOUND(OutData%MassM_fd,2) - DO i1 = LBOUND(OutData%MassM_fd,1), UBOUND(OutData%MassM_fd,1) - OutData%MassM_fd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampG_fd 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%DampG_fd)) DEALLOCATE(OutData%DampG_fd) - ALLOCATE(OutData%DampG_fd(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%DampG_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%DampG_fd,4), UBOUND(OutData%DampG_fd,4) - DO i3 = LBOUND(OutData%DampG_fd,3), UBOUND(OutData%DampG_fd,3) - DO i2 = LBOUND(OutData%DampG_fd,2), UBOUND(OutData%DampG_fd,2) - DO i1 = LBOUND(OutData%DampG_fd,1), UBOUND(OutData%DampG_fd,1) - OutData%DampG_fd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS 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%RHS)) DEALLOCATE(OutData%RHS) - ALLOCATE(OutData%RHS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%RHS,2), UBOUND(OutData%RHS,2) - DO i1 = LBOUND(OutData%RHS,1), UBOUND(OutData%RHS,1) - OutData%RHS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS_p 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%RHS_p)) DEALLOCATE(OutData%RHS_p) - ALLOCATE(OutData%RHS_p(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%RHS_p,2), UBOUND(OutData%RHS_p,2) - DO i1 = LBOUND(OutData%RHS_p,1), UBOUND(OutData%RHS_p,1) - OutData%RHS_p(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS_m 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%RHS_m)) DEALLOCATE(OutData%RHS_m) - ALLOCATE(OutData%RHS_m(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%RHS_m,2), UBOUND(OutData%RHS_m,2) - DO i1 = LBOUND(OutData%RHS_m,1), UBOUND(OutData%RHS_m,1) - OutData%RHS_m(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldInternalForceFE 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%BldInternalForceFE)) DEALLOCATE(OutData%BldInternalForceFE) - ALLOCATE(OutData%BldInternalForceFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldInternalForceFE,2), UBOUND(OutData%BldInternalForceFE,2) - DO i1 = LBOUND(OutData%BldInternalForceFE,1), UBOUND(OutData%BldInternalForceFE,1) - OutData%BldInternalForceFE(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldInternalForceQP 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%BldInternalForceQP)) DEALLOCATE(OutData%BldInternalForceQP) - ALLOCATE(OutData%BldInternalForceQP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceQP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldInternalForceQP,2), UBOUND(OutData%BldInternalForceQP,2) - DO i1 = LBOUND(OutData%BldInternalForceQP,1), UBOUND(OutData%BldInternalForceQP,1) - OutData%BldInternalForceQP(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FirstNodeReactionLclForceMoment 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%FirstNodeReactionLclForceMoment)) DEALLOCATE(OutData%FirstNodeReactionLclForceMoment) - ALLOCATE(OutData%FirstNodeReactionLclForceMoment(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstNodeReactionLclForceMoment.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FirstNodeReactionLclForceMoment,1), UBOUND(OutData%FirstNodeReactionLclForceMoment,1) - OutData%FirstNodeReactionLclForceMoment(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Solution 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%Solution)) DEALLOCATE(OutData%Solution) - ALLOCATE(OutData%Solution(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Solution.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Solution,2), UBOUND(OutData%Solution,2) - DO i1 = LBOUND(OutData%Solution,1), UBOUND(OutData%Solution,1) - OutData%Solution(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_StifK 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%LP_StifK)) DEALLOCATE(OutData%LP_StifK) - ALLOCATE(OutData%LP_StifK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LP_StifK,2), UBOUND(OutData%LP_StifK,2) - DO i1 = LBOUND(OutData%LP_StifK,1), UBOUND(OutData%LP_StifK,1) - OutData%LP_StifK(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_MassM 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%LP_MassM)) DEALLOCATE(OutData%LP_MassM) - ALLOCATE(OutData%LP_MassM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LP_MassM,2), UBOUND(OutData%LP_MassM,2) - DO i1 = LBOUND(OutData%LP_MassM,1), UBOUND(OutData%LP_MassM,1) - OutData%LP_MassM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_MassM_LU 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%LP_MassM_LU)) DEALLOCATE(OutData%LP_MassM_LU) - ALLOCATE(OutData%LP_MassM_LU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LP_MassM_LU,2), UBOUND(OutData%LP_MassM_LU,2) - DO i1 = LBOUND(OutData%LP_MassM_LU,1), UBOUND(OutData%LP_MassM_LU,1) - OutData%LP_MassM_LU(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_RHS 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%LP_RHS)) DEALLOCATE(OutData%LP_RHS) - ALLOCATE(OutData%LP_RHS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LP_RHS,1), UBOUND(OutData%LP_RHS,1) - OutData%LP_RHS(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_StifK_LU 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%LP_StifK_LU)) DEALLOCATE(OutData%LP_StifK_LU) - ALLOCATE(OutData%LP_StifK_LU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LP_StifK_LU,2), UBOUND(OutData%LP_StifK_LU,2) - DO i1 = LBOUND(OutData%LP_StifK_LU,1), UBOUND(OutData%LP_StifK_LU,1) - OutData%LP_StifK_LU(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_RHS_LU 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%LP_RHS_LU)) DEALLOCATE(OutData%LP_RHS_LU) - ALLOCATE(OutData%LP_RHS_LU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LP_RHS_LU,1), UBOUND(OutData%LP_RHS_LU,1) - OutData%LP_RHS_LU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_indx 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%LP_indx)) DEALLOCATE(OutData%LP_indx) - ALLOCATE(OutData%LP_indx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LP_indx,1), UBOUND(OutData%LP_indx,1) - OutData%LP_indx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u2, ErrStat2, ErrMsg2 ) ! u2 - 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 BD_UnPackMisc - - - SUBROUTINE BD_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(BD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(BD_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 + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine BD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(BD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine BD_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(BD_OtherStateType), intent(in) :: SrcOtherStateData + type(BD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%acc)) then + LB(1:2) = lbound(SrcOtherStateData%acc) + UB(1:2) = ubound(SrcOtherStateData%acc) + if (.not. allocated(DstOtherStateData%acc)) then + allocate(DstOtherStateData%acc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%acc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%acc = SrcOtherStateData%acc + end if + if (allocated(SrcOtherStateData%xcc)) then + LB(1:2) = lbound(SrcOtherStateData%xcc) + UB(1:2) = ubound(SrcOtherStateData%xcc) + if (.not. allocated(DstOtherStateData%xcc)) then + allocate(DstOtherStateData%xcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xcc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%xcc = SrcOtherStateData%xcc + end if + DstOtherStateData%InitAcc = SrcOtherStateData%InitAcc + DstOtherStateData%RunQuasiStaticInit = SrcOtherStateData%RunQuasiStaticInit +end subroutine + +subroutine BD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(BD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%acc)) then + deallocate(OtherStateData%acc) + end if + if (allocated(OtherStateData%xcc)) then + deallocate(OtherStateData%xcc) + end if +end subroutine + +subroutine BD_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%acc)) + if (allocated(InData%acc)) then + call RegPackBounds(Buf, 2, lbound(InData%acc), ubound(InData%acc)) + call RegPack(Buf, InData%acc) + end if + call RegPack(Buf, allocated(InData%xcc)) + if (allocated(InData%xcc)) then + call RegPackBounds(Buf, 2, lbound(InData%xcc), ubound(InData%xcc)) + call RegPack(Buf, InData%xcc) + end if + call RegPack(Buf, InData%InitAcc) + call RegPack(Buf, InData%RunQuasiStaticInit) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackOtherState' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%acc)) deallocate(OutData%acc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%acc(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%acc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%acc) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%xcc)) deallocate(OutData%xcc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xcc(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xcc) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%InitAcc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RunQuasiStaticInit) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_CopyqpParam(SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, ErrMsg) + type(qpParam), intent(in) :: SrcqpParamData + type(qpParam), intent(inout) :: DstqpParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BD_CopyqpParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcqpParamData%mmm)) then + LB(1:2) = lbound(SrcqpParamData%mmm) + UB(1:2) = ubound(SrcqpParamData%mmm) + if (.not. allocated(DstqpParamData%mmm)) then + allocate(DstqpParamData%mmm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstqpParamData%mmm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstqpParamData%mmm = SrcqpParamData%mmm + end if + if (allocated(SrcqpParamData%mEta)) then + LB(1:3) = lbound(SrcqpParamData%mEta) + UB(1:3) = ubound(SrcqpParamData%mEta) + if (.not. allocated(DstqpParamData%mEta)) then + allocate(DstqpParamData%mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstqpParamData%mEta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstqpParamData%mEta = SrcqpParamData%mEta + end if +end subroutine + +subroutine BD_DestroyqpParam(qpParamData, ErrStat, ErrMsg) + type(qpParam), intent(inout) :: qpParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyqpParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(qpParamData%mmm)) then + deallocate(qpParamData%mmm) + end if + if (allocated(qpParamData%mEta)) then + deallocate(qpParamData%mEta) + end if +end subroutine + +subroutine BD_PackqpParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(qpParam), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackqpParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%mmm)) + if (allocated(InData%mmm)) then + call RegPackBounds(Buf, 2, lbound(InData%mmm), ubound(InData%mmm)) + call RegPack(Buf, InData%mmm) + end if + call RegPack(Buf, allocated(InData%mEta)) + if (allocated(InData%mEta)) then + call RegPackBounds(Buf, 3, lbound(InData%mEta), ubound(InData%mEta)) + call RegPack(Buf, InData%mEta) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackqpParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(qpParam), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackqpParam' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%mmm)) deallocate(OutData%mmm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%mmm(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%mmm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%mmm) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%mEta)) deallocate(OutData%mEta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%mEta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%mEta) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(BD_ParameterType), intent(in) :: SrcParamData + type(BD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%dt = SrcParamData%dt + DstParamData%coef = SrcParamData%coef + DstParamData%rhoinf = SrcParamData%rhoinf + if (allocated(SrcParamData%uuN0)) then + LB(1:3) = lbound(SrcParamData%uuN0) + UB(1:3) = ubound(SrcParamData%uuN0) + if (.not. allocated(DstParamData%uuN0)) then + allocate(DstParamData%uuN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uuN0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uuN0 = SrcParamData%uuN0 + end if + if (allocated(SrcParamData%Stif0_QP)) then + LB(1:3) = lbound(SrcParamData%Stif0_QP) + UB(1:3) = ubound(SrcParamData%Stif0_QP) + if (.not. allocated(DstParamData%Stif0_QP)) then + allocate(DstParamData%Stif0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Stif0_QP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Stif0_QP = SrcParamData%Stif0_QP + end if + if (allocated(SrcParamData%Mass0_QP)) then + LB(1:3) = lbound(SrcParamData%Mass0_QP) + UB(1:3) = ubound(SrcParamData%Mass0_QP) + if (.not. allocated(DstParamData%Mass0_QP)) then + allocate(DstParamData%Mass0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass0_QP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Mass0_QP = SrcParamData%Mass0_QP + end if + DstParamData%gravity = SrcParamData%gravity + if (allocated(SrcParamData%segment_eta)) then + LB(1:1) = lbound(SrcParamData%segment_eta) + UB(1:1) = ubound(SrcParamData%segment_eta) + if (.not. allocated(DstParamData%segment_eta)) then + allocate(DstParamData%segment_eta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%segment_eta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%segment_eta = SrcParamData%segment_eta + end if + if (allocated(SrcParamData%member_eta)) then + LB(1:1) = lbound(SrcParamData%member_eta) + UB(1:1) = ubound(SrcParamData%member_eta) + if (.not. allocated(DstParamData%member_eta)) then + allocate(DstParamData%member_eta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%member_eta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%member_eta = SrcParamData%member_eta + end if + DstParamData%blade_length = SrcParamData%blade_length + DstParamData%blade_mass = SrcParamData%blade_mass + DstParamData%blade_CG = SrcParamData%blade_CG + DstParamData%blade_IN = SrcParamData%blade_IN + DstParamData%beta = SrcParamData%beta + DstParamData%tol = SrcParamData%tol + DstParamData%GlbPos = SrcParamData%GlbPos + DstParamData%GlbRot = SrcParamData%GlbRot + DstParamData%Glb_crv = SrcParamData%Glb_crv + if (allocated(SrcParamData%QPtN)) then + LB(1:1) = lbound(SrcParamData%QPtN) + UB(1:1) = ubound(SrcParamData%QPtN) + if (.not. allocated(DstParamData%QPtN)) then + allocate(DstParamData%QPtN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtN = SrcParamData%QPtN + end if + if (allocated(SrcParamData%QPtWeight)) then + LB(1:1) = lbound(SrcParamData%QPtWeight) + UB(1:1) = ubound(SrcParamData%QPtWeight) + if (.not. allocated(DstParamData%QPtWeight)) then + allocate(DstParamData%QPtWeight(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtWeight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtWeight = SrcParamData%QPtWeight + end if + if (allocated(SrcParamData%Shp)) then + LB(1:2) = lbound(SrcParamData%Shp) + UB(1:2) = ubound(SrcParamData%Shp) + if (.not. allocated(DstParamData%Shp)) then + allocate(DstParamData%Shp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Shp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Shp = SrcParamData%Shp + end if + if (allocated(SrcParamData%ShpDer)) then + LB(1:2) = lbound(SrcParamData%ShpDer) + UB(1:2) = ubound(SrcParamData%ShpDer) + if (.not. allocated(DstParamData%ShpDer)) then + allocate(DstParamData%ShpDer(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ShpDer.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ShpDer = SrcParamData%ShpDer + end if + if (allocated(SrcParamData%Jacobian)) then + LB(1:2) = lbound(SrcParamData%Jacobian) + UB(1:2) = ubound(SrcParamData%Jacobian) + if (.not. allocated(DstParamData%Jacobian)) then + allocate(DstParamData%Jacobian(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jacobian.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jacobian = SrcParamData%Jacobian + end if + if (allocated(SrcParamData%uu0)) then + LB(1:3) = lbound(SrcParamData%uu0) + UB(1:3) = ubound(SrcParamData%uu0) + if (.not. allocated(DstParamData%uu0)) then + allocate(DstParamData%uu0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uu0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uu0 = SrcParamData%uu0 + end if + if (allocated(SrcParamData%rrN0)) then + LB(1:3) = lbound(SrcParamData%rrN0) + UB(1:3) = ubound(SrcParamData%rrN0) + if (.not. allocated(DstParamData%rrN0)) then + allocate(DstParamData%rrN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rrN0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rrN0 = SrcParamData%rrN0 + end if + if (allocated(SrcParamData%E10)) then + LB(1:3) = lbound(SrcParamData%E10) + UB(1:3) = ubound(SrcParamData%E10) + if (.not. allocated(DstParamData%E10)) then + allocate(DstParamData%E10(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%E10.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%E10 = SrcParamData%E10 + end if + DstParamData%nodes_per_elem = SrcParamData%nodes_per_elem + if (allocated(SrcParamData%node_elem_idx)) then + LB(1:2) = lbound(SrcParamData%node_elem_idx) + UB(1:2) = ubound(SrcParamData%node_elem_idx) + if (.not. allocated(DstParamData%node_elem_idx)) then + allocate(DstParamData%node_elem_idx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%node_elem_idx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%node_elem_idx = SrcParamData%node_elem_idx + end if + DstParamData%refine = SrcParamData%refine + DstParamData%dof_node = SrcParamData%dof_node + DstParamData%dof_elem = SrcParamData%dof_elem + DstParamData%rot_elem = SrcParamData%rot_elem + DstParamData%elem_total = SrcParamData%elem_total + DstParamData%node_total = SrcParamData%node_total + DstParamData%dof_total = SrcParamData%dof_total + DstParamData%nqp = SrcParamData%nqp + DstParamData%analysis_type = SrcParamData%analysis_type + DstParamData%damp_flag = SrcParamData%damp_flag + DstParamData%ld_retries = SrcParamData%ld_retries + DstParamData%niter = SrcParamData%niter + DstParamData%quadrature = SrcParamData%quadrature + DstParamData%n_fact = SrcParamData%n_fact + DstParamData%OutInputs = SrcParamData%OutInputs + DstParamData%NumOuts = SrcParamData%NumOuts + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + DstParamData%NNodeOuts = SrcParamData%NNodeOuts + DstParamData%OutNd = SrcParamData%OutNd + if (allocated(SrcParamData%NdIndx)) then + LB(1:1) = lbound(SrcParamData%NdIndx) + UB(1:1) = ubound(SrcParamData%NdIndx) + if (.not. allocated(DstParamData%NdIndx)) then + allocate(DstParamData%NdIndx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NdIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%NdIndx = SrcParamData%NdIndx + end if + if (allocated(SrcParamData%NdIndxInverse)) then + LB(1:1) = lbound(SrcParamData%NdIndxInverse) + UB(1:1) = ubound(SrcParamData%NdIndxInverse) + if (.not. allocated(DstParamData%NdIndxInverse)) then + allocate(DstParamData%NdIndxInverse(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NdIndxInverse.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%NdIndxInverse = SrcParamData%NdIndxInverse + end if + if (allocated(SrcParamData%OutNd2NdElem)) then + LB(1:2) = lbound(SrcParamData%OutNd2NdElem) + UB(1:2) = ubound(SrcParamData%OutNd2NdElem) + if (.not. allocated(DstParamData%OutNd2NdElem)) then + allocate(DstParamData%OutNd2NdElem(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutNd2NdElem.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutNd2NdElem = SrcParamData%OutNd2NdElem + end if + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%UsePitchAct = SrcParamData%UsePitchAct + DstParamData%pitchJ = SrcParamData%pitchJ + DstParamData%pitchK = SrcParamData%pitchK + DstParamData%pitchC = SrcParamData%pitchC + DstParamData%torqM = SrcParamData%torqM + call BD_CopyqpParam(SrcParamData%qp, DstParamData%qp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%qp_indx_offset = SrcParamData%qp_indx_offset + DstParamData%BldMotionNodeLoc = SrcParamData%BldMotionNodeLoc + DstParamData%tngt_stf_fd = SrcParamData%tngt_stf_fd + DstParamData%tngt_stf_comp = SrcParamData%tngt_stf_comp + DstParamData%tngt_stf_pert = SrcParamData%tngt_stf_pert + DstParamData%tngt_stf_difftol = SrcParamData%tngt_stf_difftol + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts + if (allocated(SrcParamData%BldNd_OutParam)) then + LB(1:1) = lbound(SrcParamData%BldNd_OutParam) + UB(1:1) = ubound(SrcParamData%BldNd_OutParam) + if (.not. allocated(DstParamData%BldNd_OutParam)) then + allocate(DstParamData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%BldNd_BlOutNd)) then + LB(1:1) = lbound(SrcParamData%BldNd_BlOutNd) + UB(1:1) = ubound(SrcParamData%BldNd_BlOutNd) + if (.not. allocated(DstParamData%BldNd_BlOutNd)) then + allocate(DstParamData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_BlOutNd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd + end if + if (allocated(SrcParamData%QPtw_Shp_Shp_Jac)) then + LB(1:4) = lbound(SrcParamData%QPtw_Shp_Shp_Jac) + UB(1:4) = ubound(SrcParamData%QPtw_Shp_Shp_Jac) + if (.not. allocated(DstParamData%QPtw_Shp_Shp_Jac)) then + allocate(DstParamData%QPtw_Shp_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_Shp_Shp_Jac.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtw_Shp_Shp_Jac = SrcParamData%QPtw_Shp_Shp_Jac + end if + if (allocated(SrcParamData%QPtw_Shp_ShpDer)) then + LB(1:3) = lbound(SrcParamData%QPtw_Shp_ShpDer) + UB(1:3) = ubound(SrcParamData%QPtw_Shp_ShpDer) + if (.not. allocated(DstParamData%QPtw_Shp_ShpDer)) then + allocate(DstParamData%QPtw_Shp_ShpDer(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_Shp_ShpDer.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtw_Shp_ShpDer = SrcParamData%QPtw_Shp_ShpDer + end if + if (allocated(SrcParamData%QPtw_ShpDer_ShpDer_Jac)) then + LB(1:4) = lbound(SrcParamData%QPtw_ShpDer_ShpDer_Jac) + UB(1:4) = ubound(SrcParamData%QPtw_ShpDer_ShpDer_Jac) + if (.not. allocated(DstParamData%QPtw_ShpDer_ShpDer_Jac)) then + allocate(DstParamData%QPtw_ShpDer_ShpDer_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_ShpDer_ShpDer_Jac.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtw_ShpDer_ShpDer_Jac = SrcParamData%QPtw_ShpDer_ShpDer_Jac + end if + if (allocated(SrcParamData%QPtw_Shp_Jac)) then + LB(1:3) = lbound(SrcParamData%QPtw_Shp_Jac) + UB(1:3) = ubound(SrcParamData%QPtw_Shp_Jac) + if (.not. allocated(DstParamData%QPtw_Shp_Jac)) then + allocate(DstParamData%QPtw_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_Shp_Jac.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtw_Shp_Jac = SrcParamData%QPtw_Shp_Jac + end if + if (allocated(SrcParamData%QPtw_ShpDer)) then + LB(1:2) = lbound(SrcParamData%QPtw_ShpDer) + UB(1:2) = ubound(SrcParamData%QPtw_ShpDer) + if (.not. allocated(DstParamData%QPtw_ShpDer)) then + allocate(DstParamData%QPtw_ShpDer(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_ShpDer.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtw_ShpDer = SrcParamData%QPtw_ShpDer + end if + if (allocated(SrcParamData%FEweight)) then + LB(1:2) = lbound(SrcParamData%FEweight) + UB(1:2) = ubound(SrcParamData%FEweight) + if (.not. allocated(DstParamData%FEweight)) then + allocate(DstParamData%FEweight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FEweight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FEweight = SrcParamData%FEweight + end if + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du + end if + DstParamData%dx = SrcParamData%dx + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + DstParamData%RotStates = SrcParamData%RotStates + DstParamData%RelStates = SrcParamData%RelStates +end subroutine + +subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(BD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%uuN0)) then + deallocate(ParamData%uuN0) + end if + if (allocated(ParamData%Stif0_QP)) then + deallocate(ParamData%Stif0_QP) + end if + if (allocated(ParamData%Mass0_QP)) then + deallocate(ParamData%Mass0_QP) + end if + if (allocated(ParamData%segment_eta)) then + deallocate(ParamData%segment_eta) + end if + if (allocated(ParamData%member_eta)) then + deallocate(ParamData%member_eta) + end if + if (allocated(ParamData%QPtN)) then + deallocate(ParamData%QPtN) + end if + if (allocated(ParamData%QPtWeight)) then + deallocate(ParamData%QPtWeight) + end if + if (allocated(ParamData%Shp)) then + deallocate(ParamData%Shp) + end if + if (allocated(ParamData%ShpDer)) then + deallocate(ParamData%ShpDer) + end if + if (allocated(ParamData%Jacobian)) then + deallocate(ParamData%Jacobian) + end if + if (allocated(ParamData%uu0)) then + deallocate(ParamData%uu0) + end if + if (allocated(ParamData%rrN0)) then + deallocate(ParamData%rrN0) + end if + if (allocated(ParamData%E10)) then + deallocate(ParamData%E10) + end if + if (allocated(ParamData%node_elem_idx)) then + deallocate(ParamData%node_elem_idx) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%NdIndx)) then + deallocate(ParamData%NdIndx) + end if + if (allocated(ParamData%NdIndxInverse)) then + deallocate(ParamData%NdIndxInverse) + end if + if (allocated(ParamData%OutNd2NdElem)) then + deallocate(ParamData%OutNd2NdElem) + end if + call BD_DestroyqpParam(ParamData%qp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%BldNd_OutParam)) then + LB(1:1) = lbound(ParamData%BldNd_OutParam) + UB(1:1) = ubound(ParamData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%BldNd_OutParam) + end if + if (allocated(ParamData%BldNd_BlOutNd)) then + deallocate(ParamData%BldNd_BlOutNd) + end if + if (allocated(ParamData%QPtw_Shp_Shp_Jac)) then + deallocate(ParamData%QPtw_Shp_Shp_Jac) + end if + if (allocated(ParamData%QPtw_Shp_ShpDer)) then + deallocate(ParamData%QPtw_Shp_ShpDer) + end if + if (allocated(ParamData%QPtw_ShpDer_ShpDer_Jac)) then + deallocate(ParamData%QPtw_ShpDer_ShpDer_Jac) + end if + if (allocated(ParamData%QPtw_Shp_Jac)) then + deallocate(ParamData%QPtw_Shp_Jac) + end if + if (allocated(ParamData%QPtw_ShpDer)) then + deallocate(ParamData%QPtw_ShpDer) + end if + if (allocated(ParamData%FEweight)) then + deallocate(ParamData%FEweight) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if +end subroutine + +subroutine BD_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackParam' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dt) + call RegPack(Buf, InData%coef) + call RegPack(Buf, InData%rhoinf) + call RegPack(Buf, allocated(InData%uuN0)) + if (allocated(InData%uuN0)) then + call RegPackBounds(Buf, 3, lbound(InData%uuN0), ubound(InData%uuN0)) + call RegPack(Buf, InData%uuN0) + end if + call RegPack(Buf, allocated(InData%Stif0_QP)) + if (allocated(InData%Stif0_QP)) then + call RegPackBounds(Buf, 3, lbound(InData%Stif0_QP), ubound(InData%Stif0_QP)) + call RegPack(Buf, InData%Stif0_QP) + end if + call RegPack(Buf, allocated(InData%Mass0_QP)) + if (allocated(InData%Mass0_QP)) then + call RegPackBounds(Buf, 3, lbound(InData%Mass0_QP), ubound(InData%Mass0_QP)) + call RegPack(Buf, InData%Mass0_QP) + end if + call RegPack(Buf, InData%gravity) + call RegPack(Buf, allocated(InData%segment_eta)) + if (allocated(InData%segment_eta)) then + call RegPackBounds(Buf, 1, lbound(InData%segment_eta), ubound(InData%segment_eta)) + call RegPack(Buf, InData%segment_eta) + end if + call RegPack(Buf, allocated(InData%member_eta)) + if (allocated(InData%member_eta)) then + call RegPackBounds(Buf, 1, lbound(InData%member_eta), ubound(InData%member_eta)) + call RegPack(Buf, InData%member_eta) + end if + call RegPack(Buf, InData%blade_length) + call RegPack(Buf, InData%blade_mass) + call RegPack(Buf, InData%blade_CG) + call RegPack(Buf, InData%blade_IN) + call RegPack(Buf, InData%beta) + call RegPack(Buf, InData%tol) + call RegPack(Buf, InData%GlbPos) + call RegPack(Buf, InData%GlbRot) + call RegPack(Buf, InData%Glb_crv) + call RegPack(Buf, allocated(InData%QPtN)) + if (allocated(InData%QPtN)) then + call RegPackBounds(Buf, 1, lbound(InData%QPtN), ubound(InData%QPtN)) + call RegPack(Buf, InData%QPtN) + end if + call RegPack(Buf, allocated(InData%QPtWeight)) + if (allocated(InData%QPtWeight)) then + call RegPackBounds(Buf, 1, lbound(InData%QPtWeight), ubound(InData%QPtWeight)) + call RegPack(Buf, InData%QPtWeight) + end if + call RegPack(Buf, allocated(InData%Shp)) + if (allocated(InData%Shp)) then + call RegPackBounds(Buf, 2, lbound(InData%Shp), ubound(InData%Shp)) + call RegPack(Buf, InData%Shp) + end if + call RegPack(Buf, allocated(InData%ShpDer)) + if (allocated(InData%ShpDer)) then + call RegPackBounds(Buf, 2, lbound(InData%ShpDer), ubound(InData%ShpDer)) + call RegPack(Buf, InData%ShpDer) + end if + call RegPack(Buf, allocated(InData%Jacobian)) + if (allocated(InData%Jacobian)) then + call RegPackBounds(Buf, 2, lbound(InData%Jacobian), ubound(InData%Jacobian)) + call RegPack(Buf, InData%Jacobian) + end if + call RegPack(Buf, allocated(InData%uu0)) + if (allocated(InData%uu0)) then + call RegPackBounds(Buf, 3, lbound(InData%uu0), ubound(InData%uu0)) + call RegPack(Buf, InData%uu0) + end if + call RegPack(Buf, allocated(InData%rrN0)) + if (allocated(InData%rrN0)) then + call RegPackBounds(Buf, 3, lbound(InData%rrN0), ubound(InData%rrN0)) + call RegPack(Buf, InData%rrN0) + end if + call RegPack(Buf, allocated(InData%E10)) + if (allocated(InData%E10)) then + call RegPackBounds(Buf, 3, lbound(InData%E10), ubound(InData%E10)) + call RegPack(Buf, InData%E10) + end if + call RegPack(Buf, InData%nodes_per_elem) + call RegPack(Buf, allocated(InData%node_elem_idx)) + if (allocated(InData%node_elem_idx)) then + call RegPackBounds(Buf, 2, lbound(InData%node_elem_idx), ubound(InData%node_elem_idx)) + call RegPack(Buf, InData%node_elem_idx) + end if + call RegPack(Buf, InData%refine) + call RegPack(Buf, InData%dof_node) + call RegPack(Buf, InData%dof_elem) + call RegPack(Buf, InData%rot_elem) + call RegPack(Buf, InData%elem_total) + call RegPack(Buf, InData%node_total) + call RegPack(Buf, InData%dof_total) + call RegPack(Buf, InData%nqp) + call RegPack(Buf, InData%analysis_type) + call RegPack(Buf, InData%damp_flag) + call RegPack(Buf, InData%ld_retries) + call RegPack(Buf, InData%niter) + call RegPack(Buf, InData%quadrature) + call RegPack(Buf, InData%n_fact) + call RegPack(Buf, InData%OutInputs) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + call RegPack(Buf, InData%NNodeOuts) + call RegPack(Buf, InData%OutNd) + call RegPack(Buf, allocated(InData%NdIndx)) + if (allocated(InData%NdIndx)) then + call RegPackBounds(Buf, 1, lbound(InData%NdIndx), ubound(InData%NdIndx)) + call RegPack(Buf, InData%NdIndx) + end if + call RegPack(Buf, allocated(InData%NdIndxInverse)) + if (allocated(InData%NdIndxInverse)) then + call RegPackBounds(Buf, 1, lbound(InData%NdIndxInverse), ubound(InData%NdIndxInverse)) + call RegPack(Buf, InData%NdIndxInverse) + end if + call RegPack(Buf, allocated(InData%OutNd2NdElem)) + if (allocated(InData%OutNd2NdElem)) then + call RegPackBounds(Buf, 2, lbound(InData%OutNd2NdElem), ubound(InData%OutNd2NdElem)) + call RegPack(Buf, InData%OutNd2NdElem) + end if + call RegPack(Buf, InData%OutFmt) + call RegPack(Buf, InData%UsePitchAct) + call RegPack(Buf, InData%pitchJ) + call RegPack(Buf, InData%pitchK) + call RegPack(Buf, InData%pitchC) + call RegPack(Buf, InData%torqM) + call BD_PackqpParam(Buf, InData%qp) + call RegPack(Buf, InData%qp_indx_offset) + call RegPack(Buf, InData%BldMotionNodeLoc) + call RegPack(Buf, InData%tngt_stf_fd) + call RegPack(Buf, InData%tngt_stf_comp) + call RegPack(Buf, InData%tngt_stf_pert) + call RegPack(Buf, InData%tngt_stf_difftol) + call RegPack(Buf, InData%BldNd_NumOuts) + call RegPack(Buf, InData%BldNd_TotNumOuts) + call RegPack(Buf, allocated(InData%BldNd_OutParam)) + if (allocated(InData%BldNd_OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) + LB(1:1) = lbound(InData%BldNd_OutParam) + UB(1:1) = ubound(InData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%BldNd_OutParam(i1)) + end do + end if + call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) + if (allocated(InData%BldNd_BlOutNd)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd), ubound(InData%BldNd_BlOutNd)) + call RegPack(Buf, InData%BldNd_BlOutNd) + end if + call RegPack(Buf, allocated(InData%QPtw_Shp_Shp_Jac)) + if (allocated(InData%QPtw_Shp_Shp_Jac)) then + call RegPackBounds(Buf, 4, lbound(InData%QPtw_Shp_Shp_Jac), ubound(InData%QPtw_Shp_Shp_Jac)) + call RegPack(Buf, InData%QPtw_Shp_Shp_Jac) + end if + call RegPack(Buf, allocated(InData%QPtw_Shp_ShpDer)) + if (allocated(InData%QPtw_Shp_ShpDer)) then + call RegPackBounds(Buf, 3, lbound(InData%QPtw_Shp_ShpDer), ubound(InData%QPtw_Shp_ShpDer)) + call RegPack(Buf, InData%QPtw_Shp_ShpDer) + end if + call RegPack(Buf, allocated(InData%QPtw_ShpDer_ShpDer_Jac)) + if (allocated(InData%QPtw_ShpDer_ShpDer_Jac)) then + call RegPackBounds(Buf, 4, lbound(InData%QPtw_ShpDer_ShpDer_Jac), ubound(InData%QPtw_ShpDer_ShpDer_Jac)) + call RegPack(Buf, InData%QPtw_ShpDer_ShpDer_Jac) + end if + call RegPack(Buf, allocated(InData%QPtw_Shp_Jac)) + if (allocated(InData%QPtw_Shp_Jac)) then + call RegPackBounds(Buf, 3, lbound(InData%QPtw_Shp_Jac), ubound(InData%QPtw_Shp_Jac)) + call RegPack(Buf, InData%QPtw_Shp_Jac) + end if + call RegPack(Buf, allocated(InData%QPtw_ShpDer)) + if (allocated(InData%QPtw_ShpDer)) then + call RegPackBounds(Buf, 2, lbound(InData%QPtw_ShpDer), ubound(InData%QPtw_ShpDer)) + call RegPack(Buf, InData%QPtw_ShpDer) + end if + call RegPack(Buf, allocated(InData%FEweight)) + if (allocated(InData%FEweight)) then + call RegPackBounds(Buf, 2, lbound(InData%FEweight), ubound(InData%FEweight)) + call RegPack(Buf, InData%FEweight) + end if + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + call RegPack(Buf, allocated(InData%du)) + if (allocated(InData%du)) then + call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPack(Buf, InData%du) + end if + call RegPack(Buf, InData%dx) + call RegPack(Buf, InData%Jac_ny) + call RegPack(Buf, InData%Jac_nx) + call RegPack(Buf, InData%RotStates) + call RegPack(Buf, InData%RelStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackParam' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%coef) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rhoinf) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%uuN0)) deallocate(OutData%uuN0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uuN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uuN0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uuN0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Stif0_QP)) deallocate(OutData%Stif0_QP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Stif0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stif0_QP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Stif0_QP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Mass0_QP)) deallocate(OutData%Mass0_QP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mass0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass0_QP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Mass0_QP) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%gravity) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%segment_eta)) deallocate(OutData%segment_eta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%segment_eta(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%segment_eta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%segment_eta) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%member_eta)) deallocate(OutData%member_eta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%member_eta(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%member_eta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%member_eta) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%blade_length) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%blade_mass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%blade_CG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%blade_IN) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%beta) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tol) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GlbPos) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GlbRot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Glb_crv) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%QPtN)) deallocate(OutData%QPtN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QPtN(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QPtN) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%QPtWeight)) deallocate(OutData%QPtWeight) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QPtWeight(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtWeight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QPtWeight) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Shp)) deallocate(OutData%Shp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Shp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Shp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Shp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ShpDer)) deallocate(OutData%ShpDer) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ShpDer(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShpDer.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ShpDer) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jacobian)) deallocate(OutData%Jacobian) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jacobian(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jacobian) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%uu0)) deallocate(OutData%uu0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uu0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uu0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uu0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rrN0)) deallocate(OutData%rrN0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rrN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rrN0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rrN0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%E10)) deallocate(OutData%E10) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%E10(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%E10.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%E10) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%nodes_per_elem) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%node_elem_idx)) deallocate(OutData%node_elem_idx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%node_elem_idx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%node_elem_idx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%node_elem_idx) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%refine) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dof_node) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dof_elem) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rot_elem) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%elem_total) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%node_total) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dof_total) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nqp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%analysis_type) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%damp_flag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ld_retries) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%niter) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%quadrature) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_fact) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutInputs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(Buf, OutData%NNodeOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutNd) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%NdIndx)) deallocate(OutData%NdIndx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NdIndx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NdIndx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%NdIndxInverse)) deallocate(OutData%NdIndxInverse) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NdIndxInverse(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndxInverse.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NdIndxInverse) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OutNd2NdElem)) deallocate(OutData%OutNd2NdElem) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutNd2NdElem(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutNd2NdElem.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutNd2NdElem) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UsePitchAct) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%pitchJ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%pitchK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%pitchC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%torqM) + if (RegCheckErr(Buf, RoutineName)) return + call BD_UnpackqpParam(Buf, OutData%qp) ! qp + call RegUnpack(Buf, OutData%qp_indx_offset) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldMotionNodeLoc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tngt_stf_fd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tngt_stf_comp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tngt_stf_pert) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tngt_stf_difftol) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldNd_TotNumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam + end do + end if + if (allocated(OutData%BldNd_BlOutNd)) deallocate(OutData%BldNd_BlOutNd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_BlOutNd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldNd_BlOutNd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%QPtw_Shp_Shp_Jac)) deallocate(OutData%QPtw_Shp_Shp_Jac) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QPtw_Shp_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_Shp_Jac.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QPtw_Shp_Shp_Jac) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%QPtw_Shp_ShpDer)) deallocate(OutData%QPtw_Shp_ShpDer) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QPtw_Shp_ShpDer(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_ShpDer.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QPtw_Shp_ShpDer) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%QPtw_ShpDer_ShpDer_Jac)) deallocate(OutData%QPtw_ShpDer_ShpDer_Jac) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QPtw_ShpDer_ShpDer_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer_ShpDer_Jac.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QPtw_ShpDer_ShpDer_Jac) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%QPtw_Shp_Jac)) deallocate(OutData%QPtw_Shp_Jac) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QPtw_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_Jac.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QPtw_Shp_Jac) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%QPtw_ShpDer)) deallocate(OutData%QPtw_ShpDer) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QPtw_ShpDer(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QPtw_ShpDer) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FEweight)) deallocate(OutData%FEweight) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FEweight(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FEweight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FEweight) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%du)) deallocate(OutData%du) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%du(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Jac_nx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotStates) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RelStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(BD_InputType), intent(inout) :: SrcInputData + type(BD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%RootMotion, DstInputData%RootMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%PointLoad, DstInputData%PointLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%DistrLoad, DstInputData%DistrLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%HubMotion, DstInputData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine BD_DestroyInput(InputData, ErrStat, ErrMsg) + type(BD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%RootMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%PointLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%DistrLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%HubMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine BD_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%RootMotion) + call MeshPack(Buf, InData%PointLoad) + call MeshPack(Buf, InData%DistrLoad) + call MeshPack(Buf, InData%HubMotion) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%RootMotion) ! RootMotion + call MeshUnpack(Buf, OutData%PointLoad) ! PointLoad + call MeshUnpack(Buf, OutData%DistrLoad) ! DistrLoad + call MeshUnpack(Buf, OutData%HubMotion) ! HubMotion +end subroutine + +subroutine BD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(BD_OutputType), intent(inout) :: SrcOutputData + type(BD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%ReactionForce, DstOutputData%ReactionForce, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%BldMotion, DstOutputData%BldMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstOutputData%RootMxr = SrcOutputData%RootMxr + DstOutputData%RootMyr = SrcOutputData%RootMyr + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine BD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(BD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%ReactionForce, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%BldMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine BD_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%ReactionForce) + call MeshPack(Buf, InData%BldMotion) + call RegPack(Buf, InData%RootMxr) + call RegPack(Buf, InData%RootMyr) + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%ReactionForce) ! ReactionForce + call MeshUnpack(Buf, OutData%BldMotion) ! BldMotion + call RegUnpack(Buf, OutData%RootMxr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootMyr) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, ErrStat, ErrMsg) + type(EqMotionQP), intent(in) :: SrcEqMotionQPData + type(EqMotionQP), intent(inout) :: DstEqMotionQPData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BD_CopyEqMotionQP' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcEqMotionQPData%uuu)) then + LB(1:3) = lbound(SrcEqMotionQPData%uuu) + UB(1:3) = ubound(SrcEqMotionQPData%uuu) + if (.not. allocated(DstEqMotionQPData%uuu)) then + allocate(DstEqMotionQPData%uuu(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%uuu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%uuu = SrcEqMotionQPData%uuu + end if + if (allocated(SrcEqMotionQPData%uup)) then + LB(1:3) = lbound(SrcEqMotionQPData%uup) + UB(1:3) = ubound(SrcEqMotionQPData%uup) + if (.not. allocated(DstEqMotionQPData%uup)) then + allocate(DstEqMotionQPData%uup(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%uup.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%uup = SrcEqMotionQPData%uup + end if + if (allocated(SrcEqMotionQPData%vvv)) then + LB(1:3) = lbound(SrcEqMotionQPData%vvv) + UB(1:3) = ubound(SrcEqMotionQPData%vvv) + if (.not. allocated(DstEqMotionQPData%vvv)) then + allocate(DstEqMotionQPData%vvv(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%vvv.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%vvv = SrcEqMotionQPData%vvv + end if + if (allocated(SrcEqMotionQPData%vvp)) then + LB(1:3) = lbound(SrcEqMotionQPData%vvp) + UB(1:3) = ubound(SrcEqMotionQPData%vvp) + if (.not. allocated(DstEqMotionQPData%vvp)) then + allocate(DstEqMotionQPData%vvp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%vvp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%vvp = SrcEqMotionQPData%vvp + end if + if (allocated(SrcEqMotionQPData%aaa)) then + LB(1:3) = lbound(SrcEqMotionQPData%aaa) + UB(1:3) = ubound(SrcEqMotionQPData%aaa) + if (.not. allocated(DstEqMotionQPData%aaa)) then + allocate(DstEqMotionQPData%aaa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%aaa.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%aaa = SrcEqMotionQPData%aaa + end if + if (allocated(SrcEqMotionQPData%RR0)) then + LB(1:4) = lbound(SrcEqMotionQPData%RR0) + UB(1:4) = ubound(SrcEqMotionQPData%RR0) + if (.not. allocated(DstEqMotionQPData%RR0)) then + allocate(DstEqMotionQPData%RR0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%RR0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%RR0 = SrcEqMotionQPData%RR0 + end if + if (allocated(SrcEqMotionQPData%kappa)) then + LB(1:3) = lbound(SrcEqMotionQPData%kappa) + UB(1:3) = ubound(SrcEqMotionQPData%kappa) + if (.not. allocated(DstEqMotionQPData%kappa)) then + allocate(DstEqMotionQPData%kappa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%kappa.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%kappa = SrcEqMotionQPData%kappa + end if + if (allocated(SrcEqMotionQPData%E1)) then + LB(1:3) = lbound(SrcEqMotionQPData%E1) + UB(1:3) = ubound(SrcEqMotionQPData%E1) + if (.not. allocated(DstEqMotionQPData%E1)) then + allocate(DstEqMotionQPData%E1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%E1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%E1 = SrcEqMotionQPData%E1 + end if + if (allocated(SrcEqMotionQPData%Stif)) then + LB(1:4) = lbound(SrcEqMotionQPData%Stif) + UB(1:4) = ubound(SrcEqMotionQPData%Stif) + if (.not. allocated(DstEqMotionQPData%Stif)) then + allocate(DstEqMotionQPData%Stif(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Stif.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Stif = SrcEqMotionQPData%Stif + end if + if (allocated(SrcEqMotionQPData%Fb)) then + LB(1:3) = lbound(SrcEqMotionQPData%Fb) + UB(1:3) = ubound(SrcEqMotionQPData%Fb) + if (.not. allocated(DstEqMotionQPData%Fb)) then + allocate(DstEqMotionQPData%Fb(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Fb = SrcEqMotionQPData%Fb + end if + if (allocated(SrcEqMotionQPData%Fc)) then + LB(1:3) = lbound(SrcEqMotionQPData%Fc) + UB(1:3) = ubound(SrcEqMotionQPData%Fc) + if (.not. allocated(DstEqMotionQPData%Fc)) then + allocate(DstEqMotionQPData%Fc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Fc = SrcEqMotionQPData%Fc + end if + if (allocated(SrcEqMotionQPData%Fd)) then + LB(1:3) = lbound(SrcEqMotionQPData%Fd) + UB(1:3) = ubound(SrcEqMotionQPData%Fd) + if (.not. allocated(DstEqMotionQPData%Fd)) then + allocate(DstEqMotionQPData%Fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Fd = SrcEqMotionQPData%Fd + end if + if (allocated(SrcEqMotionQPData%Fg)) then + LB(1:3) = lbound(SrcEqMotionQPData%Fg) + UB(1:3) = ubound(SrcEqMotionQPData%Fg) + if (.not. allocated(DstEqMotionQPData%Fg)) then + allocate(DstEqMotionQPData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Fg = SrcEqMotionQPData%Fg + end if + if (allocated(SrcEqMotionQPData%Fi)) then + LB(1:3) = lbound(SrcEqMotionQPData%Fi) + UB(1:3) = ubound(SrcEqMotionQPData%Fi) + if (.not. allocated(DstEqMotionQPData%Fi)) then + allocate(DstEqMotionQPData%Fi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Fi = SrcEqMotionQPData%Fi + end if + if (allocated(SrcEqMotionQPData%Ftemp)) then + LB(1:3) = lbound(SrcEqMotionQPData%Ftemp) + UB(1:3) = ubound(SrcEqMotionQPData%Ftemp) + if (.not. allocated(DstEqMotionQPData%Ftemp)) then + allocate(DstEqMotionQPData%Ftemp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Ftemp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Ftemp = SrcEqMotionQPData%Ftemp + end if + if (allocated(SrcEqMotionQPData%RR0mEta)) then + LB(1:3) = lbound(SrcEqMotionQPData%RR0mEta) + UB(1:3) = ubound(SrcEqMotionQPData%RR0mEta) + if (.not. allocated(DstEqMotionQPData%RR0mEta)) then + allocate(DstEqMotionQPData%RR0mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%RR0mEta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%RR0mEta = SrcEqMotionQPData%RR0mEta + end if + if (allocated(SrcEqMotionQPData%rho)) then + LB(1:4) = lbound(SrcEqMotionQPData%rho) + UB(1:4) = ubound(SrcEqMotionQPData%rho) + if (.not. allocated(DstEqMotionQPData%rho)) then + allocate(DstEqMotionQPData%rho(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%rho.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%rho = SrcEqMotionQPData%rho + end if + if (allocated(SrcEqMotionQPData%betaC)) then + LB(1:4) = lbound(SrcEqMotionQPData%betaC) + UB(1:4) = ubound(SrcEqMotionQPData%betaC) + if (.not. allocated(DstEqMotionQPData%betaC)) then + allocate(DstEqMotionQPData%betaC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%betaC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%betaC = SrcEqMotionQPData%betaC + end if + if (allocated(SrcEqMotionQPData%Gi)) then + LB(1:4) = lbound(SrcEqMotionQPData%Gi) + UB(1:4) = ubound(SrcEqMotionQPData%Gi) + if (.not. allocated(DstEqMotionQPData%Gi)) then + allocate(DstEqMotionQPData%Gi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Gi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Gi = SrcEqMotionQPData%Gi + end if + if (allocated(SrcEqMotionQPData%Ki)) then + LB(1:4) = lbound(SrcEqMotionQPData%Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Ki) + if (.not. allocated(DstEqMotionQPData%Ki)) then + allocate(DstEqMotionQPData%Ki(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Ki.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Ki = SrcEqMotionQPData%Ki + end if + if (allocated(SrcEqMotionQPData%Mi)) then + LB(1:4) = lbound(SrcEqMotionQPData%Mi) + UB(1:4) = ubound(SrcEqMotionQPData%Mi) + if (.not. allocated(DstEqMotionQPData%Mi)) then + allocate(DstEqMotionQPData%Mi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Mi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Mi = SrcEqMotionQPData%Mi + end if + if (allocated(SrcEqMotionQPData%Oe)) then + LB(1:4) = lbound(SrcEqMotionQPData%Oe) + UB(1:4) = ubound(SrcEqMotionQPData%Oe) + if (.not. allocated(DstEqMotionQPData%Oe)) then + allocate(DstEqMotionQPData%Oe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Oe.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Oe = SrcEqMotionQPData%Oe + end if + if (allocated(SrcEqMotionQPData%Pe)) then + LB(1:4) = lbound(SrcEqMotionQPData%Pe) + UB(1:4) = ubound(SrcEqMotionQPData%Pe) + if (.not. allocated(DstEqMotionQPData%Pe)) then + allocate(DstEqMotionQPData%Pe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Pe.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Pe = SrcEqMotionQPData%Pe + end if + if (allocated(SrcEqMotionQPData%Qe)) then + LB(1:4) = lbound(SrcEqMotionQPData%Qe) + UB(1:4) = ubound(SrcEqMotionQPData%Qe) + if (.not. allocated(DstEqMotionQPData%Qe)) then + allocate(DstEqMotionQPData%Qe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Qe.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Qe = SrcEqMotionQPData%Qe + end if + if (allocated(SrcEqMotionQPData%Gd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Gd) + UB(1:4) = ubound(SrcEqMotionQPData%Gd) + if (.not. allocated(DstEqMotionQPData%Gd)) then + allocate(DstEqMotionQPData%Gd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Gd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Gd = SrcEqMotionQPData%Gd + end if + if (allocated(SrcEqMotionQPData%Od)) then + LB(1:4) = lbound(SrcEqMotionQPData%Od) + UB(1:4) = ubound(SrcEqMotionQPData%Od) + if (.not. allocated(DstEqMotionQPData%Od)) then + allocate(DstEqMotionQPData%Od(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Od.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Od = SrcEqMotionQPData%Od + end if + if (allocated(SrcEqMotionQPData%Pd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Pd) + UB(1:4) = ubound(SrcEqMotionQPData%Pd) + if (.not. allocated(DstEqMotionQPData%Pd)) then + allocate(DstEqMotionQPData%Pd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Pd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Pd = SrcEqMotionQPData%Pd + end if + if (allocated(SrcEqMotionQPData%Qd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Qd) + UB(1:4) = ubound(SrcEqMotionQPData%Qd) + if (.not. allocated(DstEqMotionQPData%Qd)) then + allocate(DstEqMotionQPData%Qd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Qd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Qd = SrcEqMotionQPData%Qd + end if + if (allocated(SrcEqMotionQPData%Sd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Sd) + UB(1:4) = ubound(SrcEqMotionQPData%Sd) + if (.not. allocated(DstEqMotionQPData%Sd)) then + allocate(DstEqMotionQPData%Sd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Sd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Sd = SrcEqMotionQPData%Sd + end if + if (allocated(SrcEqMotionQPData%Xd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Xd) + UB(1:4) = ubound(SrcEqMotionQPData%Xd) + if (.not. allocated(DstEqMotionQPData%Xd)) then + allocate(DstEqMotionQPData%Xd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Xd = SrcEqMotionQPData%Xd + end if + if (allocated(SrcEqMotionQPData%Yd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Yd) + UB(1:4) = ubound(SrcEqMotionQPData%Yd) + if (.not. allocated(DstEqMotionQPData%Yd)) then + allocate(DstEqMotionQPData%Yd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Yd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Yd = SrcEqMotionQPData%Yd + end if +end subroutine + +subroutine BD_DestroyEqMotionQP(EqMotionQPData, ErrStat, ErrMsg) + type(EqMotionQP), intent(inout) :: EqMotionQPData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyEqMotionQP' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(EqMotionQPData%uuu)) then + deallocate(EqMotionQPData%uuu) + end if + if (allocated(EqMotionQPData%uup)) then + deallocate(EqMotionQPData%uup) + end if + if (allocated(EqMotionQPData%vvv)) then + deallocate(EqMotionQPData%vvv) + end if + if (allocated(EqMotionQPData%vvp)) then + deallocate(EqMotionQPData%vvp) + end if + if (allocated(EqMotionQPData%aaa)) then + deallocate(EqMotionQPData%aaa) + end if + if (allocated(EqMotionQPData%RR0)) then + deallocate(EqMotionQPData%RR0) + end if + if (allocated(EqMotionQPData%kappa)) then + deallocate(EqMotionQPData%kappa) + end if + if (allocated(EqMotionQPData%E1)) then + deallocate(EqMotionQPData%E1) + end if + if (allocated(EqMotionQPData%Stif)) then + deallocate(EqMotionQPData%Stif) + end if + if (allocated(EqMotionQPData%Fb)) then + deallocate(EqMotionQPData%Fb) + end if + if (allocated(EqMotionQPData%Fc)) then + deallocate(EqMotionQPData%Fc) + end if + if (allocated(EqMotionQPData%Fd)) then + deallocate(EqMotionQPData%Fd) + end if + if (allocated(EqMotionQPData%Fg)) then + deallocate(EqMotionQPData%Fg) + end if + if (allocated(EqMotionQPData%Fi)) then + deallocate(EqMotionQPData%Fi) + end if + if (allocated(EqMotionQPData%Ftemp)) then + deallocate(EqMotionQPData%Ftemp) + end if + if (allocated(EqMotionQPData%RR0mEta)) then + deallocate(EqMotionQPData%RR0mEta) + end if + if (allocated(EqMotionQPData%rho)) then + deallocate(EqMotionQPData%rho) + end if + if (allocated(EqMotionQPData%betaC)) then + deallocate(EqMotionQPData%betaC) + end if + if (allocated(EqMotionQPData%Gi)) then + deallocate(EqMotionQPData%Gi) + end if + if (allocated(EqMotionQPData%Ki)) then + deallocate(EqMotionQPData%Ki) + end if + if (allocated(EqMotionQPData%Mi)) then + deallocate(EqMotionQPData%Mi) + end if + if (allocated(EqMotionQPData%Oe)) then + deallocate(EqMotionQPData%Oe) + end if + if (allocated(EqMotionQPData%Pe)) then + deallocate(EqMotionQPData%Pe) + end if + if (allocated(EqMotionQPData%Qe)) then + deallocate(EqMotionQPData%Qe) + end if + if (allocated(EqMotionQPData%Gd)) then + deallocate(EqMotionQPData%Gd) + end if + if (allocated(EqMotionQPData%Od)) then + deallocate(EqMotionQPData%Od) + end if + if (allocated(EqMotionQPData%Pd)) then + deallocate(EqMotionQPData%Pd) + end if + if (allocated(EqMotionQPData%Qd)) then + deallocate(EqMotionQPData%Qd) + end if + if (allocated(EqMotionQPData%Sd)) then + deallocate(EqMotionQPData%Sd) + end if + if (allocated(EqMotionQPData%Xd)) then + deallocate(EqMotionQPData%Xd) + end if + if (allocated(EqMotionQPData%Yd)) then + deallocate(EqMotionQPData%Yd) + end if +end subroutine + +subroutine BD_PackEqMotionQP(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(EqMotionQP), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackEqMotionQP' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%uuu)) + if (allocated(InData%uuu)) then + call RegPackBounds(Buf, 3, lbound(InData%uuu), ubound(InData%uuu)) + call RegPack(Buf, InData%uuu) + end if + call RegPack(Buf, allocated(InData%uup)) + if (allocated(InData%uup)) then + call RegPackBounds(Buf, 3, lbound(InData%uup), ubound(InData%uup)) + call RegPack(Buf, InData%uup) + end if + call RegPack(Buf, allocated(InData%vvv)) + if (allocated(InData%vvv)) then + call RegPackBounds(Buf, 3, lbound(InData%vvv), ubound(InData%vvv)) + call RegPack(Buf, InData%vvv) + end if + call RegPack(Buf, allocated(InData%vvp)) + if (allocated(InData%vvp)) then + call RegPackBounds(Buf, 3, lbound(InData%vvp), ubound(InData%vvp)) + call RegPack(Buf, InData%vvp) + end if + call RegPack(Buf, allocated(InData%aaa)) + if (allocated(InData%aaa)) then + call RegPackBounds(Buf, 3, lbound(InData%aaa), ubound(InData%aaa)) + call RegPack(Buf, InData%aaa) + end if + call RegPack(Buf, allocated(InData%RR0)) + if (allocated(InData%RR0)) then + call RegPackBounds(Buf, 4, lbound(InData%RR0), ubound(InData%RR0)) + call RegPack(Buf, InData%RR0) + end if + call RegPack(Buf, allocated(InData%kappa)) + if (allocated(InData%kappa)) then + call RegPackBounds(Buf, 3, lbound(InData%kappa), ubound(InData%kappa)) + call RegPack(Buf, InData%kappa) + end if + call RegPack(Buf, allocated(InData%E1)) + if (allocated(InData%E1)) then + call RegPackBounds(Buf, 3, lbound(InData%E1), ubound(InData%E1)) + call RegPack(Buf, InData%E1) + end if + call RegPack(Buf, allocated(InData%Stif)) + if (allocated(InData%Stif)) then + call RegPackBounds(Buf, 4, lbound(InData%Stif), ubound(InData%Stif)) + call RegPack(Buf, InData%Stif) + end if + call RegPack(Buf, allocated(InData%Fb)) + if (allocated(InData%Fb)) then + call RegPackBounds(Buf, 3, lbound(InData%Fb), ubound(InData%Fb)) + call RegPack(Buf, InData%Fb) + end if + call RegPack(Buf, allocated(InData%Fc)) + if (allocated(InData%Fc)) then + call RegPackBounds(Buf, 3, lbound(InData%Fc), ubound(InData%Fc)) + call RegPack(Buf, InData%Fc) + end if + call RegPack(Buf, allocated(InData%Fd)) + if (allocated(InData%Fd)) then + call RegPackBounds(Buf, 3, lbound(InData%Fd), ubound(InData%Fd)) + call RegPack(Buf, InData%Fd) + end if + call RegPack(Buf, allocated(InData%Fg)) + if (allocated(InData%Fg)) then + call RegPackBounds(Buf, 3, lbound(InData%Fg), ubound(InData%Fg)) + call RegPack(Buf, InData%Fg) + end if + call RegPack(Buf, allocated(InData%Fi)) + if (allocated(InData%Fi)) then + call RegPackBounds(Buf, 3, lbound(InData%Fi), ubound(InData%Fi)) + call RegPack(Buf, InData%Fi) + end if + call RegPack(Buf, allocated(InData%Ftemp)) + if (allocated(InData%Ftemp)) then + call RegPackBounds(Buf, 3, lbound(InData%Ftemp), ubound(InData%Ftemp)) + call RegPack(Buf, InData%Ftemp) + end if + call RegPack(Buf, allocated(InData%RR0mEta)) + if (allocated(InData%RR0mEta)) then + call RegPackBounds(Buf, 3, lbound(InData%RR0mEta), ubound(InData%RR0mEta)) + call RegPack(Buf, InData%RR0mEta) + end if + call RegPack(Buf, allocated(InData%rho)) + if (allocated(InData%rho)) then + call RegPackBounds(Buf, 4, lbound(InData%rho), ubound(InData%rho)) + call RegPack(Buf, InData%rho) + end if + call RegPack(Buf, allocated(InData%betaC)) + if (allocated(InData%betaC)) then + call RegPackBounds(Buf, 4, lbound(InData%betaC), ubound(InData%betaC)) + call RegPack(Buf, InData%betaC) + end if + call RegPack(Buf, allocated(InData%Gi)) + if (allocated(InData%Gi)) then + call RegPackBounds(Buf, 4, lbound(InData%Gi), ubound(InData%Gi)) + call RegPack(Buf, InData%Gi) + end if + call RegPack(Buf, allocated(InData%Ki)) + if (allocated(InData%Ki)) then + call RegPackBounds(Buf, 4, lbound(InData%Ki), ubound(InData%Ki)) + call RegPack(Buf, InData%Ki) + end if + call RegPack(Buf, allocated(InData%Mi)) + if (allocated(InData%Mi)) then + call RegPackBounds(Buf, 4, lbound(InData%Mi), ubound(InData%Mi)) + call RegPack(Buf, InData%Mi) + end if + call RegPack(Buf, allocated(InData%Oe)) + if (allocated(InData%Oe)) then + call RegPackBounds(Buf, 4, lbound(InData%Oe), ubound(InData%Oe)) + call RegPack(Buf, InData%Oe) + end if + call RegPack(Buf, allocated(InData%Pe)) + if (allocated(InData%Pe)) then + call RegPackBounds(Buf, 4, lbound(InData%Pe), ubound(InData%Pe)) + call RegPack(Buf, InData%Pe) + end if + call RegPack(Buf, allocated(InData%Qe)) + if (allocated(InData%Qe)) then + call RegPackBounds(Buf, 4, lbound(InData%Qe), ubound(InData%Qe)) + call RegPack(Buf, InData%Qe) + end if + call RegPack(Buf, allocated(InData%Gd)) + if (allocated(InData%Gd)) then + call RegPackBounds(Buf, 4, lbound(InData%Gd), ubound(InData%Gd)) + call RegPack(Buf, InData%Gd) + end if + call RegPack(Buf, allocated(InData%Od)) + if (allocated(InData%Od)) then + call RegPackBounds(Buf, 4, lbound(InData%Od), ubound(InData%Od)) + call RegPack(Buf, InData%Od) + end if + call RegPack(Buf, allocated(InData%Pd)) + if (allocated(InData%Pd)) then + call RegPackBounds(Buf, 4, lbound(InData%Pd), ubound(InData%Pd)) + call RegPack(Buf, InData%Pd) + end if + call RegPack(Buf, allocated(InData%Qd)) + if (allocated(InData%Qd)) then + call RegPackBounds(Buf, 4, lbound(InData%Qd), ubound(InData%Qd)) + call RegPack(Buf, InData%Qd) + end if + call RegPack(Buf, allocated(InData%Sd)) + if (allocated(InData%Sd)) then + call RegPackBounds(Buf, 4, lbound(InData%Sd), ubound(InData%Sd)) + call RegPack(Buf, InData%Sd) + end if + call RegPack(Buf, allocated(InData%Xd)) + if (allocated(InData%Xd)) then + call RegPackBounds(Buf, 4, lbound(InData%Xd), ubound(InData%Xd)) + call RegPack(Buf, InData%Xd) + end if + call RegPack(Buf, allocated(InData%Yd)) + if (allocated(InData%Yd)) then + call RegPackBounds(Buf, 4, lbound(InData%Yd), ubound(InData%Yd)) + call RegPack(Buf, InData%Yd) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackEqMotionQP(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(EqMotionQP), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackEqMotionQP' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%uuu)) deallocate(OutData%uuu) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uuu(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uuu.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uuu) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%uup)) deallocate(OutData%uup) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uup(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uup.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uup) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%vvv)) deallocate(OutData%vvv) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vvv(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vvv.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vvv) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%vvp)) deallocate(OutData%vvp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vvp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vvp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vvp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%aaa)) deallocate(OutData%aaa) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%aaa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%aaa.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%aaa) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RR0)) deallocate(OutData%RR0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RR0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RR0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RR0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%kappa)) deallocate(OutData%kappa) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%kappa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%kappa.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%kappa) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%E1)) deallocate(OutData%E1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%E1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%E1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%E1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Stif)) deallocate(OutData%Stif) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Stif(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stif.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Stif) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Fb)) deallocate(OutData%Fb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fb(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fb) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Fc)) deallocate(OutData%Fc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fc) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Fd)) deallocate(OutData%Fd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Fg)) deallocate(OutData%Fg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fg) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Fi)) deallocate(OutData%Fi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Ftemp)) deallocate(OutData%Ftemp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ftemp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ftemp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ftemp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RR0mEta)) deallocate(OutData%RR0mEta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RR0mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RR0mEta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RR0mEta) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rho)) deallocate(OutData%rho) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rho(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rho.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rho) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%betaC)) deallocate(OutData%betaC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%betaC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%betaC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%betaC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Gi)) deallocate(OutData%Gi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Gi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Gi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Ki)) deallocate(OutData%Ki) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ki(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ki.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ki) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Mi)) deallocate(OutData%Mi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Mi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Oe)) deallocate(OutData%Oe) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Oe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Oe.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Oe) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Pe)) deallocate(OutData%Pe) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Pe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pe.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Pe) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Qe)) deallocate(OutData%Qe) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Qe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Qe.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Qe) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Gd)) deallocate(OutData%Gd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Gd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Gd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Od)) deallocate(OutData%Od) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Od(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Od.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Od) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Pd)) deallocate(OutData%Pd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Pd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Pd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Qd)) deallocate(OutData%Qd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Qd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Qd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Qd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Sd)) deallocate(OutData%Sd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Sd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Sd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Sd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Xd)) deallocate(OutData%Xd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Xd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Xd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Yd)) deallocate(OutData%Yd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Yd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Yd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Yd) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(BD_MiscVarType), intent(inout) :: SrcMiscData + type(BD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcMiscData%u_DistrLoad_at_y, DstMiscData%u_DistrLoad_at_y, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMiscData%y_BldMotion_at_u, DstMiscData%y_BldMotion_at_u, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcMiscData%Map_u_DistrLoad_to_y, DstMiscData%Map_u_DistrLoad_to_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcMiscData%Map_y_BldMotion_to_u, DstMiscData%Map_y_BldMotion_to_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%Un_Sum = SrcMiscData%Un_Sum + call BD_CopyEqMotionQP(SrcMiscData%qp, DstMiscData%qp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%lin_A)) then + LB(1:2) = lbound(SrcMiscData%lin_A) + UB(1:2) = ubound(SrcMiscData%lin_A) + if (.not. allocated(DstMiscData%lin_A)) then + allocate(DstMiscData%lin_A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%lin_A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%lin_A = SrcMiscData%lin_A + end if + if (allocated(SrcMiscData%lin_C)) then + LB(1:2) = lbound(SrcMiscData%lin_C) + UB(1:2) = ubound(SrcMiscData%lin_C) + if (.not. allocated(DstMiscData%lin_C)) then + allocate(DstMiscData%lin_C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%lin_C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%lin_C = SrcMiscData%lin_C + end if + if (allocated(SrcMiscData%Nrrr)) then + LB(1:3) = lbound(SrcMiscData%Nrrr) + UB(1:3) = ubound(SrcMiscData%Nrrr) + if (.not. allocated(DstMiscData%Nrrr)) then + allocate(DstMiscData%Nrrr(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Nrrr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Nrrr = SrcMiscData%Nrrr + end if + if (allocated(SrcMiscData%elf)) then + LB(1:2) = lbound(SrcMiscData%elf) + UB(1:2) = ubound(SrcMiscData%elf) + if (.not. allocated(DstMiscData%elf)) then + allocate(DstMiscData%elf(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elf.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%elf = SrcMiscData%elf + end if + if (allocated(SrcMiscData%EFint)) then + LB(1:3) = lbound(SrcMiscData%EFint) + UB(1:3) = ubound(SrcMiscData%EFint) + if (.not. allocated(DstMiscData%EFint)) then + allocate(DstMiscData%EFint(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%EFint.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%EFint = SrcMiscData%EFint + end if + if (allocated(SrcMiscData%elk)) then + LB(1:4) = lbound(SrcMiscData%elk) + UB(1:4) = ubound(SrcMiscData%elk) + if (.not. allocated(DstMiscData%elk)) then + allocate(DstMiscData%elk(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elk.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%elk = SrcMiscData%elk + end if + if (allocated(SrcMiscData%elg)) then + LB(1:4) = lbound(SrcMiscData%elg) + UB(1:4) = ubound(SrcMiscData%elg) + if (.not. allocated(DstMiscData%elg)) then + allocate(DstMiscData%elg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%elg = SrcMiscData%elg + end if + if (allocated(SrcMiscData%elm)) then + LB(1:4) = lbound(SrcMiscData%elm) + UB(1:4) = ubound(SrcMiscData%elm) + if (.not. allocated(DstMiscData%elm)) then + allocate(DstMiscData%elm(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%elm = SrcMiscData%elm + end if + if (allocated(SrcMiscData%DistrLoad_QP)) then + LB(1:3) = lbound(SrcMiscData%DistrLoad_QP) + UB(1:3) = ubound(SrcMiscData%DistrLoad_QP) + if (.not. allocated(DstMiscData%DistrLoad_QP)) then + allocate(DstMiscData%DistrLoad_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DistrLoad_QP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DistrLoad_QP = SrcMiscData%DistrLoad_QP + end if + if (allocated(SrcMiscData%PointLoadLcl)) then + LB(1:2) = lbound(SrcMiscData%PointLoadLcl) + UB(1:2) = ubound(SrcMiscData%PointLoadLcl) + if (.not. allocated(DstMiscData%PointLoadLcl)) then + allocate(DstMiscData%PointLoadLcl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointLoadLcl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%PointLoadLcl = SrcMiscData%PointLoadLcl + end if + if (allocated(SrcMiscData%StifK)) then + LB(1:4) = lbound(SrcMiscData%StifK) + UB(1:4) = ubound(SrcMiscData%StifK) + if (.not. allocated(DstMiscData%StifK)) then + allocate(DstMiscData%StifK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StifK.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%StifK = SrcMiscData%StifK + end if + if (allocated(SrcMiscData%MassM)) then + LB(1:4) = lbound(SrcMiscData%MassM) + UB(1:4) = ubound(SrcMiscData%MassM) + if (.not. allocated(DstMiscData%MassM)) then + allocate(DstMiscData%MassM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MassM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%MassM = SrcMiscData%MassM + end if + if (allocated(SrcMiscData%DampG)) then + LB(1:4) = lbound(SrcMiscData%DampG) + UB(1:4) = ubound(SrcMiscData%DampG) + if (.not. allocated(DstMiscData%DampG)) then + allocate(DstMiscData%DampG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DampG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DampG = SrcMiscData%DampG + end if + if (allocated(SrcMiscData%StifK_fd)) then + LB(1:4) = lbound(SrcMiscData%StifK_fd) + UB(1:4) = ubound(SrcMiscData%StifK_fd) + if (.not. allocated(DstMiscData%StifK_fd)) then + allocate(DstMiscData%StifK_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StifK_fd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%StifK_fd = SrcMiscData%StifK_fd + end if + if (allocated(SrcMiscData%MassM_fd)) then + LB(1:4) = lbound(SrcMiscData%MassM_fd) + UB(1:4) = ubound(SrcMiscData%MassM_fd) + if (.not. allocated(DstMiscData%MassM_fd)) then + allocate(DstMiscData%MassM_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MassM_fd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%MassM_fd = SrcMiscData%MassM_fd + end if + if (allocated(SrcMiscData%DampG_fd)) then + LB(1:4) = lbound(SrcMiscData%DampG_fd) + UB(1:4) = ubound(SrcMiscData%DampG_fd) + if (.not. allocated(DstMiscData%DampG_fd)) then + allocate(DstMiscData%DampG_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DampG_fd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DampG_fd = SrcMiscData%DampG_fd + end if + if (allocated(SrcMiscData%RHS)) then + LB(1:2) = lbound(SrcMiscData%RHS) + UB(1:2) = ubound(SrcMiscData%RHS) + if (.not. allocated(DstMiscData%RHS)) then + allocate(DstMiscData%RHS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RHS = SrcMiscData%RHS + end if + if (allocated(SrcMiscData%RHS_p)) then + LB(1:2) = lbound(SrcMiscData%RHS_p) + UB(1:2) = ubound(SrcMiscData%RHS_p) + if (.not. allocated(DstMiscData%RHS_p)) then + allocate(DstMiscData%RHS_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS_p.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RHS_p = SrcMiscData%RHS_p + end if + if (allocated(SrcMiscData%RHS_m)) then + LB(1:2) = lbound(SrcMiscData%RHS_m) + UB(1:2) = ubound(SrcMiscData%RHS_m) + if (.not. allocated(DstMiscData%RHS_m)) then + allocate(DstMiscData%RHS_m(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS_m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RHS_m = SrcMiscData%RHS_m + end if + if (allocated(SrcMiscData%BldInternalForceFE)) then + LB(1:2) = lbound(SrcMiscData%BldInternalForceFE) + UB(1:2) = ubound(SrcMiscData%BldInternalForceFE) + if (.not. allocated(DstMiscData%BldInternalForceFE)) then + allocate(DstMiscData%BldInternalForceFE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BldInternalForceFE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BldInternalForceFE = SrcMiscData%BldInternalForceFE + end if + if (allocated(SrcMiscData%BldInternalForceQP)) then + LB(1:2) = lbound(SrcMiscData%BldInternalForceQP) + UB(1:2) = ubound(SrcMiscData%BldInternalForceQP) + if (.not. allocated(DstMiscData%BldInternalForceQP)) then + allocate(DstMiscData%BldInternalForceQP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BldInternalForceQP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BldInternalForceQP = SrcMiscData%BldInternalForceQP + end if + if (allocated(SrcMiscData%FirstNodeReactionLclForceMoment)) then + LB(1:1) = lbound(SrcMiscData%FirstNodeReactionLclForceMoment) + UB(1:1) = ubound(SrcMiscData%FirstNodeReactionLclForceMoment) + if (.not. allocated(DstMiscData%FirstNodeReactionLclForceMoment)) then + allocate(DstMiscData%FirstNodeReactionLclForceMoment(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FirstNodeReactionLclForceMoment.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FirstNodeReactionLclForceMoment = SrcMiscData%FirstNodeReactionLclForceMoment + end if + if (allocated(SrcMiscData%Solution)) then + LB(1:2) = lbound(SrcMiscData%Solution) + UB(1:2) = ubound(SrcMiscData%Solution) + if (.not. allocated(DstMiscData%Solution)) then + allocate(DstMiscData%Solution(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Solution.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Solution = SrcMiscData%Solution + end if + if (allocated(SrcMiscData%LP_StifK)) then + LB(1:2) = lbound(SrcMiscData%LP_StifK) + UB(1:2) = ubound(SrcMiscData%LP_StifK) + if (.not. allocated(DstMiscData%LP_StifK)) then + allocate(DstMiscData%LP_StifK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_StifK.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_StifK = SrcMiscData%LP_StifK + end if + if (allocated(SrcMiscData%LP_MassM)) then + LB(1:2) = lbound(SrcMiscData%LP_MassM) + UB(1:2) = ubound(SrcMiscData%LP_MassM) + if (.not. allocated(DstMiscData%LP_MassM)) then + allocate(DstMiscData%LP_MassM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_MassM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_MassM = SrcMiscData%LP_MassM + end if + if (allocated(SrcMiscData%LP_MassM_LU)) then + LB(1:2) = lbound(SrcMiscData%LP_MassM_LU) + UB(1:2) = ubound(SrcMiscData%LP_MassM_LU) + if (.not. allocated(DstMiscData%LP_MassM_LU)) then + allocate(DstMiscData%LP_MassM_LU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_MassM_LU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_MassM_LU = SrcMiscData%LP_MassM_LU + end if + if (allocated(SrcMiscData%LP_RHS)) then + LB(1:1) = lbound(SrcMiscData%LP_RHS) + UB(1:1) = ubound(SrcMiscData%LP_RHS) + if (.not. allocated(DstMiscData%LP_RHS)) then + allocate(DstMiscData%LP_RHS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_RHS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_RHS = SrcMiscData%LP_RHS + end if + if (allocated(SrcMiscData%LP_StifK_LU)) then + LB(1:2) = lbound(SrcMiscData%LP_StifK_LU) + UB(1:2) = ubound(SrcMiscData%LP_StifK_LU) + if (.not. allocated(DstMiscData%LP_StifK_LU)) then + allocate(DstMiscData%LP_StifK_LU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_StifK_LU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_StifK_LU = SrcMiscData%LP_StifK_LU + end if + if (allocated(SrcMiscData%LP_RHS_LU)) then + LB(1:1) = lbound(SrcMiscData%LP_RHS_LU) + UB(1:1) = ubound(SrcMiscData%LP_RHS_LU) + if (.not. allocated(DstMiscData%LP_RHS_LU)) then + allocate(DstMiscData%LP_RHS_LU(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_RHS_LU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_RHS_LU = SrcMiscData%LP_RHS_LU + end if + if (allocated(SrcMiscData%LP_indx)) then + LB(1:1) = lbound(SrcMiscData%LP_indx) + UB(1:1) = ubound(SrcMiscData%LP_indx) + if (.not. allocated(DstMiscData%LP_indx)) then + allocate(DstMiscData%LP_indx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_indx = SrcMiscData%LP_indx + end if + call BD_CopyInput(SrcMiscData%u, DstMiscData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BD_CopyInput(SrcMiscData%u2, DstMiscData%u2, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine BD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(BD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%lin_A)) then + deallocate(MiscData%lin_A) + end if + if (allocated(MiscData%lin_C)) then + deallocate(MiscData%lin_C) + end if + if (allocated(MiscData%Nrrr)) then + deallocate(MiscData%Nrrr) + end if + if (allocated(MiscData%elf)) then + deallocate(MiscData%elf) + end if + if (allocated(MiscData%EFint)) then + deallocate(MiscData%EFint) + end if + if (allocated(MiscData%elk)) then + deallocate(MiscData%elk) + end if + if (allocated(MiscData%elg)) then + deallocate(MiscData%elg) + end if + if (allocated(MiscData%elm)) then + deallocate(MiscData%elm) + end if + if (allocated(MiscData%DistrLoad_QP)) then + deallocate(MiscData%DistrLoad_QP) + end if + if (allocated(MiscData%PointLoadLcl)) then + deallocate(MiscData%PointLoadLcl) + end if + if (allocated(MiscData%StifK)) then + deallocate(MiscData%StifK) + end if + if (allocated(MiscData%MassM)) then + deallocate(MiscData%MassM) + end if + if (allocated(MiscData%DampG)) then + deallocate(MiscData%DampG) + end if + if (allocated(MiscData%StifK_fd)) then + deallocate(MiscData%StifK_fd) + end if + if (allocated(MiscData%MassM_fd)) then + deallocate(MiscData%MassM_fd) + end if + if (allocated(MiscData%DampG_fd)) then + deallocate(MiscData%DampG_fd) + end if + if (allocated(MiscData%RHS)) then + deallocate(MiscData%RHS) + end if + if (allocated(MiscData%RHS_p)) then + deallocate(MiscData%RHS_p) + end if + if (allocated(MiscData%RHS_m)) then + deallocate(MiscData%RHS_m) + end if + if (allocated(MiscData%BldInternalForceFE)) then + deallocate(MiscData%BldInternalForceFE) + end if + if (allocated(MiscData%BldInternalForceQP)) then + deallocate(MiscData%BldInternalForceQP) + end if + if (allocated(MiscData%FirstNodeReactionLclForceMoment)) then + deallocate(MiscData%FirstNodeReactionLclForceMoment) + end if + if (allocated(MiscData%Solution)) then + deallocate(MiscData%Solution) + end if + if (allocated(MiscData%LP_StifK)) then + deallocate(MiscData%LP_StifK) + end if + if (allocated(MiscData%LP_MassM)) then + deallocate(MiscData%LP_MassM) + end if + if (allocated(MiscData%LP_MassM_LU)) then + deallocate(MiscData%LP_MassM_LU) + end if + if (allocated(MiscData%LP_RHS)) then + deallocate(MiscData%LP_RHS) + end if + if (allocated(MiscData%LP_StifK_LU)) then + deallocate(MiscData%LP_StifK_LU) + end if + if (allocated(MiscData%LP_RHS_LU)) then + deallocate(MiscData%LP_RHS_LU) + end if + if (allocated(MiscData%LP_indx)) then + deallocate(MiscData%LP_indx) + end if + call BD_DestroyInput(MiscData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyInput(MiscData%u2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine BD_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%u_DistrLoad_at_y) + call MeshPack(Buf, InData%y_BldMotion_at_u) + call NWTC_Library_PackMeshMapType(Buf, InData%Map_u_DistrLoad_to_y) + call NWTC_Library_PackMeshMapType(Buf, InData%Map_y_BldMotion_to_u) + call RegPack(Buf, InData%Un_Sum) + call BD_PackEqMotionQP(Buf, InData%qp) + call RegPack(Buf, allocated(InData%lin_A)) + if (allocated(InData%lin_A)) then + call RegPackBounds(Buf, 2, lbound(InData%lin_A), ubound(InData%lin_A)) + call RegPack(Buf, InData%lin_A) + end if + call RegPack(Buf, allocated(InData%lin_C)) + if (allocated(InData%lin_C)) then + call RegPackBounds(Buf, 2, lbound(InData%lin_C), ubound(InData%lin_C)) + call RegPack(Buf, InData%lin_C) + end if + call RegPack(Buf, allocated(InData%Nrrr)) + if (allocated(InData%Nrrr)) then + call RegPackBounds(Buf, 3, lbound(InData%Nrrr), ubound(InData%Nrrr)) + call RegPack(Buf, InData%Nrrr) + end if + call RegPack(Buf, allocated(InData%elf)) + if (allocated(InData%elf)) then + call RegPackBounds(Buf, 2, lbound(InData%elf), ubound(InData%elf)) + call RegPack(Buf, InData%elf) + end if + call RegPack(Buf, allocated(InData%EFint)) + if (allocated(InData%EFint)) then + call RegPackBounds(Buf, 3, lbound(InData%EFint), ubound(InData%EFint)) + call RegPack(Buf, InData%EFint) + end if + call RegPack(Buf, allocated(InData%elk)) + if (allocated(InData%elk)) then + call RegPackBounds(Buf, 4, lbound(InData%elk), ubound(InData%elk)) + call RegPack(Buf, InData%elk) + end if + call RegPack(Buf, allocated(InData%elg)) + if (allocated(InData%elg)) then + call RegPackBounds(Buf, 4, lbound(InData%elg), ubound(InData%elg)) + call RegPack(Buf, InData%elg) + end if + call RegPack(Buf, allocated(InData%elm)) + if (allocated(InData%elm)) then + call RegPackBounds(Buf, 4, lbound(InData%elm), ubound(InData%elm)) + call RegPack(Buf, InData%elm) + end if + call RegPack(Buf, allocated(InData%DistrLoad_QP)) + if (allocated(InData%DistrLoad_QP)) then + call RegPackBounds(Buf, 3, lbound(InData%DistrLoad_QP), ubound(InData%DistrLoad_QP)) + call RegPack(Buf, InData%DistrLoad_QP) + end if + call RegPack(Buf, allocated(InData%PointLoadLcl)) + if (allocated(InData%PointLoadLcl)) then + call RegPackBounds(Buf, 2, lbound(InData%PointLoadLcl), ubound(InData%PointLoadLcl)) + call RegPack(Buf, InData%PointLoadLcl) + end if + call RegPack(Buf, allocated(InData%StifK)) + if (allocated(InData%StifK)) then + call RegPackBounds(Buf, 4, lbound(InData%StifK), ubound(InData%StifK)) + call RegPack(Buf, InData%StifK) + end if + call RegPack(Buf, allocated(InData%MassM)) + if (allocated(InData%MassM)) then + call RegPackBounds(Buf, 4, lbound(InData%MassM), ubound(InData%MassM)) + call RegPack(Buf, InData%MassM) + end if + call RegPack(Buf, allocated(InData%DampG)) + if (allocated(InData%DampG)) then + call RegPackBounds(Buf, 4, lbound(InData%DampG), ubound(InData%DampG)) + call RegPack(Buf, InData%DampG) + end if + call RegPack(Buf, allocated(InData%StifK_fd)) + if (allocated(InData%StifK_fd)) then + call RegPackBounds(Buf, 4, lbound(InData%StifK_fd), ubound(InData%StifK_fd)) + call RegPack(Buf, InData%StifK_fd) + end if + call RegPack(Buf, allocated(InData%MassM_fd)) + if (allocated(InData%MassM_fd)) then + call RegPackBounds(Buf, 4, lbound(InData%MassM_fd), ubound(InData%MassM_fd)) + call RegPack(Buf, InData%MassM_fd) + end if + call RegPack(Buf, allocated(InData%DampG_fd)) + if (allocated(InData%DampG_fd)) then + call RegPackBounds(Buf, 4, lbound(InData%DampG_fd), ubound(InData%DampG_fd)) + call RegPack(Buf, InData%DampG_fd) + end if + call RegPack(Buf, allocated(InData%RHS)) + if (allocated(InData%RHS)) then + call RegPackBounds(Buf, 2, lbound(InData%RHS), ubound(InData%RHS)) + call RegPack(Buf, InData%RHS) + end if + call RegPack(Buf, allocated(InData%RHS_p)) + if (allocated(InData%RHS_p)) then + call RegPackBounds(Buf, 2, lbound(InData%RHS_p), ubound(InData%RHS_p)) + call RegPack(Buf, InData%RHS_p) + end if + call RegPack(Buf, allocated(InData%RHS_m)) + if (allocated(InData%RHS_m)) then + call RegPackBounds(Buf, 2, lbound(InData%RHS_m), ubound(InData%RHS_m)) + call RegPack(Buf, InData%RHS_m) + end if + call RegPack(Buf, allocated(InData%BldInternalForceFE)) + if (allocated(InData%BldInternalForceFE)) then + call RegPackBounds(Buf, 2, lbound(InData%BldInternalForceFE), ubound(InData%BldInternalForceFE)) + call RegPack(Buf, InData%BldInternalForceFE) + end if + call RegPack(Buf, allocated(InData%BldInternalForceQP)) + if (allocated(InData%BldInternalForceQP)) then + call RegPackBounds(Buf, 2, lbound(InData%BldInternalForceQP), ubound(InData%BldInternalForceQP)) + call RegPack(Buf, InData%BldInternalForceQP) + end if + call RegPack(Buf, allocated(InData%FirstNodeReactionLclForceMoment)) + if (allocated(InData%FirstNodeReactionLclForceMoment)) then + call RegPackBounds(Buf, 1, lbound(InData%FirstNodeReactionLclForceMoment), ubound(InData%FirstNodeReactionLclForceMoment)) + call RegPack(Buf, InData%FirstNodeReactionLclForceMoment) + end if + call RegPack(Buf, allocated(InData%Solution)) + if (allocated(InData%Solution)) then + call RegPackBounds(Buf, 2, lbound(InData%Solution), ubound(InData%Solution)) + call RegPack(Buf, InData%Solution) + end if + call RegPack(Buf, allocated(InData%LP_StifK)) + if (allocated(InData%LP_StifK)) then + call RegPackBounds(Buf, 2, lbound(InData%LP_StifK), ubound(InData%LP_StifK)) + call RegPack(Buf, InData%LP_StifK) + end if + call RegPack(Buf, allocated(InData%LP_MassM)) + if (allocated(InData%LP_MassM)) then + call RegPackBounds(Buf, 2, lbound(InData%LP_MassM), ubound(InData%LP_MassM)) + call RegPack(Buf, InData%LP_MassM) + end if + call RegPack(Buf, allocated(InData%LP_MassM_LU)) + if (allocated(InData%LP_MassM_LU)) then + call RegPackBounds(Buf, 2, lbound(InData%LP_MassM_LU), ubound(InData%LP_MassM_LU)) + call RegPack(Buf, InData%LP_MassM_LU) + end if + call RegPack(Buf, allocated(InData%LP_RHS)) + if (allocated(InData%LP_RHS)) then + call RegPackBounds(Buf, 1, lbound(InData%LP_RHS), ubound(InData%LP_RHS)) + call RegPack(Buf, InData%LP_RHS) + end if + call RegPack(Buf, allocated(InData%LP_StifK_LU)) + if (allocated(InData%LP_StifK_LU)) then + call RegPackBounds(Buf, 2, lbound(InData%LP_StifK_LU), ubound(InData%LP_StifK_LU)) + call RegPack(Buf, InData%LP_StifK_LU) + end if + call RegPack(Buf, allocated(InData%LP_RHS_LU)) + if (allocated(InData%LP_RHS_LU)) then + call RegPackBounds(Buf, 1, lbound(InData%LP_RHS_LU), ubound(InData%LP_RHS_LU)) + call RegPack(Buf, InData%LP_RHS_LU) + end if + call RegPack(Buf, allocated(InData%LP_indx)) + if (allocated(InData%LP_indx)) then + call RegPackBounds(Buf, 1, lbound(InData%LP_indx), ubound(InData%LP_indx)) + call RegPack(Buf, InData%LP_indx) + end if + call BD_PackInput(Buf, InData%u) + call BD_PackInput(Buf, InData%u2) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackMisc' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%u_DistrLoad_at_y) ! u_DistrLoad_at_y + call MeshUnpack(Buf, OutData%y_BldMotion_at_u) ! y_BldMotion_at_u + call NWTC_Library_UnpackMeshMapType(Buf, OutData%Map_u_DistrLoad_to_y) ! Map_u_DistrLoad_to_y + call NWTC_Library_UnpackMeshMapType(Buf, OutData%Map_y_BldMotion_to_u) ! Map_y_BldMotion_to_u + call RegUnpack(Buf, OutData%Un_Sum) + if (RegCheckErr(Buf, RoutineName)) return + call BD_UnpackEqMotionQP(Buf, OutData%qp) ! qp + if (allocated(OutData%lin_A)) deallocate(OutData%lin_A) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%lin_A(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%lin_A) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%lin_C)) deallocate(OutData%lin_C) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%lin_C(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%lin_C) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Nrrr)) deallocate(OutData%Nrrr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nrrr(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nrrr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Nrrr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%elf)) deallocate(OutData%elf) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%elf(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%elf.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%elf) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%EFint)) deallocate(OutData%EFint) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%EFint(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%EFint.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%EFint) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%elk)) deallocate(OutData%elk) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%elk(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%elk.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%elk) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%elg)) deallocate(OutData%elg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%elg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%elg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%elg) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%elm)) deallocate(OutData%elm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%elm(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%elm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%elm) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DistrLoad_QP)) deallocate(OutData%DistrLoad_QP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DistrLoad_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DistrLoad_QP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DistrLoad_QP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PointLoadLcl)) deallocate(OutData%PointLoadLcl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PointLoadLcl(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointLoadLcl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PointLoadLcl) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StifK)) deallocate(OutData%StifK) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StifK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StifK.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StifK) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MassM)) deallocate(OutData%MassM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MassM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MassM) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DampG)) deallocate(OutData%DampG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DampG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DampG) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StifK_fd)) deallocate(OutData%StifK_fd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StifK_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StifK_fd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StifK_fd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MassM_fd)) deallocate(OutData%MassM_fd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MassM_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassM_fd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MassM_fd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DampG_fd)) deallocate(OutData%DampG_fd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DampG_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampG_fd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DampG_fd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RHS)) deallocate(OutData%RHS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RHS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RHS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RHS_p)) deallocate(OutData%RHS_p) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RHS_p(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_p.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RHS_p) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RHS_m)) deallocate(OutData%RHS_m) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RHS_m(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RHS_m) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BldInternalForceFE)) deallocate(OutData%BldInternalForceFE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldInternalForceFE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceFE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldInternalForceFE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BldInternalForceQP)) deallocate(OutData%BldInternalForceQP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldInternalForceQP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceQP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldInternalForceQP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FirstNodeReactionLclForceMoment)) deallocate(OutData%FirstNodeReactionLclForceMoment) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FirstNodeReactionLclForceMoment(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstNodeReactionLclForceMoment.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FirstNodeReactionLclForceMoment) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Solution)) deallocate(OutData%Solution) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Solution(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Solution.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Solution) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LP_StifK)) deallocate(OutData%LP_StifK) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LP_StifK(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LP_StifK) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LP_MassM)) deallocate(OutData%LP_MassM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LP_MassM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LP_MassM) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LP_MassM_LU)) deallocate(OutData%LP_MassM_LU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LP_MassM_LU(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM_LU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LP_MassM_LU) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LP_RHS)) deallocate(OutData%LP_RHS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LP_RHS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LP_RHS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LP_StifK_LU)) deallocate(OutData%LP_StifK_LU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LP_StifK_LU(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK_LU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LP_StifK_LU) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LP_RHS_LU)) deallocate(OutData%LP_RHS_LU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LP_RHS_LU(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS_LU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LP_RHS_LU) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LP_indx)) deallocate(OutData%LP_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LP_indx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LP_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + call BD_UnpackInput(Buf, OutData%u) ! u + call BD_UnpackInput(Buf, OutData%u2) ! u2 +end subroutine + +subroutine BD_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(BD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(BD_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 = 'BD_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 BD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL BD_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 BD_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 BD_Input_ExtrapInterp - - - SUBROUTINE BD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call BD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call BD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call BD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE BD_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. @@ -12783,47 +5444,48 @@ SUBROUTINE BD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(BD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(BD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(BD_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 + TYPE(BD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(BD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(BD_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 = 'BD_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(u1%RootMotion, u2%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%PointLoad, u2%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%DistrLoad, u2%DistrLoad, tin, u_out%DistrLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%HubMotion, u2%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE BD_Input_ExtrapInterp1 - - - SUBROUTINE BD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%RootMotion, u2%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%PointLoad, u2%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%DistrLoad, u2%DistrLoad, tin, u_out%DistrLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%HubMotion, u2%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE BD_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. @@ -12837,107 +5499,108 @@ SUBROUTINE BD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(BD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(BD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(BD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(BD_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 + TYPE(BD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(BD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(BD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(BD_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 = 'BD_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'BD_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(u1%RootMotion, u2%RootMotion, u3%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%PointLoad, u2%PointLoad, u3%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%DistrLoad, u2%DistrLoad, u3%DistrLoad, tin, u_out%DistrLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%HubMotion, u2%HubMotion, u3%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE BD_Input_ExtrapInterp2 - - - SUBROUTINE BD_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(BD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(BD_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%RootMotion, u2%RootMotion, u3%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%PointLoad, u2%PointLoad, u3%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%DistrLoad, u2%DistrLoad, u3%DistrLoad, tin, u_out%DistrLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%HubMotion, u2%HubMotion, u3%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine BD_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(BD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(BD_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 = 'BD_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 BD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL BD_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 BD_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 BD_Output_ExtrapInterp - - - SUBROUTINE BD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call BD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call BD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call BD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE BD_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. @@ -12949,55 +5612,51 @@ SUBROUTINE BD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(BD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(BD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(BD_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 + TYPE(BD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(BD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(BD_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 = 'BD_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(y1%ReactionForce, y2%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%BldMotion, y2%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - b = -(y1%RootMxr - y2%RootMxr) - y_out%RootMxr = y1%RootMxr + b * ScaleFactor - b = -(y1%RootMyr - y2%RootMyr) - y_out%RootMyr = y1%RootMyr + b * ScaleFactor -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 BD_Output_ExtrapInterp1 - - - SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%ReactionForce, y2%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%BldMotion, y2%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + y_out%RootMxr = a1*y1%RootMxr + a2*y2%RootMxr + y_out%RootMyr = a1*y1%RootMyr + a2*y2%RootMyr + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE BD_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. @@ -13011,64 +5670,56 @@ SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(BD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(BD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(BD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(BD_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 + TYPE(BD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(BD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(BD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(BD_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 = 'BD_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'BD_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(y1%ReactionForce, y2%ReactionForce, y3%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%BldMotion, y2%BldMotion, y3%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - b = (t(3)**2*(y1%RootMxr - y2%RootMxr) + t(2)**2*(-y1%RootMxr + y3%RootMxr))* scaleFactor - c = ( (t(2)-t(3))*y1%RootMxr + t(3)*y2%RootMxr - t(2)*y3%RootMxr ) * scaleFactor - y_out%RootMxr = y1%RootMxr + b + c * t_out - b = (t(3)**2*(y1%RootMyr - y2%RootMyr) + t(2)**2*(-y1%RootMyr + y3%RootMyr))* scaleFactor - c = ( (t(2)-t(3))*y1%RootMyr + t(3)*y2%RootMyr - t(2)*y3%RootMyr ) * scaleFactor - y_out%RootMyr = y1%RootMyr + b + c * t_out -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 BD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%ReactionForce, y2%ReactionForce, y3%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%BldMotion, y2%BldMotion, y3%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + y_out%RootMxr = a1*y1%RootMxr + a2*y2%RootMxr + a3*y3%RootMxr + y_out%RootMyr = a1*y1%RootMyr + a2*y2%RootMyr + a3*y3%RootMyr + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE BeamDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 9c7a4eec8b..45e632f0a6 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -39,11 +39,11 @@ MODULE ElastoDyn_Types CHARACTER(1024) :: InputFile !< Name of the input file [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] CHARACTER(1024) :: ADInputFile !< Name of the AeroDyn input file (in this verison, that is where we'll get the blade mesh info [-] - LOGICAL :: CompElast !< flag to determine if ElastoDyn is computing blade loads (true) or BeamDyn is (false) [-] + LOGICAL :: CompElast = .false. !< flag to determine if ElastoDyn is computing blade loads (true) or BeamDyn is (false) [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) :: Gravity !< Gravitational acceleration [m/s^2] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] END TYPE ED_InitInputType ! ======================= ! ========= ED_InitOutputType ======= @@ -51,22 +51,22 @@ MODULE ElastoDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - INTEGER(IntKi) :: NumBl !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades on the turbine [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitch !< Initial blade pitch angles [radians] - REAL(ReKi) :: BladeLength !< Blade length (for AeroDyn) [meters] - REAL(ReKi) :: TowerHeight !< Tower Height [meters] - REAL(ReKi) :: TowerBaseHeight !< Tower Base Height [meters] - REAL(ReKi) :: HubHt !< Height of the hub [meters] + REAL(ReKi) :: BladeLength = 0.0_ReKi !< Blade length (for AeroDyn) [meters] + REAL(ReKi) :: TowerHeight = 0.0_ReKi !< Tower Height [meters] + REAL(ReKi) :: TowerBaseHeight = 0.0_ReKi !< Tower Base Height [meters] + REAL(ReKi) :: HubHt = 0.0_ReKi !< Height of the hub [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldRNodes !< Radius to analysis nodes relative to hub ( 0 < RNodes(:) < BldFlexL ) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrHNodes !< Location of variable-spaced tower nodes (relative to the tower rigid base height [-] - REAL(ReKi) , DIMENSION(1:6) :: PlatformPos !< Initial platform position (6 DOFs) [-] - REAL(ReKi) , DIMENSION(1:3) :: TwrBaseRefPos !< initial position of the tower base (for SrvD) [m] - REAL(R8Ki) , DIMENSION(1:3) :: TwrBaseTransDisp !< initial displacement of the tower base (for SrvD) [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseRefOrient !< reference orientation of the tower base (for SrvD) [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseOrient !< initial orientation of the tower base (for SrvD) [-] - REAL(ReKi) :: HubRad !< Preconed hub radius (distance from the rotor apex to the blade root) [m] - REAL(ReKi) :: RotSpeed !< Initial or fixed rotor speed [rad/s] - LOGICAL :: isFixed_GenDOF !< whether the generator is fixed or free [-] + REAL(ReKi) , DIMENSION(1:6) :: PlatformPos = 0.0_ReKi !< Initial platform position (6 DOFs) [-] + REAL(ReKi) , DIMENSION(1:3) :: TwrBaseRefPos = 0.0_ReKi !< initial position of the tower base (for SrvD) [m] + REAL(R8Ki) , DIMENSION(1:3) :: TwrBaseTransDisp = 0.0_R8Ki !< initial displacement of the tower base (for SrvD) [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseRefOrient = 0.0_R8Ki !< reference orientation of the tower base (for SrvD) [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseOrient = 0.0_R8Ki !< initial orientation of the tower base (for SrvD) [-] + REAL(ReKi) :: HubRad = 0.0_ReKi !< Preconed hub radius (distance from the rotor apex to the blade root) [m] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Initial or fixed rotor speed [rad/s] + LOGICAL :: isFixed_GenDOF = .false. !< whether the generator is fixed or free [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] @@ -79,16 +79,16 @@ MODULE ElastoDyn_Types ! ======================= ! ========= BladeInputData ======= TYPE, PUBLIC :: BladeInputData - INTEGER(IntKi) :: NBlInpSt !< Number of blade input stations [-] + INTEGER(IntKi) :: NBlInpSt = 0_IntKi !< Number of blade input stations [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlFract !< Blade fractional radius for distributed input data [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PitchAx !< Pitch axis for distributed input data [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: StrcTwst !< Structural twist for distributed input data [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BMassDen !< Blade mass density for distributed input data [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FlpStff !< Blade flap stiffness for distributed input data [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: EdgStff !< Blade edge stiffness for distributed input data [-] - REAL(ReKi) , DIMENSION(1:2) :: BldFlDmp !< Blade structural damping ratios in flapwise direction [-] - REAL(ReKi) , DIMENSION(1:1) :: BldEdDmp !< Blade structural damping ratios in edgewise direction [-] - REAL(ReKi) , DIMENSION(1:2) :: FlStTunr !< Blade flapwise modal stiffness tuners (input) [-] + REAL(ReKi) , DIMENSION(1:2) :: BldFlDmp = 0.0_ReKi !< Blade structural damping ratios in flapwise direction [-] + REAL(ReKi) , DIMENSION(1:1) :: BldEdDmp = 0.0_ReKi !< Blade structural damping ratios in edgewise direction [-] + REAL(ReKi) , DIMENSION(1:2) :: FlStTunr = 0.0_ReKi !< Blade flapwise modal stiffness tuners (input) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldFl1Sh !< Blade-flap-mode-1 shape coefficients [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldFl2Sh !< Blade-flap-mode-2 shape coefficients [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldEdgSh !< Blade-edge-mode shape coefficients [-] @@ -96,7 +96,7 @@ MODULE ElastoDyn_Types ! ======================= ! ========= ED_BladeMeshInputData ======= TYPE, PUBLIC :: ED_BladeMeshInputData - INTEGER(IntKi) :: BldNodes !< Number of blade nodes used for analysis [-] + INTEGER(IntKi) :: BldNodes = 0_IntKi !< Number of blade nodes used for analysis [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RNodes !< Radius to analysis nodes relative to hub ( 0 < RNodes(:) < BldFlexL ) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AeroTwst !< Aerodynamic twist of the blade at the analysis nodes [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Chord !< Chord of the blade at the analysis nodes [-] @@ -104,108 +104,108 @@ MODULE ElastoDyn_Types ! ======================= ! ========= ED_InputFile ======= TYPE, PUBLIC :: ED_InputFile - REAL(DbKi) :: DT !< Requested integration time for ElastoDyn [seconds] - LOGICAL :: FlapDOF1 !< First flapwise blade mode DOF [-] - LOGICAL :: FlapDOF2 !< Second flapwise blade mode DOF [-] - LOGICAL :: EdgeDOF !< Edgewise blade mode DOF [-] - LOGICAL :: TeetDOF !< Rotor-teeter DOF [-] - LOGICAL :: DrTrDOF !< Drivetrain rotational-flexibility DOF [-] - LOGICAL :: GenDOF !< Generator DOF [-] - LOGICAL :: YawDOF !< Nacelle-yaw DOF [-] - LOGICAL :: TwFADOF1 !< First tower fore-aft bending-mode DOF [-] - LOGICAL :: TwFADOF2 !< Second tower fore-aft bending-mode DOF [-] - LOGICAL :: TwSSDOF1 !< First tower side-to-side bending-mode DOF [-] - LOGICAL :: TwSSDOF2 !< Second tower side-to-side bending-mode DOF [-] - LOGICAL :: PtfmSgDOF !< Platform horizontal surge translation DOF [-] - LOGICAL :: PtfmSwDOF !< Platform horizontal sway translation DOF [-] - LOGICAL :: PtfmHvDOF !< Platform vertical heave translation DOF [-] - LOGICAL :: PtfmRDOF !< Platform roll tilt rotation DOF [-] - LOGICAL :: PtfmPDOF !< Platform pitch tilt rotation DOF [-] - LOGICAL :: PtfmYDOF !< Platform yaw rotation DOF [-] - REAL(ReKi) :: OoPDefl !< Initial out-of-plane blade-tip displacement [meters] - REAL(ReKi) :: IPDefl !< Initial in-plane blade-tip deflection [meters] + REAL(DbKi) :: DT = 0.0_R8Ki !< Requested integration time for ElastoDyn [seconds] + LOGICAL :: FlapDOF1 = .false. !< First flapwise blade mode DOF [-] + LOGICAL :: FlapDOF2 = .false. !< Second flapwise blade mode DOF [-] + LOGICAL :: EdgeDOF = .false. !< Edgewise blade mode DOF [-] + LOGICAL :: TeetDOF = .false. !< Rotor-teeter DOF [-] + LOGICAL :: DrTrDOF = .false. !< Drivetrain rotational-flexibility DOF [-] + LOGICAL :: GenDOF = .false. !< Generator DOF [-] + LOGICAL :: YawDOF = .false. !< Nacelle-yaw DOF [-] + LOGICAL :: TwFADOF1 = .false. !< First tower fore-aft bending-mode DOF [-] + LOGICAL :: TwFADOF2 = .false. !< Second tower fore-aft bending-mode DOF [-] + LOGICAL :: TwSSDOF1 = .false. !< First tower side-to-side bending-mode DOF [-] + LOGICAL :: TwSSDOF2 = .false. !< Second tower side-to-side bending-mode DOF [-] + LOGICAL :: PtfmSgDOF = .false. !< Platform horizontal surge translation DOF [-] + LOGICAL :: PtfmSwDOF = .false. !< Platform horizontal sway translation DOF [-] + LOGICAL :: PtfmHvDOF = .false. !< Platform vertical heave translation DOF [-] + LOGICAL :: PtfmRDOF = .false. !< Platform roll tilt rotation DOF [-] + LOGICAL :: PtfmPDOF = .false. !< Platform pitch tilt rotation DOF [-] + LOGICAL :: PtfmYDOF = .false. !< Platform yaw rotation DOF [-] + REAL(ReKi) :: OoPDefl = 0.0_ReKi !< Initial out-of-plane blade-tip displacement [meters] + REAL(ReKi) :: IPDefl = 0.0_ReKi !< Initial in-plane blade-tip deflection [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitch !< Initial blade pitch angles [radians] - REAL(ReKi) :: TeetDefl !< Initial teeter angle [radians] - REAL(R8Ki) :: Azimuth !< Initial azimuth angle for blade 1 [radians] - REAL(ReKi) :: RotSpeed !< Initial rotor speed [rad/s] - REAL(ReKi) :: NacYaw !< Initial nacelle-yaw angle [radians] - REAL(ReKi) :: TTDspFA !< Initial fore-aft tower-top displacement [meters] - REAL(ReKi) :: TTDspSS !< Initial side-to-side tower-top displacement [meters] - REAL(ReKi) :: PtfmSurge !< Initial horizontal surge translational displacement of platform [meters] - REAL(ReKi) :: PtfmSway !< Initial horizontal sway translational displacement of platform [meters] - REAL(ReKi) :: PtfmHeave !< Initial vertical heave translational displacement of platform [meters] - REAL(ReKi) :: PtfmRoll !< Initial roll tilt rotational displacement of platform [radians] - REAL(ReKi) :: PtfmPitch !< Initial pitch tilt rotational displacement of platform [radians] - REAL(ReKi) :: PtfmYaw !< Initial yaw rotational displacement of platform [radians] - INTEGER(IntKi) :: NumBl !< Number of blades [-] - REAL(ReKi) :: TipRad !< Preconed blade-tip radius (distance from the rotor apex to the blade tip) [meters] - REAL(ReKi) :: HubRad !< Preconed hub radius (distance from the rotor apex to the blade root) [meters] + REAL(ReKi) :: TeetDefl = 0.0_ReKi !< Initial teeter angle [radians] + REAL(R8Ki) :: Azimuth = 0.0_R8Ki !< Initial azimuth angle for blade 1 [radians] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Initial rotor speed [rad/s] + REAL(ReKi) :: NacYaw = 0.0_ReKi !< Initial nacelle-yaw angle [radians] + REAL(ReKi) :: TTDspFA = 0.0_ReKi !< Initial fore-aft tower-top displacement [meters] + REAL(ReKi) :: TTDspSS = 0.0_ReKi !< Initial side-to-side tower-top displacement [meters] + REAL(ReKi) :: PtfmSurge = 0.0_ReKi !< Initial horizontal surge translational displacement of platform [meters] + REAL(ReKi) :: PtfmSway = 0.0_ReKi !< Initial horizontal sway translational displacement of platform [meters] + REAL(ReKi) :: PtfmHeave = 0.0_ReKi !< Initial vertical heave translational displacement of platform [meters] + REAL(ReKi) :: PtfmRoll = 0.0_ReKi !< Initial roll tilt rotational displacement of platform [radians] + REAL(ReKi) :: PtfmPitch = 0.0_ReKi !< Initial pitch tilt rotational displacement of platform [radians] + REAL(ReKi) :: PtfmYaw = 0.0_ReKi !< Initial yaw rotational displacement of platform [radians] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades [-] + REAL(ReKi) :: TipRad = 0.0_ReKi !< Preconed blade-tip radius (distance from the rotor apex to the blade tip) [meters] + REAL(ReKi) :: HubRad = 0.0_ReKi !< Preconed hub radius (distance from the rotor apex to the blade root) [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PreCone !< Rotor precone angles [radians] - REAL(ReKi) :: HubCM !< Distance from rotor apex to hub mass [meters] - REAL(ReKi) :: UndSling !< Undersling length [meters] - REAL(ReKi) :: Delta3 !< Delta-3 angle for teetering rotors [radians] - REAL(R8Ki) :: AzimB1Up !< Azimuth value to use for I/O when blade 1 points up [radians] - REAL(ReKi) :: OverHang !< Distance from yaw axis to rotor apex or teeter pin [meters] - REAL(ReKi) :: ShftGagL !< Distance from hub or teeter pin to shaft strain gages [meters] - REAL(ReKi) :: ShftTilt !< Rotor shaft tilt angle [radians] - REAL(ReKi) :: NacCMxn !< Downwind distance from tower-top to nacelle CM [meters] - REAL(ReKi) :: NacCMyn !< Lateral distance from tower-top to nacelle CM [meters] - REAL(ReKi) :: NacCMzn !< Vertical distance from tower-top to nacelle CM [meters] - REAL(ReKi) :: NcIMUxn !< Downwind distance from the tower-top to the nacelle IMU [meters] - REAL(ReKi) :: NcIMUyn !< Lateral distance from the tower-top to the nacelle IMU [meters] - REAL(ReKi) :: NcIMUzn !< Vertical distance from the tower-top to the nacelle IMU [meters] - REAL(ReKi) :: Twr2Shft !< Vertical distance from the tower-top to the rotor shaft [meters] - REAL(ReKi) :: TowerHt !< Height of tower relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] - REAL(ReKi) :: TowerBsHt !< Height of tower base relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] - REAL(ReKi) :: PtfmCMxt !< Downwind distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] - REAL(ReKi) :: PtfmCMyt !< Lateral distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] - REAL(ReKi) :: PtfmCMzt !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] - REAL(ReKi) :: PtfmRefzt !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [meters] + REAL(ReKi) :: HubCM = 0.0_ReKi !< Distance from rotor apex to hub mass [meters] + REAL(ReKi) :: UndSling = 0.0_ReKi !< Undersling length [meters] + REAL(ReKi) :: Delta3 = 0.0_ReKi !< Delta-3 angle for teetering rotors [radians] + REAL(R8Ki) :: AzimB1Up = 0.0_R8Ki !< Azimuth value to use for I/O when blade 1 points up [radians] + REAL(ReKi) :: OverHang = 0.0_ReKi !< Distance from yaw axis to rotor apex or teeter pin [meters] + REAL(ReKi) :: ShftGagL = 0.0_ReKi !< Distance from hub or teeter pin to shaft strain gages [meters] + REAL(ReKi) :: ShftTilt = 0.0_ReKi !< Rotor shaft tilt angle [radians] + REAL(ReKi) :: NacCMxn = 0.0_ReKi !< Downwind distance from tower-top to nacelle CM [meters] + REAL(ReKi) :: NacCMyn = 0.0_ReKi !< Lateral distance from tower-top to nacelle CM [meters] + REAL(ReKi) :: NacCMzn = 0.0_ReKi !< Vertical distance from tower-top to nacelle CM [meters] + REAL(ReKi) :: NcIMUxn = 0.0_ReKi !< Downwind distance from the tower-top to the nacelle IMU [meters] + REAL(ReKi) :: NcIMUyn = 0.0_ReKi !< Lateral distance from the tower-top to the nacelle IMU [meters] + REAL(ReKi) :: NcIMUzn = 0.0_ReKi !< Vertical distance from the tower-top to the nacelle IMU [meters] + REAL(ReKi) :: Twr2Shft = 0.0_ReKi !< Vertical distance from the tower-top to the rotor shaft [meters] + REAL(ReKi) :: TowerHt = 0.0_ReKi !< Height of tower relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] + REAL(ReKi) :: TowerBsHt = 0.0_ReKi !< Height of tower base relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] + REAL(ReKi) :: PtfmCMxt = 0.0_ReKi !< Downwind distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] + REAL(ReKi) :: PtfmCMyt = 0.0_ReKi !< Lateral distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] + REAL(ReKi) :: PtfmCMzt = 0.0_ReKi !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] + REAL(ReKi) :: PtfmRefzt = 0.0_ReKi !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TipMass !< Tip-brake masses [kg] - REAL(ReKi) :: HubMass !< Hub mass [kg] - REAL(ReKi) :: HubIner !< Hub inertia about teeter axis (2-blader) or rotor axis (3-blader) [kg m^2] - REAL(ReKi) :: GenIner !< Generator inertia about HSS [kg m^2] - REAL(ReKi) :: NacMass !< Nacelle mass [kg] - REAL(ReKi) :: NacYIner !< Nacelle yaw inertia [kg m^2] - REAL(ReKi) :: YawBrMass !< Yaw bearing mass [kg] - REAL(ReKi) :: PtfmMass !< Platform mass [kg] - REAL(ReKi) :: PtfmRIner !< Platform inertia for roll tilt rotation about the platform CM [kg m^2] - REAL(ReKi) :: PtfmPIner !< Platform inertia for pitch tilt rotation about the platform CM [kg m^2] - REAL(ReKi) :: PtfmYIner !< Platform inertia for yaw rotation about the platform CM [kg m^2] - REAL(ReKi) :: BldNodes !< Number of blade nodes (per blade) used for analysis [-] + REAL(ReKi) :: HubMass = 0.0_ReKi !< Hub mass [kg] + REAL(ReKi) :: HubIner = 0.0_ReKi !< Hub inertia about teeter axis (2-blader) or rotor axis (3-blader) [kg m^2] + REAL(ReKi) :: GenIner = 0.0_ReKi !< Generator inertia about HSS [kg m^2] + REAL(ReKi) :: NacMass = 0.0_ReKi !< Nacelle mass [kg] + REAL(ReKi) :: NacYIner = 0.0_ReKi !< Nacelle yaw inertia [kg m^2] + REAL(ReKi) :: YawBrMass = 0.0_ReKi !< Yaw bearing mass [kg] + REAL(ReKi) :: PtfmMass = 0.0_ReKi !< Platform mass [kg] + REAL(ReKi) :: PtfmRIner = 0.0_ReKi !< Platform inertia for roll tilt rotation about the platform CM [kg m^2] + REAL(ReKi) :: PtfmPIner = 0.0_ReKi !< Platform inertia for pitch tilt rotation about the platform CM [kg m^2] + REAL(ReKi) :: PtfmYIner = 0.0_ReKi !< Platform inertia for yaw rotation about the platform CM [kg m^2] + REAL(ReKi) :: BldNodes = 0.0_ReKi !< Number of blade nodes (per blade) used for analysis [-] TYPE(ED_BladeMeshInputData) , DIMENSION(:), ALLOCATABLE :: InpBlMesh !< Input data for blade discretizations (could be on each blade) [see BladeMeshInputData] TYPE(BladeInputData) , DIMENSION(:), ALLOCATABLE :: InpBl !< Input data for individual blades [see BladeInputData type] - INTEGER(IntKi) :: TeetMod !< Rotor-teeter spring/damper model switch [-] - REAL(ReKi) :: TeetDmpP !< Rotor-teeter damper position [radians] - REAL(ReKi) :: TeetDmp !< Rotor-teeter damping constant [N-m/(rad/s)] - REAL(ReKi) :: TeetCDmp !< Rotor-teeter rate-independent Coulomb-damping [N-m] - REAL(ReKi) :: TeetSStP !< Rotor-teeter soft-stop position [radians] - REAL(ReKi) :: TeetHStP !< Rotor-teeter hard-stop position [radians] - REAL(ReKi) :: TeetSSSp !< Rotor-teeter soft-stop linear-spring constant [N-m/rad] - REAL(ReKi) :: TeetHSSp !< Rotor-teeter hard-stop linear-spring constant [N-m/rad] - REAL(ReKi) :: GBoxEff !< Gearbox efficiency [%] - REAL(ReKi) :: GBRatio !< Gearbox ratio [-] - REAL(ReKi) :: DTTorSpr !< Drivetrain torsional spring [N-m/rad] - REAL(ReKi) :: DTTorDmp !< Drivetrain torsional damper [N-m/(rad/s)] - LOGICAL :: Furling !< Use Additional Furling parameters? [-] - INTEGER(IntKi) :: TwrNodes !< Number of tower nodes used in the analysis [-] - LOGICAL :: SumPrint !< Print summary data to .sum [-] - INTEGER(IntKi) :: OutFile !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] - LOGICAL :: TabDelim !< Flag to cause tab-delimited text output (delimited by space otherwise) [-] + INTEGER(IntKi) :: TeetMod = 0_IntKi !< Rotor-teeter spring/damper model switch [-] + REAL(ReKi) :: TeetDmpP = 0.0_ReKi !< Rotor-teeter damper position [radians] + REAL(ReKi) :: TeetDmp = 0.0_ReKi !< Rotor-teeter damping constant [N-m/(rad/s)] + REAL(ReKi) :: TeetCDmp = 0.0_ReKi !< Rotor-teeter rate-independent Coulomb-damping [N-m] + REAL(ReKi) :: TeetSStP = 0.0_ReKi !< Rotor-teeter soft-stop position [radians] + REAL(ReKi) :: TeetHStP = 0.0_ReKi !< Rotor-teeter hard-stop position [radians] + REAL(ReKi) :: TeetSSSp = 0.0_ReKi !< Rotor-teeter soft-stop linear-spring constant [N-m/rad] + REAL(ReKi) :: TeetHSSp = 0.0_ReKi !< Rotor-teeter hard-stop linear-spring constant [N-m/rad] + REAL(ReKi) :: GBoxEff = 0.0_ReKi !< Gearbox efficiency [%] + REAL(ReKi) :: GBRatio = 0.0_ReKi !< Gearbox ratio [-] + REAL(ReKi) :: DTTorSpr = 0.0_ReKi !< Drivetrain torsional spring [N-m/rad] + REAL(ReKi) :: DTTorDmp = 0.0_ReKi !< Drivetrain torsional damper [N-m/(rad/s)] + LOGICAL :: Furling = .false. !< Use Additional Furling parameters? [-] + INTEGER(IntKi) :: TwrNodes = 0_IntKi !< Number of tower nodes used in the analysis [-] + LOGICAL :: SumPrint = .false. !< Print summary data to .sum [-] + INTEGER(IntKi) :: OutFile = 0_IntKi !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] + LOGICAL :: TabDelim = .false. !< Flag to cause tab-delimited text output (delimited by space otherwise) [-] CHARACTER(20) :: OutFmt !< Format used for module's text tabular output (except time); resulting field should be 10 characters [-] - REAL(DbKi) :: Tstart !< Time to start module's tabular output [seconds] - INTEGER(IntKi) :: DecFact !< Decimation factor for module's tabular output (1=output every step) [-] - INTEGER(IntKi) :: NTwGages !< Number of tower strain gages [-] - INTEGER(IntKi) , DIMENSION(1:9) :: TwrGagNd !< Nodes closest to the tower strain gages [-] - INTEGER(IntKi) :: NBlGages !< Number of blade strain gages [-] - INTEGER(IntKi) , DIMENSION(1:9) :: BldGagNd !< Nodes closest to the blade strain gages [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [seconds] + INTEGER(IntKi) :: DecFact = 0_IntKi !< Decimation factor for module's tabular output (1=output every step) [-] + INTEGER(IntKi) :: NTwGages = 0_IntKi !< Number of tower strain gages [-] + INTEGER(IntKi) , DIMENSION(1:9) :: TwrGagNd = 0_IntKi !< Nodes closest to the tower strain gages [-] + INTEGER(IntKi) :: NBlGages = 0_IntKi !< Number of blade strain gages [-] + INTEGER(IntKi) , DIMENSION(1:9) :: BldGagNd = 0_IntKi !< Nodes closest to the blade strain gages [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - INTEGER(IntKi) :: NTwInpSt !< Number of tower input stations [-] - REAL(ReKi) , DIMENSION(1:2) :: TwrFADmp !< Tower fore-aft structural damping ratios [%] - REAL(ReKi) , DIMENSION(1:2) :: TwrSSDmp !< Tower side-to-side structural damping ratios [%] - REAL(ReKi) , DIMENSION(1:2) :: FAStTunr !< Tower fore-aft modal stiffness tuners [-] - REAL(ReKi) , DIMENSION(1:2) :: SSStTunr !< Tower side-to-side modal stiffness tuners [-] + INTEGER(IntKi) :: NTwInpSt = 0_IntKi !< Number of tower input stations [-] + REAL(ReKi) , DIMENSION(1:2) :: TwrFADmp = 0.0_ReKi !< Tower fore-aft structural damping ratios [%] + REAL(ReKi) , DIMENSION(1:2) :: TwrSSDmp = 0.0_ReKi !< Tower side-to-side structural damping ratios [%] + REAL(ReKi) , DIMENSION(1:2) :: FAStTunr = 0.0_ReKi !< Tower fore-aft modal stiffness tuners [-] + REAL(ReKi) , DIMENSION(1:2) :: SSStTunr = 0.0_ReKi !< Tower side-to-side modal stiffness tuners [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HtFract !< Fractional height of the flexible portion of tower for a given input station [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TMassDen !< Tower mass density for a given input station [kg/m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwFAStif !< Tower fore-aft stiffness for a given input station [Nm^2] @@ -214,78 +214,78 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwFAM2Sh !< Tower fore-aft mode-2 shape coefficients [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwSSM1Sh !< Tower side-to-side mode-1 shape coefficients [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwSSM2Sh !< Tower side-to-side mode-2 shape coefficients [-] - LOGICAL :: RFrlDOF !< Rotor-furl DOF [-] - LOGICAL :: TFrlDOF !< Tail-furl DOF [-] - REAL(ReKi) :: RotFurl !< Initial or fixed rotor-furl angle [radians] - REAL(ReKi) :: TailFurl !< Initial or fixed tail-furl angle [radians] - REAL(ReKi) :: Yaw2Shft !< Lateral distance from the yaw axis to the rotor shaft [meters] - REAL(ReKi) :: ShftSkew !< Rotor shaft skew angle [radians] - REAL(ReKi) , DIMENSION(1:3) :: RFrlCM_n !< Vector from tower-top to rotor-furl CM [meters] - REAL(ReKi) , DIMENSION(1:3) :: BoomCM_n !< Vector from tower-top to tail boom CM [meters] - REAL(ReKi) , DIMENSION(1:3) :: TFinCM_n !< Vector from tower-top to tail fin CM [meters] - REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n !< Vector from tower-top to arbitrary point on rotor-furl axis [meters] - REAL(ReKi) :: RFrlSkew !< Rotor-furl axis skew angle [radians] - REAL(ReKi) :: RFrlTilt !< Rotor-furl axis tilt angle [radians] - REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n !< Vector from tower-top to arbitrary point on tail-furl axis [meters] - REAL(ReKi) :: TFrlSkew !< Rotor-furl axis skew angle [radians] - REAL(ReKi) :: TFrlTilt !< Rotor-furl axis tilt angle [radians] - REAL(ReKi) :: RFrlMass !< Rotor-furl mass [kg] - REAL(ReKi) :: BoomMass !< Tail boom mass [kg] - REAL(ReKi) :: TFinMass !< Tail fin mass [kg] - REAL(ReKi) :: RFrlIner !< Rotor-furl inertia about rotor-furl axis [kg m^2] - REAL(ReKi) :: TFrlIner !< Tail boom inertia about tail-furl axis [kg m^2] - INTEGER(IntKi) :: RFrlMod !< Rotor-furl spring/damper model switch [-] - REAL(ReKi) :: RFrlSpr !< Rotor-furl spring constant [N-m/rad] - REAL(ReKi) :: RFrlDmp !< Rotor-furl damping constant [N-m/(rad/s)] - REAL(ReKi) :: RFrlUSSP !< Rotor-furl up-stop spring position [radians] - REAL(ReKi) :: RFrlDSSP !< Rotor-furl down-stop spring position [radians] - REAL(ReKi) :: RFrlUSSpr !< Rotor-furl up-stop spring constant [N-m/rad] - REAL(ReKi) :: RFrlDSSpr !< Rotor-furl down-stop spring constant [N-m/rad] - REAL(ReKi) :: RFrlUSDP !< Rotor-furl up-stop damper position [radians] - REAL(ReKi) :: RFrlDSDP !< Rotor-furl down-stop damper position [radians] - REAL(ReKi) :: RFrlUSDmp !< Rotor-furl up-stop damping constant [N-m/(rad/s)] - REAL(ReKi) :: RFrlDSDmp !< Rotor-furl down-stop damping constant [N-m/(rad/s)] - INTEGER(IntKi) :: TFrlMod !< Tail-furl spring/damper model switch [-] - REAL(ReKi) :: TFrlSpr !< Tail-furl spring constant [N-m/rad] - REAL(ReKi) :: TFrlDmp !< Tail-furl damping constant [N-m/(rad/s)] - REAL(ReKi) :: TFrlUSSP !< Tail-furl up-stop spring position [radians] - REAL(ReKi) :: TFrlDSSP !< Tail-furl down-stop spring position [radians] - REAL(ReKi) :: TFrlUSSpr !< Tail-furl up-stop spring constant [N-m/rad] - REAL(ReKi) :: TFrlDSSpr !< Tail-furl down-stop spring constant [N-m/rad] - REAL(ReKi) :: TFrlUSDP !< Tail-furl up-stop damper position [radians] - REAL(ReKi) :: TFrlDSDP !< Tail-furl down-stop damper position [radians] - REAL(ReKi) :: TFrlUSDmp !< Tail-furl up-stop damping constant [N-m/(rad/s)] - REAL(ReKi) :: TFrlDSDmp !< Tail-furl down-stop damping constant [N-m/(rad/s)] - INTEGER(IntKi) :: method !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] - INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] + LOGICAL :: RFrlDOF = .false. !< Rotor-furl DOF [-] + LOGICAL :: TFrlDOF = .false. !< Tail-furl DOF [-] + REAL(ReKi) :: RotFurl = 0.0_ReKi !< Initial or fixed rotor-furl angle [radians] + REAL(ReKi) :: TailFurl = 0.0_ReKi !< Initial or fixed tail-furl angle [radians] + REAL(ReKi) :: Yaw2Shft = 0.0_ReKi !< Lateral distance from the yaw axis to the rotor shaft [meters] + REAL(ReKi) :: ShftSkew = 0.0_ReKi !< Rotor shaft skew angle [radians] + REAL(ReKi) , DIMENSION(1:3) :: RFrlCM_n = 0.0_ReKi !< Vector from tower-top to rotor-furl CM [meters] + REAL(ReKi) , DIMENSION(1:3) :: BoomCM_n = 0.0_ReKi !< Vector from tower-top to tail boom CM [meters] + REAL(ReKi) , DIMENSION(1:3) :: TFinCM_n = 0.0_ReKi !< Vector from tower-top to tail fin CM [meters] + REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n = 0.0_ReKi !< Vector from tower-top to arbitrary point on rotor-furl axis [meters] + REAL(ReKi) :: RFrlSkew = 0.0_ReKi !< Rotor-furl axis skew angle [radians] + REAL(ReKi) :: RFrlTilt = 0.0_ReKi !< Rotor-furl axis tilt angle [radians] + REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n = 0.0_ReKi !< Vector from tower-top to arbitrary point on tail-furl axis [meters] + REAL(ReKi) :: TFrlSkew = 0.0_ReKi !< Rotor-furl axis skew angle [radians] + REAL(ReKi) :: TFrlTilt = 0.0_ReKi !< Rotor-furl axis tilt angle [radians] + REAL(ReKi) :: RFrlMass = 0.0_ReKi !< Rotor-furl mass [kg] + REAL(ReKi) :: BoomMass = 0.0_ReKi !< Tail boom mass [kg] + REAL(ReKi) :: TFinMass = 0.0_ReKi !< Tail fin mass [kg] + REAL(ReKi) :: RFrlIner = 0.0_ReKi !< Rotor-furl inertia about rotor-furl axis [kg m^2] + REAL(ReKi) :: TFrlIner = 0.0_ReKi !< Tail boom inertia about tail-furl axis [kg m^2] + INTEGER(IntKi) :: RFrlMod = 0_IntKi !< Rotor-furl spring/damper model switch [-] + REAL(ReKi) :: RFrlSpr = 0.0_ReKi !< Rotor-furl spring constant [N-m/rad] + REAL(ReKi) :: RFrlDmp = 0.0_ReKi !< Rotor-furl damping constant [N-m/(rad/s)] + REAL(ReKi) :: RFrlUSSP = 0.0_ReKi !< Rotor-furl up-stop spring position [radians] + REAL(ReKi) :: RFrlDSSP = 0.0_ReKi !< Rotor-furl down-stop spring position [radians] + REAL(ReKi) :: RFrlUSSpr = 0.0_ReKi !< Rotor-furl up-stop spring constant [N-m/rad] + REAL(ReKi) :: RFrlDSSpr = 0.0_ReKi !< Rotor-furl down-stop spring constant [N-m/rad] + REAL(ReKi) :: RFrlUSDP = 0.0_ReKi !< Rotor-furl up-stop damper position [radians] + REAL(ReKi) :: RFrlDSDP = 0.0_ReKi !< Rotor-furl down-stop damper position [radians] + REAL(ReKi) :: RFrlUSDmp = 0.0_ReKi !< Rotor-furl up-stop damping constant [N-m/(rad/s)] + REAL(ReKi) :: RFrlDSDmp = 0.0_ReKi !< Rotor-furl down-stop damping constant [N-m/(rad/s)] + INTEGER(IntKi) :: TFrlMod = 0_IntKi !< Tail-furl spring/damper model switch [-] + REAL(ReKi) :: TFrlSpr = 0.0_ReKi !< Tail-furl spring constant [N-m/rad] + REAL(ReKi) :: TFrlDmp = 0.0_ReKi !< Tail-furl damping constant [N-m/(rad/s)] + REAL(ReKi) :: TFrlUSSP = 0.0_ReKi !< Tail-furl up-stop spring position [radians] + REAL(ReKi) :: TFrlDSSP = 0.0_ReKi !< Tail-furl down-stop spring position [radians] + REAL(ReKi) :: TFrlUSSpr = 0.0_ReKi !< Tail-furl up-stop spring constant [N-m/rad] + REAL(ReKi) :: TFrlDSSpr = 0.0_ReKi !< Tail-furl down-stop spring constant [N-m/rad] + REAL(ReKi) :: TFrlUSDP = 0.0_ReKi !< Tail-furl up-stop damper position [radians] + REAL(ReKi) :: TFrlDSDP = 0.0_ReKi !< Tail-furl down-stop damper position [radians] + REAL(ReKi) :: TFrlUSDmp = 0.0_ReKi !< Tail-furl up-stop damping constant [N-m/(rad/s)] + REAL(ReKi) :: TFrlDSDmp = 0.0_ReKi !< Tail-furl down-stop damping constant [N-m/(rad/s)] + INTEGER(IntKi) :: method = 0_IntKi !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (ED_AllBldNdOuts) [-] CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (ED_AllBldNdOuts) [-] - INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (ED_AllBldNdOuts) [-] END TYPE ED_InputFile ! ======================= ! ========= ED_CoordSys ======= TYPE, PUBLIC :: ED_CoordSys - REAL(R8Ki) , DIMENSION(1:3) :: a1 !< Vector / direction a1 (= xt from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: a2 !< Vector / direction a2 (= zt from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: a3 !< Vector / direction a3 (= -yt from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: b1 !< Vector / direction b1 (= xp from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: b2 !< Vector / direction b2 (= zp from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: b3 !< Vector / direction b3 (= -yp from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: c1 !< Vector / direction c1 (= xs from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: c2 !< Vector / direction c2 (= zs from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: c3 !< Vector / direction c3 (= -ys from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: d1 !< Vector / direction d1 (= xn from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: d2 !< Vector / direction d2 (= zn from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: d3 !< Vector / direction d3 (= -yn from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: e1 !< Vector / direction e1 (= xa from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: e2 !< Vector / direction e2 (= ya from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: e3 !< Vector / direction e3 (= za from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: f1 !< Vector / direction f1 [-] - REAL(R8Ki) , DIMENSION(1:3) :: f2 !< Vector / direction f2 [-] - REAL(R8Ki) , DIMENSION(1:3) :: f3 !< Vector / direction f3 [-] - REAL(R8Ki) , DIMENSION(1:3) :: g1 !< Vector / direction g1 (= xh from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: g2 !< Vector / direction g2 (= yh from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: g3 !< Vector / direction g3 (= zh from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: a1 = 0.0_R8Ki !< Vector / direction a1 (= xt from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: a2 = 0.0_R8Ki !< Vector / direction a2 (= zt from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: a3 = 0.0_R8Ki !< Vector / direction a3 (= -yt from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: b1 = 0.0_R8Ki !< Vector / direction b1 (= xp from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: b2 = 0.0_R8Ki !< Vector / direction b2 (= zp from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: b3 = 0.0_R8Ki !< Vector / direction b3 (= -yp from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: c1 = 0.0_R8Ki !< Vector / direction c1 (= xs from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: c2 = 0.0_R8Ki !< Vector / direction c2 (= zs from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: c3 = 0.0_R8Ki !< Vector / direction c3 (= -ys from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: d1 = 0.0_R8Ki !< Vector / direction d1 (= xn from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: d2 = 0.0_R8Ki !< Vector / direction d2 (= zn from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: d3 = 0.0_R8Ki !< Vector / direction d3 (= -yn from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: e1 = 0.0_R8Ki !< Vector / direction e1 (= xa from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: e2 = 0.0_R8Ki !< Vector / direction e2 (= ya from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: e3 = 0.0_R8Ki !< Vector / direction e3 (= za from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: f1 = 0.0_R8Ki !< Vector / direction f1 [-] + REAL(R8Ki) , DIMENSION(1:3) :: f2 = 0.0_R8Ki !< Vector / direction f2 [-] + REAL(R8Ki) , DIMENSION(1:3) :: f3 = 0.0_R8Ki !< Vector / direction f3 [-] + REAL(R8Ki) , DIMENSION(1:3) :: g1 = 0.0_R8Ki !< Vector / direction g1 (= xh from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: g2 = 0.0_R8Ki !< Vector / direction g2 (= yh from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: g3 = 0.0_R8Ki !< Vector / direction g3 (= zh from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: i1 !< i1(K,:) = vector / direction i1 for blade K (= xcK from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: i2 !< i2(K,:) = vector / direction i2 for blade K (= ycK from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: i3 !< i3(K,:) = vector / direction i3 for blade K (= zcK from the IEC coord. system) [-] @@ -298,37 +298,37 @@ MODULE ElastoDyn_Types REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: n1 !< n1(K,J,:) = vector / direction n1 for node J of blade K (= LxbK from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: n2 !< n2(K,J,:) = vector / direction n2 for node J of blade K (= LybK from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: n3 !< n3(K,J,:) = vector / direction n3 for node J of blade K (= LzbK from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: rf1 !< Vector / direction rf1 (rotor-furl coordinate system = d1 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: rf2 !< Vector / direction rf2 (rotor-furl coordinate system = d2 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: rf3 !< Vector / direction rf3 (rotor-furl coordinate system = d3 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: rfa !< Vector / direction of the rotor-furl axis [-] + REAL(R8Ki) , DIMENSION(1:3) :: rf1 = 0.0_R8Ki !< Vector / direction rf1 (rotor-furl coordinate system = d1 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: rf2 = 0.0_R8Ki !< Vector / direction rf2 (rotor-furl coordinate system = d2 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: rf3 = 0.0_R8Ki !< Vector / direction rf3 (rotor-furl coordinate system = d3 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: rfa = 0.0_R8Ki !< Vector / direction of the rotor-furl axis [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: t1 !< Vector / direction t1 for tower node J (= Lxt from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: t2 !< Vector / direction t2 for tower node J (= Lzt from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: t3 !< Vector / direction t3 for tower node J (= -Lyt from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: te1 !< te1(K,J,:) = vector / direction te1 for node J of blade K (used to calc. noise) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: te2 !< te2(K,J,:) = vector / direction te2 for node J of blade K (used to calc. noise) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: te3 !< te3(K,J,:) = vector / direction te3 for node J of blade K (used to calc. noise) [-] - REAL(R8Ki) , DIMENSION(1:3) :: tf1 !< Vector / direction tf1 (tail-furl coordinate system = d1 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: tf2 !< Vector / direction tf2 (tail-furl coordinate system = d2 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: tf3 !< Vector / direction tf3 (tail-furl coordinate system = d3 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: tfa !< Vector / direction of the tail-furl axis [-] - REAL(R8Ki) , DIMENSION(1:3) :: z1 !< Vector / direction z1 (= xi from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: z2 !< Vector / direction z2 (= zi from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: z3 !< Vector / direction z3 (= -yi from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: tf1 = 0.0_R8Ki !< Vector / direction tf1 (tail-furl coordinate system = d1 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: tf2 = 0.0_R8Ki !< Vector / direction tf2 (tail-furl coordinate system = d2 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: tf3 = 0.0_R8Ki !< Vector / direction tf3 (tail-furl coordinate system = d3 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: tfa = 0.0_R8Ki !< Vector / direction of the tail-furl axis [-] + REAL(R8Ki) , DIMENSION(1:3) :: z1 = 0.0_R8Ki !< Vector / direction z1 (= xi from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: z2 = 0.0_R8Ki !< Vector / direction z2 (= zi from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: z3 = 0.0_R8Ki !< Vector / direction z3 (= -yi from the IEC coord. system) [-] END TYPE ED_CoordSys ! ======================= ! ========= ED_ActiveDOFs ======= TYPE, PUBLIC :: ED_ActiveDOFs - INTEGER(IntKi) :: NActvDOF !< The number of active (enabled) DOFs in the model [-] - INTEGER(IntKi) :: NPCE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the hub center of mass (point C) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPDE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the center of mass of the structure that furls with the rotor (not including rotor) (point D) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPIE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the tail boom center of mass (point I) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPTE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the tower nodes (point T) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPTTE !< Number of tower DOFs that contribute to the QD2T-related linear accelerations of the tower nodes (point T) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NActvDOF = 0_IntKi !< The number of active (enabled) DOFs in the model [-] + INTEGER(IntKi) :: NPCE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the hub center of mass (point C) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPDE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the center of mass of the structure that furls with the rotor (not including rotor) (point D) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPIE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the tail boom center of mass (point I) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPTE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the tower nodes (point T) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPTTE = 0_IntKi !< Number of tower DOFs that contribute to the QD2T-related linear accelerations of the tower nodes (point T) in the inertia frame, based on which DOFs are presently enabled [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NPSBE !< Number of blade DOFs that contribute to the QD2T-related linear accelerations of the blade nodes (point S) in the inertia frame, based on which DOFs are presently enabled [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NPSE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the blade nodes (point S) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPUE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the nacelle center of mass (point U) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPYE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the platform center of mass (point Y) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPUE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the nacelle center of mass (point U) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPYE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the platform center of mass (point Y) in the inertia frame, based on which DOFs are presently enabled [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PCE !< Array of DOF indices (pointers) that contribute to the QD2T-related linear accelerations of the hub center of mass (point C) in the inertia frame, based on which DOFs are presently enabled [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PDE !< Array of DOF indices (pointers) that contribute to the QD2T-related linear accelerations of the center of mass of the structure that furls with the rotor (not including rotor) (point D) in the inertia frame, based on which DOFs are presently enabled [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PIE !< Array of DOF indices (pointers) that contribute to the QD2T-related linear accelerations of the tail boom center of mass (point I) in the inertia frame, based on which DOFs are presently enabled [-] @@ -346,39 +346,39 @@ MODULE ElastoDyn_Types ! ======================= ! ========= ED_RtHndSide ======= TYPE, PUBLIC :: ED_RtHndSide - REAL(R8Ki) , DIMENSION(1:3) :: rO !< Position vector from inertial frame origin to tower-top / base plate (point O) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rO = 0.0_R8Ki !< Position vector from inertial frame origin to tower-top / base plate (point O) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: rQS !< Position vector from the apex of rotation (point Q) to a point on a blade (point S) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: rS !< Position vector from inertial frame origin to a point on a blade (point S) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: rS0S !< Position vector from the blade root (point S(0)) to a point on a blade (point S) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: rT !< Position vector from inertial frame origin to the current node (point T(HNodes(J)) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rT0O !< Position vector from the tower base (point T(0)) to tower-top / base plate (point O) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rT0O = 0.0_R8Ki !< Position vector from the tower base (point T(0)) to tower-top / base plate (point O) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: rT0T !< Position vector from a height of TowerBsHt (base of flexible portion of tower) (point T(0)) to a point on the tower (point T) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rZ !< Position vector from inertia frame origin to platform reference (point Z) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rZO !< Position vector from platform reference (point Z) to tower-top / base plate (point O) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rZ = 0.0_R8Ki !< Position vector from inertia frame origin to platform reference (point Z) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rZO = 0.0_R8Ki !< Position vector from platform reference (point Z) to tower-top / base plate (point O) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: rZT !< Position vector from platform reference (point Z) to a point on a tower (point T) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rPQ !< Position vector from teeter pin (point P) to apex of rotation (point Q) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rP !< Position vector from inertial frame origin to teeter pin (point P) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rV !< Position vector from inertial frame origin to specified point on rotor-furl axis (point V) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rJ !< Position vector from inertial frame origin to tail fin center of mass (point J) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rZY !< Position vector from platform reference (point Z) to platform mass center (point Y) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rOU !< Position vector from tower-top / base plate (point O) to nacelle center of mass (point U). [m] - REAL(R8Ki) , DIMENSION(1:3) :: rOV !< Position vector from tower-top / base plate (point O) to specified point on rotor-furl axis (point V) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rVD !< Position vector from specified point on rotor-furl axis (point V) to center of mass of structure that furls with the rotor (not including rotor) (point D) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rOW !< Position vector from tower-top / base plate (point O) to specified point on tail-furl axis (point W) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rPC !< Position vector from teeter pin (point P) to hub center of mass (point C) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rPQ = 0.0_R8Ki !< Position vector from teeter pin (point P) to apex of rotation (point Q) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rP = 0.0_R8Ki !< Position vector from inertial frame origin to teeter pin (point P) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rV = 0.0_R8Ki !< Position vector from inertial frame origin to specified point on rotor-furl axis (point V) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rJ = 0.0_R8Ki !< Position vector from inertial frame origin to tail fin center of mass (point J) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rZY = 0.0_R8Ki !< Position vector from platform reference (point Z) to platform mass center (point Y) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rOU = 0.0_R8Ki !< Position vector from tower-top / base plate (point O) to nacelle center of mass (point U). [m] + REAL(R8Ki) , DIMENSION(1:3) :: rOV = 0.0_R8Ki !< Position vector from tower-top / base plate (point O) to specified point on rotor-furl axis (point V) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rVD = 0.0_R8Ki !< Position vector from specified point on rotor-furl axis (point V) to center of mass of structure that furls with the rotor (not including rotor) (point D) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rOW = 0.0_R8Ki !< Position vector from tower-top / base plate (point O) to specified point on tail-furl axis (point W) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rPC = 0.0_R8Ki !< Position vector from teeter pin (point P) to hub center of mass (point C) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: rPS0 !< Position vector from teeter pin (point P) to blade root (point S(0)) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rQ !< Position vector from inertial frame origin to apex of rotation (point Q) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rQC !< Position vector from apex of rotation (point Q) to hub center of mass (point C) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rVIMU !< Position vector from specified point on rotor-furl axis (point V) to nacelle IMU (point IMU) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rVP !< Position vector from specified point on rotor-furl axis (point V) to teeter pin (point P) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rWI !< Position vector from specified point on tail-furl axis (point W) to tail boom center of mass (point I) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rWJ !< Position vector from specified point on tail-furl axis (point W) to tail fin center of mass (point J) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rZT0 !< Position vector from platform reference (point Z) to tower base (point T(0)) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rQ = 0.0_R8Ki !< Position vector from inertial frame origin to apex of rotation (point Q) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rQC = 0.0_R8Ki !< Position vector from apex of rotation (point Q) to hub center of mass (point C) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rVIMU = 0.0_R8Ki !< Position vector from specified point on rotor-furl axis (point V) to nacelle IMU (point IMU) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rVP = 0.0_R8Ki !< Position vector from specified point on rotor-furl axis (point V) to teeter pin (point P) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rWI = 0.0_R8Ki !< Position vector from specified point on tail-furl axis (point W) to tail boom center of mass (point I) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rWJ = 0.0_R8Ki !< Position vector from specified point on tail-furl axis (point W) to tail fin center of mass (point J) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rZT0 = 0.0_R8Ki !< Position vector from platform reference (point Z) to tower base (point T(0)) [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AngPosEF !< Angular position of the current point on the tower (body F) in the inertial frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AngPosXF !< Angular position of the current point on the tower (body F) in the platform (body X) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AngPosHM !< Angular position of eleMent J of blade K (body M) in the hub (body H) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngPosXB !< Angular position of the base plate (body B) in the platform (body X) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngPosEX !< Angular position of the platform (body X) in the inertial frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngPosXB = 0.0_ReKi !< Angular position of the base plate (body B) in the platform (body X) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngPosEX = 0.0_ReKi !< Angular position of the platform (body X) in the inertial frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelEA !< Partial angular velocity (and its 1st time derivative) of the tail (body A) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PAngVelEF !< Partial angular velocity (and its 1st time derivative) of tower element J (body F) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelEG !< Partial angular velocity (and its 1st time derivative) of the generator (body G) in the inertia frame (body E for earth) [-] @@ -387,37 +387,37 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: PAngVelEM !< Partial angular velocity (and its 1st time derivative) of eleMent J of blade K (body M) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AngVelEM !< Angular velocity of of eleMent J of blade K (body M) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelEN !< Partial angular velocity (and its 1st time derivative) of the nacelle (body N) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEA !< Angular velocity of the tail (body A) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEA = 0.0_ReKi !< Angular velocity of the tail (body A) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelEB !< Partial angular velocity (and its 1st time derivative) of the base plate (body B) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelER !< Partial angular velocity (and its 1st time derivative) of the structure that furls with the rotor (not including rotor) (body R) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelEX !< Partial angular velocity (and its 1st time derivative) of the platform (body B) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEG !< Angular velocity of the generator (body G) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEH !< Angular velocity of the hub (body H) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEL !< Angular velocity of the low-speed shaft (body L) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEN !< Angular velocity of the nacelle (body N) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEB !< Angular velocity of the base plate (body B) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelER !< Angular velocity of the structure that furls with the rotor (not including rotor) (body R) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEX !< Angular velocity of the platform (body X) in the inertia frame (body E for earth) [-] - REAL(R8Ki) :: TeetAngVel !< Angular velocity of the teeter motion [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccEBt !< Portion of the angular acceleration of the base plate (body B) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccERt !< Portion of the angular acceleration of the structure that furls with the rotor (not including rotor) (body R) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccEXt !< Portion of the angular acceleration of the platform (body X) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEG = 0.0_ReKi !< Angular velocity of the generator (body G) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEH = 0.0_ReKi !< Angular velocity of the hub (body H) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEL = 0.0_ReKi !< Angular velocity of the low-speed shaft (body L) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEN = 0.0_ReKi !< Angular velocity of the nacelle (body N) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEB = 0.0_ReKi !< Angular velocity of the base plate (body B) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelER = 0.0_ReKi !< Angular velocity of the structure that furls with the rotor (not including rotor) (body R) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEX = 0.0_ReKi !< Angular velocity of the platform (body X) in the inertia frame (body E for earth) [-] + REAL(R8Ki) :: TeetAngVel = 0.0_R8Ki !< Angular velocity of the teeter motion [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccEBt = 0.0_ReKi !< Portion of the angular acceleration of the base plate (body B) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccERt = 0.0_ReKi !< Portion of the angular acceleration of the structure that furls with the rotor (not including rotor) (body R) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccEXt = 0.0_ReKi !< Portion of the angular acceleration of the platform (body X) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AngAccEFt !< Portion of the angular acceleration of tower element J (body F) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AngVelEF !< Angular velocity of the current point on the tower (body F) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AngVelHM !< Angular velocity of the current point on the blade in the inertia frame [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccEAt !< Portion of the angular acceleration of the tail (body A) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccEGt !< Portion of the angular acceleration of the generator (body G) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccEHt !< Portion of the angular acceleration of the hub (body H) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccEAt = 0.0_ReKi !< Portion of the angular acceleration of the tail (body A) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccEGt = 0.0_ReKi !< Portion of the angular acceleration of the generator (body G) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccEHt = 0.0_ReKi !< Portion of the angular acceleration of the hub (body H) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AngAccEKt !< Portion of the angular acceleration of the blade in the inertia frame associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccENt !< Portion of the angular acceleration of the nacelle (body N) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccECt !< Portion of the linear acceleration of the hub center of mass (point C) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEDt !< Portion of the linear acceleration of the center of mass of the structure that furls with the rotor (not including rotor) (point D) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEIt !< Portion of the linear acceleration of the tail boom center of mass (point I) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEJt !< Portion of the linear acceleration of the tail fin center of mass (point J) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEUt !< Portion of the linear acceleration of the nacelle center of mass (point U) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEYt !< Portion of the linear acceleration of the platform center of mass (point Y) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccENt = 0.0_ReKi !< Portion of the angular acceleration of the nacelle (body N) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccECt = 0.0_ReKi !< Portion of the linear acceleration of the hub center of mass (point C) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEDt = 0.0_ReKi !< Portion of the linear acceleration of the center of mass of the structure that furls with the rotor (not including rotor) (point D) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEIt = 0.0_ReKi !< Portion of the linear acceleration of the tail boom center of mass (point I) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEJt = 0.0_ReKi !< Portion of the linear acceleration of the tail fin center of mass (point J) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEUt = 0.0_ReKi !< Portion of the linear acceleration of the nacelle center of mass (point U) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEYt = 0.0_ReKi !< Portion of the linear acceleration of the platform center of mass (point Y) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: LinVelES !< Linear velocity of current point on the current blade (point S) in the inertia frame [-] - REAL(ReKi) , DIMENSION(1:3) :: LinVelEQ !< Linear velocity of of the apex of rotation (point Q) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: LinVelEQ = 0.0_ReKi !< Linear velocity of of the apex of rotation (point Q) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: LinVelET !< Linear velocity of current point on the tower (point T) in the inertia frame [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LinVelESm2 !< The m2-component (closest to tip) of LinVelES [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PLinVelEIMU !< Partial linear velocity (and its 1st time derivative) of the nacelle IMU (point IMU) in the inertia frame (body E for earth) [-] @@ -435,38 +435,38 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PLinVelEV !< Partial linear velocity (and its 1st time derivative) of the selected point on the rotor-furl axis (point V) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PLinVelEW !< Partial linear velocity (and its 1st time derivative) of the selected point on the tail-furl axis (point W) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PLinVelEY !< Partial linear velocity (and its 1st time derivative) of the platform mass center (point Y) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEIMUt !< Portion of the linear acceleration of the nacelle IMU (point IMU) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEOt !< Portion of the linear acceleration of the base plate (point O) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEIMUt = 0.0_ReKi !< Portion of the linear acceleration of the nacelle IMU (point IMU) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEOt = 0.0_ReKi !< Portion of the linear acceleration of the base plate (point O) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: LinAccESt !< Portion of the linear acceleration of a point on a blade (point S) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: LinAccETt !< Portion of the linear acceleration of a point on the tower (point T) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEZt !< Portion of the linear acceleration of the platform reference (point Z) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinVelEIMU !< Linear velocity of the nacelle IMU (point IMU) in the inertia frame [-] - REAL(ReKi) , DIMENSION(1:3) :: LinVelEZ !< Linear velocity of platform reference (point Z) in the inertia frame [-] - REAL(ReKi) , DIMENSION(1:3) :: LinVelEO !< Linear velocity of the base plate (point O) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: LinVelEJ !< Linear velocity of the tail fin CM (point J) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcONcRtt !< Portion of the force at yaw bearing (point O) due to the nacelle, generator, and rotor associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcPRott !< Portion of the force at the teeter pin (point P) due to the rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEZt = 0.0_ReKi !< Portion of the linear acceleration of the platform reference (point Z) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinVelEIMU = 0.0_ReKi !< Linear velocity of the nacelle IMU (point IMU) in the inertia frame [-] + REAL(ReKi) , DIMENSION(1:3) :: LinVelEZ = 0.0_ReKi !< Linear velocity of platform reference (point Z) in the inertia frame [-] + REAL(ReKi) , DIMENSION(1:3) :: LinVelEO = 0.0_ReKi !< Linear velocity of the base plate (point O) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: LinVelEJ = 0.0_ReKi !< Linear velocity of the tail fin CM (point J) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcONcRtt = 0.0_ReKi !< Portion of the force at yaw bearing (point O) due to the nacelle, generator, and rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcPRott = 0.0_ReKi !< Portion of the force at the teeter pin (point P) due to the rotor associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FrcS0Bt !< Portion of the force at the blade root (point S(0)) due to the blade associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcT0Trbt !< Portion of the force at tower base (point T(0)) due to the turbine associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcT0Trbt = 0.0_ReKi !< Portion of the force at tower base (point T(0)) due to the turbine associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: FSAero !< The aerodynamic force per unit span acting on a blade at point S [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FSTipDrag !< The aerodynamic force at a blade tip resulting from tip drag [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FTHydrot !< Portion of the hydrodynamic force (& all other external forces, including aerodynamic) per unit length acting on the tower at point T associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: FZHydrot !< Portion of the platform hydrodynamic force at the platform reference (point Z) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: FZHydrot = 0.0_ReKi !< Portion of the platform hydrodynamic force at the platform reference (point Z) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MFHydrot !< Portion of the hydrodynamic moment (and all other external moments, including aerodynamic) per unit length acting on a tower element (body F) at point T associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomBNcRtt !< Portion of the moment at the base plate (body B) / yaw bearing (point O) due to the nacelle, generator, and rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomBNcRtt = 0.0_ReKi !< Portion of the moment at the base plate (body B) / yaw bearing (point O) due to the nacelle, generator, and rotor associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MomH0Bt !< Portion of the moment at the hub (body H) / blade root (point S(0)) due to the blade associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomLPRott !< Portion of the moment at the teeter pin (point P) on the low-speed shaft (body L) due to the rotor associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomNGnRtt !< Portion of the moment at the nacelle (body N) / selected point on rotor-furl axis (point V) due the structure that furls with the rotor, generator, and rotor associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomNTailt !< Portion of the moment at the nacelle (body N) / selected point on tail-furl axis (point W) due the tail associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomX0Trbt !< Portion of the moment at the platform (body X) / tower base (point T(0)) due to the turbine associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomLPRott = 0.0_ReKi !< Portion of the moment at the teeter pin (point P) on the low-speed shaft (body L) due to the rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomNGnRtt = 0.0_ReKi !< Portion of the moment at the nacelle (body N) / selected point on rotor-furl axis (point V) due the structure that furls with the rotor, generator, and rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomNTailt = 0.0_ReKi !< Portion of the moment at the nacelle (body N) / selected point on tail-furl axis (point W) due the tail associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomX0Trbt = 0.0_ReKi !< Portion of the moment at the platform (body X) / tower base (point T(0)) due to the turbine associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: MMAero !< The aerodynamic moment per unit span acting on a blade at point S [-] - REAL(ReKi) , DIMENSION(1:3) :: MXHydrot !< Portion of the platform hydrodynamic moment acting at the platform (body X) / platform reference (point Z) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MXHydrot = 0.0_ReKi !< Portion of the platform hydrodynamic moment acting at the platform (body X) / platform reference (point Z) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcONcRt !< Partial force at the yaw bearing (point O) due to the nacelle, generator, and rotor [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcPRot !< Partial force at the teeter pin (point P) due to the rotor [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PFrcS0B !< Partial force at the blade root (point S(0)) due to the blade [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcT0Trb !< Partial force at the tower base (point T(0)) due to the turbine [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PFTHydro !< Partial hydrodynamic force per unit length acting on the tower at point T [-] - REAL(ReKi) , DIMENSION(1:6,1:3) :: PFZHydro !< Partial platform hydrodynamic force at the platform reference (point Z) [-] + REAL(ReKi) , DIMENSION(1:6,1:3) :: PFZHydro = 0.0_ReKi !< Partial platform hydrodynamic force at the platform reference (point Z) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PMFHydro !< Partial hydrodynamic moment per unit length acting on a tower element (body F) at point T [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PMomBNcRt !< Partial moment at the base plate (body B) / yaw bearing (point O) due the nacelle, generator, and rotor [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PMomH0B !< Partial moment at the hub (body H) / blade root (point S(0)) due to the blade [-] @@ -474,20 +474,20 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PMomNGnRt !< Partial moment at the nacelle (body N) / selected point on rotor-furl axis (point V) due the structure that furls with the rotor, generator, and rotor [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PMomNTail !< Partial moment at the nacelle (body N) / selected point on tail-furl axis (point W) due the tail [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PMomX0Trb !< Partial moment at the platform (body X) / tower base (point T(0)) due to the turbine [-] - REAL(ReKi) , DIMENSION(1:6,1:3) :: PMXHydro !< Partial platform hydrodynamic moment at the platform (body X) / platform reference (point Z) [-] - REAL(R8Ki) :: TeetAng !< Current teeter angle = QT(DOF_Teet) for 2-blader or 0 for 3-blader (this is used in place of QT(DOF_Teet) throughout RtHS() [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcVGnRtt !< Portion of the force at the rotor-furl axis (point V) due to the structure that furls with the rotor, generator, and rotor associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcWTailt !< Portion of the force at the tail-furl axis (point W) due to the tail associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcZAllt !< Portion of the force at platform reference (point Z) due to everything associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomXAllt !< Portion of the moment at the platform (body X) / platform reference (point Z) due to everything associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:6,1:3) :: PMXHydro = 0.0_ReKi !< Partial platform hydrodynamic moment at the platform (body X) / platform reference (point Z) [-] + REAL(R8Ki) :: TeetAng = 0.0_R8Ki !< Current teeter angle = QT(DOF_Teet) for 2-blader or 0 for 3-blader (this is used in place of QT(DOF_Teet) throughout RtHS() [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcVGnRtt = 0.0_ReKi !< Portion of the force at the rotor-furl axis (point V) due to the structure that furls with the rotor, generator, and rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcWTailt = 0.0_ReKi !< Portion of the force at the tail-furl axis (point W) due to the tail associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcZAllt = 0.0_ReKi !< Portion of the force at platform reference (point Z) due to everything associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomXAllt = 0.0_ReKi !< Portion of the moment at the platform (body X) / platform reference (point Z) due to everything associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcVGnRt !< Partial force at the rotor-furl axis (point V) due to the structure that furls with the rotor, generator, and rotor [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcWTail !< Partial force at the tail-furl axis (point W) due to the tail [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcZAll !< Partial force at the platform reference (point Z) due to everything [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PMomXAll !< Partial moment at the platform (body X) / platform reference (point Z) due to the everything [-] - REAL(ReKi) :: TeetMom !< The total moment supplied by the stop, spring, and damper of the teeter mechanism [-] - REAL(ReKi) :: TFrlMom !< The total tail-furl spring and damper moment [-] - REAL(ReKi) :: RFrlMom !< The total rotor-furl spring and damper moment [-] - REAL(ReKi) :: GBoxEffFac !< The factor used to apply the gearbox efficiency effects to the equation associated with the generator DOF [-] + REAL(ReKi) :: TeetMom = 0.0_ReKi !< The total moment supplied by the stop, spring, and damper of the teeter mechanism [-] + REAL(ReKi) :: TFrlMom = 0.0_ReKi !< The total tail-furl spring and damper moment [-] + REAL(ReKi) :: RFrlMom = 0.0_ReKi !< The total rotor-furl spring and damper moment [-] + REAL(ReKi) :: GBoxEffFac = 0.0_ReKi !< The factor used to apply the gearbox efficiency effects to the equation associated with the generator DOF [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: rSAerCen !< aerodynamic pitching moment arm (i.e., the position vector from point S on the blade to the aerodynamic center of the element) [-] END TYPE ED_RtHndSide ! ======================= @@ -499,23 +499,23 @@ MODULE ElastoDyn_Types ! ======================= ! ========= ED_DiscreteStateType ======= TYPE, PUBLIC :: ED_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE ED_DiscreteStateType ! ======================= ! ========= ED_ConstraintStateType ======= TYPE, PUBLIC :: ED_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE ED_ConstraintStateType ! ======================= ! ========= ED_OtherStateType ======= TYPE, PUBLIC :: ED_OtherStateType - INTEGER(IntKi) :: n !< tracks time step for which OtherState was updated [-] + INTEGER(IntKi) :: n = 0_IntKi !< tracks time step for which OtherState was updated [-] 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(1:ED_NMX) :: SgnLSTQ !< history of sign of LSTQ [-] + REAL(ReKi) :: HSSBrTrq = 0.0_ReKi !< HSSBrTrq from update states; a hack to get this working with a single integrator [-] + REAL(ReKi) :: HSSBrTrqC = 0.0_ReKi !< Commanded HSS brake torque (adjusted for sign) [N-m] + INTEGER(IntKi) :: SgnPrvLSTQ = 0_IntKi !< 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(1:ED_NMX) :: SgnLSTQ = 0_IntKi !< history of sign of LSTQ [-] END TYPE ED_OtherStateType ! ======================= ! ========= ED_MiscVarType ======= @@ -529,21 +529,21 @@ MODULE ElastoDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AugMat_pivot !< Pivot column for AugMat in LAPACK factorization [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OgnlGeAzRo !< Original DOF_GeAz row in AugMat [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QD2T !< Solution (acceleration) vector; the first time derivative of QDT [-] - LOGICAL :: IgnoreMod !< whether to ignore the modulo in ED outputs (necessary for linearization perturbations) [-] + LOGICAL :: IgnoreMod = .false. !< whether to ignore the modulo in ED outputs (necessary for linearization perturbations) [-] END TYPE ED_MiscVarType ! ======================= ! ========= ED_ParameterType ======= TYPE, PUBLIC :: ED_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - REAL(DbKi) :: DT24 !< =DT/24 (used in loose coupling) [seconds] - INTEGER(IntKi) :: BldNodes !< Number of blade nodes used in the analysis [-] - INTEGER(IntKi) :: TipNode !< Index of the additional node located at the blade tip = BldNodes + 1 [-] - INTEGER(IntKi) :: NDOF !< Number of total degrees of freedom (DOFs) [-] - REAL(R8Ki) :: TwoPiNB !< Two pi divided by the number of blades [radians] - INTEGER(IntKi) :: NAug !< Dimension of augmented solution matrix [-] - INTEGER(IntKi) :: NPH !< Number of DOFs that contribute to the angular velocity of the hub (body H) in the inertia frame [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: DT24 = 0.0_R8Ki !< =DT/24 (used in loose coupling) [seconds] + INTEGER(IntKi) :: BldNodes = 0_IntKi !< Number of blade nodes used in the analysis [-] + INTEGER(IntKi) :: TipNode = 0_IntKi !< Index of the additional node located at the blade tip = BldNodes + 1 [-] + INTEGER(IntKi) :: NDOF = 0_IntKi !< Number of total degrees of freedom (DOFs) [-] + REAL(R8Ki) :: TwoPiNB = 0.0_R8Ki !< Two pi divided by the number of blades [radians] + INTEGER(IntKi) :: NAug = 0_IntKi !< Dimension of augmented solution matrix [-] + INTEGER(IntKi) :: NPH = 0_IntKi !< Number of DOFs that contribute to the angular velocity of the hub (body H) in the inertia frame [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PH !< Array of DOF indices (pointers) that contribute to the angular velocity of the hub (body H) in the inertia frame [-] - INTEGER(IntKi) :: NPM !< Number of DOFs that contribute to the angular velocity of the blade elements (body M) in the inertia frame [-] + INTEGER(IntKi) :: NPM = 0_IntKi !< Number of DOFs that contribute to the angular velocity of the blade elements (body M) in the inertia frame [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: PM !< Array of DOF indices (pointers) that contribute to the angular velocity of the blade elements (body M) in the inertia frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: DOF_Flag !< Array which stores values of the feature flags for each DOF [-] CHARACTER(99) , DIMENSION(:), ALLOCATABLE :: DOF_Desc !< Array which stores descriptions of each DOF [-] @@ -554,122 +554,122 @@ MODULE ElastoDyn_Types INTEGER(IntKi) :: NTwGages = 0 !< Number of tower strain gages [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] CHARACTER(1) :: Delim !< Column delimiter for output text files [-] - REAL(ReKi) :: AvgNrmTpRd !< Average tip radius normal to the shaft [meters] - REAL(R8Ki) :: AzimB1Up !< Azimuth value to use for I/O when blade 1 points up [radians] + REAL(ReKi) :: AvgNrmTpRd = 0.0_ReKi !< Average tip radius normal to the shaft [meters] + REAL(R8Ki) :: AzimB1Up = 0.0_R8Ki !< Azimuth value to use for I/O when blade 1 points up [radians] REAL(R8Ki) :: CosDel3 = 1.0 !< Cosine of the Delta-3 angle for teetering rotors [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: CosPreC !< Cosines of the precone angles [-] - REAL(R8Ki) :: CRFrlSkew !< Cosine of the rotor-furl axis skew angle [-] - REAL(R8Ki) :: CRFrlSkw2 !< Cosine-squared of the rotor-furl axis skew angle [-] - REAL(R8Ki) :: CRFrlTilt !< Cosine of the rotor-furl axis tilt angle [-] - REAL(R8Ki) :: CRFrlTlt2 !< Cosine-squared of the rotor-furl axis tilt angle [-] - REAL(R8Ki) :: CShftSkew !< Cosine of the shaft skew angle [-] - REAL(R8Ki) :: CShftTilt !< Cosine of the shaft tilt angle [-] - REAL(R8Ki) :: CSRFrlSkw !< Cosine*Sine of the rotor-furl axis skew angle [-] - REAL(R8Ki) :: CSRFrlTlt !< Cosine*Sine of the rotor-furl axis tilt angle [-] - REAL(R8Ki) :: CSTFrlSkw !< Cosine*Sine of the tail-furl axis skew angle [-] - REAL(R8Ki) :: CSTFrlTlt !< Cosine*Sine of the tail-furl axis tilt angle [-] - REAL(R8Ki) :: CTFrlSkew !< Cosine of the tail-furl axis skew angle [-] - REAL(R8Ki) :: CTFrlSkw2 !< Cosine-squared of the tail-furl axis skew angle [-] - REAL(R8Ki) :: CTFrlTilt !< Cosine of the tail-furl axis tilt angle [-] - REAL(R8Ki) :: CTFrlTlt2 !< Cosine-squared of the tail-furl axis tilt angle [-] - REAL(ReKi) :: HubHt !< Hub-height as computed using FAST inputs [= TowerHt + Twr2Shft + OverHang*SIN( ShftTilt ) ] (was FASTHH) [-] - REAL(ReKi) :: HubCM !< Distance from rotor apex to hub mass [-] - REAL(ReKi) :: HubRad !< Preconed hub radius [-] - REAL(ReKi) :: NacCMxn !< Downwind distance from tower-top to nacelle CM [-] - REAL(ReKi) :: NacCMyn !< Lateral distance from tower-top to nacelle CM [-] - REAL(ReKi) :: NacCMzn !< Vertical distance from tower-top to nacelle CM [-] - REAL(ReKi) :: OverHang !< Distance from yaw axis to rotor apex or teeter pin [-] - REAL(ReKi) :: ProjArea !< Swept area of the rotor projected onto the rotor plane (the plane normal to the low-speed shaft) [-] - REAL(ReKi) :: PtfmRefzt !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [-] - REAL(ReKi) :: RefTwrHt !< Vertical distance between FAST's undisplaced tower height (variable TowerHt) and FAST's inertia frame reference point (variable PtfmRef); that is, RefTwrHt = TowerHt - PtfmRefzt [-] - REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n !< Vector from tower-top to arbitrary point on rotor-furl axis [-] - REAL(ReKi) :: rVDxn !< xn-component of position vector Rvd [-] - REAL(ReKi) :: rVDyn !< yn-component of position vector rVD [-] - REAL(ReKi) :: rVDzn !< zn-component of position vector rVD [-] - REAL(ReKi) :: rVIMUxn !< xn-component of position vector rVIMU [-] - REAL(ReKi) :: rVIMUyn !< yn-component of position vector rVIMU [-] - REAL(ReKi) :: rVIMUzn !< zn-component of position vector rVIMU [-] - REAL(ReKi) :: rVPxn !< xn-component of position vector rVP [-] - REAL(ReKi) :: rVPyn !< yn-component of position vector rVP [-] - REAL(ReKi) :: rVPzn !< zn-component of position vector rVP [-] - REAL(ReKi) :: rWIxn !< xn-component of position vector rWI [-] - REAL(ReKi) :: rWIyn !< yn-component of position vector rWI [-] - REAL(ReKi) :: rWIzn !< zn-component of position vector rWI [-] - REAL(ReKi) :: rWJxn !< xn-component of position vector rWJ [-] - REAL(ReKi) :: rWJyn !< yn-component of position vector rWJ [-] - REAL(ReKi) :: rWJzn !< zn-component of position vector rWJ [-] - REAL(ReKi) :: rZT0zt !< zt-component of position vector rZT0 [-] - REAL(ReKi) :: rZYzt !< zt-component of position vector rZY [-] - REAL(R8Ki) :: SinDel3 !< Sine of the Delta-3 angle for teetering rotors [-] + REAL(R8Ki) :: CRFrlSkew = 0.0_R8Ki !< Cosine of the rotor-furl axis skew angle [-] + REAL(R8Ki) :: CRFrlSkw2 = 0.0_R8Ki !< Cosine-squared of the rotor-furl axis skew angle [-] + REAL(R8Ki) :: CRFrlTilt = 0.0_R8Ki !< Cosine of the rotor-furl axis tilt angle [-] + REAL(R8Ki) :: CRFrlTlt2 = 0.0_R8Ki !< Cosine-squared of the rotor-furl axis tilt angle [-] + REAL(R8Ki) :: CShftSkew = 0.0_R8Ki !< Cosine of the shaft skew angle [-] + REAL(R8Ki) :: CShftTilt = 0.0_R8Ki !< Cosine of the shaft tilt angle [-] + REAL(R8Ki) :: CSRFrlSkw = 0.0_R8Ki !< Cosine*Sine of the rotor-furl axis skew angle [-] + REAL(R8Ki) :: CSRFrlTlt = 0.0_R8Ki !< Cosine*Sine of the rotor-furl axis tilt angle [-] + REAL(R8Ki) :: CSTFrlSkw = 0.0_R8Ki !< Cosine*Sine of the tail-furl axis skew angle [-] + REAL(R8Ki) :: CSTFrlTlt = 0.0_R8Ki !< Cosine*Sine of the tail-furl axis tilt angle [-] + REAL(R8Ki) :: CTFrlSkew = 0.0_R8Ki !< Cosine of the tail-furl axis skew angle [-] + REAL(R8Ki) :: CTFrlSkw2 = 0.0_R8Ki !< Cosine-squared of the tail-furl axis skew angle [-] + REAL(R8Ki) :: CTFrlTilt = 0.0_R8Ki !< Cosine of the tail-furl axis tilt angle [-] + REAL(R8Ki) :: CTFrlTlt2 = 0.0_R8Ki !< Cosine-squared of the tail-furl axis tilt angle [-] + REAL(ReKi) :: HubHt = 0.0_ReKi !< Hub-height as computed using FAST inputs [= TowerHt + Twr2Shft + OverHang*SIN( ShftTilt ) ] (was FASTHH) [-] + REAL(ReKi) :: HubCM = 0.0_ReKi !< Distance from rotor apex to hub mass [-] + REAL(ReKi) :: HubRad = 0.0_ReKi !< Preconed hub radius [-] + REAL(ReKi) :: NacCMxn = 0.0_ReKi !< Downwind distance from tower-top to nacelle CM [-] + REAL(ReKi) :: NacCMyn = 0.0_ReKi !< Lateral distance from tower-top to nacelle CM [-] + REAL(ReKi) :: NacCMzn = 0.0_ReKi !< Vertical distance from tower-top to nacelle CM [-] + REAL(ReKi) :: OverHang = 0.0_ReKi !< Distance from yaw axis to rotor apex or teeter pin [-] + REAL(ReKi) :: ProjArea = 0.0_ReKi !< Swept area of the rotor projected onto the rotor plane (the plane normal to the low-speed shaft) [-] + REAL(ReKi) :: PtfmRefzt = 0.0_ReKi !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [-] + REAL(ReKi) :: RefTwrHt = 0.0_ReKi !< Vertical distance between FAST's undisplaced tower height (variable TowerHt) and FAST's inertia frame reference point (variable PtfmRef); that is, RefTwrHt = TowerHt - PtfmRefzt [-] + REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n = 0.0_ReKi !< Vector from tower-top to arbitrary point on rotor-furl axis [-] + REAL(ReKi) :: rVDxn = 0.0_ReKi !< xn-component of position vector Rvd [-] + REAL(ReKi) :: rVDyn = 0.0_ReKi !< yn-component of position vector rVD [-] + REAL(ReKi) :: rVDzn = 0.0_ReKi !< zn-component of position vector rVD [-] + REAL(ReKi) :: rVIMUxn = 0.0_ReKi !< xn-component of position vector rVIMU [-] + REAL(ReKi) :: rVIMUyn = 0.0_ReKi !< yn-component of position vector rVIMU [-] + REAL(ReKi) :: rVIMUzn = 0.0_ReKi !< zn-component of position vector rVIMU [-] + REAL(ReKi) :: rVPxn = 0.0_ReKi !< xn-component of position vector rVP [-] + REAL(ReKi) :: rVPyn = 0.0_ReKi !< yn-component of position vector rVP [-] + REAL(ReKi) :: rVPzn = 0.0_ReKi !< zn-component of position vector rVP [-] + REAL(ReKi) :: rWIxn = 0.0_ReKi !< xn-component of position vector rWI [-] + REAL(ReKi) :: rWIyn = 0.0_ReKi !< yn-component of position vector rWI [-] + REAL(ReKi) :: rWIzn = 0.0_ReKi !< zn-component of position vector rWI [-] + REAL(ReKi) :: rWJxn = 0.0_ReKi !< xn-component of position vector rWJ [-] + REAL(ReKi) :: rWJyn = 0.0_ReKi !< yn-component of position vector rWJ [-] + REAL(ReKi) :: rWJzn = 0.0_ReKi !< zn-component of position vector rWJ [-] + REAL(ReKi) :: rZT0zt = 0.0_ReKi !< zt-component of position vector rZT0 [-] + REAL(ReKi) :: rZYzt = 0.0_ReKi !< zt-component of position vector rZY [-] + REAL(R8Ki) :: SinDel3 = 0.0_R8Ki !< Sine of the Delta-3 angle for teetering rotors [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: SinPreC !< Sines of the precone angles [-] - REAL(R8Ki) :: SRFrlSkew !< Sine of the rotor-furl axis skew angle [-] - REAL(R8Ki) :: SRFrlSkw2 !< Sine-squared of the rotor-furl axis skew angle [-] - REAL(R8Ki) :: SRFrlTilt !< Sine of the rotor-furl axis tilt angle [-] - REAL(R8Ki) :: SRFrlTlt2 !< Sine-squared of the rotor-furl axis tilt angle [-] - REAL(R8Ki) :: SShftSkew !< Sine of the shaft skew angle [-] - REAL(R8Ki) :: SShftTilt !< Sine of the shaft tilt angle [-] - REAL(R8Ki) :: STFrlSkew !< Sine of the tail-furl axis skew angle [-] - REAL(R8Ki) :: STFrlSkw2 !< Sine-squared of the tail-furl axis skew angle [-] - REAL(R8Ki) :: STFrlTilt !< Sine of the tail-furl axis tilt angle [-] - REAL(R8Ki) :: STFrlTlt2 !< Sine-squared of the tail-furl axis tilt angle [-] - REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n !< Vector from tower-top to arbitrary point on tail-furl axis [-] - REAL(ReKi) :: TipRad !< Preconed blade-tip radius [-] - REAL(ReKi) :: TowerHt !< Height of tower relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] - REAL(ReKi) :: TowerBsHt !< Height of tower base relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] - REAL(ReKi) :: UndSling !< Undersling length [-] - INTEGER(IntKi) :: NumBl !< Number of turbine blades [-] + REAL(R8Ki) :: SRFrlSkew = 0.0_R8Ki !< Sine of the rotor-furl axis skew angle [-] + REAL(R8Ki) :: SRFrlSkw2 = 0.0_R8Ki !< Sine-squared of the rotor-furl axis skew angle [-] + REAL(R8Ki) :: SRFrlTilt = 0.0_R8Ki !< Sine of the rotor-furl axis tilt angle [-] + REAL(R8Ki) :: SRFrlTlt2 = 0.0_R8Ki !< Sine-squared of the rotor-furl axis tilt angle [-] + REAL(R8Ki) :: SShftSkew = 0.0_R8Ki !< Sine of the shaft skew angle [-] + REAL(R8Ki) :: SShftTilt = 0.0_R8Ki !< Sine of the shaft tilt angle [-] + REAL(R8Ki) :: STFrlSkew = 0.0_R8Ki !< Sine of the tail-furl axis skew angle [-] + REAL(R8Ki) :: STFrlSkw2 = 0.0_R8Ki !< Sine-squared of the tail-furl axis skew angle [-] + REAL(R8Ki) :: STFrlTilt = 0.0_R8Ki !< Sine of the tail-furl axis tilt angle [-] + REAL(R8Ki) :: STFrlTlt2 = 0.0_R8Ki !< Sine-squared of the tail-furl axis tilt angle [-] + REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n = 0.0_ReKi !< Vector from tower-top to arbitrary point on tail-furl axis [-] + REAL(ReKi) :: TipRad = 0.0_ReKi !< Preconed blade-tip radius [-] + REAL(ReKi) :: TowerHt = 0.0_ReKi !< Height of tower relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] + REAL(ReKi) :: TowerBsHt = 0.0_ReKi !< Height of tower base relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] + REAL(ReKi) :: UndSling = 0.0_ReKi !< Undersling length [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of turbine blades [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AxRedTFA !< The axial-reduction terms for the fore-aft tower mode shapes [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AxRedTSS !< The axial-reduction terms for the side-to-side tower mode shapes [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: CTFA !< Generalized damping of tower in fore-aft direction [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: CTSS !< Generalized damping of tower in side-to-side direction [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: CTFA = 0.0_ReKi !< Generalized damping of tower in fore-aft direction [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: CTSS = 0.0_ReKi !< Generalized damping of tower in side-to-side direction [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DHNodes !< Length of variable-length tower elements [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HNodes !< Location of variable-spaced tower nodes (relative to the tower rigid base height [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HNodesNorm !< Normalized location of variable-spaced tower nodes (relative to the tower rigid base height) (0 < HNodesNorm(:) < 1) [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: KTFA !< Generalized stiffness of tower in fore-aft direction [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: KTSS !< Generalized stiffness of tower in side-to-side direction [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: KTFA = 0.0_ReKi !< Generalized stiffness of tower in fore-aft direction [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: KTSS = 0.0_ReKi !< Generalized stiffness of tower in side-to-side direction [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MassT !< Interpolated lineal mass density of tower [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: StiffTSS !< Interpolated side-side tower stiffness [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: TwrFASF !< Tower fore-aft shape functions [-] - REAL(ReKi) :: TwrFlexL !< Height / length of the flexible portion of the tower [-] + REAL(ReKi) :: TwrFlexL = 0.0_ReKi !< Height / length of the flexible portion of the tower [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: TwrSSSF !< Tower side-to-side shape functions [-] - INTEGER(IntKi) :: TTopNode !< Index of the additional node located at the tower-top = TwrNodes + 1 [-] - INTEGER(IntKi) :: TwrNodes !< Number of tower nodes used in the analysis [-] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] + INTEGER(IntKi) :: TTopNode = 0_IntKi !< Index of the additional node located at the tower-top = TwrNodes + 1 [-] + INTEGER(IntKi) :: TwrNodes = 0_IntKi !< Number of tower nodes used in the analysis [-] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: StiffTFA !< Interpolated fore-aft tower stiffness [-] - REAL(ReKi) :: AtfaIner !< Inertia of tail boom about the tail-furl axis whose origin is the tail boom center of mass [-] + REAL(ReKi) :: AtfaIner = 0.0_ReKi !< Inertia of tail boom about the tail-furl axis whose origin is the tail boom center of mass [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldCG !< Blade center of mass wrt the blade root [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldMass !< Blade masses [-] - REAL(ReKi) :: BoomMass !< Tail boom mass [-] + REAL(ReKi) :: BoomMass = 0.0_ReKi !< Tail boom mass [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FirstMom !< First mass moment of inertia of blades wrt the root [-] - REAL(ReKi) :: GenIner !< Generator inertia about HSS [-] - REAL(ReKi) :: Hubg1Iner !< Inertia of hub about g1-axis (rotor centerline) [-] - REAL(ReKi) :: Hubg2Iner !< Inertia of hub about g2-axis (transverse to the cyclinder and passing through its c.g.) [-] - REAL(ReKi) :: HubMass !< Hub mass [-] - REAL(ReKi) :: Nacd2Iner !< Inertia of nacelle about the d2-axis whose origin is the nacelle center of mass [-] - REAL(ReKi) :: NacMass !< Nacelle mass [-] - REAL(ReKi) :: PtfmMass !< Platform mass [-] - REAL(ReKi) :: PtfmPIner !< Platform inertia for pitch tilt rotation about the platform CM. [-] - REAL(ReKi) :: PtfmRIner !< Platform inertia for roll tilt rotation about the platform CM. [-] - REAL(ReKi) :: PtfmYIner !< Platform inertia for yaw rotation about the platform CM. [-] - REAL(ReKi) :: RFrlMass !< Rotor-furl mass [-] - REAL(ReKi) :: RotIner !< Inertia of rotor about its centerline [-] - REAL(ReKi) :: RotMass !< Rotor mass (blades, tips, and hub) [-] - REAL(ReKi) :: RrfaIner !< Inertia of structure that furls with the rotor (not including rotor) about the rotor-furl axis whose origin is the center of mass of the structure that furls with the rotor (not including rotor) [-] + REAL(ReKi) :: GenIner = 0.0_ReKi !< Generator inertia about HSS [-] + REAL(ReKi) :: Hubg1Iner = 0.0_ReKi !< Inertia of hub about g1-axis (rotor centerline) [-] + REAL(ReKi) :: Hubg2Iner = 0.0_ReKi !< Inertia of hub about g2-axis (transverse to the cyclinder and passing through its c.g.) [-] + REAL(ReKi) :: HubMass = 0.0_ReKi !< Hub mass [-] + REAL(ReKi) :: Nacd2Iner = 0.0_ReKi !< Inertia of nacelle about the d2-axis whose origin is the nacelle center of mass [-] + REAL(ReKi) :: NacMass = 0.0_ReKi !< Nacelle mass [-] + REAL(ReKi) :: PtfmMass = 0.0_ReKi !< Platform mass [-] + REAL(ReKi) :: PtfmPIner = 0.0_ReKi !< Platform inertia for pitch tilt rotation about the platform CM. [-] + REAL(ReKi) :: PtfmRIner = 0.0_ReKi !< Platform inertia for roll tilt rotation about the platform CM. [-] + REAL(ReKi) :: PtfmYIner = 0.0_ReKi !< Platform inertia for yaw rotation about the platform CM. [-] + REAL(ReKi) :: RFrlMass = 0.0_ReKi !< Rotor-furl mass [-] + REAL(ReKi) :: RotIner = 0.0_ReKi !< Inertia of rotor about its centerline [-] + REAL(ReKi) :: RotMass = 0.0_ReKi !< Rotor mass (blades, tips, and hub) [-] + REAL(ReKi) :: RrfaIner = 0.0_ReKi !< Inertia of structure that furls with the rotor (not including rotor) about the rotor-furl axis whose origin is the center of mass of the structure that furls with the rotor (not including rotor) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SecondMom !< Second mass moment of inertia of blades wrt the root [-] - REAL(ReKi) :: TFinMass !< Tail fin mass [-] - REAL(ReKi) :: TFrlIner !< Tail boom inertia about tail-furl axis [-] + REAL(ReKi) :: TFinMass = 0.0_ReKi !< Tail fin mass [-] + REAL(ReKi) :: TFrlIner = 0.0_ReKi !< Tail boom inertia about tail-furl axis [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TipMass !< Tip-brake masses [-] - REAL(ReKi) :: TurbMass !< Mass of turbine (tower + rotor + nacelle) [-] - REAL(ReKi) :: TwrMass !< Mass of tower [-] - REAL(ReKi) :: TwrTpMass !< Tower-top mass (rotor + nacelle) [-] - REAL(ReKi) :: YawBrMass !< Yaw bearing mass [-] - REAL(ReKi) :: Gravity !< Gravitational acceleration [m/s^2] + REAL(ReKi) :: TurbMass = 0.0_ReKi !< Mass of turbine (tower + rotor + nacelle) [-] + REAL(ReKi) :: TwrMass = 0.0_ReKi !< Mass of tower [-] + REAL(ReKi) :: TwrTpMass = 0.0_ReKi !< Tower-top mass (rotor + nacelle) [-] + REAL(ReKi) :: YawBrMass = 0.0_ReKi !< Yaw bearing mass [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PitchAxis !< Pitch axis for analysis nodes [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AeroTwst !< Aerodynamic twist of the blade at the analysis nodes [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: AxRedBld !< The axial-reduction terms of the blade shape function [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldEDamp !< Blade edgewise damping coefficients [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldFDamp !< Blade flapwise damping coefficients [-] - REAL(ReKi) :: BldFlexL !< Flexible blade length [-] + REAL(ReKi) :: BldFlexL = 0.0_ReKi !< Flexible blade length [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CAeroTwst !< Cosine of the aerodynamic twist of the blade at the analysis nodes [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CBE !< Generalized edgewise damping of the blades [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CBF !< Generalized flapwise damping of the blades [-] @@ -695,63 +695,63 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldEdgSh !< Blade-edge-mode shape coefficients [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: FreqBE !< Blade edgewise natural frequencies (both w/ and w/o centrifugal stiffening) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: FreqBF !< Blade flapwise natural frequencies (both w/ and w/o centrifugal stiffening) [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: FreqTFA !< Computed fore-aft tower natural frequencies [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: FreqTSS !< Computed side-to-side tower natural frequencies [-] - REAL(ReKi) :: TeetCDmp !< Rotor-teeter rate-independent Coulomb-damping [-] - REAL(ReKi) :: TeetDmp !< Rotor-teeter damping constant [-] - REAL(ReKi) :: TeetDmpP !< Rotor-teeter damper position [-] - REAL(ReKi) :: TeetHSSp !< Rotor-teeter hard-stop linear-spring constant [-] - REAL(ReKi) :: TeetHStP !< Rotor-teeter hard-stop position [-] - REAL(ReKi) :: TeetSSSp !< Rotor-teeter soft-stop linear-spring constant [-] - REAL(ReKi) :: TeetSStP !< Rotor-teeter soft-stop position [-] - INTEGER(IntKi) :: TeetMod !< Rotor-teeter spring/damper model switch [-] - REAL(ReKi) :: TFrlDmp !< Tail-furl damping constant [-] - REAL(ReKi) :: TFrlDSDmp !< Tail-furl down-stop damping constant [-] - REAL(ReKi) :: TFrlDSDP !< Tail-furl down-stop damper position [-] - REAL(ReKi) :: TFrlDSSP !< Tail-furl down-stop spring position [-] - REAL(ReKi) :: TFrlDSSpr !< Tail-furl down-stop spring constant [-] - REAL(ReKi) :: TFrlSpr !< Tail-furl spring constant [-] - REAL(ReKi) :: TFrlUSDmp !< Tail-furl up-stop damping constant [-] - REAL(ReKi) :: TFrlUSDP !< Tail-furl up-stop damper position [-] - REAL(ReKi) :: TFrlUSSP !< Tail-furl up-stop spring position [-] - REAL(ReKi) :: TFrlUSSpr !< Tail-furl up-stop spring constant [-] - INTEGER(IntKi) :: TFrlMod !< Tail-furl spring/damper model switch [-] - REAL(ReKi) :: RFrlDmp !< Rotor-furl damping constant [-] - REAL(ReKi) :: RFrlDSDmp !< Rotor-furl down-stop damping constant [-] - REAL(ReKi) :: RFrlDSDP !< Rotor-furl down-stop damper position [-] - REAL(ReKi) :: RFrlDSSP !< Rotor-furl down-stop spring position [-] - REAL(ReKi) :: RFrlDSSpr !< Rotor-furl down-stop spring constant [-] - REAL(ReKi) :: RFrlSpr !< Rotor-furl spring constant [-] - REAL(ReKi) :: RFrlUSDmp !< Rotor-furl up-stop damping constant [-] - REAL(ReKi) :: RFrlUSDP !< Rotor-furl up-stop damper position [-] - REAL(ReKi) :: RFrlUSSP !< Rotor-furl up-stop spring position [-] - REAL(ReKi) :: RFrlUSSpr !< Rotor-furl up-stop spring constant [-] - INTEGER(IntKi) :: RFrlMod !< Rotor-furl spring/damper model switch [-] - REAL(ReKi) :: ShftGagL !< Distance from hub or teeter pin to shaft strain gages [-] - INTEGER(IntKi) , DIMENSION(1:9) :: BldGagNd !< Nodes closest to the blade strain gages [-] - INTEGER(IntKi) , DIMENSION(1:9) :: TwrGagNd !< Nodes closest to the tower strain gages [-] - REAL(DbKi) :: TStart !< Time to begin tabular output [-] - REAL(ReKi) :: DTTorDmp !< Drivetrain torsional damper [-] - REAL(ReKi) :: DTTorSpr !< Drivetrain torsional spring [-] - REAL(ReKi) :: GBRatio !< Gearbox ratio [-] - REAL(ReKi) :: GBoxEff !< Gearbox efficiency [-] - REAL(ReKi) :: RotSpeed !< Initial or fixed rotor speed [rad/s] + REAL(ReKi) , DIMENSION(1:2,1:2) :: FreqTFA = 0.0_ReKi !< Computed fore-aft tower natural frequencies [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: FreqTSS = 0.0_ReKi !< Computed side-to-side tower natural frequencies [-] + REAL(ReKi) :: TeetCDmp = 0.0_ReKi !< Rotor-teeter rate-independent Coulomb-damping [-] + REAL(ReKi) :: TeetDmp = 0.0_ReKi !< Rotor-teeter damping constant [-] + REAL(ReKi) :: TeetDmpP = 0.0_ReKi !< Rotor-teeter damper position [-] + REAL(ReKi) :: TeetHSSp = 0.0_ReKi !< Rotor-teeter hard-stop linear-spring constant [-] + REAL(ReKi) :: TeetHStP = 0.0_ReKi !< Rotor-teeter hard-stop position [-] + REAL(ReKi) :: TeetSSSp = 0.0_ReKi !< Rotor-teeter soft-stop linear-spring constant [-] + REAL(ReKi) :: TeetSStP = 0.0_ReKi !< Rotor-teeter soft-stop position [-] + INTEGER(IntKi) :: TeetMod = 0_IntKi !< Rotor-teeter spring/damper model switch [-] + REAL(ReKi) :: TFrlDmp = 0.0_ReKi !< Tail-furl damping constant [-] + REAL(ReKi) :: TFrlDSDmp = 0.0_ReKi !< Tail-furl down-stop damping constant [-] + REAL(ReKi) :: TFrlDSDP = 0.0_ReKi !< Tail-furl down-stop damper position [-] + REAL(ReKi) :: TFrlDSSP = 0.0_ReKi !< Tail-furl down-stop spring position [-] + REAL(ReKi) :: TFrlDSSpr = 0.0_ReKi !< Tail-furl down-stop spring constant [-] + REAL(ReKi) :: TFrlSpr = 0.0_ReKi !< Tail-furl spring constant [-] + REAL(ReKi) :: TFrlUSDmp = 0.0_ReKi !< Tail-furl up-stop damping constant [-] + REAL(ReKi) :: TFrlUSDP = 0.0_ReKi !< Tail-furl up-stop damper position [-] + REAL(ReKi) :: TFrlUSSP = 0.0_ReKi !< Tail-furl up-stop spring position [-] + REAL(ReKi) :: TFrlUSSpr = 0.0_ReKi !< Tail-furl up-stop spring constant [-] + INTEGER(IntKi) :: TFrlMod = 0_IntKi !< Tail-furl spring/damper model switch [-] + REAL(ReKi) :: RFrlDmp = 0.0_ReKi !< Rotor-furl damping constant [-] + REAL(ReKi) :: RFrlDSDmp = 0.0_ReKi !< Rotor-furl down-stop damping constant [-] + REAL(ReKi) :: RFrlDSDP = 0.0_ReKi !< Rotor-furl down-stop damper position [-] + REAL(ReKi) :: RFrlDSSP = 0.0_ReKi !< Rotor-furl down-stop spring position [-] + REAL(ReKi) :: RFrlDSSpr = 0.0_ReKi !< Rotor-furl down-stop spring constant [-] + REAL(ReKi) :: RFrlSpr = 0.0_ReKi !< Rotor-furl spring constant [-] + REAL(ReKi) :: RFrlUSDmp = 0.0_ReKi !< Rotor-furl up-stop damping constant [-] + REAL(ReKi) :: RFrlUSDP = 0.0_ReKi !< Rotor-furl up-stop damper position [-] + REAL(ReKi) :: RFrlUSSP = 0.0_ReKi !< Rotor-furl up-stop spring position [-] + REAL(ReKi) :: RFrlUSSpr = 0.0_ReKi !< Rotor-furl up-stop spring constant [-] + INTEGER(IntKi) :: RFrlMod = 0_IntKi !< Rotor-furl spring/damper model switch [-] + REAL(ReKi) :: ShftGagL = 0.0_ReKi !< Distance from hub or teeter pin to shaft strain gages [-] + INTEGER(IntKi) , DIMENSION(1:9) :: BldGagNd = 0_IntKi !< Nodes closest to the blade strain gages [-] + INTEGER(IntKi) , DIMENSION(1:9) :: TwrGagNd = 0_IntKi !< Nodes closest to the tower strain gages [-] + REAL(DbKi) :: TStart = 0.0_R8Ki !< Time to begin tabular output [-] + REAL(ReKi) :: DTTorDmp = 0.0_ReKi !< Drivetrain torsional damper [-] + REAL(ReKi) :: DTTorSpr = 0.0_ReKi !< Drivetrain torsional spring [-] + REAL(ReKi) :: GBRatio = 0.0_ReKi !< Gearbox ratio [-] + REAL(ReKi) :: GBoxEff = 0.0_ReKi !< Gearbox efficiency [-] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Initial or fixed rotor speed [rad/s] CHARACTER(1024) :: RootName !< RootName for writing output files [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BElmntMass !< Mass of the blade elements [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TElmntMass !< Mass of the tower elements [-] - INTEGER(IntKi) :: method !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] - REAL(ReKi) :: PtfmCMxt !< Downwind distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] - REAL(ReKi) :: PtfmCMyt !< Lateral distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] - LOGICAL :: BD4Blades !< flag to determine if BeamDyn is computing blade loads (true) or ElastoDyn is (false) [-] - LOGICAL :: UseAD14 !< flag to determine if AeroDyn14 is being used. Will remove this later when we've replaced AD14. [-] - INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] - INTEGER(IntKi) :: BldNd_TotNumOuts !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: method = 0_IntKi !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] + REAL(ReKi) :: PtfmCMxt = 0.0_ReKi !< Downwind distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] + REAL(ReKi) :: PtfmCMyt = 0.0_ReKi !< Lateral distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] + LOGICAL :: BD4Blades = .false. !< flag to determine if BeamDyn is computing blade loads (true) or ElastoDyn is (false) [-] + LOGICAL :: UseAD14 = .false. !< flag to determine if AeroDyn14 is being used. Will remove this later when we've replaced AD14. [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_TotNumOuts = 0_IntKi !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- ED_AllBldNdOuts) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (ED_AllBldNdOuts) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] END TYPE ED_ParameterType ! ======================= ! ========= ED_InputType ======= @@ -763,11 +763,11 @@ MODULE ElastoDyn_Types TYPE(MeshType) :: NacelleLoads !< From ServoDyn/TMD: loads on the nacelle. [-] TYPE(MeshType) :: TFinCMLoads !< Aerodynamic forces and moments at the tail-fin center of mass point (point J) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: TwrAddedMass !< 6-by-6 added mass matrix of the tower elements, per unit length-bjj: place on a mesh [per unit length] - REAL(ReKi) , DIMENSION(1:6,1:6) :: PtfmAddedMass !< Platform added mass matrix [kg, kg-m, kg-m^2] + REAL(ReKi) , DIMENSION(1:6,1:6) :: PtfmAddedMass = 0.0_ReKi !< Platform added mass matrix [kg, kg-m, kg-m^2] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchCom !< Commanded blade pitch angles [radians] - REAL(ReKi) :: YawMom !< Torque transmitted through the yaw bearing [N-m] - REAL(ReKi) :: GenTrq !< Electrical generator torque [N-m] - REAL(ReKi) :: HSSBrTrqC !< Commanded HSS brake torque [N-m] + REAL(ReKi) :: YawMom = 0.0_ReKi !< Torque transmitted through the yaw bearing [N-m] + REAL(ReKi) :: GenTrq = 0.0_ReKi !< Electrical generator torque [N-m] + REAL(ReKi) :: HSSBrTrqC = 0.0_ReKi !< Commanded HSS brake torque [N-m] END TYPE ED_InputType ! ======================= ! ========= ED_OutputType ======= @@ -785,22090 +785,10313 @@ MODULE ElastoDyn_Types TYPE(MeshType) :: TFinCMMotion !< For AeroDyn: motions of the tail find CM point (point J) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitch !< Current blade pitch angles [radians] - REAL(ReKi) :: Yaw !< Current nacelle yaw [radians] - REAL(ReKi) :: YawRate !< Current nacelle yaw rate [rad/s] - REAL(ReKi) :: LSS_Spd !< Low-speed shaft (LSS) speed at entrance to gearbox [rad/s] - REAL(ReKi) :: HSS_Spd !< High-speed shaft (HSS) speed [rad/s] - REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] - REAL(ReKi) :: TwrAccel !< Tower acceleration for tower feedback control (user routine only) [m/s^2] - REAL(ReKi) :: YawAngle !< Yaw angle to be used for yaw error calculations [radians] - REAL(ReKi) , DIMENSION(1:3) :: RootMyc !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] - REAL(ReKi) :: YawBrTAxp !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: YawBrTAyp !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: LSSTipPxa !< Rotor azimuth angle (position) [radians] - REAL(ReKi) , DIMENSION(1:3) :: RootMxc !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] - REAL(ReKi) :: LSSTipMxa !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMya !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMza !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMys !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMzs !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: YawBrMyn !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] - REAL(ReKi) :: YawBrMzn !< Tower-top / yaw bearing yaw moment [N-m] - REAL(ReKi) :: NcIMURAxs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAys !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAzs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: RotPwr !< Rotor power (this is equivalent to the low-speed shaft power) [W] - REAL(ReKi) :: LSShftFxa !< Rotating low-speed shaft force x [N] - REAL(ReKi) :: LSShftFys !< Nonrotating low-speed shaft force y [N] - REAL(ReKi) :: LSShftFzs !< Nonrotating low-speed shaft force z [N] + REAL(ReKi) :: Yaw = 0.0_ReKi !< Current nacelle yaw [radians] + REAL(ReKi) :: YawRate = 0.0_ReKi !< Current nacelle yaw rate [rad/s] + REAL(ReKi) :: LSS_Spd = 0.0_ReKi !< Low-speed shaft (LSS) speed at entrance to gearbox [rad/s] + REAL(ReKi) :: HSS_Spd = 0.0_ReKi !< High-speed shaft (HSS) speed [rad/s] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: TwrAccel = 0.0_ReKi !< Tower acceleration for tower feedback control (user routine only) [m/s^2] + REAL(ReKi) :: YawAngle = 0.0_ReKi !< Yaw angle to be used for yaw error calculations [radians] + REAL(ReKi) , DIMENSION(1:3) :: RootMyc = 0.0_ReKi !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] + REAL(ReKi) :: YawBrTAxp = 0.0_ReKi !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: YawBrTAyp = 0.0_ReKi !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: LSSTipPxa = 0.0_ReKi !< Rotor azimuth angle (position) [radians] + REAL(ReKi) , DIMENSION(1:3) :: RootMxc = 0.0_ReKi !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] + REAL(ReKi) :: LSSTipMxa = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMya = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMza = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMys = 0.0_ReKi !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMzs = 0.0_ReKi !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: YawBrMyn = 0.0_ReKi !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] + REAL(ReKi) :: YawBrMzn = 0.0_ReKi !< Tower-top / yaw bearing yaw moment [N-m] + REAL(ReKi) :: NcIMURAxs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAys = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAzs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: RotPwr = 0.0_ReKi !< Rotor power (this is equivalent to the low-speed shaft power) [W] + REAL(ReKi) :: LSShftFxa = 0.0_ReKi !< Rotating low-speed shaft force x [N] + REAL(ReKi) :: LSShftFys = 0.0_ReKi !< Nonrotating low-speed shaft force y [N] + REAL(ReKi) :: LSShftFzs = 0.0_ReKi !< Nonrotating low-speed shaft force z [N] END TYPE ED_OutputType ! ======================= CONTAINS - SUBROUTINE ED_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(ED_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%ADInputFile = SrcInitInputData%ADInputFile - DstInitInputData%CompElast = SrcInitInputData%CompElast - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%MHK = SrcInitInputData%MHK - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - END SUBROUTINE ED_CopyInitInput - - SUBROUTINE ED_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(ED_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 = 'ED_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE ED_DestroyInitInput - - SUBROUTINE ED_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(ED_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 = 'ED_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 ! Linearize - Int_BufSz = Int_BufSz + 1*LEN(InData%ADInputFile) ! ADInputFile - Int_BufSz = Int_BufSz + 1 ! CompElast - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! Gravity - Int_BufSz = Int_BufSz + 1 ! MHK - 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 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%ADInputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%ADInputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%CompElast, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_PackInitInput - - SUBROUTINE ED_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(ED_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_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%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%ADInputFile) - OutData%ADInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CompElast = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompElast) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_UnPackInitInput - - SUBROUTINE ED_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(ED_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_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 - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%NumBl = SrcInitOutputData%NumBl -IF (ALLOCATED(SrcInitOutputData%BlPitch)) THEN - i1_l = LBOUND(SrcInitOutputData%BlPitch,1) - i1_u = UBOUND(SrcInitOutputData%BlPitch,1) - IF (.NOT. ALLOCATED(DstInitOutputData%BlPitch)) THEN - ALLOCATE(DstInitOutputData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%BlPitch = SrcInitOutputData%BlPitch -ENDIF - DstInitOutputData%BladeLength = SrcInitOutputData%BladeLength - DstInitOutputData%TowerHeight = SrcInitOutputData%TowerHeight - DstInitOutputData%TowerBaseHeight = SrcInitOutputData%TowerBaseHeight - DstInitOutputData%HubHt = SrcInitOutputData%HubHt -IF (ALLOCATED(SrcInitOutputData%BldRNodes)) THEN - i1_l = LBOUND(SrcInitOutputData%BldRNodes,1) - i1_u = UBOUND(SrcInitOutputData%BldRNodes,1) - IF (.NOT. ALLOCATED(DstInitOutputData%BldRNodes)) THEN - ALLOCATE(DstInitOutputData%BldRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%BldRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%BldRNodes = SrcInitOutputData%BldRNodes -ENDIF -IF (ALLOCATED(SrcInitOutputData%TwrHNodes)) THEN - i1_l = LBOUND(SrcInitOutputData%TwrHNodes,1) - i1_u = UBOUND(SrcInitOutputData%TwrHNodes,1) - IF (.NOT. ALLOCATED(DstInitOutputData%TwrHNodes)) THEN - ALLOCATE(DstInitOutputData%TwrHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%TwrHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%TwrHNodes = SrcInitOutputData%TwrHNodes -ENDIF - DstInitOutputData%PlatformPos = SrcInitOutputData%PlatformPos - DstInitOutputData%TwrBaseRefPos = SrcInitOutputData%TwrBaseRefPos - DstInitOutputData%TwrBaseTransDisp = SrcInitOutputData%TwrBaseTransDisp - DstInitOutputData%TwrBaseRefOrient = SrcInitOutputData%TwrBaseRefOrient - DstInitOutputData%TwrBaseOrient = SrcInitOutputData%TwrBaseOrient - DstInitOutputData%HubRad = SrcInitOutputData%HubRad - DstInitOutputData%RotSpeed = SrcInitOutputData%RotSpeed - DstInitOutputData%isFixed_GenDOF = SrcInitOutputData%isFixed_GenDOF -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN - ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF - END SUBROUTINE ED_CopyInitOutput - - SUBROUTINE ED_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(ED_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 = 'ED_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%BlPitch)) THEN - DEALLOCATE(InitOutputData%BlPitch) -ENDIF -IF (ALLOCATED(InitOutputData%BldRNodes)) THEN - DEALLOCATE(InitOutputData%BldRNodes) -ENDIF -IF (ALLOCATED(InitOutputData%TwrHNodes)) THEN - DEALLOCATE(InitOutputData%TwrHNodes) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN - DEALLOCATE(InitOutputData%RotFrame_x) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF - END SUBROUTINE ED_DestroyInitOutput - - SUBROUTINE ED_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(ED_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 = 'ED_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1 ! BlPitch allocated yes/no - IF ( ALLOCATED(InData%BlPitch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitch) ! BlPitch - END IF - Re_BufSz = Re_BufSz + 1 ! BladeLength - Re_BufSz = Re_BufSz + 1 ! TowerHeight - Re_BufSz = Re_BufSz + 1 ! TowerBaseHeight - Re_BufSz = Re_BufSz + 1 ! HubHt - Int_BufSz = Int_BufSz + 1 ! BldRNodes allocated yes/no - IF ( ALLOCATED(InData%BldRNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldRNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldRNodes) ! BldRNodes - END IF - Int_BufSz = Int_BufSz + 1 ! TwrHNodes allocated yes/no - IF ( ALLOCATED(InData%TwrHNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrHNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrHNodes) ! TwrHNodes - END IF - Re_BufSz = Re_BufSz + SIZE(InData%PlatformPos) ! PlatformPos - Re_BufSz = Re_BufSz + SIZE(InData%TwrBaseRefPos) ! TwrBaseRefPos - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseTransDisp) ! TwrBaseTransDisp - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseRefOrient) ! TwrBaseRefOrient - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseOrient) ! TwrBaseOrient - Re_BufSz = Re_BufSz + 1 ! HubRad - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Int_BufSz = Int_BufSz + 1 ! isFixed_GenDOF - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - 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 - 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 - - 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%NumBl - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlPitch) ) 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%BlPitch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) - ReKiBuf(Re_Xferred) = InData%BlPitch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldRNodes) ) 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%BldRNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldRNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldRNodes,1), UBOUND(InData%BldRNodes,1) - ReKiBuf(Re_Xferred) = InData%BldRNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrHNodes) ) 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%TwrHNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrHNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrHNodes,1), UBOUND(InData%TwrHNodes,1) - ReKiBuf(Re_Xferred) = InData%TwrHNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%PlatformPos,1), UBOUND(InData%PlatformPos,1) - ReKiBuf(Re_Xferred) = InData%PlatformPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TwrBaseRefPos,1), UBOUND(InData%TwrBaseRefPos,1) - ReKiBuf(Re_Xferred) = InData%TwrBaseRefPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TwrBaseTransDisp,1), UBOUND(InData%TwrBaseTransDisp,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseTransDisp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%TwrBaseRefOrient,2), UBOUND(InData%TwrBaseRefOrient,2) - DO i1 = LBOUND(InData%TwrBaseRefOrient,1), UBOUND(InData%TwrBaseRefOrient,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseRefOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%TwrBaseOrient,2), UBOUND(InData%TwrBaseOrient,2) - DO i1 = LBOUND(InData%TwrBaseOrient,1), UBOUND(InData%TwrBaseOrient,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - ReKiBuf(Re_Xferred) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%isFixed_GenDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) 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%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) 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%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) 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%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) 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%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) 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%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) 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%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) 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%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) 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%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_PackInitOutput - - SUBROUTINE ED_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(ED_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_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%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch 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%BlPitch)) DEALLOCATE(OutData%BlPitch) - ALLOCATE(OutData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) - OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldRNodes 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%BldRNodes)) DEALLOCATE(OutData%BldRNodes) - ALLOCATE(OutData%BldRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldRNodes,1), UBOUND(OutData%BldRNodes,1) - OutData%BldRNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrHNodes 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%TwrHNodes)) DEALLOCATE(OutData%TwrHNodes) - ALLOCATE(OutData%TwrHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrHNodes,1), UBOUND(OutData%TwrHNodes,1) - OutData%TwrHNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%PlatformPos,1) - i1_u = UBOUND(OutData%PlatformPos,1) - DO i1 = LBOUND(OutData%PlatformPos,1), UBOUND(OutData%PlatformPos,1) - OutData%PlatformPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrBaseRefPos,1) - i1_u = UBOUND(OutData%TwrBaseRefPos,1) - DO i1 = LBOUND(OutData%TwrBaseRefPos,1), UBOUND(OutData%TwrBaseRefPos,1) - OutData%TwrBaseRefPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrBaseTransDisp,1) - i1_u = UBOUND(OutData%TwrBaseTransDisp,1) - DO i1 = LBOUND(OutData%TwrBaseTransDisp,1), UBOUND(OutData%TwrBaseTransDisp,1) - OutData%TwrBaseTransDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrBaseRefOrient,1) - i1_u = UBOUND(OutData%TwrBaseRefOrient,1) - i2_l = LBOUND(OutData%TwrBaseRefOrient,2) - i2_u = UBOUND(OutData%TwrBaseRefOrient,2) - DO i2 = LBOUND(OutData%TwrBaseRefOrient,2), UBOUND(OutData%TwrBaseRefOrient,2) - DO i1 = LBOUND(OutData%TwrBaseRefOrient,1), UBOUND(OutData%TwrBaseRefOrient,1) - OutData%TwrBaseRefOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%TwrBaseOrient,1) - i1_u = UBOUND(OutData%TwrBaseOrient,1) - i2_l = LBOUND(OutData%TwrBaseOrient,2) - i2_u = UBOUND(OutData%TwrBaseOrient,2) - DO i2 = LBOUND(OutData%TwrBaseOrient,2), UBOUND(OutData%TwrBaseOrient,2) - DO i1 = LBOUND(OutData%TwrBaseOrient,1), UBOUND(OutData%TwrBaseOrient,1) - OutData%TwrBaseOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%HubRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%isFixed_GenDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%isFixed_GenDOF) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y 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%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(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 ! LinNames_x 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%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(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 ! LinNames_u 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%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(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 ! RotFrame_y 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%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x 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%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x 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%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u 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%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u 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%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_UnPackInitOutput - - SUBROUTINE ED_CopyBladeInputData( SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladeInputData), INTENT(IN) :: SrcBladeInputDataData - TYPE(BladeInputData), INTENT(INOUT) :: DstBladeInputDataData - 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 = 'ED_CopyBladeInputData' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBladeInputDataData%NBlInpSt = SrcBladeInputDataData%NBlInpSt -IF (ALLOCATED(SrcBladeInputDataData%BlFract)) THEN - i1_l = LBOUND(SrcBladeInputDataData%BlFract,1) - i1_u = UBOUND(SrcBladeInputDataData%BlFract,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%BlFract)) THEN - ALLOCATE(DstBladeInputDataData%BlFract(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BlFract.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%BlFract = SrcBladeInputDataData%BlFract -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%PitchAx)) THEN - i1_l = LBOUND(SrcBladeInputDataData%PitchAx,1) - i1_u = UBOUND(SrcBladeInputDataData%PitchAx,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%PitchAx)) THEN - ALLOCATE(DstBladeInputDataData%PitchAx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%PitchAx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%PitchAx = SrcBladeInputDataData%PitchAx -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%StrcTwst)) THEN - i1_l = LBOUND(SrcBladeInputDataData%StrcTwst,1) - i1_u = UBOUND(SrcBladeInputDataData%StrcTwst,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%StrcTwst)) THEN - ALLOCATE(DstBladeInputDataData%StrcTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%StrcTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%StrcTwst = SrcBladeInputDataData%StrcTwst -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%BMassDen)) THEN - i1_l = LBOUND(SrcBladeInputDataData%BMassDen,1) - i1_u = UBOUND(SrcBladeInputDataData%BMassDen,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%BMassDen)) THEN - ALLOCATE(DstBladeInputDataData%BMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%BMassDen = SrcBladeInputDataData%BMassDen -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%FlpStff)) THEN - i1_l = LBOUND(SrcBladeInputDataData%FlpStff,1) - i1_u = UBOUND(SrcBladeInputDataData%FlpStff,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%FlpStff)) THEN - ALLOCATE(DstBladeInputDataData%FlpStff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%FlpStff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%FlpStff = SrcBladeInputDataData%FlpStff -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%EdgStff)) THEN - i1_l = LBOUND(SrcBladeInputDataData%EdgStff,1) - i1_u = UBOUND(SrcBladeInputDataData%EdgStff,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%EdgStff)) THEN - ALLOCATE(DstBladeInputDataData%EdgStff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%EdgStff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%EdgStff = SrcBladeInputDataData%EdgStff -ENDIF - DstBladeInputDataData%BldFlDmp = SrcBladeInputDataData%BldFlDmp - DstBladeInputDataData%BldEdDmp = SrcBladeInputDataData%BldEdDmp - DstBladeInputDataData%FlStTunr = SrcBladeInputDataData%FlStTunr -IF (ALLOCATED(SrcBladeInputDataData%BldFl1Sh)) THEN - i1_l = LBOUND(SrcBladeInputDataData%BldFl1Sh,1) - i1_u = UBOUND(SrcBladeInputDataData%BldFl1Sh,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%BldFl1Sh)) THEN - ALLOCATE(DstBladeInputDataData%BldFl1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%BldFl1Sh = SrcBladeInputDataData%BldFl1Sh -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%BldFl2Sh)) THEN - i1_l = LBOUND(SrcBladeInputDataData%BldFl2Sh,1) - i1_u = UBOUND(SrcBladeInputDataData%BldFl2Sh,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%BldFl2Sh)) THEN - ALLOCATE(DstBladeInputDataData%BldFl2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%BldFl2Sh = SrcBladeInputDataData%BldFl2Sh -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%BldEdgSh)) THEN - i1_l = LBOUND(SrcBladeInputDataData%BldEdgSh,1) - i1_u = UBOUND(SrcBladeInputDataData%BldEdgSh,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%BldEdgSh)) THEN - ALLOCATE(DstBladeInputDataData%BldEdgSh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%BldEdgSh = SrcBladeInputDataData%BldEdgSh -ENDIF - END SUBROUTINE ED_CopyBladeInputData - - SUBROUTINE ED_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg ) - TYPE(BladeInputData), INTENT(INOUT) :: BladeInputDataData - 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 = 'ED_DestroyBladeInputData' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladeInputDataData%BlFract)) THEN - DEALLOCATE(BladeInputDataData%BlFract) -ENDIF -IF (ALLOCATED(BladeInputDataData%PitchAx)) THEN - DEALLOCATE(BladeInputDataData%PitchAx) -ENDIF -IF (ALLOCATED(BladeInputDataData%StrcTwst)) THEN - DEALLOCATE(BladeInputDataData%StrcTwst) -ENDIF -IF (ALLOCATED(BladeInputDataData%BMassDen)) THEN - DEALLOCATE(BladeInputDataData%BMassDen) -ENDIF -IF (ALLOCATED(BladeInputDataData%FlpStff)) THEN - DEALLOCATE(BladeInputDataData%FlpStff) -ENDIF -IF (ALLOCATED(BladeInputDataData%EdgStff)) THEN - DEALLOCATE(BladeInputDataData%EdgStff) -ENDIF -IF (ALLOCATED(BladeInputDataData%BldFl1Sh)) THEN - DEALLOCATE(BladeInputDataData%BldFl1Sh) -ENDIF -IF (ALLOCATED(BladeInputDataData%BldFl2Sh)) THEN - DEALLOCATE(BladeInputDataData%BldFl2Sh) -ENDIF -IF (ALLOCATED(BladeInputDataData%BldEdgSh)) THEN - DEALLOCATE(BladeInputDataData%BldEdgSh) -ENDIF - END SUBROUTINE ED_DestroyBladeInputData - - SUBROUTINE ED_PackBladeInputData( 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(BladeInputData), 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 = 'ED_PackBladeInputData' - ! 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 ! NBlInpSt - Int_BufSz = Int_BufSz + 1 ! BlFract allocated yes/no - IF ( ALLOCATED(InData%BlFract) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlFract upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlFract) ! BlFract - END IF - Int_BufSz = Int_BufSz + 1 ! PitchAx allocated yes/no - IF ( ALLOCATED(InData%PitchAx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PitchAx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PitchAx) ! PitchAx - END IF - Int_BufSz = Int_BufSz + 1 ! StrcTwst allocated yes/no - IF ( ALLOCATED(InData%StrcTwst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StrcTwst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StrcTwst) ! StrcTwst - END IF - Int_BufSz = Int_BufSz + 1 ! BMassDen allocated yes/no - IF ( ALLOCATED(InData%BMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BMassDen) ! BMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! FlpStff allocated yes/no - IF ( ALLOCATED(InData%FlpStff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FlpStff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FlpStff) ! FlpStff - END IF - Int_BufSz = Int_BufSz + 1 ! EdgStff allocated yes/no - IF ( ALLOCATED(InData%EdgStff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! EdgStff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%EdgStff) ! EdgStff - END IF - Re_BufSz = Re_BufSz + SIZE(InData%BldFlDmp) ! BldFlDmp - Re_BufSz = Re_BufSz + SIZE(InData%BldEdDmp) ! BldEdDmp - Re_BufSz = Re_BufSz + SIZE(InData%FlStTunr) ! FlStTunr - Int_BufSz = Int_BufSz + 1 ! BldFl1Sh allocated yes/no - IF ( ALLOCATED(InData%BldFl1Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldFl1Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldFl1Sh) ! BldFl1Sh - END IF - Int_BufSz = Int_BufSz + 1 ! BldFl2Sh allocated yes/no - IF ( ALLOCATED(InData%BldFl2Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldFl2Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldFl2Sh) ! BldFl2Sh - END IF - Int_BufSz = Int_BufSz + 1 ! BldEdgSh allocated yes/no - IF ( ALLOCATED(InData%BldEdgSh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldEdgSh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldEdgSh) ! BldEdgSh - 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 - - IntKiBuf(Int_Xferred) = InData%NBlInpSt - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlFract) ) 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%BlFract,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFract,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlFract,1), UBOUND(InData%BlFract,1) - ReKiBuf(Re_Xferred) = InData%BlFract(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PitchAx) ) 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%PitchAx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PitchAx,1), UBOUND(InData%PitchAx,1) - ReKiBuf(Re_Xferred) = InData%PitchAx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StrcTwst) ) 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%StrcTwst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StrcTwst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StrcTwst,1), UBOUND(InData%StrcTwst,1) - ReKiBuf(Re_Xferred) = InData%StrcTwst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BMassDen) ) 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%BMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BMassDen,1), UBOUND(InData%BMassDen,1) - ReKiBuf(Re_Xferred) = InData%BMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FlpStff) ) 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%FlpStff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FlpStff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FlpStff,1), UBOUND(InData%FlpStff,1) - ReKiBuf(Re_Xferred) = InData%FlpStff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%EdgStff) ) 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%EdgStff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgStff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%EdgStff,1), UBOUND(InData%EdgStff,1) - ReKiBuf(Re_Xferred) = InData%EdgStff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%BldFlDmp,1), UBOUND(InData%BldFlDmp,1) - ReKiBuf(Re_Xferred) = InData%BldFlDmp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%BldEdDmp,1), UBOUND(InData%BldEdDmp,1) - ReKiBuf(Re_Xferred) = InData%BldEdDmp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FlStTunr,1), UBOUND(InData%FlStTunr,1) - ReKiBuf(Re_Xferred) = InData%FlStTunr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%BldFl1Sh) ) 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%BldFl1Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl1Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldFl1Sh,1), UBOUND(InData%BldFl1Sh,1) - ReKiBuf(Re_Xferred) = InData%BldFl1Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldFl2Sh) ) 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%BldFl2Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl2Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldFl2Sh,1), UBOUND(InData%BldFl2Sh,1) - ReKiBuf(Re_Xferred) = InData%BldFl2Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldEdgSh) ) 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%BldEdgSh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEdgSh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldEdgSh,1), UBOUND(InData%BldEdgSh,1) - ReKiBuf(Re_Xferred) = InData%BldEdgSh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_PackBladeInputData - - SUBROUTINE ED_UnPackBladeInputData( 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(BladeInputData), 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 = 'ED_UnPackBladeInputData' - ! 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%NBlInpSt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlFract 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%BlFract)) DEALLOCATE(OutData%BlFract) - ALLOCATE(OutData%BlFract(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlFract.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlFract,1), UBOUND(OutData%BlFract,1) - OutData%BlFract(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAx 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%PitchAx)) DEALLOCATE(OutData%PitchAx) - ALLOCATE(OutData%PitchAx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PitchAx,1), UBOUND(OutData%PitchAx,1) - OutData%PitchAx(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StrcTwst 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%StrcTwst)) DEALLOCATE(OutData%StrcTwst) - ALLOCATE(OutData%StrcTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrcTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StrcTwst,1), UBOUND(OutData%StrcTwst,1) - OutData%StrcTwst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BMassDen 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%BMassDen)) DEALLOCATE(OutData%BMassDen) - ALLOCATE(OutData%BMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BMassDen,1), UBOUND(OutData%BMassDen,1) - OutData%BMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlpStff 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%FlpStff)) DEALLOCATE(OutData%FlpStff) - ALLOCATE(OutData%FlpStff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpStff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FlpStff,1), UBOUND(OutData%FlpStff,1) - OutData%FlpStff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgStff 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%EdgStff)) DEALLOCATE(OutData%EdgStff) - ALLOCATE(OutData%EdgStff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgStff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%EdgStff,1), UBOUND(OutData%EdgStff,1) - OutData%EdgStff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%BldFlDmp,1) - i1_u = UBOUND(OutData%BldFlDmp,1) - DO i1 = LBOUND(OutData%BldFlDmp,1), UBOUND(OutData%BldFlDmp,1) - OutData%BldFlDmp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%BldEdDmp,1) - i1_u = UBOUND(OutData%BldEdDmp,1) - DO i1 = LBOUND(OutData%BldEdDmp,1), UBOUND(OutData%BldEdDmp,1) - OutData%BldEdDmp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FlStTunr,1) - i1_u = UBOUND(OutData%FlStTunr,1) - DO i1 = LBOUND(OutData%FlStTunr,1), UBOUND(OutData%FlStTunr,1) - OutData%FlStTunr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl1Sh 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%BldFl1Sh)) DEALLOCATE(OutData%BldFl1Sh) - ALLOCATE(OutData%BldFl1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldFl1Sh,1), UBOUND(OutData%BldFl1Sh,1) - OutData%BldFl1Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl2Sh 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%BldFl2Sh)) DEALLOCATE(OutData%BldFl2Sh) - ALLOCATE(OutData%BldFl2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldFl2Sh,1), UBOUND(OutData%BldFl2Sh,1) - OutData%BldFl2Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEdgSh 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%BldEdgSh)) DEALLOCATE(OutData%BldEdgSh) - ALLOCATE(OutData%BldEdgSh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldEdgSh,1), UBOUND(OutData%BldEdgSh,1) - OutData%BldEdgSh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_UnPackBladeInputData - - SUBROUTINE ED_CopyBladeMeshInputData( SrcBladeMeshInputDataData, DstBladeMeshInputDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_BladeMeshInputData), INTENT(IN) :: SrcBladeMeshInputDataData - TYPE(ED_BladeMeshInputData), INTENT(INOUT) :: DstBladeMeshInputDataData - 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 = 'ED_CopyBladeMeshInputData' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBladeMeshInputDataData%BldNodes = SrcBladeMeshInputDataData%BldNodes -IF (ALLOCATED(SrcBladeMeshInputDataData%RNodes)) THEN - i1_l = LBOUND(SrcBladeMeshInputDataData%RNodes,1) - i1_u = UBOUND(SrcBladeMeshInputDataData%RNodes,1) - IF (.NOT. ALLOCATED(DstBladeMeshInputDataData%RNodes)) THEN - ALLOCATE(DstBladeMeshInputDataData%RNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%RNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeMeshInputDataData%RNodes = SrcBladeMeshInputDataData%RNodes -ENDIF -IF (ALLOCATED(SrcBladeMeshInputDataData%AeroTwst)) THEN - i1_l = LBOUND(SrcBladeMeshInputDataData%AeroTwst,1) - i1_u = UBOUND(SrcBladeMeshInputDataData%AeroTwst,1) - IF (.NOT. ALLOCATED(DstBladeMeshInputDataData%AeroTwst)) THEN - ALLOCATE(DstBladeMeshInputDataData%AeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%AeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeMeshInputDataData%AeroTwst = SrcBladeMeshInputDataData%AeroTwst -ENDIF -IF (ALLOCATED(SrcBladeMeshInputDataData%Chord)) THEN - i1_l = LBOUND(SrcBladeMeshInputDataData%Chord,1) - i1_u = UBOUND(SrcBladeMeshInputDataData%Chord,1) - IF (.NOT. ALLOCATED(DstBladeMeshInputDataData%Chord)) THEN - ALLOCATE(DstBladeMeshInputDataData%Chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%Chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeMeshInputDataData%Chord = SrcBladeMeshInputDataData%Chord -ENDIF - END SUBROUTINE ED_CopyBladeMeshInputData - - SUBROUTINE ED_DestroyBladeMeshInputData( BladeMeshInputDataData, ErrStat, ErrMsg ) - TYPE(ED_BladeMeshInputData), INTENT(INOUT) :: BladeMeshInputDataData - 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 = 'ED_DestroyBladeMeshInputData' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladeMeshInputDataData%RNodes)) THEN - DEALLOCATE(BladeMeshInputDataData%RNodes) -ENDIF -IF (ALLOCATED(BladeMeshInputDataData%AeroTwst)) THEN - DEALLOCATE(BladeMeshInputDataData%AeroTwst) -ENDIF -IF (ALLOCATED(BladeMeshInputDataData%Chord)) THEN - DEALLOCATE(BladeMeshInputDataData%Chord) -ENDIF - END SUBROUTINE ED_DestroyBladeMeshInputData - - SUBROUTINE ED_PackBladeMeshInputData( 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(ED_BladeMeshInputData), 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 = 'ED_PackBladeMeshInputData' - ! 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 ! BldNodes - Int_BufSz = Int_BufSz + 1 ! RNodes allocated yes/no - IF ( ALLOCATED(InData%RNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RNodes) ! RNodes - END IF - Int_BufSz = Int_BufSz + 1 ! AeroTwst allocated yes/no - IF ( ALLOCATED(InData%AeroTwst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AeroTwst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AeroTwst) ! AeroTwst - END IF - Int_BufSz = Int_BufSz + 1 ! Chord allocated yes/no - IF ( ALLOCATED(InData%Chord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Chord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Chord) ! Chord - 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 - - IntKiBuf(Int_Xferred) = InData%BldNodes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%RNodes) ) 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%RNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RNodes,1), UBOUND(InData%RNodes,1) - ReKiBuf(Re_Xferred) = InData%RNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AeroTwst) ) 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%AeroTwst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroTwst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AeroTwst,1), UBOUND(InData%AeroTwst,1) - ReKiBuf(Re_Xferred) = InData%AeroTwst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Chord) ) 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%Chord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Chord,1), UBOUND(InData%Chord,1) - ReKiBuf(Re_Xferred) = InData%Chord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_PackBladeMeshInputData - - SUBROUTINE ED_UnPackBladeMeshInputData( 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(ED_BladeMeshInputData), 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 = 'ED_UnPackBladeMeshInputData' - ! 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%BldNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodes 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%RNodes)) DEALLOCATE(OutData%RNodes) - ALLOCATE(OutData%RNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RNodes,1), UBOUND(OutData%RNodes,1) - OutData%RNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroTwst 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%AeroTwst)) DEALLOCATE(OutData%AeroTwst) - ALLOCATE(OutData%AeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AeroTwst,1), UBOUND(OutData%AeroTwst,1) - OutData%AeroTwst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Chord 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%Chord)) DEALLOCATE(OutData%Chord) - ALLOCATE(OutData%Chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Chord,1), UBOUND(OutData%Chord,1) - OutData%Chord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_UnPackBladeMeshInputData - - SUBROUTINE ED_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(ED_InputFile), INTENT(INOUT) :: DstInputFileData - 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 = 'ED_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DT = SrcInputFileData%DT - DstInputFileData%FlapDOF1 = SrcInputFileData%FlapDOF1 - DstInputFileData%FlapDOF2 = SrcInputFileData%FlapDOF2 - DstInputFileData%EdgeDOF = SrcInputFileData%EdgeDOF - DstInputFileData%TeetDOF = SrcInputFileData%TeetDOF - DstInputFileData%DrTrDOF = SrcInputFileData%DrTrDOF - DstInputFileData%GenDOF = SrcInputFileData%GenDOF - DstInputFileData%YawDOF = SrcInputFileData%YawDOF - DstInputFileData%TwFADOF1 = SrcInputFileData%TwFADOF1 - DstInputFileData%TwFADOF2 = SrcInputFileData%TwFADOF2 - DstInputFileData%TwSSDOF1 = SrcInputFileData%TwSSDOF1 - DstInputFileData%TwSSDOF2 = SrcInputFileData%TwSSDOF2 - DstInputFileData%PtfmSgDOF = SrcInputFileData%PtfmSgDOF - DstInputFileData%PtfmSwDOF = SrcInputFileData%PtfmSwDOF - DstInputFileData%PtfmHvDOF = SrcInputFileData%PtfmHvDOF - DstInputFileData%PtfmRDOF = SrcInputFileData%PtfmRDOF - DstInputFileData%PtfmPDOF = SrcInputFileData%PtfmPDOF - DstInputFileData%PtfmYDOF = SrcInputFileData%PtfmYDOF - DstInputFileData%OoPDefl = SrcInputFileData%OoPDefl - DstInputFileData%IPDefl = SrcInputFileData%IPDefl -IF (ALLOCATED(SrcInputFileData%BlPitch)) THEN - i1_l = LBOUND(SrcInputFileData%BlPitch,1) - i1_u = UBOUND(SrcInputFileData%BlPitch,1) - IF (.NOT. ALLOCATED(DstInputFileData%BlPitch)) THEN - ALLOCATE(DstInputFileData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BlPitch = SrcInputFileData%BlPitch -ENDIF - DstInputFileData%TeetDefl = SrcInputFileData%TeetDefl - DstInputFileData%Azimuth = SrcInputFileData%Azimuth - DstInputFileData%RotSpeed = SrcInputFileData%RotSpeed - DstInputFileData%NacYaw = SrcInputFileData%NacYaw - DstInputFileData%TTDspFA = SrcInputFileData%TTDspFA - DstInputFileData%TTDspSS = SrcInputFileData%TTDspSS - DstInputFileData%PtfmSurge = SrcInputFileData%PtfmSurge - DstInputFileData%PtfmSway = SrcInputFileData%PtfmSway - DstInputFileData%PtfmHeave = SrcInputFileData%PtfmHeave - DstInputFileData%PtfmRoll = SrcInputFileData%PtfmRoll - DstInputFileData%PtfmPitch = SrcInputFileData%PtfmPitch - DstInputFileData%PtfmYaw = SrcInputFileData%PtfmYaw - DstInputFileData%NumBl = SrcInputFileData%NumBl - DstInputFileData%TipRad = SrcInputFileData%TipRad - DstInputFileData%HubRad = SrcInputFileData%HubRad -IF (ALLOCATED(SrcInputFileData%PreCone)) THEN - i1_l = LBOUND(SrcInputFileData%PreCone,1) - i1_u = UBOUND(SrcInputFileData%PreCone,1) - IF (.NOT. ALLOCATED(DstInputFileData%PreCone)) THEN - ALLOCATE(DstInputFileData%PreCone(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PreCone.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PreCone = SrcInputFileData%PreCone -ENDIF - DstInputFileData%HubCM = SrcInputFileData%HubCM - DstInputFileData%UndSling = SrcInputFileData%UndSling - DstInputFileData%Delta3 = SrcInputFileData%Delta3 - DstInputFileData%AzimB1Up = SrcInputFileData%AzimB1Up - DstInputFileData%OverHang = SrcInputFileData%OverHang - DstInputFileData%ShftGagL = SrcInputFileData%ShftGagL - DstInputFileData%ShftTilt = SrcInputFileData%ShftTilt - DstInputFileData%NacCMxn = SrcInputFileData%NacCMxn - DstInputFileData%NacCMyn = SrcInputFileData%NacCMyn - DstInputFileData%NacCMzn = SrcInputFileData%NacCMzn - DstInputFileData%NcIMUxn = SrcInputFileData%NcIMUxn - DstInputFileData%NcIMUyn = SrcInputFileData%NcIMUyn - DstInputFileData%NcIMUzn = SrcInputFileData%NcIMUzn - DstInputFileData%Twr2Shft = SrcInputFileData%Twr2Shft - DstInputFileData%TowerHt = SrcInputFileData%TowerHt - DstInputFileData%TowerBsHt = SrcInputFileData%TowerBsHt - DstInputFileData%PtfmCMxt = SrcInputFileData%PtfmCMxt - DstInputFileData%PtfmCMyt = SrcInputFileData%PtfmCMyt - DstInputFileData%PtfmCMzt = SrcInputFileData%PtfmCMzt - DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt -IF (ALLOCATED(SrcInputFileData%TipMass)) THEN - i1_l = LBOUND(SrcInputFileData%TipMass,1) - i1_u = UBOUND(SrcInputFileData%TipMass,1) - IF (.NOT. ALLOCATED(DstInputFileData%TipMass)) THEN - ALLOCATE(DstInputFileData%TipMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TipMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TipMass = SrcInputFileData%TipMass -ENDIF - DstInputFileData%HubMass = SrcInputFileData%HubMass - DstInputFileData%HubIner = SrcInputFileData%HubIner - DstInputFileData%GenIner = SrcInputFileData%GenIner - DstInputFileData%NacMass = SrcInputFileData%NacMass - DstInputFileData%NacYIner = SrcInputFileData%NacYIner - DstInputFileData%YawBrMass = SrcInputFileData%YawBrMass - DstInputFileData%PtfmMass = SrcInputFileData%PtfmMass - DstInputFileData%PtfmRIner = SrcInputFileData%PtfmRIner - DstInputFileData%PtfmPIner = SrcInputFileData%PtfmPIner - DstInputFileData%PtfmYIner = SrcInputFileData%PtfmYIner - DstInputFileData%BldNodes = SrcInputFileData%BldNodes -IF (ALLOCATED(SrcInputFileData%InpBlMesh)) THEN - i1_l = LBOUND(SrcInputFileData%InpBlMesh,1) - i1_u = UBOUND(SrcInputFileData%InpBlMesh,1) - IF (.NOT. ALLOCATED(DstInputFileData%InpBlMesh)) THEN - ALLOCATE(DstInputFileData%InpBlMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InpBlMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputFileData%InpBlMesh,1), UBOUND(SrcInputFileData%InpBlMesh,1) - CALL ED_Copyblademeshinputdata( SrcInputFileData%InpBlMesh(i1), DstInputFileData%InpBlMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputFileData%InpBl)) THEN - i1_l = LBOUND(SrcInputFileData%InpBl,1) - i1_u = UBOUND(SrcInputFileData%InpBl,1) - IF (.NOT. ALLOCATED(DstInputFileData%InpBl)) THEN - ALLOCATE(DstInputFileData%InpBl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InpBl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputFileData%InpBl,1), UBOUND(SrcInputFileData%InpBl,1) - CALL ED_Copybladeinputdata( SrcInputFileData%InpBl(i1), DstInputFileData%InpBl(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInputFileData%TeetMod = SrcInputFileData%TeetMod - DstInputFileData%TeetDmpP = SrcInputFileData%TeetDmpP - DstInputFileData%TeetDmp = SrcInputFileData%TeetDmp - DstInputFileData%TeetCDmp = SrcInputFileData%TeetCDmp - DstInputFileData%TeetSStP = SrcInputFileData%TeetSStP - DstInputFileData%TeetHStP = SrcInputFileData%TeetHStP - DstInputFileData%TeetSSSp = SrcInputFileData%TeetSSSp - DstInputFileData%TeetHSSp = SrcInputFileData%TeetHSSp - DstInputFileData%GBoxEff = SrcInputFileData%GBoxEff - DstInputFileData%GBRatio = SrcInputFileData%GBRatio - DstInputFileData%DTTorSpr = SrcInputFileData%DTTorSpr - DstInputFileData%DTTorDmp = SrcInputFileData%DTTorDmp - DstInputFileData%Furling = SrcInputFileData%Furling - DstInputFileData%TwrNodes = SrcInputFileData%TwrNodes - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%OutFile = SrcInputFileData%OutFile - DstInputFileData%TabDelim = SrcInputFileData%TabDelim - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%Tstart = SrcInputFileData%Tstart - DstInputFileData%DecFact = SrcInputFileData%DecFact - DstInputFileData%NTwGages = SrcInputFileData%NTwGages - DstInputFileData%TwrGagNd = SrcInputFileData%TwrGagNd - DstInputFileData%NBlGages = SrcInputFileData%NBlGages - DstInputFileData%BldGagNd = SrcInputFileData%BldGagNd - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%NTwInpSt = SrcInputFileData%NTwInpSt - DstInputFileData%TwrFADmp = SrcInputFileData%TwrFADmp - DstInputFileData%TwrSSDmp = SrcInputFileData%TwrSSDmp - DstInputFileData%FAStTunr = SrcInputFileData%FAStTunr - DstInputFileData%SSStTunr = SrcInputFileData%SSStTunr -IF (ALLOCATED(SrcInputFileData%HtFract)) THEN - i1_l = LBOUND(SrcInputFileData%HtFract,1) - i1_u = UBOUND(SrcInputFileData%HtFract,1) - IF (.NOT. ALLOCATED(DstInputFileData%HtFract)) THEN - ALLOCATE(DstInputFileData%HtFract(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%HtFract.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%HtFract = SrcInputFileData%HtFract -ENDIF -IF (ALLOCATED(SrcInputFileData%TMassDen)) THEN - i1_l = LBOUND(SrcInputFileData%TMassDen,1) - i1_u = UBOUND(SrcInputFileData%TMassDen,1) - IF (.NOT. ALLOCATED(DstInputFileData%TMassDen)) THEN - ALLOCATE(DstInputFileData%TMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TMassDen = SrcInputFileData%TMassDen -ENDIF -IF (ALLOCATED(SrcInputFileData%TwFAStif)) THEN - i1_l = LBOUND(SrcInputFileData%TwFAStif,1) - i1_u = UBOUND(SrcInputFileData%TwFAStif,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwFAStif)) THEN - ALLOCATE(DstInputFileData%TwFAStif(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAStif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwFAStif = SrcInputFileData%TwFAStif -ENDIF -IF (ALLOCATED(SrcInputFileData%TwSSStif)) THEN - i1_l = LBOUND(SrcInputFileData%TwSSStif,1) - i1_u = UBOUND(SrcInputFileData%TwSSStif,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwSSStif)) THEN - ALLOCATE(DstInputFileData%TwSSStif(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSStif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwSSStif = SrcInputFileData%TwSSStif -ENDIF -IF (ALLOCATED(SrcInputFileData%TwFAM1Sh)) THEN - i1_l = LBOUND(SrcInputFileData%TwFAM1Sh,1) - i1_u = UBOUND(SrcInputFileData%TwFAM1Sh,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwFAM1Sh)) THEN - ALLOCATE(DstInputFileData%TwFAM1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAM1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwFAM1Sh = SrcInputFileData%TwFAM1Sh -ENDIF -IF (ALLOCATED(SrcInputFileData%TwFAM2Sh)) THEN - i1_l = LBOUND(SrcInputFileData%TwFAM2Sh,1) - i1_u = UBOUND(SrcInputFileData%TwFAM2Sh,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwFAM2Sh)) THEN - ALLOCATE(DstInputFileData%TwFAM2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAM2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwFAM2Sh = SrcInputFileData%TwFAM2Sh -ENDIF -IF (ALLOCATED(SrcInputFileData%TwSSM1Sh)) THEN - i1_l = LBOUND(SrcInputFileData%TwSSM1Sh,1) - i1_u = UBOUND(SrcInputFileData%TwSSM1Sh,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwSSM1Sh)) THEN - ALLOCATE(DstInputFileData%TwSSM1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSM1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwSSM1Sh = SrcInputFileData%TwSSM1Sh -ENDIF -IF (ALLOCATED(SrcInputFileData%TwSSM2Sh)) THEN - i1_l = LBOUND(SrcInputFileData%TwSSM2Sh,1) - i1_u = UBOUND(SrcInputFileData%TwSSM2Sh,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwSSM2Sh)) THEN - ALLOCATE(DstInputFileData%TwSSM2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSM2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwSSM2Sh = SrcInputFileData%TwSSM2Sh -ENDIF - DstInputFileData%RFrlDOF = SrcInputFileData%RFrlDOF - DstInputFileData%TFrlDOF = SrcInputFileData%TFrlDOF - DstInputFileData%RotFurl = SrcInputFileData%RotFurl - DstInputFileData%TailFurl = SrcInputFileData%TailFurl - DstInputFileData%Yaw2Shft = SrcInputFileData%Yaw2Shft - DstInputFileData%ShftSkew = SrcInputFileData%ShftSkew - DstInputFileData%RFrlCM_n = SrcInputFileData%RFrlCM_n - DstInputFileData%BoomCM_n = SrcInputFileData%BoomCM_n - DstInputFileData%TFinCM_n = SrcInputFileData%TFinCM_n - DstInputFileData%RFrlPnt_n = SrcInputFileData%RFrlPnt_n - DstInputFileData%RFrlSkew = SrcInputFileData%RFrlSkew - DstInputFileData%RFrlTilt = SrcInputFileData%RFrlTilt - DstInputFileData%TFrlPnt_n = SrcInputFileData%TFrlPnt_n - DstInputFileData%TFrlSkew = SrcInputFileData%TFrlSkew - DstInputFileData%TFrlTilt = SrcInputFileData%TFrlTilt - DstInputFileData%RFrlMass = SrcInputFileData%RFrlMass - DstInputFileData%BoomMass = SrcInputFileData%BoomMass - DstInputFileData%TFinMass = SrcInputFileData%TFinMass - DstInputFileData%RFrlIner = SrcInputFileData%RFrlIner - DstInputFileData%TFrlIner = SrcInputFileData%TFrlIner - DstInputFileData%RFrlMod = SrcInputFileData%RFrlMod - DstInputFileData%RFrlSpr = SrcInputFileData%RFrlSpr - DstInputFileData%RFrlDmp = SrcInputFileData%RFrlDmp - DstInputFileData%RFrlUSSP = SrcInputFileData%RFrlUSSP - DstInputFileData%RFrlDSSP = SrcInputFileData%RFrlDSSP - DstInputFileData%RFrlUSSpr = SrcInputFileData%RFrlUSSpr - DstInputFileData%RFrlDSSpr = SrcInputFileData%RFrlDSSpr - DstInputFileData%RFrlUSDP = SrcInputFileData%RFrlUSDP - DstInputFileData%RFrlDSDP = SrcInputFileData%RFrlDSDP - DstInputFileData%RFrlUSDmp = SrcInputFileData%RFrlUSDmp - DstInputFileData%RFrlDSDmp = SrcInputFileData%RFrlDSDmp - DstInputFileData%TFrlMod = SrcInputFileData%TFrlMod - DstInputFileData%TFrlSpr = SrcInputFileData%TFrlSpr - DstInputFileData%TFrlDmp = SrcInputFileData%TFrlDmp - DstInputFileData%TFrlUSSP = SrcInputFileData%TFrlUSSP - DstInputFileData%TFrlDSSP = SrcInputFileData%TFrlDSSP - DstInputFileData%TFrlUSSpr = SrcInputFileData%TFrlUSSpr - DstInputFileData%TFrlDSSpr = SrcInputFileData%TFrlDSSpr - DstInputFileData%TFrlUSDP = SrcInputFileData%TFrlUSDP - DstInputFileData%TFrlDSDP = SrcInputFileData%TFrlDSDP - DstInputFileData%TFrlUSDmp = SrcInputFileData%TFrlUSDmp - DstInputFileData%TFrlDSDmp = SrcInputFileData%TFrlDSDmp - DstInputFileData%method = SrcInputFileData%method - DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts -IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN - i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) - i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN - ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList -ENDIF - DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str - DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut - END SUBROUTINE ED_CopyInputFile - - SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(ED_InputFile), INTENT(INOUT) :: InputFileData - 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 = 'ED_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%BlPitch)) THEN - DEALLOCATE(InputFileData%BlPitch) -ENDIF -IF (ALLOCATED(InputFileData%PreCone)) THEN - DEALLOCATE(InputFileData%PreCone) -ENDIF -IF (ALLOCATED(InputFileData%TipMass)) THEN - DEALLOCATE(InputFileData%TipMass) -ENDIF -IF (ALLOCATED(InputFileData%InpBlMesh)) THEN -DO i1 = LBOUND(InputFileData%InpBlMesh,1), UBOUND(InputFileData%InpBlMesh,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputFileData%InpBl) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF -IF (ALLOCATED(InputFileData%HtFract)) THEN - DEALLOCATE(InputFileData%HtFract) -ENDIF -IF (ALLOCATED(InputFileData%TMassDen)) THEN - DEALLOCATE(InputFileData%TMassDen) -ENDIF -IF (ALLOCATED(InputFileData%TwFAStif)) THEN - DEALLOCATE(InputFileData%TwFAStif) -ENDIF -IF (ALLOCATED(InputFileData%TwSSStif)) THEN - DEALLOCATE(InputFileData%TwSSStif) -ENDIF -IF (ALLOCATED(InputFileData%TwFAM1Sh)) THEN - DEALLOCATE(InputFileData%TwFAM1Sh) -ENDIF -IF (ALLOCATED(InputFileData%TwFAM2Sh)) THEN - DEALLOCATE(InputFileData%TwFAM2Sh) -ENDIF -IF (ALLOCATED(InputFileData%TwSSM1Sh)) THEN - DEALLOCATE(InputFileData%TwSSM1Sh) -ENDIF -IF (ALLOCATED(InputFileData%TwSSM2Sh)) THEN - DEALLOCATE(InputFileData%TwSSM2Sh) -ENDIF -IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN - DEALLOCATE(InputFileData%BldNd_OutList) -ENDIF - END SUBROUTINE ED_DestroyInputFile - - SUBROUTINE ED_PackInputFile( 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(ED_InputFile), 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 = 'ED_PackInputFile' - ! 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 ! FlapDOF1 - Int_BufSz = Int_BufSz + 1 ! FlapDOF2 - Int_BufSz = Int_BufSz + 1 ! EdgeDOF - Int_BufSz = Int_BufSz + 1 ! TeetDOF - Int_BufSz = Int_BufSz + 1 ! DrTrDOF - Int_BufSz = Int_BufSz + 1 ! GenDOF - Int_BufSz = Int_BufSz + 1 ! YawDOF - Int_BufSz = Int_BufSz + 1 ! TwFADOF1 - Int_BufSz = Int_BufSz + 1 ! TwFADOF2 - Int_BufSz = Int_BufSz + 1 ! TwSSDOF1 - Int_BufSz = Int_BufSz + 1 ! TwSSDOF2 - Int_BufSz = Int_BufSz + 1 ! PtfmSgDOF - Int_BufSz = Int_BufSz + 1 ! PtfmSwDOF - Int_BufSz = Int_BufSz + 1 ! PtfmHvDOF - Int_BufSz = Int_BufSz + 1 ! PtfmRDOF - Int_BufSz = Int_BufSz + 1 ! PtfmPDOF - Int_BufSz = Int_BufSz + 1 ! PtfmYDOF - Re_BufSz = Re_BufSz + 1 ! OoPDefl - Re_BufSz = Re_BufSz + 1 ! IPDefl - Int_BufSz = Int_BufSz + 1 ! BlPitch allocated yes/no - IF ( ALLOCATED(InData%BlPitch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitch) ! BlPitch - END IF - Re_BufSz = Re_BufSz + 1 ! TeetDefl - Db_BufSz = Db_BufSz + 1 ! Azimuth - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! NacYaw - Re_BufSz = Re_BufSz + 1 ! TTDspFA - Re_BufSz = Re_BufSz + 1 ! TTDspSS - Re_BufSz = Re_BufSz + 1 ! PtfmSurge - Re_BufSz = Re_BufSz + 1 ! PtfmSway - Re_BufSz = Re_BufSz + 1 ! PtfmHeave - Re_BufSz = Re_BufSz + 1 ! PtfmRoll - Re_BufSz = Re_BufSz + 1 ! PtfmPitch - Re_BufSz = Re_BufSz + 1 ! PtfmYaw - Int_BufSz = Int_BufSz + 1 ! NumBl - Re_BufSz = Re_BufSz + 1 ! TipRad - Re_BufSz = Re_BufSz + 1 ! HubRad - Int_BufSz = Int_BufSz + 1 ! PreCone allocated yes/no - IF ( ALLOCATED(InData%PreCone) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PreCone upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PreCone) ! PreCone - END IF - Re_BufSz = Re_BufSz + 1 ! HubCM - Re_BufSz = Re_BufSz + 1 ! UndSling - Re_BufSz = Re_BufSz + 1 ! Delta3 - Db_BufSz = Db_BufSz + 1 ! AzimB1Up - Re_BufSz = Re_BufSz + 1 ! OverHang - Re_BufSz = Re_BufSz + 1 ! ShftGagL - Re_BufSz = Re_BufSz + 1 ! ShftTilt - Re_BufSz = Re_BufSz + 1 ! NacCMxn - Re_BufSz = Re_BufSz + 1 ! NacCMyn - Re_BufSz = Re_BufSz + 1 ! NacCMzn - Re_BufSz = Re_BufSz + 1 ! NcIMUxn - Re_BufSz = Re_BufSz + 1 ! NcIMUyn - Re_BufSz = Re_BufSz + 1 ! NcIMUzn - Re_BufSz = Re_BufSz + 1 ! Twr2Shft - Re_BufSz = Re_BufSz + 1 ! TowerHt - Re_BufSz = Re_BufSz + 1 ! TowerBsHt - Re_BufSz = Re_BufSz + 1 ! PtfmCMxt - Re_BufSz = Re_BufSz + 1 ! PtfmCMyt - Re_BufSz = Re_BufSz + 1 ! PtfmCMzt - Re_BufSz = Re_BufSz + 1 ! PtfmRefzt - Int_BufSz = Int_BufSz + 1 ! TipMass allocated yes/no - IF ( ALLOCATED(InData%TipMass) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TipMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TipMass) ! TipMass - END IF - Re_BufSz = Re_BufSz + 1 ! HubMass - Re_BufSz = Re_BufSz + 1 ! HubIner - Re_BufSz = Re_BufSz + 1 ! GenIner - Re_BufSz = Re_BufSz + 1 ! NacMass - Re_BufSz = Re_BufSz + 1 ! NacYIner - Re_BufSz = Re_BufSz + 1 ! YawBrMass - Re_BufSz = Re_BufSz + 1 ! PtfmMass - Re_BufSz = Re_BufSz + 1 ! PtfmRIner - Re_BufSz = Re_BufSz + 1 ! PtfmPIner - Re_BufSz = Re_BufSz + 1 ! PtfmYIner - Re_BufSz = Re_BufSz + 1 ! BldNodes - Int_BufSz = Int_BufSz + 1 ! InpBlMesh allocated yes/no - IF ( ALLOCATED(InData%InpBlMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InpBlMesh upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InpBlMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InpBlMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InpBlMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InpBl allocated yes/no - IF ( ALLOCATED(InData%InpBl) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InpBl - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InpBl - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InpBl - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TeetMod - Re_BufSz = Re_BufSz + 1 ! TeetDmpP - Re_BufSz = Re_BufSz + 1 ! TeetDmp - Re_BufSz = Re_BufSz + 1 ! TeetCDmp - Re_BufSz = Re_BufSz + 1 ! TeetSStP - Re_BufSz = Re_BufSz + 1 ! TeetHStP - Re_BufSz = Re_BufSz + 1 ! TeetSSSp - Re_BufSz = Re_BufSz + 1 ! TeetHSSp - Re_BufSz = Re_BufSz + 1 ! GBoxEff - Re_BufSz = Re_BufSz + 1 ! GBRatio - Re_BufSz = Re_BufSz + 1 ! DTTorSpr - Re_BufSz = Re_BufSz + 1 ! DTTorDmp - Int_BufSz = Int_BufSz + 1 ! Furling - Int_BufSz = Int_BufSz + 1 ! TwrNodes - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! OutFile - Int_BufSz = Int_BufSz + 1 ! TabDelim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Db_BufSz = Db_BufSz + 1 ! Tstart - Int_BufSz = Int_BufSz + 1 ! DecFact - Int_BufSz = Int_BufSz + 1 ! NTwGages - Int_BufSz = Int_BufSz + SIZE(InData%TwrGagNd) ! TwrGagNd - Int_BufSz = Int_BufSz + 1 ! NBlGages - Int_BufSz = Int_BufSz + SIZE(InData%BldGagNd) ! BldGagNd - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1 ! NTwInpSt - Re_BufSz = Re_BufSz + SIZE(InData%TwrFADmp) ! TwrFADmp - Re_BufSz = Re_BufSz + SIZE(InData%TwrSSDmp) ! TwrSSDmp - Re_BufSz = Re_BufSz + SIZE(InData%FAStTunr) ! FAStTunr - Re_BufSz = Re_BufSz + SIZE(InData%SSStTunr) ! SSStTunr - Int_BufSz = Int_BufSz + 1 ! HtFract allocated yes/no - IF ( ALLOCATED(InData%HtFract) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HtFract upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HtFract) ! HtFract - END IF - Int_BufSz = Int_BufSz + 1 ! TMassDen allocated yes/no - IF ( ALLOCATED(InData%TMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TMassDen) ! TMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! TwFAStif allocated yes/no - IF ( ALLOCATED(InData%TwFAStif) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwFAStif upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwFAStif) ! TwFAStif - END IF - Int_BufSz = Int_BufSz + 1 ! TwSSStif allocated yes/no - IF ( ALLOCATED(InData%TwSSStif) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwSSStif upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwSSStif) ! TwSSStif - END IF - Int_BufSz = Int_BufSz + 1 ! TwFAM1Sh allocated yes/no - IF ( ALLOCATED(InData%TwFAM1Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwFAM1Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwFAM1Sh) ! TwFAM1Sh - END IF - Int_BufSz = Int_BufSz + 1 ! TwFAM2Sh allocated yes/no - IF ( ALLOCATED(InData%TwFAM2Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwFAM2Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwFAM2Sh) ! TwFAM2Sh - END IF - Int_BufSz = Int_BufSz + 1 ! TwSSM1Sh allocated yes/no - IF ( ALLOCATED(InData%TwSSM1Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwSSM1Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwSSM1Sh) ! TwSSM1Sh - END IF - Int_BufSz = Int_BufSz + 1 ! TwSSM2Sh allocated yes/no - IF ( ALLOCATED(InData%TwSSM2Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwSSM2Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwSSM2Sh) ! TwSSM2Sh - END IF - Int_BufSz = Int_BufSz + 1 ! RFrlDOF - Int_BufSz = Int_BufSz + 1 ! TFrlDOF - Re_BufSz = Re_BufSz + 1 ! RotFurl - Re_BufSz = Re_BufSz + 1 ! TailFurl - Re_BufSz = Re_BufSz + 1 ! Yaw2Shft - Re_BufSz = Re_BufSz + 1 ! ShftSkew - Re_BufSz = Re_BufSz + SIZE(InData%RFrlCM_n) ! RFrlCM_n - Re_BufSz = Re_BufSz + SIZE(InData%BoomCM_n) ! BoomCM_n - Re_BufSz = Re_BufSz + SIZE(InData%TFinCM_n) ! TFinCM_n - Re_BufSz = Re_BufSz + SIZE(InData%RFrlPnt_n) ! RFrlPnt_n - Re_BufSz = Re_BufSz + 1 ! RFrlSkew - Re_BufSz = Re_BufSz + 1 ! RFrlTilt - Re_BufSz = Re_BufSz + SIZE(InData%TFrlPnt_n) ! TFrlPnt_n - Re_BufSz = Re_BufSz + 1 ! TFrlSkew - Re_BufSz = Re_BufSz + 1 ! TFrlTilt - Re_BufSz = Re_BufSz + 1 ! RFrlMass - Re_BufSz = Re_BufSz + 1 ! BoomMass - Re_BufSz = Re_BufSz + 1 ! TFinMass - Re_BufSz = Re_BufSz + 1 ! RFrlIner - Re_BufSz = Re_BufSz + 1 ! TFrlIner - Int_BufSz = Int_BufSz + 1 ! RFrlMod - Re_BufSz = Re_BufSz + 1 ! RFrlSpr - Re_BufSz = Re_BufSz + 1 ! RFrlDmp - Re_BufSz = Re_BufSz + 1 ! RFrlUSSP - Re_BufSz = Re_BufSz + 1 ! RFrlDSSP - Re_BufSz = Re_BufSz + 1 ! RFrlUSSpr - Re_BufSz = Re_BufSz + 1 ! RFrlDSSpr - Re_BufSz = Re_BufSz + 1 ! RFrlUSDP - Re_BufSz = Re_BufSz + 1 ! RFrlDSDP - Re_BufSz = Re_BufSz + 1 ! RFrlUSDmp - Re_BufSz = Re_BufSz + 1 ! RFrlDSDmp - Int_BufSz = Int_BufSz + 1 ! TFrlMod - Re_BufSz = Re_BufSz + 1 ! TFrlSpr - Re_BufSz = Re_BufSz + 1 ! TFrlDmp - Re_BufSz = Re_BufSz + 1 ! TFrlUSSP - Re_BufSz = Re_BufSz + 1 ! TFrlDSSP - Re_BufSz = Re_BufSz + 1 ! TFrlUSSpr - Re_BufSz = Re_BufSz + 1 ! TFrlDSSpr - Re_BufSz = Re_BufSz + 1 ! TFrlUSDP - Re_BufSz = Re_BufSz + 1 ! TFrlDSDP - Re_BufSz = Re_BufSz + 1 ! TFrlUSDmp - Re_BufSz = Re_BufSz + 1 ! TFrlDSDmp - Int_BufSz = Int_BufSz + 1 ! method - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str - Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut - 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%FlapDOF1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FlapDOF2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EdgeDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TeetDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DrTrDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%YawDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwFADOF1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwFADOF2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwSSDOF1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwSSDOF2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSgDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSwDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmHvDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmRDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmPDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmYDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%OoPDefl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%IPDefl - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlPitch) ) 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%BlPitch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) - ReKiBuf(Re_Xferred) = InData%BlPitch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TeetDefl - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Azimuth - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TTDspFA - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TTDspSS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmSurge - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmSway - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmHeave - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRoll - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmPitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmYaw - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TipRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PreCone) ) 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%PreCone,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PreCone,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PreCone,1), UBOUND(InData%PreCone,1) - ReKiBuf(Re_Xferred) = InData%PreCone(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%HubCM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UndSling - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Delta3 - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%AzimB1Up - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%OverHang - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShftGagL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShftTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMUxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMUyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMUzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Twr2Shft - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerBsHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmCMxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmCMyt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmCMzt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TipMass) ) 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%TipMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TipMass,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TipMass,1), UBOUND(InData%TipMass,1) - ReKiBuf(Re_Xferred) = InData%TipMass(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%HubMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmPIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BldNodes - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%InpBlMesh) ) 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%InpBlMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InpBlMesh,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%InpBl) ) 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%InpBl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InpBl,1) - 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 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%TeetMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetDmpP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetSStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetHStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetSSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetHSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GBoxEff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GBRatio - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTTorSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTTorDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Furling, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) - 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 - DbKiBuf(Db_Xferred) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DecFact - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NTwGages - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TwrGagNd,1), UBOUND(InData%TwrGagNd,1) - IntKiBuf(Int_Xferred) = InData%TwrGagNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NBlGages - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%BldGagNd,1), UBOUND(InData%BldGagNd,1) - IntKiBuf(Int_Xferred) = InData%BldGagNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) 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%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - 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 - END IF - IntKiBuf(Int_Xferred) = InData%NTwInpSt - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TwrFADmp,1), UBOUND(InData%TwrFADmp,1) - ReKiBuf(Re_Xferred) = InData%TwrFADmp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TwrSSDmp,1), UBOUND(InData%TwrSSDmp,1) - ReKiBuf(Re_Xferred) = InData%TwrSSDmp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FAStTunr,1), UBOUND(InData%FAStTunr,1) - ReKiBuf(Re_Xferred) = InData%FAStTunr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%SSStTunr,1), UBOUND(InData%SSStTunr,1) - ReKiBuf(Re_Xferred) = InData%SSStTunr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%HtFract) ) 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%HtFract,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HtFract,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HtFract,1), UBOUND(InData%HtFract,1) - ReKiBuf(Re_Xferred) = InData%HtFract(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TMassDen) ) 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%TMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TMassDen,1), UBOUND(InData%TMassDen,1) - ReKiBuf(Re_Xferred) = InData%TMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwFAStif) ) 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%TwFAStif,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAStif,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwFAStif,1), UBOUND(InData%TwFAStif,1) - ReKiBuf(Re_Xferred) = InData%TwFAStif(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwSSStif) ) 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%TwSSStif,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSStif,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwSSStif,1), UBOUND(InData%TwSSStif,1) - ReKiBuf(Re_Xferred) = InData%TwSSStif(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwFAM1Sh) ) 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%TwFAM1Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAM1Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwFAM1Sh,1), UBOUND(InData%TwFAM1Sh,1) - ReKiBuf(Re_Xferred) = InData%TwFAM1Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwFAM2Sh) ) 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%TwFAM2Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAM2Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwFAM2Sh,1), UBOUND(InData%TwFAM2Sh,1) - ReKiBuf(Re_Xferred) = InData%TwFAM2Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwSSM1Sh) ) 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%TwSSM1Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSM1Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwSSM1Sh,1), UBOUND(InData%TwSSM1Sh,1) - ReKiBuf(Re_Xferred) = InData%TwSSM1Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwSSM2Sh) ) 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%TwSSM2Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSM2Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwSSM2Sh,1), UBOUND(InData%TwSSM2Sh,1) - ReKiBuf(Re_Xferred) = InData%TwSSM2Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%RFrlDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TFrlDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotFurl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TailFurl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Yaw2Shft - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShftSkew - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RFrlCM_n,1), UBOUND(InData%RFrlCM_n,1) - ReKiBuf(Re_Xferred) = InData%RFrlCM_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%BoomCM_n,1), UBOUND(InData%BoomCM_n,1) - ReKiBuf(Re_Xferred) = InData%BoomCM_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinCM_n,1), UBOUND(InData%TFinCM_n,1) - ReKiBuf(Re_Xferred) = InData%TFinCM_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RFrlPnt_n,1), UBOUND(InData%RFrlPnt_n,1) - ReKiBuf(Re_Xferred) = InData%RFrlPnt_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%RFrlSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlTilt - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%TFrlPnt_n,1), UBOUND(InData%TFrlPnt_n,1) - ReKiBuf(Re_Xferred) = InData%TFrlPnt_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%TFrlSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BoomMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlIner - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%method - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_OutList) ) 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%BldNd_OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) - DO I = 1, LEN(InData%BldNd_OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%BldNd_BlOutNd_Str) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_PackInputFile - - SUBROUTINE ED_UnPackInputFile( 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(ED_InputFile), 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 = 'ED_UnPackInputFile' - ! 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%FlapDOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FlapDOF1) - Int_Xferred = Int_Xferred + 1 - OutData%FlapDOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FlapDOF2) - Int_Xferred = Int_Xferred + 1 - OutData%EdgeDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%EdgeDOF) - Int_Xferred = Int_Xferred + 1 - OutData%TeetDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TeetDOF) - Int_Xferred = Int_Xferred + 1 - OutData%DrTrDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DrTrDOF) - Int_Xferred = Int_Xferred + 1 - OutData%GenDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenDOF) - Int_Xferred = Int_Xferred + 1 - OutData%YawDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%YawDOF) - Int_Xferred = Int_Xferred + 1 - OutData%TwFADOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwFADOF1) - Int_Xferred = Int_Xferred + 1 - OutData%TwFADOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwFADOF2) - Int_Xferred = Int_Xferred + 1 - OutData%TwSSDOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwSSDOF1) - Int_Xferred = Int_Xferred + 1 - OutData%TwSSDOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwSSDOF2) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSgDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSgDOF) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSwDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSwDOF) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmHvDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmHvDOF) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmRDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmRDOF) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmPDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmPDOF) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmYDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmYDOF) - Int_Xferred = Int_Xferred + 1 - OutData%OoPDefl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%IPDefl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch 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%BlPitch)) DEALLOCATE(OutData%BlPitch) - ALLOCATE(OutData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) - OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%TeetDefl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Azimuth = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TTDspFA = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TTDspSS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmSurge = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmSway = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmHeave = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRoll = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TipRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PreCone 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%PreCone)) DEALLOCATE(OutData%PreCone) - ALLOCATE(OutData%PreCone(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PreCone.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PreCone,1), UBOUND(OutData%PreCone,1) - OutData%PreCone(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%HubCM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UndSling = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Delta3 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AzimB1Up = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%OverHang = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShftGagL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShftTilt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Twr2Shft = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBsHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMxt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMyt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRefzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TipMass 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%TipMass)) DEALLOCATE(OutData%TipMass) - ALLOCATE(OutData%TipMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TipMass,1), UBOUND(OutData%TipMass,1) - OutData%TipMass(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%HubMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BldNodes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpBlMesh 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%InpBlMesh)) DEALLOCATE(OutData%InpBlMesh) - ALLOCATE(OutData%InpBlMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBlMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InpBlMesh,1), UBOUND(OutData%InpBlMesh,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 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 - - 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 ! InpBl 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%InpBl)) DEALLOCATE(OutData%InpBl) - ALLOCATE(OutData%InpBl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InpBl,1), UBOUND(OutData%InpBl,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 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 - - 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%TeetMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TeetDmpP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetCDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSStP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHStP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSSSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHSSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GBRatio = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Furling = TRANSFER(IntKiBuf(Int_Xferred), OutData%Furling) - Int_Xferred = Int_Xferred + 1 - OutData%TwrNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) - 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 - OutData%Tstart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DecFact = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NTwGages = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TwrGagNd,1) - i1_u = UBOUND(OutData%TwrGagNd,1) - DO i1 = LBOUND(OutData%TwrGagNd,1), UBOUND(OutData%TwrGagNd,1) - OutData%TwrGagNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NBlGages = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%BldGagNd,1) - i1_u = UBOUND(OutData%BldGagNd,1) - DO i1 = LBOUND(OutData%BldGagNd,1), UBOUND(OutData%BldGagNd,1) - OutData%BldGagNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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%NTwInpSt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TwrFADmp,1) - i1_u = UBOUND(OutData%TwrFADmp,1) - DO i1 = LBOUND(OutData%TwrFADmp,1), UBOUND(OutData%TwrFADmp,1) - OutData%TwrFADmp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrSSDmp,1) - i1_u = UBOUND(OutData%TwrSSDmp,1) - DO i1 = LBOUND(OutData%TwrSSDmp,1), UBOUND(OutData%TwrSSDmp,1) - OutData%TwrSSDmp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FAStTunr,1) - i1_u = UBOUND(OutData%FAStTunr,1) - DO i1 = LBOUND(OutData%FAStTunr,1), UBOUND(OutData%FAStTunr,1) - OutData%FAStTunr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%SSStTunr,1) - i1_u = UBOUND(OutData%SSStTunr,1) - DO i1 = LBOUND(OutData%SSStTunr,1), UBOUND(OutData%SSStTunr,1) - OutData%SSStTunr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HtFract 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%HtFract)) DEALLOCATE(OutData%HtFract) - ALLOCATE(OutData%HtFract(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HtFract.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HtFract,1), UBOUND(OutData%HtFract,1) - OutData%HtFract(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TMassDen 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%TMassDen)) DEALLOCATE(OutData%TMassDen) - ALLOCATE(OutData%TMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TMassDen,1), UBOUND(OutData%TMassDen,1) - OutData%TMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAStif 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%TwFAStif)) DEALLOCATE(OutData%TwFAStif) - ALLOCATE(OutData%TwFAStif(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAStif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwFAStif,1), UBOUND(OutData%TwFAStif,1) - OutData%TwFAStif(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSStif 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%TwSSStif)) DEALLOCATE(OutData%TwSSStif) - ALLOCATE(OutData%TwSSStif(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSStif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwSSStif,1), UBOUND(OutData%TwSSStif,1) - OutData%TwSSStif(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAM1Sh 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%TwFAM1Sh)) DEALLOCATE(OutData%TwFAM1Sh) - ALLOCATE(OutData%TwFAM1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwFAM1Sh,1), UBOUND(OutData%TwFAM1Sh,1) - OutData%TwFAM1Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAM2Sh 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%TwFAM2Sh)) DEALLOCATE(OutData%TwFAM2Sh) - ALLOCATE(OutData%TwFAM2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwFAM2Sh,1), UBOUND(OutData%TwFAM2Sh,1) - OutData%TwFAM2Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSM1Sh 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%TwSSM1Sh)) DEALLOCATE(OutData%TwSSM1Sh) - ALLOCATE(OutData%TwSSM1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwSSM1Sh,1), UBOUND(OutData%TwSSM1Sh,1) - OutData%TwSSM1Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSM2Sh 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%TwSSM2Sh)) DEALLOCATE(OutData%TwSSM2Sh) - ALLOCATE(OutData%TwSSM2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwSSM2Sh,1), UBOUND(OutData%TwSSM2Sh,1) - OutData%TwSSM2Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%RFrlDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%RFrlDOF) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TFrlDOF) - Int_Xferred = Int_Xferred + 1 - OutData%RotFurl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TailFurl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Yaw2Shft = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShftSkew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RFrlCM_n,1) - i1_u = UBOUND(OutData%RFrlCM_n,1) - DO i1 = LBOUND(OutData%RFrlCM_n,1), UBOUND(OutData%RFrlCM_n,1) - OutData%RFrlCM_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%BoomCM_n,1) - i1_u = UBOUND(OutData%BoomCM_n,1) - DO i1 = LBOUND(OutData%BoomCM_n,1), UBOUND(OutData%BoomCM_n,1) - OutData%BoomCM_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinCM_n,1) - i1_u = UBOUND(OutData%TFinCM_n,1) - DO i1 = LBOUND(OutData%TFinCM_n,1), UBOUND(OutData%TFinCM_n,1) - OutData%TFinCM_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RFrlPnt_n,1) - i1_u = UBOUND(OutData%RFrlPnt_n,1) - DO i1 = LBOUND(OutData%RFrlPnt_n,1), UBOUND(OutData%RFrlPnt_n,1) - OutData%RFrlPnt_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%RFrlSkew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlTilt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%TFrlPnt_n,1) - i1_u = UBOUND(OutData%TFrlPnt_n,1) - DO i1 = LBOUND(OutData%TFrlPnt_n,1), UBOUND(OutData%TFrlPnt_n,1) - OutData%TFrlPnt_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TFrlSkew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlTilt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BoomMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RFrlSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%method = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_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%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) - ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) - DO I = 1, LEN(OutData%BldNd_OutList) - OutData%BldNd_OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) - OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_UnPackInputFile - - SUBROUTINE ED_CopyCoordSys( SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_CoordSys), INTENT(IN) :: SrcCoordSysData - TYPE(ED_CoordSys), INTENT(INOUT) :: DstCoordSysData - 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 = 'ED_CopyCoordSys' -! - ErrStat = ErrID_None - ErrMsg = "" - DstCoordSysData%a1 = SrcCoordSysData%a1 - DstCoordSysData%a2 = SrcCoordSysData%a2 - DstCoordSysData%a3 = SrcCoordSysData%a3 - DstCoordSysData%b1 = SrcCoordSysData%b1 - DstCoordSysData%b2 = SrcCoordSysData%b2 - DstCoordSysData%b3 = SrcCoordSysData%b3 - DstCoordSysData%c1 = SrcCoordSysData%c1 - DstCoordSysData%c2 = SrcCoordSysData%c2 - DstCoordSysData%c3 = SrcCoordSysData%c3 - DstCoordSysData%d1 = SrcCoordSysData%d1 - DstCoordSysData%d2 = SrcCoordSysData%d2 - DstCoordSysData%d3 = SrcCoordSysData%d3 - DstCoordSysData%e1 = SrcCoordSysData%e1 - DstCoordSysData%e2 = SrcCoordSysData%e2 - DstCoordSysData%e3 = SrcCoordSysData%e3 - DstCoordSysData%f1 = SrcCoordSysData%f1 - DstCoordSysData%f2 = SrcCoordSysData%f2 - DstCoordSysData%f3 = SrcCoordSysData%f3 - DstCoordSysData%g1 = SrcCoordSysData%g1 - DstCoordSysData%g2 = SrcCoordSysData%g2 - DstCoordSysData%g3 = SrcCoordSysData%g3 -IF (ALLOCATED(SrcCoordSysData%i1)) THEN - i1_l = LBOUND(SrcCoordSysData%i1,1) - i1_u = UBOUND(SrcCoordSysData%i1,1) - i2_l = LBOUND(SrcCoordSysData%i1,2) - i2_u = UBOUND(SrcCoordSysData%i1,2) - IF (.NOT. ALLOCATED(DstCoordSysData%i1)) THEN - ALLOCATE(DstCoordSysData%i1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%i1 = SrcCoordSysData%i1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%i2)) THEN - i1_l = LBOUND(SrcCoordSysData%i2,1) - i1_u = UBOUND(SrcCoordSysData%i2,1) - i2_l = LBOUND(SrcCoordSysData%i2,2) - i2_u = UBOUND(SrcCoordSysData%i2,2) - IF (.NOT. ALLOCATED(DstCoordSysData%i2)) THEN - ALLOCATE(DstCoordSysData%i2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%i2 = SrcCoordSysData%i2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%i3)) THEN - i1_l = LBOUND(SrcCoordSysData%i3,1) - i1_u = UBOUND(SrcCoordSysData%i3,1) - i2_l = LBOUND(SrcCoordSysData%i3,2) - i2_u = UBOUND(SrcCoordSysData%i3,2) - IF (.NOT. ALLOCATED(DstCoordSysData%i3)) THEN - ALLOCATE(DstCoordSysData%i3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%i3 = SrcCoordSysData%i3 -ENDIF -IF (ALLOCATED(SrcCoordSysData%j1)) THEN - i1_l = LBOUND(SrcCoordSysData%j1,1) - i1_u = UBOUND(SrcCoordSysData%j1,1) - i2_l = LBOUND(SrcCoordSysData%j1,2) - i2_u = UBOUND(SrcCoordSysData%j1,2) - IF (.NOT. ALLOCATED(DstCoordSysData%j1)) THEN - ALLOCATE(DstCoordSysData%j1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%j1 = SrcCoordSysData%j1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%j2)) THEN - i1_l = LBOUND(SrcCoordSysData%j2,1) - i1_u = UBOUND(SrcCoordSysData%j2,1) - i2_l = LBOUND(SrcCoordSysData%j2,2) - i2_u = UBOUND(SrcCoordSysData%j2,2) - IF (.NOT. ALLOCATED(DstCoordSysData%j2)) THEN - ALLOCATE(DstCoordSysData%j2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%j2 = SrcCoordSysData%j2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%j3)) THEN - i1_l = LBOUND(SrcCoordSysData%j3,1) - i1_u = UBOUND(SrcCoordSysData%j3,1) - i2_l = LBOUND(SrcCoordSysData%j3,2) - i2_u = UBOUND(SrcCoordSysData%j3,2) - IF (.NOT. ALLOCATED(DstCoordSysData%j3)) THEN - ALLOCATE(DstCoordSysData%j3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%j3 = SrcCoordSysData%j3 -ENDIF -IF (ALLOCATED(SrcCoordSysData%m1)) THEN - i1_l = LBOUND(SrcCoordSysData%m1,1) - i1_u = UBOUND(SrcCoordSysData%m1,1) - i2_l = LBOUND(SrcCoordSysData%m1,2) - i2_u = UBOUND(SrcCoordSysData%m1,2) - i3_l = LBOUND(SrcCoordSysData%m1,3) - i3_u = UBOUND(SrcCoordSysData%m1,3) - IF (.NOT. ALLOCATED(DstCoordSysData%m1)) THEN - ALLOCATE(DstCoordSysData%m1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%m1 = SrcCoordSysData%m1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%m2)) THEN - i1_l = LBOUND(SrcCoordSysData%m2,1) - i1_u = UBOUND(SrcCoordSysData%m2,1) - i2_l = LBOUND(SrcCoordSysData%m2,2) - i2_u = UBOUND(SrcCoordSysData%m2,2) - i3_l = LBOUND(SrcCoordSysData%m2,3) - i3_u = UBOUND(SrcCoordSysData%m2,3) - IF (.NOT. ALLOCATED(DstCoordSysData%m2)) THEN - ALLOCATE(DstCoordSysData%m2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%m2 = SrcCoordSysData%m2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%m3)) THEN - i1_l = LBOUND(SrcCoordSysData%m3,1) - i1_u = UBOUND(SrcCoordSysData%m3,1) - i2_l = LBOUND(SrcCoordSysData%m3,2) - i2_u = UBOUND(SrcCoordSysData%m3,2) - i3_l = LBOUND(SrcCoordSysData%m3,3) - i3_u = UBOUND(SrcCoordSysData%m3,3) - IF (.NOT. ALLOCATED(DstCoordSysData%m3)) THEN - ALLOCATE(DstCoordSysData%m3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%m3 = SrcCoordSysData%m3 -ENDIF -IF (ALLOCATED(SrcCoordSysData%n1)) THEN - i1_l = LBOUND(SrcCoordSysData%n1,1) - i1_u = UBOUND(SrcCoordSysData%n1,1) - i2_l = LBOUND(SrcCoordSysData%n1,2) - i2_u = UBOUND(SrcCoordSysData%n1,2) - i3_l = LBOUND(SrcCoordSysData%n1,3) - i3_u = UBOUND(SrcCoordSysData%n1,3) - IF (.NOT. ALLOCATED(DstCoordSysData%n1)) THEN - ALLOCATE(DstCoordSysData%n1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%n1 = SrcCoordSysData%n1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%n2)) THEN - i1_l = LBOUND(SrcCoordSysData%n2,1) - i1_u = UBOUND(SrcCoordSysData%n2,1) - i2_l = LBOUND(SrcCoordSysData%n2,2) - i2_u = UBOUND(SrcCoordSysData%n2,2) - i3_l = LBOUND(SrcCoordSysData%n2,3) - i3_u = UBOUND(SrcCoordSysData%n2,3) - IF (.NOT. ALLOCATED(DstCoordSysData%n2)) THEN - ALLOCATE(DstCoordSysData%n2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%n2 = SrcCoordSysData%n2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%n3)) THEN - i1_l = LBOUND(SrcCoordSysData%n3,1) - i1_u = UBOUND(SrcCoordSysData%n3,1) - i2_l = LBOUND(SrcCoordSysData%n3,2) - i2_u = UBOUND(SrcCoordSysData%n3,2) - i3_l = LBOUND(SrcCoordSysData%n3,3) - i3_u = UBOUND(SrcCoordSysData%n3,3) - IF (.NOT. ALLOCATED(DstCoordSysData%n3)) THEN - ALLOCATE(DstCoordSysData%n3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%n3 = SrcCoordSysData%n3 -ENDIF - DstCoordSysData%rf1 = SrcCoordSysData%rf1 - DstCoordSysData%rf2 = SrcCoordSysData%rf2 - DstCoordSysData%rf3 = SrcCoordSysData%rf3 - DstCoordSysData%rfa = SrcCoordSysData%rfa -IF (ALLOCATED(SrcCoordSysData%t1)) THEN - i1_l = LBOUND(SrcCoordSysData%t1,1) - i1_u = UBOUND(SrcCoordSysData%t1,1) - i2_l = LBOUND(SrcCoordSysData%t1,2) - i2_u = UBOUND(SrcCoordSysData%t1,2) - IF (.NOT. ALLOCATED(DstCoordSysData%t1)) THEN - ALLOCATE(DstCoordSysData%t1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%t1 = SrcCoordSysData%t1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%t2)) THEN - i1_l = LBOUND(SrcCoordSysData%t2,1) - i1_u = UBOUND(SrcCoordSysData%t2,1) - i2_l = LBOUND(SrcCoordSysData%t2,2) - i2_u = UBOUND(SrcCoordSysData%t2,2) - IF (.NOT. ALLOCATED(DstCoordSysData%t2)) THEN - ALLOCATE(DstCoordSysData%t2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%t2 = SrcCoordSysData%t2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%t3)) THEN - i1_l = LBOUND(SrcCoordSysData%t3,1) - i1_u = UBOUND(SrcCoordSysData%t3,1) - i2_l = LBOUND(SrcCoordSysData%t3,2) - i2_u = UBOUND(SrcCoordSysData%t3,2) - IF (.NOT. ALLOCATED(DstCoordSysData%t3)) THEN - ALLOCATE(DstCoordSysData%t3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%t3 = SrcCoordSysData%t3 -ENDIF -IF (ALLOCATED(SrcCoordSysData%te1)) THEN - i1_l = LBOUND(SrcCoordSysData%te1,1) - i1_u = UBOUND(SrcCoordSysData%te1,1) - i2_l = LBOUND(SrcCoordSysData%te1,2) - i2_u = UBOUND(SrcCoordSysData%te1,2) - i3_l = LBOUND(SrcCoordSysData%te1,3) - i3_u = UBOUND(SrcCoordSysData%te1,3) - IF (.NOT. ALLOCATED(DstCoordSysData%te1)) THEN - ALLOCATE(DstCoordSysData%te1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%te1 = SrcCoordSysData%te1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%te2)) THEN - i1_l = LBOUND(SrcCoordSysData%te2,1) - i1_u = UBOUND(SrcCoordSysData%te2,1) - i2_l = LBOUND(SrcCoordSysData%te2,2) - i2_u = UBOUND(SrcCoordSysData%te2,2) - i3_l = LBOUND(SrcCoordSysData%te2,3) - i3_u = UBOUND(SrcCoordSysData%te2,3) - IF (.NOT. ALLOCATED(DstCoordSysData%te2)) THEN - ALLOCATE(DstCoordSysData%te2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%te2 = SrcCoordSysData%te2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%te3)) THEN - i1_l = LBOUND(SrcCoordSysData%te3,1) - i1_u = UBOUND(SrcCoordSysData%te3,1) - i2_l = LBOUND(SrcCoordSysData%te3,2) - i2_u = UBOUND(SrcCoordSysData%te3,2) - i3_l = LBOUND(SrcCoordSysData%te3,3) - i3_u = UBOUND(SrcCoordSysData%te3,3) - IF (.NOT. ALLOCATED(DstCoordSysData%te3)) THEN - ALLOCATE(DstCoordSysData%te3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%te3 = SrcCoordSysData%te3 -ENDIF - DstCoordSysData%tf1 = SrcCoordSysData%tf1 - DstCoordSysData%tf2 = SrcCoordSysData%tf2 - DstCoordSysData%tf3 = SrcCoordSysData%tf3 - DstCoordSysData%tfa = SrcCoordSysData%tfa - DstCoordSysData%z1 = SrcCoordSysData%z1 - DstCoordSysData%z2 = SrcCoordSysData%z2 - DstCoordSysData%z3 = SrcCoordSysData%z3 - END SUBROUTINE ED_CopyCoordSys - - SUBROUTINE ED_DestroyCoordSys( CoordSysData, ErrStat, ErrMsg ) - TYPE(ED_CoordSys), INTENT(INOUT) :: CoordSysData - 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 = 'ED_DestroyCoordSys' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(CoordSysData%i1)) THEN - DEALLOCATE(CoordSysData%i1) -ENDIF -IF (ALLOCATED(CoordSysData%i2)) THEN - DEALLOCATE(CoordSysData%i2) -ENDIF -IF (ALLOCATED(CoordSysData%i3)) THEN - DEALLOCATE(CoordSysData%i3) -ENDIF -IF (ALLOCATED(CoordSysData%j1)) THEN - DEALLOCATE(CoordSysData%j1) -ENDIF -IF (ALLOCATED(CoordSysData%j2)) THEN - DEALLOCATE(CoordSysData%j2) -ENDIF -IF (ALLOCATED(CoordSysData%j3)) THEN - DEALLOCATE(CoordSysData%j3) -ENDIF -IF (ALLOCATED(CoordSysData%m1)) THEN - DEALLOCATE(CoordSysData%m1) -ENDIF -IF (ALLOCATED(CoordSysData%m2)) THEN - DEALLOCATE(CoordSysData%m2) -ENDIF -IF (ALLOCATED(CoordSysData%m3)) THEN - DEALLOCATE(CoordSysData%m3) -ENDIF -IF (ALLOCATED(CoordSysData%n1)) THEN - DEALLOCATE(CoordSysData%n1) -ENDIF -IF (ALLOCATED(CoordSysData%n2)) THEN - DEALLOCATE(CoordSysData%n2) -ENDIF -IF (ALLOCATED(CoordSysData%n3)) THEN - DEALLOCATE(CoordSysData%n3) -ENDIF -IF (ALLOCATED(CoordSysData%t1)) THEN - DEALLOCATE(CoordSysData%t1) -ENDIF -IF (ALLOCATED(CoordSysData%t2)) THEN - DEALLOCATE(CoordSysData%t2) -ENDIF -IF (ALLOCATED(CoordSysData%t3)) THEN - DEALLOCATE(CoordSysData%t3) -ENDIF -IF (ALLOCATED(CoordSysData%te1)) THEN - DEALLOCATE(CoordSysData%te1) -ENDIF -IF (ALLOCATED(CoordSysData%te2)) THEN - DEALLOCATE(CoordSysData%te2) -ENDIF -IF (ALLOCATED(CoordSysData%te3)) THEN - DEALLOCATE(CoordSysData%te3) -ENDIF - END SUBROUTINE ED_DestroyCoordSys - - SUBROUTINE ED_PackCoordSys( 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(ED_CoordSys), 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 = 'ED_PackCoordSys' - ! 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 + SIZE(InData%a1) ! a1 - Db_BufSz = Db_BufSz + SIZE(InData%a2) ! a2 - Db_BufSz = Db_BufSz + SIZE(InData%a3) ! a3 - Db_BufSz = Db_BufSz + SIZE(InData%b1) ! b1 - Db_BufSz = Db_BufSz + SIZE(InData%b2) ! b2 - Db_BufSz = Db_BufSz + SIZE(InData%b3) ! b3 - Db_BufSz = Db_BufSz + SIZE(InData%c1) ! c1 - Db_BufSz = Db_BufSz + SIZE(InData%c2) ! c2 - Db_BufSz = Db_BufSz + SIZE(InData%c3) ! c3 - Db_BufSz = Db_BufSz + SIZE(InData%d1) ! d1 - Db_BufSz = Db_BufSz + SIZE(InData%d2) ! d2 - Db_BufSz = Db_BufSz + SIZE(InData%d3) ! d3 - Db_BufSz = Db_BufSz + SIZE(InData%e1) ! e1 - Db_BufSz = Db_BufSz + SIZE(InData%e2) ! e2 - Db_BufSz = Db_BufSz + SIZE(InData%e3) ! e3 - Db_BufSz = Db_BufSz + SIZE(InData%f1) ! f1 - Db_BufSz = Db_BufSz + SIZE(InData%f2) ! f2 - Db_BufSz = Db_BufSz + SIZE(InData%f3) ! f3 - Db_BufSz = Db_BufSz + SIZE(InData%g1) ! g1 - Db_BufSz = Db_BufSz + SIZE(InData%g2) ! g2 - Db_BufSz = Db_BufSz + SIZE(InData%g3) ! g3 - Int_BufSz = Int_BufSz + 1 ! i1 allocated yes/no - IF ( ALLOCATED(InData%i1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! i1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%i1) ! i1 - END IF - Int_BufSz = Int_BufSz + 1 ! i2 allocated yes/no - IF ( ALLOCATED(InData%i2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! i2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%i2) ! i2 - END IF - Int_BufSz = Int_BufSz + 1 ! i3 allocated yes/no - IF ( ALLOCATED(InData%i3) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! i3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%i3) ! i3 - END IF - Int_BufSz = Int_BufSz + 1 ! j1 allocated yes/no - IF ( ALLOCATED(InData%j1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! j1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%j1) ! j1 - END IF - Int_BufSz = Int_BufSz + 1 ! j2 allocated yes/no - IF ( ALLOCATED(InData%j2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! j2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%j2) ! j2 - END IF - Int_BufSz = Int_BufSz + 1 ! j3 allocated yes/no - IF ( ALLOCATED(InData%j3) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! j3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%j3) ! j3 - END IF - Int_BufSz = Int_BufSz + 1 ! m1 allocated yes/no - IF ( ALLOCATED(InData%m1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! m1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%m1) ! m1 - END IF - Int_BufSz = Int_BufSz + 1 ! m2 allocated yes/no - IF ( ALLOCATED(InData%m2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! m2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%m2) ! m2 - END IF - Int_BufSz = Int_BufSz + 1 ! m3 allocated yes/no - IF ( ALLOCATED(InData%m3) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! m3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%m3) ! m3 - END IF - Int_BufSz = Int_BufSz + 1 ! n1 allocated yes/no - IF ( ALLOCATED(InData%n1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! n1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%n1) ! n1 - END IF - Int_BufSz = Int_BufSz + 1 ! n2 allocated yes/no - IF ( ALLOCATED(InData%n2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! n2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%n2) ! n2 - END IF - Int_BufSz = Int_BufSz + 1 ! n3 allocated yes/no - IF ( ALLOCATED(InData%n3) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! n3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%n3) ! n3 - END IF - Db_BufSz = Db_BufSz + SIZE(InData%rf1) ! rf1 - Db_BufSz = Db_BufSz + SIZE(InData%rf2) ! rf2 - Db_BufSz = Db_BufSz + SIZE(InData%rf3) ! rf3 - Db_BufSz = Db_BufSz + SIZE(InData%rfa) ! rfa - Int_BufSz = Int_BufSz + 1 ! t1 allocated yes/no - IF ( ALLOCATED(InData%t1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! t1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%t1) ! t1 - END IF - Int_BufSz = Int_BufSz + 1 ! t2 allocated yes/no - IF ( ALLOCATED(InData%t2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! t2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%t2) ! t2 - END IF - Int_BufSz = Int_BufSz + 1 ! t3 allocated yes/no - IF ( ALLOCATED(InData%t3) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! t3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%t3) ! t3 - END IF - Int_BufSz = Int_BufSz + 1 ! te1 allocated yes/no - IF ( ALLOCATED(InData%te1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! te1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%te1) ! te1 - END IF - Int_BufSz = Int_BufSz + 1 ! te2 allocated yes/no - IF ( ALLOCATED(InData%te2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! te2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%te2) ! te2 - END IF - Int_BufSz = Int_BufSz + 1 ! te3 allocated yes/no - IF ( ALLOCATED(InData%te3) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! te3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%te3) ! te3 - END IF - Db_BufSz = Db_BufSz + SIZE(InData%tf1) ! tf1 - Db_BufSz = Db_BufSz + SIZE(InData%tf2) ! tf2 - Db_BufSz = Db_BufSz + SIZE(InData%tf3) ! tf3 - Db_BufSz = Db_BufSz + SIZE(InData%tfa) ! tfa - Db_BufSz = Db_BufSz + SIZE(InData%z1) ! z1 - Db_BufSz = Db_BufSz + SIZE(InData%z2) ! z2 - Db_BufSz = Db_BufSz + SIZE(InData%z3) ! z3 - 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 i1 = LBOUND(InData%a1,1), UBOUND(InData%a1,1) - DbKiBuf(Db_Xferred) = InData%a1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%a2,1), UBOUND(InData%a2,1) - DbKiBuf(Db_Xferred) = InData%a2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%a3,1), UBOUND(InData%a3,1) - DbKiBuf(Db_Xferred) = InData%a3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%b1,1), UBOUND(InData%b1,1) - DbKiBuf(Db_Xferred) = InData%b1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%b2,1), UBOUND(InData%b2,1) - DbKiBuf(Db_Xferred) = InData%b2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%b3,1), UBOUND(InData%b3,1) - DbKiBuf(Db_Xferred) = InData%b3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%c1,1), UBOUND(InData%c1,1) - DbKiBuf(Db_Xferred) = InData%c1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%c2,1), UBOUND(InData%c2,1) - DbKiBuf(Db_Xferred) = InData%c2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%c3,1), UBOUND(InData%c3,1) - DbKiBuf(Db_Xferred) = InData%c3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%d1,1), UBOUND(InData%d1,1) - DbKiBuf(Db_Xferred) = InData%d1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%d2,1), UBOUND(InData%d2,1) - DbKiBuf(Db_Xferred) = InData%d2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%d3,1), UBOUND(InData%d3,1) - DbKiBuf(Db_Xferred) = InData%d3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%e1,1), UBOUND(InData%e1,1) - DbKiBuf(Db_Xferred) = InData%e1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%e2,1), UBOUND(InData%e2,1) - DbKiBuf(Db_Xferred) = InData%e2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%e3,1), UBOUND(InData%e3,1) - DbKiBuf(Db_Xferred) = InData%e3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%f1,1), UBOUND(InData%f1,1) - DbKiBuf(Db_Xferred) = InData%f1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%f2,1), UBOUND(InData%f2,1) - DbKiBuf(Db_Xferred) = InData%f2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%f3,1), UBOUND(InData%f3,1) - DbKiBuf(Db_Xferred) = InData%f3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%g1,1), UBOUND(InData%g1,1) - DbKiBuf(Db_Xferred) = InData%g1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%g2,1), UBOUND(InData%g2,1) - DbKiBuf(Db_Xferred) = InData%g2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%g3,1), UBOUND(InData%g3,1) - DbKiBuf(Db_Xferred) = InData%g3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%i1) ) 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%i1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%i1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%i1,2), UBOUND(InData%i1,2) - DO i1 = LBOUND(InData%i1,1), UBOUND(InData%i1,1) - DbKiBuf(Db_Xferred) = InData%i1(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%i2) ) 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%i2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%i2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%i2,2), UBOUND(InData%i2,2) - DO i1 = LBOUND(InData%i2,1), UBOUND(InData%i2,1) - DbKiBuf(Db_Xferred) = InData%i2(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%i3) ) 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%i3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%i3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i3,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%i3,2), UBOUND(InData%i3,2) - DO i1 = LBOUND(InData%i3,1), UBOUND(InData%i3,1) - DbKiBuf(Db_Xferred) = InData%i3(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%j1) ) 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%j1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%j1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%j1,2), UBOUND(InData%j1,2) - DO i1 = LBOUND(InData%j1,1), UBOUND(InData%j1,1) - DbKiBuf(Db_Xferred) = InData%j1(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%j2) ) 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%j2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%j2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%j2,2), UBOUND(InData%j2,2) - DO i1 = LBOUND(InData%j2,1), UBOUND(InData%j2,1) - DbKiBuf(Db_Xferred) = InData%j2(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%j3) ) 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%j3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%j3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j3,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%j3,2), UBOUND(InData%j3,2) - DO i1 = LBOUND(InData%j3,1), UBOUND(InData%j3,1) - DbKiBuf(Db_Xferred) = InData%j3(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m1) ) 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%m1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%m1,3), UBOUND(InData%m1,3) - DO i2 = LBOUND(InData%m1,2), UBOUND(InData%m1,2) - DO i1 = LBOUND(InData%m1,1), UBOUND(InData%m1,1) - DbKiBuf(Db_Xferred) = InData%m1(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m2) ) 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%m2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%m2,3), UBOUND(InData%m2,3) - DO i2 = LBOUND(InData%m2,2), UBOUND(InData%m2,2) - DO i1 = LBOUND(InData%m2,1), UBOUND(InData%m2,1) - DbKiBuf(Db_Xferred) = InData%m2(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m3) ) 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%m3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m3,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m3,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m3,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%m3,3), UBOUND(InData%m3,3) - DO i2 = LBOUND(InData%m3,2), UBOUND(InData%m3,2) - DO i1 = LBOUND(InData%m3,1), UBOUND(InData%m3,1) - DbKiBuf(Db_Xferred) = InData%m3(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%n1) ) 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%n1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%n1,3), UBOUND(InData%n1,3) - DO i2 = LBOUND(InData%n1,2), UBOUND(InData%n1,2) - DO i1 = LBOUND(InData%n1,1), UBOUND(InData%n1,1) - DbKiBuf(Db_Xferred) = InData%n1(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%n2) ) 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%n2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%n2,3), UBOUND(InData%n2,3) - DO i2 = LBOUND(InData%n2,2), UBOUND(InData%n2,2) - DO i1 = LBOUND(InData%n2,1), UBOUND(InData%n2,1) - DbKiBuf(Db_Xferred) = InData%n2(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%n3) ) 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%n3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n3,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n3,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n3,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%n3,3), UBOUND(InData%n3,3) - DO i2 = LBOUND(InData%n3,2), UBOUND(InData%n3,2) - DO i1 = LBOUND(InData%n3,1), UBOUND(InData%n3,1) - DbKiBuf(Db_Xferred) = InData%n3(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%rf1,1), UBOUND(InData%rf1,1) - DbKiBuf(Db_Xferred) = InData%rf1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rf2,1), UBOUND(InData%rf2,1) - DbKiBuf(Db_Xferred) = InData%rf2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rf3,1), UBOUND(InData%rf3,1) - DbKiBuf(Db_Xferred) = InData%rf3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rfa,1), UBOUND(InData%rfa,1) - DbKiBuf(Db_Xferred) = InData%rfa(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%t1) ) 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%t1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%t1,2), UBOUND(InData%t1,2) - DO i1 = LBOUND(InData%t1,1), UBOUND(InData%t1,1) - DbKiBuf(Db_Xferred) = InData%t1(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%t2) ) 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%t2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%t2,2), UBOUND(InData%t2,2) - DO i1 = LBOUND(InData%t2,1), UBOUND(InData%t2,1) - DbKiBuf(Db_Xferred) = InData%t2(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%t3) ) 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%t3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t3,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%t3,2), UBOUND(InData%t3,2) - DO i1 = LBOUND(InData%t3,1), UBOUND(InData%t3,1) - DbKiBuf(Db_Xferred) = InData%t3(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%te1) ) 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%te1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%te1,3), UBOUND(InData%te1,3) - DO i2 = LBOUND(InData%te1,2), UBOUND(InData%te1,2) - DO i1 = LBOUND(InData%te1,1), UBOUND(InData%te1,1) - DbKiBuf(Db_Xferred) = InData%te1(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%te2) ) 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%te2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%te2,3), UBOUND(InData%te2,3) - DO i2 = LBOUND(InData%te2,2), UBOUND(InData%te2,2) - DO i1 = LBOUND(InData%te2,1), UBOUND(InData%te2,1) - DbKiBuf(Db_Xferred) = InData%te2(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%te3) ) 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%te3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te3,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te3,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te3,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%te3,3), UBOUND(InData%te3,3) - DO i2 = LBOUND(InData%te3,2), UBOUND(InData%te3,2) - DO i1 = LBOUND(InData%te3,1), UBOUND(InData%te3,1) - DbKiBuf(Db_Xferred) = InData%te3(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%tf1,1), UBOUND(InData%tf1,1) - DbKiBuf(Db_Xferred) = InData%tf1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%tf2,1), UBOUND(InData%tf2,1) - DbKiBuf(Db_Xferred) = InData%tf2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%tf3,1), UBOUND(InData%tf3,1) - DbKiBuf(Db_Xferred) = InData%tf3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%tfa,1), UBOUND(InData%tfa,1) - DbKiBuf(Db_Xferred) = InData%tfa(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%z1,1), UBOUND(InData%z1,1) - DbKiBuf(Db_Xferred) = InData%z1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%z2,1), UBOUND(InData%z2,1) - DbKiBuf(Db_Xferred) = InData%z2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%z3,1), UBOUND(InData%z3,1) - DbKiBuf(Db_Xferred) = InData%z3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE ED_PackCoordSys - - SUBROUTINE ED_UnPackCoordSys( 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(ED_CoordSys), 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 = 'ED_UnPackCoordSys' - ! 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 - i1_l = LBOUND(OutData%a1,1) - i1_u = UBOUND(OutData%a1,1) - DO i1 = LBOUND(OutData%a1,1), UBOUND(OutData%a1,1) - OutData%a1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%a2,1) - i1_u = UBOUND(OutData%a2,1) - DO i1 = LBOUND(OutData%a2,1), UBOUND(OutData%a2,1) - OutData%a2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%a3,1) - i1_u = UBOUND(OutData%a3,1) - DO i1 = LBOUND(OutData%a3,1), UBOUND(OutData%a3,1) - OutData%a3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%b1,1) - i1_u = UBOUND(OutData%b1,1) - DO i1 = LBOUND(OutData%b1,1), UBOUND(OutData%b1,1) - OutData%b1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%b2,1) - i1_u = UBOUND(OutData%b2,1) - DO i1 = LBOUND(OutData%b2,1), UBOUND(OutData%b2,1) - OutData%b2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%b3,1) - i1_u = UBOUND(OutData%b3,1) - DO i1 = LBOUND(OutData%b3,1), UBOUND(OutData%b3,1) - OutData%b3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%c1,1) - i1_u = UBOUND(OutData%c1,1) - DO i1 = LBOUND(OutData%c1,1), UBOUND(OutData%c1,1) - OutData%c1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%c2,1) - i1_u = UBOUND(OutData%c2,1) - DO i1 = LBOUND(OutData%c2,1), UBOUND(OutData%c2,1) - OutData%c2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%c3,1) - i1_u = UBOUND(OutData%c3,1) - DO i1 = LBOUND(OutData%c3,1), UBOUND(OutData%c3,1) - OutData%c3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%d1,1) - i1_u = UBOUND(OutData%d1,1) - DO i1 = LBOUND(OutData%d1,1), UBOUND(OutData%d1,1) - OutData%d1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%d2,1) - i1_u = UBOUND(OutData%d2,1) - DO i1 = LBOUND(OutData%d2,1), UBOUND(OutData%d2,1) - OutData%d2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%d3,1) - i1_u = UBOUND(OutData%d3,1) - DO i1 = LBOUND(OutData%d3,1), UBOUND(OutData%d3,1) - OutData%d3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%e1,1) - i1_u = UBOUND(OutData%e1,1) - DO i1 = LBOUND(OutData%e1,1), UBOUND(OutData%e1,1) - OutData%e1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%e2,1) - i1_u = UBOUND(OutData%e2,1) - DO i1 = LBOUND(OutData%e2,1), UBOUND(OutData%e2,1) - OutData%e2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%e3,1) - i1_u = UBOUND(OutData%e3,1) - DO i1 = LBOUND(OutData%e3,1), UBOUND(OutData%e3,1) - OutData%e3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%f1,1) - i1_u = UBOUND(OutData%f1,1) - DO i1 = LBOUND(OutData%f1,1), UBOUND(OutData%f1,1) - OutData%f1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%f2,1) - i1_u = UBOUND(OutData%f2,1) - DO i1 = LBOUND(OutData%f2,1), UBOUND(OutData%f2,1) - OutData%f2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%f3,1) - i1_u = UBOUND(OutData%f3,1) - DO i1 = LBOUND(OutData%f3,1), UBOUND(OutData%f3,1) - OutData%f3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%g1,1) - i1_u = UBOUND(OutData%g1,1) - DO i1 = LBOUND(OutData%g1,1), UBOUND(OutData%g1,1) - OutData%g1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%g2,1) - i1_u = UBOUND(OutData%g2,1) - DO i1 = LBOUND(OutData%g2,1), UBOUND(OutData%g2,1) - OutData%g2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%g3,1) - i1_u = UBOUND(OutData%g3,1) - DO i1 = LBOUND(OutData%g3,1), UBOUND(OutData%g3,1) - OutData%g3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i1 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%i1)) DEALLOCATE(OutData%i1) - ALLOCATE(OutData%i1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%i1,2), UBOUND(OutData%i1,2) - DO i1 = LBOUND(OutData%i1,1), UBOUND(OutData%i1,1) - OutData%i1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i2 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%i2)) DEALLOCATE(OutData%i2) - ALLOCATE(OutData%i2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%i2,2), UBOUND(OutData%i2,2) - DO i1 = LBOUND(OutData%i2,1), UBOUND(OutData%i2,1) - OutData%i2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i3 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%i3)) DEALLOCATE(OutData%i3) - ALLOCATE(OutData%i3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%i3,2), UBOUND(OutData%i3,2) - DO i1 = LBOUND(OutData%i3,1), UBOUND(OutData%i3,1) - OutData%i3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j1 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%j1)) DEALLOCATE(OutData%j1) - ALLOCATE(OutData%j1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%j1,2), UBOUND(OutData%j1,2) - DO i1 = LBOUND(OutData%j1,1), UBOUND(OutData%j1,1) - OutData%j1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j2 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%j2)) DEALLOCATE(OutData%j2) - ALLOCATE(OutData%j2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%j2,2), UBOUND(OutData%j2,2) - DO i1 = LBOUND(OutData%j2,1), UBOUND(OutData%j2,1) - OutData%j2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j3 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%j3)) DEALLOCATE(OutData%j3) - ALLOCATE(OutData%j3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%j3,2), UBOUND(OutData%j3,2) - DO i1 = LBOUND(OutData%j3,1), UBOUND(OutData%j3,1) - OutData%j3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m1 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%m1)) DEALLOCATE(OutData%m1) - ALLOCATE(OutData%m1(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%m1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%m1,3), UBOUND(OutData%m1,3) - DO i2 = LBOUND(OutData%m1,2), UBOUND(OutData%m1,2) - DO i1 = LBOUND(OutData%m1,1), UBOUND(OutData%m1,1) - OutData%m1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m2 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%m2)) DEALLOCATE(OutData%m2) - ALLOCATE(OutData%m2(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%m2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%m2,3), UBOUND(OutData%m2,3) - DO i2 = LBOUND(OutData%m2,2), UBOUND(OutData%m2,2) - DO i1 = LBOUND(OutData%m2,1), UBOUND(OutData%m2,1) - OutData%m2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m3 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%m3)) DEALLOCATE(OutData%m3) - ALLOCATE(OutData%m3(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%m3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%m3,3), UBOUND(OutData%m3,3) - DO i2 = LBOUND(OutData%m3,2), UBOUND(OutData%m3,2) - DO i1 = LBOUND(OutData%m3,1), UBOUND(OutData%m3,1) - OutData%m3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n1 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%n1)) DEALLOCATE(OutData%n1) - ALLOCATE(OutData%n1(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%n1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%n1,3), UBOUND(OutData%n1,3) - DO i2 = LBOUND(OutData%n1,2), UBOUND(OutData%n1,2) - DO i1 = LBOUND(OutData%n1,1), UBOUND(OutData%n1,1) - OutData%n1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n2 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%n2)) DEALLOCATE(OutData%n2) - ALLOCATE(OutData%n2(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%n2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%n2,3), UBOUND(OutData%n2,3) - DO i2 = LBOUND(OutData%n2,2), UBOUND(OutData%n2,2) - DO i1 = LBOUND(OutData%n2,1), UBOUND(OutData%n2,1) - OutData%n2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n3 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%n3)) DEALLOCATE(OutData%n3) - ALLOCATE(OutData%n3(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%n3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%n3,3), UBOUND(OutData%n3,3) - DO i2 = LBOUND(OutData%n3,2), UBOUND(OutData%n3,2) - DO i1 = LBOUND(OutData%n3,1), UBOUND(OutData%n3,1) - OutData%n3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%rf1,1) - i1_u = UBOUND(OutData%rf1,1) - DO i1 = LBOUND(OutData%rf1,1), UBOUND(OutData%rf1,1) - OutData%rf1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rf2,1) - i1_u = UBOUND(OutData%rf2,1) - DO i1 = LBOUND(OutData%rf2,1), UBOUND(OutData%rf2,1) - OutData%rf2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rf3,1) - i1_u = UBOUND(OutData%rf3,1) - DO i1 = LBOUND(OutData%rf3,1), UBOUND(OutData%rf3,1) - OutData%rf3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rfa,1) - i1_u = UBOUND(OutData%rfa,1) - DO i1 = LBOUND(OutData%rfa,1), UBOUND(OutData%rfa,1) - OutData%rfa(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t1 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%t1)) DEALLOCATE(OutData%t1) - ALLOCATE(OutData%t1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%t1,2), UBOUND(OutData%t1,2) - DO i1 = LBOUND(OutData%t1,1), UBOUND(OutData%t1,1) - OutData%t1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t2 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%t2)) DEALLOCATE(OutData%t2) - ALLOCATE(OutData%t2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%t2,2), UBOUND(OutData%t2,2) - DO i1 = LBOUND(OutData%t2,1), UBOUND(OutData%t2,1) - OutData%t2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t3 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%t3)) DEALLOCATE(OutData%t3) - ALLOCATE(OutData%t3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%t3,2), UBOUND(OutData%t3,2) - DO i1 = LBOUND(OutData%t3,1), UBOUND(OutData%t3,1) - OutData%t3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te1 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%te1)) DEALLOCATE(OutData%te1) - ALLOCATE(OutData%te1(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%te1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%te1,3), UBOUND(OutData%te1,3) - DO i2 = LBOUND(OutData%te1,2), UBOUND(OutData%te1,2) - DO i1 = LBOUND(OutData%te1,1), UBOUND(OutData%te1,1) - OutData%te1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te2 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%te2)) DEALLOCATE(OutData%te2) - ALLOCATE(OutData%te2(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%te2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%te2,3), UBOUND(OutData%te2,3) - DO i2 = LBOUND(OutData%te2,2), UBOUND(OutData%te2,2) - DO i1 = LBOUND(OutData%te2,1), UBOUND(OutData%te2,1) - OutData%te2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te3 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%te3)) DEALLOCATE(OutData%te3) - ALLOCATE(OutData%te3(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%te3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%te3,3), UBOUND(OutData%te3,3) - DO i2 = LBOUND(OutData%te3,2), UBOUND(OutData%te3,2) - DO i1 = LBOUND(OutData%te3,1), UBOUND(OutData%te3,1) - OutData%te3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%tf1,1) - i1_u = UBOUND(OutData%tf1,1) - DO i1 = LBOUND(OutData%tf1,1), UBOUND(OutData%tf1,1) - OutData%tf1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%tf2,1) - i1_u = UBOUND(OutData%tf2,1) - DO i1 = LBOUND(OutData%tf2,1), UBOUND(OutData%tf2,1) - OutData%tf2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%tf3,1) - i1_u = UBOUND(OutData%tf3,1) - DO i1 = LBOUND(OutData%tf3,1), UBOUND(OutData%tf3,1) - OutData%tf3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%tfa,1) - i1_u = UBOUND(OutData%tfa,1) - DO i1 = LBOUND(OutData%tfa,1), UBOUND(OutData%tfa,1) - OutData%tfa(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%z1,1) - i1_u = UBOUND(OutData%z1,1) - DO i1 = LBOUND(OutData%z1,1), UBOUND(OutData%z1,1) - OutData%z1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%z2,1) - i1_u = UBOUND(OutData%z2,1) - DO i1 = LBOUND(OutData%z2,1), UBOUND(OutData%z2,1) - OutData%z2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%z3,1) - i1_u = UBOUND(OutData%z3,1) - DO i1 = LBOUND(OutData%z3,1), UBOUND(OutData%z3,1) - OutData%z3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE ED_UnPackCoordSys - - SUBROUTINE ED_CopyActiveDOFs( SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ActiveDOFs), INTENT(IN) :: SrcActiveDOFsData - TYPE(ED_ActiveDOFs), INTENT(INOUT) :: DstActiveDOFsData - 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 = 'ED_CopyActiveDOFs' -! - ErrStat = ErrID_None - ErrMsg = "" - DstActiveDOFsData%NActvDOF = SrcActiveDOFsData%NActvDOF - DstActiveDOFsData%NPCE = SrcActiveDOFsData%NPCE - DstActiveDOFsData%NPDE = SrcActiveDOFsData%NPDE - DstActiveDOFsData%NPIE = SrcActiveDOFsData%NPIE - DstActiveDOFsData%NPTE = SrcActiveDOFsData%NPTE - DstActiveDOFsData%NPTTE = SrcActiveDOFsData%NPTTE -IF (ALLOCATED(SrcActiveDOFsData%NPSBE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%NPSBE,1) - i1_u = UBOUND(SrcActiveDOFsData%NPSBE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%NPSBE)) THEN - ALLOCATE(DstActiveDOFsData%NPSBE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%NPSBE = SrcActiveDOFsData%NPSBE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%NPSE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%NPSE,1) - i1_u = UBOUND(SrcActiveDOFsData%NPSE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%NPSE)) THEN - ALLOCATE(DstActiveDOFsData%NPSE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%NPSE = SrcActiveDOFsData%NPSE -ENDIF - DstActiveDOFsData%NPUE = SrcActiveDOFsData%NPUE - DstActiveDOFsData%NPYE = SrcActiveDOFsData%NPYE -IF (ALLOCATED(SrcActiveDOFsData%PCE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PCE,1) - i1_u = UBOUND(SrcActiveDOFsData%PCE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PCE)) THEN - ALLOCATE(DstActiveDOFsData%PCE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PCE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PCE = SrcActiveDOFsData%PCE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PDE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PDE,1) - i1_u = UBOUND(SrcActiveDOFsData%PDE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PDE)) THEN - ALLOCATE(DstActiveDOFsData%PDE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PDE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PDE = SrcActiveDOFsData%PDE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PIE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PIE,1) - i1_u = UBOUND(SrcActiveDOFsData%PIE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PIE)) THEN - ALLOCATE(DstActiveDOFsData%PIE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PIE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PIE = SrcActiveDOFsData%PIE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PTE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PTE,1) - i1_u = UBOUND(SrcActiveDOFsData%PTE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PTE)) THEN - ALLOCATE(DstActiveDOFsData%PTE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PTE = SrcActiveDOFsData%PTE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PTTE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PTTE,1) - i1_u = UBOUND(SrcActiveDOFsData%PTTE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PTTE)) THEN - ALLOCATE(DstActiveDOFsData%PTTE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PTTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PTTE = SrcActiveDOFsData%PTTE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PS)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PS,1) - i1_u = UBOUND(SrcActiveDOFsData%PS,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PS)) THEN - ALLOCATE(DstActiveDOFsData%PS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PS = SrcActiveDOFsData%PS -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PSBE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PSBE,1) - i1_u = UBOUND(SrcActiveDOFsData%PSBE,1) - i2_l = LBOUND(SrcActiveDOFsData%PSBE,2) - i2_u = UBOUND(SrcActiveDOFsData%PSBE,2) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PSBE)) THEN - ALLOCATE(DstActiveDOFsData%PSBE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PSBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PSBE = SrcActiveDOFsData%PSBE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PSE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PSE,1) - i1_u = UBOUND(SrcActiveDOFsData%PSE,1) - i2_l = LBOUND(SrcActiveDOFsData%PSE,2) - i2_u = UBOUND(SrcActiveDOFsData%PSE,2) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PSE)) THEN - ALLOCATE(DstActiveDOFsData%PSE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PSE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PSE = SrcActiveDOFsData%PSE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PUE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PUE,1) - i1_u = UBOUND(SrcActiveDOFsData%PUE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PUE)) THEN - ALLOCATE(DstActiveDOFsData%PUE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PUE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PUE = SrcActiveDOFsData%PUE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PYE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PYE,1) - i1_u = UBOUND(SrcActiveDOFsData%PYE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PYE)) THEN - ALLOCATE(DstActiveDOFsData%PYE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PYE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PYE = SrcActiveDOFsData%PYE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%SrtPS)) THEN - i1_l = LBOUND(SrcActiveDOFsData%SrtPS,1) - i1_u = UBOUND(SrcActiveDOFsData%SrtPS,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%SrtPS)) THEN - ALLOCATE(DstActiveDOFsData%SrtPS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%SrtPS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%SrtPS = SrcActiveDOFsData%SrtPS -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%SrtPSNAUG)) THEN - i1_l = LBOUND(SrcActiveDOFsData%SrtPSNAUG,1) - i1_u = UBOUND(SrcActiveDOFsData%SrtPSNAUG,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%SrtPSNAUG)) THEN - ALLOCATE(DstActiveDOFsData%SrtPSNAUG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%SrtPSNAUG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%SrtPSNAUG = SrcActiveDOFsData%SrtPSNAUG -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%Diag)) THEN - i1_l = LBOUND(SrcActiveDOFsData%Diag,1) - i1_u = UBOUND(SrcActiveDOFsData%Diag,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%Diag)) THEN - ALLOCATE(DstActiveDOFsData%Diag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%Diag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%Diag = SrcActiveDOFsData%Diag -ENDIF - END SUBROUTINE ED_CopyActiveDOFs - - SUBROUTINE ED_DestroyActiveDOFs( ActiveDOFsData, ErrStat, ErrMsg ) - TYPE(ED_ActiveDOFs), INTENT(INOUT) :: ActiveDOFsData - 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 = 'ED_DestroyActiveDOFs' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ActiveDOFsData%NPSBE)) THEN - DEALLOCATE(ActiveDOFsData%NPSBE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%NPSE)) THEN - DEALLOCATE(ActiveDOFsData%NPSE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PCE)) THEN - DEALLOCATE(ActiveDOFsData%PCE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PDE)) THEN - DEALLOCATE(ActiveDOFsData%PDE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PIE)) THEN - DEALLOCATE(ActiveDOFsData%PIE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PTE)) THEN - DEALLOCATE(ActiveDOFsData%PTE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PTTE)) THEN - DEALLOCATE(ActiveDOFsData%PTTE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PS)) THEN - DEALLOCATE(ActiveDOFsData%PS) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PSBE)) THEN - DEALLOCATE(ActiveDOFsData%PSBE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PSE)) THEN - DEALLOCATE(ActiveDOFsData%PSE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PUE)) THEN - DEALLOCATE(ActiveDOFsData%PUE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PYE)) THEN - DEALLOCATE(ActiveDOFsData%PYE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%SrtPS)) THEN - DEALLOCATE(ActiveDOFsData%SrtPS) -ENDIF -IF (ALLOCATED(ActiveDOFsData%SrtPSNAUG)) THEN - DEALLOCATE(ActiveDOFsData%SrtPSNAUG) -ENDIF -IF (ALLOCATED(ActiveDOFsData%Diag)) THEN - DEALLOCATE(ActiveDOFsData%Diag) -ENDIF - END SUBROUTINE ED_DestroyActiveDOFs - - SUBROUTINE ED_PackActiveDOFs( 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(ED_ActiveDOFs), 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 = 'ED_PackActiveDOFs' - ! 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 ! NActvDOF - Int_BufSz = Int_BufSz + 1 ! NPCE - Int_BufSz = Int_BufSz + 1 ! NPDE - Int_BufSz = Int_BufSz + 1 ! NPIE - Int_BufSz = Int_BufSz + 1 ! NPTE - Int_BufSz = Int_BufSz + 1 ! NPTTE - Int_BufSz = Int_BufSz + 1 ! NPSBE allocated yes/no - IF ( ALLOCATED(InData%NPSBE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NPSBE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NPSBE) ! NPSBE - END IF - Int_BufSz = Int_BufSz + 1 ! NPSE allocated yes/no - IF ( ALLOCATED(InData%NPSE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NPSE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NPSE) ! NPSE - END IF - Int_BufSz = Int_BufSz + 1 ! NPUE - Int_BufSz = Int_BufSz + 1 ! NPYE - Int_BufSz = Int_BufSz + 1 ! PCE allocated yes/no - IF ( ALLOCATED(InData%PCE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PCE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PCE) ! PCE - END IF - Int_BufSz = Int_BufSz + 1 ! PDE allocated yes/no - IF ( ALLOCATED(InData%PDE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PDE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PDE) ! PDE - END IF - Int_BufSz = Int_BufSz + 1 ! PIE allocated yes/no - IF ( ALLOCATED(InData%PIE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PIE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PIE) ! PIE - END IF - Int_BufSz = Int_BufSz + 1 ! PTE allocated yes/no - IF ( ALLOCATED(InData%PTE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PTE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PTE) ! PTE - END IF - Int_BufSz = Int_BufSz + 1 ! PTTE allocated yes/no - IF ( ALLOCATED(InData%PTTE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PTTE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PTTE) ! PTTE - END IF - Int_BufSz = Int_BufSz + 1 ! PS allocated yes/no - IF ( ALLOCATED(InData%PS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PS upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PS) ! PS - END IF - Int_BufSz = Int_BufSz + 1 ! PSBE allocated yes/no - IF ( ALLOCATED(InData%PSBE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PSBE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PSBE) ! PSBE - END IF - Int_BufSz = Int_BufSz + 1 ! PSE allocated yes/no - IF ( ALLOCATED(InData%PSE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PSE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PSE) ! PSE - END IF - Int_BufSz = Int_BufSz + 1 ! PUE allocated yes/no - IF ( ALLOCATED(InData%PUE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PUE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PUE) ! PUE - END IF - Int_BufSz = Int_BufSz + 1 ! PYE allocated yes/no - IF ( ALLOCATED(InData%PYE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PYE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PYE) ! PYE - END IF - Int_BufSz = Int_BufSz + 1 ! SrtPS allocated yes/no - IF ( ALLOCATED(InData%SrtPS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SrtPS upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SrtPS) ! SrtPS - END IF - Int_BufSz = Int_BufSz + 1 ! SrtPSNAUG allocated yes/no - IF ( ALLOCATED(InData%SrtPSNAUG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SrtPSNAUG upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SrtPSNAUG) ! SrtPSNAUG - END IF - Int_BufSz = Int_BufSz + 1 ! Diag allocated yes/no - IF ( ALLOCATED(InData%Diag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Diag upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Diag) ! Diag - 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 - - IntKiBuf(Int_Xferred) = InData%NActvDOF - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPCE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPDE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPIE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPTE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPTTE - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NPSBE) ) 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%NPSBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NPSBE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NPSBE,1), UBOUND(InData%NPSBE,1) - IntKiBuf(Int_Xferred) = InData%NPSBE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NPSE) ) 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%NPSE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NPSE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NPSE,1), UBOUND(InData%NPSE,1) - IntKiBuf(Int_Xferred) = InData%NPSE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NPUE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPYE - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PCE) ) 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%PCE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PCE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PCE,1), UBOUND(InData%PCE,1) - IntKiBuf(Int_Xferred) = InData%PCE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PDE) ) 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%PDE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PDE,1), UBOUND(InData%PDE,1) - IntKiBuf(Int_Xferred) = InData%PDE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PIE) ) 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%PIE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PIE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PIE,1), UBOUND(InData%PIE,1) - IntKiBuf(Int_Xferred) = InData%PIE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PTE) ) 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%PTE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PTE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PTE,1), UBOUND(InData%PTE,1) - IntKiBuf(Int_Xferred) = InData%PTE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PTTE) ) 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%PTTE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PTTE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PTTE,1), UBOUND(InData%PTTE,1) - IntKiBuf(Int_Xferred) = InData%PTTE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PS) ) 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%PS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PS,1), UBOUND(InData%PS,1) - IntKiBuf(Int_Xferred) = InData%PS(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PSBE) ) 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%PSBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSBE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PSBE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSBE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PSBE,2), UBOUND(InData%PSBE,2) - DO i1 = LBOUND(InData%PSBE,1), UBOUND(InData%PSBE,1) - IntKiBuf(Int_Xferred) = InData%PSBE(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PSE) ) 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%PSE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PSE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PSE,2), UBOUND(InData%PSE,2) - DO i1 = LBOUND(InData%PSE,1), UBOUND(InData%PSE,1) - IntKiBuf(Int_Xferred) = InData%PSE(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PUE) ) 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%PUE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PUE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PUE,1), UBOUND(InData%PUE,1) - IntKiBuf(Int_Xferred) = InData%PUE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PYE) ) 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%PYE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PYE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PYE,1), UBOUND(InData%PYE,1) - IntKiBuf(Int_Xferred) = InData%PYE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SrtPS) ) 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%SrtPS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SrtPS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SrtPS,1), UBOUND(InData%SrtPS,1) - IntKiBuf(Int_Xferred) = InData%SrtPS(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SrtPSNAUG) ) 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%SrtPSNAUG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SrtPSNAUG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SrtPSNAUG,1), UBOUND(InData%SrtPSNAUG,1) - IntKiBuf(Int_Xferred) = InData%SrtPSNAUG(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Diag) ) 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%Diag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Diag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Diag,1), UBOUND(InData%Diag,1) - IntKiBuf(Int_Xferred) = InData%Diag(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_PackActiveDOFs - - SUBROUTINE ED_UnPackActiveDOFs( 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(ED_ActiveDOFs), 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 = 'ED_UnPackActiveDOFs' - ! 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%NActvDOF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPCE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPDE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPIE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPTE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPTTE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NPSBE 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%NPSBE)) DEALLOCATE(OutData%NPSBE) - ALLOCATE(OutData%NPSBE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NPSBE,1), UBOUND(OutData%NPSBE,1) - OutData%NPSBE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NPSE 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%NPSE)) DEALLOCATE(OutData%NPSE) - ALLOCATE(OutData%NPSE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NPSE,1), UBOUND(OutData%NPSE,1) - OutData%NPSE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NPUE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPYE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PCE 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%PCE)) DEALLOCATE(OutData%PCE) - ALLOCATE(OutData%PCE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PCE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PCE,1), UBOUND(OutData%PCE,1) - OutData%PCE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDE 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%PDE)) DEALLOCATE(OutData%PDE) - ALLOCATE(OutData%PDE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PDE,1), UBOUND(OutData%PDE,1) - OutData%PDE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PIE 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%PIE)) DEALLOCATE(OutData%PIE) - ALLOCATE(OutData%PIE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PIE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PIE,1), UBOUND(OutData%PIE,1) - OutData%PIE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PTE 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%PTE)) DEALLOCATE(OutData%PTE) - ALLOCATE(OutData%PTE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PTE,1), UBOUND(OutData%PTE,1) - OutData%PTE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PTTE 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%PTTE)) DEALLOCATE(OutData%PTTE) - ALLOCATE(OutData%PTTE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PTTE,1), UBOUND(OutData%PTTE,1) - OutData%PTTE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PS 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%PS)) DEALLOCATE(OutData%PS) - ALLOCATE(OutData%PS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PS,1), UBOUND(OutData%PS,1) - OutData%PS(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PSBE 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%PSBE)) DEALLOCATE(OutData%PSBE) - ALLOCATE(OutData%PSBE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PSBE,2), UBOUND(OutData%PSBE,2) - DO i1 = LBOUND(OutData%PSBE,1), UBOUND(OutData%PSBE,1) - OutData%PSBE(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PSE 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%PSE)) DEALLOCATE(OutData%PSE) - ALLOCATE(OutData%PSE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PSE,2), UBOUND(OutData%PSE,2) - DO i1 = LBOUND(OutData%PSE,1), UBOUND(OutData%PSE,1) - OutData%PSE(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PUE 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%PUE)) DEALLOCATE(OutData%PUE) - ALLOCATE(OutData%PUE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PUE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PUE,1), UBOUND(OutData%PUE,1) - OutData%PUE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PYE 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%PYE)) DEALLOCATE(OutData%PYE) - ALLOCATE(OutData%PYE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PYE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PYE,1), UBOUND(OutData%PYE,1) - OutData%PYE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SrtPS 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%SrtPS)) DEALLOCATE(OutData%SrtPS) - ALLOCATE(OutData%SrtPS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SrtPS,1), UBOUND(OutData%SrtPS,1) - OutData%SrtPS(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SrtPSNAUG 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%SrtPSNAUG)) DEALLOCATE(OutData%SrtPSNAUG) - ALLOCATE(OutData%SrtPSNAUG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPSNAUG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SrtPSNAUG,1), UBOUND(OutData%SrtPSNAUG,1) - OutData%SrtPSNAUG(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Diag 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%Diag)) DEALLOCATE(OutData%Diag) - ALLOCATE(OutData%Diag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Diag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Diag,1), UBOUND(OutData%Diag,1) - OutData%Diag(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_UnPackActiveDOFs - - SUBROUTINE ED_CopyRtHndSide( SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_RtHndSide), INTENT(IN) :: SrcRtHndSideData - TYPE(ED_RtHndSide), INTENT(INOUT) :: DstRtHndSideData - 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 = 'ED_CopyRtHndSide' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRtHndSideData%rO = SrcRtHndSideData%rO -IF (ALLOCATED(SrcRtHndSideData%rQS)) THEN - i1_l = LBOUND(SrcRtHndSideData%rQS,1) - i1_u = UBOUND(SrcRtHndSideData%rQS,1) - i2_l = LBOUND(SrcRtHndSideData%rQS,2) - i2_u = UBOUND(SrcRtHndSideData%rQS,2) - i3_l = LBOUND(SrcRtHndSideData%rQS,3) - i3_u = UBOUND(SrcRtHndSideData%rQS,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%rQS)) THEN - ALLOCATE(DstRtHndSideData%rQS(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rQS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rQS = SrcRtHndSideData%rQS -ENDIF -IF (ALLOCATED(SrcRtHndSideData%rS)) THEN - i1_l = LBOUND(SrcRtHndSideData%rS,1) - i1_u = UBOUND(SrcRtHndSideData%rS,1) - i2_l = LBOUND(SrcRtHndSideData%rS,2) - i2_u = UBOUND(SrcRtHndSideData%rS,2) - i3_l = LBOUND(SrcRtHndSideData%rS,3) - i3_u = UBOUND(SrcRtHndSideData%rS,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%rS)) THEN - ALLOCATE(DstRtHndSideData%rS(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rS = SrcRtHndSideData%rS -ENDIF -IF (ALLOCATED(SrcRtHndSideData%rS0S)) THEN - i1_l = LBOUND(SrcRtHndSideData%rS0S,1) - i1_u = UBOUND(SrcRtHndSideData%rS0S,1) - i2_l = LBOUND(SrcRtHndSideData%rS0S,2) - i2_u = UBOUND(SrcRtHndSideData%rS0S,2) - i3_l = LBOUND(SrcRtHndSideData%rS0S,3) - i3_u = UBOUND(SrcRtHndSideData%rS0S,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%rS0S)) THEN - ALLOCATE(DstRtHndSideData%rS0S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rS0S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rS0S = SrcRtHndSideData%rS0S -ENDIF -IF (ALLOCATED(SrcRtHndSideData%rT)) THEN - i1_l = LBOUND(SrcRtHndSideData%rT,1) - i1_u = UBOUND(SrcRtHndSideData%rT,1) - i2_l = LBOUND(SrcRtHndSideData%rT,2) - i2_u = UBOUND(SrcRtHndSideData%rT,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%rT)) THEN - ALLOCATE(DstRtHndSideData%rT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rT = SrcRtHndSideData%rT -ENDIF - DstRtHndSideData%rT0O = SrcRtHndSideData%rT0O -IF (ALLOCATED(SrcRtHndSideData%rT0T)) THEN - i1_l = LBOUND(SrcRtHndSideData%rT0T,1) - i1_u = UBOUND(SrcRtHndSideData%rT0T,1) - i2_l = LBOUND(SrcRtHndSideData%rT0T,2) - i2_u = UBOUND(SrcRtHndSideData%rT0T,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%rT0T)) THEN - ALLOCATE(DstRtHndSideData%rT0T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rT0T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rT0T = SrcRtHndSideData%rT0T -ENDIF - DstRtHndSideData%rZ = SrcRtHndSideData%rZ - DstRtHndSideData%rZO = SrcRtHndSideData%rZO -IF (ALLOCATED(SrcRtHndSideData%rZT)) THEN - i1_l = LBOUND(SrcRtHndSideData%rZT,1) - i1_u = UBOUND(SrcRtHndSideData%rZT,1) - i2_l = LBOUND(SrcRtHndSideData%rZT,2) - i2_u = UBOUND(SrcRtHndSideData%rZT,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%rZT)) THEN - ALLOCATE(DstRtHndSideData%rZT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rZT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rZT = SrcRtHndSideData%rZT -ENDIF - DstRtHndSideData%rPQ = SrcRtHndSideData%rPQ - DstRtHndSideData%rP = SrcRtHndSideData%rP - DstRtHndSideData%rV = SrcRtHndSideData%rV - DstRtHndSideData%rJ = SrcRtHndSideData%rJ - DstRtHndSideData%rZY = SrcRtHndSideData%rZY - DstRtHndSideData%rOU = SrcRtHndSideData%rOU - DstRtHndSideData%rOV = SrcRtHndSideData%rOV - DstRtHndSideData%rVD = SrcRtHndSideData%rVD - DstRtHndSideData%rOW = SrcRtHndSideData%rOW - DstRtHndSideData%rPC = SrcRtHndSideData%rPC -IF (ALLOCATED(SrcRtHndSideData%rPS0)) THEN - i1_l = LBOUND(SrcRtHndSideData%rPS0,1) - i1_u = UBOUND(SrcRtHndSideData%rPS0,1) - i2_l = LBOUND(SrcRtHndSideData%rPS0,2) - i2_u = UBOUND(SrcRtHndSideData%rPS0,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%rPS0)) THEN - ALLOCATE(DstRtHndSideData%rPS0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rPS0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rPS0 = SrcRtHndSideData%rPS0 -ENDIF - DstRtHndSideData%rQ = SrcRtHndSideData%rQ - DstRtHndSideData%rQC = SrcRtHndSideData%rQC - DstRtHndSideData%rVIMU = SrcRtHndSideData%rVIMU - DstRtHndSideData%rVP = SrcRtHndSideData%rVP - DstRtHndSideData%rWI = SrcRtHndSideData%rWI - DstRtHndSideData%rWJ = SrcRtHndSideData%rWJ - DstRtHndSideData%rZT0 = SrcRtHndSideData%rZT0 -IF (ALLOCATED(SrcRtHndSideData%AngPosEF)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngPosEF,1) - i1_u = UBOUND(SrcRtHndSideData%AngPosEF,1) - i2_l = LBOUND(SrcRtHndSideData%AngPosEF,2) - i2_u = UBOUND(SrcRtHndSideData%AngPosEF,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngPosEF)) THEN - ALLOCATE(DstRtHndSideData%AngPosEF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngPosEF = SrcRtHndSideData%AngPosEF -ENDIF -IF (ALLOCATED(SrcRtHndSideData%AngPosXF)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngPosXF,1) - i1_u = UBOUND(SrcRtHndSideData%AngPosXF,1) - i2_l = LBOUND(SrcRtHndSideData%AngPosXF,2) - i2_u = UBOUND(SrcRtHndSideData%AngPosXF,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngPosXF)) THEN - ALLOCATE(DstRtHndSideData%AngPosXF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosXF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngPosXF = SrcRtHndSideData%AngPosXF -ENDIF -IF (ALLOCATED(SrcRtHndSideData%AngPosHM)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngPosHM,1) - i1_u = UBOUND(SrcRtHndSideData%AngPosHM,1) - i2_l = LBOUND(SrcRtHndSideData%AngPosHM,2) - i2_u = UBOUND(SrcRtHndSideData%AngPosHM,2) - i3_l = LBOUND(SrcRtHndSideData%AngPosHM,3) - i3_u = UBOUND(SrcRtHndSideData%AngPosHM,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngPosHM)) THEN - ALLOCATE(DstRtHndSideData%AngPosHM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosHM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngPosHM = SrcRtHndSideData%AngPosHM -ENDIF - DstRtHndSideData%AngPosXB = SrcRtHndSideData%AngPosXB - DstRtHndSideData%AngPosEX = SrcRtHndSideData%AngPosEX -IF (ALLOCATED(SrcRtHndSideData%PAngVelEA)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEA,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEA,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEA,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEA,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEA,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEA,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEA)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEA = SrcRtHndSideData%PAngVelEA -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEF)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEF,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEF,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEF,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEF,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEF,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEF,3) - i4_l = LBOUND(SrcRtHndSideData%PAngVelEF,4) - i4_u = UBOUND(SrcRtHndSideData%PAngVelEF,4) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEF)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEF(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 DstRtHndSideData%PAngVelEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEF = SrcRtHndSideData%PAngVelEF -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEG)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEG,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEG,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEG,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEG,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEG,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEG,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEG)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEG(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEG = SrcRtHndSideData%PAngVelEG -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEH)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEH,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEH,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEH,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEH,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEH,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEH,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEH)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEH(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEH = SrcRtHndSideData%PAngVelEH -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEL)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEL,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEL,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEL,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEL,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEL,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEL,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEL)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEL = SrcRtHndSideData%PAngVelEL -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEM)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEM,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEM,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEM,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEM,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEM,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEM,3) - i4_l = LBOUND(SrcRtHndSideData%PAngVelEM,4) - i4_u = UBOUND(SrcRtHndSideData%PAngVelEM,4) - i5_l = LBOUND(SrcRtHndSideData%PAngVelEM,5) - i5_u = UBOUND(SrcRtHndSideData%PAngVelEM,5) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEM)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEM(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 DstRtHndSideData%PAngVelEM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEM = SrcRtHndSideData%PAngVelEM -ENDIF -IF (ALLOCATED(SrcRtHndSideData%AngVelEM)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngVelEM,1) - i1_u = UBOUND(SrcRtHndSideData%AngVelEM,1) - i2_l = LBOUND(SrcRtHndSideData%AngVelEM,2) - i2_u = UBOUND(SrcRtHndSideData%AngVelEM,2) - i3_l = LBOUND(SrcRtHndSideData%AngVelEM,3) - i3_u = UBOUND(SrcRtHndSideData%AngVelEM,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngVelEM)) THEN - ALLOCATE(DstRtHndSideData%AngVelEM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelEM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngVelEM = SrcRtHndSideData%AngVelEM -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEN)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEN,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEN,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEN,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEN,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEN,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEN,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEN)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEN(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEN = SrcRtHndSideData%PAngVelEN -ENDIF - DstRtHndSideData%AngVelEA = SrcRtHndSideData%AngVelEA -IF (ALLOCATED(SrcRtHndSideData%PAngVelEB)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEB,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEB,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEB,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEB,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEB,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEB,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEB)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEB(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEB = SrcRtHndSideData%PAngVelEB -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelER)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelER,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelER,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelER,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelER,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelER,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelER,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelER)) THEN - ALLOCATE(DstRtHndSideData%PAngVelER(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelER.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelER = SrcRtHndSideData%PAngVelER -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEX)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEX,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEX,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEX,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEX,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEX,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEX,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEX)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEX(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEX = SrcRtHndSideData%PAngVelEX -ENDIF - DstRtHndSideData%AngVelEG = SrcRtHndSideData%AngVelEG - DstRtHndSideData%AngVelEH = SrcRtHndSideData%AngVelEH - DstRtHndSideData%AngVelEL = SrcRtHndSideData%AngVelEL - DstRtHndSideData%AngVelEN = SrcRtHndSideData%AngVelEN - DstRtHndSideData%AngVelEB = SrcRtHndSideData%AngVelEB - DstRtHndSideData%AngVelER = SrcRtHndSideData%AngVelER - DstRtHndSideData%AngVelEX = SrcRtHndSideData%AngVelEX - DstRtHndSideData%TeetAngVel = SrcRtHndSideData%TeetAngVel - DstRtHndSideData%AngAccEBt = SrcRtHndSideData%AngAccEBt - DstRtHndSideData%AngAccERt = SrcRtHndSideData%AngAccERt - DstRtHndSideData%AngAccEXt = SrcRtHndSideData%AngAccEXt -IF (ALLOCATED(SrcRtHndSideData%AngAccEFt)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngAccEFt,1) - i1_u = UBOUND(SrcRtHndSideData%AngAccEFt,1) - i2_l = LBOUND(SrcRtHndSideData%AngAccEFt,2) - i2_u = UBOUND(SrcRtHndSideData%AngAccEFt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngAccEFt)) THEN - ALLOCATE(DstRtHndSideData%AngAccEFt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngAccEFt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngAccEFt = SrcRtHndSideData%AngAccEFt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%AngVelEF)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngVelEF,1) - i1_u = UBOUND(SrcRtHndSideData%AngVelEF,1) - i2_l = LBOUND(SrcRtHndSideData%AngVelEF,2) - i2_u = UBOUND(SrcRtHndSideData%AngVelEF,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngVelEF)) THEN - ALLOCATE(DstRtHndSideData%AngVelEF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngVelEF = SrcRtHndSideData%AngVelEF -ENDIF -IF (ALLOCATED(SrcRtHndSideData%AngVelHM)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngVelHM,1) - i1_u = UBOUND(SrcRtHndSideData%AngVelHM,1) - i2_l = LBOUND(SrcRtHndSideData%AngVelHM,2) - i2_u = UBOUND(SrcRtHndSideData%AngVelHM,2) - i3_l = LBOUND(SrcRtHndSideData%AngVelHM,3) - i3_u = UBOUND(SrcRtHndSideData%AngVelHM,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngVelHM)) THEN - ALLOCATE(DstRtHndSideData%AngVelHM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelHM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngVelHM = SrcRtHndSideData%AngVelHM -ENDIF - DstRtHndSideData%AngAccEAt = SrcRtHndSideData%AngAccEAt - DstRtHndSideData%AngAccEGt = SrcRtHndSideData%AngAccEGt - DstRtHndSideData%AngAccEHt = SrcRtHndSideData%AngAccEHt -IF (ALLOCATED(SrcRtHndSideData%AngAccEKt)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngAccEKt,1) - i1_u = UBOUND(SrcRtHndSideData%AngAccEKt,1) - i2_l = LBOUND(SrcRtHndSideData%AngAccEKt,2) - i2_u = UBOUND(SrcRtHndSideData%AngAccEKt,2) - i3_l = LBOUND(SrcRtHndSideData%AngAccEKt,3) - i3_u = UBOUND(SrcRtHndSideData%AngAccEKt,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngAccEKt)) THEN - ALLOCATE(DstRtHndSideData%AngAccEKt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngAccEKt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngAccEKt = SrcRtHndSideData%AngAccEKt -ENDIF - DstRtHndSideData%AngAccENt = SrcRtHndSideData%AngAccENt - DstRtHndSideData%LinAccECt = SrcRtHndSideData%LinAccECt - DstRtHndSideData%LinAccEDt = SrcRtHndSideData%LinAccEDt - DstRtHndSideData%LinAccEIt = SrcRtHndSideData%LinAccEIt - DstRtHndSideData%LinAccEJt = SrcRtHndSideData%LinAccEJt - DstRtHndSideData%LinAccEUt = SrcRtHndSideData%LinAccEUt - DstRtHndSideData%LinAccEYt = SrcRtHndSideData%LinAccEYt -IF (ALLOCATED(SrcRtHndSideData%LinVelES)) THEN - i1_l = LBOUND(SrcRtHndSideData%LinVelES,1) - i1_u = UBOUND(SrcRtHndSideData%LinVelES,1) - i2_l = LBOUND(SrcRtHndSideData%LinVelES,2) - i2_u = UBOUND(SrcRtHndSideData%LinVelES,2) - i3_l = LBOUND(SrcRtHndSideData%LinVelES,3) - i3_u = UBOUND(SrcRtHndSideData%LinVelES,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%LinVelES)) THEN - ALLOCATE(DstRtHndSideData%LinVelES(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelES.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%LinVelES = SrcRtHndSideData%LinVelES -ENDIF - DstRtHndSideData%LinVelEQ = SrcRtHndSideData%LinVelEQ -IF (ALLOCATED(SrcRtHndSideData%LinVelET)) THEN - i1_l = LBOUND(SrcRtHndSideData%LinVelET,1) - i1_u = UBOUND(SrcRtHndSideData%LinVelET,1) - i2_l = LBOUND(SrcRtHndSideData%LinVelET,2) - i2_u = UBOUND(SrcRtHndSideData%LinVelET,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%LinVelET)) THEN - ALLOCATE(DstRtHndSideData%LinVelET(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelET.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%LinVelET = SrcRtHndSideData%LinVelET -ENDIF -IF (ALLOCATED(SrcRtHndSideData%LinVelESm2)) THEN - i1_l = LBOUND(SrcRtHndSideData%LinVelESm2,1) - i1_u = UBOUND(SrcRtHndSideData%LinVelESm2,1) - IF (.NOT. ALLOCATED(DstRtHndSideData%LinVelESm2)) THEN - ALLOCATE(DstRtHndSideData%LinVelESm2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelESm2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%LinVelESm2 = SrcRtHndSideData%LinVelESm2 -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEIMU)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEIMU,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEIMU,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEIMU,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEIMU,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEIMU,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEIMU,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEIMU)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEIMU(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEIMU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEIMU = SrcRtHndSideData%PLinVelEIMU -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEO)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEO,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEO,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEO,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEO,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEO,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEO,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEO)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEO(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEO.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEO = SrcRtHndSideData%PLinVelEO -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelES)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelES,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelES,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelES,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelES,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelES,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelES,3) - i4_l = LBOUND(SrcRtHndSideData%PLinVelES,4) - i4_u = UBOUND(SrcRtHndSideData%PLinVelES,4) - i5_l = LBOUND(SrcRtHndSideData%PLinVelES,5) - i5_u = UBOUND(SrcRtHndSideData%PLinVelES,5) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelES)) THEN - ALLOCATE(DstRtHndSideData%PLinVelES(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 DstRtHndSideData%PLinVelES.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelES = SrcRtHndSideData%PLinVelES -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelET)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelET,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelET,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelET,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelET,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelET,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelET,3) - i4_l = LBOUND(SrcRtHndSideData%PLinVelET,4) - i4_u = UBOUND(SrcRtHndSideData%PLinVelET,4) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelET)) THEN - ALLOCATE(DstRtHndSideData%PLinVelET(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 DstRtHndSideData%PLinVelET.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelET = SrcRtHndSideData%PLinVelET -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEZ)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEZ,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEZ,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEZ,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEZ,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEZ,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEZ,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEZ)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEZ(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEZ = SrcRtHndSideData%PLinVelEZ -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEC)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEC,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEC,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEC,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEC,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEC,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEC,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEC)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEC = SrcRtHndSideData%PLinVelEC -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelED)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelED,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelED,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelED,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelED,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelED,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelED,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelED)) THEN - ALLOCATE(DstRtHndSideData%PLinVelED(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelED = SrcRtHndSideData%PLinVelED -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEI)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEI,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEI,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEI,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEI,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEI,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEI,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEI)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEI(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEI = SrcRtHndSideData%PLinVelEI -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEJ)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEJ,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEJ,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEJ,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEJ,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEJ,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEJ,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEJ)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEJ(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEJ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEJ = SrcRtHndSideData%PLinVelEJ -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEP)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEP,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEP,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEP,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEP,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEP,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEP,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEP)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEP = SrcRtHndSideData%PLinVelEP -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEQ)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEQ,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEQ,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEQ,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEQ,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEQ,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEQ,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEQ)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEQ(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEQ = SrcRtHndSideData%PLinVelEQ -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEU)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEU,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEU,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEU,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEU,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEU,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEU,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEU)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEU(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEU = SrcRtHndSideData%PLinVelEU -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEV)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEV,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEV,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEV,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEV,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEV,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEV,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEV)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEV(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEV = SrcRtHndSideData%PLinVelEV -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEW)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEW,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEW,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEW,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEW,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEW,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEW,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEW)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEW = SrcRtHndSideData%PLinVelEW -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEY)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEY,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEY,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEY,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEY,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEY,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEY,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEY)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEY(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEY = SrcRtHndSideData%PLinVelEY -ENDIF - DstRtHndSideData%LinAccEIMUt = SrcRtHndSideData%LinAccEIMUt - DstRtHndSideData%LinAccEOt = SrcRtHndSideData%LinAccEOt -IF (ALLOCATED(SrcRtHndSideData%LinAccESt)) THEN - i1_l = LBOUND(SrcRtHndSideData%LinAccESt,1) - i1_u = UBOUND(SrcRtHndSideData%LinAccESt,1) - i2_l = LBOUND(SrcRtHndSideData%LinAccESt,2) - i2_u = UBOUND(SrcRtHndSideData%LinAccESt,2) - i3_l = LBOUND(SrcRtHndSideData%LinAccESt,3) - i3_u = UBOUND(SrcRtHndSideData%LinAccESt,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%LinAccESt)) THEN - ALLOCATE(DstRtHndSideData%LinAccESt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinAccESt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%LinAccESt = SrcRtHndSideData%LinAccESt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%LinAccETt)) THEN - i1_l = LBOUND(SrcRtHndSideData%LinAccETt,1) - i1_u = UBOUND(SrcRtHndSideData%LinAccETt,1) - i2_l = LBOUND(SrcRtHndSideData%LinAccETt,2) - i2_u = UBOUND(SrcRtHndSideData%LinAccETt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%LinAccETt)) THEN - ALLOCATE(DstRtHndSideData%LinAccETt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinAccETt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%LinAccETt = SrcRtHndSideData%LinAccETt -ENDIF - DstRtHndSideData%LinAccEZt = SrcRtHndSideData%LinAccEZt - DstRtHndSideData%LinVelEIMU = SrcRtHndSideData%LinVelEIMU - DstRtHndSideData%LinVelEZ = SrcRtHndSideData%LinVelEZ - DstRtHndSideData%LinVelEO = SrcRtHndSideData%LinVelEO - DstRtHndSideData%LinVelEJ = SrcRtHndSideData%LinVelEJ - DstRtHndSideData%FrcONcRtt = SrcRtHndSideData%FrcONcRtt - DstRtHndSideData%FrcPRott = SrcRtHndSideData%FrcPRott -IF (ALLOCATED(SrcRtHndSideData%FrcS0Bt)) THEN - i1_l = LBOUND(SrcRtHndSideData%FrcS0Bt,1) - i1_u = UBOUND(SrcRtHndSideData%FrcS0Bt,1) - i2_l = LBOUND(SrcRtHndSideData%FrcS0Bt,2) - i2_u = UBOUND(SrcRtHndSideData%FrcS0Bt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%FrcS0Bt)) THEN - ALLOCATE(DstRtHndSideData%FrcS0Bt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FrcS0Bt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%FrcS0Bt = SrcRtHndSideData%FrcS0Bt -ENDIF - DstRtHndSideData%FrcT0Trbt = SrcRtHndSideData%FrcT0Trbt -IF (ALLOCATED(SrcRtHndSideData%FSAero)) THEN - i1_l = LBOUND(SrcRtHndSideData%FSAero,1) - i1_u = UBOUND(SrcRtHndSideData%FSAero,1) - i2_l = LBOUND(SrcRtHndSideData%FSAero,2) - i2_u = UBOUND(SrcRtHndSideData%FSAero,2) - i3_l = LBOUND(SrcRtHndSideData%FSAero,3) - i3_u = UBOUND(SrcRtHndSideData%FSAero,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%FSAero)) THEN - ALLOCATE(DstRtHndSideData%FSAero(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FSAero.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%FSAero = SrcRtHndSideData%FSAero -ENDIF -IF (ALLOCATED(SrcRtHndSideData%FSTipDrag)) THEN - i1_l = LBOUND(SrcRtHndSideData%FSTipDrag,1) - i1_u = UBOUND(SrcRtHndSideData%FSTipDrag,1) - i2_l = LBOUND(SrcRtHndSideData%FSTipDrag,2) - i2_u = UBOUND(SrcRtHndSideData%FSTipDrag,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%FSTipDrag)) THEN - ALLOCATE(DstRtHndSideData%FSTipDrag(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FSTipDrag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%FSTipDrag = SrcRtHndSideData%FSTipDrag -ENDIF -IF (ALLOCATED(SrcRtHndSideData%FTHydrot)) THEN - i1_l = LBOUND(SrcRtHndSideData%FTHydrot,1) - i1_u = UBOUND(SrcRtHndSideData%FTHydrot,1) - i2_l = LBOUND(SrcRtHndSideData%FTHydrot,2) - i2_u = UBOUND(SrcRtHndSideData%FTHydrot,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%FTHydrot)) THEN - ALLOCATE(DstRtHndSideData%FTHydrot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FTHydrot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%FTHydrot = SrcRtHndSideData%FTHydrot -ENDIF - DstRtHndSideData%FZHydrot = SrcRtHndSideData%FZHydrot -IF (ALLOCATED(SrcRtHndSideData%MFHydrot)) THEN - i1_l = LBOUND(SrcRtHndSideData%MFHydrot,1) - i1_u = UBOUND(SrcRtHndSideData%MFHydrot,1) - i2_l = LBOUND(SrcRtHndSideData%MFHydrot,2) - i2_u = UBOUND(SrcRtHndSideData%MFHydrot,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%MFHydrot)) THEN - ALLOCATE(DstRtHndSideData%MFHydrot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MFHydrot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%MFHydrot = SrcRtHndSideData%MFHydrot -ENDIF - DstRtHndSideData%MomBNcRtt = SrcRtHndSideData%MomBNcRtt -IF (ALLOCATED(SrcRtHndSideData%MomH0Bt)) THEN - i1_l = LBOUND(SrcRtHndSideData%MomH0Bt,1) - i1_u = UBOUND(SrcRtHndSideData%MomH0Bt,1) - i2_l = LBOUND(SrcRtHndSideData%MomH0Bt,2) - i2_u = UBOUND(SrcRtHndSideData%MomH0Bt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%MomH0Bt)) THEN - ALLOCATE(DstRtHndSideData%MomH0Bt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MomH0Bt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%MomH0Bt = SrcRtHndSideData%MomH0Bt -ENDIF - DstRtHndSideData%MomLPRott = SrcRtHndSideData%MomLPRott - DstRtHndSideData%MomNGnRtt = SrcRtHndSideData%MomNGnRtt - DstRtHndSideData%MomNTailt = SrcRtHndSideData%MomNTailt - DstRtHndSideData%MomX0Trbt = SrcRtHndSideData%MomX0Trbt -IF (ALLOCATED(SrcRtHndSideData%MMAero)) THEN - i1_l = LBOUND(SrcRtHndSideData%MMAero,1) - i1_u = UBOUND(SrcRtHndSideData%MMAero,1) - i2_l = LBOUND(SrcRtHndSideData%MMAero,2) - i2_u = UBOUND(SrcRtHndSideData%MMAero,2) - i3_l = LBOUND(SrcRtHndSideData%MMAero,3) - i3_u = UBOUND(SrcRtHndSideData%MMAero,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%MMAero)) THEN - ALLOCATE(DstRtHndSideData%MMAero(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MMAero.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%MMAero = SrcRtHndSideData%MMAero -ENDIF - DstRtHndSideData%MXHydrot = SrcRtHndSideData%MXHydrot -IF (ALLOCATED(SrcRtHndSideData%PFrcONcRt)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcONcRt,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcONcRt,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcONcRt,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcONcRt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcONcRt)) THEN - ALLOCATE(DstRtHndSideData%PFrcONcRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcONcRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcONcRt = SrcRtHndSideData%PFrcONcRt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFrcPRot)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcPRot,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcPRot,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcPRot,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcPRot,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcPRot)) THEN - ALLOCATE(DstRtHndSideData%PFrcPRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcPRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcPRot = SrcRtHndSideData%PFrcPRot -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFrcS0B)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcS0B,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcS0B,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcS0B,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcS0B,2) - i3_l = LBOUND(SrcRtHndSideData%PFrcS0B,3) - i3_u = UBOUND(SrcRtHndSideData%PFrcS0B,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcS0B)) THEN - ALLOCATE(DstRtHndSideData%PFrcS0B(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcS0B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcS0B = SrcRtHndSideData%PFrcS0B -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFrcT0Trb)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcT0Trb,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcT0Trb,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcT0Trb,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcT0Trb,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcT0Trb)) THEN - ALLOCATE(DstRtHndSideData%PFrcT0Trb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcT0Trb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcT0Trb = SrcRtHndSideData%PFrcT0Trb -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFTHydro)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFTHydro,1) - i1_u = UBOUND(SrcRtHndSideData%PFTHydro,1) - i2_l = LBOUND(SrcRtHndSideData%PFTHydro,2) - i2_u = UBOUND(SrcRtHndSideData%PFTHydro,2) - i3_l = LBOUND(SrcRtHndSideData%PFTHydro,3) - i3_u = UBOUND(SrcRtHndSideData%PFTHydro,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFTHydro)) THEN - ALLOCATE(DstRtHndSideData%PFTHydro(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFTHydro.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFTHydro = SrcRtHndSideData%PFTHydro -ENDIF - DstRtHndSideData%PFZHydro = SrcRtHndSideData%PFZHydro -IF (ALLOCATED(SrcRtHndSideData%PMFHydro)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMFHydro,1) - i1_u = UBOUND(SrcRtHndSideData%PMFHydro,1) - i2_l = LBOUND(SrcRtHndSideData%PMFHydro,2) - i2_u = UBOUND(SrcRtHndSideData%PMFHydro,2) - i3_l = LBOUND(SrcRtHndSideData%PMFHydro,3) - i3_u = UBOUND(SrcRtHndSideData%PMFHydro,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMFHydro)) THEN - ALLOCATE(DstRtHndSideData%PMFHydro(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMFHydro.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMFHydro = SrcRtHndSideData%PMFHydro -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomBNcRt)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomBNcRt,1) - i1_u = UBOUND(SrcRtHndSideData%PMomBNcRt,1) - i2_l = LBOUND(SrcRtHndSideData%PMomBNcRt,2) - i2_u = UBOUND(SrcRtHndSideData%PMomBNcRt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomBNcRt)) THEN - ALLOCATE(DstRtHndSideData%PMomBNcRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomBNcRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomBNcRt = SrcRtHndSideData%PMomBNcRt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomH0B)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomH0B,1) - i1_u = UBOUND(SrcRtHndSideData%PMomH0B,1) - i2_l = LBOUND(SrcRtHndSideData%PMomH0B,2) - i2_u = UBOUND(SrcRtHndSideData%PMomH0B,2) - i3_l = LBOUND(SrcRtHndSideData%PMomH0B,3) - i3_u = UBOUND(SrcRtHndSideData%PMomH0B,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomH0B)) THEN - ALLOCATE(DstRtHndSideData%PMomH0B(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomH0B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomH0B = SrcRtHndSideData%PMomH0B -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomLPRot)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomLPRot,1) - i1_u = UBOUND(SrcRtHndSideData%PMomLPRot,1) - i2_l = LBOUND(SrcRtHndSideData%PMomLPRot,2) - i2_u = UBOUND(SrcRtHndSideData%PMomLPRot,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomLPRot)) THEN - ALLOCATE(DstRtHndSideData%PMomLPRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomLPRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomLPRot = SrcRtHndSideData%PMomLPRot -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomNGnRt)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomNGnRt,1) - i1_u = UBOUND(SrcRtHndSideData%PMomNGnRt,1) - i2_l = LBOUND(SrcRtHndSideData%PMomNGnRt,2) - i2_u = UBOUND(SrcRtHndSideData%PMomNGnRt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomNGnRt)) THEN - ALLOCATE(DstRtHndSideData%PMomNGnRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomNGnRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomNGnRt = SrcRtHndSideData%PMomNGnRt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomNTail)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomNTail,1) - i1_u = UBOUND(SrcRtHndSideData%PMomNTail,1) - i2_l = LBOUND(SrcRtHndSideData%PMomNTail,2) - i2_u = UBOUND(SrcRtHndSideData%PMomNTail,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomNTail)) THEN - ALLOCATE(DstRtHndSideData%PMomNTail(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomNTail.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomNTail = SrcRtHndSideData%PMomNTail -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomX0Trb)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomX0Trb,1) - i1_u = UBOUND(SrcRtHndSideData%PMomX0Trb,1) - i2_l = LBOUND(SrcRtHndSideData%PMomX0Trb,2) - i2_u = UBOUND(SrcRtHndSideData%PMomX0Trb,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomX0Trb)) THEN - ALLOCATE(DstRtHndSideData%PMomX0Trb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomX0Trb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomX0Trb = SrcRtHndSideData%PMomX0Trb -ENDIF - DstRtHndSideData%PMXHydro = SrcRtHndSideData%PMXHydro - DstRtHndSideData%TeetAng = SrcRtHndSideData%TeetAng - DstRtHndSideData%FrcVGnRtt = SrcRtHndSideData%FrcVGnRtt - DstRtHndSideData%FrcWTailt = SrcRtHndSideData%FrcWTailt - DstRtHndSideData%FrcZAllt = SrcRtHndSideData%FrcZAllt - DstRtHndSideData%MomXAllt = SrcRtHndSideData%MomXAllt -IF (ALLOCATED(SrcRtHndSideData%PFrcVGnRt)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcVGnRt,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcVGnRt,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcVGnRt,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcVGnRt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcVGnRt)) THEN - ALLOCATE(DstRtHndSideData%PFrcVGnRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcVGnRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcVGnRt = SrcRtHndSideData%PFrcVGnRt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFrcWTail)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcWTail,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcWTail,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcWTail,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcWTail,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcWTail)) THEN - ALLOCATE(DstRtHndSideData%PFrcWTail(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcWTail.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcWTail = SrcRtHndSideData%PFrcWTail -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFrcZAll)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcZAll,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcZAll,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcZAll,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcZAll,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcZAll)) THEN - ALLOCATE(DstRtHndSideData%PFrcZAll(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcZAll.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcZAll = SrcRtHndSideData%PFrcZAll -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomXAll)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomXAll,1) - i1_u = UBOUND(SrcRtHndSideData%PMomXAll,1) - i2_l = LBOUND(SrcRtHndSideData%PMomXAll,2) - i2_u = UBOUND(SrcRtHndSideData%PMomXAll,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomXAll)) THEN - ALLOCATE(DstRtHndSideData%PMomXAll(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomXAll.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomXAll = SrcRtHndSideData%PMomXAll -ENDIF - DstRtHndSideData%TeetMom = SrcRtHndSideData%TeetMom - DstRtHndSideData%TFrlMom = SrcRtHndSideData%TFrlMom - DstRtHndSideData%RFrlMom = SrcRtHndSideData%RFrlMom - DstRtHndSideData%GBoxEffFac = SrcRtHndSideData%GBoxEffFac -IF (ALLOCATED(SrcRtHndSideData%rSAerCen)) THEN - i1_l = LBOUND(SrcRtHndSideData%rSAerCen,1) - i1_u = UBOUND(SrcRtHndSideData%rSAerCen,1) - i2_l = LBOUND(SrcRtHndSideData%rSAerCen,2) - i2_u = UBOUND(SrcRtHndSideData%rSAerCen,2) - i3_l = LBOUND(SrcRtHndSideData%rSAerCen,3) - i3_u = UBOUND(SrcRtHndSideData%rSAerCen,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%rSAerCen)) THEN - ALLOCATE(DstRtHndSideData%rSAerCen(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rSAerCen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rSAerCen = SrcRtHndSideData%rSAerCen -ENDIF - END SUBROUTINE ED_CopyRtHndSide - - SUBROUTINE ED_DestroyRtHndSide( RtHndSideData, ErrStat, ErrMsg ) - TYPE(ED_RtHndSide), INTENT(INOUT) :: RtHndSideData - 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 = 'ED_DestroyRtHndSide' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(RtHndSideData%rQS)) THEN - DEALLOCATE(RtHndSideData%rQS) -ENDIF -IF (ALLOCATED(RtHndSideData%rS)) THEN - DEALLOCATE(RtHndSideData%rS) -ENDIF -IF (ALLOCATED(RtHndSideData%rS0S)) THEN - DEALLOCATE(RtHndSideData%rS0S) -ENDIF -IF (ALLOCATED(RtHndSideData%rT)) THEN - DEALLOCATE(RtHndSideData%rT) -ENDIF -IF (ALLOCATED(RtHndSideData%rT0T)) THEN - DEALLOCATE(RtHndSideData%rT0T) -ENDIF -IF (ALLOCATED(RtHndSideData%rZT)) THEN - DEALLOCATE(RtHndSideData%rZT) -ENDIF -IF (ALLOCATED(RtHndSideData%rPS0)) THEN - DEALLOCATE(RtHndSideData%rPS0) -ENDIF -IF (ALLOCATED(RtHndSideData%AngPosEF)) THEN - DEALLOCATE(RtHndSideData%AngPosEF) -ENDIF -IF (ALLOCATED(RtHndSideData%AngPosXF)) THEN - DEALLOCATE(RtHndSideData%AngPosXF) -ENDIF -IF (ALLOCATED(RtHndSideData%AngPosHM)) THEN - DEALLOCATE(RtHndSideData%AngPosHM) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEA)) THEN - DEALLOCATE(RtHndSideData%PAngVelEA) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEF)) THEN - DEALLOCATE(RtHndSideData%PAngVelEF) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEG)) THEN - DEALLOCATE(RtHndSideData%PAngVelEG) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEH)) THEN - DEALLOCATE(RtHndSideData%PAngVelEH) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEL)) THEN - DEALLOCATE(RtHndSideData%PAngVelEL) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEM)) THEN - DEALLOCATE(RtHndSideData%PAngVelEM) -ENDIF -IF (ALLOCATED(RtHndSideData%AngVelEM)) THEN - DEALLOCATE(RtHndSideData%AngVelEM) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEN)) THEN - DEALLOCATE(RtHndSideData%PAngVelEN) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEB)) THEN - DEALLOCATE(RtHndSideData%PAngVelEB) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelER)) THEN - DEALLOCATE(RtHndSideData%PAngVelER) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEX)) THEN - DEALLOCATE(RtHndSideData%PAngVelEX) -ENDIF -IF (ALLOCATED(RtHndSideData%AngAccEFt)) THEN - DEALLOCATE(RtHndSideData%AngAccEFt) -ENDIF -IF (ALLOCATED(RtHndSideData%AngVelEF)) THEN - DEALLOCATE(RtHndSideData%AngVelEF) -ENDIF -IF (ALLOCATED(RtHndSideData%AngVelHM)) THEN - DEALLOCATE(RtHndSideData%AngVelHM) -ENDIF -IF (ALLOCATED(RtHndSideData%AngAccEKt)) THEN - DEALLOCATE(RtHndSideData%AngAccEKt) -ENDIF -IF (ALLOCATED(RtHndSideData%LinVelES)) THEN - DEALLOCATE(RtHndSideData%LinVelES) -ENDIF -IF (ALLOCATED(RtHndSideData%LinVelET)) THEN - DEALLOCATE(RtHndSideData%LinVelET) -ENDIF -IF (ALLOCATED(RtHndSideData%LinVelESm2)) THEN - DEALLOCATE(RtHndSideData%LinVelESm2) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEIMU)) THEN - DEALLOCATE(RtHndSideData%PLinVelEIMU) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEO)) THEN - DEALLOCATE(RtHndSideData%PLinVelEO) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelES)) THEN - DEALLOCATE(RtHndSideData%PLinVelES) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelET)) THEN - DEALLOCATE(RtHndSideData%PLinVelET) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEZ)) THEN - DEALLOCATE(RtHndSideData%PLinVelEZ) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEC)) THEN - DEALLOCATE(RtHndSideData%PLinVelEC) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelED)) THEN - DEALLOCATE(RtHndSideData%PLinVelED) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEI)) THEN - DEALLOCATE(RtHndSideData%PLinVelEI) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEJ)) THEN - DEALLOCATE(RtHndSideData%PLinVelEJ) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEP)) THEN - DEALLOCATE(RtHndSideData%PLinVelEP) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEQ)) THEN - DEALLOCATE(RtHndSideData%PLinVelEQ) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEU)) THEN - DEALLOCATE(RtHndSideData%PLinVelEU) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEV)) THEN - DEALLOCATE(RtHndSideData%PLinVelEV) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEW)) THEN - DEALLOCATE(RtHndSideData%PLinVelEW) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEY)) THEN - DEALLOCATE(RtHndSideData%PLinVelEY) -ENDIF -IF (ALLOCATED(RtHndSideData%LinAccESt)) THEN - DEALLOCATE(RtHndSideData%LinAccESt) -ENDIF -IF (ALLOCATED(RtHndSideData%LinAccETt)) THEN - DEALLOCATE(RtHndSideData%LinAccETt) -ENDIF -IF (ALLOCATED(RtHndSideData%FrcS0Bt)) THEN - DEALLOCATE(RtHndSideData%FrcS0Bt) -ENDIF -IF (ALLOCATED(RtHndSideData%FSAero)) THEN - DEALLOCATE(RtHndSideData%FSAero) -ENDIF -IF (ALLOCATED(RtHndSideData%FSTipDrag)) THEN - DEALLOCATE(RtHndSideData%FSTipDrag) -ENDIF -IF (ALLOCATED(RtHndSideData%FTHydrot)) THEN - DEALLOCATE(RtHndSideData%FTHydrot) -ENDIF -IF (ALLOCATED(RtHndSideData%MFHydrot)) THEN - DEALLOCATE(RtHndSideData%MFHydrot) -ENDIF -IF (ALLOCATED(RtHndSideData%MomH0Bt)) THEN - DEALLOCATE(RtHndSideData%MomH0Bt) -ENDIF -IF (ALLOCATED(RtHndSideData%MMAero)) THEN - DEALLOCATE(RtHndSideData%MMAero) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcONcRt)) THEN - DEALLOCATE(RtHndSideData%PFrcONcRt) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcPRot)) THEN - DEALLOCATE(RtHndSideData%PFrcPRot) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcS0B)) THEN - DEALLOCATE(RtHndSideData%PFrcS0B) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcT0Trb)) THEN - DEALLOCATE(RtHndSideData%PFrcT0Trb) -ENDIF -IF (ALLOCATED(RtHndSideData%PFTHydro)) THEN - DEALLOCATE(RtHndSideData%PFTHydro) -ENDIF -IF (ALLOCATED(RtHndSideData%PMFHydro)) THEN - DEALLOCATE(RtHndSideData%PMFHydro) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomBNcRt)) THEN - DEALLOCATE(RtHndSideData%PMomBNcRt) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomH0B)) THEN - DEALLOCATE(RtHndSideData%PMomH0B) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomLPRot)) THEN - DEALLOCATE(RtHndSideData%PMomLPRot) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomNGnRt)) THEN - DEALLOCATE(RtHndSideData%PMomNGnRt) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomNTail)) THEN - DEALLOCATE(RtHndSideData%PMomNTail) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomX0Trb)) THEN - DEALLOCATE(RtHndSideData%PMomX0Trb) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcVGnRt)) THEN - DEALLOCATE(RtHndSideData%PFrcVGnRt) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcWTail)) THEN - DEALLOCATE(RtHndSideData%PFrcWTail) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcZAll)) THEN - DEALLOCATE(RtHndSideData%PFrcZAll) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomXAll)) THEN - DEALLOCATE(RtHndSideData%PMomXAll) -ENDIF -IF (ALLOCATED(RtHndSideData%rSAerCen)) THEN - DEALLOCATE(RtHndSideData%rSAerCen) -ENDIF - END SUBROUTINE ED_DestroyRtHndSide - - SUBROUTINE ED_PackRtHndSide( 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(ED_RtHndSide), 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 = 'ED_PackRtHndSide' - ! 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 + SIZE(InData%rO) ! rO - Int_BufSz = Int_BufSz + 1 ! rQS allocated yes/no - IF ( ALLOCATED(InData%rQS) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rQS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rQS) ! rQS - END IF - Int_BufSz = Int_BufSz + 1 ! rS allocated yes/no - IF ( ALLOCATED(InData%rS) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rS) ! rS - END IF - Int_BufSz = Int_BufSz + 1 ! rS0S allocated yes/no - IF ( ALLOCATED(InData%rS0S) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rS0S upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rS0S) ! rS0S - END IF - Int_BufSz = Int_BufSz + 1 ! rT allocated yes/no - IF ( ALLOCATED(InData%rT) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rT upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rT) ! rT - END IF - Db_BufSz = Db_BufSz + SIZE(InData%rT0O) ! rT0O - Int_BufSz = Int_BufSz + 1 ! rT0T allocated yes/no - IF ( ALLOCATED(InData%rT0T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rT0T upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rT0T) ! rT0T - END IF - Db_BufSz = Db_BufSz + SIZE(InData%rZ) ! rZ - Db_BufSz = Db_BufSz + SIZE(InData%rZO) ! rZO - Int_BufSz = Int_BufSz + 1 ! rZT allocated yes/no - IF ( ALLOCATED(InData%rZT) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rZT upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rZT) ! rZT - END IF - Db_BufSz = Db_BufSz + SIZE(InData%rPQ) ! rPQ - Db_BufSz = Db_BufSz + SIZE(InData%rP) ! rP - Db_BufSz = Db_BufSz + SIZE(InData%rV) ! rV - Db_BufSz = Db_BufSz + SIZE(InData%rJ) ! rJ - Db_BufSz = Db_BufSz + SIZE(InData%rZY) ! rZY - Db_BufSz = Db_BufSz + SIZE(InData%rOU) ! rOU - Db_BufSz = Db_BufSz + SIZE(InData%rOV) ! rOV - Db_BufSz = Db_BufSz + SIZE(InData%rVD) ! rVD - Db_BufSz = Db_BufSz + SIZE(InData%rOW) ! rOW - Db_BufSz = Db_BufSz + SIZE(InData%rPC) ! rPC - Int_BufSz = Int_BufSz + 1 ! rPS0 allocated yes/no - IF ( ALLOCATED(InData%rPS0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rPS0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rPS0) ! rPS0 - END IF - Db_BufSz = Db_BufSz + SIZE(InData%rQ) ! rQ - Db_BufSz = Db_BufSz + SIZE(InData%rQC) ! rQC - Db_BufSz = Db_BufSz + SIZE(InData%rVIMU) ! rVIMU - Db_BufSz = Db_BufSz + SIZE(InData%rVP) ! rVP - Db_BufSz = Db_BufSz + SIZE(InData%rWI) ! rWI - Db_BufSz = Db_BufSz + SIZE(InData%rWJ) ! rWJ - Db_BufSz = Db_BufSz + SIZE(InData%rZT0) ! rZT0 - Int_BufSz = Int_BufSz + 1 ! AngPosEF allocated yes/no - IF ( ALLOCATED(InData%AngPosEF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AngPosEF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngPosEF) ! AngPosEF - END IF - Int_BufSz = Int_BufSz + 1 ! AngPosXF allocated yes/no - IF ( ALLOCATED(InData%AngPosXF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AngPosXF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngPosXF) ! AngPosXF - END IF - Int_BufSz = Int_BufSz + 1 ! AngPosHM allocated yes/no - IF ( ALLOCATED(InData%AngPosHM) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AngPosHM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngPosHM) ! AngPosHM - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AngPosXB) ! AngPosXB - Re_BufSz = Re_BufSz + SIZE(InData%AngPosEX) ! AngPosEX - Int_BufSz = Int_BufSz + 1 ! PAngVelEA allocated yes/no - IF ( ALLOCATED(InData%PAngVelEA) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEA) ! PAngVelEA - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEF allocated yes/no - IF ( ALLOCATED(InData%PAngVelEF) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PAngVelEF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEF) ! PAngVelEF - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEG allocated yes/no - IF ( ALLOCATED(InData%PAngVelEG) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEG) ! PAngVelEG - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEH allocated yes/no - IF ( ALLOCATED(InData%PAngVelEH) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEH) ! PAngVelEH - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEL allocated yes/no - IF ( ALLOCATED(InData%PAngVelEL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEL) ! PAngVelEL - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEM allocated yes/no - IF ( ALLOCATED(InData%PAngVelEM) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! PAngVelEM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEM) ! PAngVelEM - END IF - Int_BufSz = Int_BufSz + 1 ! AngVelEM allocated yes/no - IF ( ALLOCATED(InData%AngVelEM) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AngVelEM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEM) ! AngVelEM - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEN allocated yes/no - IF ( ALLOCATED(InData%PAngVelEN) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEN) ! PAngVelEN - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEA) ! AngVelEA - Int_BufSz = Int_BufSz + 1 ! PAngVelEB allocated yes/no - IF ( ALLOCATED(InData%PAngVelEB) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEB) ! PAngVelEB - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelER allocated yes/no - IF ( ALLOCATED(InData%PAngVelER) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelER upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelER) ! PAngVelER - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEX allocated yes/no - IF ( ALLOCATED(InData%PAngVelEX) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEX) ! PAngVelEX - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEG) ! AngVelEG - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEH) ! AngVelEH - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEL) ! AngVelEL - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEN) ! AngVelEN - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEB) ! AngVelEB - Re_BufSz = Re_BufSz + SIZE(InData%AngVelER) ! AngVelER - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEX) ! AngVelEX - Db_BufSz = Db_BufSz + 1 ! TeetAngVel - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEBt) ! AngAccEBt - Re_BufSz = Re_BufSz + SIZE(InData%AngAccERt) ! AngAccERt - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEXt) ! AngAccEXt - Int_BufSz = Int_BufSz + 1 ! AngAccEFt allocated yes/no - IF ( ALLOCATED(InData%AngAccEFt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AngAccEFt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEFt) ! AngAccEFt - END IF - Int_BufSz = Int_BufSz + 1 ! AngVelEF allocated yes/no - IF ( ALLOCATED(InData%AngVelEF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AngVelEF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEF) ! AngVelEF - END IF - Int_BufSz = Int_BufSz + 1 ! AngVelHM allocated yes/no - IF ( ALLOCATED(InData%AngVelHM) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AngVelHM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngVelHM) ! AngVelHM - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEAt) ! AngAccEAt - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEGt) ! AngAccEGt - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEHt) ! AngAccEHt - Int_BufSz = Int_BufSz + 1 ! AngAccEKt allocated yes/no - IF ( ALLOCATED(InData%AngAccEKt) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AngAccEKt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEKt) ! AngAccEKt - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AngAccENt) ! AngAccENt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccECt) ! LinAccECt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEDt) ! LinAccEDt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEIt) ! LinAccEIt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEJt) ! LinAccEJt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEUt) ! LinAccEUt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEYt) ! LinAccEYt - Int_BufSz = Int_BufSz + 1 ! LinVelES allocated yes/no - IF ( ALLOCATED(InData%LinVelES) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! LinVelES upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinVelES) ! LinVelES - END IF - Re_BufSz = Re_BufSz + SIZE(InData%LinVelEQ) ! LinVelEQ - Int_BufSz = Int_BufSz + 1 ! LinVelET allocated yes/no - IF ( ALLOCATED(InData%LinVelET) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LinVelET upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinVelET) ! LinVelET - END IF - Int_BufSz = Int_BufSz + 1 ! LinVelESm2 allocated yes/no - IF ( ALLOCATED(InData%LinVelESm2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinVelESm2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinVelESm2) ! LinVelESm2 - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEIMU allocated yes/no - IF ( ALLOCATED(InData%PLinVelEIMU) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEIMU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEIMU) ! PLinVelEIMU - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEO allocated yes/no - IF ( ALLOCATED(InData%PLinVelEO) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEO upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEO) ! PLinVelEO - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelES allocated yes/no - IF ( ALLOCATED(InData%PLinVelES) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! PLinVelES upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelES) ! PLinVelES - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelET allocated yes/no - IF ( ALLOCATED(InData%PLinVelET) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PLinVelET upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelET) ! PLinVelET - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEZ allocated yes/no - IF ( ALLOCATED(InData%PLinVelEZ) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEZ) ! PLinVelEZ - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEC allocated yes/no - IF ( ALLOCATED(InData%PLinVelEC) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEC) ! PLinVelEC - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelED allocated yes/no - IF ( ALLOCATED(InData%PLinVelED) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelED upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelED) ! PLinVelED - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEI allocated yes/no - IF ( ALLOCATED(InData%PLinVelEI) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEI) ! PLinVelEI - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEJ allocated yes/no - IF ( ALLOCATED(InData%PLinVelEJ) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEJ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEJ) ! PLinVelEJ - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEP allocated yes/no - IF ( ALLOCATED(InData%PLinVelEP) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEP) ! PLinVelEP - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEQ allocated yes/no - IF ( ALLOCATED(InData%PLinVelEQ) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEQ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEQ) ! PLinVelEQ - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEU allocated yes/no - IF ( ALLOCATED(InData%PLinVelEU) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEU) ! PLinVelEU - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEV allocated yes/no - IF ( ALLOCATED(InData%PLinVelEV) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEV) ! PLinVelEV - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEW allocated yes/no - IF ( ALLOCATED(InData%PLinVelEW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEW) ! PLinVelEW - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEY allocated yes/no - IF ( ALLOCATED(InData%PLinVelEY) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEY) ! PLinVelEY - END IF - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEIMUt) ! LinAccEIMUt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEOt) ! LinAccEOt - Int_BufSz = Int_BufSz + 1 ! LinAccESt allocated yes/no - IF ( ALLOCATED(InData%LinAccESt) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! LinAccESt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinAccESt) ! LinAccESt - END IF - Int_BufSz = Int_BufSz + 1 ! LinAccETt allocated yes/no - IF ( ALLOCATED(InData%LinAccETt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LinAccETt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinAccETt) ! LinAccETt - END IF - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEZt) ! LinAccEZt - Re_BufSz = Re_BufSz + SIZE(InData%LinVelEIMU) ! LinVelEIMU - Re_BufSz = Re_BufSz + SIZE(InData%LinVelEZ) ! LinVelEZ - Re_BufSz = Re_BufSz + SIZE(InData%LinVelEO) ! LinVelEO - Re_BufSz = Re_BufSz + SIZE(InData%LinVelEJ) ! LinVelEJ - Re_BufSz = Re_BufSz + SIZE(InData%FrcONcRtt) ! FrcONcRtt - Re_BufSz = Re_BufSz + SIZE(InData%FrcPRott) ! FrcPRott - Int_BufSz = Int_BufSz + 1 ! FrcS0Bt allocated yes/no - IF ( ALLOCATED(InData%FrcS0Bt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FrcS0Bt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FrcS0Bt) ! FrcS0Bt - END IF - Re_BufSz = Re_BufSz + SIZE(InData%FrcT0Trbt) ! FrcT0Trbt - Int_BufSz = Int_BufSz + 1 ! FSAero allocated yes/no - IF ( ALLOCATED(InData%FSAero) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! FSAero upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSAero) ! FSAero - END IF - Int_BufSz = Int_BufSz + 1 ! FSTipDrag allocated yes/no - IF ( ALLOCATED(InData%FSTipDrag) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FSTipDrag upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSTipDrag) ! FSTipDrag - END IF - Int_BufSz = Int_BufSz + 1 ! FTHydrot allocated yes/no - IF ( ALLOCATED(InData%FTHydrot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FTHydrot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FTHydrot) ! FTHydrot - END IF - Re_BufSz = Re_BufSz + SIZE(InData%FZHydrot) ! FZHydrot - Int_BufSz = Int_BufSz + 1 ! MFHydrot allocated yes/no - IF ( ALLOCATED(InData%MFHydrot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MFHydrot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MFHydrot) ! MFHydrot - END IF - Re_BufSz = Re_BufSz + SIZE(InData%MomBNcRtt) ! MomBNcRtt - Int_BufSz = Int_BufSz + 1 ! MomH0Bt allocated yes/no - IF ( ALLOCATED(InData%MomH0Bt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MomH0Bt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MomH0Bt) ! MomH0Bt - END IF - Re_BufSz = Re_BufSz + SIZE(InData%MomLPRott) ! MomLPRott - Re_BufSz = Re_BufSz + SIZE(InData%MomNGnRtt) ! MomNGnRtt - Re_BufSz = Re_BufSz + SIZE(InData%MomNTailt) ! MomNTailt - Re_BufSz = Re_BufSz + SIZE(InData%MomX0Trbt) ! MomX0Trbt - Int_BufSz = Int_BufSz + 1 ! MMAero allocated yes/no - IF ( ALLOCATED(InData%MMAero) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! MMAero upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MMAero) ! MMAero - END IF - Re_BufSz = Re_BufSz + SIZE(InData%MXHydrot) ! MXHydrot - Int_BufSz = Int_BufSz + 1 ! PFrcONcRt allocated yes/no - IF ( ALLOCATED(InData%PFrcONcRt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcONcRt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcONcRt) ! PFrcONcRt - END IF - Int_BufSz = Int_BufSz + 1 ! PFrcPRot allocated yes/no - IF ( ALLOCATED(InData%PFrcPRot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcPRot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcPRot) ! PFrcPRot - END IF - Int_BufSz = Int_BufSz + 1 ! PFrcS0B allocated yes/no - IF ( ALLOCATED(InData%PFrcS0B) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PFrcS0B upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcS0B) ! PFrcS0B - END IF - Int_BufSz = Int_BufSz + 1 ! PFrcT0Trb allocated yes/no - IF ( ALLOCATED(InData%PFrcT0Trb) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcT0Trb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcT0Trb) ! PFrcT0Trb - END IF - Int_BufSz = Int_BufSz + 1 ! PFTHydro allocated yes/no - IF ( ALLOCATED(InData%PFTHydro) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PFTHydro upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFTHydro) ! PFTHydro - END IF - Re_BufSz = Re_BufSz + SIZE(InData%PFZHydro) ! PFZHydro - Int_BufSz = Int_BufSz + 1 ! PMFHydro allocated yes/no - IF ( ALLOCATED(InData%PMFHydro) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PMFHydro upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMFHydro) ! PMFHydro - END IF - Int_BufSz = Int_BufSz + 1 ! PMomBNcRt allocated yes/no - IF ( ALLOCATED(InData%PMomBNcRt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomBNcRt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomBNcRt) ! PMomBNcRt - END IF - Int_BufSz = Int_BufSz + 1 ! PMomH0B allocated yes/no - IF ( ALLOCATED(InData%PMomH0B) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PMomH0B upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomH0B) ! PMomH0B - END IF - Int_BufSz = Int_BufSz + 1 ! PMomLPRot allocated yes/no - IF ( ALLOCATED(InData%PMomLPRot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomLPRot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomLPRot) ! PMomLPRot - END IF - Int_BufSz = Int_BufSz + 1 ! PMomNGnRt allocated yes/no - IF ( ALLOCATED(InData%PMomNGnRt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomNGnRt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomNGnRt) ! PMomNGnRt - END IF - Int_BufSz = Int_BufSz + 1 ! PMomNTail allocated yes/no - IF ( ALLOCATED(InData%PMomNTail) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomNTail upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomNTail) ! PMomNTail - END IF - Int_BufSz = Int_BufSz + 1 ! PMomX0Trb allocated yes/no - IF ( ALLOCATED(InData%PMomX0Trb) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomX0Trb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomX0Trb) ! PMomX0Trb - END IF - Re_BufSz = Re_BufSz + SIZE(InData%PMXHydro) ! PMXHydro - Db_BufSz = Db_BufSz + 1 ! TeetAng - Re_BufSz = Re_BufSz + SIZE(InData%FrcVGnRtt) ! FrcVGnRtt - Re_BufSz = Re_BufSz + SIZE(InData%FrcWTailt) ! FrcWTailt - Re_BufSz = Re_BufSz + SIZE(InData%FrcZAllt) ! FrcZAllt - Re_BufSz = Re_BufSz + SIZE(InData%MomXAllt) ! MomXAllt - Int_BufSz = Int_BufSz + 1 ! PFrcVGnRt allocated yes/no - IF ( ALLOCATED(InData%PFrcVGnRt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcVGnRt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcVGnRt) ! PFrcVGnRt - END IF - Int_BufSz = Int_BufSz + 1 ! PFrcWTail allocated yes/no - IF ( ALLOCATED(InData%PFrcWTail) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcWTail upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcWTail) ! PFrcWTail - END IF - Int_BufSz = Int_BufSz + 1 ! PFrcZAll allocated yes/no - IF ( ALLOCATED(InData%PFrcZAll) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcZAll upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcZAll) ! PFrcZAll - END IF - Int_BufSz = Int_BufSz + 1 ! PMomXAll allocated yes/no - IF ( ALLOCATED(InData%PMomXAll) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomXAll upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomXAll) ! PMomXAll - END IF - Re_BufSz = Re_BufSz + 1 ! TeetMom - Re_BufSz = Re_BufSz + 1 ! TFrlMom - Re_BufSz = Re_BufSz + 1 ! RFrlMom - Re_BufSz = Re_BufSz + 1 ! GBoxEffFac - Int_BufSz = Int_BufSz + 1 ! rSAerCen allocated yes/no - IF ( ALLOCATED(InData%rSAerCen) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rSAerCen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rSAerCen) ! rSAerCen - 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 i1 = LBOUND(InData%rO,1), UBOUND(InData%rO,1) - DbKiBuf(Db_Xferred) = InData%rO(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%rQS) ) 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%rQS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rQS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rQS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rQS,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rQS,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rQS,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rQS,3), UBOUND(InData%rQS,3) - DO i2 = LBOUND(InData%rQS,2), UBOUND(InData%rQS,2) - DO i1 = LBOUND(InData%rQS,1), UBOUND(InData%rQS,1) - DbKiBuf(Db_Xferred) = InData%rQS(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rS) ) 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%rS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rS,3), UBOUND(InData%rS,3) - DO i2 = LBOUND(InData%rS,2), UBOUND(InData%rS,2) - DO i1 = LBOUND(InData%rS,1), UBOUND(InData%rS,1) - DbKiBuf(Db_Xferred) = InData%rS(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rS0S) ) 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%rS0S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS0S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS0S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS0S,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS0S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS0S,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rS0S,3), UBOUND(InData%rS0S,3) - DO i2 = LBOUND(InData%rS0S,2), UBOUND(InData%rS0S,2) - DO i1 = LBOUND(InData%rS0S,1), UBOUND(InData%rS0S,1) - DbKiBuf(Db_Xferred) = InData%rS0S(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rT) ) 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%rT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rT,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rT,2), UBOUND(InData%rT,2) - DO i1 = LBOUND(InData%rT,1), UBOUND(InData%rT,1) - DbKiBuf(Db_Xferred) = InData%rT(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%rT0O,1), UBOUND(InData%rT0O,1) - DbKiBuf(Db_Xferred) = InData%rT0O(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%rT0T) ) 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%rT0T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT0T,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rT0T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT0T,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rT0T,2), UBOUND(InData%rT0T,2) - DO i1 = LBOUND(InData%rT0T,1), UBOUND(InData%rT0T,1) - DbKiBuf(Db_Xferred) = InData%rT0T(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%rZ,1), UBOUND(InData%rZ,1) - DbKiBuf(Db_Xferred) = InData%rZ(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rZO,1), UBOUND(InData%rZO,1) - DbKiBuf(Db_Xferred) = InData%rZO(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%rZT) ) 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%rZT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rZT,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rZT,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rZT,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rZT,2), UBOUND(InData%rZT,2) - DO i1 = LBOUND(InData%rZT,1), UBOUND(InData%rZT,1) - DbKiBuf(Db_Xferred) = InData%rZT(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%rPQ,1), UBOUND(InData%rPQ,1) - DbKiBuf(Db_Xferred) = InData%rPQ(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rP,1), UBOUND(InData%rP,1) - DbKiBuf(Db_Xferred) = InData%rP(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rV,1), UBOUND(InData%rV,1) - DbKiBuf(Db_Xferred) = InData%rV(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rJ,1), UBOUND(InData%rJ,1) - DbKiBuf(Db_Xferred) = InData%rJ(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rZY,1), UBOUND(InData%rZY,1) - DbKiBuf(Db_Xferred) = InData%rZY(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rOU,1), UBOUND(InData%rOU,1) - DbKiBuf(Db_Xferred) = InData%rOU(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rOV,1), UBOUND(InData%rOV,1) - DbKiBuf(Db_Xferred) = InData%rOV(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rVD,1), UBOUND(InData%rVD,1) - DbKiBuf(Db_Xferred) = InData%rVD(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rOW,1), UBOUND(InData%rOW,1) - DbKiBuf(Db_Xferred) = InData%rOW(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rPC,1), UBOUND(InData%rPC,1) - DbKiBuf(Db_Xferred) = InData%rPC(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%rPS0) ) 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%rPS0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rPS0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rPS0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rPS0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rPS0,2), UBOUND(InData%rPS0,2) - DO i1 = LBOUND(InData%rPS0,1), UBOUND(InData%rPS0,1) - DbKiBuf(Db_Xferred) = InData%rPS0(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%rQ,1), UBOUND(InData%rQ,1) - DbKiBuf(Db_Xferred) = InData%rQ(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rQC,1), UBOUND(InData%rQC,1) - DbKiBuf(Db_Xferred) = InData%rQC(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rVIMU,1), UBOUND(InData%rVIMU,1) - DbKiBuf(Db_Xferred) = InData%rVIMU(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rVP,1), UBOUND(InData%rVP,1) - DbKiBuf(Db_Xferred) = InData%rVP(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rWI,1), UBOUND(InData%rWI,1) - DbKiBuf(Db_Xferred) = InData%rWI(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rWJ,1), UBOUND(InData%rWJ,1) - DbKiBuf(Db_Xferred) = InData%rWJ(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rZT0,1), UBOUND(InData%rZT0,1) - DbKiBuf(Db_Xferred) = InData%rZT0(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%AngPosEF) ) 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%AngPosEF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosEF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosEF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosEF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AngPosEF,2), UBOUND(InData%AngPosEF,2) - DO i1 = LBOUND(InData%AngPosEF,1), UBOUND(InData%AngPosEF,1) - ReKiBuf(Re_Xferred) = InData%AngPosEF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngPosXF) ) 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%AngPosXF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosXF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosXF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosXF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AngPosXF,2), UBOUND(InData%AngPosXF,2) - DO i1 = LBOUND(InData%AngPosXF,1), UBOUND(InData%AngPosXF,1) - ReKiBuf(Re_Xferred) = InData%AngPosXF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngPosHM) ) 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%AngPosHM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosHM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosHM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosHM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosHM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosHM,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AngPosHM,3), UBOUND(InData%AngPosHM,3) - DO i2 = LBOUND(InData%AngPosHM,2), UBOUND(InData%AngPosHM,2) - DO i1 = LBOUND(InData%AngPosHM,1), UBOUND(InData%AngPosHM,1) - ReKiBuf(Re_Xferred) = InData%AngPosHM(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%AngPosXB,1), UBOUND(InData%AngPosXB,1) - ReKiBuf(Re_Xferred) = InData%AngPosXB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngPosEX,1), UBOUND(InData%AngPosEX,1) - ReKiBuf(Re_Xferred) = InData%AngPosEX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%PAngVelEA) ) 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%PAngVelEA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEA,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEA,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEA,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEA,3), UBOUND(InData%PAngVelEA,3) - DO i2 = LBOUND(InData%PAngVelEA,2), UBOUND(InData%PAngVelEA,2) - DO i1 = LBOUND(InData%PAngVelEA,1), UBOUND(InData%PAngVelEA,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEA(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEF) ) 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%PAngVelEF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEF,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEF,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEF,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PAngVelEF,4), UBOUND(InData%PAngVelEF,4) - DO i3 = LBOUND(InData%PAngVelEF,3), UBOUND(InData%PAngVelEF,3) - DO i2 = LBOUND(InData%PAngVelEF,2), UBOUND(InData%PAngVelEF,2) - DO i1 = LBOUND(InData%PAngVelEF,1), UBOUND(InData%PAngVelEF,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEF(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEG) ) 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%PAngVelEG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEG,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEG,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEG,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEG,3), UBOUND(InData%PAngVelEG,3) - DO i2 = LBOUND(InData%PAngVelEG,2), UBOUND(InData%PAngVelEG,2) - DO i1 = LBOUND(InData%PAngVelEG,1), UBOUND(InData%PAngVelEG,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEG(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEH) ) 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%PAngVelEH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEH,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEH,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEH,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEH,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEH,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEH,3), UBOUND(InData%PAngVelEH,3) - DO i2 = LBOUND(InData%PAngVelEH,2), UBOUND(InData%PAngVelEH,2) - DO i1 = LBOUND(InData%PAngVelEH,1), UBOUND(InData%PAngVelEH,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEH(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEL) ) 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%PAngVelEL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEL,3), UBOUND(InData%PAngVelEL,3) - DO i2 = LBOUND(InData%PAngVelEL,2), UBOUND(InData%PAngVelEL,2) - DO i1 = LBOUND(InData%PAngVelEL,1), UBOUND(InData%PAngVelEL,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEM) ) 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%PAngVelEM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEM,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEM,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%PAngVelEM,5), UBOUND(InData%PAngVelEM,5) - DO i4 = LBOUND(InData%PAngVelEM,4), UBOUND(InData%PAngVelEM,4) - DO i3 = LBOUND(InData%PAngVelEM,3), UBOUND(InData%PAngVelEM,3) - DO i2 = LBOUND(InData%PAngVelEM,2), UBOUND(InData%PAngVelEM,2) - DO i1 = LBOUND(InData%PAngVelEM,1), UBOUND(InData%PAngVelEM,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEM(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%AngVelEM) ) 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%AngVelEM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelEM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelEM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEM,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AngVelEM,3), UBOUND(InData%AngVelEM,3) - DO i2 = LBOUND(InData%AngVelEM,2), UBOUND(InData%AngVelEM,2) - DO i1 = LBOUND(InData%AngVelEM,1), UBOUND(InData%AngVelEM,1) - ReKiBuf(Re_Xferred) = InData%AngVelEM(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEN) ) 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%PAngVelEN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEN,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEN,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEN,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEN,3), UBOUND(InData%PAngVelEN,3) - DO i2 = LBOUND(InData%PAngVelEN,2), UBOUND(InData%PAngVelEN,2) - DO i1 = LBOUND(InData%PAngVelEN,1), UBOUND(InData%PAngVelEN,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEN(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%AngVelEA,1), UBOUND(InData%AngVelEA,1) - ReKiBuf(Re_Xferred) = InData%AngVelEA(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%PAngVelEB) ) 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%PAngVelEB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEB,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEB,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEB,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEB,3), UBOUND(InData%PAngVelEB,3) - DO i2 = LBOUND(InData%PAngVelEB,2), UBOUND(InData%PAngVelEB,2) - DO i1 = LBOUND(InData%PAngVelEB,1), UBOUND(InData%PAngVelEB,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEB(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelER) ) 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%PAngVelER,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelER,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelER,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelER,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelER,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelER,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelER,3), UBOUND(InData%PAngVelER,3) - DO i2 = LBOUND(InData%PAngVelER,2), UBOUND(InData%PAngVelER,2) - DO i1 = LBOUND(InData%PAngVelER,1), UBOUND(InData%PAngVelER,1) - ReKiBuf(Re_Xferred) = InData%PAngVelER(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEX) ) 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%PAngVelEX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEX,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEX,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEX,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEX,3), UBOUND(InData%PAngVelEX,3) - DO i2 = LBOUND(InData%PAngVelEX,2), UBOUND(InData%PAngVelEX,2) - DO i1 = LBOUND(InData%PAngVelEX,1), UBOUND(InData%PAngVelEX,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEX(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%AngVelEG,1), UBOUND(InData%AngVelEG,1) - ReKiBuf(Re_Xferred) = InData%AngVelEG(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelEH,1), UBOUND(InData%AngVelEH,1) - ReKiBuf(Re_Xferred) = InData%AngVelEH(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelEL,1), UBOUND(InData%AngVelEL,1) - ReKiBuf(Re_Xferred) = InData%AngVelEL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelEN,1), UBOUND(InData%AngVelEN,1) - ReKiBuf(Re_Xferred) = InData%AngVelEN(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelEB,1), UBOUND(InData%AngVelEB,1) - ReKiBuf(Re_Xferred) = InData%AngVelEB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelER,1), UBOUND(InData%AngVelER,1) - ReKiBuf(Re_Xferred) = InData%AngVelER(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelEX,1), UBOUND(InData%AngVelEX,1) - ReKiBuf(Re_Xferred) = InData%AngVelEX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%TeetAngVel - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%AngAccEBt,1), UBOUND(InData%AngAccEBt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEBt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngAccERt,1), UBOUND(InData%AngAccERt,1) - ReKiBuf(Re_Xferred) = InData%AngAccERt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngAccEXt,1), UBOUND(InData%AngAccEXt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEXt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%AngAccEFt) ) 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%AngAccEFt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEFt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngAccEFt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEFt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AngAccEFt,2), UBOUND(InData%AngAccEFt,2) - DO i1 = LBOUND(InData%AngAccEFt,1), UBOUND(InData%AngAccEFt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEFt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngVelEF) ) 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%AngVelEF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelEF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AngVelEF,2), UBOUND(InData%AngVelEF,2) - DO i1 = LBOUND(InData%AngVelEF,1), UBOUND(InData%AngVelEF,1) - ReKiBuf(Re_Xferred) = InData%AngVelEF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngVelHM) ) 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%AngVelHM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelHM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelHM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelHM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelHM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelHM,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AngVelHM,3), UBOUND(InData%AngVelHM,3) - DO i2 = LBOUND(InData%AngVelHM,2), UBOUND(InData%AngVelHM,2) - DO i1 = LBOUND(InData%AngVelHM,1), UBOUND(InData%AngVelHM,1) - ReKiBuf(Re_Xferred) = InData%AngVelHM(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%AngAccEAt,1), UBOUND(InData%AngAccEAt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEAt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngAccEGt,1), UBOUND(InData%AngAccEGt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEGt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngAccEHt,1), UBOUND(InData%AngAccEHt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEHt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%AngAccEKt) ) 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%AngAccEKt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEKt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngAccEKt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEKt,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngAccEKt,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEKt,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AngAccEKt,3), UBOUND(InData%AngAccEKt,3) - DO i2 = LBOUND(InData%AngAccEKt,2), UBOUND(InData%AngAccEKt,2) - DO i1 = LBOUND(InData%AngAccEKt,1), UBOUND(InData%AngAccEKt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEKt(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%AngAccENt,1), UBOUND(InData%AngAccENt,1) - ReKiBuf(Re_Xferred) = InData%AngAccENt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccECt,1), UBOUND(InData%LinAccECt,1) - ReKiBuf(Re_Xferred) = InData%LinAccECt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEDt,1), UBOUND(InData%LinAccEDt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEDt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEIt,1), UBOUND(InData%LinAccEIt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEIt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEJt,1), UBOUND(InData%LinAccEJt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEJt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEUt,1), UBOUND(InData%LinAccEUt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEUt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEYt,1), UBOUND(InData%LinAccEYt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEYt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%LinVelES) ) 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%LinVelES,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelES,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinVelES,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelES,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinVelES,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelES,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%LinVelES,3), UBOUND(InData%LinVelES,3) - DO i2 = LBOUND(InData%LinVelES,2), UBOUND(InData%LinVelES,2) - DO i1 = LBOUND(InData%LinVelES,1), UBOUND(InData%LinVelES,1) - ReKiBuf(Re_Xferred) = InData%LinVelES(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%LinVelEQ,1), UBOUND(InData%LinVelEQ,1) - ReKiBuf(Re_Xferred) = InData%LinVelEQ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%LinVelET) ) 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%LinVelET,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelET,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinVelET,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelET,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LinVelET,2), UBOUND(InData%LinVelET,2) - DO i1 = LBOUND(InData%LinVelET,1), UBOUND(InData%LinVelET,1) - ReKiBuf(Re_Xferred) = InData%LinVelET(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinVelESm2) ) 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%LinVelESm2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelESm2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinVelESm2,1), UBOUND(InData%LinVelESm2,1) - ReKiBuf(Re_Xferred) = InData%LinVelESm2(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEIMU) ) 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%PLinVelEIMU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEIMU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEIMU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEIMU,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEIMU,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEIMU,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEIMU,3), UBOUND(InData%PLinVelEIMU,3) - DO i2 = LBOUND(InData%PLinVelEIMU,2), UBOUND(InData%PLinVelEIMU,2) - DO i1 = LBOUND(InData%PLinVelEIMU,1), UBOUND(InData%PLinVelEIMU,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEIMU(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEO) ) 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%PLinVelEO,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEO,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEO,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEO,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEO,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEO,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEO,3), UBOUND(InData%PLinVelEO,3) - DO i2 = LBOUND(InData%PLinVelEO,2), UBOUND(InData%PLinVelEO,2) - DO i1 = LBOUND(InData%PLinVelEO,1), UBOUND(InData%PLinVelEO,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEO(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelES) ) 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%PLinVelES,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelES,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelES,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelES,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelES,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%PLinVelES,5), UBOUND(InData%PLinVelES,5) - DO i4 = LBOUND(InData%PLinVelES,4), UBOUND(InData%PLinVelES,4) - DO i3 = LBOUND(InData%PLinVelES,3), UBOUND(InData%PLinVelES,3) - DO i2 = LBOUND(InData%PLinVelES,2), UBOUND(InData%PLinVelES,2) - DO i1 = LBOUND(InData%PLinVelES,1), UBOUND(InData%PLinVelES,1) - ReKiBuf(Re_Xferred) = InData%PLinVelES(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%PLinVelET) ) 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%PLinVelET,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelET,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelET,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelET,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelET,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelET,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelET,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelET,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PLinVelET,4), UBOUND(InData%PLinVelET,4) - DO i3 = LBOUND(InData%PLinVelET,3), UBOUND(InData%PLinVelET,3) - DO i2 = LBOUND(InData%PLinVelET,2), UBOUND(InData%PLinVelET,2) - DO i1 = LBOUND(InData%PLinVelET,1), UBOUND(InData%PLinVelET,1) - ReKiBuf(Re_Xferred) = InData%PLinVelET(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEZ) ) 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%PLinVelEZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEZ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEZ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEZ,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEZ,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEZ,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEZ,3), UBOUND(InData%PLinVelEZ,3) - DO i2 = LBOUND(InData%PLinVelEZ,2), UBOUND(InData%PLinVelEZ,2) - DO i1 = LBOUND(InData%PLinVelEZ,1), UBOUND(InData%PLinVelEZ,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEZ(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEC) ) 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%PLinVelEC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEC,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEC,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEC,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEC,3), UBOUND(InData%PLinVelEC,3) - DO i2 = LBOUND(InData%PLinVelEC,2), UBOUND(InData%PLinVelEC,2) - DO i1 = LBOUND(InData%PLinVelEC,1), UBOUND(InData%PLinVelEC,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEC(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelED) ) 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%PLinVelED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelED,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelED,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelED,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelED,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelED,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelED,3), UBOUND(InData%PLinVelED,3) - DO i2 = LBOUND(InData%PLinVelED,2), UBOUND(InData%PLinVelED,2) - DO i1 = LBOUND(InData%PLinVelED,1), UBOUND(InData%PLinVelED,1) - ReKiBuf(Re_Xferred) = InData%PLinVelED(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEI) ) 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%PLinVelEI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEI,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEI,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEI,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEI,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEI,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEI,3), UBOUND(InData%PLinVelEI,3) - DO i2 = LBOUND(InData%PLinVelEI,2), UBOUND(InData%PLinVelEI,2) - DO i1 = LBOUND(InData%PLinVelEI,1), UBOUND(InData%PLinVelEI,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEI(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEJ) ) 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%PLinVelEJ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEJ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEJ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEJ,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEJ,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEJ,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEJ,3), UBOUND(InData%PLinVelEJ,3) - DO i2 = LBOUND(InData%PLinVelEJ,2), UBOUND(InData%PLinVelEJ,2) - DO i1 = LBOUND(InData%PLinVelEJ,1), UBOUND(InData%PLinVelEJ,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEJ(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEP) ) 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%PLinVelEP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEP,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEP,3), UBOUND(InData%PLinVelEP,3) - DO i2 = LBOUND(InData%PLinVelEP,2), UBOUND(InData%PLinVelEP,2) - DO i1 = LBOUND(InData%PLinVelEP,1), UBOUND(InData%PLinVelEP,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEP(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEQ) ) 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%PLinVelEQ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEQ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEQ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEQ,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEQ,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEQ,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEQ,3), UBOUND(InData%PLinVelEQ,3) - DO i2 = LBOUND(InData%PLinVelEQ,2), UBOUND(InData%PLinVelEQ,2) - DO i1 = LBOUND(InData%PLinVelEQ,1), UBOUND(InData%PLinVelEQ,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEQ(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEU) ) 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%PLinVelEU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEU,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEU,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEU,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEU,3), UBOUND(InData%PLinVelEU,3) - DO i2 = LBOUND(InData%PLinVelEU,2), UBOUND(InData%PLinVelEU,2) - DO i1 = LBOUND(InData%PLinVelEU,1), UBOUND(InData%PLinVelEU,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEU(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEV) ) 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%PLinVelEV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEV,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEV,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEV,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEV,3), UBOUND(InData%PLinVelEV,3) - DO i2 = LBOUND(InData%PLinVelEV,2), UBOUND(InData%PLinVelEV,2) - DO i1 = LBOUND(InData%PLinVelEV,1), UBOUND(InData%PLinVelEV,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEV(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEW) ) 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%PLinVelEW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEW,3), UBOUND(InData%PLinVelEW,3) - DO i2 = LBOUND(InData%PLinVelEW,2), UBOUND(InData%PLinVelEW,2) - DO i1 = LBOUND(InData%PLinVelEW,1), UBOUND(InData%PLinVelEW,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEY) ) 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%PLinVelEY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEY,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEY,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEY,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEY,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEY,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEY,3), UBOUND(InData%PLinVelEY,3) - DO i2 = LBOUND(InData%PLinVelEY,2), UBOUND(InData%PLinVelEY,2) - DO i1 = LBOUND(InData%PLinVelEY,1), UBOUND(InData%PLinVelEY,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEY(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%LinAccEIMUt,1), UBOUND(InData%LinAccEIMUt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEIMUt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEOt,1), UBOUND(InData%LinAccEOt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEOt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%LinAccESt) ) 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%LinAccESt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccESt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinAccESt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccESt,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinAccESt,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccESt,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%LinAccESt,3), UBOUND(InData%LinAccESt,3) - DO i2 = LBOUND(InData%LinAccESt,2), UBOUND(InData%LinAccESt,2) - DO i1 = LBOUND(InData%LinAccESt,1), UBOUND(InData%LinAccESt,1) - ReKiBuf(Re_Xferred) = InData%LinAccESt(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinAccETt) ) 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%LinAccETt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccETt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinAccETt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccETt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LinAccETt,2), UBOUND(InData%LinAccETt,2) - DO i1 = LBOUND(InData%LinAccETt,1), UBOUND(InData%LinAccETt,1) - ReKiBuf(Re_Xferred) = InData%LinAccETt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%LinAccEZt,1), UBOUND(InData%LinAccEZt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEZt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinVelEIMU,1), UBOUND(InData%LinVelEIMU,1) - ReKiBuf(Re_Xferred) = InData%LinVelEIMU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinVelEZ,1), UBOUND(InData%LinVelEZ,1) - ReKiBuf(Re_Xferred) = InData%LinVelEZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinVelEO,1), UBOUND(InData%LinVelEO,1) - ReKiBuf(Re_Xferred) = InData%LinVelEO(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinVelEJ,1), UBOUND(InData%LinVelEJ,1) - ReKiBuf(Re_Xferred) = InData%LinVelEJ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FrcONcRtt,1), UBOUND(InData%FrcONcRtt,1) - ReKiBuf(Re_Xferred) = InData%FrcONcRtt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FrcPRott,1), UBOUND(InData%FrcPRott,1) - ReKiBuf(Re_Xferred) = InData%FrcPRott(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%FrcS0Bt) ) 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%FrcS0Bt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FrcS0Bt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FrcS0Bt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FrcS0Bt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FrcS0Bt,2), UBOUND(InData%FrcS0Bt,2) - DO i1 = LBOUND(InData%FrcS0Bt,1), UBOUND(InData%FrcS0Bt,1) - ReKiBuf(Re_Xferred) = InData%FrcS0Bt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%FrcT0Trbt,1), UBOUND(InData%FrcT0Trbt,1) - ReKiBuf(Re_Xferred) = InData%FrcT0Trbt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%FSAero) ) 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%FSAero,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSAero,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSAero,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSAero,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSAero,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSAero,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%FSAero,3), UBOUND(InData%FSAero,3) - DO i2 = LBOUND(InData%FSAero,2), UBOUND(InData%FSAero,2) - DO i1 = LBOUND(InData%FSAero,1), UBOUND(InData%FSAero,1) - ReKiBuf(Re_Xferred) = InData%FSAero(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FSTipDrag) ) 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%FSTipDrag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSTipDrag,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSTipDrag,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSTipDrag,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FSTipDrag,2), UBOUND(InData%FSTipDrag,2) - DO i1 = LBOUND(InData%FSTipDrag,1), UBOUND(InData%FSTipDrag,1) - ReKiBuf(Re_Xferred) = InData%FSTipDrag(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FTHydrot) ) 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%FTHydrot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTHydrot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTHydrot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTHydrot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FTHydrot,2), UBOUND(InData%FTHydrot,2) - DO i1 = LBOUND(InData%FTHydrot,1), UBOUND(InData%FTHydrot,1) - ReKiBuf(Re_Xferred) = InData%FTHydrot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%FZHydrot,1), UBOUND(InData%FZHydrot,1) - ReKiBuf(Re_Xferred) = InData%FZHydrot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%MFHydrot) ) 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%MFHydrot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MFHydrot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MFHydrot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MFHydrot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MFHydrot,2), UBOUND(InData%MFHydrot,2) - DO i1 = LBOUND(InData%MFHydrot,1), UBOUND(InData%MFHydrot,1) - ReKiBuf(Re_Xferred) = InData%MFHydrot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%MomBNcRtt,1), UBOUND(InData%MomBNcRtt,1) - ReKiBuf(Re_Xferred) = InData%MomBNcRtt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%MomH0Bt) ) 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%MomH0Bt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MomH0Bt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MomH0Bt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MomH0Bt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MomH0Bt,2), UBOUND(InData%MomH0Bt,2) - DO i1 = LBOUND(InData%MomH0Bt,1), UBOUND(InData%MomH0Bt,1) - ReKiBuf(Re_Xferred) = InData%MomH0Bt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%MomLPRott,1), UBOUND(InData%MomLPRott,1) - ReKiBuf(Re_Xferred) = InData%MomLPRott(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%MomNGnRtt,1), UBOUND(InData%MomNGnRtt,1) - ReKiBuf(Re_Xferred) = InData%MomNGnRtt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%MomNTailt,1), UBOUND(InData%MomNTailt,1) - ReKiBuf(Re_Xferred) = InData%MomNTailt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%MomX0Trbt,1), UBOUND(InData%MomX0Trbt,1) - ReKiBuf(Re_Xferred) = InData%MomX0Trbt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%MMAero) ) 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%MMAero,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMAero,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MMAero,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMAero,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MMAero,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMAero,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%MMAero,3), UBOUND(InData%MMAero,3) - DO i2 = LBOUND(InData%MMAero,2), UBOUND(InData%MMAero,2) - DO i1 = LBOUND(InData%MMAero,1), UBOUND(InData%MMAero,1) - ReKiBuf(Re_Xferred) = InData%MMAero(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%MXHydrot,1), UBOUND(InData%MXHydrot,1) - ReKiBuf(Re_Xferred) = InData%MXHydrot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%PFrcONcRt) ) 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%PFrcONcRt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcONcRt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcONcRt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcONcRt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcONcRt,2), UBOUND(InData%PFrcONcRt,2) - DO i1 = LBOUND(InData%PFrcONcRt,1), UBOUND(InData%PFrcONcRt,1) - ReKiBuf(Re_Xferred) = InData%PFrcONcRt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFrcPRot) ) 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%PFrcPRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcPRot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcPRot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcPRot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcPRot,2), UBOUND(InData%PFrcPRot,2) - DO i1 = LBOUND(InData%PFrcPRot,1), UBOUND(InData%PFrcPRot,1) - ReKiBuf(Re_Xferred) = InData%PFrcPRot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFrcS0B) ) 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%PFrcS0B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcS0B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcS0B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcS0B,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcS0B,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcS0B,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PFrcS0B,3), UBOUND(InData%PFrcS0B,3) - DO i2 = LBOUND(InData%PFrcS0B,2), UBOUND(InData%PFrcS0B,2) - DO i1 = LBOUND(InData%PFrcS0B,1), UBOUND(InData%PFrcS0B,1) - ReKiBuf(Re_Xferred) = InData%PFrcS0B(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFrcT0Trb) ) 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%PFrcT0Trb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcT0Trb,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcT0Trb,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcT0Trb,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcT0Trb,2), UBOUND(InData%PFrcT0Trb,2) - DO i1 = LBOUND(InData%PFrcT0Trb,1), UBOUND(InData%PFrcT0Trb,1) - ReKiBuf(Re_Xferred) = InData%PFrcT0Trb(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFTHydro) ) 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%PFTHydro,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFTHydro,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFTHydro,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFTHydro,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFTHydro,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFTHydro,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PFTHydro,3), UBOUND(InData%PFTHydro,3) - DO i2 = LBOUND(InData%PFTHydro,2), UBOUND(InData%PFTHydro,2) - DO i1 = LBOUND(InData%PFTHydro,1), UBOUND(InData%PFTHydro,1) - ReKiBuf(Re_Xferred) = InData%PFTHydro(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i2 = LBOUND(InData%PFZHydro,2), UBOUND(InData%PFZHydro,2) - DO i1 = LBOUND(InData%PFZHydro,1), UBOUND(InData%PFZHydro,1) - ReKiBuf(Re_Xferred) = InData%PFZHydro(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%PMFHydro) ) 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%PMFHydro,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMFHydro,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMFHydro,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMFHydro,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMFHydro,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMFHydro,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PMFHydro,3), UBOUND(InData%PMFHydro,3) - DO i2 = LBOUND(InData%PMFHydro,2), UBOUND(InData%PMFHydro,2) - DO i1 = LBOUND(InData%PMFHydro,1), UBOUND(InData%PMFHydro,1) - ReKiBuf(Re_Xferred) = InData%PMFHydro(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomBNcRt) ) 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%PMomBNcRt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomBNcRt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomBNcRt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomBNcRt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomBNcRt,2), UBOUND(InData%PMomBNcRt,2) - DO i1 = LBOUND(InData%PMomBNcRt,1), UBOUND(InData%PMomBNcRt,1) - ReKiBuf(Re_Xferred) = InData%PMomBNcRt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomH0B) ) 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%PMomH0B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomH0B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomH0B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomH0B,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomH0B,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomH0B,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PMomH0B,3), UBOUND(InData%PMomH0B,3) - DO i2 = LBOUND(InData%PMomH0B,2), UBOUND(InData%PMomH0B,2) - DO i1 = LBOUND(InData%PMomH0B,1), UBOUND(InData%PMomH0B,1) - ReKiBuf(Re_Xferred) = InData%PMomH0B(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomLPRot) ) 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%PMomLPRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomLPRot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomLPRot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomLPRot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomLPRot,2), UBOUND(InData%PMomLPRot,2) - DO i1 = LBOUND(InData%PMomLPRot,1), UBOUND(InData%PMomLPRot,1) - ReKiBuf(Re_Xferred) = InData%PMomLPRot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomNGnRt) ) 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%PMomNGnRt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNGnRt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomNGnRt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNGnRt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomNGnRt,2), UBOUND(InData%PMomNGnRt,2) - DO i1 = LBOUND(InData%PMomNGnRt,1), UBOUND(InData%PMomNGnRt,1) - ReKiBuf(Re_Xferred) = InData%PMomNGnRt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomNTail) ) 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%PMomNTail,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNTail,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomNTail,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNTail,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomNTail,2), UBOUND(InData%PMomNTail,2) - DO i1 = LBOUND(InData%PMomNTail,1), UBOUND(InData%PMomNTail,1) - ReKiBuf(Re_Xferred) = InData%PMomNTail(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomX0Trb) ) 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%PMomX0Trb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomX0Trb,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomX0Trb,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomX0Trb,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomX0Trb,2), UBOUND(InData%PMomX0Trb,2) - DO i1 = LBOUND(InData%PMomX0Trb,1), UBOUND(InData%PMomX0Trb,1) - ReKiBuf(Re_Xferred) = InData%PMomX0Trb(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i2 = LBOUND(InData%PMXHydro,2), UBOUND(InData%PMXHydro,2) - DO i1 = LBOUND(InData%PMXHydro,1), UBOUND(InData%PMXHydro,1) - ReKiBuf(Re_Xferred) = InData%PMXHydro(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DbKiBuf(Db_Xferred) = InData%TeetAng - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%FrcVGnRtt,1), UBOUND(InData%FrcVGnRtt,1) - ReKiBuf(Re_Xferred) = InData%FrcVGnRtt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FrcWTailt,1), UBOUND(InData%FrcWTailt,1) - ReKiBuf(Re_Xferred) = InData%FrcWTailt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FrcZAllt,1), UBOUND(InData%FrcZAllt,1) - ReKiBuf(Re_Xferred) = InData%FrcZAllt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%MomXAllt,1), UBOUND(InData%MomXAllt,1) - ReKiBuf(Re_Xferred) = InData%MomXAllt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%PFrcVGnRt) ) 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%PFrcVGnRt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcVGnRt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcVGnRt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcVGnRt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcVGnRt,2), UBOUND(InData%PFrcVGnRt,2) - DO i1 = LBOUND(InData%PFrcVGnRt,1), UBOUND(InData%PFrcVGnRt,1) - ReKiBuf(Re_Xferred) = InData%PFrcVGnRt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFrcWTail) ) 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%PFrcWTail,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcWTail,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcWTail,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcWTail,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcWTail,2), UBOUND(InData%PFrcWTail,2) - DO i1 = LBOUND(InData%PFrcWTail,1), UBOUND(InData%PFrcWTail,1) - ReKiBuf(Re_Xferred) = InData%PFrcWTail(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFrcZAll) ) 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%PFrcZAll,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcZAll,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcZAll,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcZAll,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcZAll,2), UBOUND(InData%PFrcZAll,2) - DO i1 = LBOUND(InData%PFrcZAll,1), UBOUND(InData%PFrcZAll,1) - ReKiBuf(Re_Xferred) = InData%PFrcZAll(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomXAll) ) 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%PMomXAll,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomXAll,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomXAll,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomXAll,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomXAll,2), UBOUND(InData%PMomXAll,2) - DO i1 = LBOUND(InData%PMomXAll,1), UBOUND(InData%PMomXAll,1) - ReKiBuf(Re_Xferred) = InData%PMomXAll(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TeetMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GBoxEffFac - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%rSAerCen) ) 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%rSAerCen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCen,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCen,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCen,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCen,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCen,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rSAerCen,3), UBOUND(InData%rSAerCen,3) - DO i2 = LBOUND(InData%rSAerCen,2), UBOUND(InData%rSAerCen,2) - DO i1 = LBOUND(InData%rSAerCen,1), UBOUND(InData%rSAerCen,1) - ReKiBuf(Re_Xferred) = InData%rSAerCen(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE ED_PackRtHndSide - - SUBROUTINE ED_UnPackRtHndSide( 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(ED_RtHndSide), 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 = 'ED_UnPackRtHndSide' - ! 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 - i1_l = LBOUND(OutData%rO,1) - i1_u = UBOUND(OutData%rO,1) - DO i1 = LBOUND(OutData%rO,1), UBOUND(OutData%rO,1) - OutData%rO(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rQS 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%rQS)) DEALLOCATE(OutData%rQS) - ALLOCATE(OutData%rQS(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%rQS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rQS,3), UBOUND(OutData%rQS,3) - DO i2 = LBOUND(OutData%rQS,2), UBOUND(OutData%rQS,2) - DO i1 = LBOUND(OutData%rQS,1), UBOUND(OutData%rQS,1) - OutData%rQS(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rS 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%rS)) DEALLOCATE(OutData%rS) - ALLOCATE(OutData%rS(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%rS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rS,3), UBOUND(OutData%rS,3) - DO i2 = LBOUND(OutData%rS,2), UBOUND(OutData%rS,2) - DO i1 = LBOUND(OutData%rS,1), UBOUND(OutData%rS,1) - OutData%rS(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rS0S 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%rS0S)) DEALLOCATE(OutData%rS0S) - ALLOCATE(OutData%rS0S(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%rS0S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rS0S,3), UBOUND(OutData%rS0S,3) - DO i2 = LBOUND(OutData%rS0S,2), UBOUND(OutData%rS0S,2) - DO i1 = LBOUND(OutData%rS0S,1), UBOUND(OutData%rS0S,1) - OutData%rS0S(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rT 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%rT)) DEALLOCATE(OutData%rT) - ALLOCATE(OutData%rT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rT,2), UBOUND(OutData%rT,2) - DO i1 = LBOUND(OutData%rT,1), UBOUND(OutData%rT,1) - OutData%rT(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%rT0O,1) - i1_u = UBOUND(OutData%rT0O,1) - DO i1 = LBOUND(OutData%rT0O,1), UBOUND(OutData%rT0O,1) - OutData%rT0O(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rT0T 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%rT0T)) DEALLOCATE(OutData%rT0T) - ALLOCATE(OutData%rT0T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT0T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rT0T,2), UBOUND(OutData%rT0T,2) - DO i1 = LBOUND(OutData%rT0T,1), UBOUND(OutData%rT0T,1) - OutData%rT0T(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%rZ,1) - i1_u = UBOUND(OutData%rZ,1) - DO i1 = LBOUND(OutData%rZ,1), UBOUND(OutData%rZ,1) - OutData%rZ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rZO,1) - i1_u = UBOUND(OutData%rZO,1) - DO i1 = LBOUND(OutData%rZO,1), UBOUND(OutData%rZO,1) - OutData%rZO(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rZT 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%rZT)) DEALLOCATE(OutData%rZT) - ALLOCATE(OutData%rZT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rZT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rZT,2), UBOUND(OutData%rZT,2) - DO i1 = LBOUND(OutData%rZT,1), UBOUND(OutData%rZT,1) - OutData%rZT(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%rPQ,1) - i1_u = UBOUND(OutData%rPQ,1) - DO i1 = LBOUND(OutData%rPQ,1), UBOUND(OutData%rPQ,1) - OutData%rPQ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rP,1) - i1_u = UBOUND(OutData%rP,1) - DO i1 = LBOUND(OutData%rP,1), UBOUND(OutData%rP,1) - OutData%rP(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rV,1) - i1_u = UBOUND(OutData%rV,1) - DO i1 = LBOUND(OutData%rV,1), UBOUND(OutData%rV,1) - OutData%rV(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rJ,1) - i1_u = UBOUND(OutData%rJ,1) - DO i1 = LBOUND(OutData%rJ,1), UBOUND(OutData%rJ,1) - OutData%rJ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rZY,1) - i1_u = UBOUND(OutData%rZY,1) - DO i1 = LBOUND(OutData%rZY,1), UBOUND(OutData%rZY,1) - OutData%rZY(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rOU,1) - i1_u = UBOUND(OutData%rOU,1) - DO i1 = LBOUND(OutData%rOU,1), UBOUND(OutData%rOU,1) - OutData%rOU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rOV,1) - i1_u = UBOUND(OutData%rOV,1) - DO i1 = LBOUND(OutData%rOV,1), UBOUND(OutData%rOV,1) - OutData%rOV(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rVD,1) - i1_u = UBOUND(OutData%rVD,1) - DO i1 = LBOUND(OutData%rVD,1), UBOUND(OutData%rVD,1) - OutData%rVD(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rOW,1) - i1_u = UBOUND(OutData%rOW,1) - DO i1 = LBOUND(OutData%rOW,1), UBOUND(OutData%rOW,1) - OutData%rOW(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rPC,1) - i1_u = UBOUND(OutData%rPC,1) - DO i1 = LBOUND(OutData%rPC,1), UBOUND(OutData%rPC,1) - OutData%rPC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rPS0 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%rPS0)) DEALLOCATE(OutData%rPS0) - ALLOCATE(OutData%rPS0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rPS0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rPS0,2), UBOUND(OutData%rPS0,2) - DO i1 = LBOUND(OutData%rPS0,1), UBOUND(OutData%rPS0,1) - OutData%rPS0(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%rQ,1) - i1_u = UBOUND(OutData%rQ,1) - DO i1 = LBOUND(OutData%rQ,1), UBOUND(OutData%rQ,1) - OutData%rQ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rQC,1) - i1_u = UBOUND(OutData%rQC,1) - DO i1 = LBOUND(OutData%rQC,1), UBOUND(OutData%rQC,1) - OutData%rQC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rVIMU,1) - i1_u = UBOUND(OutData%rVIMU,1) - DO i1 = LBOUND(OutData%rVIMU,1), UBOUND(OutData%rVIMU,1) - OutData%rVIMU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rVP,1) - i1_u = UBOUND(OutData%rVP,1) - DO i1 = LBOUND(OutData%rVP,1), UBOUND(OutData%rVP,1) - OutData%rVP(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rWI,1) - i1_u = UBOUND(OutData%rWI,1) - DO i1 = LBOUND(OutData%rWI,1), UBOUND(OutData%rWI,1) - OutData%rWI(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rWJ,1) - i1_u = UBOUND(OutData%rWJ,1) - DO i1 = LBOUND(OutData%rWJ,1), UBOUND(OutData%rWJ,1) - OutData%rWJ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rZT0,1) - i1_u = UBOUND(OutData%rZT0,1) - DO i1 = LBOUND(OutData%rZT0,1), UBOUND(OutData%rZT0,1) - OutData%rZT0(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosEF 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%AngPosEF)) DEALLOCATE(OutData%AngPosEF) - ALLOCATE(OutData%AngPosEF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AngPosEF,2), UBOUND(OutData%AngPosEF,2) - DO i1 = LBOUND(OutData%AngPosEF,1), UBOUND(OutData%AngPosEF,1) - OutData%AngPosEF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosXF 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%AngPosXF)) DEALLOCATE(OutData%AngPosXF) - ALLOCATE(OutData%AngPosXF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosXF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AngPosXF,2), UBOUND(OutData%AngPosXF,2) - DO i1 = LBOUND(OutData%AngPosXF,1), UBOUND(OutData%AngPosXF,1) - OutData%AngPosXF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosHM 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%AngPosHM)) DEALLOCATE(OutData%AngPosHM) - ALLOCATE(OutData%AngPosHM(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%AngPosHM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AngPosHM,3), UBOUND(OutData%AngPosHM,3) - DO i2 = LBOUND(OutData%AngPosHM,2), UBOUND(OutData%AngPosHM,2) - DO i1 = LBOUND(OutData%AngPosHM,1), UBOUND(OutData%AngPosHM,1) - OutData%AngPosHM(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%AngPosXB,1) - i1_u = UBOUND(OutData%AngPosXB,1) - DO i1 = LBOUND(OutData%AngPosXB,1), UBOUND(OutData%AngPosXB,1) - OutData%AngPosXB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngPosEX,1) - i1_u = UBOUND(OutData%AngPosEX,1) - DO i1 = LBOUND(OutData%AngPosEX,1), UBOUND(OutData%AngPosEX,1) - OutData%AngPosEX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEA 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%PAngVelEA)) DEALLOCATE(OutData%PAngVelEA) - ALLOCATE(OutData%PAngVelEA(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%PAngVelEA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEA,3), UBOUND(OutData%PAngVelEA,3) - DO i2 = LBOUND(OutData%PAngVelEA,2), UBOUND(OutData%PAngVelEA,2) - DO i1 = LBOUND(OutData%PAngVelEA,1), UBOUND(OutData%PAngVelEA,1) - OutData%PAngVelEA(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEF 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%PAngVelEF)) DEALLOCATE(OutData%PAngVelEF) - ALLOCATE(OutData%PAngVelEF(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%PAngVelEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PAngVelEF,4), UBOUND(OutData%PAngVelEF,4) - DO i3 = LBOUND(OutData%PAngVelEF,3), UBOUND(OutData%PAngVelEF,3) - DO i2 = LBOUND(OutData%PAngVelEF,2), UBOUND(OutData%PAngVelEF,2) - DO i1 = LBOUND(OutData%PAngVelEF,1), UBOUND(OutData%PAngVelEF,1) - OutData%PAngVelEF(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEG 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%PAngVelEG)) DEALLOCATE(OutData%PAngVelEG) - ALLOCATE(OutData%PAngVelEG(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%PAngVelEG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEG,3), UBOUND(OutData%PAngVelEG,3) - DO i2 = LBOUND(OutData%PAngVelEG,2), UBOUND(OutData%PAngVelEG,2) - DO i1 = LBOUND(OutData%PAngVelEG,1), UBOUND(OutData%PAngVelEG,1) - OutData%PAngVelEG(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEH 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%PAngVelEH)) DEALLOCATE(OutData%PAngVelEH) - ALLOCATE(OutData%PAngVelEH(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%PAngVelEH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEH,3), UBOUND(OutData%PAngVelEH,3) - DO i2 = LBOUND(OutData%PAngVelEH,2), UBOUND(OutData%PAngVelEH,2) - DO i1 = LBOUND(OutData%PAngVelEH,1), UBOUND(OutData%PAngVelEH,1) - OutData%PAngVelEH(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEL 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%PAngVelEL)) DEALLOCATE(OutData%PAngVelEL) - ALLOCATE(OutData%PAngVelEL(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%PAngVelEL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEL,3), UBOUND(OutData%PAngVelEL,3) - DO i2 = LBOUND(OutData%PAngVelEL,2), UBOUND(OutData%PAngVelEL,2) - DO i1 = LBOUND(OutData%PAngVelEL,1), UBOUND(OutData%PAngVelEL,1) - OutData%PAngVelEL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEM 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%PAngVelEM)) DEALLOCATE(OutData%PAngVelEM) - ALLOCATE(OutData%PAngVelEM(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%PAngVelEM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%PAngVelEM,5), UBOUND(OutData%PAngVelEM,5) - DO i4 = LBOUND(OutData%PAngVelEM,4), UBOUND(OutData%PAngVelEM,4) - DO i3 = LBOUND(OutData%PAngVelEM,3), UBOUND(OutData%PAngVelEM,3) - DO i2 = LBOUND(OutData%PAngVelEM,2), UBOUND(OutData%PAngVelEM,2) - DO i1 = LBOUND(OutData%PAngVelEM,1), UBOUND(OutData%PAngVelEM,1) - OutData%PAngVelEM(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngVelEM 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%AngVelEM)) DEALLOCATE(OutData%AngVelEM) - ALLOCATE(OutData%AngVelEM(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%AngVelEM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AngVelEM,3), UBOUND(OutData%AngVelEM,3) - DO i2 = LBOUND(OutData%AngVelEM,2), UBOUND(OutData%AngVelEM,2) - DO i1 = LBOUND(OutData%AngVelEM,1), UBOUND(OutData%AngVelEM,1) - OutData%AngVelEM(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEN 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%PAngVelEN)) DEALLOCATE(OutData%PAngVelEN) - ALLOCATE(OutData%PAngVelEN(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%PAngVelEN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEN,3), UBOUND(OutData%PAngVelEN,3) - DO i2 = LBOUND(OutData%PAngVelEN,2), UBOUND(OutData%PAngVelEN,2) - DO i1 = LBOUND(OutData%PAngVelEN,1), UBOUND(OutData%PAngVelEN,1) - OutData%PAngVelEN(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%AngVelEA,1) - i1_u = UBOUND(OutData%AngVelEA,1) - DO i1 = LBOUND(OutData%AngVelEA,1), UBOUND(OutData%AngVelEA,1) - OutData%AngVelEA(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEB 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%PAngVelEB)) DEALLOCATE(OutData%PAngVelEB) - ALLOCATE(OutData%PAngVelEB(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%PAngVelEB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEB,3), UBOUND(OutData%PAngVelEB,3) - DO i2 = LBOUND(OutData%PAngVelEB,2), UBOUND(OutData%PAngVelEB,2) - DO i1 = LBOUND(OutData%PAngVelEB,1), UBOUND(OutData%PAngVelEB,1) - OutData%PAngVelEB(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelER 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%PAngVelER)) DEALLOCATE(OutData%PAngVelER) - ALLOCATE(OutData%PAngVelER(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%PAngVelER.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelER,3), UBOUND(OutData%PAngVelER,3) - DO i2 = LBOUND(OutData%PAngVelER,2), UBOUND(OutData%PAngVelER,2) - DO i1 = LBOUND(OutData%PAngVelER,1), UBOUND(OutData%PAngVelER,1) - OutData%PAngVelER(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEX 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%PAngVelEX)) DEALLOCATE(OutData%PAngVelEX) - ALLOCATE(OutData%PAngVelEX(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%PAngVelEX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEX,3), UBOUND(OutData%PAngVelEX,3) - DO i2 = LBOUND(OutData%PAngVelEX,2), UBOUND(OutData%PAngVelEX,2) - DO i1 = LBOUND(OutData%PAngVelEX,1), UBOUND(OutData%PAngVelEX,1) - OutData%PAngVelEX(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%AngVelEG,1) - i1_u = UBOUND(OutData%AngVelEG,1) - DO i1 = LBOUND(OutData%AngVelEG,1), UBOUND(OutData%AngVelEG,1) - OutData%AngVelEG(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelEH,1) - i1_u = UBOUND(OutData%AngVelEH,1) - DO i1 = LBOUND(OutData%AngVelEH,1), UBOUND(OutData%AngVelEH,1) - OutData%AngVelEH(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelEL,1) - i1_u = UBOUND(OutData%AngVelEL,1) - DO i1 = LBOUND(OutData%AngVelEL,1), UBOUND(OutData%AngVelEL,1) - OutData%AngVelEL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelEN,1) - i1_u = UBOUND(OutData%AngVelEN,1) - DO i1 = LBOUND(OutData%AngVelEN,1), UBOUND(OutData%AngVelEN,1) - OutData%AngVelEN(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelEB,1) - i1_u = UBOUND(OutData%AngVelEB,1) - DO i1 = LBOUND(OutData%AngVelEB,1), UBOUND(OutData%AngVelEB,1) - OutData%AngVelEB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelER,1) - i1_u = UBOUND(OutData%AngVelER,1) - DO i1 = LBOUND(OutData%AngVelER,1), UBOUND(OutData%AngVelER,1) - OutData%AngVelER(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelEX,1) - i1_u = UBOUND(OutData%AngVelEX,1) - DO i1 = LBOUND(OutData%AngVelEX,1), UBOUND(OutData%AngVelEX,1) - OutData%AngVelEX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TeetAngVel = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%AngAccEBt,1) - i1_u = UBOUND(OutData%AngAccEBt,1) - DO i1 = LBOUND(OutData%AngAccEBt,1), UBOUND(OutData%AngAccEBt,1) - OutData%AngAccEBt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngAccERt,1) - i1_u = UBOUND(OutData%AngAccERt,1) - DO i1 = LBOUND(OutData%AngAccERt,1), UBOUND(OutData%AngAccERt,1) - OutData%AngAccERt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngAccEXt,1) - i1_u = UBOUND(OutData%AngAccEXt,1) - DO i1 = LBOUND(OutData%AngAccEXt,1), UBOUND(OutData%AngAccEXt,1) - OutData%AngAccEXt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngAccEFt 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%AngAccEFt)) DEALLOCATE(OutData%AngAccEFt) - ALLOCATE(OutData%AngAccEFt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngAccEFt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AngAccEFt,2), UBOUND(OutData%AngAccEFt,2) - DO i1 = LBOUND(OutData%AngAccEFt,1), UBOUND(OutData%AngAccEFt,1) - OutData%AngAccEFt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngVelEF 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%AngVelEF)) DEALLOCATE(OutData%AngVelEF) - ALLOCATE(OutData%AngVelEF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AngVelEF,2), UBOUND(OutData%AngVelEF,2) - DO i1 = LBOUND(OutData%AngVelEF,1), UBOUND(OutData%AngVelEF,1) - OutData%AngVelEF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngVelHM 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%AngVelHM)) DEALLOCATE(OutData%AngVelHM) - ALLOCATE(OutData%AngVelHM(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%AngVelHM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AngVelHM,3), UBOUND(OutData%AngVelHM,3) - DO i2 = LBOUND(OutData%AngVelHM,2), UBOUND(OutData%AngVelHM,2) - DO i1 = LBOUND(OutData%AngVelHM,1), UBOUND(OutData%AngVelHM,1) - OutData%AngVelHM(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%AngAccEAt,1) - i1_u = UBOUND(OutData%AngAccEAt,1) - DO i1 = LBOUND(OutData%AngAccEAt,1), UBOUND(OutData%AngAccEAt,1) - OutData%AngAccEAt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngAccEGt,1) - i1_u = UBOUND(OutData%AngAccEGt,1) - DO i1 = LBOUND(OutData%AngAccEGt,1), UBOUND(OutData%AngAccEGt,1) - OutData%AngAccEGt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngAccEHt,1) - i1_u = UBOUND(OutData%AngAccEHt,1) - DO i1 = LBOUND(OutData%AngAccEHt,1), UBOUND(OutData%AngAccEHt,1) - OutData%AngAccEHt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngAccEKt 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%AngAccEKt)) DEALLOCATE(OutData%AngAccEKt) - ALLOCATE(OutData%AngAccEKt(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%AngAccEKt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AngAccEKt,3), UBOUND(OutData%AngAccEKt,3) - DO i2 = LBOUND(OutData%AngAccEKt,2), UBOUND(OutData%AngAccEKt,2) - DO i1 = LBOUND(OutData%AngAccEKt,1), UBOUND(OutData%AngAccEKt,1) - OutData%AngAccEKt(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%AngAccENt,1) - i1_u = UBOUND(OutData%AngAccENt,1) - DO i1 = LBOUND(OutData%AngAccENt,1), UBOUND(OutData%AngAccENt,1) - OutData%AngAccENt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccECt,1) - i1_u = UBOUND(OutData%LinAccECt,1) - DO i1 = LBOUND(OutData%LinAccECt,1), UBOUND(OutData%LinAccECt,1) - OutData%LinAccECt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEDt,1) - i1_u = UBOUND(OutData%LinAccEDt,1) - DO i1 = LBOUND(OutData%LinAccEDt,1), UBOUND(OutData%LinAccEDt,1) - OutData%LinAccEDt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEIt,1) - i1_u = UBOUND(OutData%LinAccEIt,1) - DO i1 = LBOUND(OutData%LinAccEIt,1), UBOUND(OutData%LinAccEIt,1) - OutData%LinAccEIt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEJt,1) - i1_u = UBOUND(OutData%LinAccEJt,1) - DO i1 = LBOUND(OutData%LinAccEJt,1), UBOUND(OutData%LinAccEJt,1) - OutData%LinAccEJt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEUt,1) - i1_u = UBOUND(OutData%LinAccEUt,1) - DO i1 = LBOUND(OutData%LinAccEUt,1), UBOUND(OutData%LinAccEUt,1) - OutData%LinAccEUt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEYt,1) - i1_u = UBOUND(OutData%LinAccEYt,1) - DO i1 = LBOUND(OutData%LinAccEYt,1), UBOUND(OutData%LinAccEYt,1) - OutData%LinAccEYt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelES 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%LinVelES)) DEALLOCATE(OutData%LinVelES) - ALLOCATE(OutData%LinVelES(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%LinVelES.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%LinVelES,3), UBOUND(OutData%LinVelES,3) - DO i2 = LBOUND(OutData%LinVelES,2), UBOUND(OutData%LinVelES,2) - DO i1 = LBOUND(OutData%LinVelES,1), UBOUND(OutData%LinVelES,1) - OutData%LinVelES(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%LinVelEQ,1) - i1_u = UBOUND(OutData%LinVelEQ,1) - DO i1 = LBOUND(OutData%LinVelEQ,1), UBOUND(OutData%LinVelEQ,1) - OutData%LinVelEQ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelET 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%LinVelET)) DEALLOCATE(OutData%LinVelET) - ALLOCATE(OutData%LinVelET(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelET.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LinVelET,2), UBOUND(OutData%LinVelET,2) - DO i1 = LBOUND(OutData%LinVelET,1), UBOUND(OutData%LinVelET,1) - OutData%LinVelET(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelESm2 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%LinVelESm2)) DEALLOCATE(OutData%LinVelESm2) - ALLOCATE(OutData%LinVelESm2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelESm2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinVelESm2,1), UBOUND(OutData%LinVelESm2,1) - OutData%LinVelESm2(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEIMU 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%PLinVelEIMU)) DEALLOCATE(OutData%PLinVelEIMU) - ALLOCATE(OutData%PLinVelEIMU(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%PLinVelEIMU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEIMU,3), UBOUND(OutData%PLinVelEIMU,3) - DO i2 = LBOUND(OutData%PLinVelEIMU,2), UBOUND(OutData%PLinVelEIMU,2) - DO i1 = LBOUND(OutData%PLinVelEIMU,1), UBOUND(OutData%PLinVelEIMU,1) - OutData%PLinVelEIMU(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEO 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%PLinVelEO)) DEALLOCATE(OutData%PLinVelEO) - ALLOCATE(OutData%PLinVelEO(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%PLinVelEO.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEO,3), UBOUND(OutData%PLinVelEO,3) - DO i2 = LBOUND(OutData%PLinVelEO,2), UBOUND(OutData%PLinVelEO,2) - DO i1 = LBOUND(OutData%PLinVelEO,1), UBOUND(OutData%PLinVelEO,1) - OutData%PLinVelEO(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelES 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%PLinVelES)) DEALLOCATE(OutData%PLinVelES) - ALLOCATE(OutData%PLinVelES(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%PLinVelES.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%PLinVelES,5), UBOUND(OutData%PLinVelES,5) - DO i4 = LBOUND(OutData%PLinVelES,4), UBOUND(OutData%PLinVelES,4) - DO i3 = LBOUND(OutData%PLinVelES,3), UBOUND(OutData%PLinVelES,3) - DO i2 = LBOUND(OutData%PLinVelES,2), UBOUND(OutData%PLinVelES,2) - DO i1 = LBOUND(OutData%PLinVelES,1), UBOUND(OutData%PLinVelES,1) - OutData%PLinVelES(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelET 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%PLinVelET)) DEALLOCATE(OutData%PLinVelET) - ALLOCATE(OutData%PLinVelET(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%PLinVelET.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PLinVelET,4), UBOUND(OutData%PLinVelET,4) - DO i3 = LBOUND(OutData%PLinVelET,3), UBOUND(OutData%PLinVelET,3) - DO i2 = LBOUND(OutData%PLinVelET,2), UBOUND(OutData%PLinVelET,2) - DO i1 = LBOUND(OutData%PLinVelET,1), UBOUND(OutData%PLinVelET,1) - OutData%PLinVelET(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEZ 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%PLinVelEZ)) DEALLOCATE(OutData%PLinVelEZ) - ALLOCATE(OutData%PLinVelEZ(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%PLinVelEZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEZ,3), UBOUND(OutData%PLinVelEZ,3) - DO i2 = LBOUND(OutData%PLinVelEZ,2), UBOUND(OutData%PLinVelEZ,2) - DO i1 = LBOUND(OutData%PLinVelEZ,1), UBOUND(OutData%PLinVelEZ,1) - OutData%PLinVelEZ(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEC 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%PLinVelEC)) DEALLOCATE(OutData%PLinVelEC) - ALLOCATE(OutData%PLinVelEC(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%PLinVelEC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEC,3), UBOUND(OutData%PLinVelEC,3) - DO i2 = LBOUND(OutData%PLinVelEC,2), UBOUND(OutData%PLinVelEC,2) - DO i1 = LBOUND(OutData%PLinVelEC,1), UBOUND(OutData%PLinVelEC,1) - OutData%PLinVelEC(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelED 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%PLinVelED)) DEALLOCATE(OutData%PLinVelED) - ALLOCATE(OutData%PLinVelED(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%PLinVelED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelED,3), UBOUND(OutData%PLinVelED,3) - DO i2 = LBOUND(OutData%PLinVelED,2), UBOUND(OutData%PLinVelED,2) - DO i1 = LBOUND(OutData%PLinVelED,1), UBOUND(OutData%PLinVelED,1) - OutData%PLinVelED(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEI 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%PLinVelEI)) DEALLOCATE(OutData%PLinVelEI) - ALLOCATE(OutData%PLinVelEI(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%PLinVelEI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEI,3), UBOUND(OutData%PLinVelEI,3) - DO i2 = LBOUND(OutData%PLinVelEI,2), UBOUND(OutData%PLinVelEI,2) - DO i1 = LBOUND(OutData%PLinVelEI,1), UBOUND(OutData%PLinVelEI,1) - OutData%PLinVelEI(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEJ 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%PLinVelEJ)) DEALLOCATE(OutData%PLinVelEJ) - ALLOCATE(OutData%PLinVelEJ(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%PLinVelEJ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEJ,3), UBOUND(OutData%PLinVelEJ,3) - DO i2 = LBOUND(OutData%PLinVelEJ,2), UBOUND(OutData%PLinVelEJ,2) - DO i1 = LBOUND(OutData%PLinVelEJ,1), UBOUND(OutData%PLinVelEJ,1) - OutData%PLinVelEJ(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEP 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%PLinVelEP)) DEALLOCATE(OutData%PLinVelEP) - ALLOCATE(OutData%PLinVelEP(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%PLinVelEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEP,3), UBOUND(OutData%PLinVelEP,3) - DO i2 = LBOUND(OutData%PLinVelEP,2), UBOUND(OutData%PLinVelEP,2) - DO i1 = LBOUND(OutData%PLinVelEP,1), UBOUND(OutData%PLinVelEP,1) - OutData%PLinVelEP(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEQ 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%PLinVelEQ)) DEALLOCATE(OutData%PLinVelEQ) - ALLOCATE(OutData%PLinVelEQ(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%PLinVelEQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEQ,3), UBOUND(OutData%PLinVelEQ,3) - DO i2 = LBOUND(OutData%PLinVelEQ,2), UBOUND(OutData%PLinVelEQ,2) - DO i1 = LBOUND(OutData%PLinVelEQ,1), UBOUND(OutData%PLinVelEQ,1) - OutData%PLinVelEQ(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEU 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%PLinVelEU)) DEALLOCATE(OutData%PLinVelEU) - ALLOCATE(OutData%PLinVelEU(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%PLinVelEU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEU,3), UBOUND(OutData%PLinVelEU,3) - DO i2 = LBOUND(OutData%PLinVelEU,2), UBOUND(OutData%PLinVelEU,2) - DO i1 = LBOUND(OutData%PLinVelEU,1), UBOUND(OutData%PLinVelEU,1) - OutData%PLinVelEU(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEV 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%PLinVelEV)) DEALLOCATE(OutData%PLinVelEV) - ALLOCATE(OutData%PLinVelEV(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%PLinVelEV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEV,3), UBOUND(OutData%PLinVelEV,3) - DO i2 = LBOUND(OutData%PLinVelEV,2), UBOUND(OutData%PLinVelEV,2) - DO i1 = LBOUND(OutData%PLinVelEV,1), UBOUND(OutData%PLinVelEV,1) - OutData%PLinVelEV(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEW 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%PLinVelEW)) DEALLOCATE(OutData%PLinVelEW) - ALLOCATE(OutData%PLinVelEW(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%PLinVelEW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEW,3), UBOUND(OutData%PLinVelEW,3) - DO i2 = LBOUND(OutData%PLinVelEW,2), UBOUND(OutData%PLinVelEW,2) - DO i1 = LBOUND(OutData%PLinVelEW,1), UBOUND(OutData%PLinVelEW,1) - OutData%PLinVelEW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEY 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%PLinVelEY)) DEALLOCATE(OutData%PLinVelEY) - ALLOCATE(OutData%PLinVelEY(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%PLinVelEY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEY,3), UBOUND(OutData%PLinVelEY,3) - DO i2 = LBOUND(OutData%PLinVelEY,2), UBOUND(OutData%PLinVelEY,2) - DO i1 = LBOUND(OutData%PLinVelEY,1), UBOUND(OutData%PLinVelEY,1) - OutData%PLinVelEY(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%LinAccEIMUt,1) - i1_u = UBOUND(OutData%LinAccEIMUt,1) - DO i1 = LBOUND(OutData%LinAccEIMUt,1), UBOUND(OutData%LinAccEIMUt,1) - OutData%LinAccEIMUt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEOt,1) - i1_u = UBOUND(OutData%LinAccEOt,1) - DO i1 = LBOUND(OutData%LinAccEOt,1), UBOUND(OutData%LinAccEOt,1) - OutData%LinAccEOt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinAccESt 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%LinAccESt)) DEALLOCATE(OutData%LinAccESt) - ALLOCATE(OutData%LinAccESt(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%LinAccESt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%LinAccESt,3), UBOUND(OutData%LinAccESt,3) - DO i2 = LBOUND(OutData%LinAccESt,2), UBOUND(OutData%LinAccESt,2) - DO i1 = LBOUND(OutData%LinAccESt,1), UBOUND(OutData%LinAccESt,1) - OutData%LinAccESt(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinAccETt 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%LinAccETt)) DEALLOCATE(OutData%LinAccETt) - ALLOCATE(OutData%LinAccETt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccETt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LinAccETt,2), UBOUND(OutData%LinAccETt,2) - DO i1 = LBOUND(OutData%LinAccETt,1), UBOUND(OutData%LinAccETt,1) - OutData%LinAccETt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%LinAccEZt,1) - i1_u = UBOUND(OutData%LinAccEZt,1) - DO i1 = LBOUND(OutData%LinAccEZt,1), UBOUND(OutData%LinAccEZt,1) - OutData%LinAccEZt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinVelEIMU,1) - i1_u = UBOUND(OutData%LinVelEIMU,1) - DO i1 = LBOUND(OutData%LinVelEIMU,1), UBOUND(OutData%LinVelEIMU,1) - OutData%LinVelEIMU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinVelEZ,1) - i1_u = UBOUND(OutData%LinVelEZ,1) - DO i1 = LBOUND(OutData%LinVelEZ,1), UBOUND(OutData%LinVelEZ,1) - OutData%LinVelEZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinVelEO,1) - i1_u = UBOUND(OutData%LinVelEO,1) - DO i1 = LBOUND(OutData%LinVelEO,1), UBOUND(OutData%LinVelEO,1) - OutData%LinVelEO(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinVelEJ,1) - i1_u = UBOUND(OutData%LinVelEJ,1) - DO i1 = LBOUND(OutData%LinVelEJ,1), UBOUND(OutData%LinVelEJ,1) - OutData%LinVelEJ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FrcONcRtt,1) - i1_u = UBOUND(OutData%FrcONcRtt,1) - DO i1 = LBOUND(OutData%FrcONcRtt,1), UBOUND(OutData%FrcONcRtt,1) - OutData%FrcONcRtt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FrcPRott,1) - i1_u = UBOUND(OutData%FrcPRott,1) - DO i1 = LBOUND(OutData%FrcPRott,1), UBOUND(OutData%FrcPRott,1) - OutData%FrcPRott(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FrcS0Bt 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%FrcS0Bt)) DEALLOCATE(OutData%FrcS0Bt) - ALLOCATE(OutData%FrcS0Bt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FrcS0Bt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FrcS0Bt,2), UBOUND(OutData%FrcS0Bt,2) - DO i1 = LBOUND(OutData%FrcS0Bt,1), UBOUND(OutData%FrcS0Bt,1) - OutData%FrcS0Bt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%FrcT0Trbt,1) - i1_u = UBOUND(OutData%FrcT0Trbt,1) - DO i1 = LBOUND(OutData%FrcT0Trbt,1), UBOUND(OutData%FrcT0Trbt,1) - OutData%FrcT0Trbt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSAero 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%FSAero)) DEALLOCATE(OutData%FSAero) - ALLOCATE(OutData%FSAero(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%FSAero.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%FSAero,3), UBOUND(OutData%FSAero,3) - DO i2 = LBOUND(OutData%FSAero,2), UBOUND(OutData%FSAero,2) - DO i1 = LBOUND(OutData%FSAero,1), UBOUND(OutData%FSAero,1) - OutData%FSAero(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSTipDrag 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%FSTipDrag)) DEALLOCATE(OutData%FSTipDrag) - ALLOCATE(OutData%FSTipDrag(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSTipDrag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FSTipDrag,2), UBOUND(OutData%FSTipDrag,2) - DO i1 = LBOUND(OutData%FSTipDrag,1), UBOUND(OutData%FSTipDrag,1) - OutData%FSTipDrag(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTHydrot 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%FTHydrot)) DEALLOCATE(OutData%FTHydrot) - ALLOCATE(OutData%FTHydrot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTHydrot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FTHydrot,2), UBOUND(OutData%FTHydrot,2) - DO i1 = LBOUND(OutData%FTHydrot,1), UBOUND(OutData%FTHydrot,1) - OutData%FTHydrot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%FZHydrot,1) - i1_u = UBOUND(OutData%FZHydrot,1) - DO i1 = LBOUND(OutData%FZHydrot,1), UBOUND(OutData%FZHydrot,1) - OutData%FZHydrot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MFHydrot 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%MFHydrot)) DEALLOCATE(OutData%MFHydrot) - ALLOCATE(OutData%MFHydrot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MFHydrot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MFHydrot,2), UBOUND(OutData%MFHydrot,2) - DO i1 = LBOUND(OutData%MFHydrot,1), UBOUND(OutData%MFHydrot,1) - OutData%MFHydrot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%MomBNcRtt,1) - i1_u = UBOUND(OutData%MomBNcRtt,1) - DO i1 = LBOUND(OutData%MomBNcRtt,1), UBOUND(OutData%MomBNcRtt,1) - OutData%MomBNcRtt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MomH0Bt 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%MomH0Bt)) DEALLOCATE(OutData%MomH0Bt) - ALLOCATE(OutData%MomH0Bt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MomH0Bt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MomH0Bt,2), UBOUND(OutData%MomH0Bt,2) - DO i1 = LBOUND(OutData%MomH0Bt,1), UBOUND(OutData%MomH0Bt,1) - OutData%MomH0Bt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%MomLPRott,1) - i1_u = UBOUND(OutData%MomLPRott,1) - DO i1 = LBOUND(OutData%MomLPRott,1), UBOUND(OutData%MomLPRott,1) - OutData%MomLPRott(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%MomNGnRtt,1) - i1_u = UBOUND(OutData%MomNGnRtt,1) - DO i1 = LBOUND(OutData%MomNGnRtt,1), UBOUND(OutData%MomNGnRtt,1) - OutData%MomNGnRtt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%MomNTailt,1) - i1_u = UBOUND(OutData%MomNTailt,1) - DO i1 = LBOUND(OutData%MomNTailt,1), UBOUND(OutData%MomNTailt,1) - OutData%MomNTailt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%MomX0Trbt,1) - i1_u = UBOUND(OutData%MomX0Trbt,1) - DO i1 = LBOUND(OutData%MomX0Trbt,1), UBOUND(OutData%MomX0Trbt,1) - OutData%MomX0Trbt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MMAero 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%MMAero)) DEALLOCATE(OutData%MMAero) - ALLOCATE(OutData%MMAero(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%MMAero.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%MMAero,3), UBOUND(OutData%MMAero,3) - DO i2 = LBOUND(OutData%MMAero,2), UBOUND(OutData%MMAero,2) - DO i1 = LBOUND(OutData%MMAero,1), UBOUND(OutData%MMAero,1) - OutData%MMAero(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%MXHydrot,1) - i1_u = UBOUND(OutData%MXHydrot,1) - DO i1 = LBOUND(OutData%MXHydrot,1), UBOUND(OutData%MXHydrot,1) - OutData%MXHydrot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcONcRt 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%PFrcONcRt)) DEALLOCATE(OutData%PFrcONcRt) - ALLOCATE(OutData%PFrcONcRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcONcRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcONcRt,2), UBOUND(OutData%PFrcONcRt,2) - DO i1 = LBOUND(OutData%PFrcONcRt,1), UBOUND(OutData%PFrcONcRt,1) - OutData%PFrcONcRt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcPRot 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%PFrcPRot)) DEALLOCATE(OutData%PFrcPRot) - ALLOCATE(OutData%PFrcPRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcPRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcPRot,2), UBOUND(OutData%PFrcPRot,2) - DO i1 = LBOUND(OutData%PFrcPRot,1), UBOUND(OutData%PFrcPRot,1) - OutData%PFrcPRot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcS0B 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%PFrcS0B)) DEALLOCATE(OutData%PFrcS0B) - ALLOCATE(OutData%PFrcS0B(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%PFrcS0B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PFrcS0B,3), UBOUND(OutData%PFrcS0B,3) - DO i2 = LBOUND(OutData%PFrcS0B,2), UBOUND(OutData%PFrcS0B,2) - DO i1 = LBOUND(OutData%PFrcS0B,1), UBOUND(OutData%PFrcS0B,1) - OutData%PFrcS0B(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcT0Trb 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%PFrcT0Trb)) DEALLOCATE(OutData%PFrcT0Trb) - ALLOCATE(OutData%PFrcT0Trb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcT0Trb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcT0Trb,2), UBOUND(OutData%PFrcT0Trb,2) - DO i1 = LBOUND(OutData%PFrcT0Trb,1), UBOUND(OutData%PFrcT0Trb,1) - OutData%PFrcT0Trb(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFTHydro 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%PFTHydro)) DEALLOCATE(OutData%PFTHydro) - ALLOCATE(OutData%PFTHydro(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%PFTHydro.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PFTHydro,3), UBOUND(OutData%PFTHydro,3) - DO i2 = LBOUND(OutData%PFTHydro,2), UBOUND(OutData%PFTHydro,2) - DO i1 = LBOUND(OutData%PFTHydro,1), UBOUND(OutData%PFTHydro,1) - OutData%PFTHydro(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%PFZHydro,1) - i1_u = UBOUND(OutData%PFZHydro,1) - i2_l = LBOUND(OutData%PFZHydro,2) - i2_u = UBOUND(OutData%PFZHydro,2) - DO i2 = LBOUND(OutData%PFZHydro,2), UBOUND(OutData%PFZHydro,2) - DO i1 = LBOUND(OutData%PFZHydro,1), UBOUND(OutData%PFZHydro,1) - OutData%PFZHydro(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMFHydro 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%PMFHydro)) DEALLOCATE(OutData%PMFHydro) - ALLOCATE(OutData%PMFHydro(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%PMFHydro.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PMFHydro,3), UBOUND(OutData%PMFHydro,3) - DO i2 = LBOUND(OutData%PMFHydro,2), UBOUND(OutData%PMFHydro,2) - DO i1 = LBOUND(OutData%PMFHydro,1), UBOUND(OutData%PMFHydro,1) - OutData%PMFHydro(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomBNcRt 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%PMomBNcRt)) DEALLOCATE(OutData%PMomBNcRt) - ALLOCATE(OutData%PMomBNcRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomBNcRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomBNcRt,2), UBOUND(OutData%PMomBNcRt,2) - DO i1 = LBOUND(OutData%PMomBNcRt,1), UBOUND(OutData%PMomBNcRt,1) - OutData%PMomBNcRt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomH0B 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%PMomH0B)) DEALLOCATE(OutData%PMomH0B) - ALLOCATE(OutData%PMomH0B(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%PMomH0B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PMomH0B,3), UBOUND(OutData%PMomH0B,3) - DO i2 = LBOUND(OutData%PMomH0B,2), UBOUND(OutData%PMomH0B,2) - DO i1 = LBOUND(OutData%PMomH0B,1), UBOUND(OutData%PMomH0B,1) - OutData%PMomH0B(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomLPRot 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%PMomLPRot)) DEALLOCATE(OutData%PMomLPRot) - ALLOCATE(OutData%PMomLPRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomLPRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomLPRot,2), UBOUND(OutData%PMomLPRot,2) - DO i1 = LBOUND(OutData%PMomLPRot,1), UBOUND(OutData%PMomLPRot,1) - OutData%PMomLPRot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomNGnRt 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%PMomNGnRt)) DEALLOCATE(OutData%PMomNGnRt) - ALLOCATE(OutData%PMomNGnRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNGnRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomNGnRt,2), UBOUND(OutData%PMomNGnRt,2) - DO i1 = LBOUND(OutData%PMomNGnRt,1), UBOUND(OutData%PMomNGnRt,1) - OutData%PMomNGnRt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomNTail 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%PMomNTail)) DEALLOCATE(OutData%PMomNTail) - ALLOCATE(OutData%PMomNTail(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNTail.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomNTail,2), UBOUND(OutData%PMomNTail,2) - DO i1 = LBOUND(OutData%PMomNTail,1), UBOUND(OutData%PMomNTail,1) - OutData%PMomNTail(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomX0Trb 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%PMomX0Trb)) DEALLOCATE(OutData%PMomX0Trb) - ALLOCATE(OutData%PMomX0Trb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomX0Trb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomX0Trb,2), UBOUND(OutData%PMomX0Trb,2) - DO i1 = LBOUND(OutData%PMomX0Trb,1), UBOUND(OutData%PMomX0Trb,1) - OutData%PMomX0Trb(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%PMXHydro,1) - i1_u = UBOUND(OutData%PMXHydro,1) - i2_l = LBOUND(OutData%PMXHydro,2) - i2_u = UBOUND(OutData%PMXHydro,2) - DO i2 = LBOUND(OutData%PMXHydro,2), UBOUND(OutData%PMXHydro,2) - DO i1 = LBOUND(OutData%PMXHydro,1), UBOUND(OutData%PMXHydro,1) - OutData%PMXHydro(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - OutData%TeetAng = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%FrcVGnRtt,1) - i1_u = UBOUND(OutData%FrcVGnRtt,1) - DO i1 = LBOUND(OutData%FrcVGnRtt,1), UBOUND(OutData%FrcVGnRtt,1) - OutData%FrcVGnRtt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FrcWTailt,1) - i1_u = UBOUND(OutData%FrcWTailt,1) - DO i1 = LBOUND(OutData%FrcWTailt,1), UBOUND(OutData%FrcWTailt,1) - OutData%FrcWTailt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FrcZAllt,1) - i1_u = UBOUND(OutData%FrcZAllt,1) - DO i1 = LBOUND(OutData%FrcZAllt,1), UBOUND(OutData%FrcZAllt,1) - OutData%FrcZAllt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%MomXAllt,1) - i1_u = UBOUND(OutData%MomXAllt,1) - DO i1 = LBOUND(OutData%MomXAllt,1), UBOUND(OutData%MomXAllt,1) - OutData%MomXAllt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcVGnRt 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%PFrcVGnRt)) DEALLOCATE(OutData%PFrcVGnRt) - ALLOCATE(OutData%PFrcVGnRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcVGnRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcVGnRt,2), UBOUND(OutData%PFrcVGnRt,2) - DO i1 = LBOUND(OutData%PFrcVGnRt,1), UBOUND(OutData%PFrcVGnRt,1) - OutData%PFrcVGnRt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcWTail 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%PFrcWTail)) DEALLOCATE(OutData%PFrcWTail) - ALLOCATE(OutData%PFrcWTail(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcWTail.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcWTail,2), UBOUND(OutData%PFrcWTail,2) - DO i1 = LBOUND(OutData%PFrcWTail,1), UBOUND(OutData%PFrcWTail,1) - OutData%PFrcWTail(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcZAll 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%PFrcZAll)) DEALLOCATE(OutData%PFrcZAll) - ALLOCATE(OutData%PFrcZAll(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcZAll.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcZAll,2), UBOUND(OutData%PFrcZAll,2) - DO i1 = LBOUND(OutData%PFrcZAll,1), UBOUND(OutData%PFrcZAll,1) - OutData%PFrcZAll(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomXAll 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%PMomXAll)) DEALLOCATE(OutData%PMomXAll) - ALLOCATE(OutData%PMomXAll(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomXAll.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomXAll,2), UBOUND(OutData%PMomXAll,2) - DO i1 = LBOUND(OutData%PMomXAll,1), UBOUND(OutData%PMomXAll,1) - OutData%PMomXAll(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%TeetMom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEffFac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCen 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%rSAerCen)) DEALLOCATE(OutData%rSAerCen) - ALLOCATE(OutData%rSAerCen(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%rSAerCen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rSAerCen,3), UBOUND(OutData%rSAerCen,3) - DO i2 = LBOUND(OutData%rSAerCen,2), UBOUND(OutData%rSAerCen,2) - DO i1 = LBOUND(OutData%rSAerCen,1), UBOUND(OutData%rSAerCen,1) - OutData%rSAerCen(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE ED_UnPackRtHndSide - - SUBROUTINE ED_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(ED_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%QT)) THEN - i1_l = LBOUND(SrcContStateData%QT,1) - i1_u = UBOUND(SrcContStateData%QT,1) - IF (.NOT. ALLOCATED(DstContStateData%QT)) THEN - ALLOCATE(DstContStateData%QT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%QT = SrcContStateData%QT -ENDIF -IF (ALLOCATED(SrcContStateData%QDT)) THEN - i1_l = LBOUND(SrcContStateData%QDT,1) - i1_u = UBOUND(SrcContStateData%QDT,1) - IF (.NOT. ALLOCATED(DstContStateData%QDT)) THEN - ALLOCATE(DstContStateData%QDT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QDT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%QDT = SrcContStateData%QDT -ENDIF - END SUBROUTINE ED_CopyContState - - SUBROUTINE ED_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(ED_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 = 'ED_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%QT)) THEN - DEALLOCATE(ContStateData%QT) -ENDIF -IF (ALLOCATED(ContStateData%QDT)) THEN - DEALLOCATE(ContStateData%QDT) -ENDIF - END SUBROUTINE ED_DestroyContState - - SUBROUTINE ED_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(ED_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 = 'ED_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 - Int_BufSz = Int_BufSz + 1 ! QT allocated yes/no - IF ( ALLOCATED(InData%QT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QT upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QT) ! QT - END IF - Int_BufSz = Int_BufSz + 1 ! QDT allocated yes/no - IF ( ALLOCATED(InData%QDT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QDT upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QDT) ! QDT - 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%QT) ) 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%QT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QT,1), UBOUND(InData%QT,1) - DbKiBuf(Db_Xferred) = InData%QT(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QDT) ) 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%QDT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QDT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QDT,1), UBOUND(InData%QDT,1) - DbKiBuf(Db_Xferred) = InData%QDT(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_PackContState - - SUBROUTINE ED_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(ED_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QT 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%QT)) DEALLOCATE(OutData%QT) - ALLOCATE(OutData%QT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QT,1), UBOUND(OutData%QT,1) - OutData%QT(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QDT 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%QDT)) DEALLOCATE(OutData%QDT) - ALLOCATE(OutData%QDT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QDT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QDT,1), UBOUND(OutData%QDT,1) - OutData%QDT(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_UnPackContState - - SUBROUTINE ED_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(ED_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 = 'ED_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE ED_CopyDiscState - - SUBROUTINE ED_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(ED_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 = 'ED_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE ED_DestroyDiscState - - SUBROUTINE ED_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(ED_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 = 'ED_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 ED_PackDiscState - - SUBROUTINE ED_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(ED_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 = 'ED_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_UnPackDiscState - - SUBROUTINE ED_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(ED_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 = 'ED_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE ED_CopyConstrState - - SUBROUTINE ED_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(ED_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 = 'ED_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE ED_DestroyConstrState - - SUBROUTINE ED_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(ED_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 = 'ED_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 ED_PackConstrState - - SUBROUTINE ED_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(ED_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 = 'ED_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_UnPackConstrState - - SUBROUTINE ED_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(ED_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%n = SrcOtherStateData%n - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL ED_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -IF (ALLOCATED(SrcOtherStateData%IC)) THEN - i1_l = LBOUND(SrcOtherStateData%IC,1) - i1_u = UBOUND(SrcOtherStateData%IC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%IC)) THEN - ALLOCATE(DstOtherStateData%IC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%IC = SrcOtherStateData%IC -ENDIF - DstOtherStateData%HSSBrTrq = SrcOtherStateData%HSSBrTrq - DstOtherStateData%HSSBrTrqC = SrcOtherStateData%HSSBrTrqC - DstOtherStateData%SgnPrvLSTQ = SrcOtherStateData%SgnPrvLSTQ - DstOtherStateData%SgnLSTQ = SrcOtherStateData%SgnLSTQ - END SUBROUTINE ED_CopyOtherState - - SUBROUTINE ED_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(ED_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 = 'ED_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL ED_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -IF (ALLOCATED(OtherStateData%IC)) THEN - DEALLOCATE(OtherStateData%IC) -ENDIF - END SUBROUTINE ED_DestroyOtherState - - SUBROUTINE ED_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(ED_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 = 'ED_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 ! n - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 1 ! IC allocated yes/no - IF ( ALLOCATED(InData%IC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IC upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IC) ! IC - END IF - Re_BufSz = Re_BufSz + 1 ! HSSBrTrq - Re_BufSz = Re_BufSz + 1 ! HSSBrTrqC - Int_BufSz = Int_BufSz + 1 ! SgnPrvLSTQ - Int_BufSz = Int_BufSz + SIZE(InData%SgnLSTQ) ! SgnLSTQ - 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%n - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - 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 - IF ( .NOT. ALLOCATED(InData%IC) ) 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%IC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IC,1), UBOUND(InData%IC,1) - IntKiBuf(Int_Xferred) = InData%IC(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%HSSBrTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SgnPrvLSTQ - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%SgnLSTQ,1), UBOUND(InData%SgnLSTQ,1) - IntKiBuf(Int_Xferred) = InData%SgnLSTQ(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END SUBROUTINE ED_PackOtherState - - SUBROUTINE ED_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(ED_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_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%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,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 ED_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IC 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%IC)) DEALLOCATE(OutData%IC) - ALLOCATE(OutData%IC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IC,1), UBOUND(OutData%IC,1) - OutData%IC(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%HSSBrTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SgnPrvLSTQ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%SgnLSTQ,1) - i1_u = UBOUND(OutData%SgnLSTQ,1) - DO i1 = LBOUND(OutData%SgnLSTQ,1), UBOUND(OutData%SgnLSTQ,1) - OutData%SgnLSTQ(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END SUBROUTINE ED_UnPackOtherState - - SUBROUTINE ED_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(ED_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) :: 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 = 'ED_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL ED_Copycoordsys( SrcMiscData%CoordSys, DstMiscData%CoordSys, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_Copyrthndside( SrcMiscData%RtHS, DstMiscData%RtHS, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF -IF (ALLOCATED(SrcMiscData%AugMat)) THEN - i1_l = LBOUND(SrcMiscData%AugMat,1) - i1_u = UBOUND(SrcMiscData%AugMat,1) - i2_l = LBOUND(SrcMiscData%AugMat,2) - i2_u = UBOUND(SrcMiscData%AugMat,2) - IF (.NOT. ALLOCATED(DstMiscData%AugMat)) THEN - ALLOCATE(DstMiscData%AugMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AugMat = SrcMiscData%AugMat -ENDIF -IF (ALLOCATED(SrcMiscData%AugMat_factor)) THEN - i1_l = LBOUND(SrcMiscData%AugMat_factor,1) - i1_u = UBOUND(SrcMiscData%AugMat_factor,1) - i2_l = LBOUND(SrcMiscData%AugMat_factor,2) - i2_u = UBOUND(SrcMiscData%AugMat_factor,2) - IF (.NOT. ALLOCATED(DstMiscData%AugMat_factor)) THEN - ALLOCATE(DstMiscData%AugMat_factor(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_factor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor -ENDIF -IF (ALLOCATED(SrcMiscData%SolnVec)) THEN - i1_l = LBOUND(SrcMiscData%SolnVec,1) - i1_u = UBOUND(SrcMiscData%SolnVec,1) - IF (.NOT. ALLOCATED(DstMiscData%SolnVec)) THEN - ALLOCATE(DstMiscData%SolnVec(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SolnVec.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SolnVec = SrcMiscData%SolnVec -ENDIF -IF (ALLOCATED(SrcMiscData%AugMat_pivot)) THEN - i1_l = LBOUND(SrcMiscData%AugMat_pivot,1) - i1_u = UBOUND(SrcMiscData%AugMat_pivot,1) - IF (.NOT. ALLOCATED(DstMiscData%AugMat_pivot)) THEN - ALLOCATE(DstMiscData%AugMat_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot -ENDIF -IF (ALLOCATED(SrcMiscData%OgnlGeAzRo)) THEN - i1_l = LBOUND(SrcMiscData%OgnlGeAzRo,1) - i1_u = UBOUND(SrcMiscData%OgnlGeAzRo,1) - IF (.NOT. ALLOCATED(DstMiscData%OgnlGeAzRo)) THEN - ALLOCATE(DstMiscData%OgnlGeAzRo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlGeAzRo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo -ENDIF -IF (ALLOCATED(SrcMiscData%QD2T)) THEN - i1_l = LBOUND(SrcMiscData%QD2T,1) - i1_u = UBOUND(SrcMiscData%QD2T,1) - IF (.NOT. ALLOCATED(DstMiscData%QD2T)) THEN - ALLOCATE(DstMiscData%QD2T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%QD2T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%QD2T = SrcMiscData%QD2T -ENDIF - DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod - END SUBROUTINE ED_CopyMisc - - SUBROUTINE ED_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(ED_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 = 'ED_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL ED_DestroyCoordSys( MiscData%CoordSys, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyRtHndSide( MiscData%RtHS, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%AugMat)) THEN - DEALLOCATE(MiscData%AugMat) -ENDIF -IF (ALLOCATED(MiscData%AugMat_factor)) THEN - DEALLOCATE(MiscData%AugMat_factor) -ENDIF -IF (ALLOCATED(MiscData%SolnVec)) THEN - DEALLOCATE(MiscData%SolnVec) -ENDIF -IF (ALLOCATED(MiscData%AugMat_pivot)) THEN - DEALLOCATE(MiscData%AugMat_pivot) -ENDIF -IF (ALLOCATED(MiscData%OgnlGeAzRo)) THEN - DEALLOCATE(MiscData%OgnlGeAzRo) -ENDIF -IF (ALLOCATED(MiscData%QD2T)) THEN - DEALLOCATE(MiscData%QD2T) -ENDIF - END SUBROUTINE ED_DestroyMisc - - SUBROUTINE ED_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(ED_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 = 'ED_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CoordSys - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CoordSys - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CoordSys - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RtHS - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RtHS - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RtHS - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Int_BufSz = Int_BufSz + 1 ! AugMat allocated yes/no - IF ( ALLOCATED(InData%AugMat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AugMat upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%AugMat) ! AugMat - END IF - Int_BufSz = Int_BufSz + 1 ! AugMat_factor allocated yes/no - IF ( ALLOCATED(InData%AugMat_factor) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AugMat_factor upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%AugMat_factor) ! AugMat_factor - END IF - Int_BufSz = Int_BufSz + 1 ! SolnVec allocated yes/no - IF ( ALLOCATED(InData%SolnVec) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SolnVec upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SolnVec) ! SolnVec - END IF - Int_BufSz = Int_BufSz + 1 ! AugMat_pivot allocated yes/no - IF ( ALLOCATED(InData%AugMat_pivot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AugMat_pivot upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AugMat_pivot) ! AugMat_pivot - END IF - Int_BufSz = Int_BufSz + 1 ! OgnlGeAzRo allocated yes/no - IF ( ALLOCATED(InData%OgnlGeAzRo) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OgnlGeAzRo upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OgnlGeAzRo) ! OgnlGeAzRo - END IF - Int_BufSz = Int_BufSz + 1 ! QD2T allocated yes/no - IF ( ALLOCATED(InData%QD2T) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QD2T upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QD2T) ! QD2T - END IF - Int_BufSz = Int_BufSz + 1 ! IgnoreMod - 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 - - 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 - - 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%AllOuts) ) 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%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AugMat) ) 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%AugMat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AugMat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AugMat,2), UBOUND(InData%AugMat,2) - DO i1 = LBOUND(InData%AugMat,1), UBOUND(InData%AugMat,1) - DbKiBuf(Db_Xferred) = InData%AugMat(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AugMat_factor) ) 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%AugMat_factor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat_factor,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AugMat_factor,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat_factor,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AugMat_factor,2), UBOUND(InData%AugMat_factor,2) - DO i1 = LBOUND(InData%AugMat_factor,1), UBOUND(InData%AugMat_factor,1) - DbKiBuf(Db_Xferred) = InData%AugMat_factor(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SolnVec) ) 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%SolnVec,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SolnVec,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SolnVec,1), UBOUND(InData%SolnVec,1) - DbKiBuf(Db_Xferred) = InData%SolnVec(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AugMat_pivot) ) 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%AugMat_pivot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat_pivot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AugMat_pivot,1), UBOUND(InData%AugMat_pivot,1) - IntKiBuf(Int_Xferred) = InData%AugMat_pivot(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OgnlGeAzRo) ) 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%OgnlGeAzRo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OgnlGeAzRo,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OgnlGeAzRo,1), UBOUND(InData%OgnlGeAzRo,1) - ReKiBuf(Re_Xferred) = InData%OgnlGeAzRo(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QD2T) ) 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%QD2T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QD2T,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QD2T,1), UBOUND(InData%QD2T,1) - DbKiBuf(Db_Xferred) = InData%QD2T(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%IgnoreMod, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_PackMisc - - SUBROUTINE ED_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(ED_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) :: 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 = 'ED_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 - 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 ED_UnpackCoordSys( Re_Buf, Db_Buf, Int_Buf, OutData%CoordSys, ErrStat2, ErrMsg2 ) ! CoordSys - 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) - 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 ED_UnpackRtHndSide( Re_Buf, Db_Buf, Int_Buf, OutData%RtHS, ErrStat2, ErrMsg2 ) ! RtHS - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts 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%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat 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%AugMat)) DEALLOCATE(OutData%AugMat) - ALLOCATE(OutData%AugMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AugMat,2), UBOUND(OutData%AugMat,2) - DO i1 = LBOUND(OutData%AugMat,1), UBOUND(OutData%AugMat,1) - OutData%AugMat(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat_factor 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%AugMat_factor)) DEALLOCATE(OutData%AugMat_factor) - ALLOCATE(OutData%AugMat_factor(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_factor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AugMat_factor,2), UBOUND(OutData%AugMat_factor,2) - DO i1 = LBOUND(OutData%AugMat_factor,1), UBOUND(OutData%AugMat_factor,1) - OutData%AugMat_factor(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SolnVec 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%SolnVec)) DEALLOCATE(OutData%SolnVec) - ALLOCATE(OutData%SolnVec(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SolnVec.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SolnVec,1), UBOUND(OutData%SolnVec,1) - OutData%SolnVec(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat_pivot 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%AugMat_pivot)) DEALLOCATE(OutData%AugMat_pivot) - ALLOCATE(OutData%AugMat_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AugMat_pivot,1), UBOUND(OutData%AugMat_pivot,1) - OutData%AugMat_pivot(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OgnlGeAzRo 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%OgnlGeAzRo)) DEALLOCATE(OutData%OgnlGeAzRo) - ALLOCATE(OutData%OgnlGeAzRo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OgnlGeAzRo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OgnlGeAzRo,1), UBOUND(OutData%OgnlGeAzRo,1) - OutData%OgnlGeAzRo(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QD2T 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%QD2T)) DEALLOCATE(OutData%QD2T) - ALLOCATE(OutData%QD2T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QD2T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QD2T,1), UBOUND(OutData%QD2T,1) - OutData%QD2T(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%IgnoreMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%IgnoreMod) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_UnPackMisc - - SUBROUTINE ED_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ParameterType), INTENT(IN) :: SrcParamData - TYPE(ED_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 = 'ED_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%DT24 = SrcParamData%DT24 - DstParamData%BldNodes = SrcParamData%BldNodes - DstParamData%TipNode = SrcParamData%TipNode - DstParamData%NDOF = SrcParamData%NDOF - DstParamData%TwoPiNB = SrcParamData%TwoPiNB - DstParamData%NAug = SrcParamData%NAug - DstParamData%NPH = SrcParamData%NPH -IF (ALLOCATED(SrcParamData%PH)) THEN - i1_l = LBOUND(SrcParamData%PH,1) - i1_u = UBOUND(SrcParamData%PH,1) - IF (.NOT. ALLOCATED(DstParamData%PH)) THEN - ALLOCATE(DstParamData%PH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PH = SrcParamData%PH -ENDIF - DstParamData%NPM = SrcParamData%NPM -IF (ALLOCATED(SrcParamData%PM)) THEN - i1_l = LBOUND(SrcParamData%PM,1) - i1_u = UBOUND(SrcParamData%PM,1) - i2_l = LBOUND(SrcParamData%PM,2) - i2_u = UBOUND(SrcParamData%PM,2) - IF (.NOT. ALLOCATED(DstParamData%PM)) THEN - ALLOCATE(DstParamData%PM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PM = SrcParamData%PM -ENDIF -IF (ALLOCATED(SrcParamData%DOF_Flag)) THEN - i1_l = LBOUND(SrcParamData%DOF_Flag,1) - i1_u = UBOUND(SrcParamData%DOF_Flag,1) - IF (.NOT. ALLOCATED(DstParamData%DOF_Flag)) THEN - ALLOCATE(DstParamData%DOF_Flag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Flag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DOF_Flag = SrcParamData%DOF_Flag -ENDIF -IF (ALLOCATED(SrcParamData%DOF_Desc)) THEN - i1_l = LBOUND(SrcParamData%DOF_Desc,1) - i1_u = UBOUND(SrcParamData%DOF_Desc,1) - IF (.NOT. ALLOCATED(DstParamData%DOF_Desc)) THEN - ALLOCATE(DstParamData%DOF_Desc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Desc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DOF_Desc = SrcParamData%DOF_Desc -ENDIF - CALL ED_Copyactivedofs( SrcParamData%DOFs, DstParamData%DOFs, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%NBlGages = SrcParamData%NBlGages - DstParamData%NTwGages = SrcParamData%NTwGages -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%Delim = SrcParamData%Delim - DstParamData%AvgNrmTpRd = SrcParamData%AvgNrmTpRd - DstParamData%AzimB1Up = SrcParamData%AzimB1Up - DstParamData%CosDel3 = SrcParamData%CosDel3 -IF (ALLOCATED(SrcParamData%CosPreC)) THEN - i1_l = LBOUND(SrcParamData%CosPreC,1) - i1_u = UBOUND(SrcParamData%CosPreC,1) - IF (.NOT. ALLOCATED(DstParamData%CosPreC)) THEN - ALLOCATE(DstParamData%CosPreC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CosPreC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CosPreC = SrcParamData%CosPreC -ENDIF - DstParamData%CRFrlSkew = SrcParamData%CRFrlSkew - DstParamData%CRFrlSkw2 = SrcParamData%CRFrlSkw2 - DstParamData%CRFrlTilt = SrcParamData%CRFrlTilt - DstParamData%CRFrlTlt2 = SrcParamData%CRFrlTlt2 - DstParamData%CShftSkew = SrcParamData%CShftSkew - DstParamData%CShftTilt = SrcParamData%CShftTilt - DstParamData%CSRFrlSkw = SrcParamData%CSRFrlSkw - DstParamData%CSRFrlTlt = SrcParamData%CSRFrlTlt - DstParamData%CSTFrlSkw = SrcParamData%CSTFrlSkw - DstParamData%CSTFrlTlt = SrcParamData%CSTFrlTlt - DstParamData%CTFrlSkew = SrcParamData%CTFrlSkew - DstParamData%CTFrlSkw2 = SrcParamData%CTFrlSkw2 - DstParamData%CTFrlTilt = SrcParamData%CTFrlTilt - DstParamData%CTFrlTlt2 = SrcParamData%CTFrlTlt2 - DstParamData%HubHt = SrcParamData%HubHt - DstParamData%HubCM = SrcParamData%HubCM - DstParamData%HubRad = SrcParamData%HubRad - DstParamData%NacCMxn = SrcParamData%NacCMxn - DstParamData%NacCMyn = SrcParamData%NacCMyn - DstParamData%NacCMzn = SrcParamData%NacCMzn - DstParamData%OverHang = SrcParamData%OverHang - DstParamData%ProjArea = SrcParamData%ProjArea - DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt - DstParamData%RefTwrHt = SrcParamData%RefTwrHt - DstParamData%RFrlPnt_n = SrcParamData%RFrlPnt_n - DstParamData%rVDxn = SrcParamData%rVDxn - DstParamData%rVDyn = SrcParamData%rVDyn - DstParamData%rVDzn = SrcParamData%rVDzn - DstParamData%rVIMUxn = SrcParamData%rVIMUxn - DstParamData%rVIMUyn = SrcParamData%rVIMUyn - DstParamData%rVIMUzn = SrcParamData%rVIMUzn - DstParamData%rVPxn = SrcParamData%rVPxn - DstParamData%rVPyn = SrcParamData%rVPyn - DstParamData%rVPzn = SrcParamData%rVPzn - DstParamData%rWIxn = SrcParamData%rWIxn - DstParamData%rWIyn = SrcParamData%rWIyn - DstParamData%rWIzn = SrcParamData%rWIzn - DstParamData%rWJxn = SrcParamData%rWJxn - DstParamData%rWJyn = SrcParamData%rWJyn - DstParamData%rWJzn = SrcParamData%rWJzn - DstParamData%rZT0zt = SrcParamData%rZT0zt - DstParamData%rZYzt = SrcParamData%rZYzt - DstParamData%SinDel3 = SrcParamData%SinDel3 -IF (ALLOCATED(SrcParamData%SinPreC)) THEN - i1_l = LBOUND(SrcParamData%SinPreC,1) - i1_u = UBOUND(SrcParamData%SinPreC,1) - IF (.NOT. ALLOCATED(DstParamData%SinPreC)) THEN - ALLOCATE(DstParamData%SinPreC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SinPreC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SinPreC = SrcParamData%SinPreC -ENDIF - DstParamData%SRFrlSkew = SrcParamData%SRFrlSkew - DstParamData%SRFrlSkw2 = SrcParamData%SRFrlSkw2 - DstParamData%SRFrlTilt = SrcParamData%SRFrlTilt - DstParamData%SRFrlTlt2 = SrcParamData%SRFrlTlt2 - DstParamData%SShftSkew = SrcParamData%SShftSkew - DstParamData%SShftTilt = SrcParamData%SShftTilt - DstParamData%STFrlSkew = SrcParamData%STFrlSkew - DstParamData%STFrlSkw2 = SrcParamData%STFrlSkw2 - DstParamData%STFrlTilt = SrcParamData%STFrlTilt - DstParamData%STFrlTlt2 = SrcParamData%STFrlTlt2 - DstParamData%TFrlPnt_n = SrcParamData%TFrlPnt_n - DstParamData%TipRad = SrcParamData%TipRad - DstParamData%TowerHt = SrcParamData%TowerHt - DstParamData%TowerBsHt = SrcParamData%TowerBsHt - DstParamData%UndSling = SrcParamData%UndSling - DstParamData%NumBl = SrcParamData%NumBl -IF (ALLOCATED(SrcParamData%AxRedTFA)) THEN - i1_l = LBOUND(SrcParamData%AxRedTFA,1) - i1_u = UBOUND(SrcParamData%AxRedTFA,1) - i2_l = LBOUND(SrcParamData%AxRedTFA,2) - i2_u = UBOUND(SrcParamData%AxRedTFA,2) - i3_l = LBOUND(SrcParamData%AxRedTFA,3) - i3_u = UBOUND(SrcParamData%AxRedTFA,3) - IF (.NOT. ALLOCATED(DstParamData%AxRedTFA)) THEN - ALLOCATE(DstParamData%AxRedTFA(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%AxRedTFA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AxRedTFA = SrcParamData%AxRedTFA -ENDIF -IF (ALLOCATED(SrcParamData%AxRedTSS)) THEN - i1_l = LBOUND(SrcParamData%AxRedTSS,1) - i1_u = UBOUND(SrcParamData%AxRedTSS,1) - i2_l = LBOUND(SrcParamData%AxRedTSS,2) - i2_u = UBOUND(SrcParamData%AxRedTSS,2) - i3_l = LBOUND(SrcParamData%AxRedTSS,3) - i3_u = UBOUND(SrcParamData%AxRedTSS,3) - IF (.NOT. ALLOCATED(DstParamData%AxRedTSS)) THEN - ALLOCATE(DstParamData%AxRedTSS(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%AxRedTSS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AxRedTSS = SrcParamData%AxRedTSS -ENDIF - DstParamData%CTFA = SrcParamData%CTFA - DstParamData%CTSS = SrcParamData%CTSS -IF (ALLOCATED(SrcParamData%DHNodes)) THEN - i1_l = LBOUND(SrcParamData%DHNodes,1) - i1_u = UBOUND(SrcParamData%DHNodes,1) - IF (.NOT. ALLOCATED(DstParamData%DHNodes)) THEN - ALLOCATE(DstParamData%DHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DHNodes = SrcParamData%DHNodes -ENDIF -IF (ALLOCATED(SrcParamData%HNodes)) THEN - i1_l = LBOUND(SrcParamData%HNodes,1) - i1_u = UBOUND(SrcParamData%HNodes,1) - IF (.NOT. ALLOCATED(DstParamData%HNodes)) THEN - ALLOCATE(DstParamData%HNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%HNodes = SrcParamData%HNodes -ENDIF -IF (ALLOCATED(SrcParamData%HNodesNorm)) THEN - i1_l = LBOUND(SrcParamData%HNodesNorm,1) - i1_u = UBOUND(SrcParamData%HNodesNorm,1) - IF (.NOT. ALLOCATED(DstParamData%HNodesNorm)) THEN - ALLOCATE(DstParamData%HNodesNorm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodesNorm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%HNodesNorm = SrcParamData%HNodesNorm -ENDIF - DstParamData%KTFA = SrcParamData%KTFA - DstParamData%KTSS = SrcParamData%KTSS -IF (ALLOCATED(SrcParamData%MassT)) THEN - i1_l = LBOUND(SrcParamData%MassT,1) - i1_u = UBOUND(SrcParamData%MassT,1) - IF (.NOT. ALLOCATED(DstParamData%MassT)) THEN - ALLOCATE(DstParamData%MassT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MassT = SrcParamData%MassT -ENDIF -IF (ALLOCATED(SrcParamData%StiffTSS)) THEN - i1_l = LBOUND(SrcParamData%StiffTSS,1) - i1_u = UBOUND(SrcParamData%StiffTSS,1) - IF (.NOT. ALLOCATED(DstParamData%StiffTSS)) THEN - ALLOCATE(DstParamData%StiffTSS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTSS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffTSS = SrcParamData%StiffTSS -ENDIF -IF (ALLOCATED(SrcParamData%TwrFASF)) THEN - i1_l = LBOUND(SrcParamData%TwrFASF,1) - i1_u = UBOUND(SrcParamData%TwrFASF,1) - i2_l = LBOUND(SrcParamData%TwrFASF,2) - i2_u = UBOUND(SrcParamData%TwrFASF,2) - i3_l = LBOUND(SrcParamData%TwrFASF,3) - i3_u = UBOUND(SrcParamData%TwrFASF,3) - IF (.NOT. ALLOCATED(DstParamData%TwrFASF)) THEN - ALLOCATE(DstParamData%TwrFASF(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%TwrFASF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TwrFASF = SrcParamData%TwrFASF -ENDIF - DstParamData%TwrFlexL = SrcParamData%TwrFlexL -IF (ALLOCATED(SrcParamData%TwrSSSF)) THEN - i1_l = LBOUND(SrcParamData%TwrSSSF,1) - i1_u = UBOUND(SrcParamData%TwrSSSF,1) - i2_l = LBOUND(SrcParamData%TwrSSSF,2) - i2_u = UBOUND(SrcParamData%TwrSSSF,2) - i3_l = LBOUND(SrcParamData%TwrSSSF,3) - i3_u = UBOUND(SrcParamData%TwrSSSF,3) - IF (.NOT. ALLOCATED(DstParamData%TwrSSSF)) THEN - ALLOCATE(DstParamData%TwrSSSF(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%TwrSSSF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TwrSSSF = SrcParamData%TwrSSSF -ENDIF - DstParamData%TTopNode = SrcParamData%TTopNode - DstParamData%TwrNodes = SrcParamData%TwrNodes - DstParamData%MHK = SrcParamData%MHK -IF (ALLOCATED(SrcParamData%StiffTFA)) THEN - i1_l = LBOUND(SrcParamData%StiffTFA,1) - i1_u = UBOUND(SrcParamData%StiffTFA,1) - IF (.NOT. ALLOCATED(DstParamData%StiffTFA)) THEN - ALLOCATE(DstParamData%StiffTFA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTFA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffTFA = SrcParamData%StiffTFA -ENDIF - DstParamData%AtfaIner = SrcParamData%AtfaIner -IF (ALLOCATED(SrcParamData%BldCG)) THEN - i1_l = LBOUND(SrcParamData%BldCG,1) - i1_u = UBOUND(SrcParamData%BldCG,1) - IF (.NOT. ALLOCATED(DstParamData%BldCG)) THEN - ALLOCATE(DstParamData%BldCG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldCG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldCG = SrcParamData%BldCG -ENDIF -IF (ALLOCATED(SrcParamData%BldMass)) THEN - i1_l = LBOUND(SrcParamData%BldMass,1) - i1_u = UBOUND(SrcParamData%BldMass,1) - IF (.NOT. ALLOCATED(DstParamData%BldMass)) THEN - ALLOCATE(DstParamData%BldMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldMass = SrcParamData%BldMass -ENDIF - DstParamData%BoomMass = SrcParamData%BoomMass -IF (ALLOCATED(SrcParamData%FirstMom)) THEN - i1_l = LBOUND(SrcParamData%FirstMom,1) - i1_u = UBOUND(SrcParamData%FirstMom,1) - IF (.NOT. ALLOCATED(DstParamData%FirstMom)) THEN - ALLOCATE(DstParamData%FirstMom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FirstMom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FirstMom = SrcParamData%FirstMom -ENDIF - DstParamData%GenIner = SrcParamData%GenIner - DstParamData%Hubg1Iner = SrcParamData%Hubg1Iner - DstParamData%Hubg2Iner = SrcParamData%Hubg2Iner - DstParamData%HubMass = SrcParamData%HubMass - DstParamData%Nacd2Iner = SrcParamData%Nacd2Iner - DstParamData%NacMass = SrcParamData%NacMass - DstParamData%PtfmMass = SrcParamData%PtfmMass - DstParamData%PtfmPIner = SrcParamData%PtfmPIner - DstParamData%PtfmRIner = SrcParamData%PtfmRIner - DstParamData%PtfmYIner = SrcParamData%PtfmYIner - DstParamData%RFrlMass = SrcParamData%RFrlMass - DstParamData%RotIner = SrcParamData%RotIner - DstParamData%RotMass = SrcParamData%RotMass - DstParamData%RrfaIner = SrcParamData%RrfaIner -IF (ALLOCATED(SrcParamData%SecondMom)) THEN - i1_l = LBOUND(SrcParamData%SecondMom,1) - i1_u = UBOUND(SrcParamData%SecondMom,1) - IF (.NOT. ALLOCATED(DstParamData%SecondMom)) THEN - ALLOCATE(DstParamData%SecondMom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SecondMom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SecondMom = SrcParamData%SecondMom -ENDIF - DstParamData%TFinMass = SrcParamData%TFinMass - DstParamData%TFrlIner = SrcParamData%TFrlIner -IF (ALLOCATED(SrcParamData%TipMass)) THEN - i1_l = LBOUND(SrcParamData%TipMass,1) - i1_u = UBOUND(SrcParamData%TipMass,1) - IF (.NOT. ALLOCATED(DstParamData%TipMass)) THEN - ALLOCATE(DstParamData%TipMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TipMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TipMass = SrcParamData%TipMass -ENDIF - DstParamData%TurbMass = SrcParamData%TurbMass - DstParamData%TwrMass = SrcParamData%TwrMass - DstParamData%TwrTpMass = SrcParamData%TwrTpMass - DstParamData%YawBrMass = SrcParamData%YawBrMass - DstParamData%Gravity = SrcParamData%Gravity -IF (ALLOCATED(SrcParamData%PitchAxis)) THEN - i1_l = LBOUND(SrcParamData%PitchAxis,1) - i1_u = UBOUND(SrcParamData%PitchAxis,1) - i2_l = LBOUND(SrcParamData%PitchAxis,2) - i2_u = UBOUND(SrcParamData%PitchAxis,2) - IF (.NOT. ALLOCATED(DstParamData%PitchAxis)) THEN - ALLOCATE(DstParamData%PitchAxis(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitchAxis.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PitchAxis = SrcParamData%PitchAxis -ENDIF -IF (ALLOCATED(SrcParamData%AeroTwst)) THEN - i1_l = LBOUND(SrcParamData%AeroTwst,1) - i1_u = UBOUND(SrcParamData%AeroTwst,1) - IF (.NOT. ALLOCATED(DstParamData%AeroTwst)) THEN - ALLOCATE(DstParamData%AeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AeroTwst = SrcParamData%AeroTwst -ENDIF -IF (ALLOCATED(SrcParamData%AxRedBld)) THEN - i1_l = LBOUND(SrcParamData%AxRedBld,1) - i1_u = UBOUND(SrcParamData%AxRedBld,1) - i2_l = LBOUND(SrcParamData%AxRedBld,2) - i2_u = UBOUND(SrcParamData%AxRedBld,2) - i3_l = LBOUND(SrcParamData%AxRedBld,3) - i3_u = UBOUND(SrcParamData%AxRedBld,3) - i4_l = LBOUND(SrcParamData%AxRedBld,4) - i4_u = UBOUND(SrcParamData%AxRedBld,4) - IF (.NOT. ALLOCATED(DstParamData%AxRedBld)) THEN - ALLOCATE(DstParamData%AxRedBld(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%AxRedBld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AxRedBld = SrcParamData%AxRedBld -ENDIF -IF (ALLOCATED(SrcParamData%BldEDamp)) THEN - i1_l = LBOUND(SrcParamData%BldEDamp,1) - i1_u = UBOUND(SrcParamData%BldEDamp,1) - i2_l = LBOUND(SrcParamData%BldEDamp,2) - i2_u = UBOUND(SrcParamData%BldEDamp,2) - IF (.NOT. ALLOCATED(DstParamData%BldEDamp)) THEN - ALLOCATE(DstParamData%BldEDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldEDamp = SrcParamData%BldEDamp -ENDIF -IF (ALLOCATED(SrcParamData%BldFDamp)) THEN - i1_l = LBOUND(SrcParamData%BldFDamp,1) - i1_u = UBOUND(SrcParamData%BldFDamp,1) - i2_l = LBOUND(SrcParamData%BldFDamp,2) - i2_u = UBOUND(SrcParamData%BldFDamp,2) - IF (.NOT. ALLOCATED(DstParamData%BldFDamp)) THEN - ALLOCATE(DstParamData%BldFDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldFDamp = SrcParamData%BldFDamp -ENDIF - DstParamData%BldFlexL = SrcParamData%BldFlexL -IF (ALLOCATED(SrcParamData%CAeroTwst)) THEN - i1_l = LBOUND(SrcParamData%CAeroTwst,1) - i1_u = UBOUND(SrcParamData%CAeroTwst,1) - IF (.NOT. ALLOCATED(DstParamData%CAeroTwst)) THEN - ALLOCATE(DstParamData%CAeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CAeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CAeroTwst = SrcParamData%CAeroTwst -ENDIF -IF (ALLOCATED(SrcParamData%CBE)) THEN - i1_l = LBOUND(SrcParamData%CBE,1) - i1_u = UBOUND(SrcParamData%CBE,1) - i2_l = LBOUND(SrcParamData%CBE,2) - i2_u = UBOUND(SrcParamData%CBE,2) - i3_l = LBOUND(SrcParamData%CBE,3) - i3_u = UBOUND(SrcParamData%CBE,3) - IF (.NOT. ALLOCATED(DstParamData%CBE)) THEN - ALLOCATE(DstParamData%CBE(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%CBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CBE = SrcParamData%CBE -ENDIF -IF (ALLOCATED(SrcParamData%CBF)) THEN - i1_l = LBOUND(SrcParamData%CBF,1) - i1_u = UBOUND(SrcParamData%CBF,1) - i2_l = LBOUND(SrcParamData%CBF,2) - i2_u = UBOUND(SrcParamData%CBF,2) - i3_l = LBOUND(SrcParamData%CBF,3) - i3_u = UBOUND(SrcParamData%CBF,3) - IF (.NOT. ALLOCATED(DstParamData%CBF)) THEN - ALLOCATE(DstParamData%CBF(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%CBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CBF = SrcParamData%CBF -ENDIF -IF (ALLOCATED(SrcParamData%Chord)) THEN - i1_l = LBOUND(SrcParamData%Chord,1) - i1_u = UBOUND(SrcParamData%Chord,1) - IF (.NOT. ALLOCATED(DstParamData%Chord)) THEN - ALLOCATE(DstParamData%Chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Chord = SrcParamData%Chord -ENDIF -IF (ALLOCATED(SrcParamData%CThetaS)) THEN - i1_l = LBOUND(SrcParamData%CThetaS,1) - i1_u = UBOUND(SrcParamData%CThetaS,1) - i2_l = LBOUND(SrcParamData%CThetaS,2) - i2_u = UBOUND(SrcParamData%CThetaS,2) - IF (.NOT. ALLOCATED(DstParamData%CThetaS)) THEN - ALLOCATE(DstParamData%CThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CThetaS = SrcParamData%CThetaS -ENDIF -IF (ALLOCATED(SrcParamData%DRNodes)) THEN - i1_l = LBOUND(SrcParamData%DRNodes,1) - i1_u = UBOUND(SrcParamData%DRNodes,1) - IF (.NOT. ALLOCATED(DstParamData%DRNodes)) THEN - ALLOCATE(DstParamData%DRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DRNodes = SrcParamData%DRNodes -ENDIF -IF (ALLOCATED(SrcParamData%FStTunr)) THEN - i1_l = LBOUND(SrcParamData%FStTunr,1) - i1_u = UBOUND(SrcParamData%FStTunr,1) - i2_l = LBOUND(SrcParamData%FStTunr,2) - i2_u = UBOUND(SrcParamData%FStTunr,2) - IF (.NOT. ALLOCATED(DstParamData%FStTunr)) THEN - ALLOCATE(DstParamData%FStTunr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FStTunr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FStTunr = SrcParamData%FStTunr -ENDIF -IF (ALLOCATED(SrcParamData%KBE)) THEN - i1_l = LBOUND(SrcParamData%KBE,1) - i1_u = UBOUND(SrcParamData%KBE,1) - i2_l = LBOUND(SrcParamData%KBE,2) - i2_u = UBOUND(SrcParamData%KBE,2) - i3_l = LBOUND(SrcParamData%KBE,3) - i3_u = UBOUND(SrcParamData%KBE,3) - IF (.NOT. ALLOCATED(DstParamData%KBE)) THEN - ALLOCATE(DstParamData%KBE(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%KBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KBE = SrcParamData%KBE -ENDIF -IF (ALLOCATED(SrcParamData%KBF)) THEN - i1_l = LBOUND(SrcParamData%KBF,1) - i1_u = UBOUND(SrcParamData%KBF,1) - i2_l = LBOUND(SrcParamData%KBF,2) - i2_u = UBOUND(SrcParamData%KBF,2) - i3_l = LBOUND(SrcParamData%KBF,3) - i3_u = UBOUND(SrcParamData%KBF,3) - IF (.NOT. ALLOCATED(DstParamData%KBF)) THEN - ALLOCATE(DstParamData%KBF(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%KBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KBF = SrcParamData%KBF -ENDIF -IF (ALLOCATED(SrcParamData%MassB)) THEN - i1_l = LBOUND(SrcParamData%MassB,1) - i1_u = UBOUND(SrcParamData%MassB,1) - i2_l = LBOUND(SrcParamData%MassB,2) - i2_u = UBOUND(SrcParamData%MassB,2) - IF (.NOT. ALLOCATED(DstParamData%MassB)) THEN - ALLOCATE(DstParamData%MassB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MassB = SrcParamData%MassB -ENDIF -IF (ALLOCATED(SrcParamData%RNodes)) THEN - i1_l = LBOUND(SrcParamData%RNodes,1) - i1_u = UBOUND(SrcParamData%RNodes,1) - IF (.NOT. ALLOCATED(DstParamData%RNodes)) THEN - ALLOCATE(DstParamData%RNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%RNodes = SrcParamData%RNodes -ENDIF -IF (ALLOCATED(SrcParamData%RNodesNorm)) THEN - i1_l = LBOUND(SrcParamData%RNodesNorm,1) - i1_u = UBOUND(SrcParamData%RNodesNorm,1) - IF (.NOT. ALLOCATED(DstParamData%RNodesNorm)) THEN - ALLOCATE(DstParamData%RNodesNorm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodesNorm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%RNodesNorm = SrcParamData%RNodesNorm -ENDIF -IF (ALLOCATED(SrcParamData%rSAerCenn1)) THEN - i1_l = LBOUND(SrcParamData%rSAerCenn1,1) - i1_u = UBOUND(SrcParamData%rSAerCenn1,1) - i2_l = LBOUND(SrcParamData%rSAerCenn1,2) - i2_u = UBOUND(SrcParamData%rSAerCenn1,2) - IF (.NOT. ALLOCATED(DstParamData%rSAerCenn1)) THEN - ALLOCATE(DstParamData%rSAerCenn1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rSAerCenn1 = SrcParamData%rSAerCenn1 -ENDIF -IF (ALLOCATED(SrcParamData%rSAerCenn2)) THEN - i1_l = LBOUND(SrcParamData%rSAerCenn2,1) - i1_u = UBOUND(SrcParamData%rSAerCenn2,1) - i2_l = LBOUND(SrcParamData%rSAerCenn2,2) - i2_u = UBOUND(SrcParamData%rSAerCenn2,2) - IF (.NOT. ALLOCATED(DstParamData%rSAerCenn2)) THEN - ALLOCATE(DstParamData%rSAerCenn2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rSAerCenn2 = SrcParamData%rSAerCenn2 -ENDIF -IF (ALLOCATED(SrcParamData%SAeroTwst)) THEN - i1_l = LBOUND(SrcParamData%SAeroTwst,1) - i1_u = UBOUND(SrcParamData%SAeroTwst,1) - IF (.NOT. ALLOCATED(DstParamData%SAeroTwst)) THEN - ALLOCATE(DstParamData%SAeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SAeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SAeroTwst = SrcParamData%SAeroTwst -ENDIF -IF (ALLOCATED(SrcParamData%StiffBE)) THEN - i1_l = LBOUND(SrcParamData%StiffBE,1) - i1_u = UBOUND(SrcParamData%StiffBE,1) - i2_l = LBOUND(SrcParamData%StiffBE,2) - i2_u = UBOUND(SrcParamData%StiffBE,2) - IF (.NOT. ALLOCATED(DstParamData%StiffBE)) THEN - ALLOCATE(DstParamData%StiffBE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffBE = SrcParamData%StiffBE -ENDIF -IF (ALLOCATED(SrcParamData%StiffBF)) THEN - i1_l = LBOUND(SrcParamData%StiffBF,1) - i1_u = UBOUND(SrcParamData%StiffBF,1) - i2_l = LBOUND(SrcParamData%StiffBF,2) - i2_u = UBOUND(SrcParamData%StiffBF,2) - IF (.NOT. ALLOCATED(DstParamData%StiffBF)) THEN - ALLOCATE(DstParamData%StiffBF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffBF = SrcParamData%StiffBF -ENDIF -IF (ALLOCATED(SrcParamData%SThetaS)) THEN - i1_l = LBOUND(SrcParamData%SThetaS,1) - i1_u = UBOUND(SrcParamData%SThetaS,1) - i2_l = LBOUND(SrcParamData%SThetaS,2) - i2_u = UBOUND(SrcParamData%SThetaS,2) - IF (.NOT. ALLOCATED(DstParamData%SThetaS)) THEN - ALLOCATE(DstParamData%SThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SThetaS = SrcParamData%SThetaS -ENDIF -IF (ALLOCATED(SrcParamData%ThetaS)) THEN - i1_l = LBOUND(SrcParamData%ThetaS,1) - i1_u = UBOUND(SrcParamData%ThetaS,1) - i2_l = LBOUND(SrcParamData%ThetaS,2) - i2_u = UBOUND(SrcParamData%ThetaS,2) - IF (.NOT. ALLOCATED(DstParamData%ThetaS)) THEN - ALLOCATE(DstParamData%ThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ThetaS = SrcParamData%ThetaS -ENDIF -IF (ALLOCATED(SrcParamData%TwistedSF)) THEN - i1_l = LBOUND(SrcParamData%TwistedSF,1) - i1_u = UBOUND(SrcParamData%TwistedSF,1) - i2_l = LBOUND(SrcParamData%TwistedSF,2) - i2_u = UBOUND(SrcParamData%TwistedSF,2) - i3_l = LBOUND(SrcParamData%TwistedSF,3) - i3_u = UBOUND(SrcParamData%TwistedSF,3) - i4_l = LBOUND(SrcParamData%TwistedSF,4) - i4_u = UBOUND(SrcParamData%TwistedSF,4) - i5_l = LBOUND(SrcParamData%TwistedSF,5) - i5_u = UBOUND(SrcParamData%TwistedSF,5) - IF (.NOT. ALLOCATED(DstParamData%TwistedSF)) THEN - ALLOCATE(DstParamData%TwistedSF(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%TwistedSF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TwistedSF = SrcParamData%TwistedSF -ENDIF -IF (ALLOCATED(SrcParamData%BldFl1Sh)) THEN - i1_l = LBOUND(SrcParamData%BldFl1Sh,1) - i1_u = UBOUND(SrcParamData%BldFl1Sh,1) - i2_l = LBOUND(SrcParamData%BldFl1Sh,2) - i2_u = UBOUND(SrcParamData%BldFl1Sh,2) - IF (.NOT. ALLOCATED(DstParamData%BldFl1Sh)) THEN - ALLOCATE(DstParamData%BldFl1Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldFl1Sh = SrcParamData%BldFl1Sh -ENDIF -IF (ALLOCATED(SrcParamData%BldFl2Sh)) THEN - i1_l = LBOUND(SrcParamData%BldFl2Sh,1) - i1_u = UBOUND(SrcParamData%BldFl2Sh,1) - i2_l = LBOUND(SrcParamData%BldFl2Sh,2) - i2_u = UBOUND(SrcParamData%BldFl2Sh,2) - IF (.NOT. ALLOCATED(DstParamData%BldFl2Sh)) THEN - ALLOCATE(DstParamData%BldFl2Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldFl2Sh = SrcParamData%BldFl2Sh -ENDIF -IF (ALLOCATED(SrcParamData%BldEdgSh)) THEN - i1_l = LBOUND(SrcParamData%BldEdgSh,1) - i1_u = UBOUND(SrcParamData%BldEdgSh,1) - i2_l = LBOUND(SrcParamData%BldEdgSh,2) - i2_u = UBOUND(SrcParamData%BldEdgSh,2) - IF (.NOT. ALLOCATED(DstParamData%BldEdgSh)) THEN - ALLOCATE(DstParamData%BldEdgSh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldEdgSh = SrcParamData%BldEdgSh -ENDIF -IF (ALLOCATED(SrcParamData%FreqBE)) THEN - i1_l = LBOUND(SrcParamData%FreqBE,1) - i1_u = UBOUND(SrcParamData%FreqBE,1) - i2_l = LBOUND(SrcParamData%FreqBE,2) - i2_u = UBOUND(SrcParamData%FreqBE,2) - i3_l = LBOUND(SrcParamData%FreqBE,3) - i3_u = UBOUND(SrcParamData%FreqBE,3) - IF (.NOT. ALLOCATED(DstParamData%FreqBE)) THEN - ALLOCATE(DstParamData%FreqBE(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%FreqBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FreqBE = SrcParamData%FreqBE -ENDIF -IF (ALLOCATED(SrcParamData%FreqBF)) THEN - i1_l = LBOUND(SrcParamData%FreqBF,1) - i1_u = UBOUND(SrcParamData%FreqBF,1) - i2_l = LBOUND(SrcParamData%FreqBF,2) - i2_u = UBOUND(SrcParamData%FreqBF,2) - i3_l = LBOUND(SrcParamData%FreqBF,3) - i3_u = UBOUND(SrcParamData%FreqBF,3) - IF (.NOT. ALLOCATED(DstParamData%FreqBF)) THEN - ALLOCATE(DstParamData%FreqBF(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%FreqBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FreqBF = SrcParamData%FreqBF -ENDIF - DstParamData%FreqTFA = SrcParamData%FreqTFA - DstParamData%FreqTSS = SrcParamData%FreqTSS - DstParamData%TeetCDmp = SrcParamData%TeetCDmp - DstParamData%TeetDmp = SrcParamData%TeetDmp - DstParamData%TeetDmpP = SrcParamData%TeetDmpP - DstParamData%TeetHSSp = SrcParamData%TeetHSSp - DstParamData%TeetHStP = SrcParamData%TeetHStP - DstParamData%TeetSSSp = SrcParamData%TeetSSSp - DstParamData%TeetSStP = SrcParamData%TeetSStP - DstParamData%TeetMod = SrcParamData%TeetMod - DstParamData%TFrlDmp = SrcParamData%TFrlDmp - DstParamData%TFrlDSDmp = SrcParamData%TFrlDSDmp - DstParamData%TFrlDSDP = SrcParamData%TFrlDSDP - DstParamData%TFrlDSSP = SrcParamData%TFrlDSSP - DstParamData%TFrlDSSpr = SrcParamData%TFrlDSSpr - DstParamData%TFrlSpr = SrcParamData%TFrlSpr - DstParamData%TFrlUSDmp = SrcParamData%TFrlUSDmp - DstParamData%TFrlUSDP = SrcParamData%TFrlUSDP - DstParamData%TFrlUSSP = SrcParamData%TFrlUSSP - DstParamData%TFrlUSSpr = SrcParamData%TFrlUSSpr - DstParamData%TFrlMod = SrcParamData%TFrlMod - DstParamData%RFrlDmp = SrcParamData%RFrlDmp - DstParamData%RFrlDSDmp = SrcParamData%RFrlDSDmp - DstParamData%RFrlDSDP = SrcParamData%RFrlDSDP - DstParamData%RFrlDSSP = SrcParamData%RFrlDSSP - DstParamData%RFrlDSSpr = SrcParamData%RFrlDSSpr - DstParamData%RFrlSpr = SrcParamData%RFrlSpr - DstParamData%RFrlUSDmp = SrcParamData%RFrlUSDmp - DstParamData%RFrlUSDP = SrcParamData%RFrlUSDP - DstParamData%RFrlUSSP = SrcParamData%RFrlUSSP - DstParamData%RFrlUSSpr = SrcParamData%RFrlUSSpr - DstParamData%RFrlMod = SrcParamData%RFrlMod - DstParamData%ShftGagL = SrcParamData%ShftGagL - DstParamData%BldGagNd = SrcParamData%BldGagNd - DstParamData%TwrGagNd = SrcParamData%TwrGagNd - DstParamData%TStart = SrcParamData%TStart - DstParamData%DTTorDmp = SrcParamData%DTTorDmp - DstParamData%DTTorSpr = SrcParamData%DTTorSpr - DstParamData%GBRatio = SrcParamData%GBRatio - DstParamData%GBoxEff = SrcParamData%GBoxEff - DstParamData%RotSpeed = SrcParamData%RotSpeed - DstParamData%RootName = SrcParamData%RootName -IF (ALLOCATED(SrcParamData%BElmntMass)) THEN - i1_l = LBOUND(SrcParamData%BElmntMass,1) - i1_u = UBOUND(SrcParamData%BElmntMass,1) - i2_l = LBOUND(SrcParamData%BElmntMass,2) - i2_u = UBOUND(SrcParamData%BElmntMass,2) - IF (.NOT. ALLOCATED(DstParamData%BElmntMass)) THEN - ALLOCATE(DstParamData%BElmntMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BElmntMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BElmntMass = SrcParamData%BElmntMass -ENDIF -IF (ALLOCATED(SrcParamData%TElmntMass)) THEN - i1_l = LBOUND(SrcParamData%TElmntMass,1) - i1_u = UBOUND(SrcParamData%TElmntMass,1) - IF (.NOT. ALLOCATED(DstParamData%TElmntMass)) THEN - ALLOCATE(DstParamData%TElmntMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TElmntMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TElmntMass = SrcParamData%TElmntMass -ENDIF - DstParamData%method = SrcParamData%method - DstParamData%PtfmCMxt = SrcParamData%PtfmCMxt - DstParamData%PtfmCMyt = SrcParamData%PtfmCMyt - DstParamData%BD4Blades = SrcParamData%BD4Blades - DstParamData%UseAD14 = SrcParamData%UseAD14 - DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts - DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts -IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN - i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) - i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN - ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut -IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_u_indx,1) - i1_u = UBOUND(SrcParamData%Jac_u_indx,1) - i2_l = LBOUND(SrcParamData%Jac_u_indx,2) - i2_u = UBOUND(SrcParamData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN - ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcParamData%du)) THEN - i1_l = LBOUND(SrcParamData%du,1) - i1_u = UBOUND(SrcParamData%du,1) - IF (.NOT. ALLOCATED(DstParamData%du)) THEN - ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%du = SrcParamData%du -ENDIF -IF (ALLOCATED(SrcParamData%dx)) THEN - i1_l = LBOUND(SrcParamData%dx,1) - i1_u = UBOUND(SrcParamData%dx,1) - IF (.NOT. ALLOCATED(DstParamData%dx)) THEN - ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dx = SrcParamData%dx -ENDIF - DstParamData%Jac_ny = SrcParamData%Jac_ny - END SUBROUTINE ED_CopyParam - - SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(ED_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 = 'ED_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%PH)) THEN - DEALLOCATE(ParamData%PH) -ENDIF -IF (ALLOCATED(ParamData%PM)) THEN - DEALLOCATE(ParamData%PM) -ENDIF -IF (ALLOCATED(ParamData%DOF_Flag)) THEN - DEALLOCATE(ParamData%DOF_Flag) -ENDIF -IF (ALLOCATED(ParamData%DOF_Desc)) THEN - DEALLOCATE(ParamData%DOF_Desc) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%CosPreC)) THEN - DEALLOCATE(ParamData%CosPreC) -ENDIF -IF (ALLOCATED(ParamData%SinPreC)) THEN - DEALLOCATE(ParamData%SinPreC) -ENDIF -IF (ALLOCATED(ParamData%AxRedTFA)) THEN - DEALLOCATE(ParamData%AxRedTFA) -ENDIF -IF (ALLOCATED(ParamData%AxRedTSS)) THEN - DEALLOCATE(ParamData%AxRedTSS) -ENDIF -IF (ALLOCATED(ParamData%DHNodes)) THEN - DEALLOCATE(ParamData%DHNodes) -ENDIF -IF (ALLOCATED(ParamData%HNodes)) THEN - DEALLOCATE(ParamData%HNodes) -ENDIF -IF (ALLOCATED(ParamData%HNodesNorm)) THEN - DEALLOCATE(ParamData%HNodesNorm) -ENDIF -IF (ALLOCATED(ParamData%MassT)) THEN - DEALLOCATE(ParamData%MassT) -ENDIF -IF (ALLOCATED(ParamData%StiffTSS)) THEN - DEALLOCATE(ParamData%StiffTSS) -ENDIF -IF (ALLOCATED(ParamData%TwrFASF)) THEN - DEALLOCATE(ParamData%TwrFASF) -ENDIF -IF (ALLOCATED(ParamData%TwrSSSF)) THEN - DEALLOCATE(ParamData%TwrSSSF) -ENDIF -IF (ALLOCATED(ParamData%StiffTFA)) THEN - DEALLOCATE(ParamData%StiffTFA) -ENDIF -IF (ALLOCATED(ParamData%BldCG)) THEN - DEALLOCATE(ParamData%BldCG) -ENDIF -IF (ALLOCATED(ParamData%BldMass)) THEN - DEALLOCATE(ParamData%BldMass) -ENDIF -IF (ALLOCATED(ParamData%FirstMom)) THEN - DEALLOCATE(ParamData%FirstMom) -ENDIF -IF (ALLOCATED(ParamData%SecondMom)) THEN - DEALLOCATE(ParamData%SecondMom) -ENDIF -IF (ALLOCATED(ParamData%TipMass)) THEN - DEALLOCATE(ParamData%TipMass) -ENDIF -IF (ALLOCATED(ParamData%PitchAxis)) THEN - DEALLOCATE(ParamData%PitchAxis) -ENDIF -IF (ALLOCATED(ParamData%AeroTwst)) THEN - DEALLOCATE(ParamData%AeroTwst) -ENDIF -IF (ALLOCATED(ParamData%AxRedBld)) THEN - DEALLOCATE(ParamData%AxRedBld) -ENDIF -IF (ALLOCATED(ParamData%BldEDamp)) THEN - DEALLOCATE(ParamData%BldEDamp) -ENDIF -IF (ALLOCATED(ParamData%BldFDamp)) THEN - DEALLOCATE(ParamData%BldFDamp) -ENDIF -IF (ALLOCATED(ParamData%CAeroTwst)) THEN - DEALLOCATE(ParamData%CAeroTwst) -ENDIF -IF (ALLOCATED(ParamData%CBE)) THEN - DEALLOCATE(ParamData%CBE) -ENDIF -IF (ALLOCATED(ParamData%CBF)) THEN - DEALLOCATE(ParamData%CBF) -ENDIF -IF (ALLOCATED(ParamData%Chord)) THEN - DEALLOCATE(ParamData%Chord) -ENDIF -IF (ALLOCATED(ParamData%CThetaS)) THEN - DEALLOCATE(ParamData%CThetaS) -ENDIF -IF (ALLOCATED(ParamData%DRNodes)) THEN - DEALLOCATE(ParamData%DRNodes) -ENDIF -IF (ALLOCATED(ParamData%FStTunr)) THEN - DEALLOCATE(ParamData%FStTunr) -ENDIF -IF (ALLOCATED(ParamData%KBE)) THEN - DEALLOCATE(ParamData%KBE) -ENDIF -IF (ALLOCATED(ParamData%KBF)) THEN - DEALLOCATE(ParamData%KBF) -ENDIF -IF (ALLOCATED(ParamData%MassB)) THEN - DEALLOCATE(ParamData%MassB) -ENDIF -IF (ALLOCATED(ParamData%RNodes)) THEN - DEALLOCATE(ParamData%RNodes) -ENDIF -IF (ALLOCATED(ParamData%RNodesNorm)) THEN - DEALLOCATE(ParamData%RNodesNorm) -ENDIF -IF (ALLOCATED(ParamData%rSAerCenn1)) THEN - DEALLOCATE(ParamData%rSAerCenn1) -ENDIF -IF (ALLOCATED(ParamData%rSAerCenn2)) THEN - DEALLOCATE(ParamData%rSAerCenn2) -ENDIF -IF (ALLOCATED(ParamData%SAeroTwst)) THEN - DEALLOCATE(ParamData%SAeroTwst) -ENDIF -IF (ALLOCATED(ParamData%StiffBE)) THEN - DEALLOCATE(ParamData%StiffBE) -ENDIF -IF (ALLOCATED(ParamData%StiffBF)) THEN - DEALLOCATE(ParamData%StiffBF) -ENDIF -IF (ALLOCATED(ParamData%SThetaS)) THEN - DEALLOCATE(ParamData%SThetaS) -ENDIF -IF (ALLOCATED(ParamData%ThetaS)) THEN - DEALLOCATE(ParamData%ThetaS) -ENDIF -IF (ALLOCATED(ParamData%TwistedSF)) THEN - DEALLOCATE(ParamData%TwistedSF) -ENDIF -IF (ALLOCATED(ParamData%BldFl1Sh)) THEN - DEALLOCATE(ParamData%BldFl1Sh) -ENDIF -IF (ALLOCATED(ParamData%BldFl2Sh)) THEN - DEALLOCATE(ParamData%BldFl2Sh) -ENDIF -IF (ALLOCATED(ParamData%BldEdgSh)) THEN - DEALLOCATE(ParamData%BldEdgSh) -ENDIF -IF (ALLOCATED(ParamData%FreqBE)) THEN - DEALLOCATE(ParamData%FreqBE) -ENDIF -IF (ALLOCATED(ParamData%FreqBF)) THEN - DEALLOCATE(ParamData%FreqBF) -ENDIF -IF (ALLOCATED(ParamData%BElmntMass)) THEN - DEALLOCATE(ParamData%BElmntMass) -ENDIF -IF (ALLOCATED(ParamData%TElmntMass)) THEN - DEALLOCATE(ParamData%TElmntMass) -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%BldNd_OutParam) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF -IF (ALLOCATED(ParamData%dx)) THEN - DEALLOCATE(ParamData%dx) -ENDIF - END SUBROUTINE ED_DestroyParam - - SUBROUTINE ED_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(ED_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 = 'ED_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 ! DT24 - Int_BufSz = Int_BufSz + 1 ! BldNodes - Int_BufSz = Int_BufSz + 1 ! TipNode - Int_BufSz = Int_BufSz + 1 ! NDOF - Db_BufSz = Db_BufSz + 1 ! TwoPiNB - Int_BufSz = Int_BufSz + 1 ! NAug - Int_BufSz = Int_BufSz + 1 ! NPH - Int_BufSz = Int_BufSz + 1 ! PH allocated yes/no - IF ( ALLOCATED(InData%PH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PH upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PH) ! PH - END IF - Int_BufSz = Int_BufSz + 1 ! NPM - Int_BufSz = Int_BufSz + 1 ! PM allocated yes/no - IF ( ALLOCATED(InData%PM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PM upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PM) ! PM - END IF - Int_BufSz = Int_BufSz + 1 ! DOF_Flag allocated yes/no - IF ( ALLOCATED(InData%DOF_Flag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DOF_Flag upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DOF_Flag) ! DOF_Flag - END IF - Int_BufSz = Int_BufSz + 1 ! DOF_Desc allocated yes/no - IF ( ALLOCATED(InData%DOF_Desc) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DOF_Desc upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DOF_Desc)*LEN(InData%DOF_Desc) ! DOF_Desc - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DOFs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DOFs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DOFs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1 ! NBlGages - Int_BufSz = Int_BufSz + 1 ! NTwGages - 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 - 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*LEN(InData%Delim) ! Delim - Re_BufSz = Re_BufSz + 1 ! AvgNrmTpRd - Db_BufSz = Db_BufSz + 1 ! AzimB1Up - Db_BufSz = Db_BufSz + 1 ! CosDel3 - Int_BufSz = Int_BufSz + 1 ! CosPreC allocated yes/no - IF ( ALLOCATED(InData%CosPreC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CosPreC upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%CosPreC) ! CosPreC - END IF - Db_BufSz = Db_BufSz + 1 ! CRFrlSkew - Db_BufSz = Db_BufSz + 1 ! CRFrlSkw2 - Db_BufSz = Db_BufSz + 1 ! CRFrlTilt - Db_BufSz = Db_BufSz + 1 ! CRFrlTlt2 - Db_BufSz = Db_BufSz + 1 ! CShftSkew - Db_BufSz = Db_BufSz + 1 ! CShftTilt - Db_BufSz = Db_BufSz + 1 ! CSRFrlSkw - Db_BufSz = Db_BufSz + 1 ! CSRFrlTlt - Db_BufSz = Db_BufSz + 1 ! CSTFrlSkw - Db_BufSz = Db_BufSz + 1 ! CSTFrlTlt - Db_BufSz = Db_BufSz + 1 ! CTFrlSkew - Db_BufSz = Db_BufSz + 1 ! CTFrlSkw2 - Db_BufSz = Db_BufSz + 1 ! CTFrlTilt - Db_BufSz = Db_BufSz + 1 ! CTFrlTlt2 - Re_BufSz = Re_BufSz + 1 ! HubHt - Re_BufSz = Re_BufSz + 1 ! HubCM - Re_BufSz = Re_BufSz + 1 ! HubRad - Re_BufSz = Re_BufSz + 1 ! NacCMxn - Re_BufSz = Re_BufSz + 1 ! NacCMyn - Re_BufSz = Re_BufSz + 1 ! NacCMzn - Re_BufSz = Re_BufSz + 1 ! OverHang - Re_BufSz = Re_BufSz + 1 ! ProjArea - Re_BufSz = Re_BufSz + 1 ! PtfmRefzt - Re_BufSz = Re_BufSz + 1 ! RefTwrHt - Re_BufSz = Re_BufSz + SIZE(InData%RFrlPnt_n) ! RFrlPnt_n - Re_BufSz = Re_BufSz + 1 ! rVDxn - Re_BufSz = Re_BufSz + 1 ! rVDyn - Re_BufSz = Re_BufSz + 1 ! rVDzn - Re_BufSz = Re_BufSz + 1 ! rVIMUxn - Re_BufSz = Re_BufSz + 1 ! rVIMUyn - Re_BufSz = Re_BufSz + 1 ! rVIMUzn - Re_BufSz = Re_BufSz + 1 ! rVPxn - Re_BufSz = Re_BufSz + 1 ! rVPyn - Re_BufSz = Re_BufSz + 1 ! rVPzn - Re_BufSz = Re_BufSz + 1 ! rWIxn - Re_BufSz = Re_BufSz + 1 ! rWIyn - Re_BufSz = Re_BufSz + 1 ! rWIzn - Re_BufSz = Re_BufSz + 1 ! rWJxn - Re_BufSz = Re_BufSz + 1 ! rWJyn - Re_BufSz = Re_BufSz + 1 ! rWJzn - Re_BufSz = Re_BufSz + 1 ! rZT0zt - Re_BufSz = Re_BufSz + 1 ! rZYzt - Db_BufSz = Db_BufSz + 1 ! SinDel3 - Int_BufSz = Int_BufSz + 1 ! SinPreC allocated yes/no - IF ( ALLOCATED(InData%SinPreC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SinPreC upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SinPreC) ! SinPreC - END IF - Db_BufSz = Db_BufSz + 1 ! SRFrlSkew - Db_BufSz = Db_BufSz + 1 ! SRFrlSkw2 - Db_BufSz = Db_BufSz + 1 ! SRFrlTilt - Db_BufSz = Db_BufSz + 1 ! SRFrlTlt2 - Db_BufSz = Db_BufSz + 1 ! SShftSkew - Db_BufSz = Db_BufSz + 1 ! SShftTilt - Db_BufSz = Db_BufSz + 1 ! STFrlSkew - Db_BufSz = Db_BufSz + 1 ! STFrlSkw2 - Db_BufSz = Db_BufSz + 1 ! STFrlTilt - Db_BufSz = Db_BufSz + 1 ! STFrlTlt2 - Re_BufSz = Re_BufSz + SIZE(InData%TFrlPnt_n) ! TFrlPnt_n - Re_BufSz = Re_BufSz + 1 ! TipRad - Re_BufSz = Re_BufSz + 1 ! TowerHt - Re_BufSz = Re_BufSz + 1 ! TowerBsHt - Re_BufSz = Re_BufSz + 1 ! UndSling - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1 ! AxRedTFA allocated yes/no - IF ( ALLOCATED(InData%AxRedTFA) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AxRedTFA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxRedTFA) ! AxRedTFA - END IF - Int_BufSz = Int_BufSz + 1 ! AxRedTSS allocated yes/no - IF ( ALLOCATED(InData%AxRedTSS) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AxRedTSS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxRedTSS) ! AxRedTSS - END IF - Re_BufSz = Re_BufSz + SIZE(InData%CTFA) ! CTFA - Re_BufSz = Re_BufSz + SIZE(InData%CTSS) ! CTSS - Int_BufSz = Int_BufSz + 1 ! DHNodes allocated yes/no - IF ( ALLOCATED(InData%DHNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DHNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DHNodes) ! DHNodes - END IF - Int_BufSz = Int_BufSz + 1 ! HNodes allocated yes/no - IF ( ALLOCATED(InData%HNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HNodes) ! HNodes - END IF - Int_BufSz = Int_BufSz + 1 ! HNodesNorm allocated yes/no - IF ( ALLOCATED(InData%HNodesNorm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HNodesNorm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HNodesNorm) ! HNodesNorm - END IF - Re_BufSz = Re_BufSz + SIZE(InData%KTFA) ! KTFA - Re_BufSz = Re_BufSz + SIZE(InData%KTSS) ! KTSS - Int_BufSz = Int_BufSz + 1 ! MassT allocated yes/no - IF ( ALLOCATED(InData%MassT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MassT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MassT) ! MassT - END IF - Int_BufSz = Int_BufSz + 1 ! StiffTSS allocated yes/no - IF ( ALLOCATED(InData%StiffTSS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StiffTSS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StiffTSS) ! StiffTSS - END IF - Int_BufSz = Int_BufSz + 1 ! TwrFASF allocated yes/no - IF ( ALLOCATED(InData%TwrFASF) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! TwrFASF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrFASF) ! TwrFASF - END IF - Re_BufSz = Re_BufSz + 1 ! TwrFlexL - Int_BufSz = Int_BufSz + 1 ! TwrSSSF allocated yes/no - IF ( ALLOCATED(InData%TwrSSSF) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! TwrSSSF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrSSSF) ! TwrSSSF - END IF - Int_BufSz = Int_BufSz + 1 ! TTopNode - Int_BufSz = Int_BufSz + 1 ! TwrNodes - Int_BufSz = Int_BufSz + 1 ! MHK - Int_BufSz = Int_BufSz + 1 ! StiffTFA allocated yes/no - IF ( ALLOCATED(InData%StiffTFA) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StiffTFA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StiffTFA) ! StiffTFA - END IF - Re_BufSz = Re_BufSz + 1 ! AtfaIner - Int_BufSz = Int_BufSz + 1 ! BldCG allocated yes/no - IF ( ALLOCATED(InData%BldCG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldCG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldCG) ! BldCG - END IF - Int_BufSz = Int_BufSz + 1 ! BldMass allocated yes/no - IF ( ALLOCATED(InData%BldMass) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldMass) ! BldMass - END IF - Re_BufSz = Re_BufSz + 1 ! BoomMass - Int_BufSz = Int_BufSz + 1 ! FirstMom allocated yes/no - IF ( ALLOCATED(InData%FirstMom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FirstMom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FirstMom) ! FirstMom - END IF - Re_BufSz = Re_BufSz + 1 ! GenIner - Re_BufSz = Re_BufSz + 1 ! Hubg1Iner - Re_BufSz = Re_BufSz + 1 ! Hubg2Iner - Re_BufSz = Re_BufSz + 1 ! HubMass - Re_BufSz = Re_BufSz + 1 ! Nacd2Iner - Re_BufSz = Re_BufSz + 1 ! NacMass - Re_BufSz = Re_BufSz + 1 ! PtfmMass - Re_BufSz = Re_BufSz + 1 ! PtfmPIner - Re_BufSz = Re_BufSz + 1 ! PtfmRIner - Re_BufSz = Re_BufSz + 1 ! PtfmYIner - Re_BufSz = Re_BufSz + 1 ! RFrlMass - Re_BufSz = Re_BufSz + 1 ! RotIner - Re_BufSz = Re_BufSz + 1 ! RotMass - Re_BufSz = Re_BufSz + 1 ! RrfaIner - Int_BufSz = Int_BufSz + 1 ! SecondMom allocated yes/no - IF ( ALLOCATED(InData%SecondMom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SecondMom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SecondMom) ! SecondMom - END IF - Re_BufSz = Re_BufSz + 1 ! TFinMass - Re_BufSz = Re_BufSz + 1 ! TFrlIner - Int_BufSz = Int_BufSz + 1 ! TipMass allocated yes/no - IF ( ALLOCATED(InData%TipMass) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TipMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TipMass) ! TipMass - END IF - Re_BufSz = Re_BufSz + 1 ! TurbMass - Re_BufSz = Re_BufSz + 1 ! TwrMass - Re_BufSz = Re_BufSz + 1 ! TwrTpMass - Re_BufSz = Re_BufSz + 1 ! YawBrMass - Re_BufSz = Re_BufSz + 1 ! Gravity - Int_BufSz = Int_BufSz + 1 ! PitchAxis allocated yes/no - IF ( ALLOCATED(InData%PitchAxis) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PitchAxis upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PitchAxis) ! PitchAxis - END IF - Int_BufSz = Int_BufSz + 1 ! AeroTwst allocated yes/no - IF ( ALLOCATED(InData%AeroTwst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AeroTwst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AeroTwst) ! AeroTwst - END IF - Int_BufSz = Int_BufSz + 1 ! AxRedBld allocated yes/no - IF ( ALLOCATED(InData%AxRedBld) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! AxRedBld upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxRedBld) ! AxRedBld - END IF - Int_BufSz = Int_BufSz + 1 ! BldEDamp allocated yes/no - IF ( ALLOCATED(InData%BldEDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldEDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldEDamp) ! BldEDamp - END IF - Int_BufSz = Int_BufSz + 1 ! BldFDamp allocated yes/no - IF ( ALLOCATED(InData%BldFDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldFDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldFDamp) ! BldFDamp - END IF - Re_BufSz = Re_BufSz + 1 ! BldFlexL - Int_BufSz = Int_BufSz + 1 ! CAeroTwst allocated yes/no - IF ( ALLOCATED(InData%CAeroTwst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CAeroTwst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CAeroTwst) ! CAeroTwst - END IF - Int_BufSz = Int_BufSz + 1 ! CBE allocated yes/no - IF ( ALLOCATED(InData%CBE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CBE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CBE) ! CBE - END IF - Int_BufSz = Int_BufSz + 1 ! CBF allocated yes/no - IF ( ALLOCATED(InData%CBF) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CBF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CBF) ! CBF - END IF - Int_BufSz = Int_BufSz + 1 ! Chord allocated yes/no - IF ( ALLOCATED(InData%Chord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Chord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Chord) ! Chord - END IF - Int_BufSz = Int_BufSz + 1 ! CThetaS allocated yes/no - IF ( ALLOCATED(InData%CThetaS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CThetaS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%CThetaS) ! CThetaS - END IF - Int_BufSz = Int_BufSz + 1 ! DRNodes allocated yes/no - IF ( ALLOCATED(InData%DRNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DRNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DRNodes) ! DRNodes - END IF - Int_BufSz = Int_BufSz + 1 ! FStTunr allocated yes/no - IF ( ALLOCATED(InData%FStTunr) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FStTunr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FStTunr) ! FStTunr - END IF - Int_BufSz = Int_BufSz + 1 ! KBE allocated yes/no - IF ( ALLOCATED(InData%KBE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! KBE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KBE) ! KBE - END IF - Int_BufSz = Int_BufSz + 1 ! KBF allocated yes/no - IF ( ALLOCATED(InData%KBF) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! KBF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KBF) ! KBF - END IF - Int_BufSz = Int_BufSz + 1 ! MassB allocated yes/no - IF ( ALLOCATED(InData%MassB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MassB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MassB) ! MassB - END IF - Int_BufSz = Int_BufSz + 1 ! RNodes allocated yes/no - IF ( ALLOCATED(InData%RNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RNodes) ! RNodes - END IF - Int_BufSz = Int_BufSz + 1 ! RNodesNorm allocated yes/no - IF ( ALLOCATED(InData%RNodesNorm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RNodesNorm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RNodesNorm) ! RNodesNorm - END IF - Int_BufSz = Int_BufSz + 1 ! rSAerCenn1 allocated yes/no - IF ( ALLOCATED(InData%rSAerCenn1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rSAerCenn1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rSAerCenn1) ! rSAerCenn1 - END IF - Int_BufSz = Int_BufSz + 1 ! rSAerCenn2 allocated yes/no - IF ( ALLOCATED(InData%rSAerCenn2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rSAerCenn2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rSAerCenn2) ! rSAerCenn2 - END IF - Int_BufSz = Int_BufSz + 1 ! SAeroTwst allocated yes/no - IF ( ALLOCATED(InData%SAeroTwst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SAeroTwst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SAeroTwst) ! SAeroTwst - END IF - Int_BufSz = Int_BufSz + 1 ! StiffBE allocated yes/no - IF ( ALLOCATED(InData%StiffBE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StiffBE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StiffBE) ! StiffBE - END IF - Int_BufSz = Int_BufSz + 1 ! StiffBF allocated yes/no - IF ( ALLOCATED(InData%StiffBF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StiffBF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StiffBF) ! StiffBF - END IF - Int_BufSz = Int_BufSz + 1 ! SThetaS allocated yes/no - IF ( ALLOCATED(InData%SThetaS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SThetaS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SThetaS) ! SThetaS - END IF - Int_BufSz = Int_BufSz + 1 ! ThetaS allocated yes/no - IF ( ALLOCATED(InData%ThetaS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ThetaS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ThetaS) ! ThetaS - END IF - Int_BufSz = Int_BufSz + 1 ! TwistedSF allocated yes/no - IF ( ALLOCATED(InData%TwistedSF) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! TwistedSF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwistedSF) ! TwistedSF - END IF - Int_BufSz = Int_BufSz + 1 ! BldFl1Sh allocated yes/no - IF ( ALLOCATED(InData%BldFl1Sh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldFl1Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldFl1Sh) ! BldFl1Sh - END IF - Int_BufSz = Int_BufSz + 1 ! BldFl2Sh allocated yes/no - IF ( ALLOCATED(InData%BldFl2Sh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldFl2Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldFl2Sh) ! BldFl2Sh - END IF - Int_BufSz = Int_BufSz + 1 ! BldEdgSh allocated yes/no - IF ( ALLOCATED(InData%BldEdgSh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldEdgSh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldEdgSh) ! BldEdgSh - END IF - Int_BufSz = Int_BufSz + 1 ! FreqBE allocated yes/no - IF ( ALLOCATED(InData%FreqBE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! FreqBE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FreqBE) ! FreqBE - END IF - Int_BufSz = Int_BufSz + 1 ! FreqBF allocated yes/no - IF ( ALLOCATED(InData%FreqBF) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! FreqBF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FreqBF) ! FreqBF - END IF - Re_BufSz = Re_BufSz + SIZE(InData%FreqTFA) ! FreqTFA - Re_BufSz = Re_BufSz + SIZE(InData%FreqTSS) ! FreqTSS - Re_BufSz = Re_BufSz + 1 ! TeetCDmp - Re_BufSz = Re_BufSz + 1 ! TeetDmp - Re_BufSz = Re_BufSz + 1 ! TeetDmpP - Re_BufSz = Re_BufSz + 1 ! TeetHSSp - Re_BufSz = Re_BufSz + 1 ! TeetHStP - Re_BufSz = Re_BufSz + 1 ! TeetSSSp - Re_BufSz = Re_BufSz + 1 ! TeetSStP - Int_BufSz = Int_BufSz + 1 ! TeetMod - Re_BufSz = Re_BufSz + 1 ! TFrlDmp - Re_BufSz = Re_BufSz + 1 ! TFrlDSDmp - Re_BufSz = Re_BufSz + 1 ! TFrlDSDP - Re_BufSz = Re_BufSz + 1 ! TFrlDSSP - Re_BufSz = Re_BufSz + 1 ! TFrlDSSpr - Re_BufSz = Re_BufSz + 1 ! TFrlSpr - Re_BufSz = Re_BufSz + 1 ! TFrlUSDmp - Re_BufSz = Re_BufSz + 1 ! TFrlUSDP - Re_BufSz = Re_BufSz + 1 ! TFrlUSSP - Re_BufSz = Re_BufSz + 1 ! TFrlUSSpr - Int_BufSz = Int_BufSz + 1 ! TFrlMod - Re_BufSz = Re_BufSz + 1 ! RFrlDmp - Re_BufSz = Re_BufSz + 1 ! RFrlDSDmp - Re_BufSz = Re_BufSz + 1 ! RFrlDSDP - Re_BufSz = Re_BufSz + 1 ! RFrlDSSP - Re_BufSz = Re_BufSz + 1 ! RFrlDSSpr - Re_BufSz = Re_BufSz + 1 ! RFrlSpr - Re_BufSz = Re_BufSz + 1 ! RFrlUSDmp - Re_BufSz = Re_BufSz + 1 ! RFrlUSDP - Re_BufSz = Re_BufSz + 1 ! RFrlUSSP - Re_BufSz = Re_BufSz + 1 ! RFrlUSSpr - Int_BufSz = Int_BufSz + 1 ! RFrlMod - Re_BufSz = Re_BufSz + 1 ! ShftGagL - Int_BufSz = Int_BufSz + SIZE(InData%BldGagNd) ! BldGagNd - Int_BufSz = Int_BufSz + SIZE(InData%TwrGagNd) ! TwrGagNd - Db_BufSz = Db_BufSz + 1 ! TStart - Re_BufSz = Re_BufSz + 1 ! DTTorDmp - Re_BufSz = Re_BufSz + 1 ! DTTorSpr - Re_BufSz = Re_BufSz + 1 ! GBRatio - Re_BufSz = Re_BufSz + 1 ! GBoxEff - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! BElmntMass allocated yes/no - IF ( ALLOCATED(InData%BElmntMass) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BElmntMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BElmntMass) ! BElmntMass - END IF - Int_BufSz = Int_BufSz + 1 ! TElmntMass allocated yes/no - IF ( ALLOCATED(InData%TElmntMass) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TElmntMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TElmntMass) ! TElmntMass - END IF - Int_BufSz = Int_BufSz + 1 ! method - Re_BufSz = Re_BufSz + 1 ! PtfmCMxt - Re_BufSz = Re_BufSz + 1 ! PtfmCMyt - Int_BufSz = Int_BufSz + 1 ! BD4Blades - Int_BufSz = Int_BufSz + 1 ! UseAD14 - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%du) ! du - END IF - Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no - IF ( ALLOCATED(InData%dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_ny - 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%DT24 - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TipNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NDOF - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TwoPiNB - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NAug - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPH - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PH) ) 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%PH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PH,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PH,1), UBOUND(InData%PH,1) - IntKiBuf(Int_Xferred) = InData%PH(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NPM - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PM) ) 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%PM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PM,2), UBOUND(InData%PM,2) - DO i1 = LBOUND(InData%PM,1), UBOUND(InData%PM,1) - IntKiBuf(Int_Xferred) = InData%PM(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DOF_Flag) ) 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%DOF_Flag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOF_Flag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DOF_Flag,1), UBOUND(InData%DOF_Flag,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%DOF_Flag(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DOF_Desc) ) 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%DOF_Desc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOF_Desc,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DOF_Desc,1), UBOUND(InData%DOF_Desc,1) - DO I = 1, LEN(InData%DOF_Desc) - IntKiBuf(Int_Xferred) = ICHAR(InData%DOF_Desc(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - 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 - - 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%NumOuts - 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 - IntKiBuf(Int_Xferred) = InData%NBlGages - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NTwGages - Int_Xferred = Int_Xferred + 1 - 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 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%AvgNrmTpRd - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%AzimB1Up - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CosDel3 - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CosPreC) ) 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%CosPreC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CosPreC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CosPreC,1), UBOUND(InData%CosPreC,1) - DbKiBuf(Db_Xferred) = InData%CosPreC(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%CRFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CRFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CRFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CRFrlTlt2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CShftSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CShftTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CSRFrlSkw - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CSRFrlTlt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CSTFrlSkw - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CSTFrlTlt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CTFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CTFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CTFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CTFrlTlt2 - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubCM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%OverHang - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ProjArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefTwrHt - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RFrlPnt_n,1), UBOUND(InData%RFrlPnt_n,1) - ReKiBuf(Re_Xferred) = InData%RFrlPnt_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%rVDxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVDyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVDzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVIMUxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVIMUyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVIMUzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVPxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVPyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVPzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWIxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWIyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWIzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWJxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWJyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWJzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rZT0zt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rZYzt - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SinDel3 - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SinPreC) ) 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%SinPreC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SinPreC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SinPreC,1), UBOUND(InData%SinPreC,1) - DbKiBuf(Db_Xferred) = InData%SinPreC(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%SRFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SRFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SRFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SRFrlTlt2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SShftSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SShftTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%STFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%STFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%STFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%STFrlTlt2 - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%TFrlPnt_n,1), UBOUND(InData%TFrlPnt_n,1) - ReKiBuf(Re_Xferred) = InData%TFrlPnt_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%TipRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerBsHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UndSling - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AxRedTFA) ) 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%AxRedTFA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTFA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTFA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTFA,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTFA,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTFA,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AxRedTFA,3), UBOUND(InData%AxRedTFA,3) - DO i2 = LBOUND(InData%AxRedTFA,2), UBOUND(InData%AxRedTFA,2) - DO i1 = LBOUND(InData%AxRedTFA,1), UBOUND(InData%AxRedTFA,1) - ReKiBuf(Re_Xferred) = InData%AxRedTFA(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxRedTSS) ) 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%AxRedTSS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTSS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTSS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTSS,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTSS,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTSS,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AxRedTSS,3), UBOUND(InData%AxRedTSS,3) - DO i2 = LBOUND(InData%AxRedTSS,2), UBOUND(InData%AxRedTSS,2) - DO i1 = LBOUND(InData%AxRedTSS,1), UBOUND(InData%AxRedTSS,1) - ReKiBuf(Re_Xferred) = InData%AxRedTSS(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i2 = LBOUND(InData%CTFA,2), UBOUND(InData%CTFA,2) - DO i1 = LBOUND(InData%CTFA,1), UBOUND(InData%CTFA,1) - ReKiBuf(Re_Xferred) = InData%CTFA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%CTSS,2), UBOUND(InData%CTSS,2) - DO i1 = LBOUND(InData%CTSS,1), UBOUND(InData%CTSS,1) - ReKiBuf(Re_Xferred) = InData%CTSS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%DHNodes) ) 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%DHNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DHNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DHNodes,1), UBOUND(InData%DHNodes,1) - ReKiBuf(Re_Xferred) = InData%DHNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HNodes) ) 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%HNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HNodes,1), UBOUND(InData%HNodes,1) - ReKiBuf(Re_Xferred) = InData%HNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HNodesNorm) ) 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%HNodesNorm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HNodesNorm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HNodesNorm,1), UBOUND(InData%HNodesNorm,1) - ReKiBuf(Re_Xferred) = InData%HNodesNorm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i2 = LBOUND(InData%KTFA,2), UBOUND(InData%KTFA,2) - DO i1 = LBOUND(InData%KTFA,1), UBOUND(InData%KTFA,1) - ReKiBuf(Re_Xferred) = InData%KTFA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%KTSS,2), UBOUND(InData%KTSS,2) - DO i1 = LBOUND(InData%KTSS,1), UBOUND(InData%KTSS,1) - ReKiBuf(Re_Xferred) = InData%KTSS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%MassT) ) 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%MassT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MassT,1), UBOUND(InData%MassT,1) - ReKiBuf(Re_Xferred) = InData%MassT(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StiffTSS) ) 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%StiffTSS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTSS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StiffTSS,1), UBOUND(InData%StiffTSS,1) - ReKiBuf(Re_Xferred) = InData%StiffTSS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrFASF) ) 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%TwrFASF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFASF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFASF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFASF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFASF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFASF,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%TwrFASF,3), UBOUND(InData%TwrFASF,3) - DO i2 = LBOUND(InData%TwrFASF,2), UBOUND(InData%TwrFASF,2) - DO i1 = LBOUND(InData%TwrFASF,1), UBOUND(InData%TwrFASF,1) - ReKiBuf(Re_Xferred) = InData%TwrFASF(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TwrFlexL - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TwrSSSF) ) 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%TwrSSSF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrSSSF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrSSSF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrSSSF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrSSSF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrSSSF,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%TwrSSSF,3), UBOUND(InData%TwrSSSF,3) - DO i2 = LBOUND(InData%TwrSSSF,2), UBOUND(InData%TwrSSSF,2) - DO i1 = LBOUND(InData%TwrSSSF,1), UBOUND(InData%TwrSSSF,1) - ReKiBuf(Re_Xferred) = InData%TwrSSSF(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%TTopNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%StiffTFA) ) 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%StiffTFA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTFA,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StiffTFA,1), UBOUND(InData%StiffTFA,1) - ReKiBuf(Re_Xferred) = InData%StiffTFA(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%AtfaIner - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldCG) ) 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%BldCG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldCG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldCG,1), UBOUND(InData%BldCG,1) - ReKiBuf(Re_Xferred) = InData%BldCG(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldMass) ) 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%BldMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldMass,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldMass,1), UBOUND(InData%BldMass,1) - ReKiBuf(Re_Xferred) = InData%BldMass(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BoomMass - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FirstMom) ) 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%FirstMom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstMom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FirstMom,1), UBOUND(InData%FirstMom,1) - ReKiBuf(Re_Xferred) = InData%FirstMom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%GenIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Hubg1Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Hubg2Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Nacd2Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmPIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RrfaIner - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SecondMom) ) 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%SecondMom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SecondMom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SecondMom,1), UBOUND(InData%SecondMom,1) - ReKiBuf(Re_Xferred) = InData%SecondMom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TFinMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlIner - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TipMass) ) 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%TipMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TipMass,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TipMass,1), UBOUND(InData%TipMass,1) - ReKiBuf(Re_Xferred) = InData%TipMass(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TurbMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TwrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TwrTpMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PitchAxis) ) 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%PitchAxis,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAxis,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PitchAxis,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAxis,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PitchAxis,2), UBOUND(InData%PitchAxis,2) - DO i1 = LBOUND(InData%PitchAxis,1), UBOUND(InData%PitchAxis,1) - ReKiBuf(Re_Xferred) = InData%PitchAxis(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AeroTwst) ) 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%AeroTwst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroTwst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AeroTwst,1), UBOUND(InData%AeroTwst,1) - ReKiBuf(Re_Xferred) = InData%AeroTwst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxRedBld) ) 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%AxRedBld,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedBld,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedBld,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedBld,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedBld,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedBld,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedBld,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedBld,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%AxRedBld,4), UBOUND(InData%AxRedBld,4) - DO i3 = LBOUND(InData%AxRedBld,3), UBOUND(InData%AxRedBld,3) - DO i2 = LBOUND(InData%AxRedBld,2), UBOUND(InData%AxRedBld,2) - DO i1 = LBOUND(InData%AxRedBld,1), UBOUND(InData%AxRedBld,1) - ReKiBuf(Re_Xferred) = InData%AxRedBld(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldEDamp) ) 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%BldEDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldEDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldEDamp,2), UBOUND(InData%BldEDamp,2) - DO i1 = LBOUND(InData%BldEDamp,1), UBOUND(InData%BldEDamp,1) - ReKiBuf(Re_Xferred) = InData%BldEDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldFDamp) ) 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%BldFDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldFDamp,2), UBOUND(InData%BldFDamp,2) - DO i1 = LBOUND(InData%BldFDamp,1), UBOUND(InData%BldFDamp,1) - ReKiBuf(Re_Xferred) = InData%BldFDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BldFlexL - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CAeroTwst) ) 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%CAeroTwst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CAeroTwst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CAeroTwst,1), UBOUND(InData%CAeroTwst,1) - ReKiBuf(Re_Xferred) = InData%CAeroTwst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CBE) ) 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%CBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CBE,3), UBOUND(InData%CBE,3) - DO i2 = LBOUND(InData%CBE,2), UBOUND(InData%CBE,2) - DO i1 = LBOUND(InData%CBE,1), UBOUND(InData%CBE,1) - ReKiBuf(Re_Xferred) = InData%CBE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CBF) ) 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%CBF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBF,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CBF,3), UBOUND(InData%CBF,3) - DO i2 = LBOUND(InData%CBF,2), UBOUND(InData%CBF,2) - DO i1 = LBOUND(InData%CBF,1), UBOUND(InData%CBF,1) - ReKiBuf(Re_Xferred) = InData%CBF(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Chord) ) 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%Chord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Chord,1), UBOUND(InData%Chord,1) - ReKiBuf(Re_Xferred) = InData%Chord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CThetaS) ) 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%CThetaS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CThetaS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CThetaS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CThetaS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CThetaS,2), UBOUND(InData%CThetaS,2) - DO i1 = LBOUND(InData%CThetaS,1), UBOUND(InData%CThetaS,1) - DbKiBuf(Db_Xferred) = InData%CThetaS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DRNodes) ) 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%DRNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DRNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DRNodes,1), UBOUND(InData%DRNodes,1) - ReKiBuf(Re_Xferred) = InData%DRNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FStTunr) ) 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%FStTunr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FStTunr,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FStTunr,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FStTunr,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FStTunr,2), UBOUND(InData%FStTunr,2) - DO i1 = LBOUND(InData%FStTunr,1), UBOUND(InData%FStTunr,1) - ReKiBuf(Re_Xferred) = InData%FStTunr(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KBE) ) 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%KBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%KBE,3), UBOUND(InData%KBE,3) - DO i2 = LBOUND(InData%KBE,2), UBOUND(InData%KBE,2) - DO i1 = LBOUND(InData%KBE,1), UBOUND(InData%KBE,1) - ReKiBuf(Re_Xferred) = InData%KBE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KBF) ) 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%KBF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBF,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%KBF,3), UBOUND(InData%KBF,3) - DO i2 = LBOUND(InData%KBF,2), UBOUND(InData%KBF,2) - DO i1 = LBOUND(InData%KBF,1), UBOUND(InData%KBF,1) - ReKiBuf(Re_Xferred) = InData%KBF(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MassB) ) 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%MassB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MassB,2), UBOUND(InData%MassB,2) - DO i1 = LBOUND(InData%MassB,1), UBOUND(InData%MassB,1) - ReKiBuf(Re_Xferred) = InData%MassB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RNodes) ) 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%RNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RNodes,1), UBOUND(InData%RNodes,1) - ReKiBuf(Re_Xferred) = InData%RNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RNodesNorm) ) 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%RNodesNorm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodesNorm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RNodesNorm,1), UBOUND(InData%RNodesNorm,1) - ReKiBuf(Re_Xferred) = InData%RNodesNorm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rSAerCenn1) ) 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%rSAerCenn1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCenn1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rSAerCenn1,2), UBOUND(InData%rSAerCenn1,2) - DO i1 = LBOUND(InData%rSAerCenn1,1), UBOUND(InData%rSAerCenn1,1) - ReKiBuf(Re_Xferred) = InData%rSAerCenn1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rSAerCenn2) ) 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%rSAerCenn2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCenn2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rSAerCenn2,2), UBOUND(InData%rSAerCenn2,2) - DO i1 = LBOUND(InData%rSAerCenn2,1), UBOUND(InData%rSAerCenn2,1) - ReKiBuf(Re_Xferred) = InData%rSAerCenn2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SAeroTwst) ) 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%SAeroTwst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SAeroTwst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SAeroTwst,1), UBOUND(InData%SAeroTwst,1) - ReKiBuf(Re_Xferred) = InData%SAeroTwst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StiffBE) ) 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%StiffBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StiffBE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StiffBE,2), UBOUND(InData%StiffBE,2) - DO i1 = LBOUND(InData%StiffBE,1), UBOUND(InData%StiffBE,1) - ReKiBuf(Re_Xferred) = InData%StiffBE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StiffBF) ) 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%StiffBF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StiffBF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StiffBF,2), UBOUND(InData%StiffBF,2) - DO i1 = LBOUND(InData%StiffBF,1), UBOUND(InData%StiffBF,1) - ReKiBuf(Re_Xferred) = InData%StiffBF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SThetaS) ) 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%SThetaS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SThetaS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SThetaS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SThetaS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SThetaS,2), UBOUND(InData%SThetaS,2) - DO i1 = LBOUND(InData%SThetaS,1), UBOUND(InData%SThetaS,1) - DbKiBuf(Db_Xferred) = InData%SThetaS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ThetaS) ) 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%ThetaS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ThetaS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ThetaS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ThetaS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ThetaS,2), UBOUND(InData%ThetaS,2) - DO i1 = LBOUND(InData%ThetaS,1), UBOUND(InData%ThetaS,1) - ReKiBuf(Re_Xferred) = InData%ThetaS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwistedSF) ) 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%TwistedSF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwistedSF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwistedSF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwistedSF,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwistedSF,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%TwistedSF,5), UBOUND(InData%TwistedSF,5) - DO i4 = LBOUND(InData%TwistedSF,4), UBOUND(InData%TwistedSF,4) - DO i3 = LBOUND(InData%TwistedSF,3), UBOUND(InData%TwistedSF,3) - DO i2 = LBOUND(InData%TwistedSF,2), UBOUND(InData%TwistedSF,2) - DO i1 = LBOUND(InData%TwistedSF,1), UBOUND(InData%TwistedSF,1) - ReKiBuf(Re_Xferred) = InData%TwistedSF(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%BldFl1Sh) ) 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%BldFl1Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl1Sh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFl1Sh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl1Sh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldFl1Sh,2), UBOUND(InData%BldFl1Sh,2) - DO i1 = LBOUND(InData%BldFl1Sh,1), UBOUND(InData%BldFl1Sh,1) - ReKiBuf(Re_Xferred) = InData%BldFl1Sh(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldFl2Sh) ) 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%BldFl2Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl2Sh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFl2Sh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl2Sh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldFl2Sh,2), UBOUND(InData%BldFl2Sh,2) - DO i1 = LBOUND(InData%BldFl2Sh,1), UBOUND(InData%BldFl2Sh,1) - ReKiBuf(Re_Xferred) = InData%BldFl2Sh(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldEdgSh) ) 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%BldEdgSh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEdgSh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldEdgSh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEdgSh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldEdgSh,2), UBOUND(InData%BldEdgSh,2) - DO i1 = LBOUND(InData%BldEdgSh,1), UBOUND(InData%BldEdgSh,1) - ReKiBuf(Re_Xferred) = InData%BldEdgSh(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreqBE) ) 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%FreqBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%FreqBE,3), UBOUND(InData%FreqBE,3) - DO i2 = LBOUND(InData%FreqBE,2), UBOUND(InData%FreqBE,2) - DO i1 = LBOUND(InData%FreqBE,1), UBOUND(InData%FreqBE,1) - ReKiBuf(Re_Xferred) = InData%FreqBE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreqBF) ) 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%FreqBF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBF,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%FreqBF,3), UBOUND(InData%FreqBF,3) - DO i2 = LBOUND(InData%FreqBF,2), UBOUND(InData%FreqBF,2) - DO i1 = LBOUND(InData%FreqBF,1), UBOUND(InData%FreqBF,1) - ReKiBuf(Re_Xferred) = InData%FreqBF(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i2 = LBOUND(InData%FreqTFA,2), UBOUND(InData%FreqTFA,2) - DO i1 = LBOUND(InData%FreqTFA,1), UBOUND(InData%FreqTFA,1) - ReKiBuf(Re_Xferred) = InData%FreqTFA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%FreqTSS,2), UBOUND(InData%FreqTSS,2) - DO i1 = LBOUND(InData%FreqTSS,1), UBOUND(InData%FreqTSS,1) - ReKiBuf(Re_Xferred) = InData%FreqTSS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - ReKiBuf(Re_Xferred) = InData%TeetCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetDmpP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetHSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetHStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetSSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetSStP - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TeetMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSSpr - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSSpr - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShftGagL - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%BldGagNd,1), UBOUND(InData%BldGagNd,1) - IntKiBuf(Int_Xferred) = InData%BldGagNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TwrGagNd,1), UBOUND(InData%TwrGagNd,1) - IntKiBuf(Int_Xferred) = InData%TwrGagNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%TStart - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTTorDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTTorSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GBRatio - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GBoxEff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%BElmntMass) ) 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%BElmntMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BElmntMass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BElmntMass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BElmntMass,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BElmntMass,2), UBOUND(InData%BElmntMass,2) - DO i1 = LBOUND(InData%BElmntMass,1), UBOUND(InData%BElmntMass,1) - ReKiBuf(Re_Xferred) = InData%BElmntMass(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TElmntMass) ) 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%TElmntMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TElmntMass,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TElmntMass,1), UBOUND(InData%TElmntMass,1) - ReKiBuf(Re_Xferred) = InData%TElmntMass(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%method - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmCMxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmCMyt - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%BD4Blades, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseAD14, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_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%BldNd_OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) - 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 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%BldNd_BladesOut - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) 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%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%du) ) 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%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - DbKiBuf(Db_Xferred) = InData%du(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dx) ) 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%dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - DbKiBuf(Db_Xferred) = InData%dx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_PackParam - - SUBROUTINE ED_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(ED_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) :: 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_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%DT24 = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BldNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TipNode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NDOF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwoPiNB = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%NAug = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPH = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PH 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%PH)) DEALLOCATE(OutData%PH) - ALLOCATE(OutData%PH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PH,1), UBOUND(OutData%PH,1) - OutData%PH(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NPM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PM 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%PM)) DEALLOCATE(OutData%PM) - ALLOCATE(OutData%PM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PM,2), UBOUND(OutData%PM,2) - DO i1 = LBOUND(OutData%PM,1), UBOUND(OutData%PM,1) - OutData%PM(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOF_Flag 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%DOF_Flag)) DEALLOCATE(OutData%DOF_Flag) - ALLOCATE(OutData%DOF_Flag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Flag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DOF_Flag,1), UBOUND(OutData%DOF_Flag,1) - OutData%DOF_Flag(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%DOF_Flag(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOF_Desc 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%DOF_Desc)) DEALLOCATE(OutData%DOF_Desc) - ALLOCATE(OutData%DOF_Desc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Desc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DOF_Desc,1), UBOUND(OutData%DOF_Desc,1) - DO I = 1, LEN(OutData%DOF_Desc) - OutData%DOF_Desc(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 ED_UnpackActiveDOFs( Re_Buf, Db_Buf, Int_Buf, OutData%DOFs, ErrStat2, ErrMsg2 ) ! DOFs - 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%NumOuts = 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 - OutData%NBlGages = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NTwGages = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%AvgNrmTpRd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AzimB1Up = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CosDel3 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CosPreC 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%CosPreC)) DEALLOCATE(OutData%CosPreC) - ALLOCATE(OutData%CosPreC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CosPreC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CosPreC,1), UBOUND(OutData%CosPreC,1) - OutData%CosPreC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%CRFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CShftSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CShftTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSRFrlSkw = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSRFrlTlt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSTFrlSkw = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSTFrlTlt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%HubHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubCM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%OverHang = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ProjArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRefzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefTwrHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RFrlPnt_n,1) - i1_u = UBOUND(OutData%RFrlPnt_n,1) - DO i1 = LBOUND(OutData%RFrlPnt_n,1), UBOUND(OutData%RFrlPnt_n,1) - OutData%RFrlPnt_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%rVDxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVDyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVDzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVPxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVPyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVPzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWIxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWIyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWIzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWJxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWJyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWJzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rZT0zt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rZYzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SinDel3 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SinPreC 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%SinPreC)) DEALLOCATE(OutData%SinPreC) - ALLOCATE(OutData%SinPreC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SinPreC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SinPreC,1), UBOUND(OutData%SinPreC,1) - OutData%SinPreC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%SRFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SShftSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SShftTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%TFrlPnt_n,1) - i1_u = UBOUND(OutData%TFrlPnt_n,1) - DO i1 = LBOUND(OutData%TFrlPnt_n,1), UBOUND(OutData%TFrlPnt_n,1) - OutData%TFrlPnt_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TipRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBsHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UndSling = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedTFA 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%AxRedTFA)) DEALLOCATE(OutData%AxRedTFA) - ALLOCATE(OutData%AxRedTFA(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%AxRedTFA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AxRedTFA,3), UBOUND(OutData%AxRedTFA,3) - DO i2 = LBOUND(OutData%AxRedTFA,2), UBOUND(OutData%AxRedTFA,2) - DO i1 = LBOUND(OutData%AxRedTFA,1), UBOUND(OutData%AxRedTFA,1) - OutData%AxRedTFA(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedTSS 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%AxRedTSS)) DEALLOCATE(OutData%AxRedTSS) - ALLOCATE(OutData%AxRedTSS(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%AxRedTSS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AxRedTSS,3), UBOUND(OutData%AxRedTSS,3) - DO i2 = LBOUND(OutData%AxRedTSS,2), UBOUND(OutData%AxRedTSS,2) - DO i1 = LBOUND(OutData%AxRedTSS,1), UBOUND(OutData%AxRedTSS,1) - OutData%AxRedTSS(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%CTFA,1) - i1_u = UBOUND(OutData%CTFA,1) - i2_l = LBOUND(OutData%CTFA,2) - i2_u = UBOUND(OutData%CTFA,2) - DO i2 = LBOUND(OutData%CTFA,2), UBOUND(OutData%CTFA,2) - DO i1 = LBOUND(OutData%CTFA,1), UBOUND(OutData%CTFA,1) - OutData%CTFA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%CTSS,1) - i1_u = UBOUND(OutData%CTSS,1) - i2_l = LBOUND(OutData%CTSS,2) - i2_u = UBOUND(OutData%CTSS,2) - DO i2 = LBOUND(OutData%CTSS,2), UBOUND(OutData%CTSS,2) - DO i1 = LBOUND(OutData%CTSS,1), UBOUND(OutData%CTSS,1) - OutData%CTSS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DHNodes 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%DHNodes)) DEALLOCATE(OutData%DHNodes) - ALLOCATE(OutData%DHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DHNodes,1), UBOUND(OutData%DHNodes,1) - OutData%DHNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HNodes 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%HNodes)) DEALLOCATE(OutData%HNodes) - ALLOCATE(OutData%HNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HNodes,1), UBOUND(OutData%HNodes,1) - OutData%HNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HNodesNorm 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%HNodesNorm)) DEALLOCATE(OutData%HNodesNorm) - ALLOCATE(OutData%HNodesNorm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodesNorm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HNodesNorm,1), UBOUND(OutData%HNodesNorm,1) - OutData%HNodesNorm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%KTFA,1) - i1_u = UBOUND(OutData%KTFA,1) - i2_l = LBOUND(OutData%KTFA,2) - i2_u = UBOUND(OutData%KTFA,2) - DO i2 = LBOUND(OutData%KTFA,2), UBOUND(OutData%KTFA,2) - DO i1 = LBOUND(OutData%KTFA,1), UBOUND(OutData%KTFA,1) - OutData%KTFA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%KTSS,1) - i1_u = UBOUND(OutData%KTSS,1) - i2_l = LBOUND(OutData%KTSS,2) - i2_u = UBOUND(OutData%KTSS,2) - DO i2 = LBOUND(OutData%KTSS,2), UBOUND(OutData%KTSS,2) - DO i1 = LBOUND(OutData%KTSS,1), UBOUND(OutData%KTSS,1) - OutData%KTSS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassT 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%MassT)) DEALLOCATE(OutData%MassT) - ALLOCATE(OutData%MassT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MassT,1), UBOUND(OutData%MassT,1) - OutData%MassT(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTSS 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%StiffTSS)) DEALLOCATE(OutData%StiffTSS) - ALLOCATE(OutData%StiffTSS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTSS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StiffTSS,1), UBOUND(OutData%StiffTSS,1) - OutData%StiffTSS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrFASF 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%TwrFASF)) DEALLOCATE(OutData%TwrFASF) - ALLOCATE(OutData%TwrFASF(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%TwrFASF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%TwrFASF,3), UBOUND(OutData%TwrFASF,3) - DO i2 = LBOUND(OutData%TwrFASF,2), UBOUND(OutData%TwrFASF,2) - DO i1 = LBOUND(OutData%TwrFASF,1), UBOUND(OutData%TwrFASF,1) - OutData%TwrFASF(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%TwrFlexL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrSSSF 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%TwrSSSF)) DEALLOCATE(OutData%TwrSSSF) - ALLOCATE(OutData%TwrSSSF(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%TwrSSSF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%TwrSSSF,3), UBOUND(OutData%TwrSSSF,3) - DO i2 = LBOUND(OutData%TwrSSSF,2), UBOUND(OutData%TwrSSSF,2) - DO i1 = LBOUND(OutData%TwrSSSF,1), UBOUND(OutData%TwrSSSF,1) - OutData%TwrSSSF(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%TTopNode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTFA 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%StiffTFA)) DEALLOCATE(OutData%StiffTFA) - ALLOCATE(OutData%StiffTFA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTFA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StiffTFA,1), UBOUND(OutData%StiffTFA,1) - OutData%StiffTFA(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%AtfaIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldCG 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%BldCG)) DEALLOCATE(OutData%BldCG) - ALLOCATE(OutData%BldCG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldCG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldCG,1), UBOUND(OutData%BldCG,1) - OutData%BldCG(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldMass 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%BldMass)) DEALLOCATE(OutData%BldMass) - ALLOCATE(OutData%BldMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldMass,1), UBOUND(OutData%BldMass,1) - OutData%BldMass(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%BoomMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FirstMom 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%FirstMom)) DEALLOCATE(OutData%FirstMom) - ALLOCATE(OutData%FirstMom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstMom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FirstMom,1), UBOUND(OutData%FirstMom,1) - OutData%FirstMom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%GenIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Hubg1Iner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Hubg2Iner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Nacd2Iner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RrfaIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SecondMom 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%SecondMom)) DEALLOCATE(OutData%SecondMom) - ALLOCATE(OutData%SecondMom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SecondMom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SecondMom,1), UBOUND(OutData%SecondMom,1) - OutData%SecondMom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%TFinMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TipMass 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%TipMass)) DEALLOCATE(OutData%TipMass) - ALLOCATE(OutData%TipMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TipMass,1), UBOUND(OutData%TipMass,1) - OutData%TipMass(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%TurbMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TwrMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TwrTpMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAxis 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%PitchAxis)) DEALLOCATE(OutData%PitchAxis) - ALLOCATE(OutData%PitchAxis(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAxis.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PitchAxis,2), UBOUND(OutData%PitchAxis,2) - DO i1 = LBOUND(OutData%PitchAxis,1), UBOUND(OutData%PitchAxis,1) - OutData%PitchAxis(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroTwst 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%AeroTwst)) DEALLOCATE(OutData%AeroTwst) - ALLOCATE(OutData%AeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AeroTwst,1), UBOUND(OutData%AeroTwst,1) - OutData%AeroTwst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedBld 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%AxRedBld)) DEALLOCATE(OutData%AxRedBld) - ALLOCATE(OutData%AxRedBld(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%AxRedBld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%AxRedBld,4), UBOUND(OutData%AxRedBld,4) - DO i3 = LBOUND(OutData%AxRedBld,3), UBOUND(OutData%AxRedBld,3) - DO i2 = LBOUND(OutData%AxRedBld,2), UBOUND(OutData%AxRedBld,2) - DO i1 = LBOUND(OutData%AxRedBld,1), UBOUND(OutData%AxRedBld,1) - OutData%AxRedBld(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEDamp 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%BldEDamp)) DEALLOCATE(OutData%BldEDamp) - ALLOCATE(OutData%BldEDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldEDamp,2), UBOUND(OutData%BldEDamp,2) - DO i1 = LBOUND(OutData%BldEDamp,1), UBOUND(OutData%BldEDamp,1) - OutData%BldEDamp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFDamp 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%BldFDamp)) DEALLOCATE(OutData%BldFDamp) - ALLOCATE(OutData%BldFDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldFDamp,2), UBOUND(OutData%BldFDamp,2) - DO i1 = LBOUND(OutData%BldFDamp,1), UBOUND(OutData%BldFDamp,1) - OutData%BldFDamp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%BldFlexL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CAeroTwst 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%CAeroTwst)) DEALLOCATE(OutData%CAeroTwst) - ALLOCATE(OutData%CAeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CAeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CAeroTwst,1), UBOUND(OutData%CAeroTwst,1) - OutData%CAeroTwst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBE 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%CBE)) DEALLOCATE(OutData%CBE) - ALLOCATE(OutData%CBE(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%CBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CBE,3), UBOUND(OutData%CBE,3) - DO i2 = LBOUND(OutData%CBE,2), UBOUND(OutData%CBE,2) - DO i1 = LBOUND(OutData%CBE,1), UBOUND(OutData%CBE,1) - OutData%CBE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBF 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%CBF)) DEALLOCATE(OutData%CBF) - ALLOCATE(OutData%CBF(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%CBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CBF,3), UBOUND(OutData%CBF,3) - DO i2 = LBOUND(OutData%CBF,2), UBOUND(OutData%CBF,2) - DO i1 = LBOUND(OutData%CBF,1), UBOUND(OutData%CBF,1) - OutData%CBF(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Chord 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%Chord)) DEALLOCATE(OutData%Chord) - ALLOCATE(OutData%Chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Chord,1), UBOUND(OutData%Chord,1) - OutData%Chord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CThetaS 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%CThetaS)) DEALLOCATE(OutData%CThetaS) - ALLOCATE(OutData%CThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CThetaS,2), UBOUND(OutData%CThetaS,2) - DO i1 = LBOUND(OutData%CThetaS,1), UBOUND(OutData%CThetaS,1) - OutData%CThetaS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DRNodes 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%DRNodes)) DEALLOCATE(OutData%DRNodes) - ALLOCATE(OutData%DRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DRNodes,1), UBOUND(OutData%DRNodes,1) - OutData%DRNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FStTunr 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%FStTunr)) DEALLOCATE(OutData%FStTunr) - ALLOCATE(OutData%FStTunr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FStTunr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FStTunr,2), UBOUND(OutData%FStTunr,2) - DO i1 = LBOUND(OutData%FStTunr,1), UBOUND(OutData%FStTunr,1) - OutData%FStTunr(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBE 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%KBE)) DEALLOCATE(OutData%KBE) - ALLOCATE(OutData%KBE(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%KBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%KBE,3), UBOUND(OutData%KBE,3) - DO i2 = LBOUND(OutData%KBE,2), UBOUND(OutData%KBE,2) - DO i1 = LBOUND(OutData%KBE,1), UBOUND(OutData%KBE,1) - OutData%KBE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBF 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%KBF)) DEALLOCATE(OutData%KBF) - ALLOCATE(OutData%KBF(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%KBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%KBF,3), UBOUND(OutData%KBF,3) - DO i2 = LBOUND(OutData%KBF,2), UBOUND(OutData%KBF,2) - DO i1 = LBOUND(OutData%KBF,1), UBOUND(OutData%KBF,1) - OutData%KBF(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassB 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%MassB)) DEALLOCATE(OutData%MassB) - ALLOCATE(OutData%MassB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MassB,2), UBOUND(OutData%MassB,2) - DO i1 = LBOUND(OutData%MassB,1), UBOUND(OutData%MassB,1) - OutData%MassB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodes 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%RNodes)) DEALLOCATE(OutData%RNodes) - ALLOCATE(OutData%RNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RNodes,1), UBOUND(OutData%RNodes,1) - OutData%RNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodesNorm 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%RNodesNorm)) DEALLOCATE(OutData%RNodesNorm) - ALLOCATE(OutData%RNodesNorm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodesNorm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RNodesNorm,1), UBOUND(OutData%RNodesNorm,1) - OutData%RNodesNorm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCenn1 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%rSAerCenn1)) DEALLOCATE(OutData%rSAerCenn1) - ALLOCATE(OutData%rSAerCenn1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rSAerCenn1,2), UBOUND(OutData%rSAerCenn1,2) - DO i1 = LBOUND(OutData%rSAerCenn1,1), UBOUND(OutData%rSAerCenn1,1) - OutData%rSAerCenn1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCenn2 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%rSAerCenn2)) DEALLOCATE(OutData%rSAerCenn2) - ALLOCATE(OutData%rSAerCenn2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rSAerCenn2,2), UBOUND(OutData%rSAerCenn2,2) - DO i1 = LBOUND(OutData%rSAerCenn2,1), UBOUND(OutData%rSAerCenn2,1) - OutData%rSAerCenn2(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SAeroTwst 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%SAeroTwst)) DEALLOCATE(OutData%SAeroTwst) - ALLOCATE(OutData%SAeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SAeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SAeroTwst,1), UBOUND(OutData%SAeroTwst,1) - OutData%SAeroTwst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBE 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%StiffBE)) DEALLOCATE(OutData%StiffBE) - ALLOCATE(OutData%StiffBE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StiffBE,2), UBOUND(OutData%StiffBE,2) - DO i1 = LBOUND(OutData%StiffBE,1), UBOUND(OutData%StiffBE,1) - OutData%StiffBE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBF 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%StiffBF)) DEALLOCATE(OutData%StiffBF) - ALLOCATE(OutData%StiffBF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StiffBF,2), UBOUND(OutData%StiffBF,2) - DO i1 = LBOUND(OutData%StiffBF,1), UBOUND(OutData%StiffBF,1) - OutData%StiffBF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SThetaS 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%SThetaS)) DEALLOCATE(OutData%SThetaS) - ALLOCATE(OutData%SThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SThetaS,2), UBOUND(OutData%SThetaS,2) - DO i1 = LBOUND(OutData%SThetaS,1), UBOUND(OutData%SThetaS,1) - OutData%SThetaS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ThetaS 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%ThetaS)) DEALLOCATE(OutData%ThetaS) - ALLOCATE(OutData%ThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ThetaS,2), UBOUND(OutData%ThetaS,2) - DO i1 = LBOUND(OutData%ThetaS,1), UBOUND(OutData%ThetaS,1) - OutData%ThetaS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwistedSF 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%TwistedSF)) DEALLOCATE(OutData%TwistedSF) - ALLOCATE(OutData%TwistedSF(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%TwistedSF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%TwistedSF,5), UBOUND(OutData%TwistedSF,5) - DO i4 = LBOUND(OutData%TwistedSF,4), UBOUND(OutData%TwistedSF,4) - DO i3 = LBOUND(OutData%TwistedSF,3), UBOUND(OutData%TwistedSF,3) - DO i2 = LBOUND(OutData%TwistedSF,2), UBOUND(OutData%TwistedSF,2) - DO i1 = LBOUND(OutData%TwistedSF,1), UBOUND(OutData%TwistedSF,1) - OutData%TwistedSF(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl1Sh 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%BldFl1Sh)) DEALLOCATE(OutData%BldFl1Sh) - ALLOCATE(OutData%BldFl1Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldFl1Sh,2), UBOUND(OutData%BldFl1Sh,2) - DO i1 = LBOUND(OutData%BldFl1Sh,1), UBOUND(OutData%BldFl1Sh,1) - OutData%BldFl1Sh(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl2Sh 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%BldFl2Sh)) DEALLOCATE(OutData%BldFl2Sh) - ALLOCATE(OutData%BldFl2Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldFl2Sh,2), UBOUND(OutData%BldFl2Sh,2) - DO i1 = LBOUND(OutData%BldFl2Sh,1), UBOUND(OutData%BldFl2Sh,1) - OutData%BldFl2Sh(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEdgSh 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%BldEdgSh)) DEALLOCATE(OutData%BldEdgSh) - ALLOCATE(OutData%BldEdgSh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldEdgSh,2), UBOUND(OutData%BldEdgSh,2) - DO i1 = LBOUND(OutData%BldEdgSh,1), UBOUND(OutData%BldEdgSh,1) - OutData%BldEdgSh(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreqBE 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%FreqBE)) DEALLOCATE(OutData%FreqBE) - ALLOCATE(OutData%FreqBE(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%FreqBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%FreqBE,3), UBOUND(OutData%FreqBE,3) - DO i2 = LBOUND(OutData%FreqBE,2), UBOUND(OutData%FreqBE,2) - DO i1 = LBOUND(OutData%FreqBE,1), UBOUND(OutData%FreqBE,1) - OutData%FreqBE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreqBF 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%FreqBF)) DEALLOCATE(OutData%FreqBF) - ALLOCATE(OutData%FreqBF(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%FreqBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%FreqBF,3), UBOUND(OutData%FreqBF,3) - DO i2 = LBOUND(OutData%FreqBF,2), UBOUND(OutData%FreqBF,2) - DO i1 = LBOUND(OutData%FreqBF,1), UBOUND(OutData%FreqBF,1) - OutData%FreqBF(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%FreqTFA,1) - i1_u = UBOUND(OutData%FreqTFA,1) - i2_l = LBOUND(OutData%FreqTFA,2) - i2_u = UBOUND(OutData%FreqTFA,2) - DO i2 = LBOUND(OutData%FreqTFA,2), UBOUND(OutData%FreqTFA,2) - DO i1 = LBOUND(OutData%FreqTFA,1), UBOUND(OutData%FreqTFA,1) - OutData%FreqTFA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%FreqTSS,1) - i1_u = UBOUND(OutData%FreqTSS,1) - i2_l = LBOUND(OutData%FreqTSS,2) - i2_u = UBOUND(OutData%FreqTSS,2) - DO i2 = LBOUND(OutData%FreqTSS,2), UBOUND(OutData%FreqTSS,2) - DO i1 = LBOUND(OutData%FreqTSS,1), UBOUND(OutData%FreqTSS,1) - OutData%FreqTSS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - OutData%TeetCDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmpP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHSSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHStP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSSSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSStP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RFrlDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ShftGagL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%BldGagNd,1) - i1_u = UBOUND(OutData%BldGagNd,1) - DO i1 = LBOUND(OutData%BldGagNd,1), UBOUND(OutData%BldGagNd,1) - OutData%BldGagNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrGagNd,1) - i1_u = UBOUND(OutData%TwrGagNd,1) - DO i1 = LBOUND(OutData%TwrGagNd,1), UBOUND(OutData%TwrGagNd,1) - OutData%TwrGagNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%TStart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DTTorDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GBRatio = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BElmntMass 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%BElmntMass)) DEALLOCATE(OutData%BElmntMass) - ALLOCATE(OutData%BElmntMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BElmntMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BElmntMass,2), UBOUND(OutData%BElmntMass,2) - DO i1 = LBOUND(OutData%BElmntMass,1), UBOUND(OutData%BElmntMass,1) - OutData%BElmntMass(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TElmntMass 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%TElmntMass)) DEALLOCATE(OutData%TElmntMass) - ALLOCATE(OutData%TElmntMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TElmntMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TElmntMass,1), UBOUND(OutData%TElmntMass,1) - OutData%TElmntMass(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%method = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmCMxt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMyt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BD4Blades = TRANSFER(IntKiBuf(Int_Xferred), OutData%BD4Blades) - Int_Xferred = Int_Xferred + 1 - OutData%UseAD14 = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseAD14) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_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%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) - ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_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%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_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%BldNd_BladesOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx 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%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du 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%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx 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%dx)) DEALLOCATE(OutData%dx) - ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_UnPackParam - SUBROUTINE ED_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_InputType), INTENT(INOUT) :: SrcInputData - TYPE(ED_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) :: 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 = 'ED_CopyInput' -! +subroutine ED_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(ED_InitInputType), intent(in) :: SrcInitInputData + type(ED_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%BladePtLoads)) THEN - i1_l = LBOUND(SrcInputData%BladePtLoads,1) - i1_u = UBOUND(SrcInputData%BladePtLoads,1) - IF (.NOT. ALLOCATED(DstInputData%BladePtLoads)) THEN - ALLOCATE(DstInputData%BladePtLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BladePtLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%BladePtLoads,1), UBOUND(SrcInputData%BladePtLoads,1) - CALL MeshCopy( SrcInputData%BladePtLoads(i1), DstInputData%BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcInputData%PlatformPtMesh, DstInputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%TowerPtLoads, DstInputData%TowerPtLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%HubPtLoad, DstInputData%HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%NacelleLoads, DstInputData%NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%TFinCMLoads, DstInputData%TFinCMLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputData%TwrAddedMass)) THEN - i1_l = LBOUND(SrcInputData%TwrAddedMass,1) - i1_u = UBOUND(SrcInputData%TwrAddedMass,1) - i2_l = LBOUND(SrcInputData%TwrAddedMass,2) - i2_u = UBOUND(SrcInputData%TwrAddedMass,2) - i3_l = LBOUND(SrcInputData%TwrAddedMass,3) - i3_u = UBOUND(SrcInputData%TwrAddedMass,3) - IF (.NOT. ALLOCATED(DstInputData%TwrAddedMass)) THEN - ALLOCATE(DstInputData%TwrAddedMass(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TwrAddedMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%TwrAddedMass = SrcInputData%TwrAddedMass -ENDIF - DstInputData%PtfmAddedMass = SrcInputData%PtfmAddedMass -IF (ALLOCATED(SrcInputData%BlPitchCom)) THEN - i1_l = LBOUND(SrcInputData%BlPitchCom,1) - i1_u = UBOUND(SrcInputData%BlPitchCom,1) - IF (.NOT. ALLOCATED(DstInputData%BlPitchCom)) THEN - ALLOCATE(DstInputData%BlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%BlPitchCom = SrcInputData%BlPitchCom -ENDIF - DstInputData%YawMom = SrcInputData%YawMom - DstInputData%GenTrq = SrcInputData%GenTrq - DstInputData%HSSBrTrqC = SrcInputData%HSSBrTrqC - END SUBROUTINE ED_CopyInput - - SUBROUTINE ED_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(ED_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 = 'ED_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%BladePtLoads)) THEN -DO i1 = LBOUND(InputData%BladePtLoads,1), UBOUND(InputData%BladePtLoads,1) - CALL MeshDestroy( InputData%BladePtLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%BladePtLoads) -ENDIF - CALL MeshDestroy( InputData%PlatformPtMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%TowerPtLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%HubPtLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%NacelleLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%TFinCMLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputData%TwrAddedMass)) THEN - DEALLOCATE(InputData%TwrAddedMass) -ENDIF -IF (ALLOCATED(InputData%BlPitchCom)) THEN - DEALLOCATE(InputData%BlPitchCom) -ENDIF - END SUBROUTINE ED_DestroyInput - - SUBROUTINE ED_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(ED_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 = 'ED_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 - Int_BufSz = Int_BufSz + 1 ! BladePtLoads allocated yes/no - IF ( ALLOCATED(InData%BladePtLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladePtLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladePtLoads,1), UBOUND(InData%BladePtLoads,1) - Int_BufSz = Int_BufSz + 3 ! BladePtLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladePtLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladePtLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladePtLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladePtLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! PlatformPtMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PlatformPtMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PlatformPtMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PlatformPtMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PlatformPtMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TowerPtLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%TowerPtLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerPtLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TowerPtLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TowerPtLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TowerPtLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubPtLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubPtLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubPtLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubPtLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubPtLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! NacelleLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NacelleLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NacelleLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NacelleLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TFinCMLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%TFinCMLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TFinCMLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFinCMLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFinCMLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFinCMLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! TwrAddedMass allocated yes/no - IF ( ALLOCATED(InData%TwrAddedMass) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! TwrAddedMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrAddedMass) ! TwrAddedMass - END IF - Re_BufSz = Re_BufSz + SIZE(InData%PtfmAddedMass) ! PtfmAddedMass - Int_BufSz = Int_BufSz + 1 ! BlPitchCom allocated yes/no - IF ( ALLOCATED(InData%BlPitchCom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchCom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom - END IF - Re_BufSz = Re_BufSz + 1 ! YawMom - Re_BufSz = Re_BufSz + 1 ! GenTrq - Re_BufSz = Re_BufSz + 1 ! HSSBrTrqC - 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%BladePtLoads) ) 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%BladePtLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladePtLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladePtLoads,1), UBOUND(InData%BladePtLoads,1) - CALL MeshPack( InData%BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladePtLoads - 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 - CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PlatformPtMesh - 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 - CALL MeshPack( InData%TowerPtLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerPtLoads - 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 - CALL MeshPack( InData%HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubPtLoad - 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 - CALL MeshPack( InData%NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleLoads - 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 - CALL MeshPack( InData%TFinCMLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TFinCMLoads - 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 - IF ( .NOT. ALLOCATED(InData%TwrAddedMass) ) 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%TwrAddedMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAddedMass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrAddedMass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAddedMass,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrAddedMass,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAddedMass,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%TwrAddedMass,3), UBOUND(InData%TwrAddedMass,3) - DO i2 = LBOUND(InData%TwrAddedMass,2), UBOUND(InData%TwrAddedMass,2) - DO i1 = LBOUND(InData%TwrAddedMass,1), UBOUND(InData%TwrAddedMass,1) - ReKiBuf(Re_Xferred) = InData%TwrAddedMass(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i2 = LBOUND(InData%PtfmAddedMass,2), UBOUND(InData%PtfmAddedMass,2) - DO i1 = LBOUND(InData%PtfmAddedMass,1), UBOUND(InData%PtfmAddedMass,1) - ReKiBuf(Re_Xferred) = InData%PtfmAddedMass(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%BlPitchCom) ) 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%BlPitchCom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchCom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) - ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%YawMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_PackInput - - SUBROUTINE ED_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(ED_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) :: 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 = 'ED_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladePtLoads 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%BladePtLoads)) DEALLOCATE(OutData%BladePtLoads) - ALLOCATE(OutData%BladePtLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladePtLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladePtLoads,1), UBOUND(OutData%BladePtLoads,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 MeshUnpack( OutData%BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladePtLoads - 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 - 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 MeshUnpack( OutData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PlatformPtMesh - 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) - 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 MeshUnpack( OutData%TowerPtLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerPtLoads - 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) - 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 MeshUnpack( OutData%HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubPtLoad - 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) - 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 MeshUnpack( OutData%NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleLoads - 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) - 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 MeshUnpack( OutData%TFinCMLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TFinCMLoads - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrAddedMass 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%TwrAddedMass)) DEALLOCATE(OutData%TwrAddedMass) - ALLOCATE(OutData%TwrAddedMass(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%TwrAddedMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%TwrAddedMass,3), UBOUND(OutData%TwrAddedMass,3) - DO i2 = LBOUND(OutData%TwrAddedMass,2), UBOUND(OutData%TwrAddedMass,2) - DO i1 = LBOUND(OutData%TwrAddedMass,1), UBOUND(OutData%TwrAddedMass,1) - OutData%TwrAddedMass(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%PtfmAddedMass,1) - i1_u = UBOUND(OutData%PtfmAddedMass,1) - i2_l = LBOUND(OutData%PtfmAddedMass,2) - i2_u = UBOUND(OutData%PtfmAddedMass,2) - DO i2 = LBOUND(OutData%PtfmAddedMass,2), UBOUND(OutData%PtfmAddedMass,2) - DO i1 = LBOUND(OutData%PtfmAddedMass,1), UBOUND(OutData%PtfmAddedMass,1) - OutData%PtfmAddedMass(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchCom 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%BlPitchCom)) DEALLOCATE(OutData%BlPitchCom) - ALLOCATE(OutData%BlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) - OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%YawMom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_UnPackInput - - SUBROUTINE ED_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(ED_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 = 'ED_CopyOutput' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%ADInputFile = SrcInitInputData%ADInputFile + DstInitInputData%CompElast = SrcInitInputData%CompElast + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%MHK = SrcInitInputData%MHK + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth +end subroutine + +subroutine ED_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(ED_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%BladeLn2Mesh)) THEN - i1_l = LBOUND(SrcOutputData%BladeLn2Mesh,1) - i1_u = UBOUND(SrcOutputData%BladeLn2Mesh,1) - IF (.NOT. ALLOCATED(DstOutputData%BladeLn2Mesh)) THEN - ALLOCATE(DstOutputData%BladeLn2Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeLn2Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%BladeLn2Mesh,1), UBOUND(SrcOutputData%BladeLn2Mesh,1) - CALL MeshCopy( SrcOutputData%BladeLn2Mesh(i1), DstOutputData%BladeLn2Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcOutputData%PlatformPtMesh, DstOutputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%TowerLn2Mesh, DstOutputData%TowerLn2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%HubPtMotion14, DstOutputData%HubPtMotion14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%HubPtMotion, DstOutputData%HubPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%BladeRootMotion14, DstOutputData%BladeRootMotion14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%BladeRootMotion)) THEN - i1_l = LBOUND(SrcOutputData%BladeRootMotion,1) - i1_u = UBOUND(SrcOutputData%BladeRootMotion,1) - IF (.NOT. ALLOCATED(DstOutputData%BladeRootMotion)) THEN - ALLOCATE(DstOutputData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%BladeRootMotion,1), UBOUND(SrcOutputData%BladeRootMotion,1) - CALL MeshCopy( SrcOutputData%BladeRootMotion(i1), DstOutputData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcOutputData%RotorFurlMotion14, DstOutputData%RotorFurlMotion14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%NacelleMotion, DstOutputData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%TowerBaseMotion14, DstOutputData%TowerBaseMotion14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%TFinCMMotion, DstOutputData%TFinCMMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -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 -IF (ALLOCATED(SrcOutputData%BlPitch)) THEN - i1_l = LBOUND(SrcOutputData%BlPitch,1) - i1_u = UBOUND(SrcOutputData%BlPitch,1) - IF (.NOT. ALLOCATED(DstOutputData%BlPitch)) THEN - ALLOCATE(DstOutputData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%BlPitch = SrcOutputData%BlPitch -ENDIF - DstOutputData%Yaw = SrcOutputData%Yaw - DstOutputData%YawRate = SrcOutputData%YawRate - DstOutputData%LSS_Spd = SrcOutputData%LSS_Spd - DstOutputData%HSS_Spd = SrcOutputData%HSS_Spd - DstOutputData%RotSpeed = SrcOutputData%RotSpeed - DstOutputData%TwrAccel = SrcOutputData%TwrAccel - DstOutputData%YawAngle = SrcOutputData%YawAngle - DstOutputData%RootMyc = SrcOutputData%RootMyc - DstOutputData%YawBrTAxp = SrcOutputData%YawBrTAxp - DstOutputData%YawBrTAyp = SrcOutputData%YawBrTAyp - DstOutputData%LSSTipPxa = SrcOutputData%LSSTipPxa - DstOutputData%RootMxc = SrcOutputData%RootMxc - DstOutputData%LSSTipMxa = SrcOutputData%LSSTipMxa - DstOutputData%LSSTipMya = SrcOutputData%LSSTipMya - DstOutputData%LSSTipMza = SrcOutputData%LSSTipMza - DstOutputData%LSSTipMys = SrcOutputData%LSSTipMys - DstOutputData%LSSTipMzs = SrcOutputData%LSSTipMzs - DstOutputData%YawBrMyn = SrcOutputData%YawBrMyn - DstOutputData%YawBrMzn = SrcOutputData%YawBrMzn - DstOutputData%NcIMURAxs = SrcOutputData%NcIMURAxs - DstOutputData%NcIMURAys = SrcOutputData%NcIMURAys - DstOutputData%NcIMURAzs = SrcOutputData%NcIMURAzs - DstOutputData%RotPwr = SrcOutputData%RotPwr - DstOutputData%LSShftFxa = SrcOutputData%LSShftFxa - DstOutputData%LSShftFys = SrcOutputData%LSShftFys - DstOutputData%LSShftFzs = SrcOutputData%LSShftFzs - END SUBROUTINE ED_CopyOutput - - SUBROUTINE ED_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(ED_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 = 'ED_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%BladeLn2Mesh)) THEN -DO i1 = LBOUND(OutputData%BladeLn2Mesh,1), UBOUND(OutputData%BladeLn2Mesh,1) - CALL MeshDestroy( OutputData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%BladeLn2Mesh) -ENDIF - CALL MeshDestroy( OutputData%PlatformPtMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%TowerLn2Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%HubPtMotion14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%HubPtMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%BladeRootMotion14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%BladeRootMotion)) THEN -DO i1 = LBOUND(OutputData%BladeRootMotion,1), UBOUND(OutputData%BladeRootMotion,1) - CALL MeshDestroy( OutputData%BladeRootMotion(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%BladeRootMotion) -ENDIF - CALL MeshDestroy( OutputData%RotorFurlMotion14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%NacelleMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%TowerBaseMotion14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%TFinCMMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF -IF (ALLOCATED(OutputData%BlPitch)) THEN - DEALLOCATE(OutputData%BlPitch) -ENDIF - END SUBROUTINE ED_DestroyOutput - - SUBROUTINE ED_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(ED_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 = 'ED_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 ! BladeLn2Mesh allocated yes/no - IF ( ALLOCATED(InData%BladeLn2Mesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeLn2Mesh upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladeLn2Mesh,1), UBOUND(InData%BladeLn2Mesh,1) - Int_BufSz = Int_BufSz + 3 ! BladeLn2Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeLn2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeLn2Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeLn2Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeLn2Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! PlatformPtMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PlatformPtMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PlatformPtMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PlatformPtMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PlatformPtMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TowerLn2Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%TowerLn2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerLn2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TowerLn2Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TowerLn2Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TowerLn2Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubPtMotion14: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubPtMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubPtMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubPtMotion14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubPtMotion14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubPtMotion14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubPtMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubPtMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubPtMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubPtMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubPtMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! BladeRootMotion14: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeRootMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeRootMotion14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeRootMotion14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeRootMotion14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootMotion allocated yes/no - IF ( ALLOCATED(InData%BladeRootMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeRootMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - Int_BufSz = Int_BufSz + 3 ! BladeRootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeRootMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeRootMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeRootMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! RotorFurlMotion14: size of buffers for each call to pack subtype - CALL MeshPack( InData%RotorFurlMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! RotorFurlMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RotorFurlMotion14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RotorFurlMotion14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RotorFurlMotion14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! NacelleMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NacelleMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NacelleMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NacelleMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TowerBaseMotion14: size of buffers for each call to pack subtype - CALL MeshPack( InData%TowerBaseMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerBaseMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TowerBaseMotion14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TowerBaseMotion14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TowerBaseMotion14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TFinCMMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%TFinCMMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TFinCMMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFinCMMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFinCMMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFinCMMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 - Int_BufSz = Int_BufSz + 1 ! BlPitch allocated yes/no - IF ( ALLOCATED(InData%BlPitch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitch) ! BlPitch - END IF - Re_BufSz = Re_BufSz + 1 ! Yaw - Re_BufSz = Re_BufSz + 1 ! YawRate - Re_BufSz = Re_BufSz + 1 ! LSS_Spd - Re_BufSz = Re_BufSz + 1 ! HSS_Spd - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! TwrAccel - Re_BufSz = Re_BufSz + 1 ! YawAngle - Re_BufSz = Re_BufSz + SIZE(InData%RootMyc) ! RootMyc - Re_BufSz = Re_BufSz + 1 ! YawBrTAxp - Re_BufSz = Re_BufSz + 1 ! YawBrTAyp - Re_BufSz = Re_BufSz + 1 ! LSSTipPxa - Re_BufSz = Re_BufSz + SIZE(InData%RootMxc) ! RootMxc - Re_BufSz = Re_BufSz + 1 ! LSSTipMxa - Re_BufSz = Re_BufSz + 1 ! LSSTipMya - Re_BufSz = Re_BufSz + 1 ! LSSTipMza - Re_BufSz = Re_BufSz + 1 ! LSSTipMys - Re_BufSz = Re_BufSz + 1 ! LSSTipMzs - Re_BufSz = Re_BufSz + 1 ! YawBrMyn - Re_BufSz = Re_BufSz + 1 ! YawBrMzn - Re_BufSz = Re_BufSz + 1 ! NcIMURAxs - Re_BufSz = Re_BufSz + 1 ! NcIMURAys - Re_BufSz = Re_BufSz + 1 ! NcIMURAzs - Re_BufSz = Re_BufSz + 1 ! RotPwr - Re_BufSz = Re_BufSz + 1 ! LSShftFxa - Re_BufSz = Re_BufSz + 1 ! LSShftFys - Re_BufSz = Re_BufSz + 1 ! LSShftFzs - 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%BladeLn2Mesh) ) 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%BladeLn2Mesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeLn2Mesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeLn2Mesh,1), UBOUND(InData%BladeLn2Mesh,1) - CALL MeshPack( InData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeLn2Mesh - 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 - CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PlatformPtMesh - 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 - CALL MeshPack( InData%TowerLn2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerLn2Mesh - 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 - CALL MeshPack( InData%HubPtMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubPtMotion14 - 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 - CALL MeshPack( InData%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubPtMotion - 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 - CALL MeshPack( InData%BladeRootMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootMotion14 - 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 - IF ( .NOT. ALLOCATED(InData%BladeRootMotion) ) 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%BladeRootMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootMotion,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootMotion - 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 - CALL MeshPack( InData%RotorFurlMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! RotorFurlMotion14 - 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 - CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleMotion - 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 - CALL MeshPack( InData%TowerBaseMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerBaseMotion14 - 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 - CALL MeshPack( InData%TFinCMMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TFinCMMotion - 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 - 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 - IF ( .NOT. ALLOCATED(InData%BlPitch) ) 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%BlPitch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) - ReKiBuf(Re_Xferred) = InData%BlPitch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TwrAccel - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawAngle - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) - ReKiBuf(Re_Xferred) = InData%RootMyc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%YawBrTAxp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrTAyp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipPxa - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) - ReKiBuf(Re_Xferred) = InData%RootMxc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%LSSTipMxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMya - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMza - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAxs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFzs - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_PackOutput - - SUBROUTINE ED_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(ED_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 = 'ED_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 ! BladeLn2Mesh 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%BladeLn2Mesh)) DEALLOCATE(OutData%BladeLn2Mesh) - ALLOCATE(OutData%BladeLn2Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeLn2Mesh,1), UBOUND(OutData%BladeLn2Mesh,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 MeshUnpack( OutData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeLn2Mesh - 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 - 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 MeshUnpack( OutData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PlatformPtMesh - 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) - 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 MeshUnpack( OutData%TowerLn2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerLn2Mesh - 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) - 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 MeshUnpack( OutData%HubPtMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubPtMotion14 - 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) - 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 MeshUnpack( OutData%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubPtMotion - 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) - 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 MeshUnpack( OutData%BladeRootMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootMotion14 - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootMotion 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%BladeRootMotion)) DEALLOCATE(OutData%BladeRootMotion) - ALLOCATE(OutData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeRootMotion,1), UBOUND(OutData%BladeRootMotion,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 MeshUnpack( OutData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootMotion - 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 - 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 MeshUnpack( OutData%RotorFurlMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! RotorFurlMotion14 - 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) - 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 MeshUnpack( OutData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleMotion - 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) - 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 MeshUnpack( OutData%TowerBaseMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerBaseMotion14 - 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) - 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 MeshUnpack( OutData%TFinCMMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TFinCMMotion - 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) - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch 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%BlPitch)) DEALLOCATE(OutData%BlPitch) - ALLOCATE(OutData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) - OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Yaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSS_Spd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSS_Spd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TwrAccel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RootMyc,1) - i1_u = UBOUND(OutData%RootMyc,1) - DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) - OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%YawBrTAxp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAyp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipPxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RootMxc,1) - i1_u = UBOUND(OutData%RootMxc,1) - DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) - OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%LSSTipMxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMya = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMza = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAxs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_UnPackOutput - - - SUBROUTINE ED_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(ED_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(ED_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 + ErrMsg = '' +end subroutine + +subroutine ED_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%Linearize) + call RegPack(Buf, InData%ADInputFile) + call RegPack(Buf, InData%CompElast) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%MHK) + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ADInputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompElast) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(ED_InitOutputType), intent(in) :: SrcInitOutputData + type(ED_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%NumBl = SrcInitOutputData%NumBl + if (allocated(SrcInitOutputData%BlPitch)) then + LB(1:1) = lbound(SrcInitOutputData%BlPitch) + UB(1:1) = ubound(SrcInitOutputData%BlPitch) + if (.not. allocated(DstInitOutputData%BlPitch)) then + allocate(DstInitOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%BlPitch = SrcInitOutputData%BlPitch + end if + DstInitOutputData%BladeLength = SrcInitOutputData%BladeLength + DstInitOutputData%TowerHeight = SrcInitOutputData%TowerHeight + DstInitOutputData%TowerBaseHeight = SrcInitOutputData%TowerBaseHeight + DstInitOutputData%HubHt = SrcInitOutputData%HubHt + if (allocated(SrcInitOutputData%BldRNodes)) then + LB(1:1) = lbound(SrcInitOutputData%BldRNodes) + UB(1:1) = ubound(SrcInitOutputData%BldRNodes) + if (.not. allocated(DstInitOutputData%BldRNodes)) then + allocate(DstInitOutputData%BldRNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%BldRNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%BldRNodes = SrcInitOutputData%BldRNodes + end if + if (allocated(SrcInitOutputData%TwrHNodes)) then + LB(1:1) = lbound(SrcInitOutputData%TwrHNodes) + UB(1:1) = ubound(SrcInitOutputData%TwrHNodes) + if (.not. allocated(DstInitOutputData%TwrHNodes)) then + allocate(DstInitOutputData%TwrHNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%TwrHNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%TwrHNodes = SrcInitOutputData%TwrHNodes + end if + DstInitOutputData%PlatformPos = SrcInitOutputData%PlatformPos + DstInitOutputData%TwrBaseRefPos = SrcInitOutputData%TwrBaseRefPos + DstInitOutputData%TwrBaseTransDisp = SrcInitOutputData%TwrBaseTransDisp + DstInitOutputData%TwrBaseRefOrient = SrcInitOutputData%TwrBaseRefOrient + DstInitOutputData%TwrBaseOrient = SrcInitOutputData%TwrBaseOrient + DstInitOutputData%HubRad = SrcInitOutputData%HubRad + DstInitOutputData%RotSpeed = SrcInitOutputData%RotSpeed + DstInitOutputData%isFixed_GenDOF = SrcInitOutputData%isFixed_GenDOF + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + end if +end subroutine + +subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(ED_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%BlPitch)) then + deallocate(InitOutputData%BlPitch) + end if + if (allocated(InitOutputData%BldRNodes)) then + deallocate(InitOutputData%BldRNodes) + end if + if (allocated(InitOutputData%TwrHNodes)) then + deallocate(InitOutputData%TwrHNodes) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if +end subroutine + +subroutine ED_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, InData%NumBl) + call RegPack(Buf, allocated(InData%BlPitch)) + if (allocated(InData%BlPitch)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) + call RegPack(Buf, InData%BlPitch) + end if + call RegPack(Buf, InData%BladeLength) + call RegPack(Buf, InData%TowerHeight) + call RegPack(Buf, InData%TowerBaseHeight) + call RegPack(Buf, InData%HubHt) + call RegPack(Buf, allocated(InData%BldRNodes)) + if (allocated(InData%BldRNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%BldRNodes), ubound(InData%BldRNodes)) + call RegPack(Buf, InData%BldRNodes) + end if + call RegPack(Buf, allocated(InData%TwrHNodes)) + if (allocated(InData%TwrHNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrHNodes), ubound(InData%TwrHNodes)) + call RegPack(Buf, InData%TwrHNodes) + end if + call RegPack(Buf, InData%PlatformPos) + call RegPack(Buf, InData%TwrBaseRefPos) + call RegPack(Buf, InData%TwrBaseTransDisp) + call RegPack(Buf, InData%TwrBaseRefOrient) + call RegPack(Buf, InData%TwrBaseOrient) + call RegPack(Buf, InData%HubRad) + call RegPack(Buf, InData%RotSpeed) + call RegPack(Buf, InData%isFixed_GenDOF) + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackInitOutput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitch(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitch) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TowerHeight) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TowerBaseHeight) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubHt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BldRNodes)) deallocate(OutData%BldRNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldRNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldRNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldRNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrHNodes)) deallocate(OutData%TwrHNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrHNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrHNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%PlatformPos) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrBaseRefPos) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrBaseTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrBaseRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrBaseOrient) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubRad) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%isFixed_GenDOF) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) + type(BladeInputData), intent(in) :: SrcBladeInputDataData + type(BladeInputData), intent(inout) :: DstBladeInputDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyBladeInputData' + ErrStat = ErrID_None + ErrMsg = '' + DstBladeInputDataData%NBlInpSt = SrcBladeInputDataData%NBlInpSt + if (allocated(SrcBladeInputDataData%BlFract)) then + LB(1:1) = lbound(SrcBladeInputDataData%BlFract) + UB(1:1) = ubound(SrcBladeInputDataData%BlFract) + if (.not. allocated(DstBladeInputDataData%BlFract)) then + allocate(DstBladeInputDataData%BlFract(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BlFract.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%BlFract = SrcBladeInputDataData%BlFract + end if + if (allocated(SrcBladeInputDataData%PitchAx)) then + LB(1:1) = lbound(SrcBladeInputDataData%PitchAx) + UB(1:1) = ubound(SrcBladeInputDataData%PitchAx) + if (.not. allocated(DstBladeInputDataData%PitchAx)) then + allocate(DstBladeInputDataData%PitchAx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%PitchAx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%PitchAx = SrcBladeInputDataData%PitchAx + end if + if (allocated(SrcBladeInputDataData%StrcTwst)) then + LB(1:1) = lbound(SrcBladeInputDataData%StrcTwst) + UB(1:1) = ubound(SrcBladeInputDataData%StrcTwst) + if (.not. allocated(DstBladeInputDataData%StrcTwst)) then + allocate(DstBladeInputDataData%StrcTwst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%StrcTwst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%StrcTwst = SrcBladeInputDataData%StrcTwst + end if + if (allocated(SrcBladeInputDataData%BMassDen)) then + LB(1:1) = lbound(SrcBladeInputDataData%BMassDen) + UB(1:1) = ubound(SrcBladeInputDataData%BMassDen) + if (.not. allocated(DstBladeInputDataData%BMassDen)) then + allocate(DstBladeInputDataData%BMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%BMassDen = SrcBladeInputDataData%BMassDen + end if + if (allocated(SrcBladeInputDataData%FlpStff)) then + LB(1:1) = lbound(SrcBladeInputDataData%FlpStff) + UB(1:1) = ubound(SrcBladeInputDataData%FlpStff) + if (.not. allocated(DstBladeInputDataData%FlpStff)) then + allocate(DstBladeInputDataData%FlpStff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%FlpStff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%FlpStff = SrcBladeInputDataData%FlpStff + end if + if (allocated(SrcBladeInputDataData%EdgStff)) then + LB(1:1) = lbound(SrcBladeInputDataData%EdgStff) + UB(1:1) = ubound(SrcBladeInputDataData%EdgStff) + if (.not. allocated(DstBladeInputDataData%EdgStff)) then + allocate(DstBladeInputDataData%EdgStff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%EdgStff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%EdgStff = SrcBladeInputDataData%EdgStff + end if + DstBladeInputDataData%BldFlDmp = SrcBladeInputDataData%BldFlDmp + DstBladeInputDataData%BldEdDmp = SrcBladeInputDataData%BldEdDmp + DstBladeInputDataData%FlStTunr = SrcBladeInputDataData%FlStTunr + if (allocated(SrcBladeInputDataData%BldFl1Sh)) then + LB(1:1) = lbound(SrcBladeInputDataData%BldFl1Sh) + UB(1:1) = ubound(SrcBladeInputDataData%BldFl1Sh) + if (.not. allocated(DstBladeInputDataData%BldFl1Sh)) then + allocate(DstBladeInputDataData%BldFl1Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldFl1Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%BldFl1Sh = SrcBladeInputDataData%BldFl1Sh + end if + if (allocated(SrcBladeInputDataData%BldFl2Sh)) then + LB(1:1) = lbound(SrcBladeInputDataData%BldFl2Sh) + UB(1:1) = ubound(SrcBladeInputDataData%BldFl2Sh) + if (.not. allocated(DstBladeInputDataData%BldFl2Sh)) then + allocate(DstBladeInputDataData%BldFl2Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldFl2Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%BldFl2Sh = SrcBladeInputDataData%BldFl2Sh + end if + if (allocated(SrcBladeInputDataData%BldEdgSh)) then + LB(1:1) = lbound(SrcBladeInputDataData%BldEdgSh) + UB(1:1) = ubound(SrcBladeInputDataData%BldEdgSh) + if (.not. allocated(DstBladeInputDataData%BldEdgSh)) then + allocate(DstBladeInputDataData%BldEdgSh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldEdgSh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%BldEdgSh = SrcBladeInputDataData%BldEdgSh + end if +end subroutine + +subroutine ED_DestroyBladeInputData(BladeInputDataData, ErrStat, ErrMsg) + type(BladeInputData), intent(inout) :: BladeInputDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyBladeInputData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladeInputDataData%BlFract)) then + deallocate(BladeInputDataData%BlFract) + end if + if (allocated(BladeInputDataData%PitchAx)) then + deallocate(BladeInputDataData%PitchAx) + end if + if (allocated(BladeInputDataData%StrcTwst)) then + deallocate(BladeInputDataData%StrcTwst) + end if + if (allocated(BladeInputDataData%BMassDen)) then + deallocate(BladeInputDataData%BMassDen) + end if + if (allocated(BladeInputDataData%FlpStff)) then + deallocate(BladeInputDataData%FlpStff) + end if + if (allocated(BladeInputDataData%EdgStff)) then + deallocate(BladeInputDataData%EdgStff) + end if + if (allocated(BladeInputDataData%BldFl1Sh)) then + deallocate(BladeInputDataData%BldFl1Sh) + end if + if (allocated(BladeInputDataData%BldFl2Sh)) then + deallocate(BladeInputDataData%BldFl2Sh) + end if + if (allocated(BladeInputDataData%BldEdgSh)) then + deallocate(BladeInputDataData%BldEdgSh) + end if +end subroutine + +subroutine ED_PackBladeInputData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BladeInputData), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackBladeInputData' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%NBlInpSt) + call RegPack(Buf, allocated(InData%BlFract)) + if (allocated(InData%BlFract)) then + call RegPackBounds(Buf, 1, lbound(InData%BlFract), ubound(InData%BlFract)) + call RegPack(Buf, InData%BlFract) + end if + call RegPack(Buf, allocated(InData%PitchAx)) + if (allocated(InData%PitchAx)) then + call RegPackBounds(Buf, 1, lbound(InData%PitchAx), ubound(InData%PitchAx)) + call RegPack(Buf, InData%PitchAx) + end if + call RegPack(Buf, allocated(InData%StrcTwst)) + if (allocated(InData%StrcTwst)) then + call RegPackBounds(Buf, 1, lbound(InData%StrcTwst), ubound(InData%StrcTwst)) + call RegPack(Buf, InData%StrcTwst) + end if + call RegPack(Buf, allocated(InData%BMassDen)) + if (allocated(InData%BMassDen)) then + call RegPackBounds(Buf, 1, lbound(InData%BMassDen), ubound(InData%BMassDen)) + call RegPack(Buf, InData%BMassDen) + end if + call RegPack(Buf, allocated(InData%FlpStff)) + if (allocated(InData%FlpStff)) then + call RegPackBounds(Buf, 1, lbound(InData%FlpStff), ubound(InData%FlpStff)) + call RegPack(Buf, InData%FlpStff) + end if + call RegPack(Buf, allocated(InData%EdgStff)) + if (allocated(InData%EdgStff)) then + call RegPackBounds(Buf, 1, lbound(InData%EdgStff), ubound(InData%EdgStff)) + call RegPack(Buf, InData%EdgStff) + end if + call RegPack(Buf, InData%BldFlDmp) + call RegPack(Buf, InData%BldEdDmp) + call RegPack(Buf, InData%FlStTunr) + call RegPack(Buf, allocated(InData%BldFl1Sh)) + if (allocated(InData%BldFl1Sh)) then + call RegPackBounds(Buf, 1, lbound(InData%BldFl1Sh), ubound(InData%BldFl1Sh)) + call RegPack(Buf, InData%BldFl1Sh) + end if + call RegPack(Buf, allocated(InData%BldFl2Sh)) + if (allocated(InData%BldFl2Sh)) then + call RegPackBounds(Buf, 1, lbound(InData%BldFl2Sh), ubound(InData%BldFl2Sh)) + call RegPack(Buf, InData%BldFl2Sh) + end if + call RegPack(Buf, allocated(InData%BldEdgSh)) + if (allocated(InData%BldEdgSh)) then + call RegPackBounds(Buf, 1, lbound(InData%BldEdgSh), ubound(InData%BldEdgSh)) + call RegPack(Buf, InData%BldEdgSh) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackBladeInputData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BladeInputData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackBladeInputData' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NBlInpSt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BlFract)) deallocate(OutData%BlFract) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlFract(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlFract.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlFract) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PitchAx)) deallocate(OutData%PitchAx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PitchAx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PitchAx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StrcTwst)) deallocate(OutData%StrcTwst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StrcTwst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrcTwst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StrcTwst) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BMassDen)) deallocate(OutData%BMassDen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BMassDen(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BMassDen) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FlpStff)) deallocate(OutData%FlpStff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FlpStff(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpStff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FlpStff) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%EdgStff)) deallocate(OutData%EdgStff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%EdgStff(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgStff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%EdgStff) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%BldFlDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldEdDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FlStTunr) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BldFl1Sh)) deallocate(OutData%BldFl1Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldFl1Sh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldFl1Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BldFl2Sh)) deallocate(OutData%BldFl2Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldFl2Sh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldFl2Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BldEdgSh)) deallocate(OutData%BldEdgSh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldEdgSh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldEdgSh) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInputDataData, CtrlCode, ErrStat, ErrMsg) + type(ED_BladeMeshInputData), intent(in) :: SrcBladeMeshInputDataData + type(ED_BladeMeshInputData), intent(inout) :: DstBladeMeshInputDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyBladeMeshInputData' + ErrStat = ErrID_None + ErrMsg = '' + DstBladeMeshInputDataData%BldNodes = SrcBladeMeshInputDataData%BldNodes + if (allocated(SrcBladeMeshInputDataData%RNodes)) then + LB(1:1) = lbound(SrcBladeMeshInputDataData%RNodes) + UB(1:1) = ubound(SrcBladeMeshInputDataData%RNodes) + if (.not. allocated(DstBladeMeshInputDataData%RNodes)) then + allocate(DstBladeMeshInputDataData%RNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%RNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeMeshInputDataData%RNodes = SrcBladeMeshInputDataData%RNodes + end if + if (allocated(SrcBladeMeshInputDataData%AeroTwst)) then + LB(1:1) = lbound(SrcBladeMeshInputDataData%AeroTwst) + UB(1:1) = ubound(SrcBladeMeshInputDataData%AeroTwst) + if (.not. allocated(DstBladeMeshInputDataData%AeroTwst)) then + allocate(DstBladeMeshInputDataData%AeroTwst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%AeroTwst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeMeshInputDataData%AeroTwst = SrcBladeMeshInputDataData%AeroTwst + end if + if (allocated(SrcBladeMeshInputDataData%Chord)) then + LB(1:1) = lbound(SrcBladeMeshInputDataData%Chord) + UB(1:1) = ubound(SrcBladeMeshInputDataData%Chord) + if (.not. allocated(DstBladeMeshInputDataData%Chord)) then + allocate(DstBladeMeshInputDataData%Chord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%Chord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeMeshInputDataData%Chord = SrcBladeMeshInputDataData%Chord + end if +end subroutine + +subroutine ED_DestroyBladeMeshInputData(BladeMeshInputDataData, ErrStat, ErrMsg) + type(ED_BladeMeshInputData), intent(inout) :: BladeMeshInputDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyBladeMeshInputData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladeMeshInputDataData%RNodes)) then + deallocate(BladeMeshInputDataData%RNodes) + end if + if (allocated(BladeMeshInputDataData%AeroTwst)) then + deallocate(BladeMeshInputDataData%AeroTwst) + end if + if (allocated(BladeMeshInputDataData%Chord)) then + deallocate(BladeMeshInputDataData%Chord) + end if +end subroutine + +subroutine ED_PackBladeMeshInputData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_BladeMeshInputData), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackBladeMeshInputData' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%BldNodes) + call RegPack(Buf, allocated(InData%RNodes)) + if (allocated(InData%RNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%RNodes), ubound(InData%RNodes)) + call RegPack(Buf, InData%RNodes) + end if + call RegPack(Buf, allocated(InData%AeroTwst)) + if (allocated(InData%AeroTwst)) then + call RegPackBounds(Buf, 1, lbound(InData%AeroTwst), ubound(InData%AeroTwst)) + call RegPack(Buf, InData%AeroTwst) + end if + call RegPack(Buf, allocated(InData%Chord)) + if (allocated(InData%Chord)) then + call RegPackBounds(Buf, 1, lbound(InData%Chord), ubound(InData%Chord)) + call RegPack(Buf, InData%Chord) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackBladeMeshInputData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_BladeMeshInputData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackBladeMeshInputData' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%BldNodes) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%RNodes)) deallocate(OutData%RNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AeroTwst)) deallocate(OutData%AeroTwst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AeroTwst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AeroTwst) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Chord)) deallocate(OutData%Chord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Chord(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Chord) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(ED_InputFile), intent(in) :: SrcInputFileData + type(ED_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%DT = SrcInputFileData%DT + DstInputFileData%FlapDOF1 = SrcInputFileData%FlapDOF1 + DstInputFileData%FlapDOF2 = SrcInputFileData%FlapDOF2 + DstInputFileData%EdgeDOF = SrcInputFileData%EdgeDOF + DstInputFileData%TeetDOF = SrcInputFileData%TeetDOF + DstInputFileData%DrTrDOF = SrcInputFileData%DrTrDOF + DstInputFileData%GenDOF = SrcInputFileData%GenDOF + DstInputFileData%YawDOF = SrcInputFileData%YawDOF + DstInputFileData%TwFADOF1 = SrcInputFileData%TwFADOF1 + DstInputFileData%TwFADOF2 = SrcInputFileData%TwFADOF2 + DstInputFileData%TwSSDOF1 = SrcInputFileData%TwSSDOF1 + DstInputFileData%TwSSDOF2 = SrcInputFileData%TwSSDOF2 + DstInputFileData%PtfmSgDOF = SrcInputFileData%PtfmSgDOF + DstInputFileData%PtfmSwDOF = SrcInputFileData%PtfmSwDOF + DstInputFileData%PtfmHvDOF = SrcInputFileData%PtfmHvDOF + DstInputFileData%PtfmRDOF = SrcInputFileData%PtfmRDOF + DstInputFileData%PtfmPDOF = SrcInputFileData%PtfmPDOF + DstInputFileData%PtfmYDOF = SrcInputFileData%PtfmYDOF + DstInputFileData%OoPDefl = SrcInputFileData%OoPDefl + DstInputFileData%IPDefl = SrcInputFileData%IPDefl + if (allocated(SrcInputFileData%BlPitch)) then + LB(1:1) = lbound(SrcInputFileData%BlPitch) + UB(1:1) = ubound(SrcInputFileData%BlPitch) + if (.not. allocated(DstInputFileData%BlPitch)) then + allocate(DstInputFileData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BlPitch = SrcInputFileData%BlPitch + end if + DstInputFileData%TeetDefl = SrcInputFileData%TeetDefl + DstInputFileData%Azimuth = SrcInputFileData%Azimuth + DstInputFileData%RotSpeed = SrcInputFileData%RotSpeed + DstInputFileData%NacYaw = SrcInputFileData%NacYaw + DstInputFileData%TTDspFA = SrcInputFileData%TTDspFA + DstInputFileData%TTDspSS = SrcInputFileData%TTDspSS + DstInputFileData%PtfmSurge = SrcInputFileData%PtfmSurge + DstInputFileData%PtfmSway = SrcInputFileData%PtfmSway + DstInputFileData%PtfmHeave = SrcInputFileData%PtfmHeave + DstInputFileData%PtfmRoll = SrcInputFileData%PtfmRoll + DstInputFileData%PtfmPitch = SrcInputFileData%PtfmPitch + DstInputFileData%PtfmYaw = SrcInputFileData%PtfmYaw + DstInputFileData%NumBl = SrcInputFileData%NumBl + DstInputFileData%TipRad = SrcInputFileData%TipRad + DstInputFileData%HubRad = SrcInputFileData%HubRad + if (allocated(SrcInputFileData%PreCone)) then + LB(1:1) = lbound(SrcInputFileData%PreCone) + UB(1:1) = ubound(SrcInputFileData%PreCone) + if (.not. allocated(DstInputFileData%PreCone)) then + allocate(DstInputFileData%PreCone(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PreCone.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PreCone = SrcInputFileData%PreCone + end if + DstInputFileData%HubCM = SrcInputFileData%HubCM + DstInputFileData%UndSling = SrcInputFileData%UndSling + DstInputFileData%Delta3 = SrcInputFileData%Delta3 + DstInputFileData%AzimB1Up = SrcInputFileData%AzimB1Up + DstInputFileData%OverHang = SrcInputFileData%OverHang + DstInputFileData%ShftGagL = SrcInputFileData%ShftGagL + DstInputFileData%ShftTilt = SrcInputFileData%ShftTilt + DstInputFileData%NacCMxn = SrcInputFileData%NacCMxn + DstInputFileData%NacCMyn = SrcInputFileData%NacCMyn + DstInputFileData%NacCMzn = SrcInputFileData%NacCMzn + DstInputFileData%NcIMUxn = SrcInputFileData%NcIMUxn + DstInputFileData%NcIMUyn = SrcInputFileData%NcIMUyn + DstInputFileData%NcIMUzn = SrcInputFileData%NcIMUzn + DstInputFileData%Twr2Shft = SrcInputFileData%Twr2Shft + DstInputFileData%TowerHt = SrcInputFileData%TowerHt + DstInputFileData%TowerBsHt = SrcInputFileData%TowerBsHt + DstInputFileData%PtfmCMxt = SrcInputFileData%PtfmCMxt + DstInputFileData%PtfmCMyt = SrcInputFileData%PtfmCMyt + DstInputFileData%PtfmCMzt = SrcInputFileData%PtfmCMzt + DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt + if (allocated(SrcInputFileData%TipMass)) then + LB(1:1) = lbound(SrcInputFileData%TipMass) + UB(1:1) = ubound(SrcInputFileData%TipMass) + if (.not. allocated(DstInputFileData%TipMass)) then + allocate(DstInputFileData%TipMass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TipMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TipMass = SrcInputFileData%TipMass + end if + DstInputFileData%HubMass = SrcInputFileData%HubMass + DstInputFileData%HubIner = SrcInputFileData%HubIner + DstInputFileData%GenIner = SrcInputFileData%GenIner + DstInputFileData%NacMass = SrcInputFileData%NacMass + DstInputFileData%NacYIner = SrcInputFileData%NacYIner + DstInputFileData%YawBrMass = SrcInputFileData%YawBrMass + DstInputFileData%PtfmMass = SrcInputFileData%PtfmMass + DstInputFileData%PtfmRIner = SrcInputFileData%PtfmRIner + DstInputFileData%PtfmPIner = SrcInputFileData%PtfmPIner + DstInputFileData%PtfmYIner = SrcInputFileData%PtfmYIner + DstInputFileData%BldNodes = SrcInputFileData%BldNodes + if (allocated(SrcInputFileData%InpBlMesh)) then + LB(1:1) = lbound(SrcInputFileData%InpBlMesh) + UB(1:1) = ubound(SrcInputFileData%InpBlMesh) + if (.not. allocated(DstInputFileData%InpBlMesh)) then + allocate(DstInputFileData%InpBlMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InpBlMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyBladeMeshInputData(SrcInputFileData%InpBlMesh(i1), DstInputFileData%InpBlMesh(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputFileData%InpBl)) then + LB(1:1) = lbound(SrcInputFileData%InpBl) + UB(1:1) = ubound(SrcInputFileData%InpBl) + if (.not. allocated(DstInputFileData%InpBl)) then + allocate(DstInputFileData%InpBl(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InpBl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyBladeInputData(SrcInputFileData%InpBl(i1), DstInputFileData%InpBl(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInputFileData%TeetMod = SrcInputFileData%TeetMod + DstInputFileData%TeetDmpP = SrcInputFileData%TeetDmpP + DstInputFileData%TeetDmp = SrcInputFileData%TeetDmp + DstInputFileData%TeetCDmp = SrcInputFileData%TeetCDmp + DstInputFileData%TeetSStP = SrcInputFileData%TeetSStP + DstInputFileData%TeetHStP = SrcInputFileData%TeetHStP + DstInputFileData%TeetSSSp = SrcInputFileData%TeetSSSp + DstInputFileData%TeetHSSp = SrcInputFileData%TeetHSSp + DstInputFileData%GBoxEff = SrcInputFileData%GBoxEff + DstInputFileData%GBRatio = SrcInputFileData%GBRatio + DstInputFileData%DTTorSpr = SrcInputFileData%DTTorSpr + DstInputFileData%DTTorDmp = SrcInputFileData%DTTorDmp + DstInputFileData%Furling = SrcInputFileData%Furling + DstInputFileData%TwrNodes = SrcInputFileData%TwrNodes + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%OutFile = SrcInputFileData%OutFile + DstInputFileData%TabDelim = SrcInputFileData%TabDelim + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%Tstart = SrcInputFileData%Tstart + DstInputFileData%DecFact = SrcInputFileData%DecFact + DstInputFileData%NTwGages = SrcInputFileData%NTwGages + DstInputFileData%TwrGagNd = SrcInputFileData%TwrGagNd + DstInputFileData%NBlGages = SrcInputFileData%NBlGages + DstInputFileData%BldGagNd = SrcInputFileData%BldGagNd + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + end if + DstInputFileData%NTwInpSt = SrcInputFileData%NTwInpSt + DstInputFileData%TwrFADmp = SrcInputFileData%TwrFADmp + DstInputFileData%TwrSSDmp = SrcInputFileData%TwrSSDmp + DstInputFileData%FAStTunr = SrcInputFileData%FAStTunr + DstInputFileData%SSStTunr = SrcInputFileData%SSStTunr + if (allocated(SrcInputFileData%HtFract)) then + LB(1:1) = lbound(SrcInputFileData%HtFract) + UB(1:1) = ubound(SrcInputFileData%HtFract) + if (.not. allocated(DstInputFileData%HtFract)) then + allocate(DstInputFileData%HtFract(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%HtFract.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%HtFract = SrcInputFileData%HtFract + end if + if (allocated(SrcInputFileData%TMassDen)) then + LB(1:1) = lbound(SrcInputFileData%TMassDen) + UB(1:1) = ubound(SrcInputFileData%TMassDen) + if (.not. allocated(DstInputFileData%TMassDen)) then + allocate(DstInputFileData%TMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TMassDen = SrcInputFileData%TMassDen + end if + if (allocated(SrcInputFileData%TwFAStif)) then + LB(1:1) = lbound(SrcInputFileData%TwFAStif) + UB(1:1) = ubound(SrcInputFileData%TwFAStif) + if (.not. allocated(DstInputFileData%TwFAStif)) then + allocate(DstInputFileData%TwFAStif(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAStif.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwFAStif = SrcInputFileData%TwFAStif + end if + if (allocated(SrcInputFileData%TwSSStif)) then + LB(1:1) = lbound(SrcInputFileData%TwSSStif) + UB(1:1) = ubound(SrcInputFileData%TwSSStif) + if (.not. allocated(DstInputFileData%TwSSStif)) then + allocate(DstInputFileData%TwSSStif(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSStif.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwSSStif = SrcInputFileData%TwSSStif + end if + if (allocated(SrcInputFileData%TwFAM1Sh)) then + LB(1:1) = lbound(SrcInputFileData%TwFAM1Sh) + UB(1:1) = ubound(SrcInputFileData%TwFAM1Sh) + if (.not. allocated(DstInputFileData%TwFAM1Sh)) then + allocate(DstInputFileData%TwFAM1Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAM1Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwFAM1Sh = SrcInputFileData%TwFAM1Sh + end if + if (allocated(SrcInputFileData%TwFAM2Sh)) then + LB(1:1) = lbound(SrcInputFileData%TwFAM2Sh) + UB(1:1) = ubound(SrcInputFileData%TwFAM2Sh) + if (.not. allocated(DstInputFileData%TwFAM2Sh)) then + allocate(DstInputFileData%TwFAM2Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAM2Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwFAM2Sh = SrcInputFileData%TwFAM2Sh + end if + if (allocated(SrcInputFileData%TwSSM1Sh)) then + LB(1:1) = lbound(SrcInputFileData%TwSSM1Sh) + UB(1:1) = ubound(SrcInputFileData%TwSSM1Sh) + if (.not. allocated(DstInputFileData%TwSSM1Sh)) then + allocate(DstInputFileData%TwSSM1Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSM1Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwSSM1Sh = SrcInputFileData%TwSSM1Sh + end if + if (allocated(SrcInputFileData%TwSSM2Sh)) then + LB(1:1) = lbound(SrcInputFileData%TwSSM2Sh) + UB(1:1) = ubound(SrcInputFileData%TwSSM2Sh) + if (.not. allocated(DstInputFileData%TwSSM2Sh)) then + allocate(DstInputFileData%TwSSM2Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSM2Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwSSM2Sh = SrcInputFileData%TwSSM2Sh + end if + DstInputFileData%RFrlDOF = SrcInputFileData%RFrlDOF + DstInputFileData%TFrlDOF = SrcInputFileData%TFrlDOF + DstInputFileData%RotFurl = SrcInputFileData%RotFurl + DstInputFileData%TailFurl = SrcInputFileData%TailFurl + DstInputFileData%Yaw2Shft = SrcInputFileData%Yaw2Shft + DstInputFileData%ShftSkew = SrcInputFileData%ShftSkew + DstInputFileData%RFrlCM_n = SrcInputFileData%RFrlCM_n + DstInputFileData%BoomCM_n = SrcInputFileData%BoomCM_n + DstInputFileData%TFinCM_n = SrcInputFileData%TFinCM_n + DstInputFileData%RFrlPnt_n = SrcInputFileData%RFrlPnt_n + DstInputFileData%RFrlSkew = SrcInputFileData%RFrlSkew + DstInputFileData%RFrlTilt = SrcInputFileData%RFrlTilt + DstInputFileData%TFrlPnt_n = SrcInputFileData%TFrlPnt_n + DstInputFileData%TFrlSkew = SrcInputFileData%TFrlSkew + DstInputFileData%TFrlTilt = SrcInputFileData%TFrlTilt + DstInputFileData%RFrlMass = SrcInputFileData%RFrlMass + DstInputFileData%BoomMass = SrcInputFileData%BoomMass + DstInputFileData%TFinMass = SrcInputFileData%TFinMass + DstInputFileData%RFrlIner = SrcInputFileData%RFrlIner + DstInputFileData%TFrlIner = SrcInputFileData%TFrlIner + DstInputFileData%RFrlMod = SrcInputFileData%RFrlMod + DstInputFileData%RFrlSpr = SrcInputFileData%RFrlSpr + DstInputFileData%RFrlDmp = SrcInputFileData%RFrlDmp + DstInputFileData%RFrlUSSP = SrcInputFileData%RFrlUSSP + DstInputFileData%RFrlDSSP = SrcInputFileData%RFrlDSSP + DstInputFileData%RFrlUSSpr = SrcInputFileData%RFrlUSSpr + DstInputFileData%RFrlDSSpr = SrcInputFileData%RFrlDSSpr + DstInputFileData%RFrlUSDP = SrcInputFileData%RFrlUSDP + DstInputFileData%RFrlDSDP = SrcInputFileData%RFrlDSDP + DstInputFileData%RFrlUSDmp = SrcInputFileData%RFrlUSDmp + DstInputFileData%RFrlDSDmp = SrcInputFileData%RFrlDSDmp + DstInputFileData%TFrlMod = SrcInputFileData%TFrlMod + DstInputFileData%TFrlSpr = SrcInputFileData%TFrlSpr + DstInputFileData%TFrlDmp = SrcInputFileData%TFrlDmp + DstInputFileData%TFrlUSSP = SrcInputFileData%TFrlUSSP + DstInputFileData%TFrlDSSP = SrcInputFileData%TFrlDSSP + DstInputFileData%TFrlUSSpr = SrcInputFileData%TFrlUSSpr + DstInputFileData%TFrlDSSpr = SrcInputFileData%TFrlDSSpr + DstInputFileData%TFrlUSDP = SrcInputFileData%TFrlUSDP + DstInputFileData%TFrlDSDP = SrcInputFileData%TFrlDSDP + DstInputFileData%TFrlUSDmp = SrcInputFileData%TFrlUSDmp + DstInputFileData%TFrlDSDmp = SrcInputFileData%TFrlDSDmp + DstInputFileData%method = SrcInputFileData%method + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts + if (allocated(SrcInputFileData%BldNd_OutList)) then + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) + if (.not. allocated(DstInputFileData%BldNd_OutList)) then + allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList + end if + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str + DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut +end subroutine + +subroutine ED_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(ED_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%BlPitch)) then + deallocate(InputFileData%BlPitch) + end if + if (allocated(InputFileData%PreCone)) then + deallocate(InputFileData%PreCone) + end if + if (allocated(InputFileData%TipMass)) then + deallocate(InputFileData%TipMass) + end if + if (allocated(InputFileData%InpBlMesh)) then + LB(1:1) = lbound(InputFileData%InpBlMesh) + UB(1:1) = ubound(InputFileData%InpBlMesh) + do i1 = LB(1), UB(1) + call ED_DestroyBladeMeshInputData(InputFileData%InpBlMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputFileData%InpBlMesh) + end if + if (allocated(InputFileData%InpBl)) then + LB(1:1) = lbound(InputFileData%InpBl) + UB(1:1) = ubound(InputFileData%InpBl) + do i1 = LB(1), UB(1) + call ED_DestroyBladeInputData(InputFileData%InpBl(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputFileData%InpBl) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%HtFract)) then + deallocate(InputFileData%HtFract) + end if + if (allocated(InputFileData%TMassDen)) then + deallocate(InputFileData%TMassDen) + end if + if (allocated(InputFileData%TwFAStif)) then + deallocate(InputFileData%TwFAStif) + end if + if (allocated(InputFileData%TwSSStif)) then + deallocate(InputFileData%TwSSStif) + end if + if (allocated(InputFileData%TwFAM1Sh)) then + deallocate(InputFileData%TwFAM1Sh) + end if + if (allocated(InputFileData%TwFAM2Sh)) then + deallocate(InputFileData%TwFAM2Sh) + end if + if (allocated(InputFileData%TwSSM1Sh)) then + deallocate(InputFileData%TwSSM1Sh) + end if + if (allocated(InputFileData%TwSSM2Sh)) then + deallocate(InputFileData%TwSSM2Sh) + end if + if (allocated(InputFileData%BldNd_OutList)) then + deallocate(InputFileData%BldNd_OutList) + end if +end subroutine + +subroutine ED_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackInputFile' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%FlapDOF1) + call RegPack(Buf, InData%FlapDOF2) + call RegPack(Buf, InData%EdgeDOF) + call RegPack(Buf, InData%TeetDOF) + call RegPack(Buf, InData%DrTrDOF) + call RegPack(Buf, InData%GenDOF) + call RegPack(Buf, InData%YawDOF) + call RegPack(Buf, InData%TwFADOF1) + call RegPack(Buf, InData%TwFADOF2) + call RegPack(Buf, InData%TwSSDOF1) + call RegPack(Buf, InData%TwSSDOF2) + call RegPack(Buf, InData%PtfmSgDOF) + call RegPack(Buf, InData%PtfmSwDOF) + call RegPack(Buf, InData%PtfmHvDOF) + call RegPack(Buf, InData%PtfmRDOF) + call RegPack(Buf, InData%PtfmPDOF) + call RegPack(Buf, InData%PtfmYDOF) + call RegPack(Buf, InData%OoPDefl) + call RegPack(Buf, InData%IPDefl) + call RegPack(Buf, allocated(InData%BlPitch)) + if (allocated(InData%BlPitch)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) + call RegPack(Buf, InData%BlPitch) + end if + call RegPack(Buf, InData%TeetDefl) + call RegPack(Buf, InData%Azimuth) + call RegPack(Buf, InData%RotSpeed) + call RegPack(Buf, InData%NacYaw) + call RegPack(Buf, InData%TTDspFA) + call RegPack(Buf, InData%TTDspSS) + call RegPack(Buf, InData%PtfmSurge) + call RegPack(Buf, InData%PtfmSway) + call RegPack(Buf, InData%PtfmHeave) + call RegPack(Buf, InData%PtfmRoll) + call RegPack(Buf, InData%PtfmPitch) + call RegPack(Buf, InData%PtfmYaw) + call RegPack(Buf, InData%NumBl) + call RegPack(Buf, InData%TipRad) + call RegPack(Buf, InData%HubRad) + call RegPack(Buf, allocated(InData%PreCone)) + if (allocated(InData%PreCone)) then + call RegPackBounds(Buf, 1, lbound(InData%PreCone), ubound(InData%PreCone)) + call RegPack(Buf, InData%PreCone) + end if + call RegPack(Buf, InData%HubCM) + call RegPack(Buf, InData%UndSling) + call RegPack(Buf, InData%Delta3) + call RegPack(Buf, InData%AzimB1Up) + call RegPack(Buf, InData%OverHang) + call RegPack(Buf, InData%ShftGagL) + call RegPack(Buf, InData%ShftTilt) + call RegPack(Buf, InData%NacCMxn) + call RegPack(Buf, InData%NacCMyn) + call RegPack(Buf, InData%NacCMzn) + call RegPack(Buf, InData%NcIMUxn) + call RegPack(Buf, InData%NcIMUyn) + call RegPack(Buf, InData%NcIMUzn) + call RegPack(Buf, InData%Twr2Shft) + call RegPack(Buf, InData%TowerHt) + call RegPack(Buf, InData%TowerBsHt) + call RegPack(Buf, InData%PtfmCMxt) + call RegPack(Buf, InData%PtfmCMyt) + call RegPack(Buf, InData%PtfmCMzt) + call RegPack(Buf, InData%PtfmRefzt) + call RegPack(Buf, allocated(InData%TipMass)) + if (allocated(InData%TipMass)) then + call RegPackBounds(Buf, 1, lbound(InData%TipMass), ubound(InData%TipMass)) + call RegPack(Buf, InData%TipMass) + end if + call RegPack(Buf, InData%HubMass) + call RegPack(Buf, InData%HubIner) + call RegPack(Buf, InData%GenIner) + call RegPack(Buf, InData%NacMass) + call RegPack(Buf, InData%NacYIner) + call RegPack(Buf, InData%YawBrMass) + call RegPack(Buf, InData%PtfmMass) + call RegPack(Buf, InData%PtfmRIner) + call RegPack(Buf, InData%PtfmPIner) + call RegPack(Buf, InData%PtfmYIner) + call RegPack(Buf, InData%BldNodes) + call RegPack(Buf, allocated(InData%InpBlMesh)) + if (allocated(InData%InpBlMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%InpBlMesh), ubound(InData%InpBlMesh)) + LB(1:1) = lbound(InData%InpBlMesh) + UB(1:1) = ubound(InData%InpBlMesh) + do i1 = LB(1), UB(1) + call ED_PackBladeMeshInputData(Buf, InData%InpBlMesh(i1)) + end do + end if + call RegPack(Buf, allocated(InData%InpBl)) + if (allocated(InData%InpBl)) then + call RegPackBounds(Buf, 1, lbound(InData%InpBl), ubound(InData%InpBl)) + LB(1:1) = lbound(InData%InpBl) + UB(1:1) = ubound(InData%InpBl) + do i1 = LB(1), UB(1) + call ED_PackBladeInputData(Buf, InData%InpBl(i1)) + end do + end if + call RegPack(Buf, InData%TeetMod) + call RegPack(Buf, InData%TeetDmpP) + call RegPack(Buf, InData%TeetDmp) + call RegPack(Buf, InData%TeetCDmp) + call RegPack(Buf, InData%TeetSStP) + call RegPack(Buf, InData%TeetHStP) + call RegPack(Buf, InData%TeetSSSp) + call RegPack(Buf, InData%TeetHSSp) + call RegPack(Buf, InData%GBoxEff) + call RegPack(Buf, InData%GBRatio) + call RegPack(Buf, InData%DTTorSpr) + call RegPack(Buf, InData%DTTorDmp) + call RegPack(Buf, InData%Furling) + call RegPack(Buf, InData%TwrNodes) + call RegPack(Buf, InData%SumPrint) + call RegPack(Buf, InData%OutFile) + call RegPack(Buf, InData%TabDelim) + call RegPack(Buf, InData%OutFmt) + call RegPack(Buf, InData%Tstart) + call RegPack(Buf, InData%DecFact) + call RegPack(Buf, InData%NTwGages) + call RegPack(Buf, InData%TwrGagNd) + call RegPack(Buf, InData%NBlGages) + call RegPack(Buf, InData%BldGagNd) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + call RegPack(Buf, InData%NTwInpSt) + call RegPack(Buf, InData%TwrFADmp) + call RegPack(Buf, InData%TwrSSDmp) + call RegPack(Buf, InData%FAStTunr) + call RegPack(Buf, InData%SSStTunr) + call RegPack(Buf, allocated(InData%HtFract)) + if (allocated(InData%HtFract)) then + call RegPackBounds(Buf, 1, lbound(InData%HtFract), ubound(InData%HtFract)) + call RegPack(Buf, InData%HtFract) + end if + call RegPack(Buf, allocated(InData%TMassDen)) + if (allocated(InData%TMassDen)) then + call RegPackBounds(Buf, 1, lbound(InData%TMassDen), ubound(InData%TMassDen)) + call RegPack(Buf, InData%TMassDen) + end if + call RegPack(Buf, allocated(InData%TwFAStif)) + if (allocated(InData%TwFAStif)) then + call RegPackBounds(Buf, 1, lbound(InData%TwFAStif), ubound(InData%TwFAStif)) + call RegPack(Buf, InData%TwFAStif) + end if + call RegPack(Buf, allocated(InData%TwSSStif)) + if (allocated(InData%TwSSStif)) then + call RegPackBounds(Buf, 1, lbound(InData%TwSSStif), ubound(InData%TwSSStif)) + call RegPack(Buf, InData%TwSSStif) + end if + call RegPack(Buf, allocated(InData%TwFAM1Sh)) + if (allocated(InData%TwFAM1Sh)) then + call RegPackBounds(Buf, 1, lbound(InData%TwFAM1Sh), ubound(InData%TwFAM1Sh)) + call RegPack(Buf, InData%TwFAM1Sh) + end if + call RegPack(Buf, allocated(InData%TwFAM2Sh)) + if (allocated(InData%TwFAM2Sh)) then + call RegPackBounds(Buf, 1, lbound(InData%TwFAM2Sh), ubound(InData%TwFAM2Sh)) + call RegPack(Buf, InData%TwFAM2Sh) + end if + call RegPack(Buf, allocated(InData%TwSSM1Sh)) + if (allocated(InData%TwSSM1Sh)) then + call RegPackBounds(Buf, 1, lbound(InData%TwSSM1Sh), ubound(InData%TwSSM1Sh)) + call RegPack(Buf, InData%TwSSM1Sh) + end if + call RegPack(Buf, allocated(InData%TwSSM2Sh)) + if (allocated(InData%TwSSM2Sh)) then + call RegPackBounds(Buf, 1, lbound(InData%TwSSM2Sh), ubound(InData%TwSSM2Sh)) + call RegPack(Buf, InData%TwSSM2Sh) + end if + call RegPack(Buf, InData%RFrlDOF) + call RegPack(Buf, InData%TFrlDOF) + call RegPack(Buf, InData%RotFurl) + call RegPack(Buf, InData%TailFurl) + call RegPack(Buf, InData%Yaw2Shft) + call RegPack(Buf, InData%ShftSkew) + call RegPack(Buf, InData%RFrlCM_n) + call RegPack(Buf, InData%BoomCM_n) + call RegPack(Buf, InData%TFinCM_n) + call RegPack(Buf, InData%RFrlPnt_n) + call RegPack(Buf, InData%RFrlSkew) + call RegPack(Buf, InData%RFrlTilt) + call RegPack(Buf, InData%TFrlPnt_n) + call RegPack(Buf, InData%TFrlSkew) + call RegPack(Buf, InData%TFrlTilt) + call RegPack(Buf, InData%RFrlMass) + call RegPack(Buf, InData%BoomMass) + call RegPack(Buf, InData%TFinMass) + call RegPack(Buf, InData%RFrlIner) + call RegPack(Buf, InData%TFrlIner) + call RegPack(Buf, InData%RFrlMod) + call RegPack(Buf, InData%RFrlSpr) + call RegPack(Buf, InData%RFrlDmp) + call RegPack(Buf, InData%RFrlUSSP) + call RegPack(Buf, InData%RFrlDSSP) + call RegPack(Buf, InData%RFrlUSSpr) + call RegPack(Buf, InData%RFrlDSSpr) + call RegPack(Buf, InData%RFrlUSDP) + call RegPack(Buf, InData%RFrlDSDP) + call RegPack(Buf, InData%RFrlUSDmp) + call RegPack(Buf, InData%RFrlDSDmp) + call RegPack(Buf, InData%TFrlMod) + call RegPack(Buf, InData%TFrlSpr) + call RegPack(Buf, InData%TFrlDmp) + call RegPack(Buf, InData%TFrlUSSP) + call RegPack(Buf, InData%TFrlDSSP) + call RegPack(Buf, InData%TFrlUSSpr) + call RegPack(Buf, InData%TFrlDSSpr) + call RegPack(Buf, InData%TFrlUSDP) + call RegPack(Buf, InData%TFrlDSDP) + call RegPack(Buf, InData%TFrlUSDmp) + call RegPack(Buf, InData%TFrlDSDmp) + call RegPack(Buf, InData%method) + call RegPack(Buf, InData%BldNd_NumOuts) + call RegPack(Buf, allocated(InData%BldNd_OutList)) + if (allocated(InData%BldNd_OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList), ubound(InData%BldNd_OutList)) + call RegPack(Buf, InData%BldNd_OutList) + end if + call RegPack(Buf, InData%BldNd_BlOutNd_Str) + call RegPack(Buf, InData%BldNd_BladesOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackInputFile' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FlapDOF1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FlapDOF2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EdgeDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DrTrDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwFADOF1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwFADOF2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwSSDOF1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwSSDOF2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmSgDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmSwDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmHvDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmRDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmPDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmYDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OoPDefl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IPDefl) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitch(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitch) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%TeetDefl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Azimuth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacYaw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TTDspFA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TTDspSS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmSurge) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmSway) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmHeave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmRoll) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmPitch) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmYaw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TipRad) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubRad) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PreCone)) deallocate(OutData%PreCone) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PreCone(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PreCone.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PreCone) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%HubCM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UndSling) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Delta3) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AzimB1Up) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OverHang) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ShftGagL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ShftTilt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacCMxn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacCMyn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacCMzn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NcIMUxn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NcIMUyn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NcIMUzn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Twr2Shft) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TowerHt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TowerBsHt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmCMxt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmCMyt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmCMzt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TipMass)) deallocate(OutData%TipMass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TipMass(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TipMass) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%HubMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubIner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenIner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacYIner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawBrMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmRIner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmPIner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmYIner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldNodes) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%InpBlMesh)) deallocate(OutData%InpBlMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InpBlMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBlMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackBladeMeshInputData(Buf, OutData%InpBlMesh(i1)) ! InpBlMesh + end do + end if + if (allocated(OutData%InpBl)) deallocate(OutData%InpBl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InpBl(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackBladeInputData(Buf, OutData%InpBl(i1)) ! InpBl + end do + end if + call RegUnpack(Buf, OutData%TeetMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetDmpP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetCDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetSStP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetHStP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetSSSp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetHSSp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GBoxEff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GBRatio) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DTTorSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DTTorDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Furling) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrNodes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TabDelim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Tstart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DecFact) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NTwGages) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrGagNd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBlGages) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldGagNd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NTwInpSt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrFADmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrSSDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FAStTunr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SSStTunr) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%HtFract)) deallocate(OutData%HtFract) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HtFract(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HtFract.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HtFract) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TMassDen)) deallocate(OutData%TMassDen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TMassDen(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TMassDen) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwFAStif)) deallocate(OutData%TwFAStif) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwFAStif(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAStif.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwFAStif) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwSSStif)) deallocate(OutData%TwSSStif) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwSSStif(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSStif.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwSSStif) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwFAM1Sh)) deallocate(OutData%TwFAM1Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwFAM1Sh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM1Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwFAM1Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwFAM2Sh)) deallocate(OutData%TwFAM2Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwFAM2Sh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM2Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwFAM2Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwSSM1Sh)) deallocate(OutData%TwSSM1Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwSSM1Sh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM1Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwSSM1Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwSSM2Sh)) deallocate(OutData%TwSSM2Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwSSM2Sh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM2Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwSSM2Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%RFrlDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotFurl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TailFurl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Yaw2Shft) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ShftSkew) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlCM_n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BoomCM_n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinCM_n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlPnt_n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlPnt_n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BoomMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFinMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlIner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlIner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlUSSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlDSSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlUSSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlDSSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlUSDP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlDSDP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlUSDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlDSDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlUSSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlDSSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlUSSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlDSSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlUSDP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlDSDP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlUSDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlDSDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%method) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BldNd_OutList)) deallocate(OutData%BldNd_OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldNd_OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%BldNd_BlOutNd_Str) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldNd_BladesOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, ErrMsg) + type(ED_CoordSys), intent(in) :: SrcCoordSysData + type(ED_CoordSys), intent(inout) :: DstCoordSysData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyCoordSys' + ErrStat = ErrID_None + ErrMsg = '' + DstCoordSysData%a1 = SrcCoordSysData%a1 + DstCoordSysData%a2 = SrcCoordSysData%a2 + DstCoordSysData%a3 = SrcCoordSysData%a3 + DstCoordSysData%b1 = SrcCoordSysData%b1 + DstCoordSysData%b2 = SrcCoordSysData%b2 + DstCoordSysData%b3 = SrcCoordSysData%b3 + DstCoordSysData%c1 = SrcCoordSysData%c1 + DstCoordSysData%c2 = SrcCoordSysData%c2 + DstCoordSysData%c3 = SrcCoordSysData%c3 + DstCoordSysData%d1 = SrcCoordSysData%d1 + DstCoordSysData%d2 = SrcCoordSysData%d2 + DstCoordSysData%d3 = SrcCoordSysData%d3 + DstCoordSysData%e1 = SrcCoordSysData%e1 + DstCoordSysData%e2 = SrcCoordSysData%e2 + DstCoordSysData%e3 = SrcCoordSysData%e3 + DstCoordSysData%f1 = SrcCoordSysData%f1 + DstCoordSysData%f2 = SrcCoordSysData%f2 + DstCoordSysData%f3 = SrcCoordSysData%f3 + DstCoordSysData%g1 = SrcCoordSysData%g1 + DstCoordSysData%g2 = SrcCoordSysData%g2 + DstCoordSysData%g3 = SrcCoordSysData%g3 + if (allocated(SrcCoordSysData%i1)) then + LB(1:2) = lbound(SrcCoordSysData%i1) + UB(1:2) = ubound(SrcCoordSysData%i1) + if (.not. allocated(DstCoordSysData%i1)) then + allocate(DstCoordSysData%i1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%i1 = SrcCoordSysData%i1 + end if + if (allocated(SrcCoordSysData%i2)) then + LB(1:2) = lbound(SrcCoordSysData%i2) + UB(1:2) = ubound(SrcCoordSysData%i2) + if (.not. allocated(DstCoordSysData%i2)) then + allocate(DstCoordSysData%i2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%i2 = SrcCoordSysData%i2 + end if + if (allocated(SrcCoordSysData%i3)) then + LB(1:2) = lbound(SrcCoordSysData%i3) + UB(1:2) = ubound(SrcCoordSysData%i3) + if (.not. allocated(DstCoordSysData%i3)) then + allocate(DstCoordSysData%i3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%i3 = SrcCoordSysData%i3 + end if + if (allocated(SrcCoordSysData%j1)) then + LB(1:2) = lbound(SrcCoordSysData%j1) + UB(1:2) = ubound(SrcCoordSysData%j1) + if (.not. allocated(DstCoordSysData%j1)) then + allocate(DstCoordSysData%j1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%j1 = SrcCoordSysData%j1 + end if + if (allocated(SrcCoordSysData%j2)) then + LB(1:2) = lbound(SrcCoordSysData%j2) + UB(1:2) = ubound(SrcCoordSysData%j2) + if (.not. allocated(DstCoordSysData%j2)) then + allocate(DstCoordSysData%j2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%j2 = SrcCoordSysData%j2 + end if + if (allocated(SrcCoordSysData%j3)) then + LB(1:2) = lbound(SrcCoordSysData%j3) + UB(1:2) = ubound(SrcCoordSysData%j3) + if (.not. allocated(DstCoordSysData%j3)) then + allocate(DstCoordSysData%j3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%j3 = SrcCoordSysData%j3 + end if + if (allocated(SrcCoordSysData%m1)) then + LB(1:3) = lbound(SrcCoordSysData%m1) + UB(1:3) = ubound(SrcCoordSysData%m1) + if (.not. allocated(DstCoordSysData%m1)) then + allocate(DstCoordSysData%m1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%m1 = SrcCoordSysData%m1 + end if + if (allocated(SrcCoordSysData%m2)) then + LB(1:3) = lbound(SrcCoordSysData%m2) + UB(1:3) = ubound(SrcCoordSysData%m2) + if (.not. allocated(DstCoordSysData%m2)) then + allocate(DstCoordSysData%m2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%m2 = SrcCoordSysData%m2 + end if + if (allocated(SrcCoordSysData%m3)) then + LB(1:3) = lbound(SrcCoordSysData%m3) + UB(1:3) = ubound(SrcCoordSysData%m3) + if (.not. allocated(DstCoordSysData%m3)) then + allocate(DstCoordSysData%m3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%m3 = SrcCoordSysData%m3 + end if + if (allocated(SrcCoordSysData%n1)) then + LB(1:3) = lbound(SrcCoordSysData%n1) + UB(1:3) = ubound(SrcCoordSysData%n1) + if (.not. allocated(DstCoordSysData%n1)) then + allocate(DstCoordSysData%n1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%n1 = SrcCoordSysData%n1 + end if + if (allocated(SrcCoordSysData%n2)) then + LB(1:3) = lbound(SrcCoordSysData%n2) + UB(1:3) = ubound(SrcCoordSysData%n2) + if (.not. allocated(DstCoordSysData%n2)) then + allocate(DstCoordSysData%n2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%n2 = SrcCoordSysData%n2 + end if + if (allocated(SrcCoordSysData%n3)) then + LB(1:3) = lbound(SrcCoordSysData%n3) + UB(1:3) = ubound(SrcCoordSysData%n3) + if (.not. allocated(DstCoordSysData%n3)) then + allocate(DstCoordSysData%n3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%n3 = SrcCoordSysData%n3 + end if + DstCoordSysData%rf1 = SrcCoordSysData%rf1 + DstCoordSysData%rf2 = SrcCoordSysData%rf2 + DstCoordSysData%rf3 = SrcCoordSysData%rf3 + DstCoordSysData%rfa = SrcCoordSysData%rfa + if (allocated(SrcCoordSysData%t1)) then + LB(1:2) = lbound(SrcCoordSysData%t1) + UB(1:2) = ubound(SrcCoordSysData%t1) + if (.not. allocated(DstCoordSysData%t1)) then + allocate(DstCoordSysData%t1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%t1 = SrcCoordSysData%t1 + end if + if (allocated(SrcCoordSysData%t2)) then + LB(1:2) = lbound(SrcCoordSysData%t2) + UB(1:2) = ubound(SrcCoordSysData%t2) + if (.not. allocated(DstCoordSysData%t2)) then + allocate(DstCoordSysData%t2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%t2 = SrcCoordSysData%t2 + end if + if (allocated(SrcCoordSysData%t3)) then + LB(1:2) = lbound(SrcCoordSysData%t3) + UB(1:2) = ubound(SrcCoordSysData%t3) + if (.not. allocated(DstCoordSysData%t3)) then + allocate(DstCoordSysData%t3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%t3 = SrcCoordSysData%t3 + end if + if (allocated(SrcCoordSysData%te1)) then + LB(1:3) = lbound(SrcCoordSysData%te1) + UB(1:3) = ubound(SrcCoordSysData%te1) + if (.not. allocated(DstCoordSysData%te1)) then + allocate(DstCoordSysData%te1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%te1 = SrcCoordSysData%te1 + end if + if (allocated(SrcCoordSysData%te2)) then + LB(1:3) = lbound(SrcCoordSysData%te2) + UB(1:3) = ubound(SrcCoordSysData%te2) + if (.not. allocated(DstCoordSysData%te2)) then + allocate(DstCoordSysData%te2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%te2 = SrcCoordSysData%te2 + end if + if (allocated(SrcCoordSysData%te3)) then + LB(1:3) = lbound(SrcCoordSysData%te3) + UB(1:3) = ubound(SrcCoordSysData%te3) + if (.not. allocated(DstCoordSysData%te3)) then + allocate(DstCoordSysData%te3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%te3 = SrcCoordSysData%te3 + end if + DstCoordSysData%tf1 = SrcCoordSysData%tf1 + DstCoordSysData%tf2 = SrcCoordSysData%tf2 + DstCoordSysData%tf3 = SrcCoordSysData%tf3 + DstCoordSysData%tfa = SrcCoordSysData%tfa + DstCoordSysData%z1 = SrcCoordSysData%z1 + DstCoordSysData%z2 = SrcCoordSysData%z2 + DstCoordSysData%z3 = SrcCoordSysData%z3 +end subroutine + +subroutine ED_DestroyCoordSys(CoordSysData, ErrStat, ErrMsg) + type(ED_CoordSys), intent(inout) :: CoordSysData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyCoordSys' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(CoordSysData%i1)) then + deallocate(CoordSysData%i1) + end if + if (allocated(CoordSysData%i2)) then + deallocate(CoordSysData%i2) + end if + if (allocated(CoordSysData%i3)) then + deallocate(CoordSysData%i3) + end if + if (allocated(CoordSysData%j1)) then + deallocate(CoordSysData%j1) + end if + if (allocated(CoordSysData%j2)) then + deallocate(CoordSysData%j2) + end if + if (allocated(CoordSysData%j3)) then + deallocate(CoordSysData%j3) + end if + if (allocated(CoordSysData%m1)) then + deallocate(CoordSysData%m1) + end if + if (allocated(CoordSysData%m2)) then + deallocate(CoordSysData%m2) + end if + if (allocated(CoordSysData%m3)) then + deallocate(CoordSysData%m3) + end if + if (allocated(CoordSysData%n1)) then + deallocate(CoordSysData%n1) + end if + if (allocated(CoordSysData%n2)) then + deallocate(CoordSysData%n2) + end if + if (allocated(CoordSysData%n3)) then + deallocate(CoordSysData%n3) + end if + if (allocated(CoordSysData%t1)) then + deallocate(CoordSysData%t1) + end if + if (allocated(CoordSysData%t2)) then + deallocate(CoordSysData%t2) + end if + if (allocated(CoordSysData%t3)) then + deallocate(CoordSysData%t3) + end if + if (allocated(CoordSysData%te1)) then + deallocate(CoordSysData%te1) + end if + if (allocated(CoordSysData%te2)) then + deallocate(CoordSysData%te2) + end if + if (allocated(CoordSysData%te3)) then + deallocate(CoordSysData%te3) + end if +end subroutine + +subroutine ED_PackCoordSys(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_CoordSys), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackCoordSys' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%a1) + call RegPack(Buf, InData%a2) + call RegPack(Buf, InData%a3) + call RegPack(Buf, InData%b1) + call RegPack(Buf, InData%b2) + call RegPack(Buf, InData%b3) + call RegPack(Buf, InData%c1) + call RegPack(Buf, InData%c2) + call RegPack(Buf, InData%c3) + call RegPack(Buf, InData%d1) + call RegPack(Buf, InData%d2) + call RegPack(Buf, InData%d3) + call RegPack(Buf, InData%e1) + call RegPack(Buf, InData%e2) + call RegPack(Buf, InData%e3) + call RegPack(Buf, InData%f1) + call RegPack(Buf, InData%f2) + call RegPack(Buf, InData%f3) + call RegPack(Buf, InData%g1) + call RegPack(Buf, InData%g2) + call RegPack(Buf, InData%g3) + call RegPack(Buf, allocated(InData%i1)) + if (allocated(InData%i1)) then + call RegPackBounds(Buf, 2, lbound(InData%i1), ubound(InData%i1)) + call RegPack(Buf, InData%i1) + end if + call RegPack(Buf, allocated(InData%i2)) + if (allocated(InData%i2)) then + call RegPackBounds(Buf, 2, lbound(InData%i2), ubound(InData%i2)) + call RegPack(Buf, InData%i2) + end if + call RegPack(Buf, allocated(InData%i3)) + if (allocated(InData%i3)) then + call RegPackBounds(Buf, 2, lbound(InData%i3), ubound(InData%i3)) + call RegPack(Buf, InData%i3) + end if + call RegPack(Buf, allocated(InData%j1)) + if (allocated(InData%j1)) then + call RegPackBounds(Buf, 2, lbound(InData%j1), ubound(InData%j1)) + call RegPack(Buf, InData%j1) + end if + call RegPack(Buf, allocated(InData%j2)) + if (allocated(InData%j2)) then + call RegPackBounds(Buf, 2, lbound(InData%j2), ubound(InData%j2)) + call RegPack(Buf, InData%j2) + end if + call RegPack(Buf, allocated(InData%j3)) + if (allocated(InData%j3)) then + call RegPackBounds(Buf, 2, lbound(InData%j3), ubound(InData%j3)) + call RegPack(Buf, InData%j3) + end if + call RegPack(Buf, allocated(InData%m1)) + if (allocated(InData%m1)) then + call RegPackBounds(Buf, 3, lbound(InData%m1), ubound(InData%m1)) + call RegPack(Buf, InData%m1) + end if + call RegPack(Buf, allocated(InData%m2)) + if (allocated(InData%m2)) then + call RegPackBounds(Buf, 3, lbound(InData%m2), ubound(InData%m2)) + call RegPack(Buf, InData%m2) + end if + call RegPack(Buf, allocated(InData%m3)) + if (allocated(InData%m3)) then + call RegPackBounds(Buf, 3, lbound(InData%m3), ubound(InData%m3)) + call RegPack(Buf, InData%m3) + end if + call RegPack(Buf, allocated(InData%n1)) + if (allocated(InData%n1)) then + call RegPackBounds(Buf, 3, lbound(InData%n1), ubound(InData%n1)) + call RegPack(Buf, InData%n1) + end if + call RegPack(Buf, allocated(InData%n2)) + if (allocated(InData%n2)) then + call RegPackBounds(Buf, 3, lbound(InData%n2), ubound(InData%n2)) + call RegPack(Buf, InData%n2) + end if + call RegPack(Buf, allocated(InData%n3)) + if (allocated(InData%n3)) then + call RegPackBounds(Buf, 3, lbound(InData%n3), ubound(InData%n3)) + call RegPack(Buf, InData%n3) + end if + call RegPack(Buf, InData%rf1) + call RegPack(Buf, InData%rf2) + call RegPack(Buf, InData%rf3) + call RegPack(Buf, InData%rfa) + call RegPack(Buf, allocated(InData%t1)) + if (allocated(InData%t1)) then + call RegPackBounds(Buf, 2, lbound(InData%t1), ubound(InData%t1)) + call RegPack(Buf, InData%t1) + end if + call RegPack(Buf, allocated(InData%t2)) + if (allocated(InData%t2)) then + call RegPackBounds(Buf, 2, lbound(InData%t2), ubound(InData%t2)) + call RegPack(Buf, InData%t2) + end if + call RegPack(Buf, allocated(InData%t3)) + if (allocated(InData%t3)) then + call RegPackBounds(Buf, 2, lbound(InData%t3), ubound(InData%t3)) + call RegPack(Buf, InData%t3) + end if + call RegPack(Buf, allocated(InData%te1)) + if (allocated(InData%te1)) then + call RegPackBounds(Buf, 3, lbound(InData%te1), ubound(InData%te1)) + call RegPack(Buf, InData%te1) + end if + call RegPack(Buf, allocated(InData%te2)) + if (allocated(InData%te2)) then + call RegPackBounds(Buf, 3, lbound(InData%te2), ubound(InData%te2)) + call RegPack(Buf, InData%te2) + end if + call RegPack(Buf, allocated(InData%te3)) + if (allocated(InData%te3)) then + call RegPackBounds(Buf, 3, lbound(InData%te3), ubound(InData%te3)) + call RegPack(Buf, InData%te3) + end if + call RegPack(Buf, InData%tf1) + call RegPack(Buf, InData%tf2) + call RegPack(Buf, InData%tf3) + call RegPack(Buf, InData%tfa) + call RegPack(Buf, InData%z1) + call RegPack(Buf, InData%z2) + call RegPack(Buf, InData%z3) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackCoordSys(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_CoordSys), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackCoordSys' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%a1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%a2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%a3) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%b1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%b2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%b3) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%c1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%c2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%c3) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%d1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%d2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%d3) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%e1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%e2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%e3) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%f1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%f2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%f3) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%g1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%g2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%g3) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%i1)) deallocate(OutData%i1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%i1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%i1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%i1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%i2)) deallocate(OutData%i2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%i2(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%i2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%i2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%i3)) deallocate(OutData%i3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%i3(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%i3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%i3) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%j1)) deallocate(OutData%j1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%j1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%j1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%j1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%j2)) deallocate(OutData%j2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%j2(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%j2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%j2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%j3)) deallocate(OutData%j3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%j3(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%j3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%j3) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%m1)) deallocate(OutData%m1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%m1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%m2)) deallocate(OutData%m2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%m2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%m3)) deallocate(OutData%m3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%m3) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%n1)) deallocate(OutData%n1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%n1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%n1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%n1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%n2)) deallocate(OutData%n2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%n2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%n2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%n2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%n3)) deallocate(OutData%n3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%n3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%n3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%n3) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%rf1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rf2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rf3) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rfa) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%t1)) deallocate(OutData%t1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%t1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%t1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%t1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%t2)) deallocate(OutData%t2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%t2(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%t2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%t2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%t3)) deallocate(OutData%t3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%t3(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%t3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%t3) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%te1)) deallocate(OutData%te1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%te1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%te1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%te1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%te2)) deallocate(OutData%te2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%te2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%te2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%te2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%te3)) deallocate(OutData%te3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%te3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%te3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%te3) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%tf1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tf2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tf3) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tfa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%z1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%z2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%z3) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, ErrStat, ErrMsg) + type(ED_ActiveDOFs), intent(in) :: SrcActiveDOFsData + type(ED_ActiveDOFs), intent(inout) :: DstActiveDOFsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyActiveDOFs' + ErrStat = ErrID_None + ErrMsg = '' + DstActiveDOFsData%NActvDOF = SrcActiveDOFsData%NActvDOF + DstActiveDOFsData%NPCE = SrcActiveDOFsData%NPCE + DstActiveDOFsData%NPDE = SrcActiveDOFsData%NPDE + DstActiveDOFsData%NPIE = SrcActiveDOFsData%NPIE + DstActiveDOFsData%NPTE = SrcActiveDOFsData%NPTE + DstActiveDOFsData%NPTTE = SrcActiveDOFsData%NPTTE + if (allocated(SrcActiveDOFsData%NPSBE)) then + LB(1:1) = lbound(SrcActiveDOFsData%NPSBE) + UB(1:1) = ubound(SrcActiveDOFsData%NPSBE) + if (.not. allocated(DstActiveDOFsData%NPSBE)) then + allocate(DstActiveDOFsData%NPSBE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%NPSBE = SrcActiveDOFsData%NPSBE + end if + if (allocated(SrcActiveDOFsData%NPSE)) then + LB(1:1) = lbound(SrcActiveDOFsData%NPSE) + UB(1:1) = ubound(SrcActiveDOFsData%NPSE) + if (.not. allocated(DstActiveDOFsData%NPSE)) then + allocate(DstActiveDOFsData%NPSE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%NPSE = SrcActiveDOFsData%NPSE + end if + DstActiveDOFsData%NPUE = SrcActiveDOFsData%NPUE + DstActiveDOFsData%NPYE = SrcActiveDOFsData%NPYE + if (allocated(SrcActiveDOFsData%PCE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PCE) + UB(1:1) = ubound(SrcActiveDOFsData%PCE) + if (.not. allocated(DstActiveDOFsData%PCE)) then + allocate(DstActiveDOFsData%PCE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PCE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PCE = SrcActiveDOFsData%PCE + end if + if (allocated(SrcActiveDOFsData%PDE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PDE) + UB(1:1) = ubound(SrcActiveDOFsData%PDE) + if (.not. allocated(DstActiveDOFsData%PDE)) then + allocate(DstActiveDOFsData%PDE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PDE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PDE = SrcActiveDOFsData%PDE + end if + if (allocated(SrcActiveDOFsData%PIE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PIE) + UB(1:1) = ubound(SrcActiveDOFsData%PIE) + if (.not. allocated(DstActiveDOFsData%PIE)) then + allocate(DstActiveDOFsData%PIE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PIE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PIE = SrcActiveDOFsData%PIE + end if + if (allocated(SrcActiveDOFsData%PTE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PTE) + UB(1:1) = ubound(SrcActiveDOFsData%PTE) + if (.not. allocated(DstActiveDOFsData%PTE)) then + allocate(DstActiveDOFsData%PTE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PTE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PTE = SrcActiveDOFsData%PTE + end if + if (allocated(SrcActiveDOFsData%PTTE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PTTE) + UB(1:1) = ubound(SrcActiveDOFsData%PTTE) + if (.not. allocated(DstActiveDOFsData%PTTE)) then + allocate(DstActiveDOFsData%PTTE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PTTE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PTTE = SrcActiveDOFsData%PTTE + end if + if (allocated(SrcActiveDOFsData%PS)) then + LB(1:1) = lbound(SrcActiveDOFsData%PS) + UB(1:1) = ubound(SrcActiveDOFsData%PS) + if (.not. allocated(DstActiveDOFsData%PS)) then + allocate(DstActiveDOFsData%PS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PS = SrcActiveDOFsData%PS + end if + if (allocated(SrcActiveDOFsData%PSBE)) then + LB(1:2) = lbound(SrcActiveDOFsData%PSBE) + UB(1:2) = ubound(SrcActiveDOFsData%PSBE) + if (.not. allocated(DstActiveDOFsData%PSBE)) then + allocate(DstActiveDOFsData%PSBE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PSBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PSBE = SrcActiveDOFsData%PSBE + end if + if (allocated(SrcActiveDOFsData%PSE)) then + LB(1:2) = lbound(SrcActiveDOFsData%PSE) + UB(1:2) = ubound(SrcActiveDOFsData%PSE) + if (.not. allocated(DstActiveDOFsData%PSE)) then + allocate(DstActiveDOFsData%PSE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PSE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PSE = SrcActiveDOFsData%PSE + end if + if (allocated(SrcActiveDOFsData%PUE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PUE) + UB(1:1) = ubound(SrcActiveDOFsData%PUE) + if (.not. allocated(DstActiveDOFsData%PUE)) then + allocate(DstActiveDOFsData%PUE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PUE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PUE = SrcActiveDOFsData%PUE + end if + if (allocated(SrcActiveDOFsData%PYE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PYE) + UB(1:1) = ubound(SrcActiveDOFsData%PYE) + if (.not. allocated(DstActiveDOFsData%PYE)) then + allocate(DstActiveDOFsData%PYE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PYE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PYE = SrcActiveDOFsData%PYE + end if + if (allocated(SrcActiveDOFsData%SrtPS)) then + LB(1:1) = lbound(SrcActiveDOFsData%SrtPS) + UB(1:1) = ubound(SrcActiveDOFsData%SrtPS) + if (.not. allocated(DstActiveDOFsData%SrtPS)) then + allocate(DstActiveDOFsData%SrtPS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%SrtPS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%SrtPS = SrcActiveDOFsData%SrtPS + end if + if (allocated(SrcActiveDOFsData%SrtPSNAUG)) then + LB(1:1) = lbound(SrcActiveDOFsData%SrtPSNAUG) + UB(1:1) = ubound(SrcActiveDOFsData%SrtPSNAUG) + if (.not. allocated(DstActiveDOFsData%SrtPSNAUG)) then + allocate(DstActiveDOFsData%SrtPSNAUG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%SrtPSNAUG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%SrtPSNAUG = SrcActiveDOFsData%SrtPSNAUG + end if + if (allocated(SrcActiveDOFsData%Diag)) then + LB(1:1) = lbound(SrcActiveDOFsData%Diag) + UB(1:1) = ubound(SrcActiveDOFsData%Diag) + if (.not. allocated(DstActiveDOFsData%Diag)) then + allocate(DstActiveDOFsData%Diag(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%Diag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%Diag = SrcActiveDOFsData%Diag + end if +end subroutine + +subroutine ED_DestroyActiveDOFs(ActiveDOFsData, ErrStat, ErrMsg) + type(ED_ActiveDOFs), intent(inout) :: ActiveDOFsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyActiveDOFs' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ActiveDOFsData%NPSBE)) then + deallocate(ActiveDOFsData%NPSBE) + end if + if (allocated(ActiveDOFsData%NPSE)) then + deallocate(ActiveDOFsData%NPSE) + end if + if (allocated(ActiveDOFsData%PCE)) then + deallocate(ActiveDOFsData%PCE) + end if + if (allocated(ActiveDOFsData%PDE)) then + deallocate(ActiveDOFsData%PDE) + end if + if (allocated(ActiveDOFsData%PIE)) then + deallocate(ActiveDOFsData%PIE) + end if + if (allocated(ActiveDOFsData%PTE)) then + deallocate(ActiveDOFsData%PTE) + end if + if (allocated(ActiveDOFsData%PTTE)) then + deallocate(ActiveDOFsData%PTTE) + end if + if (allocated(ActiveDOFsData%PS)) then + deallocate(ActiveDOFsData%PS) + end if + if (allocated(ActiveDOFsData%PSBE)) then + deallocate(ActiveDOFsData%PSBE) + end if + if (allocated(ActiveDOFsData%PSE)) then + deallocate(ActiveDOFsData%PSE) + end if + if (allocated(ActiveDOFsData%PUE)) then + deallocate(ActiveDOFsData%PUE) + end if + if (allocated(ActiveDOFsData%PYE)) then + deallocate(ActiveDOFsData%PYE) + end if + if (allocated(ActiveDOFsData%SrtPS)) then + deallocate(ActiveDOFsData%SrtPS) + end if + if (allocated(ActiveDOFsData%SrtPSNAUG)) then + deallocate(ActiveDOFsData%SrtPSNAUG) + end if + if (allocated(ActiveDOFsData%Diag)) then + deallocate(ActiveDOFsData%Diag) + end if +end subroutine + +subroutine ED_PackActiveDOFs(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_ActiveDOFs), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackActiveDOFs' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%NActvDOF) + call RegPack(Buf, InData%NPCE) + call RegPack(Buf, InData%NPDE) + call RegPack(Buf, InData%NPIE) + call RegPack(Buf, InData%NPTE) + call RegPack(Buf, InData%NPTTE) + call RegPack(Buf, allocated(InData%NPSBE)) + if (allocated(InData%NPSBE)) then + call RegPackBounds(Buf, 1, lbound(InData%NPSBE), ubound(InData%NPSBE)) + call RegPack(Buf, InData%NPSBE) + end if + call RegPack(Buf, allocated(InData%NPSE)) + if (allocated(InData%NPSE)) then + call RegPackBounds(Buf, 1, lbound(InData%NPSE), ubound(InData%NPSE)) + call RegPack(Buf, InData%NPSE) + end if + call RegPack(Buf, InData%NPUE) + call RegPack(Buf, InData%NPYE) + call RegPack(Buf, allocated(InData%PCE)) + if (allocated(InData%PCE)) then + call RegPackBounds(Buf, 1, lbound(InData%PCE), ubound(InData%PCE)) + call RegPack(Buf, InData%PCE) + end if + call RegPack(Buf, allocated(InData%PDE)) + if (allocated(InData%PDE)) then + call RegPackBounds(Buf, 1, lbound(InData%PDE), ubound(InData%PDE)) + call RegPack(Buf, InData%PDE) + end if + call RegPack(Buf, allocated(InData%PIE)) + if (allocated(InData%PIE)) then + call RegPackBounds(Buf, 1, lbound(InData%PIE), ubound(InData%PIE)) + call RegPack(Buf, InData%PIE) + end if + call RegPack(Buf, allocated(InData%PTE)) + if (allocated(InData%PTE)) then + call RegPackBounds(Buf, 1, lbound(InData%PTE), ubound(InData%PTE)) + call RegPack(Buf, InData%PTE) + end if + call RegPack(Buf, allocated(InData%PTTE)) + if (allocated(InData%PTTE)) then + call RegPackBounds(Buf, 1, lbound(InData%PTTE), ubound(InData%PTTE)) + call RegPack(Buf, InData%PTTE) + end if + call RegPack(Buf, allocated(InData%PS)) + if (allocated(InData%PS)) then + call RegPackBounds(Buf, 1, lbound(InData%PS), ubound(InData%PS)) + call RegPack(Buf, InData%PS) + end if + call RegPack(Buf, allocated(InData%PSBE)) + if (allocated(InData%PSBE)) then + call RegPackBounds(Buf, 2, lbound(InData%PSBE), ubound(InData%PSBE)) + call RegPack(Buf, InData%PSBE) + end if + call RegPack(Buf, allocated(InData%PSE)) + if (allocated(InData%PSE)) then + call RegPackBounds(Buf, 2, lbound(InData%PSE), ubound(InData%PSE)) + call RegPack(Buf, InData%PSE) + end if + call RegPack(Buf, allocated(InData%PUE)) + if (allocated(InData%PUE)) then + call RegPackBounds(Buf, 1, lbound(InData%PUE), ubound(InData%PUE)) + call RegPack(Buf, InData%PUE) + end if + call RegPack(Buf, allocated(InData%PYE)) + if (allocated(InData%PYE)) then + call RegPackBounds(Buf, 1, lbound(InData%PYE), ubound(InData%PYE)) + call RegPack(Buf, InData%PYE) + end if + call RegPack(Buf, allocated(InData%SrtPS)) + if (allocated(InData%SrtPS)) then + call RegPackBounds(Buf, 1, lbound(InData%SrtPS), ubound(InData%SrtPS)) + call RegPack(Buf, InData%SrtPS) + end if + call RegPack(Buf, allocated(InData%SrtPSNAUG)) + if (allocated(InData%SrtPSNAUG)) then + call RegPackBounds(Buf, 1, lbound(InData%SrtPSNAUG), ubound(InData%SrtPSNAUG)) + call RegPack(Buf, InData%SrtPSNAUG) + end if + call RegPack(Buf, allocated(InData%Diag)) + if (allocated(InData%Diag)) then + call RegPackBounds(Buf, 1, lbound(InData%Diag), ubound(InData%Diag)) + call RegPack(Buf, InData%Diag) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackActiveDOFs(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_ActiveDOFs), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackActiveDOFs' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NActvDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NPCE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NPDE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NPIE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NPTE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NPTTE) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%NPSBE)) deallocate(OutData%NPSBE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NPSBE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NPSBE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%NPSE)) deallocate(OutData%NPSE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NPSE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NPSE) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NPUE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NPYE) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PCE)) deallocate(OutData%PCE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PCE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PCE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PCE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PDE)) deallocate(OutData%PDE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PDE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PDE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PIE)) deallocate(OutData%PIE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PIE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PIE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PIE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PTE)) deallocate(OutData%PTE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PTE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PTE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PTTE)) deallocate(OutData%PTTE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PTTE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTTE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PTTE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PS)) deallocate(OutData%PS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PSBE)) deallocate(OutData%PSBE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PSBE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PSBE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PSE)) deallocate(OutData%PSE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PSE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PSE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PUE)) deallocate(OutData%PUE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PUE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PUE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PUE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PYE)) deallocate(OutData%PYE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PYE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PYE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PYE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SrtPS)) deallocate(OutData%SrtPS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SrtPS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SrtPS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SrtPSNAUG)) deallocate(OutData%SrtPSNAUG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SrtPSNAUG(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPSNAUG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SrtPSNAUG) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Diag)) deallocate(OutData%Diag) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Diag(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Diag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Diag) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrStat, ErrMsg) + type(ED_RtHndSide), intent(in) :: SrcRtHndSideData + type(ED_RtHndSide), intent(inout) :: DstRtHndSideData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyRtHndSide' + ErrStat = ErrID_None + ErrMsg = '' + DstRtHndSideData%rO = SrcRtHndSideData%rO + if (allocated(SrcRtHndSideData%rQS)) then + LB(1:3) = lbound(SrcRtHndSideData%rQS) + UB(1:3) = ubound(SrcRtHndSideData%rQS) + if (.not. allocated(DstRtHndSideData%rQS)) then + allocate(DstRtHndSideData%rQS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rQS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rQS = SrcRtHndSideData%rQS + end if + if (allocated(SrcRtHndSideData%rS)) then + LB(1:3) = lbound(SrcRtHndSideData%rS) + UB(1:3) = ubound(SrcRtHndSideData%rS) + if (.not. allocated(DstRtHndSideData%rS)) then + allocate(DstRtHndSideData%rS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rS = SrcRtHndSideData%rS + end if + if (allocated(SrcRtHndSideData%rS0S)) then + LB(1:3) = lbound(SrcRtHndSideData%rS0S) + UB(1:3) = ubound(SrcRtHndSideData%rS0S) + if (.not. allocated(DstRtHndSideData%rS0S)) then + allocate(DstRtHndSideData%rS0S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rS0S.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rS0S = SrcRtHndSideData%rS0S + end if + if (allocated(SrcRtHndSideData%rT)) then + LB(1:2) = lbound(SrcRtHndSideData%rT) + UB(1:2) = ubound(SrcRtHndSideData%rT) + if (.not. allocated(DstRtHndSideData%rT)) then + allocate(DstRtHndSideData%rT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rT = SrcRtHndSideData%rT + end if + DstRtHndSideData%rT0O = SrcRtHndSideData%rT0O + if (allocated(SrcRtHndSideData%rT0T)) then + LB(1:2) = lbound(SrcRtHndSideData%rT0T) + UB(1:2) = ubound(SrcRtHndSideData%rT0T) + if (.not. allocated(DstRtHndSideData%rT0T)) then + allocate(DstRtHndSideData%rT0T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rT0T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rT0T = SrcRtHndSideData%rT0T + end if + DstRtHndSideData%rZ = SrcRtHndSideData%rZ + DstRtHndSideData%rZO = SrcRtHndSideData%rZO + if (allocated(SrcRtHndSideData%rZT)) then + LB(1:2) = lbound(SrcRtHndSideData%rZT) + UB(1:2) = ubound(SrcRtHndSideData%rZT) + if (.not. allocated(DstRtHndSideData%rZT)) then + allocate(DstRtHndSideData%rZT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rZT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rZT = SrcRtHndSideData%rZT + end if + DstRtHndSideData%rPQ = SrcRtHndSideData%rPQ + DstRtHndSideData%rP = SrcRtHndSideData%rP + DstRtHndSideData%rV = SrcRtHndSideData%rV + DstRtHndSideData%rJ = SrcRtHndSideData%rJ + DstRtHndSideData%rZY = SrcRtHndSideData%rZY + DstRtHndSideData%rOU = SrcRtHndSideData%rOU + DstRtHndSideData%rOV = SrcRtHndSideData%rOV + DstRtHndSideData%rVD = SrcRtHndSideData%rVD + DstRtHndSideData%rOW = SrcRtHndSideData%rOW + DstRtHndSideData%rPC = SrcRtHndSideData%rPC + if (allocated(SrcRtHndSideData%rPS0)) then + LB(1:2) = lbound(SrcRtHndSideData%rPS0) + UB(1:2) = ubound(SrcRtHndSideData%rPS0) + if (.not. allocated(DstRtHndSideData%rPS0)) then + allocate(DstRtHndSideData%rPS0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rPS0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rPS0 = SrcRtHndSideData%rPS0 + end if + DstRtHndSideData%rQ = SrcRtHndSideData%rQ + DstRtHndSideData%rQC = SrcRtHndSideData%rQC + DstRtHndSideData%rVIMU = SrcRtHndSideData%rVIMU + DstRtHndSideData%rVP = SrcRtHndSideData%rVP + DstRtHndSideData%rWI = SrcRtHndSideData%rWI + DstRtHndSideData%rWJ = SrcRtHndSideData%rWJ + DstRtHndSideData%rZT0 = SrcRtHndSideData%rZT0 + if (allocated(SrcRtHndSideData%AngPosEF)) then + LB(1:2) = lbound(SrcRtHndSideData%AngPosEF) + UB(1:2) = ubound(SrcRtHndSideData%AngPosEF) + if (.not. allocated(DstRtHndSideData%AngPosEF)) then + allocate(DstRtHndSideData%AngPosEF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosEF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngPosEF = SrcRtHndSideData%AngPosEF + end if + if (allocated(SrcRtHndSideData%AngPosXF)) then + LB(1:2) = lbound(SrcRtHndSideData%AngPosXF) + UB(1:2) = ubound(SrcRtHndSideData%AngPosXF) + if (.not. allocated(DstRtHndSideData%AngPosXF)) then + allocate(DstRtHndSideData%AngPosXF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosXF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngPosXF = SrcRtHndSideData%AngPosXF + end if + if (allocated(SrcRtHndSideData%AngPosHM)) then + LB(1:3) = lbound(SrcRtHndSideData%AngPosHM) + UB(1:3) = ubound(SrcRtHndSideData%AngPosHM) + if (.not. allocated(DstRtHndSideData%AngPosHM)) then + allocate(DstRtHndSideData%AngPosHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosHM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngPosHM = SrcRtHndSideData%AngPosHM + end if + DstRtHndSideData%AngPosXB = SrcRtHndSideData%AngPosXB + DstRtHndSideData%AngPosEX = SrcRtHndSideData%AngPosEX + if (allocated(SrcRtHndSideData%PAngVelEA)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEA) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEA) + if (.not. allocated(DstRtHndSideData%PAngVelEA)) then + allocate(DstRtHndSideData%PAngVelEA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEA = SrcRtHndSideData%PAngVelEA + end if + if (allocated(SrcRtHndSideData%PAngVelEF)) then + LB(1:4) = lbound(SrcRtHndSideData%PAngVelEF) + UB(1:4) = ubound(SrcRtHndSideData%PAngVelEF) + if (.not. allocated(DstRtHndSideData%PAngVelEF)) then + allocate(DstRtHndSideData%PAngVelEF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEF = SrcRtHndSideData%PAngVelEF + end if + if (allocated(SrcRtHndSideData%PAngVelEG)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEG) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEG) + if (.not. allocated(DstRtHndSideData%PAngVelEG)) then + allocate(DstRtHndSideData%PAngVelEG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEG = SrcRtHndSideData%PAngVelEG + end if + if (allocated(SrcRtHndSideData%PAngVelEH)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEH) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEH) + if (.not. allocated(DstRtHndSideData%PAngVelEH)) then + allocate(DstRtHndSideData%PAngVelEH(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEH = SrcRtHndSideData%PAngVelEH + end if + if (allocated(SrcRtHndSideData%PAngVelEL)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEL) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEL) + if (.not. allocated(DstRtHndSideData%PAngVelEL)) then + allocate(DstRtHndSideData%PAngVelEL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEL = SrcRtHndSideData%PAngVelEL + end if + if (allocated(SrcRtHndSideData%PAngVelEM)) then + LB(1:5) = lbound(SrcRtHndSideData%PAngVelEM) + UB(1:5) = ubound(SrcRtHndSideData%PAngVelEM) + if (.not. allocated(DstRtHndSideData%PAngVelEM)) then + allocate(DstRtHndSideData%PAngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEM = SrcRtHndSideData%PAngVelEM + end if + if (allocated(SrcRtHndSideData%AngVelEM)) then + LB(1:3) = lbound(SrcRtHndSideData%AngVelEM) + UB(1:3) = ubound(SrcRtHndSideData%AngVelEM) + if (.not. allocated(DstRtHndSideData%AngVelEM)) then + allocate(DstRtHndSideData%AngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelEM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngVelEM = SrcRtHndSideData%AngVelEM + end if + if (allocated(SrcRtHndSideData%PAngVelEN)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEN) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEN) + if (.not. allocated(DstRtHndSideData%PAngVelEN)) then + allocate(DstRtHndSideData%PAngVelEN(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEN = SrcRtHndSideData%PAngVelEN + end if + DstRtHndSideData%AngVelEA = SrcRtHndSideData%AngVelEA + if (allocated(SrcRtHndSideData%PAngVelEB)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEB) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEB) + if (.not. allocated(DstRtHndSideData%PAngVelEB)) then + allocate(DstRtHndSideData%PAngVelEB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEB = SrcRtHndSideData%PAngVelEB + end if + if (allocated(SrcRtHndSideData%PAngVelER)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelER) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelER) + if (.not. allocated(DstRtHndSideData%PAngVelER)) then + allocate(DstRtHndSideData%PAngVelER(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelER.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelER = SrcRtHndSideData%PAngVelER + end if + if (allocated(SrcRtHndSideData%PAngVelEX)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEX) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEX) + if (.not. allocated(DstRtHndSideData%PAngVelEX)) then + allocate(DstRtHndSideData%PAngVelEX(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEX = SrcRtHndSideData%PAngVelEX + end if + DstRtHndSideData%AngVelEG = SrcRtHndSideData%AngVelEG + DstRtHndSideData%AngVelEH = SrcRtHndSideData%AngVelEH + DstRtHndSideData%AngVelEL = SrcRtHndSideData%AngVelEL + DstRtHndSideData%AngVelEN = SrcRtHndSideData%AngVelEN + DstRtHndSideData%AngVelEB = SrcRtHndSideData%AngVelEB + DstRtHndSideData%AngVelER = SrcRtHndSideData%AngVelER + DstRtHndSideData%AngVelEX = SrcRtHndSideData%AngVelEX + DstRtHndSideData%TeetAngVel = SrcRtHndSideData%TeetAngVel + DstRtHndSideData%AngAccEBt = SrcRtHndSideData%AngAccEBt + DstRtHndSideData%AngAccERt = SrcRtHndSideData%AngAccERt + DstRtHndSideData%AngAccEXt = SrcRtHndSideData%AngAccEXt + if (allocated(SrcRtHndSideData%AngAccEFt)) then + LB(1:2) = lbound(SrcRtHndSideData%AngAccEFt) + UB(1:2) = ubound(SrcRtHndSideData%AngAccEFt) + if (.not. allocated(DstRtHndSideData%AngAccEFt)) then + allocate(DstRtHndSideData%AngAccEFt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngAccEFt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngAccEFt = SrcRtHndSideData%AngAccEFt + end if + if (allocated(SrcRtHndSideData%AngVelEF)) then + LB(1:2) = lbound(SrcRtHndSideData%AngVelEF) + UB(1:2) = ubound(SrcRtHndSideData%AngVelEF) + if (.not. allocated(DstRtHndSideData%AngVelEF)) then + allocate(DstRtHndSideData%AngVelEF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelEF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngVelEF = SrcRtHndSideData%AngVelEF + end if + if (allocated(SrcRtHndSideData%AngVelHM)) then + LB(1:3) = lbound(SrcRtHndSideData%AngVelHM) + UB(1:3) = ubound(SrcRtHndSideData%AngVelHM) + if (.not. allocated(DstRtHndSideData%AngVelHM)) then + allocate(DstRtHndSideData%AngVelHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelHM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngVelHM = SrcRtHndSideData%AngVelHM + end if + DstRtHndSideData%AngAccEAt = SrcRtHndSideData%AngAccEAt + DstRtHndSideData%AngAccEGt = SrcRtHndSideData%AngAccEGt + DstRtHndSideData%AngAccEHt = SrcRtHndSideData%AngAccEHt + if (allocated(SrcRtHndSideData%AngAccEKt)) then + LB(1:3) = lbound(SrcRtHndSideData%AngAccEKt) + UB(1:3) = ubound(SrcRtHndSideData%AngAccEKt) + if (.not. allocated(DstRtHndSideData%AngAccEKt)) then + allocate(DstRtHndSideData%AngAccEKt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngAccEKt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngAccEKt = SrcRtHndSideData%AngAccEKt + end if + DstRtHndSideData%AngAccENt = SrcRtHndSideData%AngAccENt + DstRtHndSideData%LinAccECt = SrcRtHndSideData%LinAccECt + DstRtHndSideData%LinAccEDt = SrcRtHndSideData%LinAccEDt + DstRtHndSideData%LinAccEIt = SrcRtHndSideData%LinAccEIt + DstRtHndSideData%LinAccEJt = SrcRtHndSideData%LinAccEJt + DstRtHndSideData%LinAccEUt = SrcRtHndSideData%LinAccEUt + DstRtHndSideData%LinAccEYt = SrcRtHndSideData%LinAccEYt + if (allocated(SrcRtHndSideData%LinVelES)) then + LB(1:3) = lbound(SrcRtHndSideData%LinVelES) + UB(1:3) = ubound(SrcRtHndSideData%LinVelES) + if (.not. allocated(DstRtHndSideData%LinVelES)) then + allocate(DstRtHndSideData%LinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelES.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%LinVelES = SrcRtHndSideData%LinVelES + end if + DstRtHndSideData%LinVelEQ = SrcRtHndSideData%LinVelEQ + if (allocated(SrcRtHndSideData%LinVelET)) then + LB(1:2) = lbound(SrcRtHndSideData%LinVelET) + UB(1:2) = ubound(SrcRtHndSideData%LinVelET) + if (.not. allocated(DstRtHndSideData%LinVelET)) then + allocate(DstRtHndSideData%LinVelET(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelET.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%LinVelET = SrcRtHndSideData%LinVelET + end if + if (allocated(SrcRtHndSideData%LinVelESm2)) then + LB(1:1) = lbound(SrcRtHndSideData%LinVelESm2) + UB(1:1) = ubound(SrcRtHndSideData%LinVelESm2) + if (.not. allocated(DstRtHndSideData%LinVelESm2)) then + allocate(DstRtHndSideData%LinVelESm2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelESm2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%LinVelESm2 = SrcRtHndSideData%LinVelESm2 + end if + if (allocated(SrcRtHndSideData%PLinVelEIMU)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEIMU) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEIMU) + if (.not. allocated(DstRtHndSideData%PLinVelEIMU)) then + allocate(DstRtHndSideData%PLinVelEIMU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEIMU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEIMU = SrcRtHndSideData%PLinVelEIMU + end if + if (allocated(SrcRtHndSideData%PLinVelEO)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEO) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEO) + if (.not. allocated(DstRtHndSideData%PLinVelEO)) then + allocate(DstRtHndSideData%PLinVelEO(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEO.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEO = SrcRtHndSideData%PLinVelEO + end if + if (allocated(SrcRtHndSideData%PLinVelES)) then + LB(1:5) = lbound(SrcRtHndSideData%PLinVelES) + UB(1:5) = ubound(SrcRtHndSideData%PLinVelES) + if (.not. allocated(DstRtHndSideData%PLinVelES)) then + allocate(DstRtHndSideData%PLinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelES.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelES = SrcRtHndSideData%PLinVelES + end if + if (allocated(SrcRtHndSideData%PLinVelET)) then + LB(1:4) = lbound(SrcRtHndSideData%PLinVelET) + UB(1:4) = ubound(SrcRtHndSideData%PLinVelET) + if (.not. allocated(DstRtHndSideData%PLinVelET)) then + allocate(DstRtHndSideData%PLinVelET(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelET.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelET = SrcRtHndSideData%PLinVelET + end if + if (allocated(SrcRtHndSideData%PLinVelEZ)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEZ) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEZ) + if (.not. allocated(DstRtHndSideData%PLinVelEZ)) then + allocate(DstRtHndSideData%PLinVelEZ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEZ = SrcRtHndSideData%PLinVelEZ + end if + if (allocated(SrcRtHndSideData%PLinVelEC)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEC) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEC) + if (.not. allocated(DstRtHndSideData%PLinVelEC)) then + allocate(DstRtHndSideData%PLinVelEC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEC = SrcRtHndSideData%PLinVelEC + end if + if (allocated(SrcRtHndSideData%PLinVelED)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelED) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelED) + if (.not. allocated(DstRtHndSideData%PLinVelED)) then + allocate(DstRtHndSideData%PLinVelED(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelED = SrcRtHndSideData%PLinVelED + end if + if (allocated(SrcRtHndSideData%PLinVelEI)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEI) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEI) + if (.not. allocated(DstRtHndSideData%PLinVelEI)) then + allocate(DstRtHndSideData%PLinVelEI(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEI = SrcRtHndSideData%PLinVelEI + end if + if (allocated(SrcRtHndSideData%PLinVelEJ)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEJ) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEJ) + if (.not. allocated(DstRtHndSideData%PLinVelEJ)) then + allocate(DstRtHndSideData%PLinVelEJ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEJ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEJ = SrcRtHndSideData%PLinVelEJ + end if + if (allocated(SrcRtHndSideData%PLinVelEP)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEP) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEP) + if (.not. allocated(DstRtHndSideData%PLinVelEP)) then + allocate(DstRtHndSideData%PLinVelEP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEP = SrcRtHndSideData%PLinVelEP + end if + if (allocated(SrcRtHndSideData%PLinVelEQ)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEQ) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEQ) + if (.not. allocated(DstRtHndSideData%PLinVelEQ)) then + allocate(DstRtHndSideData%PLinVelEQ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEQ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEQ = SrcRtHndSideData%PLinVelEQ + end if + if (allocated(SrcRtHndSideData%PLinVelEU)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEU) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEU) + if (.not. allocated(DstRtHndSideData%PLinVelEU)) then + allocate(DstRtHndSideData%PLinVelEU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEU = SrcRtHndSideData%PLinVelEU + end if + if (allocated(SrcRtHndSideData%PLinVelEV)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEV) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEV) + if (.not. allocated(DstRtHndSideData%PLinVelEV)) then + allocate(DstRtHndSideData%PLinVelEV(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEV = SrcRtHndSideData%PLinVelEV + end if + if (allocated(SrcRtHndSideData%PLinVelEW)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEW) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEW) + if (.not. allocated(DstRtHndSideData%PLinVelEW)) then + allocate(DstRtHndSideData%PLinVelEW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEW = SrcRtHndSideData%PLinVelEW + end if + if (allocated(SrcRtHndSideData%PLinVelEY)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEY) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEY) + if (.not. allocated(DstRtHndSideData%PLinVelEY)) then + allocate(DstRtHndSideData%PLinVelEY(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEY = SrcRtHndSideData%PLinVelEY + end if + DstRtHndSideData%LinAccEIMUt = SrcRtHndSideData%LinAccEIMUt + DstRtHndSideData%LinAccEOt = SrcRtHndSideData%LinAccEOt + if (allocated(SrcRtHndSideData%LinAccESt)) then + LB(1:3) = lbound(SrcRtHndSideData%LinAccESt) + UB(1:3) = ubound(SrcRtHndSideData%LinAccESt) + if (.not. allocated(DstRtHndSideData%LinAccESt)) then + allocate(DstRtHndSideData%LinAccESt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinAccESt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%LinAccESt = SrcRtHndSideData%LinAccESt + end if + if (allocated(SrcRtHndSideData%LinAccETt)) then + LB(1:2) = lbound(SrcRtHndSideData%LinAccETt) + UB(1:2) = ubound(SrcRtHndSideData%LinAccETt) + if (.not. allocated(DstRtHndSideData%LinAccETt)) then + allocate(DstRtHndSideData%LinAccETt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinAccETt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%LinAccETt = SrcRtHndSideData%LinAccETt + end if + DstRtHndSideData%LinAccEZt = SrcRtHndSideData%LinAccEZt + DstRtHndSideData%LinVelEIMU = SrcRtHndSideData%LinVelEIMU + DstRtHndSideData%LinVelEZ = SrcRtHndSideData%LinVelEZ + DstRtHndSideData%LinVelEO = SrcRtHndSideData%LinVelEO + DstRtHndSideData%LinVelEJ = SrcRtHndSideData%LinVelEJ + DstRtHndSideData%FrcONcRtt = SrcRtHndSideData%FrcONcRtt + DstRtHndSideData%FrcPRott = SrcRtHndSideData%FrcPRott + if (allocated(SrcRtHndSideData%FrcS0Bt)) then + LB(1:2) = lbound(SrcRtHndSideData%FrcS0Bt) + UB(1:2) = ubound(SrcRtHndSideData%FrcS0Bt) + if (.not. allocated(DstRtHndSideData%FrcS0Bt)) then + allocate(DstRtHndSideData%FrcS0Bt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FrcS0Bt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%FrcS0Bt = SrcRtHndSideData%FrcS0Bt + end if + DstRtHndSideData%FrcT0Trbt = SrcRtHndSideData%FrcT0Trbt + if (allocated(SrcRtHndSideData%FSAero)) then + LB(1:3) = lbound(SrcRtHndSideData%FSAero) + UB(1:3) = ubound(SrcRtHndSideData%FSAero) + if (.not. allocated(DstRtHndSideData%FSAero)) then + allocate(DstRtHndSideData%FSAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FSAero.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%FSAero = SrcRtHndSideData%FSAero + end if + if (allocated(SrcRtHndSideData%FSTipDrag)) then + LB(1:2) = lbound(SrcRtHndSideData%FSTipDrag) + UB(1:2) = ubound(SrcRtHndSideData%FSTipDrag) + if (.not. allocated(DstRtHndSideData%FSTipDrag)) then + allocate(DstRtHndSideData%FSTipDrag(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FSTipDrag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%FSTipDrag = SrcRtHndSideData%FSTipDrag + end if + if (allocated(SrcRtHndSideData%FTHydrot)) then + LB(1:2) = lbound(SrcRtHndSideData%FTHydrot) + UB(1:2) = ubound(SrcRtHndSideData%FTHydrot) + if (.not. allocated(DstRtHndSideData%FTHydrot)) then + allocate(DstRtHndSideData%FTHydrot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FTHydrot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%FTHydrot = SrcRtHndSideData%FTHydrot + end if + DstRtHndSideData%FZHydrot = SrcRtHndSideData%FZHydrot + if (allocated(SrcRtHndSideData%MFHydrot)) then + LB(1:2) = lbound(SrcRtHndSideData%MFHydrot) + UB(1:2) = ubound(SrcRtHndSideData%MFHydrot) + if (.not. allocated(DstRtHndSideData%MFHydrot)) then + allocate(DstRtHndSideData%MFHydrot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MFHydrot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%MFHydrot = SrcRtHndSideData%MFHydrot + end if + DstRtHndSideData%MomBNcRtt = SrcRtHndSideData%MomBNcRtt + if (allocated(SrcRtHndSideData%MomH0Bt)) then + LB(1:2) = lbound(SrcRtHndSideData%MomH0Bt) + UB(1:2) = ubound(SrcRtHndSideData%MomH0Bt) + if (.not. allocated(DstRtHndSideData%MomH0Bt)) then + allocate(DstRtHndSideData%MomH0Bt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MomH0Bt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%MomH0Bt = SrcRtHndSideData%MomH0Bt + end if + DstRtHndSideData%MomLPRott = SrcRtHndSideData%MomLPRott + DstRtHndSideData%MomNGnRtt = SrcRtHndSideData%MomNGnRtt + DstRtHndSideData%MomNTailt = SrcRtHndSideData%MomNTailt + DstRtHndSideData%MomX0Trbt = SrcRtHndSideData%MomX0Trbt + if (allocated(SrcRtHndSideData%MMAero)) then + LB(1:3) = lbound(SrcRtHndSideData%MMAero) + UB(1:3) = ubound(SrcRtHndSideData%MMAero) + if (.not. allocated(DstRtHndSideData%MMAero)) then + allocate(DstRtHndSideData%MMAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MMAero.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%MMAero = SrcRtHndSideData%MMAero + end if + DstRtHndSideData%MXHydrot = SrcRtHndSideData%MXHydrot + if (allocated(SrcRtHndSideData%PFrcONcRt)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcONcRt) + UB(1:2) = ubound(SrcRtHndSideData%PFrcONcRt) + if (.not. allocated(DstRtHndSideData%PFrcONcRt)) then + allocate(DstRtHndSideData%PFrcONcRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcONcRt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcONcRt = SrcRtHndSideData%PFrcONcRt + end if + if (allocated(SrcRtHndSideData%PFrcPRot)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcPRot) + UB(1:2) = ubound(SrcRtHndSideData%PFrcPRot) + if (.not. allocated(DstRtHndSideData%PFrcPRot)) then + allocate(DstRtHndSideData%PFrcPRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcPRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcPRot = SrcRtHndSideData%PFrcPRot + end if + if (allocated(SrcRtHndSideData%PFrcS0B)) then + LB(1:3) = lbound(SrcRtHndSideData%PFrcS0B) + UB(1:3) = ubound(SrcRtHndSideData%PFrcS0B) + if (.not. allocated(DstRtHndSideData%PFrcS0B)) then + allocate(DstRtHndSideData%PFrcS0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcS0B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcS0B = SrcRtHndSideData%PFrcS0B + end if + if (allocated(SrcRtHndSideData%PFrcT0Trb)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcT0Trb) + UB(1:2) = ubound(SrcRtHndSideData%PFrcT0Trb) + if (.not. allocated(DstRtHndSideData%PFrcT0Trb)) then + allocate(DstRtHndSideData%PFrcT0Trb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcT0Trb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcT0Trb = SrcRtHndSideData%PFrcT0Trb + end if + if (allocated(SrcRtHndSideData%PFTHydro)) then + LB(1:3) = lbound(SrcRtHndSideData%PFTHydro) + UB(1:3) = ubound(SrcRtHndSideData%PFTHydro) + if (.not. allocated(DstRtHndSideData%PFTHydro)) then + allocate(DstRtHndSideData%PFTHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFTHydro.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFTHydro = SrcRtHndSideData%PFTHydro + end if + DstRtHndSideData%PFZHydro = SrcRtHndSideData%PFZHydro + if (allocated(SrcRtHndSideData%PMFHydro)) then + LB(1:3) = lbound(SrcRtHndSideData%PMFHydro) + UB(1:3) = ubound(SrcRtHndSideData%PMFHydro) + if (.not. allocated(DstRtHndSideData%PMFHydro)) then + allocate(DstRtHndSideData%PMFHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMFHydro.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMFHydro = SrcRtHndSideData%PMFHydro + end if + if (allocated(SrcRtHndSideData%PMomBNcRt)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomBNcRt) + UB(1:2) = ubound(SrcRtHndSideData%PMomBNcRt) + if (.not. allocated(DstRtHndSideData%PMomBNcRt)) then + allocate(DstRtHndSideData%PMomBNcRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomBNcRt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomBNcRt = SrcRtHndSideData%PMomBNcRt + end if + if (allocated(SrcRtHndSideData%PMomH0B)) then + LB(1:3) = lbound(SrcRtHndSideData%PMomH0B) + UB(1:3) = ubound(SrcRtHndSideData%PMomH0B) + if (.not. allocated(DstRtHndSideData%PMomH0B)) then + allocate(DstRtHndSideData%PMomH0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomH0B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomH0B = SrcRtHndSideData%PMomH0B + end if + if (allocated(SrcRtHndSideData%PMomLPRot)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomLPRot) + UB(1:2) = ubound(SrcRtHndSideData%PMomLPRot) + if (.not. allocated(DstRtHndSideData%PMomLPRot)) then + allocate(DstRtHndSideData%PMomLPRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomLPRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomLPRot = SrcRtHndSideData%PMomLPRot + end if + if (allocated(SrcRtHndSideData%PMomNGnRt)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomNGnRt) + UB(1:2) = ubound(SrcRtHndSideData%PMomNGnRt) + if (.not. allocated(DstRtHndSideData%PMomNGnRt)) then + allocate(DstRtHndSideData%PMomNGnRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomNGnRt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomNGnRt = SrcRtHndSideData%PMomNGnRt + end if + if (allocated(SrcRtHndSideData%PMomNTail)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomNTail) + UB(1:2) = ubound(SrcRtHndSideData%PMomNTail) + if (.not. allocated(DstRtHndSideData%PMomNTail)) then + allocate(DstRtHndSideData%PMomNTail(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomNTail.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomNTail = SrcRtHndSideData%PMomNTail + end if + if (allocated(SrcRtHndSideData%PMomX0Trb)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomX0Trb) + UB(1:2) = ubound(SrcRtHndSideData%PMomX0Trb) + if (.not. allocated(DstRtHndSideData%PMomX0Trb)) then + allocate(DstRtHndSideData%PMomX0Trb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomX0Trb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomX0Trb = SrcRtHndSideData%PMomX0Trb + end if + DstRtHndSideData%PMXHydro = SrcRtHndSideData%PMXHydro + DstRtHndSideData%TeetAng = SrcRtHndSideData%TeetAng + DstRtHndSideData%FrcVGnRtt = SrcRtHndSideData%FrcVGnRtt + DstRtHndSideData%FrcWTailt = SrcRtHndSideData%FrcWTailt + DstRtHndSideData%FrcZAllt = SrcRtHndSideData%FrcZAllt + DstRtHndSideData%MomXAllt = SrcRtHndSideData%MomXAllt + if (allocated(SrcRtHndSideData%PFrcVGnRt)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcVGnRt) + UB(1:2) = ubound(SrcRtHndSideData%PFrcVGnRt) + if (.not. allocated(DstRtHndSideData%PFrcVGnRt)) then + allocate(DstRtHndSideData%PFrcVGnRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcVGnRt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcVGnRt = SrcRtHndSideData%PFrcVGnRt + end if + if (allocated(SrcRtHndSideData%PFrcWTail)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcWTail) + UB(1:2) = ubound(SrcRtHndSideData%PFrcWTail) + if (.not. allocated(DstRtHndSideData%PFrcWTail)) then + allocate(DstRtHndSideData%PFrcWTail(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcWTail.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcWTail = SrcRtHndSideData%PFrcWTail + end if + if (allocated(SrcRtHndSideData%PFrcZAll)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcZAll) + UB(1:2) = ubound(SrcRtHndSideData%PFrcZAll) + if (.not. allocated(DstRtHndSideData%PFrcZAll)) then + allocate(DstRtHndSideData%PFrcZAll(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcZAll.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcZAll = SrcRtHndSideData%PFrcZAll + end if + if (allocated(SrcRtHndSideData%PMomXAll)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomXAll) + UB(1:2) = ubound(SrcRtHndSideData%PMomXAll) + if (.not. allocated(DstRtHndSideData%PMomXAll)) then + allocate(DstRtHndSideData%PMomXAll(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomXAll.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomXAll = SrcRtHndSideData%PMomXAll + end if + DstRtHndSideData%TeetMom = SrcRtHndSideData%TeetMom + DstRtHndSideData%TFrlMom = SrcRtHndSideData%TFrlMom + DstRtHndSideData%RFrlMom = SrcRtHndSideData%RFrlMom + DstRtHndSideData%GBoxEffFac = SrcRtHndSideData%GBoxEffFac + if (allocated(SrcRtHndSideData%rSAerCen)) then + LB(1:3) = lbound(SrcRtHndSideData%rSAerCen) + UB(1:3) = ubound(SrcRtHndSideData%rSAerCen) + if (.not. allocated(DstRtHndSideData%rSAerCen)) then + allocate(DstRtHndSideData%rSAerCen(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rSAerCen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rSAerCen = SrcRtHndSideData%rSAerCen + end if +end subroutine + +subroutine ED_DestroyRtHndSide(RtHndSideData, ErrStat, ErrMsg) + type(ED_RtHndSide), intent(inout) :: RtHndSideData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyRtHndSide' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RtHndSideData%rQS)) then + deallocate(RtHndSideData%rQS) + end if + if (allocated(RtHndSideData%rS)) then + deallocate(RtHndSideData%rS) + end if + if (allocated(RtHndSideData%rS0S)) then + deallocate(RtHndSideData%rS0S) + end if + if (allocated(RtHndSideData%rT)) then + deallocate(RtHndSideData%rT) + end if + if (allocated(RtHndSideData%rT0T)) then + deallocate(RtHndSideData%rT0T) + end if + if (allocated(RtHndSideData%rZT)) then + deallocate(RtHndSideData%rZT) + end if + if (allocated(RtHndSideData%rPS0)) then + deallocate(RtHndSideData%rPS0) + end if + if (allocated(RtHndSideData%AngPosEF)) then + deallocate(RtHndSideData%AngPosEF) + end if + if (allocated(RtHndSideData%AngPosXF)) then + deallocate(RtHndSideData%AngPosXF) + end if + if (allocated(RtHndSideData%AngPosHM)) then + deallocate(RtHndSideData%AngPosHM) + end if + if (allocated(RtHndSideData%PAngVelEA)) then + deallocate(RtHndSideData%PAngVelEA) + end if + if (allocated(RtHndSideData%PAngVelEF)) then + deallocate(RtHndSideData%PAngVelEF) + end if + if (allocated(RtHndSideData%PAngVelEG)) then + deallocate(RtHndSideData%PAngVelEG) + end if + if (allocated(RtHndSideData%PAngVelEH)) then + deallocate(RtHndSideData%PAngVelEH) + end if + if (allocated(RtHndSideData%PAngVelEL)) then + deallocate(RtHndSideData%PAngVelEL) + end if + if (allocated(RtHndSideData%PAngVelEM)) then + deallocate(RtHndSideData%PAngVelEM) + end if + if (allocated(RtHndSideData%AngVelEM)) then + deallocate(RtHndSideData%AngVelEM) + end if + if (allocated(RtHndSideData%PAngVelEN)) then + deallocate(RtHndSideData%PAngVelEN) + end if + if (allocated(RtHndSideData%PAngVelEB)) then + deallocate(RtHndSideData%PAngVelEB) + end if + if (allocated(RtHndSideData%PAngVelER)) then + deallocate(RtHndSideData%PAngVelER) + end if + if (allocated(RtHndSideData%PAngVelEX)) then + deallocate(RtHndSideData%PAngVelEX) + end if + if (allocated(RtHndSideData%AngAccEFt)) then + deallocate(RtHndSideData%AngAccEFt) + end if + if (allocated(RtHndSideData%AngVelEF)) then + deallocate(RtHndSideData%AngVelEF) + end if + if (allocated(RtHndSideData%AngVelHM)) then + deallocate(RtHndSideData%AngVelHM) + end if + if (allocated(RtHndSideData%AngAccEKt)) then + deallocate(RtHndSideData%AngAccEKt) + end if + if (allocated(RtHndSideData%LinVelES)) then + deallocate(RtHndSideData%LinVelES) + end if + if (allocated(RtHndSideData%LinVelET)) then + deallocate(RtHndSideData%LinVelET) + end if + if (allocated(RtHndSideData%LinVelESm2)) then + deallocate(RtHndSideData%LinVelESm2) + end if + if (allocated(RtHndSideData%PLinVelEIMU)) then + deallocate(RtHndSideData%PLinVelEIMU) + end if + if (allocated(RtHndSideData%PLinVelEO)) then + deallocate(RtHndSideData%PLinVelEO) + end if + if (allocated(RtHndSideData%PLinVelES)) then + deallocate(RtHndSideData%PLinVelES) + end if + if (allocated(RtHndSideData%PLinVelET)) then + deallocate(RtHndSideData%PLinVelET) + end if + if (allocated(RtHndSideData%PLinVelEZ)) then + deallocate(RtHndSideData%PLinVelEZ) + end if + if (allocated(RtHndSideData%PLinVelEC)) then + deallocate(RtHndSideData%PLinVelEC) + end if + if (allocated(RtHndSideData%PLinVelED)) then + deallocate(RtHndSideData%PLinVelED) + end if + if (allocated(RtHndSideData%PLinVelEI)) then + deallocate(RtHndSideData%PLinVelEI) + end if + if (allocated(RtHndSideData%PLinVelEJ)) then + deallocate(RtHndSideData%PLinVelEJ) + end if + if (allocated(RtHndSideData%PLinVelEP)) then + deallocate(RtHndSideData%PLinVelEP) + end if + if (allocated(RtHndSideData%PLinVelEQ)) then + deallocate(RtHndSideData%PLinVelEQ) + end if + if (allocated(RtHndSideData%PLinVelEU)) then + deallocate(RtHndSideData%PLinVelEU) + end if + if (allocated(RtHndSideData%PLinVelEV)) then + deallocate(RtHndSideData%PLinVelEV) + end if + if (allocated(RtHndSideData%PLinVelEW)) then + deallocate(RtHndSideData%PLinVelEW) + end if + if (allocated(RtHndSideData%PLinVelEY)) then + deallocate(RtHndSideData%PLinVelEY) + end if + if (allocated(RtHndSideData%LinAccESt)) then + deallocate(RtHndSideData%LinAccESt) + end if + if (allocated(RtHndSideData%LinAccETt)) then + deallocate(RtHndSideData%LinAccETt) + end if + if (allocated(RtHndSideData%FrcS0Bt)) then + deallocate(RtHndSideData%FrcS0Bt) + end if + if (allocated(RtHndSideData%FSAero)) then + deallocate(RtHndSideData%FSAero) + end if + if (allocated(RtHndSideData%FSTipDrag)) then + deallocate(RtHndSideData%FSTipDrag) + end if + if (allocated(RtHndSideData%FTHydrot)) then + deallocate(RtHndSideData%FTHydrot) + end if + if (allocated(RtHndSideData%MFHydrot)) then + deallocate(RtHndSideData%MFHydrot) + end if + if (allocated(RtHndSideData%MomH0Bt)) then + deallocate(RtHndSideData%MomH0Bt) + end if + if (allocated(RtHndSideData%MMAero)) then + deallocate(RtHndSideData%MMAero) + end if + if (allocated(RtHndSideData%PFrcONcRt)) then + deallocate(RtHndSideData%PFrcONcRt) + end if + if (allocated(RtHndSideData%PFrcPRot)) then + deallocate(RtHndSideData%PFrcPRot) + end if + if (allocated(RtHndSideData%PFrcS0B)) then + deallocate(RtHndSideData%PFrcS0B) + end if + if (allocated(RtHndSideData%PFrcT0Trb)) then + deallocate(RtHndSideData%PFrcT0Trb) + end if + if (allocated(RtHndSideData%PFTHydro)) then + deallocate(RtHndSideData%PFTHydro) + end if + if (allocated(RtHndSideData%PMFHydro)) then + deallocate(RtHndSideData%PMFHydro) + end if + if (allocated(RtHndSideData%PMomBNcRt)) then + deallocate(RtHndSideData%PMomBNcRt) + end if + if (allocated(RtHndSideData%PMomH0B)) then + deallocate(RtHndSideData%PMomH0B) + end if + if (allocated(RtHndSideData%PMomLPRot)) then + deallocate(RtHndSideData%PMomLPRot) + end if + if (allocated(RtHndSideData%PMomNGnRt)) then + deallocate(RtHndSideData%PMomNGnRt) + end if + if (allocated(RtHndSideData%PMomNTail)) then + deallocate(RtHndSideData%PMomNTail) + end if + if (allocated(RtHndSideData%PMomX0Trb)) then + deallocate(RtHndSideData%PMomX0Trb) + end if + if (allocated(RtHndSideData%PFrcVGnRt)) then + deallocate(RtHndSideData%PFrcVGnRt) + end if + if (allocated(RtHndSideData%PFrcWTail)) then + deallocate(RtHndSideData%PFrcWTail) + end if + if (allocated(RtHndSideData%PFrcZAll)) then + deallocate(RtHndSideData%PFrcZAll) + end if + if (allocated(RtHndSideData%PMomXAll)) then + deallocate(RtHndSideData%PMomXAll) + end if + if (allocated(RtHndSideData%rSAerCen)) then + deallocate(RtHndSideData%rSAerCen) + end if +end subroutine + +subroutine ED_PackRtHndSide(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_RtHndSide), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackRtHndSide' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%rO) + call RegPack(Buf, allocated(InData%rQS)) + if (allocated(InData%rQS)) then + call RegPackBounds(Buf, 3, lbound(InData%rQS), ubound(InData%rQS)) + call RegPack(Buf, InData%rQS) + end if + call RegPack(Buf, allocated(InData%rS)) + if (allocated(InData%rS)) then + call RegPackBounds(Buf, 3, lbound(InData%rS), ubound(InData%rS)) + call RegPack(Buf, InData%rS) + end if + call RegPack(Buf, allocated(InData%rS0S)) + if (allocated(InData%rS0S)) then + call RegPackBounds(Buf, 3, lbound(InData%rS0S), ubound(InData%rS0S)) + call RegPack(Buf, InData%rS0S) + end if + call RegPack(Buf, allocated(InData%rT)) + if (allocated(InData%rT)) then + call RegPackBounds(Buf, 2, lbound(InData%rT), ubound(InData%rT)) + call RegPack(Buf, InData%rT) + end if + call RegPack(Buf, InData%rT0O) + call RegPack(Buf, allocated(InData%rT0T)) + if (allocated(InData%rT0T)) then + call RegPackBounds(Buf, 2, lbound(InData%rT0T), ubound(InData%rT0T)) + call RegPack(Buf, InData%rT0T) + end if + call RegPack(Buf, InData%rZ) + call RegPack(Buf, InData%rZO) + call RegPack(Buf, allocated(InData%rZT)) + if (allocated(InData%rZT)) then + call RegPackBounds(Buf, 2, lbound(InData%rZT), ubound(InData%rZT)) + call RegPack(Buf, InData%rZT) + end if + call RegPack(Buf, InData%rPQ) + call RegPack(Buf, InData%rP) + call RegPack(Buf, InData%rV) + call RegPack(Buf, InData%rJ) + call RegPack(Buf, InData%rZY) + call RegPack(Buf, InData%rOU) + call RegPack(Buf, InData%rOV) + call RegPack(Buf, InData%rVD) + call RegPack(Buf, InData%rOW) + call RegPack(Buf, InData%rPC) + call RegPack(Buf, allocated(InData%rPS0)) + if (allocated(InData%rPS0)) then + call RegPackBounds(Buf, 2, lbound(InData%rPS0), ubound(InData%rPS0)) + call RegPack(Buf, InData%rPS0) + end if + call RegPack(Buf, InData%rQ) + call RegPack(Buf, InData%rQC) + call RegPack(Buf, InData%rVIMU) + call RegPack(Buf, InData%rVP) + call RegPack(Buf, InData%rWI) + call RegPack(Buf, InData%rWJ) + call RegPack(Buf, InData%rZT0) + call RegPack(Buf, allocated(InData%AngPosEF)) + if (allocated(InData%AngPosEF)) then + call RegPackBounds(Buf, 2, lbound(InData%AngPosEF), ubound(InData%AngPosEF)) + call RegPack(Buf, InData%AngPosEF) + end if + call RegPack(Buf, allocated(InData%AngPosXF)) + if (allocated(InData%AngPosXF)) then + call RegPackBounds(Buf, 2, lbound(InData%AngPosXF), ubound(InData%AngPosXF)) + call RegPack(Buf, InData%AngPosXF) + end if + call RegPack(Buf, allocated(InData%AngPosHM)) + if (allocated(InData%AngPosHM)) then + call RegPackBounds(Buf, 3, lbound(InData%AngPosHM), ubound(InData%AngPosHM)) + call RegPack(Buf, InData%AngPosHM) + end if + call RegPack(Buf, InData%AngPosXB) + call RegPack(Buf, InData%AngPosEX) + call RegPack(Buf, allocated(InData%PAngVelEA)) + if (allocated(InData%PAngVelEA)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEA), ubound(InData%PAngVelEA)) + call RegPack(Buf, InData%PAngVelEA) + end if + call RegPack(Buf, allocated(InData%PAngVelEF)) + if (allocated(InData%PAngVelEF)) then + call RegPackBounds(Buf, 4, lbound(InData%PAngVelEF), ubound(InData%PAngVelEF)) + call RegPack(Buf, InData%PAngVelEF) + end if + call RegPack(Buf, allocated(InData%PAngVelEG)) + if (allocated(InData%PAngVelEG)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEG), ubound(InData%PAngVelEG)) + call RegPack(Buf, InData%PAngVelEG) + end if + call RegPack(Buf, allocated(InData%PAngVelEH)) + if (allocated(InData%PAngVelEH)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEH), ubound(InData%PAngVelEH)) + call RegPack(Buf, InData%PAngVelEH) + end if + call RegPack(Buf, allocated(InData%PAngVelEL)) + if (allocated(InData%PAngVelEL)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEL), ubound(InData%PAngVelEL)) + call RegPack(Buf, InData%PAngVelEL) + end if + call RegPack(Buf, allocated(InData%PAngVelEM)) + if (allocated(InData%PAngVelEM)) then + call RegPackBounds(Buf, 5, lbound(InData%PAngVelEM), ubound(InData%PAngVelEM)) + call RegPack(Buf, InData%PAngVelEM) + end if + call RegPack(Buf, allocated(InData%AngVelEM)) + if (allocated(InData%AngVelEM)) then + call RegPackBounds(Buf, 3, lbound(InData%AngVelEM), ubound(InData%AngVelEM)) + call RegPack(Buf, InData%AngVelEM) + end if + call RegPack(Buf, allocated(InData%PAngVelEN)) + if (allocated(InData%PAngVelEN)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEN), ubound(InData%PAngVelEN)) + call RegPack(Buf, InData%PAngVelEN) + end if + call RegPack(Buf, InData%AngVelEA) + call RegPack(Buf, allocated(InData%PAngVelEB)) + if (allocated(InData%PAngVelEB)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEB), ubound(InData%PAngVelEB)) + call RegPack(Buf, InData%PAngVelEB) + end if + call RegPack(Buf, allocated(InData%PAngVelER)) + if (allocated(InData%PAngVelER)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelER), ubound(InData%PAngVelER)) + call RegPack(Buf, InData%PAngVelER) + end if + call RegPack(Buf, allocated(InData%PAngVelEX)) + if (allocated(InData%PAngVelEX)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEX), ubound(InData%PAngVelEX)) + call RegPack(Buf, InData%PAngVelEX) + end if + call RegPack(Buf, InData%AngVelEG) + call RegPack(Buf, InData%AngVelEH) + call RegPack(Buf, InData%AngVelEL) + call RegPack(Buf, InData%AngVelEN) + call RegPack(Buf, InData%AngVelEB) + call RegPack(Buf, InData%AngVelER) + call RegPack(Buf, InData%AngVelEX) + call RegPack(Buf, InData%TeetAngVel) + call RegPack(Buf, InData%AngAccEBt) + call RegPack(Buf, InData%AngAccERt) + call RegPack(Buf, InData%AngAccEXt) + call RegPack(Buf, allocated(InData%AngAccEFt)) + if (allocated(InData%AngAccEFt)) then + call RegPackBounds(Buf, 2, lbound(InData%AngAccEFt), ubound(InData%AngAccEFt)) + call RegPack(Buf, InData%AngAccEFt) + end if + call RegPack(Buf, allocated(InData%AngVelEF)) + if (allocated(InData%AngVelEF)) then + call RegPackBounds(Buf, 2, lbound(InData%AngVelEF), ubound(InData%AngVelEF)) + call RegPack(Buf, InData%AngVelEF) + end if + call RegPack(Buf, allocated(InData%AngVelHM)) + if (allocated(InData%AngVelHM)) then + call RegPackBounds(Buf, 3, lbound(InData%AngVelHM), ubound(InData%AngVelHM)) + call RegPack(Buf, InData%AngVelHM) + end if + call RegPack(Buf, InData%AngAccEAt) + call RegPack(Buf, InData%AngAccEGt) + call RegPack(Buf, InData%AngAccEHt) + call RegPack(Buf, allocated(InData%AngAccEKt)) + if (allocated(InData%AngAccEKt)) then + call RegPackBounds(Buf, 3, lbound(InData%AngAccEKt), ubound(InData%AngAccEKt)) + call RegPack(Buf, InData%AngAccEKt) + end if + call RegPack(Buf, InData%AngAccENt) + call RegPack(Buf, InData%LinAccECt) + call RegPack(Buf, InData%LinAccEDt) + call RegPack(Buf, InData%LinAccEIt) + call RegPack(Buf, InData%LinAccEJt) + call RegPack(Buf, InData%LinAccEUt) + call RegPack(Buf, InData%LinAccEYt) + call RegPack(Buf, allocated(InData%LinVelES)) + if (allocated(InData%LinVelES)) then + call RegPackBounds(Buf, 3, lbound(InData%LinVelES), ubound(InData%LinVelES)) + call RegPack(Buf, InData%LinVelES) + end if + call RegPack(Buf, InData%LinVelEQ) + call RegPack(Buf, allocated(InData%LinVelET)) + if (allocated(InData%LinVelET)) then + call RegPackBounds(Buf, 2, lbound(InData%LinVelET), ubound(InData%LinVelET)) + call RegPack(Buf, InData%LinVelET) + end if + call RegPack(Buf, allocated(InData%LinVelESm2)) + if (allocated(InData%LinVelESm2)) then + call RegPackBounds(Buf, 1, lbound(InData%LinVelESm2), ubound(InData%LinVelESm2)) + call RegPack(Buf, InData%LinVelESm2) + end if + call RegPack(Buf, allocated(InData%PLinVelEIMU)) + if (allocated(InData%PLinVelEIMU)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEIMU), ubound(InData%PLinVelEIMU)) + call RegPack(Buf, InData%PLinVelEIMU) + end if + call RegPack(Buf, allocated(InData%PLinVelEO)) + if (allocated(InData%PLinVelEO)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEO), ubound(InData%PLinVelEO)) + call RegPack(Buf, InData%PLinVelEO) + end if + call RegPack(Buf, allocated(InData%PLinVelES)) + if (allocated(InData%PLinVelES)) then + call RegPackBounds(Buf, 5, lbound(InData%PLinVelES), ubound(InData%PLinVelES)) + call RegPack(Buf, InData%PLinVelES) + end if + call RegPack(Buf, allocated(InData%PLinVelET)) + if (allocated(InData%PLinVelET)) then + call RegPackBounds(Buf, 4, lbound(InData%PLinVelET), ubound(InData%PLinVelET)) + call RegPack(Buf, InData%PLinVelET) + end if + call RegPack(Buf, allocated(InData%PLinVelEZ)) + if (allocated(InData%PLinVelEZ)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEZ), ubound(InData%PLinVelEZ)) + call RegPack(Buf, InData%PLinVelEZ) + end if + call RegPack(Buf, allocated(InData%PLinVelEC)) + if (allocated(InData%PLinVelEC)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEC), ubound(InData%PLinVelEC)) + call RegPack(Buf, InData%PLinVelEC) + end if + call RegPack(Buf, allocated(InData%PLinVelED)) + if (allocated(InData%PLinVelED)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelED), ubound(InData%PLinVelED)) + call RegPack(Buf, InData%PLinVelED) + end if + call RegPack(Buf, allocated(InData%PLinVelEI)) + if (allocated(InData%PLinVelEI)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEI), ubound(InData%PLinVelEI)) + call RegPack(Buf, InData%PLinVelEI) + end if + call RegPack(Buf, allocated(InData%PLinVelEJ)) + if (allocated(InData%PLinVelEJ)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEJ), ubound(InData%PLinVelEJ)) + call RegPack(Buf, InData%PLinVelEJ) + end if + call RegPack(Buf, allocated(InData%PLinVelEP)) + if (allocated(InData%PLinVelEP)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEP), ubound(InData%PLinVelEP)) + call RegPack(Buf, InData%PLinVelEP) + end if + call RegPack(Buf, allocated(InData%PLinVelEQ)) + if (allocated(InData%PLinVelEQ)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEQ), ubound(InData%PLinVelEQ)) + call RegPack(Buf, InData%PLinVelEQ) + end if + call RegPack(Buf, allocated(InData%PLinVelEU)) + if (allocated(InData%PLinVelEU)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEU), ubound(InData%PLinVelEU)) + call RegPack(Buf, InData%PLinVelEU) + end if + call RegPack(Buf, allocated(InData%PLinVelEV)) + if (allocated(InData%PLinVelEV)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEV), ubound(InData%PLinVelEV)) + call RegPack(Buf, InData%PLinVelEV) + end if + call RegPack(Buf, allocated(InData%PLinVelEW)) + if (allocated(InData%PLinVelEW)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEW), ubound(InData%PLinVelEW)) + call RegPack(Buf, InData%PLinVelEW) + end if + call RegPack(Buf, allocated(InData%PLinVelEY)) + if (allocated(InData%PLinVelEY)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEY), ubound(InData%PLinVelEY)) + call RegPack(Buf, InData%PLinVelEY) + end if + call RegPack(Buf, InData%LinAccEIMUt) + call RegPack(Buf, InData%LinAccEOt) + call RegPack(Buf, allocated(InData%LinAccESt)) + if (allocated(InData%LinAccESt)) then + call RegPackBounds(Buf, 3, lbound(InData%LinAccESt), ubound(InData%LinAccESt)) + call RegPack(Buf, InData%LinAccESt) + end if + call RegPack(Buf, allocated(InData%LinAccETt)) + if (allocated(InData%LinAccETt)) then + call RegPackBounds(Buf, 2, lbound(InData%LinAccETt), ubound(InData%LinAccETt)) + call RegPack(Buf, InData%LinAccETt) + end if + call RegPack(Buf, InData%LinAccEZt) + call RegPack(Buf, InData%LinVelEIMU) + call RegPack(Buf, InData%LinVelEZ) + call RegPack(Buf, InData%LinVelEO) + call RegPack(Buf, InData%LinVelEJ) + call RegPack(Buf, InData%FrcONcRtt) + call RegPack(Buf, InData%FrcPRott) + call RegPack(Buf, allocated(InData%FrcS0Bt)) + if (allocated(InData%FrcS0Bt)) then + call RegPackBounds(Buf, 2, lbound(InData%FrcS0Bt), ubound(InData%FrcS0Bt)) + call RegPack(Buf, InData%FrcS0Bt) + end if + call RegPack(Buf, InData%FrcT0Trbt) + call RegPack(Buf, allocated(InData%FSAero)) + if (allocated(InData%FSAero)) then + call RegPackBounds(Buf, 3, lbound(InData%FSAero), ubound(InData%FSAero)) + call RegPack(Buf, InData%FSAero) + end if + call RegPack(Buf, allocated(InData%FSTipDrag)) + if (allocated(InData%FSTipDrag)) then + call RegPackBounds(Buf, 2, lbound(InData%FSTipDrag), ubound(InData%FSTipDrag)) + call RegPack(Buf, InData%FSTipDrag) + end if + call RegPack(Buf, allocated(InData%FTHydrot)) + if (allocated(InData%FTHydrot)) then + call RegPackBounds(Buf, 2, lbound(InData%FTHydrot), ubound(InData%FTHydrot)) + call RegPack(Buf, InData%FTHydrot) + end if + call RegPack(Buf, InData%FZHydrot) + call RegPack(Buf, allocated(InData%MFHydrot)) + if (allocated(InData%MFHydrot)) then + call RegPackBounds(Buf, 2, lbound(InData%MFHydrot), ubound(InData%MFHydrot)) + call RegPack(Buf, InData%MFHydrot) + end if + call RegPack(Buf, InData%MomBNcRtt) + call RegPack(Buf, allocated(InData%MomH0Bt)) + if (allocated(InData%MomH0Bt)) then + call RegPackBounds(Buf, 2, lbound(InData%MomH0Bt), ubound(InData%MomH0Bt)) + call RegPack(Buf, InData%MomH0Bt) + end if + call RegPack(Buf, InData%MomLPRott) + call RegPack(Buf, InData%MomNGnRtt) + call RegPack(Buf, InData%MomNTailt) + call RegPack(Buf, InData%MomX0Trbt) + call RegPack(Buf, allocated(InData%MMAero)) + if (allocated(InData%MMAero)) then + call RegPackBounds(Buf, 3, lbound(InData%MMAero), ubound(InData%MMAero)) + call RegPack(Buf, InData%MMAero) + end if + call RegPack(Buf, InData%MXHydrot) + call RegPack(Buf, allocated(InData%PFrcONcRt)) + if (allocated(InData%PFrcONcRt)) then + call RegPackBounds(Buf, 2, lbound(InData%PFrcONcRt), ubound(InData%PFrcONcRt)) + call RegPack(Buf, InData%PFrcONcRt) + end if + call RegPack(Buf, allocated(InData%PFrcPRot)) + if (allocated(InData%PFrcPRot)) then + call RegPackBounds(Buf, 2, lbound(InData%PFrcPRot), ubound(InData%PFrcPRot)) + call RegPack(Buf, InData%PFrcPRot) + end if + call RegPack(Buf, allocated(InData%PFrcS0B)) + if (allocated(InData%PFrcS0B)) then + call RegPackBounds(Buf, 3, lbound(InData%PFrcS0B), ubound(InData%PFrcS0B)) + call RegPack(Buf, InData%PFrcS0B) + end if + call RegPack(Buf, allocated(InData%PFrcT0Trb)) + if (allocated(InData%PFrcT0Trb)) then + call RegPackBounds(Buf, 2, lbound(InData%PFrcT0Trb), ubound(InData%PFrcT0Trb)) + call RegPack(Buf, InData%PFrcT0Trb) + end if + call RegPack(Buf, allocated(InData%PFTHydro)) + if (allocated(InData%PFTHydro)) then + call RegPackBounds(Buf, 3, lbound(InData%PFTHydro), ubound(InData%PFTHydro)) + call RegPack(Buf, InData%PFTHydro) + end if + call RegPack(Buf, InData%PFZHydro) + call RegPack(Buf, allocated(InData%PMFHydro)) + if (allocated(InData%PMFHydro)) then + call RegPackBounds(Buf, 3, lbound(InData%PMFHydro), ubound(InData%PMFHydro)) + call RegPack(Buf, InData%PMFHydro) + end if + call RegPack(Buf, allocated(InData%PMomBNcRt)) + if (allocated(InData%PMomBNcRt)) then + call RegPackBounds(Buf, 2, lbound(InData%PMomBNcRt), ubound(InData%PMomBNcRt)) + call RegPack(Buf, InData%PMomBNcRt) + end if + call RegPack(Buf, allocated(InData%PMomH0B)) + if (allocated(InData%PMomH0B)) then + call RegPackBounds(Buf, 3, lbound(InData%PMomH0B), ubound(InData%PMomH0B)) + call RegPack(Buf, InData%PMomH0B) + end if + call RegPack(Buf, allocated(InData%PMomLPRot)) + if (allocated(InData%PMomLPRot)) then + call RegPackBounds(Buf, 2, lbound(InData%PMomLPRot), ubound(InData%PMomLPRot)) + call RegPack(Buf, InData%PMomLPRot) + end if + call RegPack(Buf, allocated(InData%PMomNGnRt)) + if (allocated(InData%PMomNGnRt)) then + call RegPackBounds(Buf, 2, lbound(InData%PMomNGnRt), ubound(InData%PMomNGnRt)) + call RegPack(Buf, InData%PMomNGnRt) + end if + call RegPack(Buf, allocated(InData%PMomNTail)) + if (allocated(InData%PMomNTail)) then + call RegPackBounds(Buf, 2, lbound(InData%PMomNTail), ubound(InData%PMomNTail)) + call RegPack(Buf, InData%PMomNTail) + end if + call RegPack(Buf, allocated(InData%PMomX0Trb)) + if (allocated(InData%PMomX0Trb)) then + call RegPackBounds(Buf, 2, lbound(InData%PMomX0Trb), ubound(InData%PMomX0Trb)) + call RegPack(Buf, InData%PMomX0Trb) + end if + call RegPack(Buf, InData%PMXHydro) + call RegPack(Buf, InData%TeetAng) + call RegPack(Buf, InData%FrcVGnRtt) + call RegPack(Buf, InData%FrcWTailt) + call RegPack(Buf, InData%FrcZAllt) + call RegPack(Buf, InData%MomXAllt) + call RegPack(Buf, allocated(InData%PFrcVGnRt)) + if (allocated(InData%PFrcVGnRt)) then + call RegPackBounds(Buf, 2, lbound(InData%PFrcVGnRt), ubound(InData%PFrcVGnRt)) + call RegPack(Buf, InData%PFrcVGnRt) + end if + call RegPack(Buf, allocated(InData%PFrcWTail)) + if (allocated(InData%PFrcWTail)) then + call RegPackBounds(Buf, 2, lbound(InData%PFrcWTail), ubound(InData%PFrcWTail)) + call RegPack(Buf, InData%PFrcWTail) + end if + call RegPack(Buf, allocated(InData%PFrcZAll)) + if (allocated(InData%PFrcZAll)) then + call RegPackBounds(Buf, 2, lbound(InData%PFrcZAll), ubound(InData%PFrcZAll)) + call RegPack(Buf, InData%PFrcZAll) + end if + call RegPack(Buf, allocated(InData%PMomXAll)) + if (allocated(InData%PMomXAll)) then + call RegPackBounds(Buf, 2, lbound(InData%PMomXAll), ubound(InData%PMomXAll)) + call RegPack(Buf, InData%PMomXAll) + end if + call RegPack(Buf, InData%TeetMom) + call RegPack(Buf, InData%TFrlMom) + call RegPack(Buf, InData%RFrlMom) + call RegPack(Buf, InData%GBoxEffFac) + call RegPack(Buf, allocated(InData%rSAerCen)) + if (allocated(InData%rSAerCen)) then + call RegPackBounds(Buf, 3, lbound(InData%rSAerCen), ubound(InData%rSAerCen)) + call RegPack(Buf, InData%rSAerCen) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackRtHndSide(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_RtHndSide), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackRtHndSide' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%rO) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%rQS)) deallocate(OutData%rQS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rQS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rQS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rQS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rS)) deallocate(OutData%rS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rS0S)) deallocate(OutData%rS0S) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rS0S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rS0S.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rS0S) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rT)) deallocate(OutData%rT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rT(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rT) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%rT0O) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%rT0T)) deallocate(OutData%rT0T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rT0T(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT0T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rT0T) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%rZ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rZO) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%rZT)) deallocate(OutData%rZT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rZT(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rZT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rZT) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%rPQ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rJ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rZY) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rOU) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rOV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rVD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rOW) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rPC) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%rPS0)) deallocate(OutData%rPS0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rPS0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rPS0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rPS0) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%rQ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rQC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rVIMU) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rVP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rWI) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rWJ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rZT0) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AngPosEF)) deallocate(OutData%AngPosEF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngPosEF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosEF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngPosEF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AngPosXF)) deallocate(OutData%AngPosXF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngPosXF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosXF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngPosXF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AngPosHM)) deallocate(OutData%AngPosHM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngPosHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosHM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngPosHM) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%AngPosXB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngPosEX) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PAngVelEA)) deallocate(OutData%PAngVelEA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEA) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PAngVelEF)) deallocate(OutData%PAngVelEF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PAngVelEG)) deallocate(OutData%PAngVelEG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEG) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PAngVelEH)) deallocate(OutData%PAngVelEH) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEH(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEH) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PAngVelEL)) deallocate(OutData%PAngVelEL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PAngVelEM)) deallocate(OutData%PAngVelEM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEM) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AngVelEM)) deallocate(OutData%AngVelEM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelEM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngVelEM) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PAngVelEN)) deallocate(OutData%PAngVelEN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEN(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEN) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%AngVelEA) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PAngVelEB)) deallocate(OutData%PAngVelEB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PAngVelER)) deallocate(OutData%PAngVelER) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelER(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelER.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelER) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PAngVelEX)) deallocate(OutData%PAngVelEX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEX(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEX) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%AngVelEG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngVelEH) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngVelEL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngVelEN) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngVelEB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngVelER) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngVelEX) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetAngVel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngAccEBt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngAccERt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngAccEXt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AngAccEFt)) deallocate(OutData%AngAccEFt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngAccEFt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngAccEFt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngAccEFt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AngVelEF)) deallocate(OutData%AngVelEF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngVelEF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelEF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngVelEF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AngVelHM)) deallocate(OutData%AngVelHM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngVelHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelHM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngVelHM) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%AngAccEAt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngAccEGt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngAccEHt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AngAccEKt)) deallocate(OutData%AngAccEKt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngAccEKt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngAccEKt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngAccEKt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%AngAccENt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinAccECt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinAccEDt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinAccEIt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinAccEJt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinAccEUt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinAccEYt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%LinVelES)) deallocate(OutData%LinVelES) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelES.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinVelES) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%LinVelEQ) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%LinVelET)) deallocate(OutData%LinVelET) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinVelET(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelET.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinVelET) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinVelESm2)) deallocate(OutData%LinVelESm2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinVelESm2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelESm2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinVelESm2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PLinVelEIMU)) deallocate(OutData%PLinVelEIMU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEIMU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEIMU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEIMU) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PLinVelEO)) deallocate(OutData%PLinVelEO) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEO(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEO.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEO) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PLinVelES)) deallocate(OutData%PLinVelES) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelES.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelES) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PLinVelET)) deallocate(OutData%PLinVelET) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelET(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelET.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelET) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PLinVelEZ)) deallocate(OutData%PLinVelEZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEZ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PLinVelEC)) deallocate(OutData%PLinVelEC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PLinVelED)) deallocate(OutData%PLinVelED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelED(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelED) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PLinVelEI)) deallocate(OutData%PLinVelEI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEI(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEI) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PLinVelEJ)) deallocate(OutData%PLinVelEJ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEJ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEJ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEJ) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PLinVelEP)) deallocate(OutData%PLinVelEP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PLinVelEQ)) deallocate(OutData%PLinVelEQ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEQ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEQ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEQ) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PLinVelEU)) deallocate(OutData%PLinVelEU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEU) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PLinVelEV)) deallocate(OutData%PLinVelEV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEV(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEV) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PLinVelEW)) deallocate(OutData%PLinVelEW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEW) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PLinVelEY)) deallocate(OutData%PLinVelEY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEY(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEY) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%LinAccEIMUt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinAccEOt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%LinAccESt)) deallocate(OutData%LinAccESt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinAccESt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccESt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinAccESt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinAccETt)) deallocate(OutData%LinAccETt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinAccETt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccETt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinAccETt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%LinAccEZt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinVelEIMU) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinVelEZ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinVelEO) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinVelEJ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FrcONcRtt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FrcPRott) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%FrcS0Bt)) deallocate(OutData%FrcS0Bt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FrcS0Bt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FrcS0Bt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FrcS0Bt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%FrcT0Trbt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%FSAero)) deallocate(OutData%FSAero) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FSAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSAero.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FSAero) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FSTipDrag)) deallocate(OutData%FSTipDrag) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FSTipDrag(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSTipDrag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FSTipDrag) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FTHydrot)) deallocate(OutData%FTHydrot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FTHydrot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTHydrot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FTHydrot) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%FZHydrot) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%MFHydrot)) deallocate(OutData%MFHydrot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MFHydrot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MFHydrot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MFHydrot) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%MomBNcRtt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%MomH0Bt)) deallocate(OutData%MomH0Bt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MomH0Bt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MomH0Bt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MomH0Bt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%MomLPRott) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MomNGnRtt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MomNTailt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MomX0Trbt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%MMAero)) deallocate(OutData%MMAero) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MMAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMAero.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MMAero) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%MXHydrot) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PFrcONcRt)) deallocate(OutData%PFrcONcRt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFrcONcRt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcONcRt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFrcONcRt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PFrcPRot)) deallocate(OutData%PFrcPRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFrcPRot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcPRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFrcPRot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PFrcS0B)) deallocate(OutData%PFrcS0B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFrcS0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcS0B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFrcS0B) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PFrcT0Trb)) deallocate(OutData%PFrcT0Trb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFrcT0Trb(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcT0Trb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFrcT0Trb) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PFTHydro)) deallocate(OutData%PFTHydro) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFTHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFTHydro.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFTHydro) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%PFZHydro) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PMFHydro)) deallocate(OutData%PMFHydro) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMFHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMFHydro.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMFHydro) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PMomBNcRt)) deallocate(OutData%PMomBNcRt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMomBNcRt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomBNcRt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMomBNcRt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PMomH0B)) deallocate(OutData%PMomH0B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMomH0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomH0B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMomH0B) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PMomLPRot)) deallocate(OutData%PMomLPRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMomLPRot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomLPRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMomLPRot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PMomNGnRt)) deallocate(OutData%PMomNGnRt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMomNGnRt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNGnRt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMomNGnRt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PMomNTail)) deallocate(OutData%PMomNTail) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMomNTail(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNTail.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMomNTail) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PMomX0Trb)) deallocate(OutData%PMomX0Trb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMomX0Trb(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomX0Trb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMomX0Trb) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%PMXHydro) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetAng) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FrcVGnRtt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FrcWTailt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FrcZAllt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MomXAllt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PFrcVGnRt)) deallocate(OutData%PFrcVGnRt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFrcVGnRt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcVGnRt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFrcVGnRt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PFrcWTail)) deallocate(OutData%PFrcWTail) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFrcWTail(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcWTail.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFrcWTail) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PFrcZAll)) deallocate(OutData%PFrcZAll) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFrcZAll(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcZAll.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFrcZAll) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PMomXAll)) deallocate(OutData%PMomXAll) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMomXAll(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomXAll.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMomXAll) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%TeetMom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlMom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlMom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GBoxEffFac) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%rSAerCen)) deallocate(OutData%rSAerCen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rSAerCen(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rSAerCen) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine ED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(ED_ContinuousStateType), intent(in) :: SrcContStateData + type(ED_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%QT)) then + LB(1:1) = lbound(SrcContStateData%QT) + UB(1:1) = ubound(SrcContStateData%QT) + if (.not. allocated(DstContStateData%QT)) then + allocate(DstContStateData%QT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%QT = SrcContStateData%QT + end if + if (allocated(SrcContStateData%QDT)) then + LB(1:1) = lbound(SrcContStateData%QDT) + UB(1:1) = ubound(SrcContStateData%QDT) + if (.not. allocated(DstContStateData%QDT)) then + allocate(DstContStateData%QDT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QDT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%QDT = SrcContStateData%QDT + end if +end subroutine + +subroutine ED_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(ED_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%QT)) then + deallocate(ContStateData%QT) + end if + if (allocated(ContStateData%QDT)) then + deallocate(ContStateData%QDT) + end if +end subroutine + +subroutine ED_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%QT)) + if (allocated(InData%QT)) then + call RegPackBounds(Buf, 1, lbound(InData%QT), ubound(InData%QT)) + call RegPack(Buf, InData%QT) + end if + call RegPack(Buf, allocated(InData%QDT)) + if (allocated(InData%QDT)) then + call RegPackBounds(Buf, 1, lbound(InData%QDT), ubound(InData%QDT)) + call RegPack(Buf, InData%QDT) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackContState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%QT)) deallocate(OutData%QT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QT) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%QDT)) deallocate(OutData%QDT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QDT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QDT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QDT) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine ED_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(ED_DiscreteStateType), intent(in) :: SrcDiscStateData + type(ED_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine ED_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(ED_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ED_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(ED_ConstraintStateType), intent(in) :: SrcConstrStateData + type(ED_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine ED_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(ED_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ED_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(ED_OtherStateType), intent(in) :: SrcOtherStateData + type(ED_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%n = SrcOtherStateData%n + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + do i1 = LB(1), UB(1) + call ED_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + if (allocated(SrcOtherStateData%IC)) then + LB(1:1) = lbound(SrcOtherStateData%IC) + UB(1:1) = ubound(SrcOtherStateData%IC) + if (.not. allocated(DstOtherStateData%IC)) then + allocate(DstOtherStateData%IC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%IC = SrcOtherStateData%IC + end if + DstOtherStateData%HSSBrTrq = SrcOtherStateData%HSSBrTrq + DstOtherStateData%HSSBrTrqC = SrcOtherStateData%HSSBrTrqC + DstOtherStateData%SgnPrvLSTQ = SrcOtherStateData%SgnPrvLSTQ + DstOtherStateData%SgnLSTQ = SrcOtherStateData%SgnLSTQ +end subroutine + +subroutine ED_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(ED_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call ED_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + if (allocated(OtherStateData%IC)) then + deallocate(OtherStateData%IC) + end if +end subroutine + +subroutine ED_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%n) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call ED_PackContState(Buf, InData%xdot(i1)) + end do + call RegPack(Buf, allocated(InData%IC)) + if (allocated(InData%IC)) then + call RegPackBounds(Buf, 1, lbound(InData%IC), ubound(InData%IC)) + call RegPack(Buf, InData%IC) + end if + call RegPack(Buf, InData%HSSBrTrq) + call RegPack(Buf, InData%HSSBrTrqC) + call RegPack(Buf, InData%SgnPrvLSTQ) + call RegPack(Buf, InData%SgnLSTQ) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call ED_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do + if (allocated(OutData%IC)) deallocate(OutData%IC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IC) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%HSSBrTrq) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HSSBrTrqC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SgnPrvLSTQ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SgnLSTQ) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ED_MiscVarType), intent(in) :: SrcMiscData + type(ED_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call ED_CopyCoordSys(SrcMiscData%CoordSys, DstMiscData%CoordSys, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyRtHndSide(SrcMiscData%RtHS, DstMiscData%RtHS, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + end if + if (allocated(SrcMiscData%AugMat)) then + LB(1:2) = lbound(SrcMiscData%AugMat) + UB(1:2) = ubound(SrcMiscData%AugMat) + if (.not. allocated(DstMiscData%AugMat)) then + allocate(DstMiscData%AugMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AugMat = SrcMiscData%AugMat + end if + if (allocated(SrcMiscData%AugMat_factor)) then + LB(1:2) = lbound(SrcMiscData%AugMat_factor) + UB(1:2) = ubound(SrcMiscData%AugMat_factor) + if (.not. allocated(DstMiscData%AugMat_factor)) then + allocate(DstMiscData%AugMat_factor(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_factor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor + end if + if (allocated(SrcMiscData%SolnVec)) then + LB(1:1) = lbound(SrcMiscData%SolnVec) + UB(1:1) = ubound(SrcMiscData%SolnVec) + if (.not. allocated(DstMiscData%SolnVec)) then + allocate(DstMiscData%SolnVec(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SolnVec.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SolnVec = SrcMiscData%SolnVec + end if + if (allocated(SrcMiscData%AugMat_pivot)) then + LB(1:1) = lbound(SrcMiscData%AugMat_pivot) + UB(1:1) = ubound(SrcMiscData%AugMat_pivot) + if (.not. allocated(DstMiscData%AugMat_pivot)) then + allocate(DstMiscData%AugMat_pivot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_pivot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot + end if + if (allocated(SrcMiscData%OgnlGeAzRo)) then + LB(1:1) = lbound(SrcMiscData%OgnlGeAzRo) + UB(1:1) = ubound(SrcMiscData%OgnlGeAzRo) + if (.not. allocated(DstMiscData%OgnlGeAzRo)) then + allocate(DstMiscData%OgnlGeAzRo(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlGeAzRo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo + end if + if (allocated(SrcMiscData%QD2T)) then + LB(1:1) = lbound(SrcMiscData%QD2T) + UB(1:1) = ubound(SrcMiscData%QD2T) + if (.not. allocated(DstMiscData%QD2T)) then + allocate(DstMiscData%QD2T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%QD2T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%QD2T = SrcMiscData%QD2T + end if + DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod +end subroutine + +subroutine ED_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ED_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call ED_DestroyCoordSys(MiscData%CoordSys, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyRtHndSide(MiscData%RtHS, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%AugMat)) then + deallocate(MiscData%AugMat) + end if + if (allocated(MiscData%AugMat_factor)) then + deallocate(MiscData%AugMat_factor) + end if + if (allocated(MiscData%SolnVec)) then + deallocate(MiscData%SolnVec) + end if + if (allocated(MiscData%AugMat_pivot)) then + deallocate(MiscData%AugMat_pivot) + end if + if (allocated(MiscData%OgnlGeAzRo)) then + deallocate(MiscData%OgnlGeAzRo) + end if + if (allocated(MiscData%QD2T)) then + deallocate(MiscData%QD2T) + end if +end subroutine + +subroutine ED_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call ED_PackCoordSys(Buf, InData%CoordSys) + call ED_PackRtHndSide(Buf, InData%RtHS) + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + call RegPack(Buf, allocated(InData%AugMat)) + if (allocated(InData%AugMat)) then + call RegPackBounds(Buf, 2, lbound(InData%AugMat), ubound(InData%AugMat)) + call RegPack(Buf, InData%AugMat) + end if + call RegPack(Buf, allocated(InData%AugMat_factor)) + if (allocated(InData%AugMat_factor)) then + call RegPackBounds(Buf, 2, lbound(InData%AugMat_factor), ubound(InData%AugMat_factor)) + call RegPack(Buf, InData%AugMat_factor) + end if + call RegPack(Buf, allocated(InData%SolnVec)) + if (allocated(InData%SolnVec)) then + call RegPackBounds(Buf, 1, lbound(InData%SolnVec), ubound(InData%SolnVec)) + call RegPack(Buf, InData%SolnVec) + end if + call RegPack(Buf, allocated(InData%AugMat_pivot)) + if (allocated(InData%AugMat_pivot)) then + call RegPackBounds(Buf, 1, lbound(InData%AugMat_pivot), ubound(InData%AugMat_pivot)) + call RegPack(Buf, InData%AugMat_pivot) + end if + call RegPack(Buf, allocated(InData%OgnlGeAzRo)) + if (allocated(InData%OgnlGeAzRo)) then + call RegPackBounds(Buf, 1, lbound(InData%OgnlGeAzRo), ubound(InData%OgnlGeAzRo)) + call RegPack(Buf, InData%OgnlGeAzRo) + end if + call RegPack(Buf, allocated(InData%QD2T)) + if (allocated(InData%QD2T)) then + call RegPackBounds(Buf, 1, lbound(InData%QD2T), ubound(InData%QD2T)) + call RegPack(Buf, InData%QD2T) + end if + call RegPack(Buf, InData%IgnoreMod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackMisc' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call ED_UnpackCoordSys(Buf, OutData%CoordSys) ! CoordSys + call ED_UnpackRtHndSide(Buf, OutData%RtHS) ! RtHS + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AugMat)) deallocate(OutData%AugMat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AugMat(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AugMat) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AugMat_factor)) deallocate(OutData%AugMat_factor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AugMat_factor(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_factor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AugMat_factor) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SolnVec)) deallocate(OutData%SolnVec) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SolnVec(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SolnVec.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SolnVec) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AugMat_pivot)) deallocate(OutData%AugMat_pivot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AugMat_pivot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_pivot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AugMat_pivot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OgnlGeAzRo)) deallocate(OutData%OgnlGeAzRo) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OgnlGeAzRo(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OgnlGeAzRo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OgnlGeAzRo) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%QD2T)) deallocate(OutData%QD2T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QD2T(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QD2T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QD2T) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%IgnoreMod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(ED_ParameterType), intent(in) :: SrcParamData + type(ED_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%DT24 = SrcParamData%DT24 + DstParamData%BldNodes = SrcParamData%BldNodes + DstParamData%TipNode = SrcParamData%TipNode + DstParamData%NDOF = SrcParamData%NDOF + DstParamData%TwoPiNB = SrcParamData%TwoPiNB + DstParamData%NAug = SrcParamData%NAug + DstParamData%NPH = SrcParamData%NPH + if (allocated(SrcParamData%PH)) then + LB(1:1) = lbound(SrcParamData%PH) + UB(1:1) = ubound(SrcParamData%PH) + if (.not. allocated(DstParamData%PH)) then + allocate(DstParamData%PH(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PH = SrcParamData%PH + end if + DstParamData%NPM = SrcParamData%NPM + if (allocated(SrcParamData%PM)) then + LB(1:2) = lbound(SrcParamData%PM) + UB(1:2) = ubound(SrcParamData%PM) + if (.not. allocated(DstParamData%PM)) then + allocate(DstParamData%PM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PM = SrcParamData%PM + end if + if (allocated(SrcParamData%DOF_Flag)) then + LB(1:1) = lbound(SrcParamData%DOF_Flag) + UB(1:1) = ubound(SrcParamData%DOF_Flag) + if (.not. allocated(DstParamData%DOF_Flag)) then + allocate(DstParamData%DOF_Flag(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Flag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DOF_Flag = SrcParamData%DOF_Flag + end if + if (allocated(SrcParamData%DOF_Desc)) then + LB(1:1) = lbound(SrcParamData%DOF_Desc) + UB(1:1) = ubound(SrcParamData%DOF_Desc) + if (.not. allocated(DstParamData%DOF_Desc)) then + allocate(DstParamData%DOF_Desc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Desc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DOF_Desc = SrcParamData%DOF_Desc + end if + call ED_CopyActiveDOFs(SrcParamData%DOFs, DstParamData%DOFs, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%NBlGages = SrcParamData%NBlGages + DstParamData%NTwGages = SrcParamData%NTwGages + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + DstParamData%Delim = SrcParamData%Delim + DstParamData%AvgNrmTpRd = SrcParamData%AvgNrmTpRd + DstParamData%AzimB1Up = SrcParamData%AzimB1Up + DstParamData%CosDel3 = SrcParamData%CosDel3 + if (allocated(SrcParamData%CosPreC)) then + LB(1:1) = lbound(SrcParamData%CosPreC) + UB(1:1) = ubound(SrcParamData%CosPreC) + if (.not. allocated(DstParamData%CosPreC)) then + allocate(DstParamData%CosPreC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CosPreC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CosPreC = SrcParamData%CosPreC + end if + DstParamData%CRFrlSkew = SrcParamData%CRFrlSkew + DstParamData%CRFrlSkw2 = SrcParamData%CRFrlSkw2 + DstParamData%CRFrlTilt = SrcParamData%CRFrlTilt + DstParamData%CRFrlTlt2 = SrcParamData%CRFrlTlt2 + DstParamData%CShftSkew = SrcParamData%CShftSkew + DstParamData%CShftTilt = SrcParamData%CShftTilt + DstParamData%CSRFrlSkw = SrcParamData%CSRFrlSkw + DstParamData%CSRFrlTlt = SrcParamData%CSRFrlTlt + DstParamData%CSTFrlSkw = SrcParamData%CSTFrlSkw + DstParamData%CSTFrlTlt = SrcParamData%CSTFrlTlt + DstParamData%CTFrlSkew = SrcParamData%CTFrlSkew + DstParamData%CTFrlSkw2 = SrcParamData%CTFrlSkw2 + DstParamData%CTFrlTilt = SrcParamData%CTFrlTilt + DstParamData%CTFrlTlt2 = SrcParamData%CTFrlTlt2 + DstParamData%HubHt = SrcParamData%HubHt + DstParamData%HubCM = SrcParamData%HubCM + DstParamData%HubRad = SrcParamData%HubRad + DstParamData%NacCMxn = SrcParamData%NacCMxn + DstParamData%NacCMyn = SrcParamData%NacCMyn + DstParamData%NacCMzn = SrcParamData%NacCMzn + DstParamData%OverHang = SrcParamData%OverHang + DstParamData%ProjArea = SrcParamData%ProjArea + DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt + DstParamData%RefTwrHt = SrcParamData%RefTwrHt + DstParamData%RFrlPnt_n = SrcParamData%RFrlPnt_n + DstParamData%rVDxn = SrcParamData%rVDxn + DstParamData%rVDyn = SrcParamData%rVDyn + DstParamData%rVDzn = SrcParamData%rVDzn + DstParamData%rVIMUxn = SrcParamData%rVIMUxn + DstParamData%rVIMUyn = SrcParamData%rVIMUyn + DstParamData%rVIMUzn = SrcParamData%rVIMUzn + DstParamData%rVPxn = SrcParamData%rVPxn + DstParamData%rVPyn = SrcParamData%rVPyn + DstParamData%rVPzn = SrcParamData%rVPzn + DstParamData%rWIxn = SrcParamData%rWIxn + DstParamData%rWIyn = SrcParamData%rWIyn + DstParamData%rWIzn = SrcParamData%rWIzn + DstParamData%rWJxn = SrcParamData%rWJxn + DstParamData%rWJyn = SrcParamData%rWJyn + DstParamData%rWJzn = SrcParamData%rWJzn + DstParamData%rZT0zt = SrcParamData%rZT0zt + DstParamData%rZYzt = SrcParamData%rZYzt + DstParamData%SinDel3 = SrcParamData%SinDel3 + if (allocated(SrcParamData%SinPreC)) then + LB(1:1) = lbound(SrcParamData%SinPreC) + UB(1:1) = ubound(SrcParamData%SinPreC) + if (.not. allocated(DstParamData%SinPreC)) then + allocate(DstParamData%SinPreC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SinPreC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%SinPreC = SrcParamData%SinPreC + end if + DstParamData%SRFrlSkew = SrcParamData%SRFrlSkew + DstParamData%SRFrlSkw2 = SrcParamData%SRFrlSkw2 + DstParamData%SRFrlTilt = SrcParamData%SRFrlTilt + DstParamData%SRFrlTlt2 = SrcParamData%SRFrlTlt2 + DstParamData%SShftSkew = SrcParamData%SShftSkew + DstParamData%SShftTilt = SrcParamData%SShftTilt + DstParamData%STFrlSkew = SrcParamData%STFrlSkew + DstParamData%STFrlSkw2 = SrcParamData%STFrlSkw2 + DstParamData%STFrlTilt = SrcParamData%STFrlTilt + DstParamData%STFrlTlt2 = SrcParamData%STFrlTlt2 + DstParamData%TFrlPnt_n = SrcParamData%TFrlPnt_n + DstParamData%TipRad = SrcParamData%TipRad + DstParamData%TowerHt = SrcParamData%TowerHt + DstParamData%TowerBsHt = SrcParamData%TowerBsHt + DstParamData%UndSling = SrcParamData%UndSling + DstParamData%NumBl = SrcParamData%NumBl + if (allocated(SrcParamData%AxRedTFA)) then + LB(1:3) = lbound(SrcParamData%AxRedTFA) + UB(1:3) = ubound(SrcParamData%AxRedTFA) + if (.not. allocated(DstParamData%AxRedTFA)) then + allocate(DstParamData%AxRedTFA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTFA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AxRedTFA = SrcParamData%AxRedTFA + end if + if (allocated(SrcParamData%AxRedTSS)) then + LB(1:3) = lbound(SrcParamData%AxRedTSS) + UB(1:3) = ubound(SrcParamData%AxRedTSS) + if (.not. allocated(DstParamData%AxRedTSS)) then + allocate(DstParamData%AxRedTSS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTSS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AxRedTSS = SrcParamData%AxRedTSS + end if + DstParamData%CTFA = SrcParamData%CTFA + DstParamData%CTSS = SrcParamData%CTSS + if (allocated(SrcParamData%DHNodes)) then + LB(1:1) = lbound(SrcParamData%DHNodes) + UB(1:1) = ubound(SrcParamData%DHNodes) + if (.not. allocated(DstParamData%DHNodes)) then + allocate(DstParamData%DHNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DHNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DHNodes = SrcParamData%DHNodes + end if + if (allocated(SrcParamData%HNodes)) then + LB(1:1) = lbound(SrcParamData%HNodes) + UB(1:1) = ubound(SrcParamData%HNodes) + if (.not. allocated(DstParamData%HNodes)) then + allocate(DstParamData%HNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%HNodes = SrcParamData%HNodes + end if + if (allocated(SrcParamData%HNodesNorm)) then + LB(1:1) = lbound(SrcParamData%HNodesNorm) + UB(1:1) = ubound(SrcParamData%HNodesNorm) + if (.not. allocated(DstParamData%HNodesNorm)) then + allocate(DstParamData%HNodesNorm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodesNorm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%HNodesNorm = SrcParamData%HNodesNorm + end if + DstParamData%KTFA = SrcParamData%KTFA + DstParamData%KTSS = SrcParamData%KTSS + if (allocated(SrcParamData%MassT)) then + LB(1:1) = lbound(SrcParamData%MassT) + UB(1:1) = ubound(SrcParamData%MassT) + if (.not. allocated(DstParamData%MassT)) then + allocate(DstParamData%MassT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MassT = SrcParamData%MassT + end if + if (allocated(SrcParamData%StiffTSS)) then + LB(1:1) = lbound(SrcParamData%StiffTSS) + UB(1:1) = ubound(SrcParamData%StiffTSS) + if (.not. allocated(DstParamData%StiffTSS)) then + allocate(DstParamData%StiffTSS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTSS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StiffTSS = SrcParamData%StiffTSS + end if + if (allocated(SrcParamData%TwrFASF)) then + LB(1:3) = lbound(SrcParamData%TwrFASF) + UB(1:3) = ubound(SrcParamData%TwrFASF) + if (.not. allocated(DstParamData%TwrFASF)) then + allocate(DstParamData%TwrFASF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwrFASF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TwrFASF = SrcParamData%TwrFASF + end if + DstParamData%TwrFlexL = SrcParamData%TwrFlexL + if (allocated(SrcParamData%TwrSSSF)) then + LB(1:3) = lbound(SrcParamData%TwrSSSF) + UB(1:3) = ubound(SrcParamData%TwrSSSF) + if (.not. allocated(DstParamData%TwrSSSF)) then + allocate(DstParamData%TwrSSSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwrSSSF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TwrSSSF = SrcParamData%TwrSSSF + end if + DstParamData%TTopNode = SrcParamData%TTopNode + DstParamData%TwrNodes = SrcParamData%TwrNodes + DstParamData%MHK = SrcParamData%MHK + if (allocated(SrcParamData%StiffTFA)) then + LB(1:1) = lbound(SrcParamData%StiffTFA) + UB(1:1) = ubound(SrcParamData%StiffTFA) + if (.not. allocated(DstParamData%StiffTFA)) then + allocate(DstParamData%StiffTFA(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTFA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StiffTFA = SrcParamData%StiffTFA + end if + DstParamData%AtfaIner = SrcParamData%AtfaIner + if (allocated(SrcParamData%BldCG)) then + LB(1:1) = lbound(SrcParamData%BldCG) + UB(1:1) = ubound(SrcParamData%BldCG) + if (.not. allocated(DstParamData%BldCG)) then + allocate(DstParamData%BldCG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldCG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldCG = SrcParamData%BldCG + end if + if (allocated(SrcParamData%BldMass)) then + LB(1:1) = lbound(SrcParamData%BldMass) + UB(1:1) = ubound(SrcParamData%BldMass) + if (.not. allocated(DstParamData%BldMass)) then + allocate(DstParamData%BldMass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldMass = SrcParamData%BldMass + end if + DstParamData%BoomMass = SrcParamData%BoomMass + if (allocated(SrcParamData%FirstMom)) then + LB(1:1) = lbound(SrcParamData%FirstMom) + UB(1:1) = ubound(SrcParamData%FirstMom) + if (.not. allocated(DstParamData%FirstMom)) then + allocate(DstParamData%FirstMom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FirstMom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FirstMom = SrcParamData%FirstMom + end if + DstParamData%GenIner = SrcParamData%GenIner + DstParamData%Hubg1Iner = SrcParamData%Hubg1Iner + DstParamData%Hubg2Iner = SrcParamData%Hubg2Iner + DstParamData%HubMass = SrcParamData%HubMass + DstParamData%Nacd2Iner = SrcParamData%Nacd2Iner + DstParamData%NacMass = SrcParamData%NacMass + DstParamData%PtfmMass = SrcParamData%PtfmMass + DstParamData%PtfmPIner = SrcParamData%PtfmPIner + DstParamData%PtfmRIner = SrcParamData%PtfmRIner + DstParamData%PtfmYIner = SrcParamData%PtfmYIner + DstParamData%RFrlMass = SrcParamData%RFrlMass + DstParamData%RotIner = SrcParamData%RotIner + DstParamData%RotMass = SrcParamData%RotMass + DstParamData%RrfaIner = SrcParamData%RrfaIner + if (allocated(SrcParamData%SecondMom)) then + LB(1:1) = lbound(SrcParamData%SecondMom) + UB(1:1) = ubound(SrcParamData%SecondMom) + if (.not. allocated(DstParamData%SecondMom)) then + allocate(DstParamData%SecondMom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SecondMom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%SecondMom = SrcParamData%SecondMom + end if + DstParamData%TFinMass = SrcParamData%TFinMass + DstParamData%TFrlIner = SrcParamData%TFrlIner + if (allocated(SrcParamData%TipMass)) then + LB(1:1) = lbound(SrcParamData%TipMass) + UB(1:1) = ubound(SrcParamData%TipMass) + if (.not. allocated(DstParamData%TipMass)) then + allocate(DstParamData%TipMass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TipMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TipMass = SrcParamData%TipMass + end if + DstParamData%TurbMass = SrcParamData%TurbMass + DstParamData%TwrMass = SrcParamData%TwrMass + DstParamData%TwrTpMass = SrcParamData%TwrTpMass + DstParamData%YawBrMass = SrcParamData%YawBrMass + DstParamData%Gravity = SrcParamData%Gravity + if (allocated(SrcParamData%PitchAxis)) then + LB(1:2) = lbound(SrcParamData%PitchAxis) + UB(1:2) = ubound(SrcParamData%PitchAxis) + if (.not. allocated(DstParamData%PitchAxis)) then + allocate(DstParamData%PitchAxis(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitchAxis.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PitchAxis = SrcParamData%PitchAxis + end if + if (allocated(SrcParamData%AeroTwst)) then + LB(1:1) = lbound(SrcParamData%AeroTwst) + UB(1:1) = ubound(SrcParamData%AeroTwst) + if (.not. allocated(DstParamData%AeroTwst)) then + allocate(DstParamData%AeroTwst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AeroTwst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AeroTwst = SrcParamData%AeroTwst + end if + if (allocated(SrcParamData%AxRedBld)) then + LB(1:4) = lbound(SrcParamData%AxRedBld) + UB(1:4) = ubound(SrcParamData%AxRedBld) + if (.not. allocated(DstParamData%AxRedBld)) then + allocate(DstParamData%AxRedBld(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedBld.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AxRedBld = SrcParamData%AxRedBld + end if + if (allocated(SrcParamData%BldEDamp)) then + LB(1:2) = lbound(SrcParamData%BldEDamp) + UB(1:2) = ubound(SrcParamData%BldEDamp) + if (.not. allocated(DstParamData%BldEDamp)) then + allocate(DstParamData%BldEDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldEDamp = SrcParamData%BldEDamp + end if + if (allocated(SrcParamData%BldFDamp)) then + LB(1:2) = lbound(SrcParamData%BldFDamp) + UB(1:2) = ubound(SrcParamData%BldFDamp) + if (.not. allocated(DstParamData%BldFDamp)) then + allocate(DstParamData%BldFDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldFDamp = SrcParamData%BldFDamp + end if + DstParamData%BldFlexL = SrcParamData%BldFlexL + if (allocated(SrcParamData%CAeroTwst)) then + LB(1:1) = lbound(SrcParamData%CAeroTwst) + UB(1:1) = ubound(SrcParamData%CAeroTwst) + if (.not. allocated(DstParamData%CAeroTwst)) then + allocate(DstParamData%CAeroTwst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CAeroTwst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CAeroTwst = SrcParamData%CAeroTwst + end if + if (allocated(SrcParamData%CBE)) then + LB(1:3) = lbound(SrcParamData%CBE) + UB(1:3) = ubound(SrcParamData%CBE) + if (.not. allocated(DstParamData%CBE)) then + allocate(DstParamData%CBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CBE = SrcParamData%CBE + end if + if (allocated(SrcParamData%CBF)) then + LB(1:3) = lbound(SrcParamData%CBF) + UB(1:3) = ubound(SrcParamData%CBF) + if (.not. allocated(DstParamData%CBF)) then + allocate(DstParamData%CBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CBF = SrcParamData%CBF + end if + if (allocated(SrcParamData%Chord)) then + LB(1:1) = lbound(SrcParamData%Chord) + UB(1:1) = ubound(SrcParamData%Chord) + if (.not. allocated(DstParamData%Chord)) then + allocate(DstParamData%Chord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Chord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Chord = SrcParamData%Chord + end if + if (allocated(SrcParamData%CThetaS)) then + LB(1:2) = lbound(SrcParamData%CThetaS) + UB(1:2) = ubound(SrcParamData%CThetaS) + if (.not. allocated(DstParamData%CThetaS)) then + allocate(DstParamData%CThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CThetaS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CThetaS = SrcParamData%CThetaS + end if + if (allocated(SrcParamData%DRNodes)) then + LB(1:1) = lbound(SrcParamData%DRNodes) + UB(1:1) = ubound(SrcParamData%DRNodes) + if (.not. allocated(DstParamData%DRNodes)) then + allocate(DstParamData%DRNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DRNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DRNodes = SrcParamData%DRNodes + end if + if (allocated(SrcParamData%FStTunr)) then + LB(1:2) = lbound(SrcParamData%FStTunr) + UB(1:2) = ubound(SrcParamData%FStTunr) + if (.not. allocated(DstParamData%FStTunr)) then + allocate(DstParamData%FStTunr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FStTunr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FStTunr = SrcParamData%FStTunr + end if + if (allocated(SrcParamData%KBE)) then + LB(1:3) = lbound(SrcParamData%KBE) + UB(1:3) = ubound(SrcParamData%KBE) + if (.not. allocated(DstParamData%KBE)) then + allocate(DstParamData%KBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%KBE = SrcParamData%KBE + end if + if (allocated(SrcParamData%KBF)) then + LB(1:3) = lbound(SrcParamData%KBF) + UB(1:3) = ubound(SrcParamData%KBF) + if (.not. allocated(DstParamData%KBF)) then + allocate(DstParamData%KBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%KBF = SrcParamData%KBF + end if + if (allocated(SrcParamData%MassB)) then + LB(1:2) = lbound(SrcParamData%MassB) + UB(1:2) = ubound(SrcParamData%MassB) + if (.not. allocated(DstParamData%MassB)) then + allocate(DstParamData%MassB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MassB = SrcParamData%MassB + end if + if (allocated(SrcParamData%RNodes)) then + LB(1:1) = lbound(SrcParamData%RNodes) + UB(1:1) = ubound(SrcParamData%RNodes) + if (.not. allocated(DstParamData%RNodes)) then + allocate(DstParamData%RNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%RNodes = SrcParamData%RNodes + end if + if (allocated(SrcParamData%RNodesNorm)) then + LB(1:1) = lbound(SrcParamData%RNodesNorm) + UB(1:1) = ubound(SrcParamData%RNodesNorm) + if (.not. allocated(DstParamData%RNodesNorm)) then + allocate(DstParamData%RNodesNorm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodesNorm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%RNodesNorm = SrcParamData%RNodesNorm + end if + if (allocated(SrcParamData%rSAerCenn1)) then + LB(1:2) = lbound(SrcParamData%rSAerCenn1) + UB(1:2) = ubound(SrcParamData%rSAerCenn1) + if (.not. allocated(DstParamData%rSAerCenn1)) then + allocate(DstParamData%rSAerCenn1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rSAerCenn1 = SrcParamData%rSAerCenn1 + end if + if (allocated(SrcParamData%rSAerCenn2)) then + LB(1:2) = lbound(SrcParamData%rSAerCenn2) + UB(1:2) = ubound(SrcParamData%rSAerCenn2) + if (.not. allocated(DstParamData%rSAerCenn2)) then + allocate(DstParamData%rSAerCenn2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rSAerCenn2 = SrcParamData%rSAerCenn2 + end if + if (allocated(SrcParamData%SAeroTwst)) then + LB(1:1) = lbound(SrcParamData%SAeroTwst) + UB(1:1) = ubound(SrcParamData%SAeroTwst) + if (.not. allocated(DstParamData%SAeroTwst)) then + allocate(DstParamData%SAeroTwst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SAeroTwst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%SAeroTwst = SrcParamData%SAeroTwst + end if + if (allocated(SrcParamData%StiffBE)) then + LB(1:2) = lbound(SrcParamData%StiffBE) + UB(1:2) = ubound(SrcParamData%StiffBE) + if (.not. allocated(DstParamData%StiffBE)) then + allocate(DstParamData%StiffBE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StiffBE = SrcParamData%StiffBE + end if + if (allocated(SrcParamData%StiffBF)) then + LB(1:2) = lbound(SrcParamData%StiffBF) + UB(1:2) = ubound(SrcParamData%StiffBF) + if (.not. allocated(DstParamData%StiffBF)) then + allocate(DstParamData%StiffBF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StiffBF = SrcParamData%StiffBF + end if + if (allocated(SrcParamData%SThetaS)) then + LB(1:2) = lbound(SrcParamData%SThetaS) + UB(1:2) = ubound(SrcParamData%SThetaS) + if (.not. allocated(DstParamData%SThetaS)) then + allocate(DstParamData%SThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SThetaS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%SThetaS = SrcParamData%SThetaS + end if + if (allocated(SrcParamData%ThetaS)) then + LB(1:2) = lbound(SrcParamData%ThetaS) + UB(1:2) = ubound(SrcParamData%ThetaS) + if (.not. allocated(DstParamData%ThetaS)) then + allocate(DstParamData%ThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ThetaS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ThetaS = SrcParamData%ThetaS + end if + if (allocated(SrcParamData%TwistedSF)) then + LB(1:5) = lbound(SrcParamData%TwistedSF) + UB(1:5) = ubound(SrcParamData%TwistedSF) + if (.not. allocated(DstParamData%TwistedSF)) then + allocate(DstParamData%TwistedSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwistedSF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TwistedSF = SrcParamData%TwistedSF + end if + if (allocated(SrcParamData%BldFl1Sh)) then + LB(1:2) = lbound(SrcParamData%BldFl1Sh) + UB(1:2) = ubound(SrcParamData%BldFl1Sh) + if (.not. allocated(DstParamData%BldFl1Sh)) then + allocate(DstParamData%BldFl1Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl1Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldFl1Sh = SrcParamData%BldFl1Sh + end if + if (allocated(SrcParamData%BldFl2Sh)) then + LB(1:2) = lbound(SrcParamData%BldFl2Sh) + UB(1:2) = ubound(SrcParamData%BldFl2Sh) + if (.not. allocated(DstParamData%BldFl2Sh)) then + allocate(DstParamData%BldFl2Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl2Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldFl2Sh = SrcParamData%BldFl2Sh + end if + if (allocated(SrcParamData%BldEdgSh)) then + LB(1:2) = lbound(SrcParamData%BldEdgSh) + UB(1:2) = ubound(SrcParamData%BldEdgSh) + if (.not. allocated(DstParamData%BldEdgSh)) then + allocate(DstParamData%BldEdgSh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEdgSh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldEdgSh = SrcParamData%BldEdgSh + end if + if (allocated(SrcParamData%FreqBE)) then + LB(1:3) = lbound(SrcParamData%FreqBE) + UB(1:3) = ubound(SrcParamData%FreqBE) + if (.not. allocated(DstParamData%FreqBE)) then + allocate(DstParamData%FreqBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FreqBE = SrcParamData%FreqBE + end if + if (allocated(SrcParamData%FreqBF)) then + LB(1:3) = lbound(SrcParamData%FreqBF) + UB(1:3) = ubound(SrcParamData%FreqBF) + if (.not. allocated(DstParamData%FreqBF)) then + allocate(DstParamData%FreqBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqBF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FreqBF = SrcParamData%FreqBF + end if + DstParamData%FreqTFA = SrcParamData%FreqTFA + DstParamData%FreqTSS = SrcParamData%FreqTSS + DstParamData%TeetCDmp = SrcParamData%TeetCDmp + DstParamData%TeetDmp = SrcParamData%TeetDmp + DstParamData%TeetDmpP = SrcParamData%TeetDmpP + DstParamData%TeetHSSp = SrcParamData%TeetHSSp + DstParamData%TeetHStP = SrcParamData%TeetHStP + DstParamData%TeetSSSp = SrcParamData%TeetSSSp + DstParamData%TeetSStP = SrcParamData%TeetSStP + DstParamData%TeetMod = SrcParamData%TeetMod + DstParamData%TFrlDmp = SrcParamData%TFrlDmp + DstParamData%TFrlDSDmp = SrcParamData%TFrlDSDmp + DstParamData%TFrlDSDP = SrcParamData%TFrlDSDP + DstParamData%TFrlDSSP = SrcParamData%TFrlDSSP + DstParamData%TFrlDSSpr = SrcParamData%TFrlDSSpr + DstParamData%TFrlSpr = SrcParamData%TFrlSpr + DstParamData%TFrlUSDmp = SrcParamData%TFrlUSDmp + DstParamData%TFrlUSDP = SrcParamData%TFrlUSDP + DstParamData%TFrlUSSP = SrcParamData%TFrlUSSP + DstParamData%TFrlUSSpr = SrcParamData%TFrlUSSpr + DstParamData%TFrlMod = SrcParamData%TFrlMod + DstParamData%RFrlDmp = SrcParamData%RFrlDmp + DstParamData%RFrlDSDmp = SrcParamData%RFrlDSDmp + DstParamData%RFrlDSDP = SrcParamData%RFrlDSDP + DstParamData%RFrlDSSP = SrcParamData%RFrlDSSP + DstParamData%RFrlDSSpr = SrcParamData%RFrlDSSpr + DstParamData%RFrlSpr = SrcParamData%RFrlSpr + DstParamData%RFrlUSDmp = SrcParamData%RFrlUSDmp + DstParamData%RFrlUSDP = SrcParamData%RFrlUSDP + DstParamData%RFrlUSSP = SrcParamData%RFrlUSSP + DstParamData%RFrlUSSpr = SrcParamData%RFrlUSSpr + DstParamData%RFrlMod = SrcParamData%RFrlMod + DstParamData%ShftGagL = SrcParamData%ShftGagL + DstParamData%BldGagNd = SrcParamData%BldGagNd + DstParamData%TwrGagNd = SrcParamData%TwrGagNd + DstParamData%TStart = SrcParamData%TStart + DstParamData%DTTorDmp = SrcParamData%DTTorDmp + DstParamData%DTTorSpr = SrcParamData%DTTorSpr + DstParamData%GBRatio = SrcParamData%GBRatio + DstParamData%GBoxEff = SrcParamData%GBoxEff + DstParamData%RotSpeed = SrcParamData%RotSpeed + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%BElmntMass)) then + LB(1:2) = lbound(SrcParamData%BElmntMass) + UB(1:2) = ubound(SrcParamData%BElmntMass) + if (.not. allocated(DstParamData%BElmntMass)) then + allocate(DstParamData%BElmntMass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BElmntMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BElmntMass = SrcParamData%BElmntMass + end if + if (allocated(SrcParamData%TElmntMass)) then + LB(1:1) = lbound(SrcParamData%TElmntMass) + UB(1:1) = ubound(SrcParamData%TElmntMass) + if (.not. allocated(DstParamData%TElmntMass)) then + allocate(DstParamData%TElmntMass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TElmntMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TElmntMass = SrcParamData%TElmntMass + end if + DstParamData%method = SrcParamData%method + DstParamData%PtfmCMxt = SrcParamData%PtfmCMxt + DstParamData%PtfmCMyt = SrcParamData%PtfmCMyt + DstParamData%BD4Blades = SrcParamData%BD4Blades + DstParamData%UseAD14 = SrcParamData%UseAD14 + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts + if (allocated(SrcParamData%BldNd_OutParam)) then + LB(1:1) = lbound(SrcParamData%BldNd_OutParam) + UB(1:1) = ubound(SrcParamData%BldNd_OutParam) + if (.not. allocated(DstParamData%BldNd_OutParam)) then + allocate(DstParamData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du + end if + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx + end if + DstParamData%Jac_ny = SrcParamData%Jac_ny +end subroutine + +subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) + type(ED_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%PH)) then + deallocate(ParamData%PH) + end if + if (allocated(ParamData%PM)) then + deallocate(ParamData%PM) + end if + if (allocated(ParamData%DOF_Flag)) then + deallocate(ParamData%DOF_Flag) + end if + if (allocated(ParamData%DOF_Desc)) then + deallocate(ParamData%DOF_Desc) + end if + call ED_DestroyActiveDOFs(ParamData%DOFs, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%CosPreC)) then + deallocate(ParamData%CosPreC) + end if + if (allocated(ParamData%SinPreC)) then + deallocate(ParamData%SinPreC) + end if + if (allocated(ParamData%AxRedTFA)) then + deallocate(ParamData%AxRedTFA) + end if + if (allocated(ParamData%AxRedTSS)) then + deallocate(ParamData%AxRedTSS) + end if + if (allocated(ParamData%DHNodes)) then + deallocate(ParamData%DHNodes) + end if + if (allocated(ParamData%HNodes)) then + deallocate(ParamData%HNodes) + end if + if (allocated(ParamData%HNodesNorm)) then + deallocate(ParamData%HNodesNorm) + end if + if (allocated(ParamData%MassT)) then + deallocate(ParamData%MassT) + end if + if (allocated(ParamData%StiffTSS)) then + deallocate(ParamData%StiffTSS) + end if + if (allocated(ParamData%TwrFASF)) then + deallocate(ParamData%TwrFASF) + end if + if (allocated(ParamData%TwrSSSF)) then + deallocate(ParamData%TwrSSSF) + end if + if (allocated(ParamData%StiffTFA)) then + deallocate(ParamData%StiffTFA) + end if + if (allocated(ParamData%BldCG)) then + deallocate(ParamData%BldCG) + end if + if (allocated(ParamData%BldMass)) then + deallocate(ParamData%BldMass) + end if + if (allocated(ParamData%FirstMom)) then + deallocate(ParamData%FirstMom) + end if + if (allocated(ParamData%SecondMom)) then + deallocate(ParamData%SecondMom) + end if + if (allocated(ParamData%TipMass)) then + deallocate(ParamData%TipMass) + end if + if (allocated(ParamData%PitchAxis)) then + deallocate(ParamData%PitchAxis) + end if + if (allocated(ParamData%AeroTwst)) then + deallocate(ParamData%AeroTwst) + end if + if (allocated(ParamData%AxRedBld)) then + deallocate(ParamData%AxRedBld) + end if + if (allocated(ParamData%BldEDamp)) then + deallocate(ParamData%BldEDamp) + end if + if (allocated(ParamData%BldFDamp)) then + deallocate(ParamData%BldFDamp) + end if + if (allocated(ParamData%CAeroTwst)) then + deallocate(ParamData%CAeroTwst) + end if + if (allocated(ParamData%CBE)) then + deallocate(ParamData%CBE) + end if + if (allocated(ParamData%CBF)) then + deallocate(ParamData%CBF) + end if + if (allocated(ParamData%Chord)) then + deallocate(ParamData%Chord) + end if + if (allocated(ParamData%CThetaS)) then + deallocate(ParamData%CThetaS) + end if + if (allocated(ParamData%DRNodes)) then + deallocate(ParamData%DRNodes) + end if + if (allocated(ParamData%FStTunr)) then + deallocate(ParamData%FStTunr) + end if + if (allocated(ParamData%KBE)) then + deallocate(ParamData%KBE) + end if + if (allocated(ParamData%KBF)) then + deallocate(ParamData%KBF) + end if + if (allocated(ParamData%MassB)) then + deallocate(ParamData%MassB) + end if + if (allocated(ParamData%RNodes)) then + deallocate(ParamData%RNodes) + end if + if (allocated(ParamData%RNodesNorm)) then + deallocate(ParamData%RNodesNorm) + end if + if (allocated(ParamData%rSAerCenn1)) then + deallocate(ParamData%rSAerCenn1) + end if + if (allocated(ParamData%rSAerCenn2)) then + deallocate(ParamData%rSAerCenn2) + end if + if (allocated(ParamData%SAeroTwst)) then + deallocate(ParamData%SAeroTwst) + end if + if (allocated(ParamData%StiffBE)) then + deallocate(ParamData%StiffBE) + end if + if (allocated(ParamData%StiffBF)) then + deallocate(ParamData%StiffBF) + end if + if (allocated(ParamData%SThetaS)) then + deallocate(ParamData%SThetaS) + end if + if (allocated(ParamData%ThetaS)) then + deallocate(ParamData%ThetaS) + end if + if (allocated(ParamData%TwistedSF)) then + deallocate(ParamData%TwistedSF) + end if + if (allocated(ParamData%BldFl1Sh)) then + deallocate(ParamData%BldFl1Sh) + end if + if (allocated(ParamData%BldFl2Sh)) then + deallocate(ParamData%BldFl2Sh) + end if + if (allocated(ParamData%BldEdgSh)) then + deallocate(ParamData%BldEdgSh) + end if + if (allocated(ParamData%FreqBE)) then + deallocate(ParamData%FreqBE) + end if + if (allocated(ParamData%FreqBF)) then + deallocate(ParamData%FreqBF) + end if + if (allocated(ParamData%BElmntMass)) then + deallocate(ParamData%BElmntMass) + end if + if (allocated(ParamData%TElmntMass)) then + deallocate(ParamData%TElmntMass) + end if + if (allocated(ParamData%BldNd_OutParam)) then + LB(1:1) = lbound(ParamData%BldNd_OutParam) + UB(1:1) = ubound(ParamData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%BldNd_OutParam) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) + end if +end subroutine + +subroutine ED_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackParam' + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(5) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%DT24) + call RegPack(Buf, InData%BldNodes) + call RegPack(Buf, InData%TipNode) + call RegPack(Buf, InData%NDOF) + call RegPack(Buf, InData%TwoPiNB) + call RegPack(Buf, InData%NAug) + call RegPack(Buf, InData%NPH) + call RegPack(Buf, allocated(InData%PH)) + if (allocated(InData%PH)) then + call RegPackBounds(Buf, 1, lbound(InData%PH), ubound(InData%PH)) + call RegPack(Buf, InData%PH) + end if + call RegPack(Buf, InData%NPM) + call RegPack(Buf, allocated(InData%PM)) + if (allocated(InData%PM)) then + call RegPackBounds(Buf, 2, lbound(InData%PM), ubound(InData%PM)) + call RegPack(Buf, InData%PM) + end if + call RegPack(Buf, allocated(InData%DOF_Flag)) + if (allocated(InData%DOF_Flag)) then + call RegPackBounds(Buf, 1, lbound(InData%DOF_Flag), ubound(InData%DOF_Flag)) + call RegPack(Buf, InData%DOF_Flag) + end if + call RegPack(Buf, allocated(InData%DOF_Desc)) + if (allocated(InData%DOF_Desc)) then + call RegPackBounds(Buf, 1, lbound(InData%DOF_Desc), ubound(InData%DOF_Desc)) + call RegPack(Buf, InData%DOF_Desc) + end if + call ED_PackActiveDOFs(Buf, InData%DOFs) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%OutFmt) + call RegPack(Buf, InData%NBlGages) + call RegPack(Buf, InData%NTwGages) + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + call RegPack(Buf, InData%Delim) + call RegPack(Buf, InData%AvgNrmTpRd) + call RegPack(Buf, InData%AzimB1Up) + call RegPack(Buf, InData%CosDel3) + call RegPack(Buf, allocated(InData%CosPreC)) + if (allocated(InData%CosPreC)) then + call RegPackBounds(Buf, 1, lbound(InData%CosPreC), ubound(InData%CosPreC)) + call RegPack(Buf, InData%CosPreC) + end if + call RegPack(Buf, InData%CRFrlSkew) + call RegPack(Buf, InData%CRFrlSkw2) + call RegPack(Buf, InData%CRFrlTilt) + call RegPack(Buf, InData%CRFrlTlt2) + call RegPack(Buf, InData%CShftSkew) + call RegPack(Buf, InData%CShftTilt) + call RegPack(Buf, InData%CSRFrlSkw) + call RegPack(Buf, InData%CSRFrlTlt) + call RegPack(Buf, InData%CSTFrlSkw) + call RegPack(Buf, InData%CSTFrlTlt) + call RegPack(Buf, InData%CTFrlSkew) + call RegPack(Buf, InData%CTFrlSkw2) + call RegPack(Buf, InData%CTFrlTilt) + call RegPack(Buf, InData%CTFrlTlt2) + call RegPack(Buf, InData%HubHt) + call RegPack(Buf, InData%HubCM) + call RegPack(Buf, InData%HubRad) + call RegPack(Buf, InData%NacCMxn) + call RegPack(Buf, InData%NacCMyn) + call RegPack(Buf, InData%NacCMzn) + call RegPack(Buf, InData%OverHang) + call RegPack(Buf, InData%ProjArea) + call RegPack(Buf, InData%PtfmRefzt) + call RegPack(Buf, InData%RefTwrHt) + call RegPack(Buf, InData%RFrlPnt_n) + call RegPack(Buf, InData%rVDxn) + call RegPack(Buf, InData%rVDyn) + call RegPack(Buf, InData%rVDzn) + call RegPack(Buf, InData%rVIMUxn) + call RegPack(Buf, InData%rVIMUyn) + call RegPack(Buf, InData%rVIMUzn) + call RegPack(Buf, InData%rVPxn) + call RegPack(Buf, InData%rVPyn) + call RegPack(Buf, InData%rVPzn) + call RegPack(Buf, InData%rWIxn) + call RegPack(Buf, InData%rWIyn) + call RegPack(Buf, InData%rWIzn) + call RegPack(Buf, InData%rWJxn) + call RegPack(Buf, InData%rWJyn) + call RegPack(Buf, InData%rWJzn) + call RegPack(Buf, InData%rZT0zt) + call RegPack(Buf, InData%rZYzt) + call RegPack(Buf, InData%SinDel3) + call RegPack(Buf, allocated(InData%SinPreC)) + if (allocated(InData%SinPreC)) then + call RegPackBounds(Buf, 1, lbound(InData%SinPreC), ubound(InData%SinPreC)) + call RegPack(Buf, InData%SinPreC) + end if + call RegPack(Buf, InData%SRFrlSkew) + call RegPack(Buf, InData%SRFrlSkw2) + call RegPack(Buf, InData%SRFrlTilt) + call RegPack(Buf, InData%SRFrlTlt2) + call RegPack(Buf, InData%SShftSkew) + call RegPack(Buf, InData%SShftTilt) + call RegPack(Buf, InData%STFrlSkew) + call RegPack(Buf, InData%STFrlSkw2) + call RegPack(Buf, InData%STFrlTilt) + call RegPack(Buf, InData%STFrlTlt2) + call RegPack(Buf, InData%TFrlPnt_n) + call RegPack(Buf, InData%TipRad) + call RegPack(Buf, InData%TowerHt) + call RegPack(Buf, InData%TowerBsHt) + call RegPack(Buf, InData%UndSling) + call RegPack(Buf, InData%NumBl) + call RegPack(Buf, allocated(InData%AxRedTFA)) + if (allocated(InData%AxRedTFA)) then + call RegPackBounds(Buf, 3, lbound(InData%AxRedTFA), ubound(InData%AxRedTFA)) + call RegPack(Buf, InData%AxRedTFA) + end if + call RegPack(Buf, allocated(InData%AxRedTSS)) + if (allocated(InData%AxRedTSS)) then + call RegPackBounds(Buf, 3, lbound(InData%AxRedTSS), ubound(InData%AxRedTSS)) + call RegPack(Buf, InData%AxRedTSS) + end if + call RegPack(Buf, InData%CTFA) + call RegPack(Buf, InData%CTSS) + call RegPack(Buf, allocated(InData%DHNodes)) + if (allocated(InData%DHNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%DHNodes), ubound(InData%DHNodes)) + call RegPack(Buf, InData%DHNodes) + end if + call RegPack(Buf, allocated(InData%HNodes)) + if (allocated(InData%HNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%HNodes), ubound(InData%HNodes)) + call RegPack(Buf, InData%HNodes) + end if + call RegPack(Buf, allocated(InData%HNodesNorm)) + if (allocated(InData%HNodesNorm)) then + call RegPackBounds(Buf, 1, lbound(InData%HNodesNorm), ubound(InData%HNodesNorm)) + call RegPack(Buf, InData%HNodesNorm) + end if + call RegPack(Buf, InData%KTFA) + call RegPack(Buf, InData%KTSS) + call RegPack(Buf, allocated(InData%MassT)) + if (allocated(InData%MassT)) then + call RegPackBounds(Buf, 1, lbound(InData%MassT), ubound(InData%MassT)) + call RegPack(Buf, InData%MassT) + end if + call RegPack(Buf, allocated(InData%StiffTSS)) + if (allocated(InData%StiffTSS)) then + call RegPackBounds(Buf, 1, lbound(InData%StiffTSS), ubound(InData%StiffTSS)) + call RegPack(Buf, InData%StiffTSS) + end if + call RegPack(Buf, allocated(InData%TwrFASF)) + if (allocated(InData%TwrFASF)) then + call RegPackBounds(Buf, 3, lbound(InData%TwrFASF), ubound(InData%TwrFASF)) + call RegPack(Buf, InData%TwrFASF) + end if + call RegPack(Buf, InData%TwrFlexL) + call RegPack(Buf, allocated(InData%TwrSSSF)) + if (allocated(InData%TwrSSSF)) then + call RegPackBounds(Buf, 3, lbound(InData%TwrSSSF), ubound(InData%TwrSSSF)) + call RegPack(Buf, InData%TwrSSSF) + end if + call RegPack(Buf, InData%TTopNode) + call RegPack(Buf, InData%TwrNodes) + call RegPack(Buf, InData%MHK) + call RegPack(Buf, allocated(InData%StiffTFA)) + if (allocated(InData%StiffTFA)) then + call RegPackBounds(Buf, 1, lbound(InData%StiffTFA), ubound(InData%StiffTFA)) + call RegPack(Buf, InData%StiffTFA) + end if + call RegPack(Buf, InData%AtfaIner) + call RegPack(Buf, allocated(InData%BldCG)) + if (allocated(InData%BldCG)) then + call RegPackBounds(Buf, 1, lbound(InData%BldCG), ubound(InData%BldCG)) + call RegPack(Buf, InData%BldCG) + end if + call RegPack(Buf, allocated(InData%BldMass)) + if (allocated(InData%BldMass)) then + call RegPackBounds(Buf, 1, lbound(InData%BldMass), ubound(InData%BldMass)) + call RegPack(Buf, InData%BldMass) + end if + call RegPack(Buf, InData%BoomMass) + call RegPack(Buf, allocated(InData%FirstMom)) + if (allocated(InData%FirstMom)) then + call RegPackBounds(Buf, 1, lbound(InData%FirstMom), ubound(InData%FirstMom)) + call RegPack(Buf, InData%FirstMom) + end if + call RegPack(Buf, InData%GenIner) + call RegPack(Buf, InData%Hubg1Iner) + call RegPack(Buf, InData%Hubg2Iner) + call RegPack(Buf, InData%HubMass) + call RegPack(Buf, InData%Nacd2Iner) + call RegPack(Buf, InData%NacMass) + call RegPack(Buf, InData%PtfmMass) + call RegPack(Buf, InData%PtfmPIner) + call RegPack(Buf, InData%PtfmRIner) + call RegPack(Buf, InData%PtfmYIner) + call RegPack(Buf, InData%RFrlMass) + call RegPack(Buf, InData%RotIner) + call RegPack(Buf, InData%RotMass) + call RegPack(Buf, InData%RrfaIner) + call RegPack(Buf, allocated(InData%SecondMom)) + if (allocated(InData%SecondMom)) then + call RegPackBounds(Buf, 1, lbound(InData%SecondMom), ubound(InData%SecondMom)) + call RegPack(Buf, InData%SecondMom) + end if + call RegPack(Buf, InData%TFinMass) + call RegPack(Buf, InData%TFrlIner) + call RegPack(Buf, allocated(InData%TipMass)) + if (allocated(InData%TipMass)) then + call RegPackBounds(Buf, 1, lbound(InData%TipMass), ubound(InData%TipMass)) + call RegPack(Buf, InData%TipMass) + end if + call RegPack(Buf, InData%TurbMass) + call RegPack(Buf, InData%TwrMass) + call RegPack(Buf, InData%TwrTpMass) + call RegPack(Buf, InData%YawBrMass) + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, allocated(InData%PitchAxis)) + if (allocated(InData%PitchAxis)) then + call RegPackBounds(Buf, 2, lbound(InData%PitchAxis), ubound(InData%PitchAxis)) + call RegPack(Buf, InData%PitchAxis) + end if + call RegPack(Buf, allocated(InData%AeroTwst)) + if (allocated(InData%AeroTwst)) then + call RegPackBounds(Buf, 1, lbound(InData%AeroTwst), ubound(InData%AeroTwst)) + call RegPack(Buf, InData%AeroTwst) + end if + call RegPack(Buf, allocated(InData%AxRedBld)) + if (allocated(InData%AxRedBld)) then + call RegPackBounds(Buf, 4, lbound(InData%AxRedBld), ubound(InData%AxRedBld)) + call RegPack(Buf, InData%AxRedBld) + end if + call RegPack(Buf, allocated(InData%BldEDamp)) + if (allocated(InData%BldEDamp)) then + call RegPackBounds(Buf, 2, lbound(InData%BldEDamp), ubound(InData%BldEDamp)) + call RegPack(Buf, InData%BldEDamp) + end if + call RegPack(Buf, allocated(InData%BldFDamp)) + if (allocated(InData%BldFDamp)) then + call RegPackBounds(Buf, 2, lbound(InData%BldFDamp), ubound(InData%BldFDamp)) + call RegPack(Buf, InData%BldFDamp) + end if + call RegPack(Buf, InData%BldFlexL) + call RegPack(Buf, allocated(InData%CAeroTwst)) + if (allocated(InData%CAeroTwst)) then + call RegPackBounds(Buf, 1, lbound(InData%CAeroTwst), ubound(InData%CAeroTwst)) + call RegPack(Buf, InData%CAeroTwst) + end if + call RegPack(Buf, allocated(InData%CBE)) + if (allocated(InData%CBE)) then + call RegPackBounds(Buf, 3, lbound(InData%CBE), ubound(InData%CBE)) + call RegPack(Buf, InData%CBE) + end if + call RegPack(Buf, allocated(InData%CBF)) + if (allocated(InData%CBF)) then + call RegPackBounds(Buf, 3, lbound(InData%CBF), ubound(InData%CBF)) + call RegPack(Buf, InData%CBF) + end if + call RegPack(Buf, allocated(InData%Chord)) + if (allocated(InData%Chord)) then + call RegPackBounds(Buf, 1, lbound(InData%Chord), ubound(InData%Chord)) + call RegPack(Buf, InData%Chord) + end if + call RegPack(Buf, allocated(InData%CThetaS)) + if (allocated(InData%CThetaS)) then + call RegPackBounds(Buf, 2, lbound(InData%CThetaS), ubound(InData%CThetaS)) + call RegPack(Buf, InData%CThetaS) + end if + call RegPack(Buf, allocated(InData%DRNodes)) + if (allocated(InData%DRNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%DRNodes), ubound(InData%DRNodes)) + call RegPack(Buf, InData%DRNodes) + end if + call RegPack(Buf, allocated(InData%FStTunr)) + if (allocated(InData%FStTunr)) then + call RegPackBounds(Buf, 2, lbound(InData%FStTunr), ubound(InData%FStTunr)) + call RegPack(Buf, InData%FStTunr) + end if + call RegPack(Buf, allocated(InData%KBE)) + if (allocated(InData%KBE)) then + call RegPackBounds(Buf, 3, lbound(InData%KBE), ubound(InData%KBE)) + call RegPack(Buf, InData%KBE) + end if + call RegPack(Buf, allocated(InData%KBF)) + if (allocated(InData%KBF)) then + call RegPackBounds(Buf, 3, lbound(InData%KBF), ubound(InData%KBF)) + call RegPack(Buf, InData%KBF) + end if + call RegPack(Buf, allocated(InData%MassB)) + if (allocated(InData%MassB)) then + call RegPackBounds(Buf, 2, lbound(InData%MassB), ubound(InData%MassB)) + call RegPack(Buf, InData%MassB) + end if + call RegPack(Buf, allocated(InData%RNodes)) + if (allocated(InData%RNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%RNodes), ubound(InData%RNodes)) + call RegPack(Buf, InData%RNodes) + end if + call RegPack(Buf, allocated(InData%RNodesNorm)) + if (allocated(InData%RNodesNorm)) then + call RegPackBounds(Buf, 1, lbound(InData%RNodesNorm), ubound(InData%RNodesNorm)) + call RegPack(Buf, InData%RNodesNorm) + end if + call RegPack(Buf, allocated(InData%rSAerCenn1)) + if (allocated(InData%rSAerCenn1)) then + call RegPackBounds(Buf, 2, lbound(InData%rSAerCenn1), ubound(InData%rSAerCenn1)) + call RegPack(Buf, InData%rSAerCenn1) + end if + call RegPack(Buf, allocated(InData%rSAerCenn2)) + if (allocated(InData%rSAerCenn2)) then + call RegPackBounds(Buf, 2, lbound(InData%rSAerCenn2), ubound(InData%rSAerCenn2)) + call RegPack(Buf, InData%rSAerCenn2) + end if + call RegPack(Buf, allocated(InData%SAeroTwst)) + if (allocated(InData%SAeroTwst)) then + call RegPackBounds(Buf, 1, lbound(InData%SAeroTwst), ubound(InData%SAeroTwst)) + call RegPack(Buf, InData%SAeroTwst) + end if + call RegPack(Buf, allocated(InData%StiffBE)) + if (allocated(InData%StiffBE)) then + call RegPackBounds(Buf, 2, lbound(InData%StiffBE), ubound(InData%StiffBE)) + call RegPack(Buf, InData%StiffBE) + end if + call RegPack(Buf, allocated(InData%StiffBF)) + if (allocated(InData%StiffBF)) then + call RegPackBounds(Buf, 2, lbound(InData%StiffBF), ubound(InData%StiffBF)) + call RegPack(Buf, InData%StiffBF) + end if + call RegPack(Buf, allocated(InData%SThetaS)) + if (allocated(InData%SThetaS)) then + call RegPackBounds(Buf, 2, lbound(InData%SThetaS), ubound(InData%SThetaS)) + call RegPack(Buf, InData%SThetaS) + end if + call RegPack(Buf, allocated(InData%ThetaS)) + if (allocated(InData%ThetaS)) then + call RegPackBounds(Buf, 2, lbound(InData%ThetaS), ubound(InData%ThetaS)) + call RegPack(Buf, InData%ThetaS) + end if + call RegPack(Buf, allocated(InData%TwistedSF)) + if (allocated(InData%TwistedSF)) then + call RegPackBounds(Buf, 5, lbound(InData%TwistedSF), ubound(InData%TwistedSF)) + call RegPack(Buf, InData%TwistedSF) + end if + call RegPack(Buf, allocated(InData%BldFl1Sh)) + if (allocated(InData%BldFl1Sh)) then + call RegPackBounds(Buf, 2, lbound(InData%BldFl1Sh), ubound(InData%BldFl1Sh)) + call RegPack(Buf, InData%BldFl1Sh) + end if + call RegPack(Buf, allocated(InData%BldFl2Sh)) + if (allocated(InData%BldFl2Sh)) then + call RegPackBounds(Buf, 2, lbound(InData%BldFl2Sh), ubound(InData%BldFl2Sh)) + call RegPack(Buf, InData%BldFl2Sh) + end if + call RegPack(Buf, allocated(InData%BldEdgSh)) + if (allocated(InData%BldEdgSh)) then + call RegPackBounds(Buf, 2, lbound(InData%BldEdgSh), ubound(InData%BldEdgSh)) + call RegPack(Buf, InData%BldEdgSh) + end if + call RegPack(Buf, allocated(InData%FreqBE)) + if (allocated(InData%FreqBE)) then + call RegPackBounds(Buf, 3, lbound(InData%FreqBE), ubound(InData%FreqBE)) + call RegPack(Buf, InData%FreqBE) + end if + call RegPack(Buf, allocated(InData%FreqBF)) + if (allocated(InData%FreqBF)) then + call RegPackBounds(Buf, 3, lbound(InData%FreqBF), ubound(InData%FreqBF)) + call RegPack(Buf, InData%FreqBF) + end if + call RegPack(Buf, InData%FreqTFA) + call RegPack(Buf, InData%FreqTSS) + call RegPack(Buf, InData%TeetCDmp) + call RegPack(Buf, InData%TeetDmp) + call RegPack(Buf, InData%TeetDmpP) + call RegPack(Buf, InData%TeetHSSp) + call RegPack(Buf, InData%TeetHStP) + call RegPack(Buf, InData%TeetSSSp) + call RegPack(Buf, InData%TeetSStP) + call RegPack(Buf, InData%TeetMod) + call RegPack(Buf, InData%TFrlDmp) + call RegPack(Buf, InData%TFrlDSDmp) + call RegPack(Buf, InData%TFrlDSDP) + call RegPack(Buf, InData%TFrlDSSP) + call RegPack(Buf, InData%TFrlDSSpr) + call RegPack(Buf, InData%TFrlSpr) + call RegPack(Buf, InData%TFrlUSDmp) + call RegPack(Buf, InData%TFrlUSDP) + call RegPack(Buf, InData%TFrlUSSP) + call RegPack(Buf, InData%TFrlUSSpr) + call RegPack(Buf, InData%TFrlMod) + call RegPack(Buf, InData%RFrlDmp) + call RegPack(Buf, InData%RFrlDSDmp) + call RegPack(Buf, InData%RFrlDSDP) + call RegPack(Buf, InData%RFrlDSSP) + call RegPack(Buf, InData%RFrlDSSpr) + call RegPack(Buf, InData%RFrlSpr) + call RegPack(Buf, InData%RFrlUSDmp) + call RegPack(Buf, InData%RFrlUSDP) + call RegPack(Buf, InData%RFrlUSSP) + call RegPack(Buf, InData%RFrlUSSpr) + call RegPack(Buf, InData%RFrlMod) + call RegPack(Buf, InData%ShftGagL) + call RegPack(Buf, InData%BldGagNd) + call RegPack(Buf, InData%TwrGagNd) + call RegPack(Buf, InData%TStart) + call RegPack(Buf, InData%DTTorDmp) + call RegPack(Buf, InData%DTTorSpr) + call RegPack(Buf, InData%GBRatio) + call RegPack(Buf, InData%GBoxEff) + call RegPack(Buf, InData%RotSpeed) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, allocated(InData%BElmntMass)) + if (allocated(InData%BElmntMass)) then + call RegPackBounds(Buf, 2, lbound(InData%BElmntMass), ubound(InData%BElmntMass)) + call RegPack(Buf, InData%BElmntMass) + end if + call RegPack(Buf, allocated(InData%TElmntMass)) + if (allocated(InData%TElmntMass)) then + call RegPackBounds(Buf, 1, lbound(InData%TElmntMass), ubound(InData%TElmntMass)) + call RegPack(Buf, InData%TElmntMass) + end if + call RegPack(Buf, InData%method) + call RegPack(Buf, InData%PtfmCMxt) + call RegPack(Buf, InData%PtfmCMyt) + call RegPack(Buf, InData%BD4Blades) + call RegPack(Buf, InData%UseAD14) + call RegPack(Buf, InData%BldNd_NumOuts) + call RegPack(Buf, InData%BldNd_TotNumOuts) + call RegPack(Buf, allocated(InData%BldNd_OutParam)) + if (allocated(InData%BldNd_OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) + LB(1:1) = lbound(InData%BldNd_OutParam) + UB(1:1) = ubound(InData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%BldNd_OutParam(i1)) + end do + end if + call RegPack(Buf, InData%BldNd_BladesOut) + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + call RegPack(Buf, allocated(InData%du)) + if (allocated(InData%du)) then + call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPack(Buf, InData%du) + end if + call RegPack(Buf, allocated(InData%dx)) + if (allocated(InData%dx)) then + call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) + call RegPack(Buf, InData%dx) + end if + call RegPack(Buf, InData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackParam' + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DT24) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldNodes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TipNode) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwoPiNB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NAug) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NPH) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PH)) deallocate(OutData%PH) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PH(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PH) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NPM) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PM)) deallocate(OutData%PM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PM) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DOF_Flag)) deallocate(OutData%DOF_Flag) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DOF_Flag(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Flag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DOF_Flag) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DOF_Desc)) deallocate(OutData%DOF_Desc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DOF_Desc(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Desc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DOF_Desc) + if (RegCheckErr(Buf, RoutineName)) return + end if + call ED_UnpackActiveDOFs(Buf, OutData%DOFs) ! DOFs + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBlGages) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NTwGages) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AvgNrmTpRd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AzimB1Up) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CosDel3) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%CosPreC)) deallocate(OutData%CosPreC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CosPreC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CosPreC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CosPreC) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%CRFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CRFrlSkw2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CRFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CRFrlTlt2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CShftSkew) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CShftTilt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CSRFrlSkw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CSRFrlTlt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CSTFrlSkw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CSTFrlTlt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CTFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CTFrlSkw2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CTFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CTFrlTlt2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubHt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubCM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubRad) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacCMxn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacCMyn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacCMzn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OverHang) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ProjArea) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefTwrHt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlPnt_n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rVDxn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rVDyn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rVDzn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rVIMUxn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rVIMUyn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rVIMUzn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rVPxn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rVPyn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rVPzn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rWIxn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rWIyn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rWIzn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rWJxn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rWJyn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rWJzn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rZT0zt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rZYzt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SinDel3) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%SinPreC)) deallocate(OutData%SinPreC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SinPreC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SinPreC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SinPreC) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%SRFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SRFrlSkw2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SRFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SRFrlTlt2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SShftSkew) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SShftTilt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%STFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%STFrlSkw2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%STFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%STFrlTlt2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlPnt_n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TipRad) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TowerHt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TowerBsHt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UndSling) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AxRedTFA)) deallocate(OutData%AxRedTFA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxRedTFA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedTFA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxRedTFA) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AxRedTSS)) deallocate(OutData%AxRedTSS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxRedTSS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedTSS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxRedTSS) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%CTFA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CTSS) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%DHNodes)) deallocate(OutData%DHNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DHNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DHNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DHNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%HNodes)) deallocate(OutData%HNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%HNodesNorm)) deallocate(OutData%HNodesNorm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HNodesNorm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodesNorm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HNodesNorm) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%KTFA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%KTSS) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%MassT)) deallocate(OutData%MassT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MassT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MassT) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StiffTSS)) deallocate(OutData%StiffTSS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StiffTSS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTSS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StiffTSS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwrFASF)) deallocate(OutData%TwrFASF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrFASF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrFASF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrFASF) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%TwrFlexL) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TwrSSSF)) deallocate(OutData%TwrSSSF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrSSSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrSSSF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrSSSF) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%TTopNode) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrNodes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%StiffTFA)) deallocate(OutData%StiffTFA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StiffTFA(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTFA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StiffTFA) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%AtfaIner) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BldCG)) deallocate(OutData%BldCG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldCG(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldCG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldCG) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BldMass)) deallocate(OutData%BldMass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldMass(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldMass) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%BoomMass) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%FirstMom)) deallocate(OutData%FirstMom) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FirstMom(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstMom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FirstMom) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%GenIner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Hubg1Iner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Hubg2Iner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Nacd2Iner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmPIner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmRIner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmYIner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotIner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RrfaIner) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%SecondMom)) deallocate(OutData%SecondMom) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SecondMom(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SecondMom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SecondMom) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%TFinMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlIner) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TipMass)) deallocate(OutData%TipMass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TipMass(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TipMass) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%TurbMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrTpMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawBrMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PitchAxis)) deallocate(OutData%PitchAxis) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PitchAxis(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAxis.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PitchAxis) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AeroTwst)) deallocate(OutData%AeroTwst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AeroTwst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AeroTwst) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AxRedBld)) deallocate(OutData%AxRedBld) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxRedBld(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedBld.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxRedBld) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BldEDamp)) deallocate(OutData%BldEDamp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldEDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldEDamp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BldFDamp)) deallocate(OutData%BldFDamp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldFDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldFDamp) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%BldFlexL) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%CAeroTwst)) deallocate(OutData%CAeroTwst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CAeroTwst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CAeroTwst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CAeroTwst) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CBE)) deallocate(OutData%CBE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CBE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CBF)) deallocate(OutData%CBF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CBF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Chord)) deallocate(OutData%Chord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Chord(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Chord) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CThetaS)) deallocate(OutData%CThetaS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CThetaS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CThetaS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CThetaS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DRNodes)) deallocate(OutData%DRNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DRNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DRNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DRNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FStTunr)) deallocate(OutData%FStTunr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FStTunr(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FStTunr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FStTunr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%KBE)) deallocate(OutData%KBE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%KBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%KBE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%KBF)) deallocate(OutData%KBF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%KBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%KBF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MassB)) deallocate(OutData%MassB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MassB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MassB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RNodes)) deallocate(OutData%RNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RNodesNorm)) deallocate(OutData%RNodesNorm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RNodesNorm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodesNorm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RNodesNorm) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rSAerCenn1)) deallocate(OutData%rSAerCenn1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rSAerCenn1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rSAerCenn1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rSAerCenn2)) deallocate(OutData%rSAerCenn2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rSAerCenn2(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rSAerCenn2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SAeroTwst)) deallocate(OutData%SAeroTwst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SAeroTwst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SAeroTwst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SAeroTwst) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StiffBE)) deallocate(OutData%StiffBE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StiffBE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StiffBE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StiffBF)) deallocate(OutData%StiffBF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StiffBF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StiffBF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SThetaS)) deallocate(OutData%SThetaS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SThetaS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SThetaS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SThetaS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ThetaS)) deallocate(OutData%ThetaS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ThetaS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ThetaS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ThetaS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TwistedSF)) deallocate(OutData%TwistedSF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwistedSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwistedSF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwistedSF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BldFl1Sh)) deallocate(OutData%BldFl1Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldFl1Sh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldFl1Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BldFl2Sh)) deallocate(OutData%BldFl2Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldFl2Sh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldFl2Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BldEdgSh)) deallocate(OutData%BldEdgSh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldEdgSh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldEdgSh) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FreqBE)) deallocate(OutData%FreqBE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FreqBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FreqBE) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FreqBF)) deallocate(OutData%FreqBF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FreqBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqBF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FreqBF) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%FreqTFA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FreqTSS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetCDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetDmpP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetHSSp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetHStP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetSSSp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetSStP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TeetMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlDSDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlDSDP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlDSSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlDSSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlUSDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlUSDP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlUSSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlUSSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TFrlMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlDSDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlDSDP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlDSSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlDSSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlUSDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlUSDP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlUSSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlUSSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RFrlMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ShftGagL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldGagNd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrGagNd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TStart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DTTorDmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DTTorSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GBRatio) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GBoxEff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BElmntMass)) deallocate(OutData%BElmntMass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BElmntMass(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BElmntMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BElmntMass) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TElmntMass)) deallocate(OutData%TElmntMass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TElmntMass(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TElmntMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TElmntMass) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%method) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmCMxt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmCMyt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BD4Blades) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UseAD14) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BldNd_TotNumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam + end do + end if + call RegUnpack(Buf, OutData%BldNd_BladesOut) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%du)) deallocate(OutData%du) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%du(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dx)) deallocate(OutData%dx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(ED_InputType), intent(inout) :: SrcInputData + type(ED_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%BladePtLoads)) then + LB(1:1) = lbound(SrcInputData%BladePtLoads) + UB(1:1) = ubound(SrcInputData%BladePtLoads) + if (.not. allocated(DstInputData%BladePtLoads)) then + allocate(DstInputData%BladePtLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BladePtLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%BladePtLoads(i1), DstInputData%BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcInputData%PlatformPtMesh, DstInputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%TowerPtLoads, DstInputData%TowerPtLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%HubPtLoad, DstInputData%HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%NacelleLoads, DstInputData%NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%TFinCMLoads, DstInputData%TFinCMLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%TwrAddedMass)) then + LB(1:3) = lbound(SrcInputData%TwrAddedMass) + UB(1:3) = ubound(SrcInputData%TwrAddedMass) + if (.not. allocated(DstInputData%TwrAddedMass)) then + allocate(DstInputData%TwrAddedMass(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TwrAddedMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%TwrAddedMass = SrcInputData%TwrAddedMass + end if + DstInputData%PtfmAddedMass = SrcInputData%PtfmAddedMass + if (allocated(SrcInputData%BlPitchCom)) then + LB(1:1) = lbound(SrcInputData%BlPitchCom) + UB(1:1) = ubound(SrcInputData%BlPitchCom) + if (.not. allocated(DstInputData%BlPitchCom)) then + allocate(DstInputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitchCom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%BlPitchCom = SrcInputData%BlPitchCom + end if + DstInputData%YawMom = SrcInputData%YawMom + DstInputData%GenTrq = SrcInputData%GenTrq + DstInputData%HSSBrTrqC = SrcInputData%HSSBrTrqC +end subroutine + +subroutine ED_DestroyInput(InputData, ErrStat, ErrMsg) + type(ED_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%BladePtLoads)) then + LB(1:1) = lbound(InputData%BladePtLoads) + UB(1:1) = ubound(InputData%BladePtLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%BladePtLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%BladePtLoads) + end if + call MeshDestroy( InputData%PlatformPtMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%TowerPtLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%HubPtLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%NacelleLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%TFinCMLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputData%TwrAddedMass)) then + deallocate(InputData%TwrAddedMass) + end if + if (allocated(InputData%BlPitchCom)) then + deallocate(InputData%BlPitchCom) + end if +end subroutine + +subroutine ED_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackInput' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%BladePtLoads)) + if (allocated(InData%BladePtLoads)) then + call RegPackBounds(Buf, 1, lbound(InData%BladePtLoads), ubound(InData%BladePtLoads)) + LB(1:1) = lbound(InData%BladePtLoads) + UB(1:1) = ubound(InData%BladePtLoads) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladePtLoads(i1)) + end do + end if + call MeshPack(Buf, InData%PlatformPtMesh) + call MeshPack(Buf, InData%TowerPtLoads) + call MeshPack(Buf, InData%HubPtLoad) + call MeshPack(Buf, InData%NacelleLoads) + call MeshPack(Buf, InData%TFinCMLoads) + call RegPack(Buf, allocated(InData%TwrAddedMass)) + if (allocated(InData%TwrAddedMass)) then + call RegPackBounds(Buf, 3, lbound(InData%TwrAddedMass), ubound(InData%TwrAddedMass)) + call RegPack(Buf, InData%TwrAddedMass) + end if + call RegPack(Buf, InData%PtfmAddedMass) + call RegPack(Buf, allocated(InData%BlPitchCom)) + if (allocated(InData%BlPitchCom)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitchCom), ubound(InData%BlPitchCom)) + call RegPack(Buf, InData%BlPitchCom) + end if + call RegPack(Buf, InData%YawMom) + call RegPack(Buf, InData%GenTrq) + call RegPack(Buf, InData%HSSBrTrqC) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackInput' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%BladePtLoads)) deallocate(OutData%BladePtLoads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladePtLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladePtLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladePtLoads(i1)) ! BladePtLoads + end do + end if + call MeshUnpack(Buf, OutData%PlatformPtMesh) ! PlatformPtMesh + call MeshUnpack(Buf, OutData%TowerPtLoads) ! TowerPtLoads + call MeshUnpack(Buf, OutData%HubPtLoad) ! HubPtLoad + call MeshUnpack(Buf, OutData%NacelleLoads) ! NacelleLoads + call MeshUnpack(Buf, OutData%TFinCMLoads) ! TFinCMLoads + if (allocated(OutData%TwrAddedMass)) deallocate(OutData%TwrAddedMass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrAddedMass(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrAddedMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrAddedMass) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%PtfmAddedMass) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BlPitchCom)) deallocate(OutData%BlPitchCom) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitchCom(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitchCom) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%YawMom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenTrq) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HSSBrTrqC) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(ED_OutputType), intent(inout) :: SrcOutputData + type(ED_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%BladeLn2Mesh)) then + LB(1:1) = lbound(SrcOutputData%BladeLn2Mesh) + UB(1:1) = ubound(SrcOutputData%BladeLn2Mesh) + if (.not. allocated(DstOutputData%BladeLn2Mesh)) then + allocate(DstOutputData%BladeLn2Mesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeLn2Mesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%BladeLn2Mesh(i1), DstOutputData%BladeLn2Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcOutputData%PlatformPtMesh, DstOutputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%TowerLn2Mesh, DstOutputData%TowerLn2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%HubPtMotion14, DstOutputData%HubPtMotion14, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%HubPtMotion, DstOutputData%HubPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%BladeRootMotion14, DstOutputData%BladeRootMotion14, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%BladeRootMotion)) then + LB(1:1) = lbound(SrcOutputData%BladeRootMotion) + UB(1:1) = ubound(SrcOutputData%BladeRootMotion) + if (.not. allocated(DstOutputData%BladeRootMotion)) then + allocate(DstOutputData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%BladeRootMotion(i1), DstOutputData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcOutputData%RotorFurlMotion14, DstOutputData%RotorFurlMotion14, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%NacelleMotion, DstOutputData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%TowerBaseMotion14, DstOutputData%TowerBaseMotion14, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%TFinCMMotion, DstOutputData%TFinCMMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if + if (allocated(SrcOutputData%BlPitch)) then + LB(1:1) = lbound(SrcOutputData%BlPitch) + UB(1:1) = ubound(SrcOutputData%BlPitch) + if (.not. allocated(DstOutputData%BlPitch)) then + allocate(DstOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%BlPitch = SrcOutputData%BlPitch + end if + DstOutputData%Yaw = SrcOutputData%Yaw + DstOutputData%YawRate = SrcOutputData%YawRate + DstOutputData%LSS_Spd = SrcOutputData%LSS_Spd + DstOutputData%HSS_Spd = SrcOutputData%HSS_Spd + DstOutputData%RotSpeed = SrcOutputData%RotSpeed + DstOutputData%TwrAccel = SrcOutputData%TwrAccel + DstOutputData%YawAngle = SrcOutputData%YawAngle + DstOutputData%RootMyc = SrcOutputData%RootMyc + DstOutputData%YawBrTAxp = SrcOutputData%YawBrTAxp + DstOutputData%YawBrTAyp = SrcOutputData%YawBrTAyp + DstOutputData%LSSTipPxa = SrcOutputData%LSSTipPxa + DstOutputData%RootMxc = SrcOutputData%RootMxc + DstOutputData%LSSTipMxa = SrcOutputData%LSSTipMxa + DstOutputData%LSSTipMya = SrcOutputData%LSSTipMya + DstOutputData%LSSTipMza = SrcOutputData%LSSTipMza + DstOutputData%LSSTipMys = SrcOutputData%LSSTipMys + DstOutputData%LSSTipMzs = SrcOutputData%LSSTipMzs + DstOutputData%YawBrMyn = SrcOutputData%YawBrMyn + DstOutputData%YawBrMzn = SrcOutputData%YawBrMzn + DstOutputData%NcIMURAxs = SrcOutputData%NcIMURAxs + DstOutputData%NcIMURAys = SrcOutputData%NcIMURAys + DstOutputData%NcIMURAzs = SrcOutputData%NcIMURAzs + DstOutputData%RotPwr = SrcOutputData%RotPwr + DstOutputData%LSShftFxa = SrcOutputData%LSShftFxa + DstOutputData%LSShftFys = SrcOutputData%LSShftFys + DstOutputData%LSShftFzs = SrcOutputData%LSShftFzs +end subroutine + +subroutine ED_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(ED_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%BladeLn2Mesh)) then + LB(1:1) = lbound(OutputData%BladeLn2Mesh) + UB(1:1) = ubound(OutputData%BladeLn2Mesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%BladeLn2Mesh) + end if + call MeshDestroy( OutputData%PlatformPtMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%TowerLn2Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%HubPtMotion14, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%HubPtMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%BladeRootMotion14, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%BladeRootMotion)) then + LB(1:1) = lbound(OutputData%BladeRootMotion) + UB(1:1) = ubound(OutputData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%BladeRootMotion) + end if + call MeshDestroy( OutputData%RotorFurlMotion14, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%NacelleMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%TowerBaseMotion14, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%TFinCMMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + if (allocated(OutputData%BlPitch)) then + deallocate(OutputData%BlPitch) + end if +end subroutine + +subroutine ED_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%BladeLn2Mesh)) + if (allocated(InData%BladeLn2Mesh)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeLn2Mesh), ubound(InData%BladeLn2Mesh)) + LB(1:1) = lbound(InData%BladeLn2Mesh) + UB(1:1) = ubound(InData%BladeLn2Mesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeLn2Mesh(i1)) + end do + end if + call MeshPack(Buf, InData%PlatformPtMesh) + call MeshPack(Buf, InData%TowerLn2Mesh) + call MeshPack(Buf, InData%HubPtMotion14) + call MeshPack(Buf, InData%HubPtMotion) + call MeshPack(Buf, InData%BladeRootMotion14) + call RegPack(Buf, allocated(InData%BladeRootMotion)) + if (allocated(InData%BladeRootMotion)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeRootMotion(i1)) + end do + end if + call MeshPack(Buf, InData%RotorFurlMotion14) + call MeshPack(Buf, InData%NacelleMotion) + call MeshPack(Buf, InData%TowerBaseMotion14) + call MeshPack(Buf, InData%TFinCMMotion) + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + call RegPack(Buf, allocated(InData%BlPitch)) + if (allocated(InData%BlPitch)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) + call RegPack(Buf, InData%BlPitch) + end if + call RegPack(Buf, InData%Yaw) + call RegPack(Buf, InData%YawRate) + call RegPack(Buf, InData%LSS_Spd) + call RegPack(Buf, InData%HSS_Spd) + call RegPack(Buf, InData%RotSpeed) + call RegPack(Buf, InData%TwrAccel) + call RegPack(Buf, InData%YawAngle) + call RegPack(Buf, InData%RootMyc) + call RegPack(Buf, InData%YawBrTAxp) + call RegPack(Buf, InData%YawBrTAyp) + call RegPack(Buf, InData%LSSTipPxa) + call RegPack(Buf, InData%RootMxc) + call RegPack(Buf, InData%LSSTipMxa) + call RegPack(Buf, InData%LSSTipMya) + call RegPack(Buf, InData%LSSTipMza) + call RegPack(Buf, InData%LSSTipMys) + call RegPack(Buf, InData%LSSTipMzs) + call RegPack(Buf, InData%YawBrMyn) + call RegPack(Buf, InData%YawBrMzn) + call RegPack(Buf, InData%NcIMURAxs) + call RegPack(Buf, InData%NcIMURAys) + call RegPack(Buf, InData%NcIMURAzs) + call RegPack(Buf, InData%RotPwr) + call RegPack(Buf, InData%LSShftFxa) + call RegPack(Buf, InData%LSShftFys) + call RegPack(Buf, InData%LSShftFzs) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%BladeLn2Mesh)) deallocate(OutData%BladeLn2Mesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeLn2Mesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeLn2Mesh(i1)) ! BladeLn2Mesh + end do + end if + call MeshUnpack(Buf, OutData%PlatformPtMesh) ! PlatformPtMesh + call MeshUnpack(Buf, OutData%TowerLn2Mesh) ! TowerLn2Mesh + call MeshUnpack(Buf, OutData%HubPtMotion14) ! HubPtMotion14 + call MeshUnpack(Buf, OutData%HubPtMotion) ! HubPtMotion + call MeshUnpack(Buf, OutData%BladeRootMotion14) ! BladeRootMotion14 + if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeRootMotion(i1)) ! BladeRootMotion + end do + end if + call MeshUnpack(Buf, OutData%RotorFurlMotion14) ! RotorFurlMotion14 + call MeshUnpack(Buf, OutData%NacelleMotion) ! NacelleMotion + call MeshUnpack(Buf, OutData%TowerBaseMotion14) ! TowerBaseMotion14 + call MeshUnpack(Buf, OutData%TFinCMMotion) ! TFinCMMotion + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitch(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitch) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Yaw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawRate) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSS_Spd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HSS_Spd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrAccel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawAngle) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootMyc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawBrTAxp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawBrTAyp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipPxa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootMxc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipMxa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipMya) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipMza) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipMys) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipMzs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawBrMyn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawBrMzn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NcIMURAxs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NcIMURAys) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NcIMURAzs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotPwr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSShftFxa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSShftFys) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSShftFzs) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_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(ED_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(ED_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 = 'ED_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 ED_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL ED_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 ED_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 ED_Input_ExtrapInterp - - - SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call ED_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ED_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ED_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ED_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. @@ -22880,88 +11103,74 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(ED_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(ED_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(ED_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 + TYPE(ED_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(ED_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(ED_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 = 'ED_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 - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 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(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) - CALL MeshExtrapInterp1(u1%BladePtLoads(i1), u2%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp1(u1%PlatformPtMesh, u2%PlatformPtMesh, tin, u_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%TowerPtLoads, u2%TowerPtLoads, tin, u_out%TowerPtLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%HubPtLoad, u2%HubPtLoad, tin, u_out%HubPtLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%NacelleLoads, u2%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%TFinCMLoads, u2%TFinCMLoads, tin, u_out%TFinCMLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN - DO i3 = LBOUND(u_out%TwrAddedMass,3),UBOUND(u_out%TwrAddedMass,3) - DO i2 = LBOUND(u_out%TwrAddedMass,2),UBOUND(u_out%TwrAddedMass,2) - DO i1 = LBOUND(u_out%TwrAddedMass,1),UBOUND(u_out%TwrAddedMass,1) - b = -(u1%TwrAddedMass(i1,i2,i3) - u2%TwrAddedMass(i1,i2,i3)) - u_out%TwrAddedMass(i1,i2,i3) = u1%TwrAddedMass(i1,i2,i3) + b * ScaleFactor - END DO - END DO - END DO -END IF ! check if allocated - DO i2 = LBOUND(u_out%PtfmAddedMass,2),UBOUND(u_out%PtfmAddedMass,2) - DO i1 = LBOUND(u_out%PtfmAddedMass,1),UBOUND(u_out%PtfmAddedMass,1) - b = -(u1%PtfmAddedMass(i1,i2) - u2%PtfmAddedMass(i1,i2)) - u_out%PtfmAddedMass(i1,i2) = u1%PtfmAddedMass(i1,i2) + b * ScaleFactor - END DO - END DO -IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) - CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated - b = -(u1%YawMom - u2%YawMom) - u_out%YawMom = u1%YawMom + b * ScaleFactor - b = -(u1%GenTrq - u2%GenTrq) - u_out%GenTrq = u1%GenTrq + b * ScaleFactor - b = -(u1%HSSBrTrqC - u2%HSSBrTrqC) - u_out%HSSBrTrqC = u1%HSSBrTrqC + b * ScaleFactor - END SUBROUTINE ED_Input_ExtrapInterp1 - - - SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN + DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) + CALL MeshExtrapInterp1(u1%BladePtLoads(i1), u2%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp1(u1%PlatformPtMesh, u2%PlatformPtMesh, tin, u_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%TowerPtLoads, u2%TowerPtLoads, tin, u_out%TowerPtLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%HubPtLoad, u2%HubPtLoad, tin, u_out%HubPtLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%NacelleLoads, u2%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%TFinCMLoads, u2%TFinCMLoads, tin, u_out%TFinCMLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN + u_out%TwrAddedMass = a1*u1%TwrAddedMass + a2*u2%TwrAddedMass + END IF ! check if allocated + u_out%PtfmAddedMass = a1*u1%PtfmAddedMass + a2*u2%PtfmAddedMass + IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN + DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + u_out%YawMom = a1*u1%YawMom + a2*u2%YawMom + u_out%GenTrq = a1*u1%GenTrq + a2*u2%GenTrq + u_out%HSSBrTrqC = a1*u1%HSSBrTrqC + a2*u2%HSSBrTrqC +END SUBROUTINE + +SUBROUTINE ED_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. @@ -22975,153 +11184,134 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(ED_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(ED_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(ED_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(ED_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 + TYPE(ED_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(ED_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(ED_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(ED_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 = 'ED_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 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 + 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 + 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 + 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(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) - CALL MeshExtrapInterp2(u1%BladePtLoads(i1), u2%BladePtLoads(i1), u3%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp2(u1%PlatformPtMesh, u2%PlatformPtMesh, u3%PlatformPtMesh, tin, u_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%TowerPtLoads, u2%TowerPtLoads, u3%TowerPtLoads, tin, u_out%TowerPtLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%HubPtLoad, u2%HubPtLoad, u3%HubPtLoad, tin, u_out%HubPtLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%NacelleLoads, u2%NacelleLoads, u3%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%TFinCMLoads, u2%TFinCMLoads, u3%TFinCMLoads, tin, u_out%TFinCMLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN - DO i3 = LBOUND(u_out%TwrAddedMass,3),UBOUND(u_out%TwrAddedMass,3) - DO i2 = LBOUND(u_out%TwrAddedMass,2),UBOUND(u_out%TwrAddedMass,2) - DO i1 = LBOUND(u_out%TwrAddedMass,1),UBOUND(u_out%TwrAddedMass,1) - b = (t(3)**2*(u1%TwrAddedMass(i1,i2,i3) - u2%TwrAddedMass(i1,i2,i3)) + t(2)**2*(-u1%TwrAddedMass(i1,i2,i3) + u3%TwrAddedMass(i1,i2,i3)))* scaleFactor - c = ( (t(2)-t(3))*u1%TwrAddedMass(i1,i2,i3) + t(3)*u2%TwrAddedMass(i1,i2,i3) - t(2)*u3%TwrAddedMass(i1,i2,i3) ) * scaleFactor - u_out%TwrAddedMass(i1,i2,i3) = u1%TwrAddedMass(i1,i2,i3) + b + c * t_out - END DO - END DO - END DO -END IF ! check if allocated - DO i2 = LBOUND(u_out%PtfmAddedMass,2),UBOUND(u_out%PtfmAddedMass,2) - DO i1 = LBOUND(u_out%PtfmAddedMass,1),UBOUND(u_out%PtfmAddedMass,1) - b = (t(3)**2*(u1%PtfmAddedMass(i1,i2) - u2%PtfmAddedMass(i1,i2)) + t(2)**2*(-u1%PtfmAddedMass(i1,i2) + u3%PtfmAddedMass(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%PtfmAddedMass(i1,i2) + t(3)*u2%PtfmAddedMass(i1,i2) - t(2)*u3%PtfmAddedMass(i1,i2) ) * scaleFactor - u_out%PtfmAddedMass(i1,i2) = u1%PtfmAddedMass(i1,i2) + b + c * t_out - END DO - END DO -IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) - CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), u3%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%YawMom - u2%YawMom) + t(2)**2*(-u1%YawMom + u3%YawMom))* scaleFactor - c = ( (t(2)-t(3))*u1%YawMom + t(3)*u2%YawMom - t(2)*u3%YawMom ) * scaleFactor - u_out%YawMom = u1%YawMom + b + c * t_out - b = (t(3)**2*(u1%GenTrq - u2%GenTrq) + t(2)**2*(-u1%GenTrq + u3%GenTrq))* scaleFactor - c = ( (t(2)-t(3))*u1%GenTrq + t(3)*u2%GenTrq - t(2)*u3%GenTrq ) * scaleFactor - u_out%GenTrq = u1%GenTrq + b + c * t_out - b = (t(3)**2*(u1%HSSBrTrqC - u2%HSSBrTrqC) + t(2)**2*(-u1%HSSBrTrqC + u3%HSSBrTrqC))* scaleFactor - c = ( (t(2)-t(3))*u1%HSSBrTrqC + t(3)*u2%HSSBrTrqC - t(2)*u3%HSSBrTrqC ) * scaleFactor - u_out%HSSBrTrqC = u1%HSSBrTrqC + b + c * t_out - END SUBROUTINE ED_Input_ExtrapInterp2 - - - SUBROUTINE ED_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(ED_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(ED_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN + DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) + CALL MeshExtrapInterp2(u1%BladePtLoads(i1), u2%BladePtLoads(i1), u3%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp2(u1%PlatformPtMesh, u2%PlatformPtMesh, u3%PlatformPtMesh, tin, u_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%TowerPtLoads, u2%TowerPtLoads, u3%TowerPtLoads, tin, u_out%TowerPtLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%HubPtLoad, u2%HubPtLoad, u3%HubPtLoad, tin, u_out%HubPtLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%NacelleLoads, u2%NacelleLoads, u3%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%TFinCMLoads, u2%TFinCMLoads, u3%TFinCMLoads, tin, u_out%TFinCMLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN + u_out%TwrAddedMass = a1*u1%TwrAddedMass + a2*u2%TwrAddedMass + a3*u3%TwrAddedMass + END IF ! check if allocated + u_out%PtfmAddedMass = a1*u1%PtfmAddedMass + a2*u2%PtfmAddedMass + a3*u3%PtfmAddedMass + IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN + DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), u3%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + u_out%YawMom = a1*u1%YawMom + a2*u2%YawMom + a3*u3%YawMom + u_out%GenTrq = a1*u1%GenTrq + a2*u2%GenTrq + a3*u3%GenTrq + u_out%HSSBrTrqC = a1*u1%HSSBrTrqC + a2*u2%HSSBrTrqC + a3*u3%HSSBrTrqC +END SUBROUTINE + +subroutine ED_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(ED_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(ED_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 = 'ED_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 ED_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL ED_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 ED_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 ED_Output_ExtrapInterp - - - SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'ED_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call ED_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ED_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ED_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ED_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. @@ -23133,135 +11323,106 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(ED_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(ED_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(ED_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 + TYPE(ED_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(ED_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(ED_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 = 'ED_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'ED_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) - CALL MeshExtrapInterp1(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp1(y1%PlatformPtMesh, y2%PlatformPtMesh, tin, y_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%TowerLn2Mesh, y2%TowerLn2Mesh, tin, y_out%TowerLn2Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%HubPtMotion14, y2%HubPtMotion14, tin, y_out%HubPtMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%HubPtMotion, y2%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%BladeRootMotion14, y2%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) - CALL MeshExtrapInterp1(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp1(y1%RotorFurlMotion14, y2%RotorFurlMotion14, tin, y_out%RotorFurlMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%NacelleMotion, y2%NacelleMotion, tin, y_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%TowerBaseMotion14, y2%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%TFinCMMotion, y2%TFinCMMotion, tin, y_out%TFinCMMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 -IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) - CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) - END DO -END IF ! check if allocated - CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, tin, y_out%Yaw, tin_out ) - b = -(y1%YawRate - y2%YawRate) - y_out%YawRate = y1%YawRate + b * ScaleFactor - b = -(y1%LSS_Spd - y2%LSS_Spd) - y_out%LSS_Spd = y1%LSS_Spd + b * ScaleFactor - b = -(y1%HSS_Spd - y2%HSS_Spd) - y_out%HSS_Spd = y1%HSS_Spd + b * ScaleFactor - b = -(y1%RotSpeed - y2%RotSpeed) - y_out%RotSpeed = y1%RotSpeed + b * ScaleFactor - b = -(y1%TwrAccel - y2%TwrAccel) - y_out%TwrAccel = y1%TwrAccel + b * ScaleFactor - CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, tin, y_out%YawAngle, tin_out ) - DO i1 = LBOUND(y_out%RootMyc,1),UBOUND(y_out%RootMyc,1) - b = -(y1%RootMyc(i1) - y2%RootMyc(i1)) - y_out%RootMyc(i1) = y1%RootMyc(i1) + b * ScaleFactor - END DO - b = -(y1%YawBrTAxp - y2%YawBrTAxp) - y_out%YawBrTAxp = y1%YawBrTAxp + b * ScaleFactor - b = -(y1%YawBrTAyp - y2%YawBrTAyp) - y_out%YawBrTAyp = y1%YawBrTAyp + b * ScaleFactor - CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) - DO i1 = LBOUND(y_out%RootMxc,1),UBOUND(y_out%RootMxc,1) - b = -(y1%RootMxc(i1) - y2%RootMxc(i1)) - y_out%RootMxc(i1) = y1%RootMxc(i1) + b * ScaleFactor - END DO - b = -(y1%LSSTipMxa - y2%LSSTipMxa) - y_out%LSSTipMxa = y1%LSSTipMxa + b * ScaleFactor - b = -(y1%LSSTipMya - y2%LSSTipMya) - y_out%LSSTipMya = y1%LSSTipMya + b * ScaleFactor - b = -(y1%LSSTipMza - y2%LSSTipMza) - y_out%LSSTipMza = y1%LSSTipMza + b * ScaleFactor - b = -(y1%LSSTipMys - y2%LSSTipMys) - y_out%LSSTipMys = y1%LSSTipMys + b * ScaleFactor - b = -(y1%LSSTipMzs - y2%LSSTipMzs) - y_out%LSSTipMzs = y1%LSSTipMzs + b * ScaleFactor - b = -(y1%YawBrMyn - y2%YawBrMyn) - y_out%YawBrMyn = y1%YawBrMyn + b * ScaleFactor - b = -(y1%YawBrMzn - y2%YawBrMzn) - y_out%YawBrMzn = y1%YawBrMzn + b * ScaleFactor - b = -(y1%NcIMURAxs - y2%NcIMURAxs) - y_out%NcIMURAxs = y1%NcIMURAxs + b * ScaleFactor - b = -(y1%NcIMURAys - y2%NcIMURAys) - y_out%NcIMURAys = y1%NcIMURAys + b * ScaleFactor - b = -(y1%NcIMURAzs - y2%NcIMURAzs) - y_out%NcIMURAzs = y1%NcIMURAzs + b * ScaleFactor - b = -(y1%RotPwr - y2%RotPwr) - y_out%RotPwr = y1%RotPwr + b * ScaleFactor - b = -(y1%LSShftFxa - y2%LSShftFxa) - y_out%LSShftFxa = y1%LSShftFxa + b * ScaleFactor - b = -(y1%LSShftFys - y2%LSShftFys) - y_out%LSShftFys = y1%LSShftFys + b * ScaleFactor - b = -(y1%LSShftFzs - y2%LSShftFzs) - y_out%LSShftFzs = y1%LSShftFzs + b * ScaleFactor - END SUBROUTINE ED_Output_ExtrapInterp1 - - - SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN + DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) + CALL MeshExtrapInterp1(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%PlatformPtMesh, y2%PlatformPtMesh, tin, y_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%TowerLn2Mesh, y2%TowerLn2Mesh, tin, y_out%TowerLn2Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%HubPtMotion14, y2%HubPtMotion14, tin, y_out%HubPtMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%HubPtMotion, y2%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%BladeRootMotion14, y2%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN + DO i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) + CALL MeshExtrapInterp1(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%RotorFurlMotion14, y2%RotorFurlMotion14, tin, y_out%RotorFurlMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%NacelleMotion, y2%NacelleMotion, tin, y_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%TowerBaseMotion14, y2%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%TFinCMMotion, y2%TFinCMMotion, tin, y_out%TFinCMMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated + IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN + DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) + CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) + END DO + END IF ! check if allocated + CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, tin, y_out%Yaw, tin_out ) + y_out%YawRate = a1*y1%YawRate + a2*y2%YawRate + y_out%LSS_Spd = a1*y1%LSS_Spd + a2*y2%LSS_Spd + y_out%HSS_Spd = a1*y1%HSS_Spd + a2*y2%HSS_Spd + y_out%RotSpeed = a1*y1%RotSpeed + a2*y2%RotSpeed + y_out%TwrAccel = a1*y1%TwrAccel + a2*y2%TwrAccel + CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, tin, y_out%YawAngle, tin_out ) + y_out%RootMyc = a1*y1%RootMyc + a2*y2%RootMyc + y_out%YawBrTAxp = a1*y1%YawBrTAxp + a2*y2%YawBrTAxp + y_out%YawBrTAyp = a1*y1%YawBrTAyp + a2*y2%YawBrTAyp + CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) + y_out%RootMxc = a1*y1%RootMxc + a2*y2%RootMxc + y_out%LSSTipMxa = a1*y1%LSSTipMxa + a2*y2%LSSTipMxa + y_out%LSSTipMya = a1*y1%LSSTipMya + a2*y2%LSSTipMya + y_out%LSSTipMza = a1*y1%LSSTipMza + a2*y2%LSSTipMza + y_out%LSSTipMys = a1*y1%LSSTipMys + a2*y2%LSSTipMys + y_out%LSSTipMzs = a1*y1%LSSTipMzs + a2*y2%LSSTipMzs + y_out%YawBrMyn = a1*y1%YawBrMyn + a2*y2%YawBrMyn + y_out%YawBrMzn = a1*y1%YawBrMzn + a2*y2%YawBrMzn + y_out%NcIMURAxs = a1*y1%NcIMURAxs + a2*y2%NcIMURAxs + y_out%NcIMURAys = a1*y1%NcIMURAys + a2*y2%NcIMURAys + y_out%NcIMURAzs = a1*y1%NcIMURAzs + a2*y2%NcIMURAzs + y_out%RotPwr = a1*y1%RotPwr + a2*y2%RotPwr + y_out%LSShftFxa = a1*y1%LSShftFxa + a2*y2%LSShftFxa + y_out%LSShftFys = a1*y1%LSShftFys + a2*y2%LSShftFys + y_out%LSShftFzs = a1*y1%LSShftFzs + a2*y2%LSShftFzs +END SUBROUTINE + +SUBROUTINE ED_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. @@ -23275,165 +11436,111 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(ED_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(ED_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(ED_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(ED_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 + TYPE(ED_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(ED_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(ED_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(ED_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 = 'ED_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ED_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 + 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 + 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 + 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%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) - CALL MeshExtrapInterp2(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), y3%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp2(y1%PlatformPtMesh, y2%PlatformPtMesh, y3%PlatformPtMesh, tin, y_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%TowerLn2Mesh, y2%TowerLn2Mesh, y3%TowerLn2Mesh, tin, y_out%TowerLn2Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%HubPtMotion14, y2%HubPtMotion14, y3%HubPtMotion14, tin, y_out%HubPtMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%HubPtMotion, y2%HubPtMotion, y3%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%BladeRootMotion14, y2%BladeRootMotion14, y3%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) - CALL MeshExtrapInterp2(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), y3%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp2(y1%RotorFurlMotion14, y2%RotorFurlMotion14, y3%RotorFurlMotion14, tin, y_out%RotorFurlMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%NacelleMotion, y2%NacelleMotion, y3%NacelleMotion, tin, y_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%TowerBaseMotion14, y2%TowerBaseMotion14, y3%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%TFinCMMotion, y2%TFinCMMotion, y3%TFinCMMotion, tin, y_out%TFinCMMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 -IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) - CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), y3%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) - END DO -END IF ! check if allocated - CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, y3%Yaw, tin, y_out%Yaw, tin_out ) - b = (t(3)**2*(y1%YawRate - y2%YawRate) + t(2)**2*(-y1%YawRate + y3%YawRate))* scaleFactor - c = ( (t(2)-t(3))*y1%YawRate + t(3)*y2%YawRate - t(2)*y3%YawRate ) * scaleFactor - y_out%YawRate = y1%YawRate + b + c * t_out - b = (t(3)**2*(y1%LSS_Spd - y2%LSS_Spd) + t(2)**2*(-y1%LSS_Spd + y3%LSS_Spd))* scaleFactor - c = ( (t(2)-t(3))*y1%LSS_Spd + t(3)*y2%LSS_Spd - t(2)*y3%LSS_Spd ) * scaleFactor - y_out%LSS_Spd = y1%LSS_Spd + b + c * t_out - b = (t(3)**2*(y1%HSS_Spd - y2%HSS_Spd) + t(2)**2*(-y1%HSS_Spd + y3%HSS_Spd))* scaleFactor - c = ( (t(2)-t(3))*y1%HSS_Spd + t(3)*y2%HSS_Spd - t(2)*y3%HSS_Spd ) * scaleFactor - y_out%HSS_Spd = y1%HSS_Spd + b + c * t_out - b = (t(3)**2*(y1%RotSpeed - y2%RotSpeed) + t(2)**2*(-y1%RotSpeed + y3%RotSpeed))* scaleFactor - c = ( (t(2)-t(3))*y1%RotSpeed + t(3)*y2%RotSpeed - t(2)*y3%RotSpeed ) * scaleFactor - y_out%RotSpeed = y1%RotSpeed + b + c * t_out - b = (t(3)**2*(y1%TwrAccel - y2%TwrAccel) + t(2)**2*(-y1%TwrAccel + y3%TwrAccel))* scaleFactor - c = ( (t(2)-t(3))*y1%TwrAccel + t(3)*y2%TwrAccel - t(2)*y3%TwrAccel ) * scaleFactor - y_out%TwrAccel = y1%TwrAccel + b + c * t_out - CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, y3%YawAngle, tin, y_out%YawAngle, tin_out ) - DO i1 = LBOUND(y_out%RootMyc,1),UBOUND(y_out%RootMyc,1) - b = (t(3)**2*(y1%RootMyc(i1) - y2%RootMyc(i1)) + t(2)**2*(-y1%RootMyc(i1) + y3%RootMyc(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%RootMyc(i1) + t(3)*y2%RootMyc(i1) - t(2)*y3%RootMyc(i1) ) * scaleFactor - y_out%RootMyc(i1) = y1%RootMyc(i1) + b + c * t_out - END DO - b = (t(3)**2*(y1%YawBrTAxp - y2%YawBrTAxp) + t(2)**2*(-y1%YawBrTAxp + y3%YawBrTAxp))* scaleFactor - c = ( (t(2)-t(3))*y1%YawBrTAxp + t(3)*y2%YawBrTAxp - t(2)*y3%YawBrTAxp ) * scaleFactor - y_out%YawBrTAxp = y1%YawBrTAxp + b + c * t_out - b = (t(3)**2*(y1%YawBrTAyp - y2%YawBrTAyp) + t(2)**2*(-y1%YawBrTAyp + y3%YawBrTAyp))* scaleFactor - c = ( (t(2)-t(3))*y1%YawBrTAyp + t(3)*y2%YawBrTAyp - t(2)*y3%YawBrTAyp ) * scaleFactor - y_out%YawBrTAyp = y1%YawBrTAyp + b + c * t_out - CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, y3%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) - DO i1 = LBOUND(y_out%RootMxc,1),UBOUND(y_out%RootMxc,1) - b = (t(3)**2*(y1%RootMxc(i1) - y2%RootMxc(i1)) + t(2)**2*(-y1%RootMxc(i1) + y3%RootMxc(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%RootMxc(i1) + t(3)*y2%RootMxc(i1) - t(2)*y3%RootMxc(i1) ) * scaleFactor - y_out%RootMxc(i1) = y1%RootMxc(i1) + b + c * t_out - END DO - b = (t(3)**2*(y1%LSSTipMxa - y2%LSSTipMxa) + t(2)**2*(-y1%LSSTipMxa + y3%LSSTipMxa))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipMxa + t(3)*y2%LSSTipMxa - t(2)*y3%LSSTipMxa ) * scaleFactor - y_out%LSSTipMxa = y1%LSSTipMxa + b + c * t_out - b = (t(3)**2*(y1%LSSTipMya - y2%LSSTipMya) + t(2)**2*(-y1%LSSTipMya + y3%LSSTipMya))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipMya + t(3)*y2%LSSTipMya - t(2)*y3%LSSTipMya ) * scaleFactor - y_out%LSSTipMya = y1%LSSTipMya + b + c * t_out - b = (t(3)**2*(y1%LSSTipMza - y2%LSSTipMza) + t(2)**2*(-y1%LSSTipMza + y3%LSSTipMza))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipMza + t(3)*y2%LSSTipMza - t(2)*y3%LSSTipMza ) * scaleFactor - y_out%LSSTipMza = y1%LSSTipMza + b + c * t_out - b = (t(3)**2*(y1%LSSTipMys - y2%LSSTipMys) + t(2)**2*(-y1%LSSTipMys + y3%LSSTipMys))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipMys + t(3)*y2%LSSTipMys - t(2)*y3%LSSTipMys ) * scaleFactor - y_out%LSSTipMys = y1%LSSTipMys + b + c * t_out - b = (t(3)**2*(y1%LSSTipMzs - y2%LSSTipMzs) + t(2)**2*(-y1%LSSTipMzs + y3%LSSTipMzs))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipMzs + t(3)*y2%LSSTipMzs - t(2)*y3%LSSTipMzs ) * scaleFactor - y_out%LSSTipMzs = y1%LSSTipMzs + b + c * t_out - b = (t(3)**2*(y1%YawBrMyn - y2%YawBrMyn) + t(2)**2*(-y1%YawBrMyn + y3%YawBrMyn))* scaleFactor - c = ( (t(2)-t(3))*y1%YawBrMyn + t(3)*y2%YawBrMyn - t(2)*y3%YawBrMyn ) * scaleFactor - y_out%YawBrMyn = y1%YawBrMyn + b + c * t_out - b = (t(3)**2*(y1%YawBrMzn - y2%YawBrMzn) + t(2)**2*(-y1%YawBrMzn + y3%YawBrMzn))* scaleFactor - c = ( (t(2)-t(3))*y1%YawBrMzn + t(3)*y2%YawBrMzn - t(2)*y3%YawBrMzn ) * scaleFactor - y_out%YawBrMzn = y1%YawBrMzn + b + c * t_out - b = (t(3)**2*(y1%NcIMURAxs - y2%NcIMURAxs) + t(2)**2*(-y1%NcIMURAxs + y3%NcIMURAxs))* scaleFactor - c = ( (t(2)-t(3))*y1%NcIMURAxs + t(3)*y2%NcIMURAxs - t(2)*y3%NcIMURAxs ) * scaleFactor - y_out%NcIMURAxs = y1%NcIMURAxs + b + c * t_out - b = (t(3)**2*(y1%NcIMURAys - y2%NcIMURAys) + t(2)**2*(-y1%NcIMURAys + y3%NcIMURAys))* scaleFactor - c = ( (t(2)-t(3))*y1%NcIMURAys + t(3)*y2%NcIMURAys - t(2)*y3%NcIMURAys ) * scaleFactor - y_out%NcIMURAys = y1%NcIMURAys + b + c * t_out - b = (t(3)**2*(y1%NcIMURAzs - y2%NcIMURAzs) + t(2)**2*(-y1%NcIMURAzs + y3%NcIMURAzs))* scaleFactor - c = ( (t(2)-t(3))*y1%NcIMURAzs + t(3)*y2%NcIMURAzs - t(2)*y3%NcIMURAzs ) * scaleFactor - y_out%NcIMURAzs = y1%NcIMURAzs + b + c * t_out - b = (t(3)**2*(y1%RotPwr - y2%RotPwr) + t(2)**2*(-y1%RotPwr + y3%RotPwr))* scaleFactor - c = ( (t(2)-t(3))*y1%RotPwr + t(3)*y2%RotPwr - t(2)*y3%RotPwr ) * scaleFactor - y_out%RotPwr = y1%RotPwr + b + c * t_out - b = (t(3)**2*(y1%LSShftFxa - y2%LSShftFxa) + t(2)**2*(-y1%LSShftFxa + y3%LSShftFxa))* scaleFactor - c = ( (t(2)-t(3))*y1%LSShftFxa + t(3)*y2%LSShftFxa - t(2)*y3%LSShftFxa ) * scaleFactor - y_out%LSShftFxa = y1%LSShftFxa + b + c * t_out - b = (t(3)**2*(y1%LSShftFys - y2%LSShftFys) + t(2)**2*(-y1%LSShftFys + y3%LSShftFys))* scaleFactor - c = ( (t(2)-t(3))*y1%LSShftFys + t(3)*y2%LSShftFys - t(2)*y3%LSShftFys ) * scaleFactor - y_out%LSShftFys = y1%LSShftFys + b + c * t_out - b = (t(3)**2*(y1%LSShftFzs - y2%LSShftFzs) + t(2)**2*(-y1%LSShftFzs + y3%LSShftFzs))* scaleFactor - c = ( (t(2)-t(3))*y1%LSShftFzs + t(3)*y2%LSShftFzs - t(2)*y3%LSShftFzs ) * scaleFactor - y_out%LSShftFzs = y1%LSShftFzs + b + c * t_out - END SUBROUTINE ED_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN + DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) + CALL MeshExtrapInterp2(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), y3%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%PlatformPtMesh, y2%PlatformPtMesh, y3%PlatformPtMesh, tin, y_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%TowerLn2Mesh, y2%TowerLn2Mesh, y3%TowerLn2Mesh, tin, y_out%TowerLn2Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%HubPtMotion14, y2%HubPtMotion14, y3%HubPtMotion14, tin, y_out%HubPtMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%HubPtMotion, y2%HubPtMotion, y3%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%BladeRootMotion14, y2%BladeRootMotion14, y3%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN + DO i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) + CALL MeshExtrapInterp2(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), y3%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%RotorFurlMotion14, y2%RotorFurlMotion14, y3%RotorFurlMotion14, tin, y_out%RotorFurlMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%NacelleMotion, y2%NacelleMotion, y3%NacelleMotion, tin, y_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%TowerBaseMotion14, y2%TowerBaseMotion14, y3%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%TFinCMMotion, y2%TFinCMMotion, y3%TFinCMMotion, tin, y_out%TFinCMMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated + IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN + DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) + CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), y3%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) + END DO + END IF ! check if allocated + CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, y3%Yaw, tin, y_out%Yaw, tin_out ) + y_out%YawRate = a1*y1%YawRate + a2*y2%YawRate + a3*y3%YawRate + y_out%LSS_Spd = a1*y1%LSS_Spd + a2*y2%LSS_Spd + a3*y3%LSS_Spd + y_out%HSS_Spd = a1*y1%HSS_Spd + a2*y2%HSS_Spd + a3*y3%HSS_Spd + y_out%RotSpeed = a1*y1%RotSpeed + a2*y2%RotSpeed + a3*y3%RotSpeed + y_out%TwrAccel = a1*y1%TwrAccel + a2*y2%TwrAccel + a3*y3%TwrAccel + CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, y3%YawAngle, tin, y_out%YawAngle, tin_out ) + y_out%RootMyc = a1*y1%RootMyc + a2*y2%RootMyc + a3*y3%RootMyc + y_out%YawBrTAxp = a1*y1%YawBrTAxp + a2*y2%YawBrTAxp + a3*y3%YawBrTAxp + y_out%YawBrTAyp = a1*y1%YawBrTAyp + a2*y2%YawBrTAyp + a3*y3%YawBrTAyp + CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, y3%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) + y_out%RootMxc = a1*y1%RootMxc + a2*y2%RootMxc + a3*y3%RootMxc + y_out%LSSTipMxa = a1*y1%LSSTipMxa + a2*y2%LSSTipMxa + a3*y3%LSSTipMxa + y_out%LSSTipMya = a1*y1%LSSTipMya + a2*y2%LSSTipMya + a3*y3%LSSTipMya + y_out%LSSTipMza = a1*y1%LSSTipMza + a2*y2%LSSTipMza + a3*y3%LSSTipMza + y_out%LSSTipMys = a1*y1%LSSTipMys + a2*y2%LSSTipMys + a3*y3%LSSTipMys + y_out%LSSTipMzs = a1*y1%LSSTipMzs + a2*y2%LSSTipMzs + a3*y3%LSSTipMzs + y_out%YawBrMyn = a1*y1%YawBrMyn + a2*y2%YawBrMyn + a3*y3%YawBrMyn + y_out%YawBrMzn = a1*y1%YawBrMzn + a2*y2%YawBrMzn + a3*y3%YawBrMzn + y_out%NcIMURAxs = a1*y1%NcIMURAxs + a2*y2%NcIMURAxs + a3*y3%NcIMURAxs + y_out%NcIMURAys = a1*y1%NcIMURAys + a2*y2%NcIMURAys + a3*y3%NcIMURAys + y_out%NcIMURAzs = a1*y1%NcIMURAzs + a2*y2%NcIMURAzs + a3*y3%NcIMURAzs + y_out%RotPwr = a1*y1%RotPwr + a2*y2%RotPwr + a3*y3%RotPwr + y_out%LSShftFxa = a1*y1%LSShftFxa + a2*y2%LSShftFxa + a3*y3%LSShftFxa + y_out%LSShftFys = a1*y1%LSShftFys + a2*y2%LSShftFys + a3*y3%LSShftFys + y_out%LSShftFzs = a1*y1%LSShftFzs + a2*y2%LSShftFzs + a3*y3%LSShftFzs +END SUBROUTINE END MODULE ElastoDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 6a6332cdb3..ce08cab5c0 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -37,27 +37,27 @@ MODULE ExtPtfm_MCKF_Types TYPE, PUBLIC :: ExtPtfm_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - REAL(ReKi) :: PtfmRefzt !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [meters] + REAL(ReKi) :: PtfmRefzt = 0.0_ReKi !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [meters] CHARACTER(1024) :: RootName !< RootName for writing output files [-] END TYPE ExtPtfm_InitInputType ! ======================= ! ========= ExtPtfm_InputFile ======= TYPE, PUBLIC :: ExtPtfm_InputFile - REAL(DbKi) :: DT !< Requested integration time for ElastoDyn [seconds] - INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4) [-] - INTEGER(IntKi) :: FileFormat !< File format switch [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Requested integration time for ElastoDyn [seconds] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1=RK4, 2=AB4, 3=ABM4) [-] + INTEGER(IntKi) :: FileFormat = 0_IntKi !< File format switch [-] CHARACTER(1024) :: RedFile !< File containing reduction inputs [-] CHARACTER(1024) :: RedFileCst !< File containing constant reduction inputs [-] - LOGICAL :: EquilStart !< Flag to determine the equilibrium positions of the CB modes at initialization (first call) [-] + LOGICAL :: EquilStart = .false. !< Flag to determine the equilibrium positions of the CB modes at initialization (first call) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ActiveCBDOF !< List of active CB DOF [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: InitPosList !< Initial positions of the CB DOFs [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: InitVelList !< Initial velocities of the CB DOFs [-] - LOGICAL :: SumPrint !< Print summary data to .sum [-] - INTEGER(IntKi) :: OutFile !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] - LOGICAL :: TabDelim !< Flag to cause tab-delimited text output (delimited by space otherwise) [-] + LOGICAL :: SumPrint = .false. !< Print summary data to .sum [-] + INTEGER(IntKi) :: OutFile = 0_IntKi !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] + LOGICAL :: TabDelim = .false. !< Flag to cause tab-delimited text output (delimited by space otherwise) [-] CHARACTER(20) :: OutFmt !< Format used for module's text tabular output (except time); resulting field should be 10 characters [-] - REAL(DbKi) :: Tstart !< Time to start module's tabular output [seconds] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [seconds] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] END TYPE ExtPtfm_InputFile ! ======================= @@ -84,27 +84,27 @@ MODULE ExtPtfm_MCKF_Types ! ======================= ! ========= ExtPtfm_DiscreteStateType ======= TYPE, PUBLIC :: ExtPtfm_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE ExtPtfm_DiscreteStateType ! ======================= ! ========= ExtPtfm_ConstraintStateType ======= TYPE, PUBLIC :: ExtPtfm_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE ExtPtfm_ConstraintStateType ! ======================= ! ========= ExtPtfm_OtherStateType ======= TYPE, PUBLIC :: ExtPtfm_OtherStateType TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: xdot !< Previous state derivs for m-step time integrator [-] - INTEGER(IntKi) :: n !< Tracks time step for which OtherState was updated last [-] + INTEGER(IntKi) :: n = 0_IntKi !< Tracks time step for which OtherState was updated last [-] END TYPE ExtPtfm_OtherStateType ! ======================= ! ========= ExtPtfm_MiscVarType ======= TYPE, PUBLIC :: ExtPtfm_MiscVarType REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xFlat !< Flattened vector of states [-] - REAL(ReKi) , DIMENSION(1:18) :: uFlat !< Flattened vector of inputs [-] + REAL(ReKi) , DIMENSION(1:18) :: uFlat = 0.0_ReKi !< Flattened vector of inputs [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_at_t !< The 6 interface loads and Craig-Bampton loads at t (force and moment acting at the platform reference (no added-mass effects); positive forces are in the direction of motion). [N, N-m] - INTEGER(IntKi) :: Indx !< Index into times, to speed up interpolation [-] - LOGICAL :: EquilStart !< Flag to determine the equilibrium position of the CB DOF at initialization (first call) [-] + INTEGER(IntKi) :: Indx = 0_IntKi !< Index into times, to speed up interpolation [-] + LOGICAL :: EquilStart = .false. !< Flag to determine the equilibrium position of the CB DOF at initialization (first call) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] END TYPE ExtPtfm_MiscVarType ! ======================= @@ -131,13 +131,13 @@ MODULE ExtPtfm_MCKF_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C12 !< Matrix C12 [] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C22 !< Matrix C22 [] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C21 !< Matrix C21 [] - REAL(DbKi) :: EP_DeltaT !< Time step (for integration of continuous states) [seconds] - INTEGER(IntKi) :: nTimeSteps !< Number of values of Forces and times [-] - INTEGER(IntKi) :: nCB !< Number of CraigBampton modes active [-] - INTEGER(IntKi) :: nCBFull !< Totla number of CraigBampton modes given as input [-] - INTEGER(IntKi) :: nTot !< Total number of debrees of freedom (CB + interface) [-] - INTEGER(IntKi) :: NumOuts !< Number of values in WriteOutput [-] - INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4) [-] + REAL(DbKi) :: EP_DeltaT = 0.0_R8Ki !< Time step (for integration of continuous states) [seconds] + INTEGER(IntKi) :: nTimeSteps = 0_IntKi !< Number of values of Forces and times [-] + INTEGER(IntKi) :: nCB = 0_IntKi !< Number of CraigBampton modes active [-] + INTEGER(IntKi) :: nCBFull = 0_IntKi !< Totla number of CraigBampton modes given as input [-] + INTEGER(IntKi) :: nTot = 0_IntKi !< Total number of debrees of freedom (CB + interface) [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of values in WriteOutput [-] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1=RK4, 2=AB4, 3=ABM4) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ActiveCBDOF !< List of active CB DOF [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutParamLinIndx !< Index into WriteOutput for linearization analysis [-] @@ -155,4720 +155,2205 @@ MODULE ExtPtfm_MCKF_Types END TYPE ExtPtfm_OutputType ! ======================= CONTAINS - SUBROUTINE ExtPtfm_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(ExtPtfm_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt - DstInitInputData%RootName = SrcInitInputData%RootName - END SUBROUTINE ExtPtfm_CopyInitInput - - SUBROUTINE ExtPtfm_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_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 = 'ExtPtfm_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE ExtPtfm_DestroyInitInput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ! Linearize - Re_BufSz = Re_BufSz + 1 ! PtfmRefzt - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE ExtPtfm_PackInitInput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_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%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmRefzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE ExtPtfm_UnPackInitInput - SUBROUTINE ExtPtfm_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(ExtPtfm_InputFile), INTENT(INOUT) :: DstInputFileData - 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 = 'ExtPtfm_CopyInputFile' -! +subroutine ExtPtfm_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_InitInputType), intent(in) :: SrcInitInputData + type(ExtPtfm_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DT = SrcInputFileData%DT - DstInputFileData%IntMethod = SrcInputFileData%IntMethod - DstInputFileData%FileFormat = SrcInputFileData%FileFormat - DstInputFileData%RedFile = SrcInputFileData%RedFile - DstInputFileData%RedFileCst = SrcInputFileData%RedFileCst - DstInputFileData%EquilStart = SrcInputFileData%EquilStart -IF (ALLOCATED(SrcInputFileData%ActiveCBDOF)) THEN - i1_l = LBOUND(SrcInputFileData%ActiveCBDOF,1) - i1_u = UBOUND(SrcInputFileData%ActiveCBDOF,1) - IF (.NOT. ALLOCATED(DstInputFileData%ActiveCBDOF)) THEN - ALLOCATE(DstInputFileData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ActiveCBDOF = SrcInputFileData%ActiveCBDOF -ENDIF -IF (ALLOCATED(SrcInputFileData%InitPosList)) THEN - i1_l = LBOUND(SrcInputFileData%InitPosList,1) - i1_u = UBOUND(SrcInputFileData%InitPosList,1) - IF (.NOT. ALLOCATED(DstInputFileData%InitPosList)) THEN - ALLOCATE(DstInputFileData%InitPosList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InitPosList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%InitPosList = SrcInputFileData%InitPosList -ENDIF -IF (ALLOCATED(SrcInputFileData%InitVelList)) THEN - i1_l = LBOUND(SrcInputFileData%InitVelList,1) - i1_u = UBOUND(SrcInputFileData%InitVelList,1) - IF (.NOT. ALLOCATED(DstInputFileData%InitVelList)) THEN - ALLOCATE(DstInputFileData%InitVelList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InitVelList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%InitVelList = SrcInputFileData%InitVelList -ENDIF - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%OutFile = SrcInputFileData%OutFile - DstInputFileData%TabDelim = SrcInputFileData%TabDelim - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%Tstart = SrcInputFileData%Tstart - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - END SUBROUTINE ExtPtfm_CopyInputFile - - SUBROUTINE ExtPtfm_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InputFile), INTENT(INOUT) :: InputFileData - 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 = 'ExtPtfm_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%ActiveCBDOF)) THEN - DEALLOCATE(InputFileData%ActiveCBDOF) -ENDIF -IF (ALLOCATED(InputFileData%InitPosList)) THEN - DEALLOCATE(InputFileData%InitPosList) -ENDIF -IF (ALLOCATED(InputFileData%InitVelList)) THEN - DEALLOCATE(InputFileData%InitVelList) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF - END SUBROUTINE ExtPtfm_DestroyInputFile - - SUBROUTINE ExtPtfm_PackInputFile( 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(ExtPtfm_InputFile), 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 = 'ExtPtfm_PackInputFile' - ! 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 ! IntMethod - Int_BufSz = Int_BufSz + 1 ! FileFormat - Int_BufSz = Int_BufSz + 1*LEN(InData%RedFile) ! RedFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RedFileCst) ! RedFileCst - Int_BufSz = Int_BufSz + 1 ! EquilStart - Int_BufSz = Int_BufSz + 1 ! ActiveCBDOF allocated yes/no - IF ( ALLOCATED(InData%ActiveCBDOF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ActiveCBDOF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ActiveCBDOF) ! ActiveCBDOF - END IF - Int_BufSz = Int_BufSz + 1 ! InitPosList allocated yes/no - IF ( ALLOCATED(InData%InitPosList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InitPosList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitPosList) ! InitPosList - END IF - Int_BufSz = Int_BufSz + 1 ! InitVelList allocated yes/no - IF ( ALLOCATED(InData%InitVelList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InitVelList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitVelList) ! InitVelList - END IF - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! OutFile - Int_BufSz = Int_BufSz + 1 ! TabDelim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Db_BufSz = Db_BufSz + 1 ! Tstart - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - 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 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FileFormat - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RedFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%RedFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RedFileCst) - IntKiBuf(Int_Xferred) = ICHAR(InData%RedFileCst(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilStart, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ActiveCBDOF) ) 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%ActiveCBDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActiveCBDOF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ActiveCBDOF,1), UBOUND(InData%ActiveCBDOF,1) - IntKiBuf(Int_Xferred) = InData%ActiveCBDOF(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitPosList) ) 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%InitPosList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitPosList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InitPosList,1), UBOUND(InData%InitPosList,1) - ReKiBuf(Re_Xferred) = InData%InitPosList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitVelList) ) 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%InitVelList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitVelList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InitVelList,1), UBOUND(InData%InitVelList,1) - ReKiBuf(Re_Xferred) = InData%InitVelList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) - 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 - DbKiBuf(Db_Xferred) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) 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%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - 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 - END IF - END SUBROUTINE ExtPtfm_PackInputFile - - SUBROUTINE ExtPtfm_UnPackInputFile( 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(ExtPtfm_InputFile), 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 = 'ExtPtfm_UnPackInputFile' - ! 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%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FileFormat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RedFile) - OutData%RedFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RedFileCst) - OutData%RedFileCst(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%EquilStart = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilStart) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActiveCBDOF 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%ActiveCBDOF)) DEALLOCATE(OutData%ActiveCBDOF) - ALLOCATE(OutData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ActiveCBDOF,1), UBOUND(OutData%ActiveCBDOF,1) - OutData%ActiveCBDOF(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitPosList 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%InitPosList)) DEALLOCATE(OutData%InitPosList) - ALLOCATE(OutData%InitPosList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitPosList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InitPosList,1), UBOUND(OutData%InitPosList,1) - OutData%InitPosList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitVelList 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%InitVelList)) DEALLOCATE(OutData%InitVelList) - ALLOCATE(OutData%InitVelList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitVelList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InitVelList,1), UBOUND(OutData%InitVelList,1) - OutData%InitVelList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) - 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 - OutData%Tstart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 - END SUBROUTINE ExtPtfm_UnPackInputFile - - SUBROUTINE ExtPtfm_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyInitOutput' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt + DstInitInputData%RootName = SrcInitInputData%RootName +end subroutine + +subroutine ExtPtfm_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(ExtPtfm_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -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%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN - ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF - END SUBROUTINE ExtPtfm_CopyInitOutput - - SUBROUTINE ExtPtfm_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_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 = 'ExtPtfm_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN - DEALLOCATE(InitOutputData%RotFrame_x) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF - END SUBROUTINE ExtPtfm_DestroyInitOutput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - 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 - - 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 - - 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 - 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%LinNames_y) ) 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%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) 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%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) 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%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) 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%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) 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%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) 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%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) 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%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) 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%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_PackInitOutput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 - 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) - 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 ! LinNames_y 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%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(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 ! LinNames_x 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%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(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 ! LinNames_u 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%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(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 ! RotFrame_y 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%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x 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%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u 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%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u 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%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x 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%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_UnPackInitOutput - - SUBROUTINE ExtPtfm_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(ExtPtfm_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyContState' -! + ErrMsg = '' +end subroutine + +subroutine ExtPtfm_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%Linearize) + call RegPack(Buf, InData%PtfmRefzt) + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_InputFile), intent(in) :: SrcInputFileData + type(ExtPtfm_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%qm)) THEN - i1_l = LBOUND(SrcContStateData%qm,1) - i1_u = UBOUND(SrcContStateData%qm,1) - IF (.NOT. ALLOCATED(DstContStateData%qm)) THEN - ALLOCATE(DstContStateData%qm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%qm = SrcContStateData%qm -ENDIF -IF (ALLOCATED(SrcContStateData%qmdot)) THEN - i1_l = LBOUND(SrcContStateData%qmdot,1) - i1_u = UBOUND(SrcContStateData%qmdot,1) - IF (.NOT. ALLOCATED(DstContStateData%qmdot)) THEN - ALLOCATE(DstContStateData%qmdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qmdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%qmdot = SrcContStateData%qmdot -ENDIF - END SUBROUTINE ExtPtfm_CopyContState - - SUBROUTINE ExtPtfm_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_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 = 'ExtPtfm_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%qm)) THEN - DEALLOCATE(ContStateData%qm) -ENDIF -IF (ALLOCATED(ContStateData%qmdot)) THEN - DEALLOCATE(ContStateData%qmdot) -ENDIF - END SUBROUTINE ExtPtfm_DestroyContState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 - Int_BufSz = Int_BufSz + 1 ! qm allocated yes/no - IF ( ALLOCATED(InData%qm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%qm) ! qm - END IF - Int_BufSz = Int_BufSz + 1 ! qmdot allocated yes/no - IF ( ALLOCATED(InData%qmdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qmdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%qmdot) ! qmdot - 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%qm) ) 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%qm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qm,1), UBOUND(InData%qm,1) - ReKiBuf(Re_Xferred) = InData%qm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%qmdot) ) 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%qmdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qmdot,1), UBOUND(InData%qmdot,1) - ReKiBuf(Re_Xferred) = InData%qmdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_PackContState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qm 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%qm)) DEALLOCATE(OutData%qm) - ALLOCATE(OutData%qm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qm,1), UBOUND(OutData%qm,1) - OutData%qm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdot 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%qmdot)) DEALLOCATE(OutData%qmdot) - ALLOCATE(OutData%qmdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qmdot,1), UBOUND(OutData%qmdot,1) - OutData%qmdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_UnPackContState - - SUBROUTINE ExtPtfm_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyDiscState' -! + ErrMsg = '' + DstInputFileData%DT = SrcInputFileData%DT + DstInputFileData%IntMethod = SrcInputFileData%IntMethod + DstInputFileData%FileFormat = SrcInputFileData%FileFormat + DstInputFileData%RedFile = SrcInputFileData%RedFile + DstInputFileData%RedFileCst = SrcInputFileData%RedFileCst + DstInputFileData%EquilStart = SrcInputFileData%EquilStart + if (allocated(SrcInputFileData%ActiveCBDOF)) then + LB(1:1) = lbound(SrcInputFileData%ActiveCBDOF) + UB(1:1) = ubound(SrcInputFileData%ActiveCBDOF) + if (.not. allocated(DstInputFileData%ActiveCBDOF)) then + allocate(DstInputFileData%ActiveCBDOF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ActiveCBDOF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ActiveCBDOF = SrcInputFileData%ActiveCBDOF + end if + if (allocated(SrcInputFileData%InitPosList)) then + LB(1:1) = lbound(SrcInputFileData%InitPosList) + UB(1:1) = ubound(SrcInputFileData%InitPosList) + if (.not. allocated(DstInputFileData%InitPosList)) then + allocate(DstInputFileData%InitPosList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InitPosList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%InitPosList = SrcInputFileData%InitPosList + end if + if (allocated(SrcInputFileData%InitVelList)) then + LB(1:1) = lbound(SrcInputFileData%InitVelList) + UB(1:1) = ubound(SrcInputFileData%InitVelList) + if (.not. allocated(DstInputFileData%InitVelList)) then + allocate(DstInputFileData%InitVelList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InitVelList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%InitVelList = SrcInputFileData%InitVelList + end if + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%OutFile = SrcInputFileData%OutFile + DstInputFileData%TabDelim = SrcInputFileData%TabDelim + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%Tstart = SrcInputFileData%Tstart + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + end if +end subroutine + +subroutine ExtPtfm_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(ExtPtfm_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE ExtPtfm_CopyDiscState - - SUBROUTINE ExtPtfm_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_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 = 'ExtPtfm_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE ExtPtfm_DestroyDiscState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_PackDiscState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ExtPtfm_UnPackDiscState - - SUBROUTINE ExtPtfm_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyConstrState' -! + ErrMsg = '' + if (allocated(InputFileData%ActiveCBDOF)) then + deallocate(InputFileData%ActiveCBDOF) + end if + if (allocated(InputFileData%InitPosList)) then + deallocate(InputFileData%InitPosList) + end if + if (allocated(InputFileData%InitVelList)) then + deallocate(InputFileData%InitVelList) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if +end subroutine + +subroutine ExtPtfm_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%IntMethod) + call RegPack(Buf, InData%FileFormat) + call RegPack(Buf, InData%RedFile) + call RegPack(Buf, InData%RedFileCst) + call RegPack(Buf, InData%EquilStart) + call RegPack(Buf, allocated(InData%ActiveCBDOF)) + if (allocated(InData%ActiveCBDOF)) then + call RegPackBounds(Buf, 1, lbound(InData%ActiveCBDOF), ubound(InData%ActiveCBDOF)) + call RegPack(Buf, InData%ActiveCBDOF) + end if + call RegPack(Buf, allocated(InData%InitPosList)) + if (allocated(InData%InitPosList)) then + call RegPackBounds(Buf, 1, lbound(InData%InitPosList), ubound(InData%InitPosList)) + call RegPack(Buf, InData%InitPosList) + end if + call RegPack(Buf, allocated(InData%InitVelList)) + if (allocated(InData%InitVelList)) then + call RegPackBounds(Buf, 1, lbound(InData%InitVelList), ubound(InData%InitVelList)) + call RegPack(Buf, InData%InitVelList) + end if + call RegPack(Buf, InData%SumPrint) + call RegPack(Buf, InData%OutFile) + call RegPack(Buf, InData%TabDelim) + call RegPack(Buf, InData%OutFmt) + call RegPack(Buf, InData%Tstart) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInputFile' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IntMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FileFormat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RedFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RedFileCst) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EquilStart) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ActiveCBDOF)) deallocate(OutData%ActiveCBDOF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ActiveCBDOF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ActiveCBDOF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%InitPosList)) deallocate(OutData%InitPosList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitPosList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitPosList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitPosList) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%InitVelList)) deallocate(OutData%InitVelList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitVelList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitVelList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitVelList) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TabDelim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Tstart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_InitOutputType), intent(in) :: SrcInitOutputData + type(ExtPtfm_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE ExtPtfm_CopyConstrState - - SUBROUTINE ExtPtfm_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_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 = 'ExtPtfm_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE ExtPtfm_DestroyConstrState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_PackConstrState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ExtPtfm_UnPackConstrState - - SUBROUTINE ExtPtfm_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(ExtPtfm_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyOtherState' -! + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x + end if +end subroutine + +subroutine ExtPtfm_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(ExtPtfm_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%xdot)) THEN - i1_l = LBOUND(SrcOtherStateData%xdot,1) - i1_u = UBOUND(SrcOtherStateData%xdot,1) - IF (.NOT. ALLOCATED(DstOtherStateData%xdot)) THEN - ALLOCATE(DstOtherStateData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL ExtPtfm_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstOtherStateData%n = SrcOtherStateData%n - END SUBROUTINE ExtPtfm_CopyOtherState - - SUBROUTINE ExtPtfm_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_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 = 'ExtPtfm_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%xdot)) THEN -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL ExtPtfm_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%xdot) -ENDIF - END SUBROUTINE ExtPtfm_DestroyOtherState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ! xdot allocated yes/no - IF ( ALLOCATED(InData%xdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xdot upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! n - 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%xdot) ) 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%xdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - 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%n - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ExtPtfm_PackOtherState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdot 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%xdot)) DEALLOCATE(OutData%xdot) - ALLOCATE(OutData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,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 ExtPtfm_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - 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%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ExtPtfm_UnPackOtherState - - SUBROUTINE ExtPtfm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(ExtPtfm_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyMisc' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if +end subroutine + +subroutine ExtPtfm_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine ExtPtfm_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_ContinuousStateType), intent(in) :: SrcContStateData + type(ExtPtfm_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%xFlat)) THEN - i1_l = LBOUND(SrcMiscData%xFlat,1) - i1_u = UBOUND(SrcMiscData%xFlat,1) - IF (.NOT. ALLOCATED(DstMiscData%xFlat)) THEN - ALLOCATE(DstMiscData%xFlat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xFlat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%xFlat = SrcMiscData%xFlat -ENDIF - DstMiscData%uFlat = SrcMiscData%uFlat -IF (ALLOCATED(SrcMiscData%F_at_t)) THEN - i1_l = LBOUND(SrcMiscData%F_at_t,1) - i1_u = UBOUND(SrcMiscData%F_at_t,1) - IF (.NOT. ALLOCATED(DstMiscData%F_at_t)) THEN - ALLOCATE(DstMiscData%F_at_t(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_at_t.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_at_t = SrcMiscData%F_at_t -ENDIF - DstMiscData%Indx = SrcMiscData%Indx - DstMiscData%EquilStart = SrcMiscData%EquilStart -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF - END SUBROUTINE ExtPtfm_CopyMisc - - SUBROUTINE ExtPtfm_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_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 = 'ExtPtfm_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%xFlat)) THEN - DEALLOCATE(MiscData%xFlat) -ENDIF -IF (ALLOCATED(MiscData%F_at_t)) THEN - DEALLOCATE(MiscData%F_at_t) -ENDIF -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF - END SUBROUTINE ExtPtfm_DestroyMisc - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ! xFlat allocated yes/no - IF ( ALLOCATED(InData%xFlat) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xFlat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xFlat) ! xFlat - END IF - Re_BufSz = Re_BufSz + SIZE(InData%uFlat) ! uFlat - Int_BufSz = Int_BufSz + 1 ! F_at_t allocated yes/no - IF ( ALLOCATED(InData%F_at_t) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_at_t upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_at_t) ! F_at_t - END IF - Int_BufSz = Int_BufSz + 1 ! Indx - Int_BufSz = Int_BufSz + 1 ! EquilStart - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - 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%xFlat) ) 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%xFlat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xFlat,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xFlat,1), UBOUND(InData%xFlat,1) - ReKiBuf(Re_Xferred) = InData%xFlat(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%uFlat,1), UBOUND(InData%uFlat,1) - ReKiBuf(Re_Xferred) = InData%uFlat(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%F_at_t) ) 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%F_at_t,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_at_t,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_at_t,1), UBOUND(InData%F_at_t,1) - ReKiBuf(Re_Xferred) = InData%F_at_t(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilStart, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AllOuts) ) 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%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_PackMisc - - SUBROUTINE ExtPtfm_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(ExtPtfm_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xFlat 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%xFlat)) DEALLOCATE(OutData%xFlat) - ALLOCATE(OutData%xFlat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xFlat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xFlat,1), UBOUND(OutData%xFlat,1) - OutData%xFlat(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%uFlat,1) - i1_u = UBOUND(OutData%uFlat,1) - DO i1 = LBOUND(OutData%uFlat,1), UBOUND(OutData%uFlat,1) - OutData%uFlat(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_at_t 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%F_at_t)) DEALLOCATE(OutData%F_at_t) - ALLOCATE(OutData%F_at_t(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_at_t.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_at_t,1), UBOUND(OutData%F_at_t,1) - OutData%F_at_t(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%EquilStart = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilStart) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts 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%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_UnPackMisc - - SUBROUTINE ExtPtfm_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ParameterType), INTENT(IN) :: SrcParamData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyParam' -! + ErrMsg = '' + if (allocated(SrcContStateData%qm)) then + LB(1:1) = lbound(SrcContStateData%qm) + UB(1:1) = ubound(SrcContStateData%qm) + if (.not. allocated(DstContStateData%qm)) then + allocate(DstContStateData%qm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%qm = SrcContStateData%qm + end if + if (allocated(SrcContStateData%qmdot)) then + LB(1:1) = lbound(SrcContStateData%qmdot) + UB(1:1) = ubound(SrcContStateData%qmdot) + if (.not. allocated(DstContStateData%qmdot)) then + allocate(DstContStateData%qmdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qmdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%qmdot = SrcContStateData%qmdot + end if +end subroutine + +subroutine ExtPtfm_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(ExtPtfm_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcParamData%Mass)) THEN - i1_l = LBOUND(SrcParamData%Mass,1) - i1_u = UBOUND(SrcParamData%Mass,1) - i2_l = LBOUND(SrcParamData%Mass,2) - i2_u = UBOUND(SrcParamData%Mass,2) - IF (.NOT. ALLOCATED(DstParamData%Mass)) THEN - ALLOCATE(DstParamData%Mass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Mass = SrcParamData%Mass -ENDIF -IF (ALLOCATED(SrcParamData%Damp)) THEN - i1_l = LBOUND(SrcParamData%Damp,1) - i1_u = UBOUND(SrcParamData%Damp,1) - i2_l = LBOUND(SrcParamData%Damp,2) - i2_u = UBOUND(SrcParamData%Damp,2) - IF (.NOT. ALLOCATED(DstParamData%Damp)) THEN - ALLOCATE(DstParamData%Damp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Damp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Damp = SrcParamData%Damp -ENDIF -IF (ALLOCATED(SrcParamData%Stff)) THEN - i1_l = LBOUND(SrcParamData%Stff,1) - i1_u = UBOUND(SrcParamData%Stff,1) - i2_l = LBOUND(SrcParamData%Stff,2) - i2_u = UBOUND(SrcParamData%Stff,2) - IF (.NOT. ALLOCATED(DstParamData%Stff)) THEN - ALLOCATE(DstParamData%Stff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Stff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Stff = SrcParamData%Stff -ENDIF -IF (ALLOCATED(SrcParamData%Forces)) THEN - i1_l = LBOUND(SrcParamData%Forces,1) - i1_u = UBOUND(SrcParamData%Forces,1) - i2_l = LBOUND(SrcParamData%Forces,2) - i2_u = UBOUND(SrcParamData%Forces,2) - IF (.NOT. ALLOCATED(DstParamData%Forces)) THEN - ALLOCATE(DstParamData%Forces(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Forces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Forces = SrcParamData%Forces -ENDIF -IF (ALLOCATED(SrcParamData%times)) THEN - i1_l = LBOUND(SrcParamData%times,1) - i1_u = UBOUND(SrcParamData%times,1) - IF (.NOT. ALLOCATED(DstParamData%times)) THEN - ALLOCATE(DstParamData%times(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%times.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%times = SrcParamData%times -ENDIF -IF (ALLOCATED(SrcParamData%AMat)) THEN - i1_l = LBOUND(SrcParamData%AMat,1) - i1_u = UBOUND(SrcParamData%AMat,1) - i2_l = LBOUND(SrcParamData%AMat,2) - i2_u = UBOUND(SrcParamData%AMat,2) - IF (.NOT. ALLOCATED(DstParamData%AMat)) THEN - ALLOCATE(DstParamData%AMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AMat = SrcParamData%AMat -ENDIF -IF (ALLOCATED(SrcParamData%BMat)) THEN - i1_l = LBOUND(SrcParamData%BMat,1) - i1_u = UBOUND(SrcParamData%BMat,1) - i2_l = LBOUND(SrcParamData%BMat,2) - i2_u = UBOUND(SrcParamData%BMat,2) - IF (.NOT. ALLOCATED(DstParamData%BMat)) THEN - ALLOCATE(DstParamData%BMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BMat = SrcParamData%BMat -ENDIF -IF (ALLOCATED(SrcParamData%CMat)) THEN - i1_l = LBOUND(SrcParamData%CMat,1) - i1_u = UBOUND(SrcParamData%CMat,1) - i2_l = LBOUND(SrcParamData%CMat,2) - i2_u = UBOUND(SrcParamData%CMat,2) - IF (.NOT. ALLOCATED(DstParamData%CMat)) THEN - ALLOCATE(DstParamData%CMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CMat = SrcParamData%CMat -ENDIF -IF (ALLOCATED(SrcParamData%DMat)) THEN - i1_l = LBOUND(SrcParamData%DMat,1) - i1_u = UBOUND(SrcParamData%DMat,1) - i2_l = LBOUND(SrcParamData%DMat,2) - i2_u = UBOUND(SrcParamData%DMat,2) - IF (.NOT. ALLOCATED(DstParamData%DMat)) THEN - ALLOCATE(DstParamData%DMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DMat = SrcParamData%DMat -ENDIF -IF (ALLOCATED(SrcParamData%FX)) THEN - i1_l = LBOUND(SrcParamData%FX,1) - i1_u = UBOUND(SrcParamData%FX,1) - IF (.NOT. ALLOCATED(DstParamData%FX)) THEN - ALLOCATE(DstParamData%FX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FX = SrcParamData%FX -ENDIF -IF (ALLOCATED(SrcParamData%FY)) THEN - i1_l = LBOUND(SrcParamData%FY,1) - i1_u = UBOUND(SrcParamData%FY,1) - IF (.NOT. ALLOCATED(DstParamData%FY)) THEN - ALLOCATE(DstParamData%FY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FY = SrcParamData%FY -ENDIF -IF (ALLOCATED(SrcParamData%M11)) THEN - i1_l = LBOUND(SrcParamData%M11,1) - i1_u = UBOUND(SrcParamData%M11,1) - i2_l = LBOUND(SrcParamData%M11,2) - i2_u = UBOUND(SrcParamData%M11,2) - IF (.NOT. ALLOCATED(DstParamData%M11)) THEN - ALLOCATE(DstParamData%M11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%M11 = SrcParamData%M11 -ENDIF -IF (ALLOCATED(SrcParamData%M12)) THEN - i1_l = LBOUND(SrcParamData%M12,1) - i1_u = UBOUND(SrcParamData%M12,1) - i2_l = LBOUND(SrcParamData%M12,2) - i2_u = UBOUND(SrcParamData%M12,2) - IF (.NOT. ALLOCATED(DstParamData%M12)) THEN - ALLOCATE(DstParamData%M12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%M12 = SrcParamData%M12 -ENDIF -IF (ALLOCATED(SrcParamData%M22)) THEN - i1_l = LBOUND(SrcParamData%M22,1) - i1_u = UBOUND(SrcParamData%M22,1) - i2_l = LBOUND(SrcParamData%M22,2) - i2_u = UBOUND(SrcParamData%M22,2) - IF (.NOT. ALLOCATED(DstParamData%M22)) THEN - ALLOCATE(DstParamData%M22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%M22 = SrcParamData%M22 -ENDIF -IF (ALLOCATED(SrcParamData%M21)) THEN - i1_l = LBOUND(SrcParamData%M21,1) - i1_u = UBOUND(SrcParamData%M21,1) - i2_l = LBOUND(SrcParamData%M21,2) - i2_u = UBOUND(SrcParamData%M21,2) - IF (.NOT. ALLOCATED(DstParamData%M21)) THEN - ALLOCATE(DstParamData%M21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M21.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%M21 = SrcParamData%M21 -ENDIF -IF (ALLOCATED(SrcParamData%K11)) THEN - i1_l = LBOUND(SrcParamData%K11,1) - i1_u = UBOUND(SrcParamData%K11,1) - i2_l = LBOUND(SrcParamData%K11,2) - i2_u = UBOUND(SrcParamData%K11,2) - IF (.NOT. ALLOCATED(DstParamData%K11)) THEN - ALLOCATE(DstParamData%K11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%K11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%K11 = SrcParamData%K11 -ENDIF -IF (ALLOCATED(SrcParamData%K22)) THEN - i1_l = LBOUND(SrcParamData%K22,1) - i1_u = UBOUND(SrcParamData%K22,1) - i2_l = LBOUND(SrcParamData%K22,2) - i2_u = UBOUND(SrcParamData%K22,2) - IF (.NOT. ALLOCATED(DstParamData%K22)) THEN - ALLOCATE(DstParamData%K22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%K22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%K22 = SrcParamData%K22 -ENDIF -IF (ALLOCATED(SrcParamData%C11)) THEN - i1_l = LBOUND(SrcParamData%C11,1) - i1_u = UBOUND(SrcParamData%C11,1) - i2_l = LBOUND(SrcParamData%C11,2) - i2_u = UBOUND(SrcParamData%C11,2) - IF (.NOT. ALLOCATED(DstParamData%C11)) THEN - ALLOCATE(DstParamData%C11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C11 = SrcParamData%C11 -ENDIF -IF (ALLOCATED(SrcParamData%C12)) THEN - i1_l = LBOUND(SrcParamData%C12,1) - i1_u = UBOUND(SrcParamData%C12,1) - i2_l = LBOUND(SrcParamData%C12,2) - i2_u = UBOUND(SrcParamData%C12,2) - IF (.NOT. ALLOCATED(DstParamData%C12)) THEN - ALLOCATE(DstParamData%C12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C12 = SrcParamData%C12 -ENDIF -IF (ALLOCATED(SrcParamData%C22)) THEN - i1_l = LBOUND(SrcParamData%C22,1) - i1_u = UBOUND(SrcParamData%C22,1) - i2_l = LBOUND(SrcParamData%C22,2) - i2_u = UBOUND(SrcParamData%C22,2) - IF (.NOT. ALLOCATED(DstParamData%C22)) THEN - ALLOCATE(DstParamData%C22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C22 = SrcParamData%C22 -ENDIF -IF (ALLOCATED(SrcParamData%C21)) THEN - i1_l = LBOUND(SrcParamData%C21,1) - i1_u = UBOUND(SrcParamData%C21,1) - i2_l = LBOUND(SrcParamData%C21,2) - i2_u = UBOUND(SrcParamData%C21,2) - IF (.NOT. ALLOCATED(DstParamData%C21)) THEN - ALLOCATE(DstParamData%C21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C21.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C21 = SrcParamData%C21 -ENDIF - DstParamData%EP_DeltaT = SrcParamData%EP_DeltaT - DstParamData%nTimeSteps = SrcParamData%nTimeSteps - DstParamData%nCB = SrcParamData%nCB - DstParamData%nCBFull = SrcParamData%nCBFull - DstParamData%nTot = SrcParamData%nTot - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%IntMethod = SrcParamData%IntMethod -IF (ALLOCATED(SrcParamData%ActiveCBDOF)) THEN - i1_l = LBOUND(SrcParamData%ActiveCBDOF,1) - i1_u = UBOUND(SrcParamData%ActiveCBDOF,1) - IF (.NOT. ALLOCATED(DstParamData%ActiveCBDOF)) THEN - ALLOCATE(DstParamData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ActiveCBDOF = SrcParamData%ActiveCBDOF -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 -IF (ALLOCATED(SrcParamData%OutParamLinIndx)) THEN - i1_l = LBOUND(SrcParamData%OutParamLinIndx,1) - i1_u = UBOUND(SrcParamData%OutParamLinIndx,1) - i2_l = LBOUND(SrcParamData%OutParamLinIndx,2) - i2_u = UBOUND(SrcParamData%OutParamLinIndx,2) - IF (.NOT. ALLOCATED(DstParamData%OutParamLinIndx)) THEN - ALLOCATE(DstParamData%OutParamLinIndx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx -ENDIF - END SUBROUTINE ExtPtfm_CopyParam - - SUBROUTINE ExtPtfm_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_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 = 'ExtPtfm_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%Mass)) THEN - DEALLOCATE(ParamData%Mass) -ENDIF -IF (ALLOCATED(ParamData%Damp)) THEN - DEALLOCATE(ParamData%Damp) -ENDIF -IF (ALLOCATED(ParamData%Stff)) THEN - DEALLOCATE(ParamData%Stff) -ENDIF -IF (ALLOCATED(ParamData%Forces)) THEN - DEALLOCATE(ParamData%Forces) -ENDIF -IF (ALLOCATED(ParamData%times)) THEN - DEALLOCATE(ParamData%times) -ENDIF -IF (ALLOCATED(ParamData%AMat)) THEN - DEALLOCATE(ParamData%AMat) -ENDIF -IF (ALLOCATED(ParamData%BMat)) THEN - DEALLOCATE(ParamData%BMat) -ENDIF -IF (ALLOCATED(ParamData%CMat)) THEN - DEALLOCATE(ParamData%CMat) -ENDIF -IF (ALLOCATED(ParamData%DMat)) THEN - DEALLOCATE(ParamData%DMat) -ENDIF -IF (ALLOCATED(ParamData%FX)) THEN - DEALLOCATE(ParamData%FX) -ENDIF -IF (ALLOCATED(ParamData%FY)) THEN - DEALLOCATE(ParamData%FY) -ENDIF -IF (ALLOCATED(ParamData%M11)) THEN - DEALLOCATE(ParamData%M11) -ENDIF -IF (ALLOCATED(ParamData%M12)) THEN - DEALLOCATE(ParamData%M12) -ENDIF -IF (ALLOCATED(ParamData%M22)) THEN - DEALLOCATE(ParamData%M22) -ENDIF -IF (ALLOCATED(ParamData%M21)) THEN - DEALLOCATE(ParamData%M21) -ENDIF -IF (ALLOCATED(ParamData%K11)) THEN - DEALLOCATE(ParamData%K11) -ENDIF -IF (ALLOCATED(ParamData%K22)) THEN - DEALLOCATE(ParamData%K22) -ENDIF -IF (ALLOCATED(ParamData%C11)) THEN - DEALLOCATE(ParamData%C11) -ENDIF -IF (ALLOCATED(ParamData%C12)) THEN - DEALLOCATE(ParamData%C12) -ENDIF -IF (ALLOCATED(ParamData%C22)) THEN - DEALLOCATE(ParamData%C22) -ENDIF -IF (ALLOCATED(ParamData%C21)) THEN - DEALLOCATE(ParamData%C21) -ENDIF -IF (ALLOCATED(ParamData%ActiveCBDOF)) THEN - DEALLOCATE(ParamData%ActiveCBDOF) -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 -IF (ALLOCATED(ParamData%OutParamLinIndx)) THEN - DEALLOCATE(ParamData%OutParamLinIndx) -ENDIF - END SUBROUTINE ExtPtfm_DestroyParam - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 - Int_BufSz = Int_BufSz + 1 ! Mass allocated yes/no - IF ( ALLOCATED(InData%Mass) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Mass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Mass) ! Mass - END IF - Int_BufSz = Int_BufSz + 1 ! Damp allocated yes/no - IF ( ALLOCATED(InData%Damp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Damp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Damp) ! Damp - END IF - Int_BufSz = Int_BufSz + 1 ! Stff allocated yes/no - IF ( ALLOCATED(InData%Stff) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Stff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Stff) ! Stff - END IF - Int_BufSz = Int_BufSz + 1 ! Forces allocated yes/no - IF ( ALLOCATED(InData%Forces) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Forces upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Forces) ! Forces - END IF - Int_BufSz = Int_BufSz + 1 ! times allocated yes/no - IF ( ALLOCATED(InData%times) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! times upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%times) ! times - END IF - Int_BufSz = Int_BufSz + 1 ! AMat allocated yes/no - IF ( ALLOCATED(InData%AMat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AMat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AMat) ! AMat - END IF - Int_BufSz = Int_BufSz + 1 ! BMat allocated yes/no - IF ( ALLOCATED(InData%BMat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BMat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BMat) ! BMat - END IF - Int_BufSz = Int_BufSz + 1 ! CMat allocated yes/no - IF ( ALLOCATED(InData%CMat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CMat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMat) ! CMat - END IF - Int_BufSz = Int_BufSz + 1 ! DMat allocated yes/no - IF ( ALLOCATED(InData%DMat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DMat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DMat) ! DMat - END IF - Int_BufSz = Int_BufSz + 1 ! FX allocated yes/no - IF ( ALLOCATED(InData%FX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FX) ! FX - END IF - Int_BufSz = Int_BufSz + 1 ! FY allocated yes/no - IF ( ALLOCATED(InData%FY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FY) ! FY - END IF - Int_BufSz = Int_BufSz + 1 ! M11 allocated yes/no - IF ( ALLOCATED(InData%M11) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M11 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M11) ! M11 - END IF - Int_BufSz = Int_BufSz + 1 ! M12 allocated yes/no - IF ( ALLOCATED(InData%M12) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M12 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M12) ! M12 - END IF - Int_BufSz = Int_BufSz + 1 ! M22 allocated yes/no - IF ( ALLOCATED(InData%M22) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M22 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M22) ! M22 - END IF - Int_BufSz = Int_BufSz + 1 ! M21 allocated yes/no - IF ( ALLOCATED(InData%M21) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M21 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M21) ! M21 - END IF - Int_BufSz = Int_BufSz + 1 ! K11 allocated yes/no - IF ( ALLOCATED(InData%K11) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K11 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%K11) ! K11 - END IF - Int_BufSz = Int_BufSz + 1 ! K22 allocated yes/no - IF ( ALLOCATED(InData%K22) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K22 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%K22) ! K22 - END IF - Int_BufSz = Int_BufSz + 1 ! C11 allocated yes/no - IF ( ALLOCATED(InData%C11) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C11 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C11) ! C11 - END IF - Int_BufSz = Int_BufSz + 1 ! C12 allocated yes/no - IF ( ALLOCATED(InData%C12) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C12 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C12) ! C12 - END IF - Int_BufSz = Int_BufSz + 1 ! C22 allocated yes/no - IF ( ALLOCATED(InData%C22) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C22 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C22) ! C22 - END IF - Int_BufSz = Int_BufSz + 1 ! C21 allocated yes/no - IF ( ALLOCATED(InData%C21) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C21 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C21) ! C21 - END IF - Db_BufSz = Db_BufSz + 1 ! EP_DeltaT - Int_BufSz = Int_BufSz + 1 ! nTimeSteps - Int_BufSz = Int_BufSz + 1 ! nCB - Int_BufSz = Int_BufSz + 1 ! nCBFull - Int_BufSz = Int_BufSz + 1 ! nTot - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! IntMethod - Int_BufSz = Int_BufSz + 1 ! ActiveCBDOF allocated yes/no - IF ( ALLOCATED(InData%ActiveCBDOF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ActiveCBDOF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ActiveCBDOF) ! ActiveCBDOF - 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 ! OutParamLinIndx allocated yes/no - IF ( ALLOCATED(InData%OutParamLinIndx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OutParamLinIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutParamLinIndx) ! OutParamLinIndx - 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%Mass) ) 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%Mass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Mass,2), UBOUND(InData%Mass,2) - DO i1 = LBOUND(InData%Mass,1), UBOUND(InData%Mass,1) - ReKiBuf(Re_Xferred) = InData%Mass(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Damp) ) 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%Damp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Damp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Damp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Damp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Damp,2), UBOUND(InData%Damp,2) - DO i1 = LBOUND(InData%Damp,1), UBOUND(InData%Damp,1) - ReKiBuf(Re_Xferred) = InData%Damp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Stff) ) 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%Stff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stff,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stff,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stff,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Stff,2), UBOUND(InData%Stff,2) - DO i1 = LBOUND(InData%Stff,1), UBOUND(InData%Stff,1) - ReKiBuf(Re_Xferred) = InData%Stff(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Forces) ) 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%Forces,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Forces,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Forces,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Forces,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Forces,2), UBOUND(InData%Forces,2) - DO i1 = LBOUND(InData%Forces,1), UBOUND(InData%Forces,1) - ReKiBuf(Re_Xferred) = InData%Forces(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%times) ) 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%times,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%times,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%times,1), UBOUND(InData%times,1) - ReKiBuf(Re_Xferred) = InData%times(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AMat) ) 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%AMat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AMat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AMat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AMat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AMat,2), UBOUND(InData%AMat,2) - DO i1 = LBOUND(InData%AMat,1), UBOUND(InData%AMat,1) - ReKiBuf(Re_Xferred) = InData%AMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BMat) ) 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%BMat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BMat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BMat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BMat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BMat,2), UBOUND(InData%BMat,2) - DO i1 = LBOUND(InData%BMat,1), UBOUND(InData%BMat,1) - ReKiBuf(Re_Xferred) = InData%BMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMat) ) 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%CMat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CMat,2), UBOUND(InData%CMat,2) - DO i1 = LBOUND(InData%CMat,1), UBOUND(InData%CMat,1) - ReKiBuf(Re_Xferred) = InData%CMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DMat) ) 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%DMat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DMat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DMat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DMat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DMat,2), UBOUND(InData%DMat,2) - DO i1 = LBOUND(InData%DMat,1), UBOUND(InData%DMat,1) - ReKiBuf(Re_Xferred) = InData%DMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FX) ) 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%FX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FX,1), UBOUND(InData%FX,1) - ReKiBuf(Re_Xferred) = InData%FX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FY) ) 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%FY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FY,1), UBOUND(InData%FY,1) - ReKiBuf(Re_Xferred) = InData%FY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M11) ) 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%M11,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M11,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M11,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M11,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M11,2), UBOUND(InData%M11,2) - DO i1 = LBOUND(InData%M11,1), UBOUND(InData%M11,1) - ReKiBuf(Re_Xferred) = InData%M11(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M12) ) 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%M12,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M12,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M12,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M12,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M12,2), UBOUND(InData%M12,2) - DO i1 = LBOUND(InData%M12,1), UBOUND(InData%M12,1) - ReKiBuf(Re_Xferred) = InData%M12(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M22) ) 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%M22,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M22,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M22,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M22,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M22,2), UBOUND(InData%M22,2) - DO i1 = LBOUND(InData%M22,1), UBOUND(InData%M22,1) - ReKiBuf(Re_Xferred) = InData%M22(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M21) ) 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%M21,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M21,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M21,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M21,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M21,2), UBOUND(InData%M21,2) - DO i1 = LBOUND(InData%M21,1), UBOUND(InData%M21,1) - ReKiBuf(Re_Xferred) = InData%M21(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%K11) ) 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%K11,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K11,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K11,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K11,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%K11,2), UBOUND(InData%K11,2) - DO i1 = LBOUND(InData%K11,1), UBOUND(InData%K11,1) - ReKiBuf(Re_Xferred) = InData%K11(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%K22) ) 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%K22,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K22,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K22,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K22,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%K22,2), UBOUND(InData%K22,2) - DO i1 = LBOUND(InData%K22,1), UBOUND(InData%K22,1) - ReKiBuf(Re_Xferred) = InData%K22(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C11) ) 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%C11,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C11,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C11,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C11,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C11,2), UBOUND(InData%C11,2) - DO i1 = LBOUND(InData%C11,1), UBOUND(InData%C11,1) - ReKiBuf(Re_Xferred) = InData%C11(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C12) ) 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%C12,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C12,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C12,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C12,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C12,2), UBOUND(InData%C12,2) - DO i1 = LBOUND(InData%C12,1), UBOUND(InData%C12,1) - ReKiBuf(Re_Xferred) = InData%C12(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C22) ) 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%C22,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C22,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C22,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C22,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C22,2), UBOUND(InData%C22,2) - DO i1 = LBOUND(InData%C22,1), UBOUND(InData%C22,1) - ReKiBuf(Re_Xferred) = InData%C22(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C21) ) 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%C21,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C21,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C21,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C21,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C21,2), UBOUND(InData%C21,2) - DO i1 = LBOUND(InData%C21,1), UBOUND(InData%C21,1) - ReKiBuf(Re_Xferred) = InData%C21(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%EP_DeltaT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nTimeSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nCB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nCBFull - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nTot - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ActiveCBDOF) ) 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%ActiveCBDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActiveCBDOF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ActiveCBDOF,1), UBOUND(InData%ActiveCBDOF,1) - IntKiBuf(Int_Xferred) = InData%ActiveCBDOF(i1) - Int_Xferred = Int_Xferred + 1 - 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 - IF ( .NOT. ALLOCATED(InData%OutParamLinIndx) ) 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%OutParamLinIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParamLinIndx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OutParamLinIndx,2), UBOUND(InData%OutParamLinIndx,2) - DO i1 = LBOUND(InData%OutParamLinIndx,1), UBOUND(InData%OutParamLinIndx,1) - IntKiBuf(Int_Xferred) = InData%OutParamLinIndx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE ExtPtfm_PackParam - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mass 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%Mass)) DEALLOCATE(OutData%Mass) - ALLOCATE(OutData%Mass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Mass,2), UBOUND(OutData%Mass,2) - DO i1 = LBOUND(OutData%Mass,1), UBOUND(OutData%Mass,1) - OutData%Mass(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Damp 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%Damp)) DEALLOCATE(OutData%Damp) - ALLOCATE(OutData%Damp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Damp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Damp,2), UBOUND(OutData%Damp,2) - DO i1 = LBOUND(OutData%Damp,1), UBOUND(OutData%Damp,1) - OutData%Damp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stff 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%Stff)) DEALLOCATE(OutData%Stff) - ALLOCATE(OutData%Stff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Stff,2), UBOUND(OutData%Stff,2) - DO i1 = LBOUND(OutData%Stff,1), UBOUND(OutData%Stff,1) - OutData%Stff(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Forces 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%Forces)) DEALLOCATE(OutData%Forces) - ALLOCATE(OutData%Forces(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Forces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Forces,2), UBOUND(OutData%Forces,2) - DO i1 = LBOUND(OutData%Forces,1), UBOUND(OutData%Forces,1) - OutData%Forces(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! times 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%times)) DEALLOCATE(OutData%times) - ALLOCATE(OutData%times(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%times.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%times,1), UBOUND(OutData%times,1) - OutData%times(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AMat 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%AMat)) DEALLOCATE(OutData%AMat) - ALLOCATE(OutData%AMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AMat,2), UBOUND(OutData%AMat,2) - DO i1 = LBOUND(OutData%AMat,1), UBOUND(OutData%AMat,1) - OutData%AMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BMat 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%BMat)) DEALLOCATE(OutData%BMat) - ALLOCATE(OutData%BMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BMat,2), UBOUND(OutData%BMat,2) - DO i1 = LBOUND(OutData%BMat,1), UBOUND(OutData%BMat,1) - OutData%BMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMat 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%CMat)) DEALLOCATE(OutData%CMat) - ALLOCATE(OutData%CMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CMat,2), UBOUND(OutData%CMat,2) - DO i1 = LBOUND(OutData%CMat,1), UBOUND(OutData%CMat,1) - OutData%CMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DMat 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%DMat)) DEALLOCATE(OutData%DMat) - ALLOCATE(OutData%DMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DMat,2), UBOUND(OutData%DMat,2) - DO i1 = LBOUND(OutData%DMat,1), UBOUND(OutData%DMat,1) - OutData%DMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FX 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%FX)) DEALLOCATE(OutData%FX) - ALLOCATE(OutData%FX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FX,1), UBOUND(OutData%FX,1) - OutData%FX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FY 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%FY)) DEALLOCATE(OutData%FY) - ALLOCATE(OutData%FY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FY,1), UBOUND(OutData%FY,1) - OutData%FY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M11 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%M11)) DEALLOCATE(OutData%M11) - ALLOCATE(OutData%M11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M11,2), UBOUND(OutData%M11,2) - DO i1 = LBOUND(OutData%M11,1), UBOUND(OutData%M11,1) - OutData%M11(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M12 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%M12)) DEALLOCATE(OutData%M12) - ALLOCATE(OutData%M12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M12,2), UBOUND(OutData%M12,2) - DO i1 = LBOUND(OutData%M12,1), UBOUND(OutData%M12,1) - OutData%M12(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M22 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%M22)) DEALLOCATE(OutData%M22) - ALLOCATE(OutData%M22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M22,2), UBOUND(OutData%M22,2) - DO i1 = LBOUND(OutData%M22,1), UBOUND(OutData%M22,1) - OutData%M22(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M21 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%M21)) DEALLOCATE(OutData%M21) - ALLOCATE(OutData%M21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M21.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M21,2), UBOUND(OutData%M21,2) - DO i1 = LBOUND(OutData%M21,1), UBOUND(OutData%M21,1) - OutData%M21(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K11 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%K11)) DEALLOCATE(OutData%K11) - ALLOCATE(OutData%K11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%K11,2), UBOUND(OutData%K11,2) - DO i1 = LBOUND(OutData%K11,1), UBOUND(OutData%K11,1) - OutData%K11(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K22 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%K22)) DEALLOCATE(OutData%K22) - ALLOCATE(OutData%K22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%K22,2), UBOUND(OutData%K22,2) - DO i1 = LBOUND(OutData%K22,1), UBOUND(OutData%K22,1) - OutData%K22(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C11 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%C11)) DEALLOCATE(OutData%C11) - ALLOCATE(OutData%C11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C11,2), UBOUND(OutData%C11,2) - DO i1 = LBOUND(OutData%C11,1), UBOUND(OutData%C11,1) - OutData%C11(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C12 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%C12)) DEALLOCATE(OutData%C12) - ALLOCATE(OutData%C12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C12,2), UBOUND(OutData%C12,2) - DO i1 = LBOUND(OutData%C12,1), UBOUND(OutData%C12,1) - OutData%C12(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C22 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%C22)) DEALLOCATE(OutData%C22) - ALLOCATE(OutData%C22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C22,2), UBOUND(OutData%C22,2) - DO i1 = LBOUND(OutData%C22,1), UBOUND(OutData%C22,1) - OutData%C22(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C21 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%C21)) DEALLOCATE(OutData%C21) - ALLOCATE(OutData%C21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C21.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C21,2), UBOUND(OutData%C21,2) - DO i1 = LBOUND(OutData%C21,1), UBOUND(OutData%C21,1) - OutData%C21(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%EP_DeltaT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%nTimeSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nCB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nCBFull = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nTot = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActiveCBDOF 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%ActiveCBDOF)) DEALLOCATE(OutData%ActiveCBDOF) - ALLOCATE(OutData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ActiveCBDOF,1), UBOUND(OutData%ActiveCBDOF,1) - OutData%ActiveCBDOF(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParamLinIndx 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%OutParamLinIndx)) DEALLOCATE(OutData%OutParamLinIndx) - ALLOCATE(OutData%OutParamLinIndx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OutParamLinIndx,2), UBOUND(OutData%OutParamLinIndx,2) - DO i1 = LBOUND(OutData%OutParamLinIndx,1), UBOUND(OutData%OutParamLinIndx,1) - OutData%OutParamLinIndx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE ExtPtfm_UnPackParam - - SUBROUTINE ExtPtfm_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: SrcInputData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyInput' -! + ErrMsg = '' + if (allocated(ContStateData%qm)) then + deallocate(ContStateData%qm) + end if + if (allocated(ContStateData%qmdot)) then + deallocate(ContStateData%qmdot) + end if +end subroutine + +subroutine ExtPtfm_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%qm)) + if (allocated(InData%qm)) then + call RegPackBounds(Buf, 1, lbound(InData%qm), ubound(InData%qm)) + call RegPack(Buf, InData%qm) + end if + call RegPack(Buf, allocated(InData%qmdot)) + if (allocated(InData%qmdot)) then + call RegPackBounds(Buf, 1, lbound(InData%qmdot), ubound(InData%qmdot)) + call RegPack(Buf, InData%qmdot) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackContState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%qm)) deallocate(OutData%qm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%qm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%qm) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%qmdot)) deallocate(OutData%qmdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%qmdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%qmdot) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine ExtPtfm_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_DiscreteStateType), intent(in) :: SrcDiscStateData + type(ExtPtfm_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%PtfmMesh, DstInputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE ExtPtfm_CopyInput - - SUBROUTINE ExtPtfm_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_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 = 'ExtPtfm_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( InputData%PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ExtPtfm_DestroyInput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtfmMesh - 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 - - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtfmMesh - 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 ExtPtfm_PackInput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 - 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 MeshUnpack( OutData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtfmMesh - 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 ExtPtfm_UnPackInput - - SUBROUTINE ExtPtfm_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyOutput' -! + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine ExtPtfm_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(ExtPtfm_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%PtfmMesh, DstOutputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -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 ExtPtfm_CopyOutput - - SUBROUTINE ExtPtfm_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_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 = 'ExtPtfm_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE ExtPtfm_DestroyOutput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtfmMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 - - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtfmMesh - 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 - 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 ExtPtfm_PackOutput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 - 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 MeshUnpack( OutData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtfmMesh - 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) - 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 ExtPtfm_UnPackOutput - - - SUBROUTINE ExtPtfm_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(ExtPtfm_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(ExtPtfm_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 + ErrMsg = '' +end subroutine + +subroutine ExtPtfm_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_ConstraintStateType), intent(in) :: SrcConstrStateData + type(ExtPtfm_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine ExtPtfm_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(ExtPtfm_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ExtPtfm_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_OtherStateType), intent(in) :: SrcOtherStateData + type(ExtPtfm_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%xdot)) then + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + if (.not. allocated(DstOtherStateData%xdot)) then + allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstOtherStateData%n = SrcOtherStateData%n +end subroutine + +subroutine ExtPtfm_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(ExtPtfm_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%xdot)) then + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%xdot) + end if +end subroutine + +subroutine ExtPtfm_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%xdot)) + if (allocated(InData%xdot)) then + call RegPackBounds(Buf, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call ExtPtfm_PackContState(Buf, InData%xdot(i1)) + end do + end if + call RegPack(Buf, InData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%xdot)) deallocate(OutData%xdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do + end if + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_MiscVarType), intent(in) :: SrcMiscData + type(ExtPtfm_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%xFlat)) then + LB(1:1) = lbound(SrcMiscData%xFlat) + UB(1:1) = ubound(SrcMiscData%xFlat) + if (.not. allocated(DstMiscData%xFlat)) then + allocate(DstMiscData%xFlat(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xFlat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%xFlat = SrcMiscData%xFlat + end if + DstMiscData%uFlat = SrcMiscData%uFlat + if (allocated(SrcMiscData%F_at_t)) then + LB(1:1) = lbound(SrcMiscData%F_at_t) + UB(1:1) = ubound(SrcMiscData%F_at_t) + if (.not. allocated(DstMiscData%F_at_t)) then + allocate(DstMiscData%F_at_t(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_at_t.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_at_t = SrcMiscData%F_at_t + end if + DstMiscData%Indx = SrcMiscData%Indx + DstMiscData%EquilStart = SrcMiscData%EquilStart + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + end if +end subroutine + +subroutine ExtPtfm_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ExtPtfm_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%xFlat)) then + deallocate(MiscData%xFlat) + end if + if (allocated(MiscData%F_at_t)) then + deallocate(MiscData%F_at_t) + end if + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if +end subroutine + +subroutine ExtPtfm_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%xFlat)) + if (allocated(InData%xFlat)) then + call RegPackBounds(Buf, 1, lbound(InData%xFlat), ubound(InData%xFlat)) + call RegPack(Buf, InData%xFlat) + end if + call RegPack(Buf, InData%uFlat) + call RegPack(Buf, allocated(InData%F_at_t)) + if (allocated(InData%F_at_t)) then + call RegPackBounds(Buf, 1, lbound(InData%F_at_t), ubound(InData%F_at_t)) + call RegPack(Buf, InData%F_at_t) + end if + call RegPack(Buf, InData%Indx) + call RegPack(Buf, InData%EquilStart) + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackMisc' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%xFlat)) deallocate(OutData%xFlat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xFlat(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xFlat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xFlat) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%uFlat) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%F_at_t)) deallocate(OutData%F_at_t) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_at_t(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_at_t.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_at_t) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Indx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EquilStart) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_ParameterType), intent(in) :: SrcParamData + type(ExtPtfm_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcParamData%Mass)) then + LB(1:2) = lbound(SrcParamData%Mass) + UB(1:2) = ubound(SrcParamData%Mass) + if (.not. allocated(DstParamData%Mass)) then + allocate(DstParamData%Mass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Mass = SrcParamData%Mass + end if + if (allocated(SrcParamData%Damp)) then + LB(1:2) = lbound(SrcParamData%Damp) + UB(1:2) = ubound(SrcParamData%Damp) + if (.not. allocated(DstParamData%Damp)) then + allocate(DstParamData%Damp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Damp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Damp = SrcParamData%Damp + end if + if (allocated(SrcParamData%Stff)) then + LB(1:2) = lbound(SrcParamData%Stff) + UB(1:2) = ubound(SrcParamData%Stff) + if (.not. allocated(DstParamData%Stff)) then + allocate(DstParamData%Stff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Stff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Stff = SrcParamData%Stff + end if + if (allocated(SrcParamData%Forces)) then + LB(1:2) = lbound(SrcParamData%Forces) + UB(1:2) = ubound(SrcParamData%Forces) + if (.not. allocated(DstParamData%Forces)) then + allocate(DstParamData%Forces(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Forces.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Forces = SrcParamData%Forces + end if + if (allocated(SrcParamData%times)) then + LB(1:1) = lbound(SrcParamData%times) + UB(1:1) = ubound(SrcParamData%times) + if (.not. allocated(DstParamData%times)) then + allocate(DstParamData%times(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%times.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%times = SrcParamData%times + end if + if (allocated(SrcParamData%AMat)) then + LB(1:2) = lbound(SrcParamData%AMat) + UB(1:2) = ubound(SrcParamData%AMat) + if (.not. allocated(DstParamData%AMat)) then + allocate(DstParamData%AMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AMat = SrcParamData%AMat + end if + if (allocated(SrcParamData%BMat)) then + LB(1:2) = lbound(SrcParamData%BMat) + UB(1:2) = ubound(SrcParamData%BMat) + if (.not. allocated(DstParamData%BMat)) then + allocate(DstParamData%BMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BMat = SrcParamData%BMat + end if + if (allocated(SrcParamData%CMat)) then + LB(1:2) = lbound(SrcParamData%CMat) + UB(1:2) = ubound(SrcParamData%CMat) + if (.not. allocated(DstParamData%CMat)) then + allocate(DstParamData%CMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CMat = SrcParamData%CMat + end if + if (allocated(SrcParamData%DMat)) then + LB(1:2) = lbound(SrcParamData%DMat) + UB(1:2) = ubound(SrcParamData%DMat) + if (.not. allocated(DstParamData%DMat)) then + allocate(DstParamData%DMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DMat = SrcParamData%DMat + end if + if (allocated(SrcParamData%FX)) then + LB(1:1) = lbound(SrcParamData%FX) + UB(1:1) = ubound(SrcParamData%FX) + if (.not. allocated(DstParamData%FX)) then + allocate(DstParamData%FX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FX = SrcParamData%FX + end if + if (allocated(SrcParamData%FY)) then + LB(1:1) = lbound(SrcParamData%FY) + UB(1:1) = ubound(SrcParamData%FY) + if (.not. allocated(DstParamData%FY)) then + allocate(DstParamData%FY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FY = SrcParamData%FY + end if + if (allocated(SrcParamData%M11)) then + LB(1:2) = lbound(SrcParamData%M11) + UB(1:2) = ubound(SrcParamData%M11) + if (.not. allocated(DstParamData%M11)) then + allocate(DstParamData%M11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M11.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%M11 = SrcParamData%M11 + end if + if (allocated(SrcParamData%M12)) then + LB(1:2) = lbound(SrcParamData%M12) + UB(1:2) = ubound(SrcParamData%M12) + if (.not. allocated(DstParamData%M12)) then + allocate(DstParamData%M12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M12.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%M12 = SrcParamData%M12 + end if + if (allocated(SrcParamData%M22)) then + LB(1:2) = lbound(SrcParamData%M22) + UB(1:2) = ubound(SrcParamData%M22) + if (.not. allocated(DstParamData%M22)) then + allocate(DstParamData%M22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M22.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%M22 = SrcParamData%M22 + end if + if (allocated(SrcParamData%M21)) then + LB(1:2) = lbound(SrcParamData%M21) + UB(1:2) = ubound(SrcParamData%M21) + if (.not. allocated(DstParamData%M21)) then + allocate(DstParamData%M21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M21.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%M21 = SrcParamData%M21 + end if + if (allocated(SrcParamData%K11)) then + LB(1:2) = lbound(SrcParamData%K11) + UB(1:2) = ubound(SrcParamData%K11) + if (.not. allocated(DstParamData%K11)) then + allocate(DstParamData%K11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%K11.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%K11 = SrcParamData%K11 + end if + if (allocated(SrcParamData%K22)) then + LB(1:2) = lbound(SrcParamData%K22) + UB(1:2) = ubound(SrcParamData%K22) + if (.not. allocated(DstParamData%K22)) then + allocate(DstParamData%K22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%K22.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%K22 = SrcParamData%K22 + end if + if (allocated(SrcParamData%C11)) then + LB(1:2) = lbound(SrcParamData%C11) + UB(1:2) = ubound(SrcParamData%C11) + if (.not. allocated(DstParamData%C11)) then + allocate(DstParamData%C11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C11.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C11 = SrcParamData%C11 + end if + if (allocated(SrcParamData%C12)) then + LB(1:2) = lbound(SrcParamData%C12) + UB(1:2) = ubound(SrcParamData%C12) + if (.not. allocated(DstParamData%C12)) then + allocate(DstParamData%C12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C12.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C12 = SrcParamData%C12 + end if + if (allocated(SrcParamData%C22)) then + LB(1:2) = lbound(SrcParamData%C22) + UB(1:2) = ubound(SrcParamData%C22) + if (.not. allocated(DstParamData%C22)) then + allocate(DstParamData%C22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C22.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C22 = SrcParamData%C22 + end if + if (allocated(SrcParamData%C21)) then + LB(1:2) = lbound(SrcParamData%C21) + UB(1:2) = ubound(SrcParamData%C21) + if (.not. allocated(DstParamData%C21)) then + allocate(DstParamData%C21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C21.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C21 = SrcParamData%C21 + end if + DstParamData%EP_DeltaT = SrcParamData%EP_DeltaT + DstParamData%nTimeSteps = SrcParamData%nTimeSteps + DstParamData%nCB = SrcParamData%nCB + DstParamData%nCBFull = SrcParamData%nCBFull + DstParamData%nTot = SrcParamData%nTot + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%IntMethod = SrcParamData%IntMethod + if (allocated(SrcParamData%ActiveCBDOF)) then + LB(1:1) = lbound(SrcParamData%ActiveCBDOF) + UB(1:1) = ubound(SrcParamData%ActiveCBDOF) + if (.not. allocated(DstParamData%ActiveCBDOF)) then + allocate(DstParamData%ActiveCBDOF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ActiveCBDOF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ActiveCBDOF = SrcParamData%ActiveCBDOF + end if + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + if (allocated(SrcParamData%OutParamLinIndx)) then + LB(1:2) = lbound(SrcParamData%OutParamLinIndx) + UB(1:2) = ubound(SrcParamData%OutParamLinIndx) + if (.not. allocated(DstParamData%OutParamLinIndx)) then + allocate(DstParamData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParamLinIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx + end if +end subroutine + +subroutine ExtPtfm_DestroyParam(ParamData, ErrStat, ErrMsg) + type(ExtPtfm_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%Mass)) then + deallocate(ParamData%Mass) + end if + if (allocated(ParamData%Damp)) then + deallocate(ParamData%Damp) + end if + if (allocated(ParamData%Stff)) then + deallocate(ParamData%Stff) + end if + if (allocated(ParamData%Forces)) then + deallocate(ParamData%Forces) + end if + if (allocated(ParamData%times)) then + deallocate(ParamData%times) + end if + if (allocated(ParamData%AMat)) then + deallocate(ParamData%AMat) + end if + if (allocated(ParamData%BMat)) then + deallocate(ParamData%BMat) + end if + if (allocated(ParamData%CMat)) then + deallocate(ParamData%CMat) + end if + if (allocated(ParamData%DMat)) then + deallocate(ParamData%DMat) + end if + if (allocated(ParamData%FX)) then + deallocate(ParamData%FX) + end if + if (allocated(ParamData%FY)) then + deallocate(ParamData%FY) + end if + if (allocated(ParamData%M11)) then + deallocate(ParamData%M11) + end if + if (allocated(ParamData%M12)) then + deallocate(ParamData%M12) + end if + if (allocated(ParamData%M22)) then + deallocate(ParamData%M22) + end if + if (allocated(ParamData%M21)) then + deallocate(ParamData%M21) + end if + if (allocated(ParamData%K11)) then + deallocate(ParamData%K11) + end if + if (allocated(ParamData%K22)) then + deallocate(ParamData%K22) + end if + if (allocated(ParamData%C11)) then + deallocate(ParamData%C11) + end if + if (allocated(ParamData%C12)) then + deallocate(ParamData%C12) + end if + if (allocated(ParamData%C22)) then + deallocate(ParamData%C22) + end if + if (allocated(ParamData%C21)) then + deallocate(ParamData%C21) + end if + if (allocated(ParamData%ActiveCBDOF)) then + deallocate(ParamData%ActiveCBDOF) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%OutParamLinIndx)) then + deallocate(ParamData%OutParamLinIndx) + end if +end subroutine + +subroutine ExtPtfm_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Mass)) + if (allocated(InData%Mass)) then + call RegPackBounds(Buf, 2, lbound(InData%Mass), ubound(InData%Mass)) + call RegPack(Buf, InData%Mass) + end if + call RegPack(Buf, allocated(InData%Damp)) + if (allocated(InData%Damp)) then + call RegPackBounds(Buf, 2, lbound(InData%Damp), ubound(InData%Damp)) + call RegPack(Buf, InData%Damp) + end if + call RegPack(Buf, allocated(InData%Stff)) + if (allocated(InData%Stff)) then + call RegPackBounds(Buf, 2, lbound(InData%Stff), ubound(InData%Stff)) + call RegPack(Buf, InData%Stff) + end if + call RegPack(Buf, allocated(InData%Forces)) + if (allocated(InData%Forces)) then + call RegPackBounds(Buf, 2, lbound(InData%Forces), ubound(InData%Forces)) + call RegPack(Buf, InData%Forces) + end if + call RegPack(Buf, allocated(InData%times)) + if (allocated(InData%times)) then + call RegPackBounds(Buf, 1, lbound(InData%times), ubound(InData%times)) + call RegPack(Buf, InData%times) + end if + call RegPack(Buf, allocated(InData%AMat)) + if (allocated(InData%AMat)) then + call RegPackBounds(Buf, 2, lbound(InData%AMat), ubound(InData%AMat)) + call RegPack(Buf, InData%AMat) + end if + call RegPack(Buf, allocated(InData%BMat)) + if (allocated(InData%BMat)) then + call RegPackBounds(Buf, 2, lbound(InData%BMat), ubound(InData%BMat)) + call RegPack(Buf, InData%BMat) + end if + call RegPack(Buf, allocated(InData%CMat)) + if (allocated(InData%CMat)) then + call RegPackBounds(Buf, 2, lbound(InData%CMat), ubound(InData%CMat)) + call RegPack(Buf, InData%CMat) + end if + call RegPack(Buf, allocated(InData%DMat)) + if (allocated(InData%DMat)) then + call RegPackBounds(Buf, 2, lbound(InData%DMat), ubound(InData%DMat)) + call RegPack(Buf, InData%DMat) + end if + call RegPack(Buf, allocated(InData%FX)) + if (allocated(InData%FX)) then + call RegPackBounds(Buf, 1, lbound(InData%FX), ubound(InData%FX)) + call RegPack(Buf, InData%FX) + end if + call RegPack(Buf, allocated(InData%FY)) + if (allocated(InData%FY)) then + call RegPackBounds(Buf, 1, lbound(InData%FY), ubound(InData%FY)) + call RegPack(Buf, InData%FY) + end if + call RegPack(Buf, allocated(InData%M11)) + if (allocated(InData%M11)) then + call RegPackBounds(Buf, 2, lbound(InData%M11), ubound(InData%M11)) + call RegPack(Buf, InData%M11) + end if + call RegPack(Buf, allocated(InData%M12)) + if (allocated(InData%M12)) then + call RegPackBounds(Buf, 2, lbound(InData%M12), ubound(InData%M12)) + call RegPack(Buf, InData%M12) + end if + call RegPack(Buf, allocated(InData%M22)) + if (allocated(InData%M22)) then + call RegPackBounds(Buf, 2, lbound(InData%M22), ubound(InData%M22)) + call RegPack(Buf, InData%M22) + end if + call RegPack(Buf, allocated(InData%M21)) + if (allocated(InData%M21)) then + call RegPackBounds(Buf, 2, lbound(InData%M21), ubound(InData%M21)) + call RegPack(Buf, InData%M21) + end if + call RegPack(Buf, allocated(InData%K11)) + if (allocated(InData%K11)) then + call RegPackBounds(Buf, 2, lbound(InData%K11), ubound(InData%K11)) + call RegPack(Buf, InData%K11) + end if + call RegPack(Buf, allocated(InData%K22)) + if (allocated(InData%K22)) then + call RegPackBounds(Buf, 2, lbound(InData%K22), ubound(InData%K22)) + call RegPack(Buf, InData%K22) + end if + call RegPack(Buf, allocated(InData%C11)) + if (allocated(InData%C11)) then + call RegPackBounds(Buf, 2, lbound(InData%C11), ubound(InData%C11)) + call RegPack(Buf, InData%C11) + end if + call RegPack(Buf, allocated(InData%C12)) + if (allocated(InData%C12)) then + call RegPackBounds(Buf, 2, lbound(InData%C12), ubound(InData%C12)) + call RegPack(Buf, InData%C12) + end if + call RegPack(Buf, allocated(InData%C22)) + if (allocated(InData%C22)) then + call RegPackBounds(Buf, 2, lbound(InData%C22), ubound(InData%C22)) + call RegPack(Buf, InData%C22) + end if + call RegPack(Buf, allocated(InData%C21)) + if (allocated(InData%C21)) then + call RegPackBounds(Buf, 2, lbound(InData%C21), ubound(InData%C21)) + call RegPack(Buf, InData%C21) + end if + call RegPack(Buf, InData%EP_DeltaT) + call RegPack(Buf, InData%nTimeSteps) + call RegPack(Buf, InData%nCB) + call RegPack(Buf, InData%nCBFull) + call RegPack(Buf, InData%nTot) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%IntMethod) + call RegPack(Buf, allocated(InData%ActiveCBDOF)) + if (allocated(InData%ActiveCBDOF)) then + call RegPackBounds(Buf, 1, lbound(InData%ActiveCBDOF), ubound(InData%ActiveCBDOF)) + call RegPack(Buf, InData%ActiveCBDOF) + end if + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OutParamLinIndx)) + if (allocated(InData%OutParamLinIndx)) then + call RegPackBounds(Buf, 2, lbound(InData%OutParamLinIndx), ubound(InData%OutParamLinIndx)) + call RegPack(Buf, InData%OutParamLinIndx) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Mass)) deallocate(OutData%Mass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mass(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Mass) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Damp)) deallocate(OutData%Damp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Damp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Damp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Damp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Stff)) deallocate(OutData%Stff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Stff(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Stff) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Forces)) deallocate(OutData%Forces) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Forces(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Forces.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Forces) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%times)) deallocate(OutData%times) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%times(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%times.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%times) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AMat)) deallocate(OutData%AMat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AMat(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AMat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AMat) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BMat)) deallocate(OutData%BMat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BMat(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BMat) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CMat)) deallocate(OutData%CMat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CMat(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CMat) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DMat)) deallocate(OutData%DMat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DMat(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DMat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DMat) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FX)) deallocate(OutData%FX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FY)) deallocate(OutData%FY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FY) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%M11)) deallocate(OutData%M11) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M11(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M11.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M11) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%M12)) deallocate(OutData%M12) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M12(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M12.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M12) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%M22)) deallocate(OutData%M22) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M22(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M22.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M22) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%M21)) deallocate(OutData%M21) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M21(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M21.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M21) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%K11)) deallocate(OutData%K11) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%K11(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%K11.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%K11) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%K22)) deallocate(OutData%K22) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%K22(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%K22.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%K22) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%C11)) deallocate(OutData%C11) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C11(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C11.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C11) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%C12)) deallocate(OutData%C12) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C12(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C12.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C12) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%C22)) deallocate(OutData%C22) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C22(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C22.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C22) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%C21)) deallocate(OutData%C21) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C21(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C21.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C21) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%EP_DeltaT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nTimeSteps) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nCB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nCBFull) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nTot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IntMethod) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ActiveCBDOF)) deallocate(OutData%ActiveCBDOF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ActiveCBDOF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ActiveCBDOF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + if (allocated(OutData%OutParamLinIndx)) deallocate(OutData%OutParamLinIndx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutParamLinIndx) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine ExtPtfm_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_InputType), intent(inout) :: SrcInputData + type(ExtPtfm_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%PtfmMesh, DstInputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ExtPtfm_DestroyInput(InputData, ErrStat, ErrMsg) + type(ExtPtfm_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ExtPtfm_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%PtfmMesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh +end subroutine + +subroutine ExtPtfm_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_OutputType), intent(inout) :: SrcOutputData + type(ExtPtfm_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%PtfmMesh, DstOutputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine ExtPtfm_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(ExtPtfm_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine ExtPtfm_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%PtfmMesh) + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine ExtPtfm_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(ExtPtfm_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL ExtPtfm_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 ExtPtfm_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 ExtPtfm_Input_ExtrapInterp - - - SUBROUTINE ExtPtfm_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call ExtPtfm_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ExtPtfm_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ExtPtfm_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ExtPtfm_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. @@ -4880,41 +2365,42 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(ExtPtfm_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 + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(ExtPtfm_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 = 'ExtPtfm_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(u1%PtfmMesh, u2%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE ExtPtfm_Input_ExtrapInterp1 - - - SUBROUTINE ExtPtfm_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%PtfmMesh, u2%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE ExtPtfm_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. @@ -4928,101 +2414,102 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(ExtPtfm_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 + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(ExtPtfm_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 = 'ExtPtfm_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(u1%PtfmMesh, u2%PtfmMesh, u3%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE ExtPtfm_Input_ExtrapInterp2 - - - SUBROUTINE ExtPtfm_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(ExtPtfm_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(ExtPtfm_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%PtfmMesh, u2%PtfmMesh, u3%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine ExtPtfm_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(ExtPtfm_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL ExtPtfm_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 ExtPtfm_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 ExtPtfm_Output_ExtrapInterp - - - SUBROUTINE ExtPtfm_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call ExtPtfm_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ExtPtfm_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ExtPtfm_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ExtPtfm_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. @@ -5034,49 +2521,47 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(ExtPtfm_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 + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(ExtPtfm_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 = 'ExtPtfm_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(y1%PtfmMesh, y2%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 ExtPtfm_Output_ExtrapInterp1 - - - SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%PtfmMesh, y2%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE ExtPtfm_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. @@ -5090,56 +2575,52 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat ! !.................................................................................................................................. - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(ExtPtfm_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 + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(ExtPtfm_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 = 'ExtPtfm_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(y1%PtfmMesh, y2%PtfmMesh, y3%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 ExtPtfm_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%PtfmMesh, y2%PtfmMesh, y3%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE ExtPtfm_MCKF_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 43ad17b62e..29b7bba7dd 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -35,7 +35,7 @@ MODULE FEAMooring_Types IMPLICIT NONE ! ========= FEAM_InputFile ======= TYPE, PUBLIC :: FEAM_InputFile - REAL(DbKi) :: DT !< Communication interval for mooring dynamics [s] + REAL(DbKi) :: DT = 0.0_R8Ki !< Communication interval for mooring dynamics [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LineCI !< Mooring line inertia coefficient [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LineCD !< Mooring line drag coefficient [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LEAStiff !< Mooring line axial stiffness [-] @@ -53,18 +53,18 @@ MODULE FEAMooring_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GSL !< Linear spring stiffness at fairlead [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GSR !< Rotational spring stiffness at fairlead [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GE !< Reference tangent vector at fairlead [-] - INTEGER(IntKi) :: NumLines !< Number of lines [-] - INTEGER(IntKi) :: NumElems !< Number of elements [-] - REAL(ReKi) :: Eps !< Tolerance for static iteration [-] - REAL(ReKi) :: Gravity !< Gravity [-] - REAL(ReKi) :: WtrDens !< Water density [-] - INTEGER(IntKi) :: MaxIter !< Maximum number of iteration step for static analysis [-] - LOGICAL :: SumPrint !< Print summary data to .fsm? [-] - INTEGER(IntKi) :: OutFile !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] - LOGICAL :: TabDelim !< Use tab delimiters in text tabular output file? [-] + INTEGER(IntKi) :: NumLines = 0_IntKi !< Number of lines [-] + INTEGER(IntKi) :: NumElems = 0_IntKi !< Number of elements [-] + REAL(ReKi) :: Eps = 0.0_ReKi !< Tolerance for static iteration [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity [-] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [-] + INTEGER(IntKi) :: MaxIter = 0_IntKi !< Maximum number of iteration step for static analysis [-] + LOGICAL :: SumPrint = .false. !< Print summary data to .fsm? [-] + INTEGER(IntKi) :: OutFile = 0_IntKi !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] + LOGICAL :: TabDelim = .false. !< Use tab delimiters in text tabular output file? [-] CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time) [-] - REAL(DbKi) :: Tstart !< Time to start module's tabular output [s] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [s] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] END TYPE FEAM_InputFile ! ======================= @@ -72,13 +72,13 @@ MODULE FEAMooring_Types TYPE, PUBLIC :: FEAM_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) , DIMENSION(1:6) :: PtfmInit !< Platform Initial Position [-] - INTEGER(IntKi) :: NStepWave !< [-] + REAL(ReKi) , DIMENSION(1:6) :: PtfmInit = 0.0_ReKi !< Platform Initial Position [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc0 !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel0 !< [-] - REAL(ReKi) :: Gravity !< Gravity [-] - REAL(ReKi) :: WtrDens !< Water density [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity [-] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [-] END TYPE FEAM_InitInputType ! ======================= ! ========= FEAM_InitOutputType ======= @@ -102,48 +102,48 @@ MODULE FEAMooring_Types ! ======================= ! ========= FEAM_DiscreteStateType ======= TYPE, PUBLIC :: FEAM_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE FEAM_DiscreteStateType ! ======================= ! ========= FEAM_ConstraintStateType ======= TYPE, PUBLIC :: FEAM_ConstraintStateType - REAL(ReKi) , DIMENSION(1:3) :: TSN !< Lagrangian multiplier [-] - REAL(ReKi) , DIMENSION(1:3) :: TZER !< Lagrangian multiplier [-] + REAL(ReKi) , DIMENSION(1:3) :: TSN = 0.0_ReKi !< Lagrangian multiplier [-] + REAL(ReKi) , DIMENSION(1:3) :: TZER = 0.0_ReKi !< Lagrangian multiplier [-] END TYPE FEAM_ConstraintStateType ! ======================= ! ========= FEAM_OtherStateType ======= TYPE, PUBLIC :: FEAM_OtherStateType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GLU0 !< Global matrix U0 (previous state) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GLDDU !< Global matrix DDU (accleration) -- other state [-] - LOGICAL :: BottomTouch !< Bottom touch flag [-] + LOGICAL :: BottomTouch = .false. !< Bottom touch flag [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GFORC0 !< Old element force matrix [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: GMASS0 !< Old element mass matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FAST_FPA !< Fairlead position - inputs from previous time step (we should replace this with a call to extrap-interp) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FAST_RP !< Fairlead tangent - part of output computation that was calculated in UpdateStates [-] - INTEGER(IntKi) :: INCR !< FEAM step [-] - REAL(ReKi) , DIMENSION(1:15) :: RSDF !< Line residue force - modifies values from previous call to FEAM_Solve [-] - REAL(ReKi) , DIMENSION(1:15) :: FORC0 !< - [Local old element force matrix] - REAL(ReKi) , DIMENSION(1:15,1:15) :: EMAS0 !< Local old element mass matrix [-] + INTEGER(IntKi) :: INCR = 0_IntKi !< FEAM step [-] + REAL(ReKi) , DIMENSION(1:15) :: RSDF = 0.0_ReKi !< Line residue force - modifies values from previous call to FEAM_Solve [-] + REAL(ReKi) , DIMENSION(1:15) :: FORC0 = 0.0_ReKi !< - [Local old element force matrix] + REAL(ReKi) , DIMENSION(1:15,1:15) :: EMAS0 = 0.0_ReKi !< Local old element mass matrix [-] END TYPE FEAM_OtherStateType ! ======================= ! ========= FEAM_MiscVarType ======= TYPE, PUBLIC :: FEAM_MiscVarType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GLF !< Global forcing matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GLK !< Global stiffness matrix [-] - REAL(ReKi) , DIMENSION(1:15,1:15) :: EMASS !< Line element mass [-] - REAL(ReKi) , DIMENSION(1:15,1:15) :: ESTIF !< Line element stiffness [-] + REAL(ReKi) , DIMENSION(1:15,1:15) :: EMASS = 0.0_ReKi !< Line element mass [-] + REAL(ReKi) , DIMENSION(1:15,1:15) :: ESTIF = 0.0_ReKi !< Line element stiffness [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FAST_FP !< Fairlead position at t+dt [-] - REAL(ReKi) , DIMENSION(1:15) :: FORCE !< Line external force [-] - REAL(ReKi) , DIMENSION(1:3) :: FP !< Fairlead position - used in Couple routine [-] - REAL(ReKi) , DIMENSION(1:3,1:4) :: U !< Local matrix U [-] - REAL(ReKi) , DIMENSION(1:3,1:4) :: U0 !< Local matrix U0 [-] - REAL(ReKi) , DIMENSION(1:3,1:4) :: DU !< Local matrix DU [-] - REAL(ReKi) , DIMENSION(1:3,1:4) :: DDU !< Local matrix DDU [-] - REAL(ReKi) , DIMENSION(1:3) :: R !< POSITION VECTOR OF NODE OF ROD ELEMENT [-] - REAL(ReKi) , DIMENSION(1:3) :: RP !< DR/DS AT R (TANGENT - NEED NOT BE UNIT VECTOR) [-] - REAL(ReKi) , DIMENSION(1:6) :: RHSR !< RIGHT HAND SIDE CONTRIBUTION TO 6 DEGREES OF FREEDOM OF ROD NODE [-] - REAL(ReKi) , DIMENSION(1:3) :: SLIN !< LINEAR SPRING CONSTANT - portion of p%GSL [(UNITS OF FORCE/LENGTH)] - REAL(ReKi) , DIMENSION(1:6,1:6) :: STIFR !< STIFFNESS COEFFICIENTS FOR 6 DEGREES OF FREEDOM OF ROD NODE (X,DX/DS,Y,DY/DS,Z,DZ/DS) [-] + REAL(ReKi) , DIMENSION(1:15) :: FORCE = 0.0_ReKi !< Line external force [-] + REAL(ReKi) , DIMENSION(1:3) :: FP = 0.0_ReKi !< Fairlead position - used in Couple routine [-] + REAL(ReKi) , DIMENSION(1:3,1:4) :: U = 0.0_ReKi !< Local matrix U [-] + REAL(ReKi) , DIMENSION(1:3,1:4) :: U0 = 0.0_ReKi !< Local matrix U0 [-] + REAL(ReKi) , DIMENSION(1:3,1:4) :: DU = 0.0_ReKi !< Local matrix DU [-] + REAL(ReKi) , DIMENSION(1:3,1:4) :: DDU = 0.0_ReKi !< Local matrix DDU [-] + REAL(ReKi) , DIMENSION(1:3) :: R = 0.0_ReKi !< POSITION VECTOR OF NODE OF ROD ELEMENT [-] + REAL(ReKi) , DIMENSION(1:3) :: RP = 0.0_ReKi !< DR/DS AT R (TANGENT - NEED NOT BE UNIT VECTOR) [-] + REAL(ReKi) , DIMENSION(1:6) :: RHSR = 0.0_ReKi !< RIGHT HAND SIDE CONTRIBUTION TO 6 DEGREES OF FREEDOM OF ROD NODE [-] + REAL(ReKi) , DIMENSION(1:3) :: SLIN = 0.0_ReKi !< LINEAR SPRING CONSTANT - portion of p%GSL [(UNITS OF FORCE/LENGTH)] + REAL(ReKi) , DIMENSION(1:6,1:6) :: STIFR = 0.0_ReKi !< STIFFNESS COEFFICIENTS FOR 6 DEGREES OF FREEDOM OF ROD NODE (X,DX/DS,Y,DY/DS,Z,DZ/DS) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FAIR_ANG !< Fairlead angle [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FAIR_T !< Fairlead tension [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ANCH_ANG !< Anchor angle [-] @@ -151,24 +151,24 @@ MODULE FEAMooring_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Line_Coordinate !< Mooring line coordinate [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Line_Tangent !< Mooring line tangent vector [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_Lines !< Mooring restoring force [-] - INTEGER(IntKi) :: LastIndWave !< FEAM step [-] + INTEGER(IntKi) :: LastIndWave = 0_IntKi !< FEAM step [-] END TYPE FEAM_MiscVarType ! ======================= ! ========= FEAM_ParameterType ======= TYPE, PUBLIC :: FEAM_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - REAL(ReKi) , DIMENSION(1:3) :: GRAV !< Gravity [-] - REAL(ReKi) :: Eps !< Tolerance for static iteration [-] - REAL(ReKi) :: Gravity !< Gravity [-] - REAL(ReKi) :: WtrDens !< Water density [-] - INTEGER(IntKi) :: MaxIter !< Maximum number of iteration step for static analysis [-] - INTEGER(IntKi) :: NHBD !< Bandwidth = (NBAND+1)/2 [-] - INTEGER(IntKi) :: NDIM !< Dimension = 3 [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] + REAL(ReKi) , DIMENSION(1:3) :: GRAV = 0.0_ReKi !< Gravity [-] + REAL(ReKi) :: Eps = 0.0_ReKi !< Tolerance for static iteration [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity [-] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [-] + INTEGER(IntKi) :: MaxIter = 0_IntKi !< Maximum number of iteration step for static analysis [-] + INTEGER(IntKi) :: NHBD = 0_IntKi !< Bandwidth = (NBAND+1)/2 [-] + INTEGER(IntKi) :: NDIM = 0_IntKi !< Dimension = 3 [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NEQ !< Number of equation [-] - INTEGER(IntKi) :: NBAND !< Bandwidth [-] - INTEGER(IntKi) :: NumLines !< Number of lines [-] - INTEGER(IntKi) :: NumElems !< Number of elements [-] - INTEGER(IntKi) :: NumNodes !< Number of nodes [-] + INTEGER(IntKi) :: NBAND = 0_IntKi !< Bandwidth [-] + INTEGER(IntKi) :: NumLines = 0_IntKi !< Number of lines [-] + INTEGER(IntKi) :: NumElems = 0_IntKi !< Number of elements [-] + INTEGER(IntKi) :: NumNodes = 0_IntKi !< Number of nodes [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GSL !< Linear spring stiffness at fairlead [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GP !< Fairlead position [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Elength !< Element length [-] @@ -183,26 +183,26 @@ MODULE FEAMooring_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc0 !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel0 !< [-] - INTEGER(IntKi) :: NStepWave !< Number of wave steps [-] - REAL(ReKi) , DIMENSION(1:6,1:4) :: SHAP !< Shape function [-] - REAL(ReKi) , DIMENSION(1:6,1:4) :: SHAPS !< Shape function [-] - REAL(ReKi) , DIMENSION(1:6) :: GAUSSW !< Shape function [-] - INTEGER(IntKi) :: NGAUSS !< 6 POINT GAUSSIAN QUADRATURE INTEGRATION [-] - REAL(ReKi) , DIMENSION(1:10,1:4) :: SHAPT !< Shape function [-] - REAL(ReKi) , DIMENSION(1:10,1:4) :: SHAPTS !< Shape function [-] - INTEGER(IntKi) :: NTRAP !< 10 TRANPEZOIDE INTEGRATION point [-] - REAL(ReKi) , DIMENSION(1:4,1:4) :: SBEND !< Internal [-] - REAL(ReKi) , DIMENSION(1:3,1:4,1:4) :: STEN !< Internal [-] - REAL(ReKi) , DIMENSION(1:4,1:4) :: RMASS !< Internal [-] - REAL(ReKi) , DIMENSION(1:4,1:4,1:4,1:4) :: RADDM !< Internal [-] - REAL(ReKi) , DIMENSION(1:3,1:3) :: PMPN !< Internal [-] - REAL(ReKi) , DIMENSION(1:4) :: AM !< Internal [-] - REAL(ReKi) , DIMENSION(1:3) :: PM !< Internal [-] - INTEGER(IntKi) , DIMENSION(1:3,1:4) :: IDOF !< Internal [-] - INTEGER(IntKi) , DIMENSION(1:3) :: JDOF !< Internal [-] - REAL(ReKi) , DIMENSION(1:3,1:3,1:4) :: PPA !< Internal [-] - REAL(ReKi) :: PtfmRefzt !< Platform reference [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of wave steps [-] + REAL(ReKi) , DIMENSION(1:6,1:4) :: SHAP = 0.0_ReKi !< Shape function [-] + REAL(ReKi) , DIMENSION(1:6,1:4) :: SHAPS = 0.0_ReKi !< Shape function [-] + REAL(ReKi) , DIMENSION(1:6) :: GAUSSW = 0.0_ReKi !< Shape function [-] + INTEGER(IntKi) :: NGAUSS = 0_IntKi !< 6 POINT GAUSSIAN QUADRATURE INTEGRATION [-] + REAL(ReKi) , DIMENSION(1:10,1:4) :: SHAPT = 0.0_ReKi !< Shape function [-] + REAL(ReKi) , DIMENSION(1:10,1:4) :: SHAPTS = 0.0_ReKi !< Shape function [-] + INTEGER(IntKi) :: NTRAP = 0_IntKi !< 10 TRANPEZOIDE INTEGRATION point [-] + REAL(ReKi) , DIMENSION(1:4,1:4) :: SBEND = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:3,1:4,1:4) :: STEN = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:4,1:4) :: RMASS = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:4,1:4,1:4,1:4) :: RADDM = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: PMPN = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:4) :: AM = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:3) :: PM = 0.0_ReKi !< Internal [-] + INTEGER(IntKi) , DIMENSION(1:3,1:4) :: IDOF = 0_IntKi !< Internal [-] + INTEGER(IntKi) , DIMENSION(1:3) :: JDOF = 0_IntKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:3,1:3,1:4) :: PPA = 0.0_ReKi !< Internal [-] + REAL(ReKi) :: PtfmRefzt = 0.0_ReKi !< Platform reference [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] CHARACTER(1) :: Delim !< Column delimiter for output text files [-] @@ -224,6832 +224,3098 @@ MODULE FEAMooring_Types END TYPE FEAM_OutputType ! ======================= CONTAINS - SUBROUTINE FEAM_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(FEAM_InputFile), INTENT(INOUT) :: DstInputFileData - 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 = 'FEAM_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DT = SrcInputFileData%DT -IF (ALLOCATED(SrcInputFileData%LineCI)) THEN - i1_l = LBOUND(SrcInputFileData%LineCI,1) - i1_u = UBOUND(SrcInputFileData%LineCI,1) - IF (.NOT. ALLOCATED(DstInputFileData%LineCI)) THEN - ALLOCATE(DstInputFileData%LineCI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LineCI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LineCI = SrcInputFileData%LineCI -ENDIF -IF (ALLOCATED(SrcInputFileData%LineCD)) THEN - i1_l = LBOUND(SrcInputFileData%LineCD,1) - i1_u = UBOUND(SrcInputFileData%LineCD,1) - IF (.NOT. ALLOCATED(DstInputFileData%LineCD)) THEN - ALLOCATE(DstInputFileData%LineCD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LineCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LineCD = SrcInputFileData%LineCD -ENDIF -IF (ALLOCATED(SrcInputFileData%LEAStiff)) THEN - i1_l = LBOUND(SrcInputFileData%LEAStiff,1) - i1_u = UBOUND(SrcInputFileData%LEAStiff,1) - IF (.NOT. ALLOCATED(DstInputFileData%LEAStiff)) THEN - ALLOCATE(DstInputFileData%LEAStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LEAStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LEAStiff = SrcInputFileData%LEAStiff -ENDIF -IF (ALLOCATED(SrcInputFileData%LMassDen)) THEN - i1_l = LBOUND(SrcInputFileData%LMassDen,1) - i1_u = UBOUND(SrcInputFileData%LMassDen,1) - IF (.NOT. ALLOCATED(DstInputFileData%LMassDen)) THEN - ALLOCATE(DstInputFileData%LMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LMassDen = SrcInputFileData%LMassDen -ENDIF -IF (ALLOCATED(SrcInputFileData%LDMassDen)) THEN - i1_l = LBOUND(SrcInputFileData%LDMassDen,1) - i1_u = UBOUND(SrcInputFileData%LDMassDen,1) - IF (.NOT. ALLOCATED(DstInputFileData%LDMassDen)) THEN - ALLOCATE(DstInputFileData%LDMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LDMassDen = SrcInputFileData%LDMassDen -ENDIF -IF (ALLOCATED(SrcInputFileData%BottmStiff)) THEN - i1_l = LBOUND(SrcInputFileData%BottmStiff,1) - i1_u = UBOUND(SrcInputFileData%BottmStiff,1) - IF (.NOT. ALLOCATED(DstInputFileData%BottmStiff)) THEN - ALLOCATE(DstInputFileData%BottmStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BottmStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BottmStiff = SrcInputFileData%BottmStiff -ENDIF -IF (ALLOCATED(SrcInputFileData%LRadAnch)) THEN - i1_l = LBOUND(SrcInputFileData%LRadAnch,1) - i1_u = UBOUND(SrcInputFileData%LRadAnch,1) - IF (.NOT. ALLOCATED(DstInputFileData%LRadAnch)) THEN - ALLOCATE(DstInputFileData%LRadAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LRadAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LRadAnch = SrcInputFileData%LRadAnch -ENDIF -IF (ALLOCATED(SrcInputFileData%LAngAnch)) THEN - i1_l = LBOUND(SrcInputFileData%LAngAnch,1) - i1_u = UBOUND(SrcInputFileData%LAngAnch,1) - IF (.NOT. ALLOCATED(DstInputFileData%LAngAnch)) THEN - ALLOCATE(DstInputFileData%LAngAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LAngAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LAngAnch = SrcInputFileData%LAngAnch -ENDIF -IF (ALLOCATED(SrcInputFileData%LDpthAnch)) THEN - i1_l = LBOUND(SrcInputFileData%LDpthAnch,1) - i1_u = UBOUND(SrcInputFileData%LDpthAnch,1) - IF (.NOT. ALLOCATED(DstInputFileData%LDpthAnch)) THEN - ALLOCATE(DstInputFileData%LDpthAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDpthAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LDpthAnch = SrcInputFileData%LDpthAnch -ENDIF -IF (ALLOCATED(SrcInputFileData%LRadFair)) THEN - i1_l = LBOUND(SrcInputFileData%LRadFair,1) - i1_u = UBOUND(SrcInputFileData%LRadFair,1) - IF (.NOT. ALLOCATED(DstInputFileData%LRadFair)) THEN - ALLOCATE(DstInputFileData%LRadFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LRadFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LRadFair = SrcInputFileData%LRadFair -ENDIF -IF (ALLOCATED(SrcInputFileData%LAngFair)) THEN - i1_l = LBOUND(SrcInputFileData%LAngFair,1) - i1_u = UBOUND(SrcInputFileData%LAngFair,1) - IF (.NOT. ALLOCATED(DstInputFileData%LAngFair)) THEN - ALLOCATE(DstInputFileData%LAngFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LAngFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LAngFair = SrcInputFileData%LAngFair -ENDIF -IF (ALLOCATED(SrcInputFileData%LDrftFair)) THEN - i1_l = LBOUND(SrcInputFileData%LDrftFair,1) - i1_u = UBOUND(SrcInputFileData%LDrftFair,1) - IF (.NOT. ALLOCATED(DstInputFileData%LDrftFair)) THEN - ALLOCATE(DstInputFileData%LDrftFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDrftFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LDrftFair = SrcInputFileData%LDrftFair -ENDIF -IF (ALLOCATED(SrcInputFileData%LUnstrLen)) THEN - i1_l = LBOUND(SrcInputFileData%LUnstrLen,1) - i1_u = UBOUND(SrcInputFileData%LUnstrLen,1) - IF (.NOT. ALLOCATED(DstInputFileData%LUnstrLen)) THEN - ALLOCATE(DstInputFileData%LUnstrLen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LUnstrLen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LUnstrLen = SrcInputFileData%LUnstrLen -ENDIF -IF (ALLOCATED(SrcInputFileData%Tension)) THEN - i1_l = LBOUND(SrcInputFileData%Tension,1) - i1_u = UBOUND(SrcInputFileData%Tension,1) - IF (.NOT. ALLOCATED(DstInputFileData%Tension)) THEN - ALLOCATE(DstInputFileData%Tension(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Tension.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Tension = SrcInputFileData%Tension -ENDIF -IF (ALLOCATED(SrcInputFileData%GSL)) THEN - i1_l = LBOUND(SrcInputFileData%GSL,1) - i1_u = UBOUND(SrcInputFileData%GSL,1) - i2_l = LBOUND(SrcInputFileData%GSL,2) - i2_u = UBOUND(SrcInputFileData%GSL,2) - i3_l = LBOUND(SrcInputFileData%GSL,3) - i3_u = UBOUND(SrcInputFileData%GSL,3) - IF (.NOT. ALLOCATED(DstInputFileData%GSL)) THEN - ALLOCATE(DstInputFileData%GSL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%GSL = SrcInputFileData%GSL -ENDIF -IF (ALLOCATED(SrcInputFileData%GSR)) THEN - i1_l = LBOUND(SrcInputFileData%GSR,1) - i1_u = UBOUND(SrcInputFileData%GSR,1) - i2_l = LBOUND(SrcInputFileData%GSR,2) - i2_u = UBOUND(SrcInputFileData%GSR,2) - IF (.NOT. ALLOCATED(DstInputFileData%GSR)) THEN - ALLOCATE(DstInputFileData%GSR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GSR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%GSR = SrcInputFileData%GSR -ENDIF -IF (ALLOCATED(SrcInputFileData%GE)) THEN - i1_l = LBOUND(SrcInputFileData%GE,1) - i1_u = UBOUND(SrcInputFileData%GE,1) - i2_l = LBOUND(SrcInputFileData%GE,2) - i2_u = UBOUND(SrcInputFileData%GE,2) - i3_l = LBOUND(SrcInputFileData%GE,3) - i3_u = UBOUND(SrcInputFileData%GE,3) - IF (.NOT. ALLOCATED(DstInputFileData%GE)) THEN - ALLOCATE(DstInputFileData%GE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%GE = SrcInputFileData%GE -ENDIF - DstInputFileData%NumLines = SrcInputFileData%NumLines - DstInputFileData%NumElems = SrcInputFileData%NumElems - DstInputFileData%Eps = SrcInputFileData%Eps - DstInputFileData%Gravity = SrcInputFileData%Gravity - DstInputFileData%WtrDens = SrcInputFileData%WtrDens - DstInputFileData%MaxIter = SrcInputFileData%MaxIter - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%OutFile = SrcInputFileData%OutFile - DstInputFileData%TabDelim = SrcInputFileData%TabDelim - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%Tstart = SrcInputFileData%Tstart - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - END SUBROUTINE FEAM_CopyInputFile - - SUBROUTINE FEAM_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(FEAM_InputFile), INTENT(INOUT) :: InputFileData - 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 = 'FEAM_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%LineCI)) THEN - DEALLOCATE(InputFileData%LineCI) -ENDIF -IF (ALLOCATED(InputFileData%LineCD)) THEN - DEALLOCATE(InputFileData%LineCD) -ENDIF -IF (ALLOCATED(InputFileData%LEAStiff)) THEN - DEALLOCATE(InputFileData%LEAStiff) -ENDIF -IF (ALLOCATED(InputFileData%LMassDen)) THEN - DEALLOCATE(InputFileData%LMassDen) -ENDIF -IF (ALLOCATED(InputFileData%LDMassDen)) THEN - DEALLOCATE(InputFileData%LDMassDen) -ENDIF -IF (ALLOCATED(InputFileData%BottmStiff)) THEN - DEALLOCATE(InputFileData%BottmStiff) -ENDIF -IF (ALLOCATED(InputFileData%LRadAnch)) THEN - DEALLOCATE(InputFileData%LRadAnch) -ENDIF -IF (ALLOCATED(InputFileData%LAngAnch)) THEN - DEALLOCATE(InputFileData%LAngAnch) -ENDIF -IF (ALLOCATED(InputFileData%LDpthAnch)) THEN - DEALLOCATE(InputFileData%LDpthAnch) -ENDIF -IF (ALLOCATED(InputFileData%LRadFair)) THEN - DEALLOCATE(InputFileData%LRadFair) -ENDIF -IF (ALLOCATED(InputFileData%LAngFair)) THEN - DEALLOCATE(InputFileData%LAngFair) -ENDIF -IF (ALLOCATED(InputFileData%LDrftFair)) THEN - DEALLOCATE(InputFileData%LDrftFair) -ENDIF -IF (ALLOCATED(InputFileData%LUnstrLen)) THEN - DEALLOCATE(InputFileData%LUnstrLen) -ENDIF -IF (ALLOCATED(InputFileData%Tension)) THEN - DEALLOCATE(InputFileData%Tension) -ENDIF -IF (ALLOCATED(InputFileData%GSL)) THEN - DEALLOCATE(InputFileData%GSL) -ENDIF -IF (ALLOCATED(InputFileData%GSR)) THEN - DEALLOCATE(InputFileData%GSR) -ENDIF -IF (ALLOCATED(InputFileData%GE)) THEN - DEALLOCATE(InputFileData%GE) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF - END SUBROUTINE FEAM_DestroyInputFile - - SUBROUTINE FEAM_PackInputFile( 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(FEAM_InputFile), 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 = 'FEAM_PackInputFile' - ! 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 ! LineCI allocated yes/no - IF ( ALLOCATED(InData%LineCI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineCI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LineCI) ! LineCI - END IF - Int_BufSz = Int_BufSz + 1 ! LineCD allocated yes/no - IF ( ALLOCATED(InData%LineCD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineCD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LineCD) ! LineCD - END IF - Int_BufSz = Int_BufSz + 1 ! LEAStiff allocated yes/no - IF ( ALLOCATED(InData%LEAStiff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LEAStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LEAStiff) ! LEAStiff - END IF - Int_BufSz = Int_BufSz + 1 ! LMassDen allocated yes/no - IF ( ALLOCATED(InData%LMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LMassDen) ! LMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! LDMassDen allocated yes/no - IF ( ALLOCATED(InData%LDMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LDMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LDMassDen) ! LDMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! BottmStiff allocated yes/no - IF ( ALLOCATED(InData%BottmStiff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BottmStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BottmStiff) ! BottmStiff - END IF - Int_BufSz = Int_BufSz + 1 ! LRadAnch allocated yes/no - IF ( ALLOCATED(InData%LRadAnch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LRadAnch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LRadAnch) ! LRadAnch - END IF - Int_BufSz = Int_BufSz + 1 ! LAngAnch allocated yes/no - IF ( ALLOCATED(InData%LAngAnch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LAngAnch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LAngAnch) ! LAngAnch - END IF - Int_BufSz = Int_BufSz + 1 ! LDpthAnch allocated yes/no - IF ( ALLOCATED(InData%LDpthAnch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LDpthAnch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LDpthAnch) ! LDpthAnch - END IF - Int_BufSz = Int_BufSz + 1 ! LRadFair allocated yes/no - IF ( ALLOCATED(InData%LRadFair) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LRadFair upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LRadFair) ! LRadFair - END IF - Int_BufSz = Int_BufSz + 1 ! LAngFair allocated yes/no - IF ( ALLOCATED(InData%LAngFair) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LAngFair upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LAngFair) ! LAngFair - END IF - Int_BufSz = Int_BufSz + 1 ! LDrftFair allocated yes/no - IF ( ALLOCATED(InData%LDrftFair) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LDrftFair upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LDrftFair) ! LDrftFair - END IF - Int_BufSz = Int_BufSz + 1 ! LUnstrLen allocated yes/no - IF ( ALLOCATED(InData%LUnstrLen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LUnstrLen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LUnstrLen) ! LUnstrLen - END IF - Int_BufSz = Int_BufSz + 1 ! Tension allocated yes/no - IF ( ALLOCATED(InData%Tension) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Tension upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Tension) ! Tension - END IF - Int_BufSz = Int_BufSz + 1 ! GSL allocated yes/no - IF ( ALLOCATED(InData%GSL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GSL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GSL) ! GSL - END IF - Int_BufSz = Int_BufSz + 1 ! GSR allocated yes/no - IF ( ALLOCATED(InData%GSR) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GSR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GSR) ! GSR - END IF - Int_BufSz = Int_BufSz + 1 ! GE allocated yes/no - IF ( ALLOCATED(InData%GE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GE) ! GE - END IF - Int_BufSz = Int_BufSz + 1 ! NumLines - Int_BufSz = Int_BufSz + 1 ! NumElems - Re_BufSz = Re_BufSz + 1 ! Eps - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Int_BufSz = Int_BufSz + 1 ! MaxIter - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! OutFile - Int_BufSz = Int_BufSz + 1 ! TabDelim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Db_BufSz = Db_BufSz + 1 ! Tstart - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - 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 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LineCI) ) 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%LineCI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineCI,1), UBOUND(InData%LineCI,1) - ReKiBuf(Re_Xferred) = InData%LineCI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineCD) ) 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%LineCD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineCD,1), UBOUND(InData%LineCD,1) - ReKiBuf(Re_Xferred) = InData%LineCD(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LEAStiff) ) 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%LEAStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LEAStiff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LEAStiff,1), UBOUND(InData%LEAStiff,1) - ReKiBuf(Re_Xferred) = InData%LEAStiff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LMassDen) ) 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%LMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LMassDen,1), UBOUND(InData%LMassDen,1) - ReKiBuf(Re_Xferred) = InData%LMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LDMassDen) ) 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%LDMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LDMassDen,1), UBOUND(InData%LDMassDen,1) - ReKiBuf(Re_Xferred) = InData%LDMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BottmStiff) ) 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%BottmStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmStiff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BottmStiff,1), UBOUND(InData%BottmStiff,1) - ReKiBuf(Re_Xferred) = InData%BottmStiff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LRadAnch) ) 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%LRadAnch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LRadAnch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LRadAnch,1), UBOUND(InData%LRadAnch,1) - ReKiBuf(Re_Xferred) = InData%LRadAnch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LAngAnch) ) 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%LAngAnch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAngAnch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LAngAnch,1), UBOUND(InData%LAngAnch,1) - ReKiBuf(Re_Xferred) = InData%LAngAnch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LDpthAnch) ) 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%LDpthAnch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDpthAnch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LDpthAnch,1), UBOUND(InData%LDpthAnch,1) - ReKiBuf(Re_Xferred) = InData%LDpthAnch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LRadFair) ) 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%LRadFair,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LRadFair,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LRadFair,1), UBOUND(InData%LRadFair,1) - ReKiBuf(Re_Xferred) = InData%LRadFair(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LAngFair) ) 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%LAngFair,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAngFair,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LAngFair,1), UBOUND(InData%LAngFair,1) - ReKiBuf(Re_Xferred) = InData%LAngFair(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LDrftFair) ) 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%LDrftFair,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDrftFair,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LDrftFair,1), UBOUND(InData%LDrftFair,1) - ReKiBuf(Re_Xferred) = InData%LDrftFair(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LUnstrLen) ) 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%LUnstrLen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LUnstrLen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LUnstrLen,1), UBOUND(InData%LUnstrLen,1) - ReKiBuf(Re_Xferred) = InData%LUnstrLen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Tension) ) 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%Tension,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tension,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Tension,1), UBOUND(InData%Tension,1) - ReKiBuf(Re_Xferred) = InData%Tension(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GSL) ) 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%GSL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GSL,3), UBOUND(InData%GSL,3) - DO i2 = LBOUND(InData%GSL,2), UBOUND(InData%GSL,2) - DO i1 = LBOUND(InData%GSL,1), UBOUND(InData%GSL,1) - ReKiBuf(Re_Xferred) = InData%GSL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GSR) ) 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%GSR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSR,2) - Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%GSR,2), UBOUND(InData%GSR,2) - DO i1 = LBOUND(InData%GSR,1), UBOUND(InData%GSR,1) - ReKiBuf(Re_Xferred) = InData%GSR(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GE) ) 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%GE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GE,3), UBOUND(InData%GE,3) - DO i2 = LBOUND(InData%GE,2), UBOUND(InData%GE,2) - DO i1 = LBOUND(InData%GE,1), UBOUND(InData%GE,1) - ReKiBuf(Re_Xferred) = InData%GE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumElems - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Eps - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MaxIter - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) - 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 - DbKiBuf(Db_Xferred) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) 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%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - 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 - END IF - END SUBROUTINE FEAM_PackInputFile - - SUBROUTINE FEAM_UnPackInputFile( 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(FEAM_InputFile), 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 = 'FEAM_UnPackInputFile' - ! 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCI 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%LineCI)) DEALLOCATE(OutData%LineCI) - ALLOCATE(OutData%LineCI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineCI,1), UBOUND(OutData%LineCI,1) - OutData%LineCI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCD 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%LineCD)) DEALLOCATE(OutData%LineCD) - ALLOCATE(OutData%LineCD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineCD,1), UBOUND(OutData%LineCD,1) - OutData%LineCD(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LEAStiff 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%LEAStiff)) DEALLOCATE(OutData%LEAStiff) - ALLOCATE(OutData%LEAStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LEAStiff,1), UBOUND(OutData%LEAStiff,1) - OutData%LEAStiff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LMassDen 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%LMassDen)) DEALLOCATE(OutData%LMassDen) - ALLOCATE(OutData%LMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LMassDen,1), UBOUND(OutData%LMassDen,1) - OutData%LMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDMassDen 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%LDMassDen)) DEALLOCATE(OutData%LDMassDen) - ALLOCATE(OutData%LDMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LDMassDen,1), UBOUND(OutData%LDMassDen,1) - OutData%LDMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmStiff 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%BottmStiff)) DEALLOCATE(OutData%BottmStiff) - ALLOCATE(OutData%BottmStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BottmStiff,1), UBOUND(OutData%BottmStiff,1) - OutData%BottmStiff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LRadAnch 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%LRadAnch)) DEALLOCATE(OutData%LRadAnch) - ALLOCATE(OutData%LRadAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LRadAnch,1), UBOUND(OutData%LRadAnch,1) - OutData%LRadAnch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAngAnch 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%LAngAnch)) DEALLOCATE(OutData%LAngAnch) - ALLOCATE(OutData%LAngAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LAngAnch,1), UBOUND(OutData%LAngAnch,1) - OutData%LAngAnch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDpthAnch 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%LDpthAnch)) DEALLOCATE(OutData%LDpthAnch) - ALLOCATE(OutData%LDpthAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDpthAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LDpthAnch,1), UBOUND(OutData%LDpthAnch,1) - OutData%LDpthAnch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LRadFair 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%LRadFair)) DEALLOCATE(OutData%LRadFair) - ALLOCATE(OutData%LRadFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LRadFair,1), UBOUND(OutData%LRadFair,1) - OutData%LRadFair(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAngFair 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%LAngFair)) DEALLOCATE(OutData%LAngFair) - ALLOCATE(OutData%LAngFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LAngFair,1), UBOUND(OutData%LAngFair,1) - OutData%LAngFair(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDrftFair 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%LDrftFair)) DEALLOCATE(OutData%LDrftFair) - ALLOCATE(OutData%LDrftFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDrftFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LDrftFair,1), UBOUND(OutData%LDrftFair,1) - OutData%LDrftFair(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LUnstrLen 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%LUnstrLen)) DEALLOCATE(OutData%LUnstrLen) - ALLOCATE(OutData%LUnstrLen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LUnstrLen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LUnstrLen,1), UBOUND(OutData%LUnstrLen,1) - OutData%LUnstrLen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Tension 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%Tension)) DEALLOCATE(OutData%Tension) - ALLOCATE(OutData%Tension(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tension.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Tension,1), UBOUND(OutData%Tension,1) - OutData%Tension(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSL 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%GSL)) DEALLOCATE(OutData%GSL) - ALLOCATE(OutData%GSL(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%GSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GSL,3), UBOUND(OutData%GSL,3) - DO i2 = LBOUND(OutData%GSL,2), UBOUND(OutData%GSL,2) - DO i1 = LBOUND(OutData%GSL,1), UBOUND(OutData%GSL,1) - OutData%GSL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSR 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%GSR)) DEALLOCATE(OutData%GSR) - ALLOCATE(OutData%GSR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GSR,2), UBOUND(OutData%GSR,2) - DO i1 = LBOUND(OutData%GSR,1), UBOUND(OutData%GSR,1) - OutData%GSR(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GE 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%GE)) DEALLOCATE(OutData%GE) - ALLOCATE(OutData%GE(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%GE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GE,3), UBOUND(OutData%GE,3) - DO i2 = LBOUND(OutData%GE,2), UBOUND(OutData%GE,2) - DO i1 = LBOUND(OutData%GE,1), UBOUND(OutData%GE,1) - OutData%GE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%NumLines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumElems = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Eps = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) - 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 - OutData%Tstart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 - END SUBROUTINE FEAM_UnPackInputFile - - SUBROUTINE FEAM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(FEAM_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyInitInput' -! +subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_InputFile), intent(in) :: SrcInputFileData + type(FEAM_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FEAM_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit - DstInitInputData%NStepWave = SrcInitInputData%NStepWave -IF (ALLOCATED(SrcInitInputData%WaveAcc0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveAcc0,1) - i1_u = UBOUND(SrcInitInputData%WaveAcc0,1) - i2_l = LBOUND(SrcInitInputData%WaveAcc0,2) - i2_u = UBOUND(SrcInitInputData%WaveAcc0,2) - i3_l = LBOUND(SrcInitInputData%WaveAcc0,3) - i3_u = UBOUND(SrcInitInputData%WaveAcc0,3) - IF (.NOT. ALLOCATED(DstInitInputData%WaveAcc0)) THEN - ALLOCATE(DstInitInputData%WaveAcc0(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%WaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveAcc0 = SrcInitInputData%WaveAcc0 -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 -IF (ALLOCATED(SrcInitInputData%WaveVel0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveVel0,1) - i1_u = UBOUND(SrcInitInputData%WaveVel0,1) - i2_l = LBOUND(SrcInitInputData%WaveVel0,2) - i2_u = UBOUND(SrcInitInputData%WaveVel0,2) - i3_l = LBOUND(SrcInitInputData%WaveVel0,3) - i3_u = UBOUND(SrcInitInputData%WaveVel0,3) - IF (.NOT. ALLOCATED(DstInitInputData%WaveVel0)) THEN - ALLOCATE(DstInitInputData%WaveVel0(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%WaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveVel0 = SrcInitInputData%WaveVel0 -ENDIF - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - END SUBROUTINE FEAM_CopyInitInput - - SUBROUTINE FEAM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(FEAM_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 = 'FEAM_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%WaveAcc0)) THEN - DEALLOCATE(InitInputData%WaveAcc0) -ENDIF -IF (ALLOCATED(InitInputData%WaveTime)) THEN - DEALLOCATE(InitInputData%WaveTime) -ENDIF -IF (ALLOCATED(InitInputData%WaveVel0)) THEN - DEALLOCATE(InitInputData%WaveVel0) -ENDIF - END SUBROUTINE FEAM_DestroyInitInput - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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%RootName) ! RootName - Re_BufSz = Re_BufSz + SIZE(InData%PtfmInit) ! PtfmInit - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! WaveAcc0 allocated yes/no - IF ( ALLOCATED(InData%WaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc0) ! WaveAcc0 - 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 ! WaveVel0 allocated yes/no - IF ( ALLOCATED(InData%WaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel0) ! WaveVel0 - END IF - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - 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%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) - ReKiBuf(Re_Xferred) = InData%PtfmInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - 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 - - 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) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - 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 - - 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) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FEAM_PackInitInput - - SUBROUTINE FEAM_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(FEAM_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_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%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%PtfmInit,1) - i1_u = UBOUND(OutData%PtfmInit,1) - DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) - OutData%PtfmInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 - IF (ALLOCATED(OutData%WaveAcc0)) DEALLOCATE(OutData%WaveAcc0) - ALLOCATE(OutData%WaveAcc0(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%WaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - 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) = ReKiBuf(Re_Xferred) - 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 (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) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 - IF (ALLOCATED(OutData%WaveVel0)) DEALLOCATE(OutData%WaveVel0) - ALLOCATE(OutData%WaveVel0(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%WaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - 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) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FEAM_UnPackInitInput - - SUBROUTINE FEAM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(FEAM_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 = 'FEAM_CopyInitOutput' -! + ErrMsg = '' + DstInputFileData%DT = SrcInputFileData%DT + if (allocated(SrcInputFileData%LineCI)) then + LB(1:1) = lbound(SrcInputFileData%LineCI) + UB(1:1) = ubound(SrcInputFileData%LineCI) + if (.not. allocated(DstInputFileData%LineCI)) then + allocate(DstInputFileData%LineCI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LineCI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LineCI = SrcInputFileData%LineCI + end if + if (allocated(SrcInputFileData%LineCD)) then + LB(1:1) = lbound(SrcInputFileData%LineCD) + UB(1:1) = ubound(SrcInputFileData%LineCD) + if (.not. allocated(DstInputFileData%LineCD)) then + allocate(DstInputFileData%LineCD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LineCD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LineCD = SrcInputFileData%LineCD + end if + if (allocated(SrcInputFileData%LEAStiff)) then + LB(1:1) = lbound(SrcInputFileData%LEAStiff) + UB(1:1) = ubound(SrcInputFileData%LEAStiff) + if (.not. allocated(DstInputFileData%LEAStiff)) then + allocate(DstInputFileData%LEAStiff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LEAStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LEAStiff = SrcInputFileData%LEAStiff + end if + if (allocated(SrcInputFileData%LMassDen)) then + LB(1:1) = lbound(SrcInputFileData%LMassDen) + UB(1:1) = ubound(SrcInputFileData%LMassDen) + if (.not. allocated(DstInputFileData%LMassDen)) then + allocate(DstInputFileData%LMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LMassDen = SrcInputFileData%LMassDen + end if + if (allocated(SrcInputFileData%LDMassDen)) then + LB(1:1) = lbound(SrcInputFileData%LDMassDen) + UB(1:1) = ubound(SrcInputFileData%LDMassDen) + if (.not. allocated(DstInputFileData%LDMassDen)) then + allocate(DstInputFileData%LDMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LDMassDen = SrcInputFileData%LDMassDen + end if + if (allocated(SrcInputFileData%BottmStiff)) then + LB(1:1) = lbound(SrcInputFileData%BottmStiff) + UB(1:1) = ubound(SrcInputFileData%BottmStiff) + if (.not. allocated(DstInputFileData%BottmStiff)) then + allocate(DstInputFileData%BottmStiff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BottmStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BottmStiff = SrcInputFileData%BottmStiff + end if + if (allocated(SrcInputFileData%LRadAnch)) then + LB(1:1) = lbound(SrcInputFileData%LRadAnch) + UB(1:1) = ubound(SrcInputFileData%LRadAnch) + if (.not. allocated(DstInputFileData%LRadAnch)) then + allocate(DstInputFileData%LRadAnch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LRadAnch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LRadAnch = SrcInputFileData%LRadAnch + end if + if (allocated(SrcInputFileData%LAngAnch)) then + LB(1:1) = lbound(SrcInputFileData%LAngAnch) + UB(1:1) = ubound(SrcInputFileData%LAngAnch) + if (.not. allocated(DstInputFileData%LAngAnch)) then + allocate(DstInputFileData%LAngAnch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LAngAnch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LAngAnch = SrcInputFileData%LAngAnch + end if + if (allocated(SrcInputFileData%LDpthAnch)) then + LB(1:1) = lbound(SrcInputFileData%LDpthAnch) + UB(1:1) = ubound(SrcInputFileData%LDpthAnch) + if (.not. allocated(DstInputFileData%LDpthAnch)) then + allocate(DstInputFileData%LDpthAnch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDpthAnch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LDpthAnch = SrcInputFileData%LDpthAnch + end if + if (allocated(SrcInputFileData%LRadFair)) then + LB(1:1) = lbound(SrcInputFileData%LRadFair) + UB(1:1) = ubound(SrcInputFileData%LRadFair) + if (.not. allocated(DstInputFileData%LRadFair)) then + allocate(DstInputFileData%LRadFair(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LRadFair.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LRadFair = SrcInputFileData%LRadFair + end if + if (allocated(SrcInputFileData%LAngFair)) then + LB(1:1) = lbound(SrcInputFileData%LAngFair) + UB(1:1) = ubound(SrcInputFileData%LAngFair) + if (.not. allocated(DstInputFileData%LAngFair)) then + allocate(DstInputFileData%LAngFair(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LAngFair.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LAngFair = SrcInputFileData%LAngFair + end if + if (allocated(SrcInputFileData%LDrftFair)) then + LB(1:1) = lbound(SrcInputFileData%LDrftFair) + UB(1:1) = ubound(SrcInputFileData%LDrftFair) + if (.not. allocated(DstInputFileData%LDrftFair)) then + allocate(DstInputFileData%LDrftFair(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDrftFair.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LDrftFair = SrcInputFileData%LDrftFair + end if + if (allocated(SrcInputFileData%LUnstrLen)) then + LB(1:1) = lbound(SrcInputFileData%LUnstrLen) + UB(1:1) = ubound(SrcInputFileData%LUnstrLen) + if (.not. allocated(DstInputFileData%LUnstrLen)) then + allocate(DstInputFileData%LUnstrLen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LUnstrLen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LUnstrLen = SrcInputFileData%LUnstrLen + end if + if (allocated(SrcInputFileData%Tension)) then + LB(1:1) = lbound(SrcInputFileData%Tension) + UB(1:1) = ubound(SrcInputFileData%Tension) + if (.not. allocated(DstInputFileData%Tension)) then + allocate(DstInputFileData%Tension(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Tension.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Tension = SrcInputFileData%Tension + end if + if (allocated(SrcInputFileData%GSL)) then + LB(1:3) = lbound(SrcInputFileData%GSL) + UB(1:3) = ubound(SrcInputFileData%GSL) + if (.not. allocated(DstInputFileData%GSL)) then + allocate(DstInputFileData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GSL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%GSL = SrcInputFileData%GSL + end if + if (allocated(SrcInputFileData%GSR)) then + LB(1:2) = lbound(SrcInputFileData%GSR) + UB(1:2) = ubound(SrcInputFileData%GSR) + if (.not. allocated(DstInputFileData%GSR)) then + allocate(DstInputFileData%GSR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GSR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%GSR = SrcInputFileData%GSR + end if + if (allocated(SrcInputFileData%GE)) then + LB(1:3) = lbound(SrcInputFileData%GE) + UB(1:3) = ubound(SrcInputFileData%GE) + if (.not. allocated(DstInputFileData%GE)) then + allocate(DstInputFileData%GE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%GE = SrcInputFileData%GE + end if + DstInputFileData%NumLines = SrcInputFileData%NumLines + DstInputFileData%NumElems = SrcInputFileData%NumElems + DstInputFileData%Eps = SrcInputFileData%Eps + DstInputFileData%Gravity = SrcInputFileData%Gravity + DstInputFileData%WtrDens = SrcInputFileData%WtrDens + DstInputFileData%MaxIter = SrcInputFileData%MaxIter + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%OutFile = SrcInputFileData%OutFile + DstInputFileData%TabDelim = SrcInputFileData%TabDelim + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%Tstart = SrcInputFileData%Tstart + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + end if +end subroutine + +subroutine FEAM_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(FEAM_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyInputFile' 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 - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%LAnchxi)) THEN - i1_l = LBOUND(SrcInitOutputData%LAnchxi,1) - i1_u = UBOUND(SrcInitOutputData%LAnchxi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LAnchxi)) THEN - ALLOCATE(DstInitOutputData%LAnchxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LAnchxi = SrcInitOutputData%LAnchxi -ENDIF -IF (ALLOCATED(SrcInitOutputData%LAnchyi)) THEN - i1_l = LBOUND(SrcInitOutputData%LAnchyi,1) - i1_u = UBOUND(SrcInitOutputData%LAnchyi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LAnchyi)) THEN - ALLOCATE(DstInitOutputData%LAnchyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LAnchyi = SrcInitOutputData%LAnchyi -ENDIF -IF (ALLOCATED(SrcInitOutputData%LAnchzi)) THEN - i1_l = LBOUND(SrcInitOutputData%LAnchzi,1) - i1_u = UBOUND(SrcInitOutputData%LAnchzi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LAnchzi)) THEN - ALLOCATE(DstInitOutputData%LAnchzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LAnchzi = SrcInitOutputData%LAnchzi -ENDIF -IF (ALLOCATED(SrcInitOutputData%LFairxt)) THEN - i1_l = LBOUND(SrcInitOutputData%LFairxt,1) - i1_u = UBOUND(SrcInitOutputData%LFairxt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LFairxt)) THEN - ALLOCATE(DstInitOutputData%LFairxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LFairxt = SrcInitOutputData%LFairxt -ENDIF -IF (ALLOCATED(SrcInitOutputData%LFairyt)) THEN - i1_l = LBOUND(SrcInitOutputData%LFairyt,1) - i1_u = UBOUND(SrcInitOutputData%LFairyt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LFairyt)) THEN - ALLOCATE(DstInitOutputData%LFairyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LFairyt = SrcInitOutputData%LFairyt -ENDIF -IF (ALLOCATED(SrcInitOutputData%LFairzt)) THEN - i1_l = LBOUND(SrcInitOutputData%LFairzt,1) - i1_u = UBOUND(SrcInitOutputData%LFairzt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LFairzt)) THEN - ALLOCATE(DstInitOutputData%LFairzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LFairzt = SrcInitOutputData%LFairzt -ENDIF - END SUBROUTINE FEAM_CopyInitOutput - - SUBROUTINE FEAM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(FEAM_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 = 'FEAM_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%LAnchxi)) THEN - DEALLOCATE(InitOutputData%LAnchxi) -ENDIF -IF (ALLOCATED(InitOutputData%LAnchyi)) THEN - DEALLOCATE(InitOutputData%LAnchyi) -ENDIF -IF (ALLOCATED(InitOutputData%LAnchzi)) THEN - DEALLOCATE(InitOutputData%LAnchzi) -ENDIF -IF (ALLOCATED(InitOutputData%LFairxt)) THEN - DEALLOCATE(InitOutputData%LFairxt) -ENDIF -IF (ALLOCATED(InitOutputData%LFairyt)) THEN - DEALLOCATE(InitOutputData%LFairyt) -ENDIF -IF (ALLOCATED(InitOutputData%LFairzt)) THEN - DEALLOCATE(InitOutputData%LFairzt) -ENDIF - END SUBROUTINE FEAM_DestroyInitOutput - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! LAnchxi allocated yes/no - IF ( ALLOCATED(InData%LAnchxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LAnchxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LAnchxi) ! LAnchxi - END IF - Int_BufSz = Int_BufSz + 1 ! LAnchyi allocated yes/no - IF ( ALLOCATED(InData%LAnchyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LAnchyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LAnchyi) ! LAnchyi - END IF - Int_BufSz = Int_BufSz + 1 ! LAnchzi allocated yes/no - IF ( ALLOCATED(InData%LAnchzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LAnchzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LAnchzi) ! LAnchzi - END IF - Int_BufSz = Int_BufSz + 1 ! LFairxt allocated yes/no - IF ( ALLOCATED(InData%LFairxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LFairxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LFairxt) ! LFairxt - END IF - Int_BufSz = Int_BufSz + 1 ! LFairyt allocated yes/no - IF ( ALLOCATED(InData%LFairyt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LFairyt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LFairyt) ! LFairyt - END IF - Int_BufSz = Int_BufSz + 1 ! LFairzt allocated yes/no - IF ( ALLOCATED(InData%LFairzt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LFairzt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LFairzt) ! LFairzt - 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%LAnchxi) ) 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%LAnchxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LAnchxi,1), UBOUND(InData%LAnchxi,1) - ReKiBuf(Re_Xferred) = InData%LAnchxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LAnchyi) ) 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%LAnchyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LAnchyi,1), UBOUND(InData%LAnchyi,1) - ReKiBuf(Re_Xferred) = InData%LAnchyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LAnchzi) ) 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%LAnchzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LAnchzi,1), UBOUND(InData%LAnchzi,1) - ReKiBuf(Re_Xferred) = InData%LAnchzi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LFairxt) ) 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%LFairxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LFairxt,1), UBOUND(InData%LFairxt,1) - ReKiBuf(Re_Xferred) = InData%LFairxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LFairyt) ) 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%LFairyt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairyt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LFairyt,1), UBOUND(InData%LFairyt,1) - ReKiBuf(Re_Xferred) = InData%LFairyt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LFairzt) ) 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%LFairzt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairzt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LFairzt,1), UBOUND(InData%LFairzt,1) - ReKiBuf(Re_Xferred) = InData%LFairzt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FEAM_PackInitOutput - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAnchxi 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%LAnchxi)) DEALLOCATE(OutData%LAnchxi) - ALLOCATE(OutData%LAnchxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LAnchxi,1), UBOUND(OutData%LAnchxi,1) - OutData%LAnchxi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAnchyi 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%LAnchyi)) DEALLOCATE(OutData%LAnchyi) - ALLOCATE(OutData%LAnchyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LAnchyi,1), UBOUND(OutData%LAnchyi,1) - OutData%LAnchyi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAnchzi 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%LAnchzi)) DEALLOCATE(OutData%LAnchzi) - ALLOCATE(OutData%LAnchzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LAnchzi,1), UBOUND(OutData%LAnchzi,1) - OutData%LAnchzi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairxt 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%LFairxt)) DEALLOCATE(OutData%LFairxt) - ALLOCATE(OutData%LFairxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LFairxt,1), UBOUND(OutData%LFairxt,1) - OutData%LFairxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairyt 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%LFairyt)) DEALLOCATE(OutData%LFairyt) - ALLOCATE(OutData%LFairyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LFairyt,1), UBOUND(OutData%LFairyt,1) - OutData%LFairyt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairzt 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%LFairzt)) DEALLOCATE(OutData%LFairzt) - ALLOCATE(OutData%LFairzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LFairzt,1), UBOUND(OutData%LFairzt,1) - OutData%LFairzt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FEAM_UnPackInitOutput - - SUBROUTINE FEAM_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(FEAM_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) :: 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 = 'FEAM_CopyContState' -! + ErrMsg = '' + if (allocated(InputFileData%LineCI)) then + deallocate(InputFileData%LineCI) + end if + if (allocated(InputFileData%LineCD)) then + deallocate(InputFileData%LineCD) + end if + if (allocated(InputFileData%LEAStiff)) then + deallocate(InputFileData%LEAStiff) + end if + if (allocated(InputFileData%LMassDen)) then + deallocate(InputFileData%LMassDen) + end if + if (allocated(InputFileData%LDMassDen)) then + deallocate(InputFileData%LDMassDen) + end if + if (allocated(InputFileData%BottmStiff)) then + deallocate(InputFileData%BottmStiff) + end if + if (allocated(InputFileData%LRadAnch)) then + deallocate(InputFileData%LRadAnch) + end if + if (allocated(InputFileData%LAngAnch)) then + deallocate(InputFileData%LAngAnch) + end if + if (allocated(InputFileData%LDpthAnch)) then + deallocate(InputFileData%LDpthAnch) + end if + if (allocated(InputFileData%LRadFair)) then + deallocate(InputFileData%LRadFair) + end if + if (allocated(InputFileData%LAngFair)) then + deallocate(InputFileData%LAngFair) + end if + if (allocated(InputFileData%LDrftFair)) then + deallocate(InputFileData%LDrftFair) + end if + if (allocated(InputFileData%LUnstrLen)) then + deallocate(InputFileData%LUnstrLen) + end if + if (allocated(InputFileData%Tension)) then + deallocate(InputFileData%Tension) + end if + if (allocated(InputFileData%GSL)) then + deallocate(InputFileData%GSL) + end if + if (allocated(InputFileData%GSR)) then + deallocate(InputFileData%GSR) + end if + if (allocated(InputFileData%GE)) then + deallocate(InputFileData%GE) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if +end subroutine + +subroutine FEAM_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, allocated(InData%LineCI)) + if (allocated(InData%LineCI)) then + call RegPackBounds(Buf, 1, lbound(InData%LineCI), ubound(InData%LineCI)) + call RegPack(Buf, InData%LineCI) + end if + call RegPack(Buf, allocated(InData%LineCD)) + if (allocated(InData%LineCD)) then + call RegPackBounds(Buf, 1, lbound(InData%LineCD), ubound(InData%LineCD)) + call RegPack(Buf, InData%LineCD) + end if + call RegPack(Buf, allocated(InData%LEAStiff)) + if (allocated(InData%LEAStiff)) then + call RegPackBounds(Buf, 1, lbound(InData%LEAStiff), ubound(InData%LEAStiff)) + call RegPack(Buf, InData%LEAStiff) + end if + call RegPack(Buf, allocated(InData%LMassDen)) + if (allocated(InData%LMassDen)) then + call RegPackBounds(Buf, 1, lbound(InData%LMassDen), ubound(InData%LMassDen)) + call RegPack(Buf, InData%LMassDen) + end if + call RegPack(Buf, allocated(InData%LDMassDen)) + if (allocated(InData%LDMassDen)) then + call RegPackBounds(Buf, 1, lbound(InData%LDMassDen), ubound(InData%LDMassDen)) + call RegPack(Buf, InData%LDMassDen) + end if + call RegPack(Buf, allocated(InData%BottmStiff)) + if (allocated(InData%BottmStiff)) then + call RegPackBounds(Buf, 1, lbound(InData%BottmStiff), ubound(InData%BottmStiff)) + call RegPack(Buf, InData%BottmStiff) + end if + call RegPack(Buf, allocated(InData%LRadAnch)) + if (allocated(InData%LRadAnch)) then + call RegPackBounds(Buf, 1, lbound(InData%LRadAnch), ubound(InData%LRadAnch)) + call RegPack(Buf, InData%LRadAnch) + end if + call RegPack(Buf, allocated(InData%LAngAnch)) + if (allocated(InData%LAngAnch)) then + call RegPackBounds(Buf, 1, lbound(InData%LAngAnch), ubound(InData%LAngAnch)) + call RegPack(Buf, InData%LAngAnch) + end if + call RegPack(Buf, allocated(InData%LDpthAnch)) + if (allocated(InData%LDpthAnch)) then + call RegPackBounds(Buf, 1, lbound(InData%LDpthAnch), ubound(InData%LDpthAnch)) + call RegPack(Buf, InData%LDpthAnch) + end if + call RegPack(Buf, allocated(InData%LRadFair)) + if (allocated(InData%LRadFair)) then + call RegPackBounds(Buf, 1, lbound(InData%LRadFair), ubound(InData%LRadFair)) + call RegPack(Buf, InData%LRadFair) + end if + call RegPack(Buf, allocated(InData%LAngFair)) + if (allocated(InData%LAngFair)) then + call RegPackBounds(Buf, 1, lbound(InData%LAngFair), ubound(InData%LAngFair)) + call RegPack(Buf, InData%LAngFair) + end if + call RegPack(Buf, allocated(InData%LDrftFair)) + if (allocated(InData%LDrftFair)) then + call RegPackBounds(Buf, 1, lbound(InData%LDrftFair), ubound(InData%LDrftFair)) + call RegPack(Buf, InData%LDrftFair) + end if + call RegPack(Buf, allocated(InData%LUnstrLen)) + if (allocated(InData%LUnstrLen)) then + call RegPackBounds(Buf, 1, lbound(InData%LUnstrLen), ubound(InData%LUnstrLen)) + call RegPack(Buf, InData%LUnstrLen) + end if + call RegPack(Buf, allocated(InData%Tension)) + if (allocated(InData%Tension)) then + call RegPackBounds(Buf, 1, lbound(InData%Tension), ubound(InData%Tension)) + call RegPack(Buf, InData%Tension) + end if + call RegPack(Buf, allocated(InData%GSL)) + if (allocated(InData%GSL)) then + call RegPackBounds(Buf, 3, lbound(InData%GSL), ubound(InData%GSL)) + call RegPack(Buf, InData%GSL) + end if + call RegPack(Buf, allocated(InData%GSR)) + if (allocated(InData%GSR)) then + call RegPackBounds(Buf, 2, lbound(InData%GSR), ubound(InData%GSR)) + call RegPack(Buf, InData%GSR) + end if + call RegPack(Buf, allocated(InData%GE)) + if (allocated(InData%GE)) then + call RegPackBounds(Buf, 3, lbound(InData%GE), ubound(InData%GE)) + call RegPack(Buf, InData%GE) + end if + call RegPack(Buf, InData%NumLines) + call RegPack(Buf, InData%NumElems) + call RegPack(Buf, InData%Eps) + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%WtrDens) + call RegPack(Buf, InData%MaxIter) + call RegPack(Buf, InData%SumPrint) + call RegPack(Buf, InData%OutFile) + call RegPack(Buf, InData%TabDelim) + call RegPack(Buf, InData%OutFmt) + call RegPack(Buf, InData%Tstart) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackInputFile' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%LineCI)) deallocate(OutData%LineCI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineCI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LineCI) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LineCD)) deallocate(OutData%LineCD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineCD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LineCD) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LEAStiff)) deallocate(OutData%LEAStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LEAStiff(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LEAStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LMassDen)) deallocate(OutData%LMassDen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LMassDen(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LMassDen) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LDMassDen)) deallocate(OutData%LDMassDen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LDMassDen(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LDMassDen) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BottmStiff)) deallocate(OutData%BottmStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BottmStiff(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BottmStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LRadAnch)) deallocate(OutData%LRadAnch) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LRadAnch(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadAnch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LRadAnch) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LAngAnch)) deallocate(OutData%LAngAnch) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LAngAnch(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngAnch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LAngAnch) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LDpthAnch)) deallocate(OutData%LDpthAnch) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LDpthAnch(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDpthAnch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LDpthAnch) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LRadFair)) deallocate(OutData%LRadFair) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LRadFair(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadFair.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LRadFair) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LAngFair)) deallocate(OutData%LAngFair) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LAngFair(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngFair.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LAngFair) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LDrftFair)) deallocate(OutData%LDrftFair) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LDrftFair(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDrftFair.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LDrftFair) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LUnstrLen)) deallocate(OutData%LUnstrLen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LUnstrLen(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LUnstrLen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LUnstrLen) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Tension)) deallocate(OutData%Tension) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Tension(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tension.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Tension) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%GSL)) deallocate(OutData%GSL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GSL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%GSR)) deallocate(OutData%GSR) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GSR(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GSR) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%GE)) deallocate(OutData%GE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GE) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NumLines) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumElems) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Eps) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MaxIter) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TabDelim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Tstart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_InitInputType), intent(in) :: SrcInitInputData + type(FEAM_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FEAM_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%GLU)) THEN - i1_l = LBOUND(SrcContStateData%GLU,1) - i1_u = UBOUND(SrcContStateData%GLU,1) - i2_l = LBOUND(SrcContStateData%GLU,2) - i2_u = UBOUND(SrcContStateData%GLU,2) - IF (.NOT. ALLOCATED(DstContStateData%GLU)) THEN - ALLOCATE(DstContStateData%GLU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%GLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%GLU = SrcContStateData%GLU -ENDIF -IF (ALLOCATED(SrcContStateData%GLDU)) THEN - i1_l = LBOUND(SrcContStateData%GLDU,1) - i1_u = UBOUND(SrcContStateData%GLDU,1) - i2_l = LBOUND(SrcContStateData%GLDU,2) - i2_u = UBOUND(SrcContStateData%GLDU,2) - IF (.NOT. ALLOCATED(DstContStateData%GLDU)) THEN - ALLOCATE(DstContStateData%GLDU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%GLDU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%GLDU = SrcContStateData%GLDU -ENDIF - END SUBROUTINE FEAM_CopyContState - - SUBROUTINE FEAM_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(FEAM_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 = 'FEAM_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%GLU)) THEN - DEALLOCATE(ContStateData%GLU) -ENDIF -IF (ALLOCATED(ContStateData%GLDU)) THEN - DEALLOCATE(ContStateData%GLDU) -ENDIF - END SUBROUTINE FEAM_DestroyContState - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 - Int_BufSz = Int_BufSz + 1 ! GLU allocated yes/no - IF ( ALLOCATED(InData%GLU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLU) ! GLU - END IF - Int_BufSz = Int_BufSz + 1 ! GLDU allocated yes/no - IF ( ALLOCATED(InData%GLDU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GLDU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLDU) ! GLDU - 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%GLU) ) 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%GLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GLU,2), UBOUND(InData%GLU,2) - DO i1 = LBOUND(InData%GLU,1), UBOUND(InData%GLU,1) - ReKiBuf(Re_Xferred) = InData%GLU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GLDU) ) 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%GLDU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLDU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GLDU,2), UBOUND(InData%GLDU,2) - DO i1 = LBOUND(InData%GLDU,1), UBOUND(InData%GLDU,1) - ReKiBuf(Re_Xferred) = InData%GLDU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FEAM_PackContState - - SUBROUTINE FEAM_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(FEAM_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) :: 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 = 'FEAM_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLU 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%GLU)) DEALLOCATE(OutData%GLU) - ALLOCATE(OutData%GLU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GLU,2), UBOUND(OutData%GLU,2) - DO i1 = LBOUND(OutData%GLU,1), UBOUND(OutData%GLU,1) - OutData%GLU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLDU 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%GLDU)) DEALLOCATE(OutData%GLDU) - ALLOCATE(OutData%GLDU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GLDU,2), UBOUND(OutData%GLDU,2) - DO i1 = LBOUND(OutData%GLDU,1), UBOUND(OutData%GLDU,1) - OutData%GLDU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FEAM_UnPackContState - - SUBROUTINE FEAM_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(FEAM_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 = 'FEAM_CopyDiscState' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit + DstInitInputData%NStepWave = SrcInitInputData%NStepWave + if (allocated(SrcInitInputData%WaveAcc0)) then + LB(1:3) = lbound(SrcInitInputData%WaveAcc0) + UB(1:3) = ubound(SrcInitInputData%WaveAcc0) + if (.not. allocated(DstInitInputData%WaveAcc0)) then + allocate(DstInitInputData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveAcc0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveAcc0 = SrcInitInputData%WaveAcc0 + end if + if (allocated(SrcInitInputData%WaveTime)) then + LB(1:1) = lbound(SrcInitInputData%WaveTime) + UB(1:1) = ubound(SrcInitInputData%WaveTime) + if (.not. allocated(DstInitInputData%WaveTime)) then + allocate(DstInitInputData%WaveTime(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitInputData%WaveVel0)) then + LB(1:3) = lbound(SrcInitInputData%WaveVel0) + UB(1:3) = ubound(SrcInitInputData%WaveVel0) + if (.not. allocated(DstInitInputData%WaveVel0)) then + allocate(DstInitInputData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveVel0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveVel0 = SrcInitInputData%WaveVel0 + end if + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%WtrDens = SrcInitInputData%WtrDens +end subroutine + +subroutine FEAM_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(FEAM_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE FEAM_CopyDiscState - - SUBROUTINE FEAM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(FEAM_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 = 'FEAM_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE FEAM_DestroyDiscState - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 FEAM_PackDiscState - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FEAM_UnPackDiscState - - SUBROUTINE FEAM_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(FEAM_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyConstrState' -! + ErrMsg = '' + if (allocated(InitInputData%WaveAcc0)) then + deallocate(InitInputData%WaveAcc0) + end if + if (allocated(InitInputData%WaveTime)) then + deallocate(InitInputData%WaveTime) + end if + if (allocated(InitInputData%WaveVel0)) then + deallocate(InitInputData%WaveVel0) + end if +end subroutine + +subroutine FEAM_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%PtfmInit) + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, allocated(InData%WaveAcc0)) + if (allocated(InData%WaveAcc0)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveAcc0), ubound(InData%WaveAcc0)) + call RegPack(Buf, InData%WaveAcc0) + end if + call RegPack(Buf, allocated(InData%WaveTime)) + if (allocated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPack(Buf, InData%WaveTime) + end if + call RegPack(Buf, allocated(InData%WaveVel0)) + if (allocated(InData%WaveVel0)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveVel0), ubound(InData%WaveVel0)) + call RegPack(Buf, InData%WaveVel0) + end if + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmInit) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WaveAcc0)) deallocate(OutData%WaveAcc0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveAcc0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveVel0)) deallocate(OutData%WaveVel0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveVel0) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_InitOutputType), intent(in) :: SrcInitOutputData + type(FEAM_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%TSN = SrcConstrStateData%TSN - DstConstrStateData%TZER = SrcConstrStateData%TZER - END SUBROUTINE FEAM_CopyConstrState - - SUBROUTINE FEAM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(FEAM_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 = 'FEAM_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE FEAM_DestroyConstrState - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 + SIZE(InData%TSN) ! TSN - Re_BufSz = Re_BufSz + SIZE(InData%TZER) ! TZER - 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 i1 = LBOUND(InData%TSN,1), UBOUND(InData%TSN,1) - ReKiBuf(Re_Xferred) = InData%TSN(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TZER,1), UBOUND(InData%TZER,1) - ReKiBuf(Re_Xferred) = InData%TZER(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FEAM_PackConstrState - - SUBROUTINE FEAM_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(FEAM_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_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 - i1_l = LBOUND(OutData%TSN,1) - i1_u = UBOUND(OutData%TSN,1) - DO i1 = LBOUND(OutData%TSN,1), UBOUND(OutData%TSN,1) - OutData%TSN(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TZER,1) - i1_u = UBOUND(OutData%TZER,1) - DO i1 = LBOUND(OutData%TZER,1), UBOUND(OutData%TZER,1) - OutData%TZER(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FEAM_UnPackConstrState - - SUBROUTINE FEAM_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(FEAM_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) :: 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_CopyOtherState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%LAnchxi)) then + LB(1:1) = lbound(SrcInitOutputData%LAnchxi) + UB(1:1) = ubound(SrcInitOutputData%LAnchxi) + if (.not. allocated(DstInitOutputData%LAnchxi)) then + allocate(DstInitOutputData%LAnchxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LAnchxi = SrcInitOutputData%LAnchxi + end if + if (allocated(SrcInitOutputData%LAnchyi)) then + LB(1:1) = lbound(SrcInitOutputData%LAnchyi) + UB(1:1) = ubound(SrcInitOutputData%LAnchyi) + if (.not. allocated(DstInitOutputData%LAnchyi)) then + allocate(DstInitOutputData%LAnchyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LAnchyi = SrcInitOutputData%LAnchyi + end if + if (allocated(SrcInitOutputData%LAnchzi)) then + LB(1:1) = lbound(SrcInitOutputData%LAnchzi) + UB(1:1) = ubound(SrcInitOutputData%LAnchzi) + if (.not. allocated(DstInitOutputData%LAnchzi)) then + allocate(DstInitOutputData%LAnchzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LAnchzi = SrcInitOutputData%LAnchzi + end if + if (allocated(SrcInitOutputData%LFairxt)) then + LB(1:1) = lbound(SrcInitOutputData%LFairxt) + UB(1:1) = ubound(SrcInitOutputData%LFairxt) + if (.not. allocated(DstInitOutputData%LFairxt)) then + allocate(DstInitOutputData%LFairxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LFairxt = SrcInitOutputData%LFairxt + end if + if (allocated(SrcInitOutputData%LFairyt)) then + LB(1:1) = lbound(SrcInitOutputData%LFairyt) + UB(1:1) = ubound(SrcInitOutputData%LFairyt) + if (.not. allocated(DstInitOutputData%LFairyt)) then + allocate(DstInitOutputData%LFairyt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairyt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LFairyt = SrcInitOutputData%LFairyt + end if + if (allocated(SrcInitOutputData%LFairzt)) then + LB(1:1) = lbound(SrcInitOutputData%LFairzt) + UB(1:1) = ubound(SrcInitOutputData%LFairzt) + if (.not. allocated(DstInitOutputData%LFairzt)) then + allocate(DstInitOutputData%LFairzt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairzt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LFairzt = SrcInitOutputData%LFairzt + end if +end subroutine + +subroutine FEAM_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(FEAM_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%GLU0)) THEN - i1_l = LBOUND(SrcOtherStateData%GLU0,1) - i1_u = UBOUND(SrcOtherStateData%GLU0,1) - i2_l = LBOUND(SrcOtherStateData%GLU0,2) - i2_u = UBOUND(SrcOtherStateData%GLU0,2) - IF (.NOT. ALLOCATED(DstOtherStateData%GLU0)) THEN - ALLOCATE(DstOtherStateData%GLU0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GLU0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%GLU0 = SrcOtherStateData%GLU0 -ENDIF -IF (ALLOCATED(SrcOtherStateData%GLDDU)) THEN - i1_l = LBOUND(SrcOtherStateData%GLDDU,1) - i1_u = UBOUND(SrcOtherStateData%GLDDU,1) - i2_l = LBOUND(SrcOtherStateData%GLDDU,2) - i2_u = UBOUND(SrcOtherStateData%GLDDU,2) - IF (.NOT. ALLOCATED(DstOtherStateData%GLDDU)) THEN - ALLOCATE(DstOtherStateData%GLDDU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GLDDU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%GLDDU = SrcOtherStateData%GLDDU -ENDIF - DstOtherStateData%BottomTouch = SrcOtherStateData%BottomTouch -IF (ALLOCATED(SrcOtherStateData%GFORC0)) THEN - i1_l = LBOUND(SrcOtherStateData%GFORC0,1) - i1_u = UBOUND(SrcOtherStateData%GFORC0,1) - i2_l = LBOUND(SrcOtherStateData%GFORC0,2) - i2_u = UBOUND(SrcOtherStateData%GFORC0,2) - i3_l = LBOUND(SrcOtherStateData%GFORC0,3) - i3_u = UBOUND(SrcOtherStateData%GFORC0,3) - IF (.NOT. ALLOCATED(DstOtherStateData%GFORC0)) THEN - ALLOCATE(DstOtherStateData%GFORC0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GFORC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%GFORC0 = SrcOtherStateData%GFORC0 -ENDIF -IF (ALLOCATED(SrcOtherStateData%GMASS0)) THEN - i1_l = LBOUND(SrcOtherStateData%GMASS0,1) - i1_u = UBOUND(SrcOtherStateData%GMASS0,1) - i2_l = LBOUND(SrcOtherStateData%GMASS0,2) - i2_u = UBOUND(SrcOtherStateData%GMASS0,2) - i3_l = LBOUND(SrcOtherStateData%GMASS0,3) - i3_u = UBOUND(SrcOtherStateData%GMASS0,3) - i4_l = LBOUND(SrcOtherStateData%GMASS0,4) - i4_u = UBOUND(SrcOtherStateData%GMASS0,4) - IF (.NOT. ALLOCATED(DstOtherStateData%GMASS0)) THEN - ALLOCATE(DstOtherStateData%GMASS0(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 DstOtherStateData%GMASS0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%GMASS0 = SrcOtherStateData%GMASS0 -ENDIF -IF (ALLOCATED(SrcOtherStateData%FAST_FPA)) THEN - i1_l = LBOUND(SrcOtherStateData%FAST_FPA,1) - i1_u = UBOUND(SrcOtherStateData%FAST_FPA,1) - i2_l = LBOUND(SrcOtherStateData%FAST_FPA,2) - i2_u = UBOUND(SrcOtherStateData%FAST_FPA,2) - IF (.NOT. ALLOCATED(DstOtherStateData%FAST_FPA)) THEN - ALLOCATE(DstOtherStateData%FAST_FPA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FAST_FPA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%FAST_FPA = SrcOtherStateData%FAST_FPA -ENDIF -IF (ALLOCATED(SrcOtherStateData%FAST_RP)) THEN - i1_l = LBOUND(SrcOtherStateData%FAST_RP,1) - i1_u = UBOUND(SrcOtherStateData%FAST_RP,1) - i2_l = LBOUND(SrcOtherStateData%FAST_RP,2) - i2_u = UBOUND(SrcOtherStateData%FAST_RP,2) - IF (.NOT. ALLOCATED(DstOtherStateData%FAST_RP)) THEN - ALLOCATE(DstOtherStateData%FAST_RP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FAST_RP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%FAST_RP = SrcOtherStateData%FAST_RP -ENDIF - DstOtherStateData%INCR = SrcOtherStateData%INCR - DstOtherStateData%RSDF = SrcOtherStateData%RSDF - DstOtherStateData%FORC0 = SrcOtherStateData%FORC0 - DstOtherStateData%EMAS0 = SrcOtherStateData%EMAS0 - END SUBROUTINE FEAM_CopyOtherState - - SUBROUTINE FEAM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(FEAM_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 = 'FEAM_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%GLU0)) THEN - DEALLOCATE(OtherStateData%GLU0) -ENDIF -IF (ALLOCATED(OtherStateData%GLDDU)) THEN - DEALLOCATE(OtherStateData%GLDDU) -ENDIF -IF (ALLOCATED(OtherStateData%GFORC0)) THEN - DEALLOCATE(OtherStateData%GFORC0) -ENDIF -IF (ALLOCATED(OtherStateData%GMASS0)) THEN - DEALLOCATE(OtherStateData%GMASS0) -ENDIF -IF (ALLOCATED(OtherStateData%FAST_FPA)) THEN - DEALLOCATE(OtherStateData%FAST_FPA) -ENDIF -IF (ALLOCATED(OtherStateData%FAST_RP)) THEN - DEALLOCATE(OtherStateData%FAST_RP) -ENDIF - END SUBROUTINE FEAM_DestroyOtherState - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 ! GLU0 allocated yes/no - IF ( ALLOCATED(InData%GLU0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GLU0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLU0) ! GLU0 - END IF - Int_BufSz = Int_BufSz + 1 ! GLDDU allocated yes/no - IF ( ALLOCATED(InData%GLDDU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GLDDU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLDDU) ! GLDDU - END IF - Int_BufSz = Int_BufSz + 1 ! BottomTouch - Int_BufSz = Int_BufSz + 1 ! GFORC0 allocated yes/no - IF ( ALLOCATED(InData%GFORC0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GFORC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GFORC0) ! GFORC0 - END IF - Int_BufSz = Int_BufSz + 1 ! GMASS0 allocated yes/no - IF ( ALLOCATED(InData%GMASS0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! GMASS0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GMASS0) ! GMASS0 - END IF - Int_BufSz = Int_BufSz + 1 ! FAST_FPA allocated yes/no - IF ( ALLOCATED(InData%FAST_FPA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FAST_FPA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAST_FPA) ! FAST_FPA - END IF - Int_BufSz = Int_BufSz + 1 ! FAST_RP allocated yes/no - IF ( ALLOCATED(InData%FAST_RP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FAST_RP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAST_RP) ! FAST_RP - END IF - Int_BufSz = Int_BufSz + 1 ! INCR - Re_BufSz = Re_BufSz + SIZE(InData%RSDF) ! RSDF - Re_BufSz = Re_BufSz + SIZE(InData%FORC0) ! FORC0 - Re_BufSz = Re_BufSz + SIZE(InData%EMAS0) ! EMAS0 - 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%GLU0) ) 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%GLU0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLU0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GLU0,2), UBOUND(InData%GLU0,2) - DO i1 = LBOUND(InData%GLU0,1), UBOUND(InData%GLU0,1) - ReKiBuf(Re_Xferred) = InData%GLU0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GLDDU) ) 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%GLDDU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDDU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLDDU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDDU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GLDDU,2), UBOUND(InData%GLDDU,2) - DO i1 = LBOUND(InData%GLDDU,1), UBOUND(InData%GLDDU,1) - ReKiBuf(Re_Xferred) = InData%GLDDU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%BottomTouch, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GFORC0) ) 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%GFORC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GFORC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GFORC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GFORC0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GFORC0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GFORC0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GFORC0,3), UBOUND(InData%GFORC0,3) - DO i2 = LBOUND(InData%GFORC0,2), UBOUND(InData%GFORC0,2) - DO i1 = LBOUND(InData%GFORC0,1), UBOUND(InData%GFORC0,1) - ReKiBuf(Re_Xferred) = InData%GFORC0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GMASS0) ) 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%GMASS0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GMASS0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GMASS0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GMASS0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GMASS0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GMASS0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GMASS0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GMASS0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%GMASS0,4), UBOUND(InData%GMASS0,4) - DO i3 = LBOUND(InData%GMASS0,3), UBOUND(InData%GMASS0,3) - DO i2 = LBOUND(InData%GMASS0,2), UBOUND(InData%GMASS0,2) - DO i1 = LBOUND(InData%GMASS0,1), UBOUND(InData%GMASS0,1) - ReKiBuf(Re_Xferred) = InData%GMASS0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FAST_FPA) ) 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%FAST_FPA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FPA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAST_FPA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FPA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FAST_FPA,2), UBOUND(InData%FAST_FPA,2) - DO i1 = LBOUND(InData%FAST_FPA,1), UBOUND(InData%FAST_FPA,1) - ReKiBuf(Re_Xferred) = InData%FAST_FPA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FAST_RP) ) 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%FAST_RP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_RP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAST_RP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_RP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FAST_RP,2), UBOUND(InData%FAST_RP,2) - DO i1 = LBOUND(InData%FAST_RP,1), UBOUND(InData%FAST_RP,1) - ReKiBuf(Re_Xferred) = InData%FAST_RP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%INCR - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RSDF,1), UBOUND(InData%RSDF,1) - ReKiBuf(Re_Xferred) = InData%RSDF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FORC0,1), UBOUND(InData%FORC0,1) - ReKiBuf(Re_Xferred) = InData%FORC0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%EMAS0,2), UBOUND(InData%EMAS0,2) - DO i1 = LBOUND(InData%EMAS0,1), UBOUND(InData%EMAS0,1) - ReKiBuf(Re_Xferred) = InData%EMAS0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE FEAM_PackOtherState - - SUBROUTINE FEAM_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(FEAM_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) :: 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_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLU0 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%GLU0)) DEALLOCATE(OutData%GLU0) - ALLOCATE(OutData%GLU0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GLU0,2), UBOUND(OutData%GLU0,2) - DO i1 = LBOUND(OutData%GLU0,1), UBOUND(OutData%GLU0,1) - OutData%GLU0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLDDU 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%GLDDU)) DEALLOCATE(OutData%GLDDU) - ALLOCATE(OutData%GLDDU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDDU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GLDDU,2), UBOUND(OutData%GLDDU,2) - DO i1 = LBOUND(OutData%GLDDU,1), UBOUND(OutData%GLDDU,1) - OutData%GLDDU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%BottomTouch = TRANSFER(IntKiBuf(Int_Xferred), OutData%BottomTouch) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GFORC0 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%GFORC0)) DEALLOCATE(OutData%GFORC0) - ALLOCATE(OutData%GFORC0(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%GFORC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GFORC0,3), UBOUND(OutData%GFORC0,3) - DO i2 = LBOUND(OutData%GFORC0,2), UBOUND(OutData%GFORC0,2) - DO i1 = LBOUND(OutData%GFORC0,1), UBOUND(OutData%GFORC0,1) - OutData%GFORC0(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GMASS0 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%GMASS0)) DEALLOCATE(OutData%GMASS0) - ALLOCATE(OutData%GMASS0(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%GMASS0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%GMASS0,4), UBOUND(OutData%GMASS0,4) - DO i3 = LBOUND(OutData%GMASS0,3), UBOUND(OutData%GMASS0,3) - DO i2 = LBOUND(OutData%GMASS0,2), UBOUND(OutData%GMASS0,2) - DO i1 = LBOUND(OutData%GMASS0,1), UBOUND(OutData%GMASS0,1) - OutData%GMASS0(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_FPA 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%FAST_FPA)) DEALLOCATE(OutData%FAST_FPA) - ALLOCATE(OutData%FAST_FPA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FPA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FAST_FPA,2), UBOUND(OutData%FAST_FPA,2) - DO i1 = LBOUND(OutData%FAST_FPA,1), UBOUND(OutData%FAST_FPA,1) - OutData%FAST_FPA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_RP 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%FAST_RP)) DEALLOCATE(OutData%FAST_RP) - ALLOCATE(OutData%FAST_RP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_RP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FAST_RP,2), UBOUND(OutData%FAST_RP,2) - DO i1 = LBOUND(OutData%FAST_RP,1), UBOUND(OutData%FAST_RP,1) - OutData%FAST_RP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%INCR = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RSDF,1) - i1_u = UBOUND(OutData%RSDF,1) - DO i1 = LBOUND(OutData%RSDF,1), UBOUND(OutData%RSDF,1) - OutData%RSDF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FORC0,1) - i1_u = UBOUND(OutData%FORC0,1) - DO i1 = LBOUND(OutData%FORC0,1), UBOUND(OutData%FORC0,1) - OutData%FORC0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%EMAS0,1) - i1_u = UBOUND(OutData%EMAS0,1) - i2_l = LBOUND(OutData%EMAS0,2) - i2_u = UBOUND(OutData%EMAS0,2) - DO i2 = LBOUND(OutData%EMAS0,2), UBOUND(OutData%EMAS0,2) - DO i1 = LBOUND(OutData%EMAS0,1), UBOUND(OutData%EMAS0,1) - OutData%EMAS0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE FEAM_UnPackOtherState - - SUBROUTINE FEAM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(FEAM_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) :: 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 = 'FEAM_CopyMisc' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%LAnchxi)) then + deallocate(InitOutputData%LAnchxi) + end if + if (allocated(InitOutputData%LAnchyi)) then + deallocate(InitOutputData%LAnchyi) + end if + if (allocated(InitOutputData%LAnchzi)) then + deallocate(InitOutputData%LAnchzi) + end if + if (allocated(InitOutputData%LFairxt)) then + deallocate(InitOutputData%LFairxt) + end if + if (allocated(InitOutputData%LFairyt)) then + deallocate(InitOutputData%LFairyt) + end if + if (allocated(InitOutputData%LFairzt)) then + deallocate(InitOutputData%LFairzt) + end if +end subroutine + +subroutine FEAM_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, allocated(InData%LAnchxi)) + if (allocated(InData%LAnchxi)) then + call RegPackBounds(Buf, 1, lbound(InData%LAnchxi), ubound(InData%LAnchxi)) + call RegPack(Buf, InData%LAnchxi) + end if + call RegPack(Buf, allocated(InData%LAnchyi)) + if (allocated(InData%LAnchyi)) then + call RegPackBounds(Buf, 1, lbound(InData%LAnchyi), ubound(InData%LAnchyi)) + call RegPack(Buf, InData%LAnchyi) + end if + call RegPack(Buf, allocated(InData%LAnchzi)) + if (allocated(InData%LAnchzi)) then + call RegPackBounds(Buf, 1, lbound(InData%LAnchzi), ubound(InData%LAnchzi)) + call RegPack(Buf, InData%LAnchzi) + end if + call RegPack(Buf, allocated(InData%LFairxt)) + if (allocated(InData%LFairxt)) then + call RegPackBounds(Buf, 1, lbound(InData%LFairxt), ubound(InData%LFairxt)) + call RegPack(Buf, InData%LFairxt) + end if + call RegPack(Buf, allocated(InData%LFairyt)) + if (allocated(InData%LFairyt)) then + call RegPackBounds(Buf, 1, lbound(InData%LFairyt), ubound(InData%LFairyt)) + call RegPack(Buf, InData%LFairyt) + end if + call RegPack(Buf, allocated(InData%LFairzt)) + if (allocated(InData%LFairzt)) then + call RegPackBounds(Buf, 1, lbound(InData%LFairzt), ubound(InData%LFairzt)) + call RegPack(Buf, InData%LFairzt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (allocated(OutData%LAnchxi)) deallocate(OutData%LAnchxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LAnchxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LAnchxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LAnchyi)) deallocate(OutData%LAnchyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LAnchyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LAnchyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LAnchzi)) deallocate(OutData%LAnchzi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LAnchzi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LAnchzi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LFairxt)) deallocate(OutData%LFairxt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LFairxt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LFairxt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LFairyt)) deallocate(OutData%LFairyt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LFairyt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairyt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LFairyt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LFairzt)) deallocate(OutData%LFairzt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LFairzt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairzt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LFairzt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FEAM_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_ContinuousStateType), intent(in) :: SrcContStateData + type(FEAM_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FEAM_CopyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%GLF)) THEN - i1_l = LBOUND(SrcMiscData%GLF,1) - i1_u = UBOUND(SrcMiscData%GLF,1) - i2_l = LBOUND(SrcMiscData%GLF,2) - i2_u = UBOUND(SrcMiscData%GLF,2) - IF (.NOT. ALLOCATED(DstMiscData%GLF)) THEN - ALLOCATE(DstMiscData%GLF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GLF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%GLF = SrcMiscData%GLF -ENDIF -IF (ALLOCATED(SrcMiscData%GLK)) THEN - i1_l = LBOUND(SrcMiscData%GLK,1) - i1_u = UBOUND(SrcMiscData%GLK,1) - i2_l = LBOUND(SrcMiscData%GLK,2) - i2_u = UBOUND(SrcMiscData%GLK,2) - i3_l = LBOUND(SrcMiscData%GLK,3) - i3_u = UBOUND(SrcMiscData%GLK,3) - IF (.NOT. ALLOCATED(DstMiscData%GLK)) THEN - ALLOCATE(DstMiscData%GLK(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GLK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%GLK = SrcMiscData%GLK -ENDIF - DstMiscData%EMASS = SrcMiscData%EMASS - DstMiscData%ESTIF = SrcMiscData%ESTIF -IF (ALLOCATED(SrcMiscData%FAST_FP)) THEN - i1_l = LBOUND(SrcMiscData%FAST_FP,1) - i1_u = UBOUND(SrcMiscData%FAST_FP,1) - i2_l = LBOUND(SrcMiscData%FAST_FP,2) - i2_u = UBOUND(SrcMiscData%FAST_FP,2) - IF (.NOT. ALLOCATED(DstMiscData%FAST_FP)) THEN - ALLOCATE(DstMiscData%FAST_FP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAST_FP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FAST_FP = SrcMiscData%FAST_FP -ENDIF - DstMiscData%FORCE = SrcMiscData%FORCE - DstMiscData%FP = SrcMiscData%FP - DstMiscData%U = SrcMiscData%U - DstMiscData%U0 = SrcMiscData%U0 - DstMiscData%DU = SrcMiscData%DU - DstMiscData%DDU = SrcMiscData%DDU - DstMiscData%R = SrcMiscData%R - DstMiscData%RP = SrcMiscData%RP - DstMiscData%RHSR = SrcMiscData%RHSR - DstMiscData%SLIN = SrcMiscData%SLIN - DstMiscData%STIFR = SrcMiscData%STIFR -IF (ALLOCATED(SrcMiscData%FAIR_ANG)) THEN - i1_l = LBOUND(SrcMiscData%FAIR_ANG,1) - i1_u = UBOUND(SrcMiscData%FAIR_ANG,1) - i2_l = LBOUND(SrcMiscData%FAIR_ANG,2) - i2_u = UBOUND(SrcMiscData%FAIR_ANG,2) - IF (.NOT. ALLOCATED(DstMiscData%FAIR_ANG)) THEN - ALLOCATE(DstMiscData%FAIR_ANG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAIR_ANG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FAIR_ANG = SrcMiscData%FAIR_ANG -ENDIF -IF (ALLOCATED(SrcMiscData%FAIR_T)) THEN - i1_l = LBOUND(SrcMiscData%FAIR_T,1) - i1_u = UBOUND(SrcMiscData%FAIR_T,1) - IF (.NOT. ALLOCATED(DstMiscData%FAIR_T)) THEN - ALLOCATE(DstMiscData%FAIR_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAIR_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FAIR_T = SrcMiscData%FAIR_T -ENDIF -IF (ALLOCATED(SrcMiscData%ANCH_ANG)) THEN - i1_l = LBOUND(SrcMiscData%ANCH_ANG,1) - i1_u = UBOUND(SrcMiscData%ANCH_ANG,1) - i2_l = LBOUND(SrcMiscData%ANCH_ANG,2) - i2_u = UBOUND(SrcMiscData%ANCH_ANG,2) - IF (.NOT. ALLOCATED(DstMiscData%ANCH_ANG)) THEN - ALLOCATE(DstMiscData%ANCH_ANG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ANCH_ANG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ANCH_ANG = SrcMiscData%ANCH_ANG -ENDIF -IF (ALLOCATED(SrcMiscData%ANCH_T)) THEN - i1_l = LBOUND(SrcMiscData%ANCH_T,1) - i1_u = UBOUND(SrcMiscData%ANCH_T,1) - IF (.NOT. ALLOCATED(DstMiscData%ANCH_T)) THEN - ALLOCATE(DstMiscData%ANCH_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ANCH_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ANCH_T = SrcMiscData%ANCH_T -ENDIF -IF (ALLOCATED(SrcMiscData%Line_Coordinate)) THEN - i1_l = LBOUND(SrcMiscData%Line_Coordinate,1) - i1_u = UBOUND(SrcMiscData%Line_Coordinate,1) - i2_l = LBOUND(SrcMiscData%Line_Coordinate,2) - i2_u = UBOUND(SrcMiscData%Line_Coordinate,2) - i3_l = LBOUND(SrcMiscData%Line_Coordinate,3) - i3_u = UBOUND(SrcMiscData%Line_Coordinate,3) - IF (.NOT. ALLOCATED(DstMiscData%Line_Coordinate)) THEN - ALLOCATE(DstMiscData%Line_Coordinate(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Line_Coordinate = SrcMiscData%Line_Coordinate -ENDIF -IF (ALLOCATED(SrcMiscData%Line_Tangent)) THEN - i1_l = LBOUND(SrcMiscData%Line_Tangent,1) - i1_u = UBOUND(SrcMiscData%Line_Tangent,1) - i2_l = LBOUND(SrcMiscData%Line_Tangent,2) - i2_u = UBOUND(SrcMiscData%Line_Tangent,2) - i3_l = LBOUND(SrcMiscData%Line_Tangent,3) - i3_u = UBOUND(SrcMiscData%Line_Tangent,3) - IF (.NOT. ALLOCATED(DstMiscData%Line_Tangent)) THEN - ALLOCATE(DstMiscData%Line_Tangent(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Tangent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Line_Tangent = SrcMiscData%Line_Tangent -ENDIF -IF (ALLOCATED(SrcMiscData%F_Lines)) THEN - i1_l = LBOUND(SrcMiscData%F_Lines,1) - i1_u = UBOUND(SrcMiscData%F_Lines,1) - i2_l = LBOUND(SrcMiscData%F_Lines,2) - i2_u = UBOUND(SrcMiscData%F_Lines,2) - IF (.NOT. ALLOCATED(DstMiscData%F_Lines)) THEN - ALLOCATE(DstMiscData%F_Lines(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Lines.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Lines = SrcMiscData%F_Lines -ENDIF - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - END SUBROUTINE FEAM_CopyMisc - - SUBROUTINE FEAM_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(FEAM_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 = 'FEAM_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%GLF)) THEN - DEALLOCATE(MiscData%GLF) -ENDIF -IF (ALLOCATED(MiscData%GLK)) THEN - DEALLOCATE(MiscData%GLK) -ENDIF -IF (ALLOCATED(MiscData%FAST_FP)) THEN - DEALLOCATE(MiscData%FAST_FP) -ENDIF -IF (ALLOCATED(MiscData%FAIR_ANG)) THEN - DEALLOCATE(MiscData%FAIR_ANG) -ENDIF -IF (ALLOCATED(MiscData%FAIR_T)) THEN - DEALLOCATE(MiscData%FAIR_T) -ENDIF -IF (ALLOCATED(MiscData%ANCH_ANG)) THEN - DEALLOCATE(MiscData%ANCH_ANG) -ENDIF -IF (ALLOCATED(MiscData%ANCH_T)) THEN - DEALLOCATE(MiscData%ANCH_T) -ENDIF -IF (ALLOCATED(MiscData%Line_Coordinate)) THEN - DEALLOCATE(MiscData%Line_Coordinate) -ENDIF -IF (ALLOCATED(MiscData%Line_Tangent)) THEN - DEALLOCATE(MiscData%Line_Tangent) -ENDIF -IF (ALLOCATED(MiscData%F_Lines)) THEN - DEALLOCATE(MiscData%F_Lines) -ENDIF - END SUBROUTINE FEAM_DestroyMisc - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 ! GLF allocated yes/no - IF ( ALLOCATED(InData%GLF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GLF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLF) ! GLF - END IF - Int_BufSz = Int_BufSz + 1 ! GLK allocated yes/no - IF ( ALLOCATED(InData%GLK) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GLK upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLK) ! GLK - END IF - Re_BufSz = Re_BufSz + SIZE(InData%EMASS) ! EMASS - Re_BufSz = Re_BufSz + SIZE(InData%ESTIF) ! ESTIF - Int_BufSz = Int_BufSz + 1 ! FAST_FP allocated yes/no - IF ( ALLOCATED(InData%FAST_FP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FAST_FP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAST_FP) ! FAST_FP - END IF - Re_BufSz = Re_BufSz + SIZE(InData%FORCE) ! FORCE - Re_BufSz = Re_BufSz + SIZE(InData%FP) ! FP - Re_BufSz = Re_BufSz + SIZE(InData%U) ! U - Re_BufSz = Re_BufSz + SIZE(InData%U0) ! U0 - Re_BufSz = Re_BufSz + SIZE(InData%DU) ! DU - Re_BufSz = Re_BufSz + SIZE(InData%DDU) ! DDU - Re_BufSz = Re_BufSz + SIZE(InData%R) ! R - Re_BufSz = Re_BufSz + SIZE(InData%RP) ! RP - Re_BufSz = Re_BufSz + SIZE(InData%RHSR) ! RHSR - Re_BufSz = Re_BufSz + SIZE(InData%SLIN) ! SLIN - Re_BufSz = Re_BufSz + SIZE(InData%STIFR) ! STIFR - Int_BufSz = Int_BufSz + 1 ! FAIR_ANG allocated yes/no - IF ( ALLOCATED(InData%FAIR_ANG) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FAIR_ANG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAIR_ANG) ! FAIR_ANG - END IF - Int_BufSz = Int_BufSz + 1 ! FAIR_T allocated yes/no - IF ( ALLOCATED(InData%FAIR_T) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FAIR_T upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAIR_T) ! FAIR_T - END IF - Int_BufSz = Int_BufSz + 1 ! ANCH_ANG allocated yes/no - IF ( ALLOCATED(InData%ANCH_ANG) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ANCH_ANG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ANCH_ANG) ! ANCH_ANG - END IF - Int_BufSz = Int_BufSz + 1 ! ANCH_T allocated yes/no - IF ( ALLOCATED(InData%ANCH_T) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ANCH_T upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ANCH_T) ! ANCH_T - END IF - Int_BufSz = Int_BufSz + 1 ! Line_Coordinate allocated yes/no - IF ( ALLOCATED(InData%Line_Coordinate) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Line_Coordinate upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Line_Coordinate) ! Line_Coordinate - END IF - Int_BufSz = Int_BufSz + 1 ! Line_Tangent allocated yes/no - IF ( ALLOCATED(InData%Line_Tangent) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Line_Tangent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Line_Tangent) ! Line_Tangent - END IF - Int_BufSz = Int_BufSz + 1 ! F_Lines allocated yes/no - IF ( ALLOCATED(InData%F_Lines) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_Lines upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Lines) ! F_Lines - END IF - 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 - - IF ( .NOT. ALLOCATED(InData%GLF) ) 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%GLF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GLF,2), UBOUND(InData%GLF,2) - DO i1 = LBOUND(InData%GLF,1), UBOUND(InData%GLF,1) - ReKiBuf(Re_Xferred) = InData%GLF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GLK) ) 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%GLK,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLK,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLK,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLK,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLK,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLK,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GLK,3), UBOUND(InData%GLK,3) - DO i2 = LBOUND(InData%GLK,2), UBOUND(InData%GLK,2) - DO i1 = LBOUND(InData%GLK,1), UBOUND(InData%GLK,1) - ReKiBuf(Re_Xferred) = InData%GLK(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i2 = LBOUND(InData%EMASS,2), UBOUND(InData%EMASS,2) - DO i1 = LBOUND(InData%EMASS,1), UBOUND(InData%EMASS,1) - ReKiBuf(Re_Xferred) = InData%EMASS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%ESTIF,2), UBOUND(InData%ESTIF,2) - DO i1 = LBOUND(InData%ESTIF,1), UBOUND(InData%ESTIF,1) - ReKiBuf(Re_Xferred) = InData%ESTIF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%FAST_FP) ) 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%FAST_FP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAST_FP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FAST_FP,2), UBOUND(InData%FAST_FP,2) - DO i1 = LBOUND(InData%FAST_FP,1), UBOUND(InData%FAST_FP,1) - ReKiBuf(Re_Xferred) = InData%FAST_FP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%FORCE,1), UBOUND(InData%FORCE,1) - ReKiBuf(Re_Xferred) = InData%FORCE(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FP,1), UBOUND(InData%FP,1) - ReKiBuf(Re_Xferred) = InData%FP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%U,2), UBOUND(InData%U,2) - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - ReKiBuf(Re_Xferred) = InData%U(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%U0,2), UBOUND(InData%U0,2) - DO i1 = LBOUND(InData%U0,1), UBOUND(InData%U0,1) - ReKiBuf(Re_Xferred) = InData%U0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%DU,2), UBOUND(InData%DU,2) - DO i1 = LBOUND(InData%DU,1), UBOUND(InData%DU,1) - ReKiBuf(Re_Xferred) = InData%DU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%DDU,2), UBOUND(InData%DDU,2) - DO i1 = LBOUND(InData%DDU,1), UBOUND(InData%DDU,1) - ReKiBuf(Re_Xferred) = InData%DDU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%R,1), UBOUND(InData%R,1) - ReKiBuf(Re_Xferred) = InData%R(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RP,1), UBOUND(InData%RP,1) - ReKiBuf(Re_Xferred) = InData%RP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RHSR,1), UBOUND(InData%RHSR,1) - ReKiBuf(Re_Xferred) = InData%RHSR(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%SLIN,1), UBOUND(InData%SLIN,1) - ReKiBuf(Re_Xferred) = InData%SLIN(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%STIFR,2), UBOUND(InData%STIFR,2) - DO i1 = LBOUND(InData%STIFR,1), UBOUND(InData%STIFR,1) - ReKiBuf(Re_Xferred) = InData%STIFR(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%FAIR_ANG) ) 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%FAIR_ANG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAIR_ANG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAIR_ANG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAIR_ANG,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FAIR_ANG,2), UBOUND(InData%FAIR_ANG,2) - DO i1 = LBOUND(InData%FAIR_ANG,1), UBOUND(InData%FAIR_ANG,1) - ReKiBuf(Re_Xferred) = InData%FAIR_ANG(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FAIR_T) ) 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%FAIR_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAIR_T,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FAIR_T,1), UBOUND(InData%FAIR_T,1) - ReKiBuf(Re_Xferred) = InData%FAIR_T(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ANCH_ANG) ) 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%ANCH_ANG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANCH_ANG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANCH_ANG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANCH_ANG,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ANCH_ANG,2), UBOUND(InData%ANCH_ANG,2) - DO i1 = LBOUND(InData%ANCH_ANG,1), UBOUND(InData%ANCH_ANG,1) - ReKiBuf(Re_Xferred) = InData%ANCH_ANG(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ANCH_T) ) 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%ANCH_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANCH_T,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ANCH_T,1), UBOUND(InData%ANCH_T,1) - ReKiBuf(Re_Xferred) = InData%ANCH_T(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Line_Coordinate) ) 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%Line_Coordinate,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Coordinate,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Coordinate,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Coordinate,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Coordinate,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Coordinate,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Line_Coordinate,3), UBOUND(InData%Line_Coordinate,3) - DO i2 = LBOUND(InData%Line_Coordinate,2), UBOUND(InData%Line_Coordinate,2) - DO i1 = LBOUND(InData%Line_Coordinate,1), UBOUND(InData%Line_Coordinate,1) - ReKiBuf(Re_Xferred) = InData%Line_Coordinate(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Line_Tangent) ) 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%Line_Tangent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Tangent,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Tangent,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Tangent,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Tangent,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Tangent,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Line_Tangent,3), UBOUND(InData%Line_Tangent,3) - DO i2 = LBOUND(InData%Line_Tangent,2), UBOUND(InData%Line_Tangent,2) - DO i1 = LBOUND(InData%Line_Tangent,1), UBOUND(InData%Line_Tangent,1) - ReKiBuf(Re_Xferred) = InData%Line_Tangent(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_Lines) ) 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%F_Lines,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Lines,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_Lines,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Lines,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_Lines,2), UBOUND(InData%F_Lines,2) - DO i1 = LBOUND(InData%F_Lines,1), UBOUND(InData%F_Lines,1) - ReKiBuf(Re_Xferred) = InData%F_Lines(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FEAM_PackMisc - - SUBROUTINE FEAM_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(FEAM_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) :: 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 = 'FEAM_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLF 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%GLF)) DEALLOCATE(OutData%GLF) - ALLOCATE(OutData%GLF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GLF,2), UBOUND(OutData%GLF,2) - DO i1 = LBOUND(OutData%GLF,1), UBOUND(OutData%GLF,1) - OutData%GLF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLK 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%GLK)) DEALLOCATE(OutData%GLK) - ALLOCATE(OutData%GLK(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%GLK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GLK,3), UBOUND(OutData%GLK,3) - DO i2 = LBOUND(OutData%GLK,2), UBOUND(OutData%GLK,2) - DO i1 = LBOUND(OutData%GLK,1), UBOUND(OutData%GLK,1) - OutData%GLK(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%EMASS,1) - i1_u = UBOUND(OutData%EMASS,1) - i2_l = LBOUND(OutData%EMASS,2) - i2_u = UBOUND(OutData%EMASS,2) - DO i2 = LBOUND(OutData%EMASS,2), UBOUND(OutData%EMASS,2) - DO i1 = LBOUND(OutData%EMASS,1), UBOUND(OutData%EMASS,1) - OutData%EMASS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%ESTIF,1) - i1_u = UBOUND(OutData%ESTIF,1) - i2_l = LBOUND(OutData%ESTIF,2) - i2_u = UBOUND(OutData%ESTIF,2) - DO i2 = LBOUND(OutData%ESTIF,2), UBOUND(OutData%ESTIF,2) - DO i1 = LBOUND(OutData%ESTIF,1), UBOUND(OutData%ESTIF,1) - OutData%ESTIF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_FP 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%FAST_FP)) DEALLOCATE(OutData%FAST_FP) - ALLOCATE(OutData%FAST_FP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FAST_FP,2), UBOUND(OutData%FAST_FP,2) - DO i1 = LBOUND(OutData%FAST_FP,1), UBOUND(OutData%FAST_FP,1) - OutData%FAST_FP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%FORCE,1) - i1_u = UBOUND(OutData%FORCE,1) - DO i1 = LBOUND(OutData%FORCE,1), UBOUND(OutData%FORCE,1) - OutData%FORCE(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FP,1) - i1_u = UBOUND(OutData%FP,1) - DO i1 = LBOUND(OutData%FP,1), UBOUND(OutData%FP,1) - OutData%FP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%U,1) - i1_u = UBOUND(OutData%U,1) - i2_l = LBOUND(OutData%U,2) - i2_u = UBOUND(OutData%U,2) - DO i2 = LBOUND(OutData%U,2), UBOUND(OutData%U,2) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%U0,1) - i1_u = UBOUND(OutData%U0,1) - i2_l = LBOUND(OutData%U0,2) - i2_u = UBOUND(OutData%U0,2) - DO i2 = LBOUND(OutData%U0,2), UBOUND(OutData%U0,2) - DO i1 = LBOUND(OutData%U0,1), UBOUND(OutData%U0,1) - OutData%U0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%DU,1) - i1_u = UBOUND(OutData%DU,1) - i2_l = LBOUND(OutData%DU,2) - i2_u = UBOUND(OutData%DU,2) - DO i2 = LBOUND(OutData%DU,2), UBOUND(OutData%DU,2) - DO i1 = LBOUND(OutData%DU,1), UBOUND(OutData%DU,1) - OutData%DU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%DDU,1) - i1_u = UBOUND(OutData%DDU,1) - i2_l = LBOUND(OutData%DDU,2) - i2_u = UBOUND(OutData%DDU,2) - DO i2 = LBOUND(OutData%DDU,2), UBOUND(OutData%DDU,2) - DO i1 = LBOUND(OutData%DDU,1), UBOUND(OutData%DDU,1) - OutData%DDU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%R,1) - i1_u = UBOUND(OutData%R,1) - DO i1 = LBOUND(OutData%R,1), UBOUND(OutData%R,1) - OutData%R(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RP,1) - i1_u = UBOUND(OutData%RP,1) - DO i1 = LBOUND(OutData%RP,1), UBOUND(OutData%RP,1) - OutData%RP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RHSR,1) - i1_u = UBOUND(OutData%RHSR,1) - DO i1 = LBOUND(OutData%RHSR,1), UBOUND(OutData%RHSR,1) - OutData%RHSR(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%SLIN,1) - i1_u = UBOUND(OutData%SLIN,1) - DO i1 = LBOUND(OutData%SLIN,1), UBOUND(OutData%SLIN,1) - OutData%SLIN(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%STIFR,1) - i1_u = UBOUND(OutData%STIFR,1) - i2_l = LBOUND(OutData%STIFR,2) - i2_u = UBOUND(OutData%STIFR,2) - DO i2 = LBOUND(OutData%STIFR,2), UBOUND(OutData%STIFR,2) - DO i1 = LBOUND(OutData%STIFR,1), UBOUND(OutData%STIFR,1) - OutData%STIFR(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAIR_ANG 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%FAIR_ANG)) DEALLOCATE(OutData%FAIR_ANG) - ALLOCATE(OutData%FAIR_ANG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_ANG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FAIR_ANG,2), UBOUND(OutData%FAIR_ANG,2) - DO i1 = LBOUND(OutData%FAIR_ANG,1), UBOUND(OutData%FAIR_ANG,1) - OutData%FAIR_ANG(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAIR_T 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%FAIR_T)) DEALLOCATE(OutData%FAIR_T) - ALLOCATE(OutData%FAIR_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FAIR_T,1), UBOUND(OutData%FAIR_T,1) - OutData%FAIR_T(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANCH_ANG 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%ANCH_ANG)) DEALLOCATE(OutData%ANCH_ANG) - ALLOCATE(OutData%ANCH_ANG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_ANG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ANCH_ANG,2), UBOUND(OutData%ANCH_ANG,2) - DO i1 = LBOUND(OutData%ANCH_ANG,1), UBOUND(OutData%ANCH_ANG,1) - OutData%ANCH_ANG(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANCH_T 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%ANCH_T)) DEALLOCATE(OutData%ANCH_T) - ALLOCATE(OutData%ANCH_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ANCH_T,1), UBOUND(OutData%ANCH_T,1) - OutData%ANCH_T(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line_Coordinate 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%Line_Coordinate)) DEALLOCATE(OutData%Line_Coordinate) - ALLOCATE(OutData%Line_Coordinate(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%Line_Coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Line_Coordinate,3), UBOUND(OutData%Line_Coordinate,3) - DO i2 = LBOUND(OutData%Line_Coordinate,2), UBOUND(OutData%Line_Coordinate,2) - DO i1 = LBOUND(OutData%Line_Coordinate,1), UBOUND(OutData%Line_Coordinate,1) - OutData%Line_Coordinate(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line_Tangent 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%Line_Tangent)) DEALLOCATE(OutData%Line_Tangent) - ALLOCATE(OutData%Line_Tangent(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%Line_Tangent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Line_Tangent,3), UBOUND(OutData%Line_Tangent,3) - DO i2 = LBOUND(OutData%Line_Tangent,2), UBOUND(OutData%Line_Tangent,2) - DO i1 = LBOUND(OutData%Line_Tangent,1), UBOUND(OutData%Line_Tangent,1) - OutData%Line_Tangent(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Lines 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%F_Lines)) DEALLOCATE(OutData%F_Lines) - ALLOCATE(OutData%F_Lines(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Lines.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_Lines,2), UBOUND(OutData%F_Lines,2) - DO i1 = LBOUND(OutData%F_Lines,1), UBOUND(OutData%F_Lines,1) - OutData%F_Lines(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FEAM_UnPackMisc - - SUBROUTINE FEAM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_ParameterType), INTENT(IN) :: SrcParamData - TYPE(FEAM_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyParam' -! + ErrMsg = '' + if (allocated(SrcContStateData%GLU)) then + LB(1:2) = lbound(SrcContStateData%GLU) + UB(1:2) = ubound(SrcContStateData%GLU) + if (.not. allocated(DstContStateData%GLU)) then + allocate(DstContStateData%GLU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%GLU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%GLU = SrcContStateData%GLU + end if + if (allocated(SrcContStateData%GLDU)) then + LB(1:2) = lbound(SrcContStateData%GLDU) + UB(1:2) = ubound(SrcContStateData%GLDU) + if (.not. allocated(DstContStateData%GLDU)) then + allocate(DstContStateData%GLDU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%GLDU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%GLDU = SrcContStateData%GLDU + end if +end subroutine + +subroutine FEAM_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(FEAM_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%GRAV = SrcParamData%GRAV - DstParamData%Eps = SrcParamData%Eps - DstParamData%Gravity = SrcParamData%Gravity - DstParamData%WtrDens = SrcParamData%WtrDens - DstParamData%MaxIter = SrcParamData%MaxIter - DstParamData%NHBD = SrcParamData%NHBD - DstParamData%NDIM = SrcParamData%NDIM -IF (ALLOCATED(SrcParamData%NEQ)) THEN - i1_l = LBOUND(SrcParamData%NEQ,1) - i1_u = UBOUND(SrcParamData%NEQ,1) - IF (.NOT. ALLOCATED(DstParamData%NEQ)) THEN - ALLOCATE(DstParamData%NEQ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NEQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NEQ = SrcParamData%NEQ -ENDIF - DstParamData%NBAND = SrcParamData%NBAND - DstParamData%NumLines = SrcParamData%NumLines - DstParamData%NumElems = SrcParamData%NumElems - DstParamData%NumNodes = SrcParamData%NumNodes -IF (ALLOCATED(SrcParamData%GSL)) THEN - i1_l = LBOUND(SrcParamData%GSL,1) - i1_u = UBOUND(SrcParamData%GSL,1) - i2_l = LBOUND(SrcParamData%GSL,2) - i2_u = UBOUND(SrcParamData%GSL,2) - i3_l = LBOUND(SrcParamData%GSL,3) - i3_u = UBOUND(SrcParamData%GSL,3) - IF (.NOT. ALLOCATED(DstParamData%GSL)) THEN - ALLOCATE(DstParamData%GSL(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%GSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GSL = SrcParamData%GSL -ENDIF -IF (ALLOCATED(SrcParamData%GP)) THEN - i1_l = LBOUND(SrcParamData%GP,1) - i1_u = UBOUND(SrcParamData%GP,1) - i2_l = LBOUND(SrcParamData%GP,2) - i2_u = UBOUND(SrcParamData%GP,2) - IF (.NOT. ALLOCATED(DstParamData%GP)) THEN - ALLOCATE(DstParamData%GP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GP = SrcParamData%GP -ENDIF -IF (ALLOCATED(SrcParamData%Elength)) THEN - i1_l = LBOUND(SrcParamData%Elength,1) - i1_u = UBOUND(SrcParamData%Elength,1) - IF (.NOT. ALLOCATED(DstParamData%Elength)) THEN - ALLOCATE(DstParamData%Elength(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elength.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Elength = SrcParamData%Elength -ENDIF -IF (ALLOCATED(SrcParamData%BottmElev)) THEN - i1_l = LBOUND(SrcParamData%BottmElev,1) - i1_u = UBOUND(SrcParamData%BottmElev,1) - IF (.NOT. ALLOCATED(DstParamData%BottmElev)) THEN - ALLOCATE(DstParamData%BottmElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BottmElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BottmElev = SrcParamData%BottmElev -ENDIF -IF (ALLOCATED(SrcParamData%BottmStiff)) THEN - i1_l = LBOUND(SrcParamData%BottmStiff,1) - i1_u = UBOUND(SrcParamData%BottmStiff,1) - IF (.NOT. ALLOCATED(DstParamData%BottmStiff)) THEN - ALLOCATE(DstParamData%BottmStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BottmStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BottmStiff = SrcParamData%BottmStiff -ENDIF -IF (ALLOCATED(SrcParamData%LMassDen)) THEN - i1_l = LBOUND(SrcParamData%LMassDen,1) - i1_u = UBOUND(SrcParamData%LMassDen,1) - IF (.NOT. ALLOCATED(DstParamData%LMassDen)) THEN - ALLOCATE(DstParamData%LMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LMassDen = SrcParamData%LMassDen -ENDIF -IF (ALLOCATED(SrcParamData%LDMassDen)) THEN - i1_l = LBOUND(SrcParamData%LDMassDen,1) - i1_u = UBOUND(SrcParamData%LDMassDen,1) - IF (.NOT. ALLOCATED(DstParamData%LDMassDen)) THEN - ALLOCATE(DstParamData%LDMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LDMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LDMassDen = SrcParamData%LDMassDen -ENDIF -IF (ALLOCATED(SrcParamData%LEAStiff)) THEN - i1_l = LBOUND(SrcParamData%LEAStiff,1) - i1_u = UBOUND(SrcParamData%LEAStiff,1) - IF (.NOT. ALLOCATED(DstParamData%LEAStiff)) THEN - ALLOCATE(DstParamData%LEAStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LEAStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LEAStiff = SrcParamData%LEAStiff -ENDIF -IF (ALLOCATED(SrcParamData%LineCI)) THEN - i1_l = LBOUND(SrcParamData%LineCI,1) - i1_u = UBOUND(SrcParamData%LineCI,1) - IF (.NOT. ALLOCATED(DstParamData%LineCI)) THEN - ALLOCATE(DstParamData%LineCI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LineCI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LineCI = SrcParamData%LineCI -ENDIF -IF (ALLOCATED(SrcParamData%LineCD)) THEN - i1_l = LBOUND(SrcParamData%LineCD,1) - i1_u = UBOUND(SrcParamData%LineCD,1) - IF (.NOT. ALLOCATED(DstParamData%LineCD)) THEN - ALLOCATE(DstParamData%LineCD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LineCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LineCD = SrcParamData%LineCD -ENDIF -IF (ALLOCATED(SrcParamData%Bvp)) THEN - i1_l = LBOUND(SrcParamData%Bvp,1) - i1_u = UBOUND(SrcParamData%Bvp,1) - i2_l = LBOUND(SrcParamData%Bvp,2) - i2_u = UBOUND(SrcParamData%Bvp,2) - IF (.NOT. ALLOCATED(DstParamData%Bvp)) THEN - ALLOCATE(DstParamData%Bvp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Bvp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Bvp = SrcParamData%Bvp -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) - IF (.NOT. ALLOCATED(DstParamData%WaveAcc0)) THEN - ALLOCATE(DstParamData%WaveAcc0(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%WaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveAcc0 = SrcParamData%WaveAcc0 -ENDIF -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%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) - IF (.NOT. ALLOCATED(DstParamData%WaveVel0)) THEN - ALLOCATE(DstParamData%WaveVel0(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%WaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveVel0 = SrcParamData%WaveVel0 -ENDIF - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%SHAP = SrcParamData%SHAP - DstParamData%SHAPS = SrcParamData%SHAPS - DstParamData%GAUSSW = SrcParamData%GAUSSW - DstParamData%NGAUSS = SrcParamData%NGAUSS - DstParamData%SHAPT = SrcParamData%SHAPT - DstParamData%SHAPTS = SrcParamData%SHAPTS - DstParamData%NTRAP = SrcParamData%NTRAP - DstParamData%SBEND = SrcParamData%SBEND - DstParamData%STEN = SrcParamData%STEN - DstParamData%RMASS = SrcParamData%RMASS - DstParamData%RADDM = SrcParamData%RADDM - DstParamData%PMPN = SrcParamData%PMPN - DstParamData%AM = SrcParamData%AM - DstParamData%PM = SrcParamData%PM - DstParamData%IDOF = SrcParamData%IDOF - DstParamData%JDOF = SrcParamData%JDOF - DstParamData%PPA = SrcParamData%PPA - DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%RootName = SrcParamData%RootName -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%Delim = SrcParamData%Delim -IF (ALLOCATED(SrcParamData%GLUZR)) THEN - i1_l = LBOUND(SrcParamData%GLUZR,1) - i1_u = UBOUND(SrcParamData%GLUZR,1) - i2_l = LBOUND(SrcParamData%GLUZR,2) - i2_u = UBOUND(SrcParamData%GLUZR,2) - i3_l = LBOUND(SrcParamData%GLUZR,3) - i3_u = UBOUND(SrcParamData%GLUZR,3) - IF (.NOT. ALLOCATED(DstParamData%GLUZR)) THEN - ALLOCATE(DstParamData%GLUZR(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%GLUZR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GLUZR = SrcParamData%GLUZR -ENDIF -IF (ALLOCATED(SrcParamData%GTZER)) THEN - i1_l = LBOUND(SrcParamData%GTZER,1) - i1_u = UBOUND(SrcParamData%GTZER,1) - i2_l = LBOUND(SrcParamData%GTZER,2) - i2_u = UBOUND(SrcParamData%GTZER,2) - IF (.NOT. ALLOCATED(DstParamData%GTZER)) THEN - ALLOCATE(DstParamData%GTZER(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GTZER.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GTZER = SrcParamData%GTZER -ENDIF - END SUBROUTINE FEAM_CopyParam - - SUBROUTINE FEAM_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(FEAM_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 = 'FEAM_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%NEQ)) THEN - DEALLOCATE(ParamData%NEQ) -ENDIF -IF (ALLOCATED(ParamData%GSL)) THEN - DEALLOCATE(ParamData%GSL) -ENDIF -IF (ALLOCATED(ParamData%GP)) THEN - DEALLOCATE(ParamData%GP) -ENDIF -IF (ALLOCATED(ParamData%Elength)) THEN - DEALLOCATE(ParamData%Elength) -ENDIF -IF (ALLOCATED(ParamData%BottmElev)) THEN - DEALLOCATE(ParamData%BottmElev) -ENDIF -IF (ALLOCATED(ParamData%BottmStiff)) THEN - DEALLOCATE(ParamData%BottmStiff) -ENDIF -IF (ALLOCATED(ParamData%LMassDen)) THEN - DEALLOCATE(ParamData%LMassDen) -ENDIF -IF (ALLOCATED(ParamData%LDMassDen)) THEN - DEALLOCATE(ParamData%LDMassDen) -ENDIF -IF (ALLOCATED(ParamData%LEAStiff)) THEN - DEALLOCATE(ParamData%LEAStiff) -ENDIF -IF (ALLOCATED(ParamData%LineCI)) THEN - DEALLOCATE(ParamData%LineCI) -ENDIF -IF (ALLOCATED(ParamData%LineCD)) THEN - DEALLOCATE(ParamData%LineCD) -ENDIF -IF (ALLOCATED(ParamData%Bvp)) THEN - DEALLOCATE(ParamData%Bvp) -ENDIF -IF (ALLOCATED(ParamData%WaveAcc0)) THEN - DEALLOCATE(ParamData%WaveAcc0) -ENDIF -IF (ALLOCATED(ParamData%WaveTime)) THEN - DEALLOCATE(ParamData%WaveTime) -ENDIF -IF (ALLOCATED(ParamData%WaveVel0)) THEN - DEALLOCATE(ParamData%WaveVel0) -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 -IF (ALLOCATED(ParamData%GLUZR)) THEN - DEALLOCATE(ParamData%GLUZR) -ENDIF -IF (ALLOCATED(ParamData%GTZER)) THEN - DEALLOCATE(ParamData%GTZER) -ENDIF - END SUBROUTINE FEAM_DestroyParam - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 - Re_BufSz = Re_BufSz + SIZE(InData%GRAV) ! GRAV - Re_BufSz = Re_BufSz + 1 ! Eps - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Int_BufSz = Int_BufSz + 1 ! MaxIter - Int_BufSz = Int_BufSz + 1 ! NHBD - Int_BufSz = Int_BufSz + 1 ! NDIM - Int_BufSz = Int_BufSz + 1 ! NEQ allocated yes/no - IF ( ALLOCATED(InData%NEQ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NEQ upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NEQ) ! NEQ - END IF - Int_BufSz = Int_BufSz + 1 ! NBAND - Int_BufSz = Int_BufSz + 1 ! NumLines - Int_BufSz = Int_BufSz + 1 ! NumElems - Int_BufSz = Int_BufSz + 1 ! NumNodes - Int_BufSz = Int_BufSz + 1 ! GSL allocated yes/no - IF ( ALLOCATED(InData%GSL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GSL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GSL) ! GSL - END IF - Int_BufSz = Int_BufSz + 1 ! GP allocated yes/no - IF ( ALLOCATED(InData%GP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GP) ! GP - END IF - Int_BufSz = Int_BufSz + 1 ! Elength allocated yes/no - IF ( ALLOCATED(InData%Elength) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Elength upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Elength) ! Elength - END IF - Int_BufSz = Int_BufSz + 1 ! BottmElev allocated yes/no - IF ( ALLOCATED(InData%BottmElev) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BottmElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BottmElev) ! BottmElev - END IF - Int_BufSz = Int_BufSz + 1 ! BottmStiff allocated yes/no - IF ( ALLOCATED(InData%BottmStiff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BottmStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BottmStiff) ! BottmStiff - END IF - Int_BufSz = Int_BufSz + 1 ! LMassDen allocated yes/no - IF ( ALLOCATED(InData%LMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LMassDen) ! LMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! LDMassDen allocated yes/no - IF ( ALLOCATED(InData%LDMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LDMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LDMassDen) ! LDMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! LEAStiff allocated yes/no - IF ( ALLOCATED(InData%LEAStiff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LEAStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LEAStiff) ! LEAStiff - END IF - Int_BufSz = Int_BufSz + 1 ! LineCI allocated yes/no - IF ( ALLOCATED(InData%LineCI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineCI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LineCI) ! LineCI - END IF - Int_BufSz = Int_BufSz + 1 ! LineCD allocated yes/no - IF ( ALLOCATED(InData%LineCD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineCD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LineCD) ! LineCD - END IF - Int_BufSz = Int_BufSz + 1 ! Bvp allocated yes/no - IF ( ALLOCATED(InData%Bvp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Bvp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Bvp) ! Bvp - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc0 allocated yes/no - IF ( ALLOCATED(InData%WaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc0) ! WaveAcc0 - 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 ! WaveVel0 allocated yes/no - IF ( ALLOCATED(InData%WaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel0) ! WaveVel0 - END IF - Int_BufSz = Int_BufSz + 1 ! NStepWave - Re_BufSz = Re_BufSz + SIZE(InData%SHAP) ! SHAP - Re_BufSz = Re_BufSz + SIZE(InData%SHAPS) ! SHAPS - Re_BufSz = Re_BufSz + SIZE(InData%GAUSSW) ! GAUSSW - Int_BufSz = Int_BufSz + 1 ! NGAUSS - Re_BufSz = Re_BufSz + SIZE(InData%SHAPT) ! SHAPT - Re_BufSz = Re_BufSz + SIZE(InData%SHAPTS) ! SHAPTS - Int_BufSz = Int_BufSz + 1 ! NTRAP - Re_BufSz = Re_BufSz + SIZE(InData%SBEND) ! SBEND - Re_BufSz = Re_BufSz + SIZE(InData%STEN) ! STEN - Re_BufSz = Re_BufSz + SIZE(InData%RMASS) ! RMASS - Re_BufSz = Re_BufSz + SIZE(InData%RADDM) ! RADDM - Re_BufSz = Re_BufSz + SIZE(InData%PMPN) ! PMPN - Re_BufSz = Re_BufSz + SIZE(InData%AM) ! AM - Re_BufSz = Re_BufSz + SIZE(InData%PM) ! PM - Int_BufSz = Int_BufSz + SIZE(InData%IDOF) ! IDOF - Int_BufSz = Int_BufSz + SIZE(InData%JDOF) ! JDOF - Re_BufSz = Re_BufSz + SIZE(InData%PPA) ! PPA - Re_BufSz = Re_BufSz + 1 ! PtfmRefzt - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - 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*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! GLUZR allocated yes/no - IF ( ALLOCATED(InData%GLUZR) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GLUZR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLUZR) ! GLUZR - END IF - Int_BufSz = Int_BufSz + 1 ! GTZER allocated yes/no - IF ( ALLOCATED(InData%GTZER) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GTZER upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GTZER) ! GTZER - 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 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%GRAV,1), UBOUND(InData%GRAV,1) - ReKiBuf(Re_Xferred) = InData%GRAV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Eps - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MaxIter - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NHBD - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NDIM - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NEQ) ) 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%NEQ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NEQ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NEQ,1), UBOUND(InData%NEQ,1) - IntKiBuf(Int_Xferred) = InData%NEQ(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NBAND - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumElems - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GSL) ) 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%GSL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GSL,3), UBOUND(InData%GSL,3) - DO i2 = LBOUND(InData%GSL,2), UBOUND(InData%GSL,2) - DO i1 = LBOUND(InData%GSL,1), UBOUND(InData%GSL,1) - ReKiBuf(Re_Xferred) = InData%GSL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GP) ) 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%GP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GP,2), UBOUND(InData%GP,2) - DO i1 = LBOUND(InData%GP,1), UBOUND(InData%GP,1) - ReKiBuf(Re_Xferred) = InData%GP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Elength) ) 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%Elength,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elength,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Elength,1), UBOUND(InData%Elength,1) - ReKiBuf(Re_Xferred) = InData%Elength(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BottmElev) ) 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%BottmElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmElev,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BottmElev,1), UBOUND(InData%BottmElev,1) - ReKiBuf(Re_Xferred) = InData%BottmElev(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BottmStiff) ) 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%BottmStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmStiff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BottmStiff,1), UBOUND(InData%BottmStiff,1) - ReKiBuf(Re_Xferred) = InData%BottmStiff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LMassDen) ) 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%LMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LMassDen,1), UBOUND(InData%LMassDen,1) - ReKiBuf(Re_Xferred) = InData%LMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LDMassDen) ) 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%LDMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LDMassDen,1), UBOUND(InData%LDMassDen,1) - ReKiBuf(Re_Xferred) = InData%LDMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LEAStiff) ) 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%LEAStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LEAStiff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LEAStiff,1), UBOUND(InData%LEAStiff,1) - ReKiBuf(Re_Xferred) = InData%LEAStiff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineCI) ) 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%LineCI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineCI,1), UBOUND(InData%LineCI,1) - ReKiBuf(Re_Xferred) = InData%LineCI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineCD) ) 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%LineCD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineCD,1), UBOUND(InData%LineCD,1) - ReKiBuf(Re_Xferred) = InData%LineCD(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Bvp) ) 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%Bvp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bvp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bvp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bvp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Bvp,2), UBOUND(InData%Bvp,2) - DO i1 = LBOUND(InData%Bvp,1), UBOUND(InData%Bvp,1) - ReKiBuf(Re_Xferred) = InData%Bvp(i1,i2) - Re_Xferred = Re_Xferred + 1 - 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 - - 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) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - 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 - - 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) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%SHAP,2), UBOUND(InData%SHAP,2) - DO i1 = LBOUND(InData%SHAP,1), UBOUND(InData%SHAP,1) - ReKiBuf(Re_Xferred) = InData%SHAP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%SHAPS,2), UBOUND(InData%SHAPS,2) - DO i1 = LBOUND(InData%SHAPS,1), UBOUND(InData%SHAPS,1) - ReKiBuf(Re_Xferred) = InData%SHAPS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%GAUSSW,1), UBOUND(InData%GAUSSW,1) - ReKiBuf(Re_Xferred) = InData%GAUSSW(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NGAUSS - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%SHAPT,2), UBOUND(InData%SHAPT,2) - DO i1 = LBOUND(InData%SHAPT,1), UBOUND(InData%SHAPT,1) - ReKiBuf(Re_Xferred) = InData%SHAPT(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%SHAPTS,2), UBOUND(InData%SHAPTS,2) - DO i1 = LBOUND(InData%SHAPTS,1), UBOUND(InData%SHAPTS,1) - ReKiBuf(Re_Xferred) = InData%SHAPTS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IntKiBuf(Int_Xferred) = InData%NTRAP - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%SBEND,2), UBOUND(InData%SBEND,2) - DO i1 = LBOUND(InData%SBEND,1), UBOUND(InData%SBEND,1) - ReKiBuf(Re_Xferred) = InData%SBEND(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i3 = LBOUND(InData%STEN,3), UBOUND(InData%STEN,3) - DO i2 = LBOUND(InData%STEN,2), UBOUND(InData%STEN,2) - DO i1 = LBOUND(InData%STEN,1), UBOUND(InData%STEN,1) - ReKiBuf(Re_Xferred) = InData%STEN(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - DO i2 = LBOUND(InData%RMASS,2), UBOUND(InData%RMASS,2) - DO i1 = LBOUND(InData%RMASS,1), UBOUND(InData%RMASS,1) - ReKiBuf(Re_Xferred) = InData%RMASS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i4 = LBOUND(InData%RADDM,4), UBOUND(InData%RADDM,4) - DO i3 = LBOUND(InData%RADDM,3), UBOUND(InData%RADDM,3) - DO i2 = LBOUND(InData%RADDM,2), UBOUND(InData%RADDM,2) - DO i1 = LBOUND(InData%RADDM,1), UBOUND(InData%RADDM,1) - ReKiBuf(Re_Xferred) = InData%RADDM(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - DO i2 = LBOUND(InData%PMPN,2), UBOUND(InData%PMPN,2) - DO i1 = LBOUND(InData%PMPN,1), UBOUND(InData%PMPN,1) - ReKiBuf(Re_Xferred) = InData%PMPN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%AM,1), UBOUND(InData%AM,1) - ReKiBuf(Re_Xferred) = InData%AM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PM,1), UBOUND(InData%PM,1) - ReKiBuf(Re_Xferred) = InData%PM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%IDOF,2), UBOUND(InData%IDOF,2) - DO i1 = LBOUND(InData%IDOF,1), UBOUND(InData%IDOF,1) - IntKiBuf(Int_Xferred) = InData%IDOF(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%JDOF,1), UBOUND(InData%JDOF,1) - IntKiBuf(Int_Xferred) = InData%JDOF(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i3 = LBOUND(InData%PPA,3), UBOUND(InData%PPA,3) - DO i2 = LBOUND(InData%PPA,2), UBOUND(InData%PPA,2) - DO i1 = LBOUND(InData%PPA,1), UBOUND(InData%PPA,1) - ReKiBuf(Re_Xferred) = InData%PPA(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - ReKiBuf(Re_Xferred) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%GLUZR) ) 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%GLUZR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLUZR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLUZR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLUZR,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLUZR,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLUZR,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GLUZR,3), UBOUND(InData%GLUZR,3) - DO i2 = LBOUND(InData%GLUZR,2), UBOUND(InData%GLUZR,2) - DO i1 = LBOUND(InData%GLUZR,1), UBOUND(InData%GLUZR,1) - ReKiBuf(Re_Xferred) = InData%GLUZR(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GTZER) ) 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%GTZER,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GTZER,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GTZER,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GTZER,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GTZER,2), UBOUND(InData%GTZER,2) - DO i1 = LBOUND(InData%GTZER,1), UBOUND(InData%GTZER,1) - ReKiBuf(Re_Xferred) = InData%GTZER(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FEAM_PackParam - - SUBROUTINE FEAM_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(FEAM_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) :: 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_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 - i1_l = LBOUND(OutData%GRAV,1) - i1_u = UBOUND(OutData%GRAV,1) - DO i1 = LBOUND(OutData%GRAV,1), UBOUND(OutData%GRAV,1) - OutData%GRAV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Eps = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NHBD = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NDIM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NEQ 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%NEQ)) DEALLOCATE(OutData%NEQ) - ALLOCATE(OutData%NEQ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NEQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NEQ,1), UBOUND(OutData%NEQ,1) - OutData%NEQ(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NBAND = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumLines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumElems = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSL 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%GSL)) DEALLOCATE(OutData%GSL) - ALLOCATE(OutData%GSL(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%GSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GSL,3), UBOUND(OutData%GSL,3) - DO i2 = LBOUND(OutData%GSL,2), UBOUND(OutData%GSL,2) - DO i1 = LBOUND(OutData%GSL,1), UBOUND(OutData%GSL,1) - OutData%GSL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GP 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%GP)) DEALLOCATE(OutData%GP) - ALLOCATE(OutData%GP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GP,2), UBOUND(OutData%GP,2) - DO i1 = LBOUND(OutData%GP,1), UBOUND(OutData%GP,1) - OutData%GP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elength 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%Elength)) DEALLOCATE(OutData%Elength) - ALLOCATE(OutData%Elength(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elength.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Elength,1), UBOUND(OutData%Elength,1) - OutData%Elength(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmElev 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%BottmElev)) DEALLOCATE(OutData%BottmElev) - ALLOCATE(OutData%BottmElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BottmElev,1), UBOUND(OutData%BottmElev,1) - OutData%BottmElev(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmStiff 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%BottmStiff)) DEALLOCATE(OutData%BottmStiff) - ALLOCATE(OutData%BottmStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BottmStiff,1), UBOUND(OutData%BottmStiff,1) - OutData%BottmStiff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LMassDen 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%LMassDen)) DEALLOCATE(OutData%LMassDen) - ALLOCATE(OutData%LMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LMassDen,1), UBOUND(OutData%LMassDen,1) - OutData%LMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDMassDen 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%LDMassDen)) DEALLOCATE(OutData%LDMassDen) - ALLOCATE(OutData%LDMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LDMassDen,1), UBOUND(OutData%LDMassDen,1) - OutData%LDMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LEAStiff 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%LEAStiff)) DEALLOCATE(OutData%LEAStiff) - ALLOCATE(OutData%LEAStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LEAStiff,1), UBOUND(OutData%LEAStiff,1) - OutData%LEAStiff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCI 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%LineCI)) DEALLOCATE(OutData%LineCI) - ALLOCATE(OutData%LineCI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineCI,1), UBOUND(OutData%LineCI,1) - OutData%LineCI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCD 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%LineCD)) DEALLOCATE(OutData%LineCD) - ALLOCATE(OutData%LineCD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineCD,1), UBOUND(OutData%LineCD,1) - OutData%LineCD(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bvp 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%Bvp)) DEALLOCATE(OutData%Bvp) - ALLOCATE(OutData%Bvp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bvp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Bvp,2), UBOUND(OutData%Bvp,2) - DO i1 = LBOUND(OutData%Bvp,1), UBOUND(OutData%Bvp,1) - OutData%Bvp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 - IF (ALLOCATED(OutData%WaveAcc0)) DEALLOCATE(OutData%WaveAcc0) - ALLOCATE(OutData%WaveAcc0(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%WaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - 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) = ReKiBuf(Re_Xferred) - 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 (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) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 - IF (ALLOCATED(OutData%WaveVel0)) DEALLOCATE(OutData%WaveVel0) - ALLOCATE(OutData%WaveVel0(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%WaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - 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) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%SHAP,1) - i1_u = UBOUND(OutData%SHAP,1) - i2_l = LBOUND(OutData%SHAP,2) - i2_u = UBOUND(OutData%SHAP,2) - DO i2 = LBOUND(OutData%SHAP,2), UBOUND(OutData%SHAP,2) - DO i1 = LBOUND(OutData%SHAP,1), UBOUND(OutData%SHAP,1) - OutData%SHAP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%SHAPS,1) - i1_u = UBOUND(OutData%SHAPS,1) - i2_l = LBOUND(OutData%SHAPS,2) - i2_u = UBOUND(OutData%SHAPS,2) - DO i2 = LBOUND(OutData%SHAPS,2), UBOUND(OutData%SHAPS,2) - DO i1 = LBOUND(OutData%SHAPS,1), UBOUND(OutData%SHAPS,1) - OutData%SHAPS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%GAUSSW,1) - i1_u = UBOUND(OutData%GAUSSW,1) - DO i1 = LBOUND(OutData%GAUSSW,1), UBOUND(OutData%GAUSSW,1) - OutData%GAUSSW(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%NGAUSS = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%SHAPT,1) - i1_u = UBOUND(OutData%SHAPT,1) - i2_l = LBOUND(OutData%SHAPT,2) - i2_u = UBOUND(OutData%SHAPT,2) - DO i2 = LBOUND(OutData%SHAPT,2), UBOUND(OutData%SHAPT,2) - DO i1 = LBOUND(OutData%SHAPT,1), UBOUND(OutData%SHAPT,1) - OutData%SHAPT(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%SHAPTS,1) - i1_u = UBOUND(OutData%SHAPTS,1) - i2_l = LBOUND(OutData%SHAPTS,2) - i2_u = UBOUND(OutData%SHAPTS,2) - DO i2 = LBOUND(OutData%SHAPTS,2), UBOUND(OutData%SHAPTS,2) - DO i1 = LBOUND(OutData%SHAPTS,1), UBOUND(OutData%SHAPTS,1) - OutData%SHAPTS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - OutData%NTRAP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%SBEND,1) - i1_u = UBOUND(OutData%SBEND,1) - i2_l = LBOUND(OutData%SBEND,2) - i2_u = UBOUND(OutData%SBEND,2) - DO i2 = LBOUND(OutData%SBEND,2), UBOUND(OutData%SBEND,2) - DO i1 = LBOUND(OutData%SBEND,1), UBOUND(OutData%SBEND,1) - OutData%SBEND(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%STEN,1) - i1_u = UBOUND(OutData%STEN,1) - i2_l = LBOUND(OutData%STEN,2) - i2_u = UBOUND(OutData%STEN,2) - i3_l = LBOUND(OutData%STEN,3) - i3_u = UBOUND(OutData%STEN,3) - DO i3 = LBOUND(OutData%STEN,3), UBOUND(OutData%STEN,3) - DO i2 = LBOUND(OutData%STEN,2), UBOUND(OutData%STEN,2) - DO i1 = LBOUND(OutData%STEN,1), UBOUND(OutData%STEN,1) - OutData%STEN(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - i1_l = LBOUND(OutData%RMASS,1) - i1_u = UBOUND(OutData%RMASS,1) - i2_l = LBOUND(OutData%RMASS,2) - i2_u = UBOUND(OutData%RMASS,2) - DO i2 = LBOUND(OutData%RMASS,2), UBOUND(OutData%RMASS,2) - DO i1 = LBOUND(OutData%RMASS,1), UBOUND(OutData%RMASS,1) - OutData%RMASS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%RADDM,1) - i1_u = UBOUND(OutData%RADDM,1) - i2_l = LBOUND(OutData%RADDM,2) - i2_u = UBOUND(OutData%RADDM,2) - i3_l = LBOUND(OutData%RADDM,3) - i3_u = UBOUND(OutData%RADDM,3) - i4_l = LBOUND(OutData%RADDM,4) - i4_u = UBOUND(OutData%RADDM,4) - DO i4 = LBOUND(OutData%RADDM,4), UBOUND(OutData%RADDM,4) - DO i3 = LBOUND(OutData%RADDM,3), UBOUND(OutData%RADDM,3) - DO i2 = LBOUND(OutData%RADDM,2), UBOUND(OutData%RADDM,2) - DO i1 = LBOUND(OutData%RADDM,1), UBOUND(OutData%RADDM,1) - OutData%RADDM(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - i1_l = LBOUND(OutData%PMPN,1) - i1_u = UBOUND(OutData%PMPN,1) - i2_l = LBOUND(OutData%PMPN,2) - i2_u = UBOUND(OutData%PMPN,2) - DO i2 = LBOUND(OutData%PMPN,2), UBOUND(OutData%PMPN,2) - DO i1 = LBOUND(OutData%PMPN,1), UBOUND(OutData%PMPN,1) - OutData%PMPN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%AM,1) - i1_u = UBOUND(OutData%AM,1) - DO i1 = LBOUND(OutData%AM,1), UBOUND(OutData%AM,1) - OutData%AM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PM,1) - i1_u = UBOUND(OutData%PM,1) - DO i1 = LBOUND(OutData%PM,1), UBOUND(OutData%PM,1) - OutData%PM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%IDOF,1) - i1_u = UBOUND(OutData%IDOF,1) - i2_l = LBOUND(OutData%IDOF,2) - i2_u = UBOUND(OutData%IDOF,2) - DO i2 = LBOUND(OutData%IDOF,2), UBOUND(OutData%IDOF,2) - DO i1 = LBOUND(OutData%IDOF,1), UBOUND(OutData%IDOF,1) - OutData%IDOF(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%JDOF,1) - i1_u = UBOUND(OutData%JDOF,1) - DO i1 = LBOUND(OutData%JDOF,1), UBOUND(OutData%JDOF,1) - OutData%JDOF(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PPA,1) - i1_u = UBOUND(OutData%PPA,1) - i2_l = LBOUND(OutData%PPA,2) - i2_u = UBOUND(OutData%PPA,2) - i3_l = LBOUND(OutData%PPA,3) - i3_u = UBOUND(OutData%PPA,3) - DO i3 = LBOUND(OutData%PPA,3), UBOUND(OutData%PPA,3) - DO i2 = LBOUND(OutData%PPA,2), UBOUND(OutData%PPA,2) - DO i1 = LBOUND(OutData%PPA,1), UBOUND(OutData%PPA,1) - OutData%PPA(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - OutData%PtfmRefzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLUZR 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%GLUZR)) DEALLOCATE(OutData%GLUZR) - ALLOCATE(OutData%GLUZR(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%GLUZR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GLUZR,3), UBOUND(OutData%GLUZR,3) - DO i2 = LBOUND(OutData%GLUZR,2), UBOUND(OutData%GLUZR,2) - DO i1 = LBOUND(OutData%GLUZR,1), UBOUND(OutData%GLUZR,1) - OutData%GLUZR(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GTZER 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%GTZER)) DEALLOCATE(OutData%GTZER) - ALLOCATE(OutData%GTZER(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GTZER.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GTZER,2), UBOUND(OutData%GTZER,2) - DO i1 = LBOUND(OutData%GTZER,1), UBOUND(OutData%GTZER,1) - OutData%GTZER(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FEAM_UnPackParam - - SUBROUTINE FEAM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_InputType), INTENT(INOUT) :: SrcInputData - TYPE(FEAM_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 = 'FEAM_CopyInput' -! + ErrMsg = '' + if (allocated(ContStateData%GLU)) then + deallocate(ContStateData%GLU) + end if + if (allocated(ContStateData%GLDU)) then + deallocate(ContStateData%GLDU) + end if +end subroutine + +subroutine FEAM_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%GLU)) + if (allocated(InData%GLU)) then + call RegPackBounds(Buf, 2, lbound(InData%GLU), ubound(InData%GLU)) + call RegPack(Buf, InData%GLU) + end if + call RegPack(Buf, allocated(InData%GLDU)) + if (allocated(InData%GLDU)) then + call RegPackBounds(Buf, 2, lbound(InData%GLDU), ubound(InData%GLDU)) + call RegPack(Buf, InData%GLDU) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackContState' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%GLU)) deallocate(OutData%GLU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GLU(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GLU) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%GLDU)) deallocate(OutData%GLDU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GLDU(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GLDU) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FEAM_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_DiscreteStateType), intent(in) :: SrcDiscStateData + type(FEAM_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%HydroForceLineMesh, DstInputData%HydroForceLineMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%PtFairleadDisplacement, DstInputData%PtFairleadDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FEAM_CopyInput - - SUBROUTINE FEAM_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(FEAM_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 = 'FEAM_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( InputData%HydroForceLineMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%PtFairleadDisplacement, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FEAM_DestroyInput - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! HydroForceLineMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%HydroForceLineMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HydroForceLineMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HydroForceLineMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HydroForceLineMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HydroForceLineMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! PtFairleadDisplacement: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtFairleadDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtFairleadDisplacement - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtFairleadDisplacement - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtFairleadDisplacement - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtFairleadDisplacement - 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 - - CALL MeshPack( InData%HydroForceLineMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HydroForceLineMesh - 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 - CALL MeshPack( InData%PtFairleadDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairleadDisplacement - 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 FEAM_PackInput - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 - 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 MeshUnpack( OutData%HydroForceLineMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HydroForceLineMesh - 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) - 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 MeshUnpack( OutData%PtFairleadDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtFairleadDisplacement - 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 FEAM_UnPackInput - - SUBROUTINE FEAM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(FEAM_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 = 'FEAM_CopyOutput' -! + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine FEAM_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(FEAM_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyDiscState' 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 - CALL MeshCopy( SrcOutputData%PtFairleadLoad, DstOutputData%PtFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%LineMeshPosition, DstOutputData%LineMeshPosition, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FEAM_CopyOutput - - SUBROUTINE FEAM_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(FEAM_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 = 'FEAM_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - CALL MeshDestroy( OutputData%PtFairleadLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%LineMeshPosition, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FEAM_DestroyOutput - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtFairleadLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtFairleadLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtFairleadLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtFairleadLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtFairleadLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! LineMeshPosition: size of buffers for each call to pack subtype - CALL MeshPack( InData%LineMeshPosition, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! LineMeshPosition - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LineMeshPosition - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LineMeshPosition - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LineMeshPosition - 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 - - 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 - CALL MeshPack( InData%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairleadLoad - 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 - CALL MeshPack( InData%LineMeshPosition, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! LineMeshPosition - 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 FEAM_PackOutput - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 - 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 MeshUnpack( OutData%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtFairleadLoad - 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) - 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 MeshUnpack( OutData%LineMeshPosition, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! LineMeshPosition - 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 FEAM_UnPackOutput - - - SUBROUTINE FEAM_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(FEAM_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(FEAM_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 + ErrMsg = '' +end subroutine + +subroutine FEAM_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_ConstraintStateType), intent(in) :: SrcConstrStateData + type(FEAM_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%TSN = SrcConstrStateData%TSN + DstConstrStateData%TZER = SrcConstrStateData%TZER +end subroutine + +subroutine FEAM_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(FEAM_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FEAM_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%TSN) + call RegPack(Buf, InData%TZER) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%TSN) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TZER) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_OtherStateType), intent(in) :: SrcOtherStateData + type(FEAM_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FEAM_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%GLU0)) then + LB(1:2) = lbound(SrcOtherStateData%GLU0) + UB(1:2) = ubound(SrcOtherStateData%GLU0) + if (.not. allocated(DstOtherStateData%GLU0)) then + allocate(DstOtherStateData%GLU0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GLU0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%GLU0 = SrcOtherStateData%GLU0 + end if + if (allocated(SrcOtherStateData%GLDDU)) then + LB(1:2) = lbound(SrcOtherStateData%GLDDU) + UB(1:2) = ubound(SrcOtherStateData%GLDDU) + if (.not. allocated(DstOtherStateData%GLDDU)) then + allocate(DstOtherStateData%GLDDU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GLDDU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%GLDDU = SrcOtherStateData%GLDDU + end if + DstOtherStateData%BottomTouch = SrcOtherStateData%BottomTouch + if (allocated(SrcOtherStateData%GFORC0)) then + LB(1:3) = lbound(SrcOtherStateData%GFORC0) + UB(1:3) = ubound(SrcOtherStateData%GFORC0) + if (.not. allocated(DstOtherStateData%GFORC0)) then + allocate(DstOtherStateData%GFORC0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GFORC0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%GFORC0 = SrcOtherStateData%GFORC0 + end if + if (allocated(SrcOtherStateData%GMASS0)) then + LB(1:4) = lbound(SrcOtherStateData%GMASS0) + UB(1:4) = ubound(SrcOtherStateData%GMASS0) + if (.not. allocated(DstOtherStateData%GMASS0)) then + allocate(DstOtherStateData%GMASS0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GMASS0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%GMASS0 = SrcOtherStateData%GMASS0 + end if + if (allocated(SrcOtherStateData%FAST_FPA)) then + LB(1:2) = lbound(SrcOtherStateData%FAST_FPA) + UB(1:2) = ubound(SrcOtherStateData%FAST_FPA) + if (.not. allocated(DstOtherStateData%FAST_FPA)) then + allocate(DstOtherStateData%FAST_FPA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FAST_FPA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%FAST_FPA = SrcOtherStateData%FAST_FPA + end if + if (allocated(SrcOtherStateData%FAST_RP)) then + LB(1:2) = lbound(SrcOtherStateData%FAST_RP) + UB(1:2) = ubound(SrcOtherStateData%FAST_RP) + if (.not. allocated(DstOtherStateData%FAST_RP)) then + allocate(DstOtherStateData%FAST_RP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FAST_RP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%FAST_RP = SrcOtherStateData%FAST_RP + end if + DstOtherStateData%INCR = SrcOtherStateData%INCR + DstOtherStateData%RSDF = SrcOtherStateData%RSDF + DstOtherStateData%FORC0 = SrcOtherStateData%FORC0 + DstOtherStateData%EMAS0 = SrcOtherStateData%EMAS0 +end subroutine + +subroutine FEAM_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(FEAM_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%GLU0)) then + deallocate(OtherStateData%GLU0) + end if + if (allocated(OtherStateData%GLDDU)) then + deallocate(OtherStateData%GLDDU) + end if + if (allocated(OtherStateData%GFORC0)) then + deallocate(OtherStateData%GFORC0) + end if + if (allocated(OtherStateData%GMASS0)) then + deallocate(OtherStateData%GMASS0) + end if + if (allocated(OtherStateData%FAST_FPA)) then + deallocate(OtherStateData%FAST_FPA) + end if + if (allocated(OtherStateData%FAST_RP)) then + deallocate(OtherStateData%FAST_RP) + end if +end subroutine + +subroutine FEAM_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%GLU0)) + if (allocated(InData%GLU0)) then + call RegPackBounds(Buf, 2, lbound(InData%GLU0), ubound(InData%GLU0)) + call RegPack(Buf, InData%GLU0) + end if + call RegPack(Buf, allocated(InData%GLDDU)) + if (allocated(InData%GLDDU)) then + call RegPackBounds(Buf, 2, lbound(InData%GLDDU), ubound(InData%GLDDU)) + call RegPack(Buf, InData%GLDDU) + end if + call RegPack(Buf, InData%BottomTouch) + call RegPack(Buf, allocated(InData%GFORC0)) + if (allocated(InData%GFORC0)) then + call RegPackBounds(Buf, 3, lbound(InData%GFORC0), ubound(InData%GFORC0)) + call RegPack(Buf, InData%GFORC0) + end if + call RegPack(Buf, allocated(InData%GMASS0)) + if (allocated(InData%GMASS0)) then + call RegPackBounds(Buf, 4, lbound(InData%GMASS0), ubound(InData%GMASS0)) + call RegPack(Buf, InData%GMASS0) + end if + call RegPack(Buf, allocated(InData%FAST_FPA)) + if (allocated(InData%FAST_FPA)) then + call RegPackBounds(Buf, 2, lbound(InData%FAST_FPA), ubound(InData%FAST_FPA)) + call RegPack(Buf, InData%FAST_FPA) + end if + call RegPack(Buf, allocated(InData%FAST_RP)) + if (allocated(InData%FAST_RP)) then + call RegPackBounds(Buf, 2, lbound(InData%FAST_RP), ubound(InData%FAST_RP)) + call RegPack(Buf, InData%FAST_RP) + end if + call RegPack(Buf, InData%INCR) + call RegPack(Buf, InData%RSDF) + call RegPack(Buf, InData%FORC0) + call RegPack(Buf, InData%EMAS0) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackOtherState' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%GLU0)) deallocate(OutData%GLU0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GLU0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GLU0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%GLDDU)) deallocate(OutData%GLDDU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GLDDU(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDDU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GLDDU) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%BottomTouch) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%GFORC0)) deallocate(OutData%GFORC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GFORC0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GFORC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GFORC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%GMASS0)) deallocate(OutData%GMASS0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GMASS0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GMASS0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GMASS0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FAST_FPA)) deallocate(OutData%FAST_FPA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FAST_FPA(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FPA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FAST_FPA) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FAST_RP)) deallocate(OutData%FAST_RP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FAST_RP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_RP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FAST_RP) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%INCR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RSDF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FORC0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EMAS0) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_MiscVarType), intent(in) :: SrcMiscData + type(FEAM_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FEAM_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%GLF)) then + LB(1:2) = lbound(SrcMiscData%GLF) + UB(1:2) = ubound(SrcMiscData%GLF) + if (.not. allocated(DstMiscData%GLF)) then + allocate(DstMiscData%GLF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GLF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%GLF = SrcMiscData%GLF + end if + if (allocated(SrcMiscData%GLK)) then + LB(1:3) = lbound(SrcMiscData%GLK) + UB(1:3) = ubound(SrcMiscData%GLK) + if (.not. allocated(DstMiscData%GLK)) then + allocate(DstMiscData%GLK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GLK.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%GLK = SrcMiscData%GLK + end if + DstMiscData%EMASS = SrcMiscData%EMASS + DstMiscData%ESTIF = SrcMiscData%ESTIF + if (allocated(SrcMiscData%FAST_FP)) then + LB(1:2) = lbound(SrcMiscData%FAST_FP) + UB(1:2) = ubound(SrcMiscData%FAST_FP) + if (.not. allocated(DstMiscData%FAST_FP)) then + allocate(DstMiscData%FAST_FP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAST_FP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FAST_FP = SrcMiscData%FAST_FP + end if + DstMiscData%FORCE = SrcMiscData%FORCE + DstMiscData%FP = SrcMiscData%FP + DstMiscData%U = SrcMiscData%U + DstMiscData%U0 = SrcMiscData%U0 + DstMiscData%DU = SrcMiscData%DU + DstMiscData%DDU = SrcMiscData%DDU + DstMiscData%R = SrcMiscData%R + DstMiscData%RP = SrcMiscData%RP + DstMiscData%RHSR = SrcMiscData%RHSR + DstMiscData%SLIN = SrcMiscData%SLIN + DstMiscData%STIFR = SrcMiscData%STIFR + if (allocated(SrcMiscData%FAIR_ANG)) then + LB(1:2) = lbound(SrcMiscData%FAIR_ANG) + UB(1:2) = ubound(SrcMiscData%FAIR_ANG) + if (.not. allocated(DstMiscData%FAIR_ANG)) then + allocate(DstMiscData%FAIR_ANG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAIR_ANG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FAIR_ANG = SrcMiscData%FAIR_ANG + end if + if (allocated(SrcMiscData%FAIR_T)) then + LB(1:1) = lbound(SrcMiscData%FAIR_T) + UB(1:1) = ubound(SrcMiscData%FAIR_T) + if (.not. allocated(DstMiscData%FAIR_T)) then + allocate(DstMiscData%FAIR_T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAIR_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FAIR_T = SrcMiscData%FAIR_T + end if + if (allocated(SrcMiscData%ANCH_ANG)) then + LB(1:2) = lbound(SrcMiscData%ANCH_ANG) + UB(1:2) = ubound(SrcMiscData%ANCH_ANG) + if (.not. allocated(DstMiscData%ANCH_ANG)) then + allocate(DstMiscData%ANCH_ANG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ANCH_ANG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ANCH_ANG = SrcMiscData%ANCH_ANG + end if + if (allocated(SrcMiscData%ANCH_T)) then + LB(1:1) = lbound(SrcMiscData%ANCH_T) + UB(1:1) = ubound(SrcMiscData%ANCH_T) + if (.not. allocated(DstMiscData%ANCH_T)) then + allocate(DstMiscData%ANCH_T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ANCH_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ANCH_T = SrcMiscData%ANCH_T + end if + if (allocated(SrcMiscData%Line_Coordinate)) then + LB(1:3) = lbound(SrcMiscData%Line_Coordinate) + UB(1:3) = ubound(SrcMiscData%Line_Coordinate) + if (.not. allocated(DstMiscData%Line_Coordinate)) then + allocate(DstMiscData%Line_Coordinate(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Coordinate.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Line_Coordinate = SrcMiscData%Line_Coordinate + end if + if (allocated(SrcMiscData%Line_Tangent)) then + LB(1:3) = lbound(SrcMiscData%Line_Tangent) + UB(1:3) = ubound(SrcMiscData%Line_Tangent) + if (.not. allocated(DstMiscData%Line_Tangent)) then + allocate(DstMiscData%Line_Tangent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Tangent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Line_Tangent = SrcMiscData%Line_Tangent + end if + if (allocated(SrcMiscData%F_Lines)) then + LB(1:2) = lbound(SrcMiscData%F_Lines) + UB(1:2) = ubound(SrcMiscData%F_Lines) + if (.not. allocated(DstMiscData%F_Lines)) then + allocate(DstMiscData%F_Lines(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Lines.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Lines = SrcMiscData%F_Lines + end if + DstMiscData%LastIndWave = SrcMiscData%LastIndWave +end subroutine + +subroutine FEAM_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(FEAM_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%GLF)) then + deallocate(MiscData%GLF) + end if + if (allocated(MiscData%GLK)) then + deallocate(MiscData%GLK) + end if + if (allocated(MiscData%FAST_FP)) then + deallocate(MiscData%FAST_FP) + end if + if (allocated(MiscData%FAIR_ANG)) then + deallocate(MiscData%FAIR_ANG) + end if + if (allocated(MiscData%FAIR_T)) then + deallocate(MiscData%FAIR_T) + end if + if (allocated(MiscData%ANCH_ANG)) then + deallocate(MiscData%ANCH_ANG) + end if + if (allocated(MiscData%ANCH_T)) then + deallocate(MiscData%ANCH_T) + end if + if (allocated(MiscData%Line_Coordinate)) then + deallocate(MiscData%Line_Coordinate) + end if + if (allocated(MiscData%Line_Tangent)) then + deallocate(MiscData%Line_Tangent) + end if + if (allocated(MiscData%F_Lines)) then + deallocate(MiscData%F_Lines) + end if +end subroutine + +subroutine FEAM_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%GLF)) + if (allocated(InData%GLF)) then + call RegPackBounds(Buf, 2, lbound(InData%GLF), ubound(InData%GLF)) + call RegPack(Buf, InData%GLF) + end if + call RegPack(Buf, allocated(InData%GLK)) + if (allocated(InData%GLK)) then + call RegPackBounds(Buf, 3, lbound(InData%GLK), ubound(InData%GLK)) + call RegPack(Buf, InData%GLK) + end if + call RegPack(Buf, InData%EMASS) + call RegPack(Buf, InData%ESTIF) + call RegPack(Buf, allocated(InData%FAST_FP)) + if (allocated(InData%FAST_FP)) then + call RegPackBounds(Buf, 2, lbound(InData%FAST_FP), ubound(InData%FAST_FP)) + call RegPack(Buf, InData%FAST_FP) + end if + call RegPack(Buf, InData%FORCE) + call RegPack(Buf, InData%FP) + call RegPack(Buf, InData%U) + call RegPack(Buf, InData%U0) + call RegPack(Buf, InData%DU) + call RegPack(Buf, InData%DDU) + call RegPack(Buf, InData%R) + call RegPack(Buf, InData%RP) + call RegPack(Buf, InData%RHSR) + call RegPack(Buf, InData%SLIN) + call RegPack(Buf, InData%STIFR) + call RegPack(Buf, allocated(InData%FAIR_ANG)) + if (allocated(InData%FAIR_ANG)) then + call RegPackBounds(Buf, 2, lbound(InData%FAIR_ANG), ubound(InData%FAIR_ANG)) + call RegPack(Buf, InData%FAIR_ANG) + end if + call RegPack(Buf, allocated(InData%FAIR_T)) + if (allocated(InData%FAIR_T)) then + call RegPackBounds(Buf, 1, lbound(InData%FAIR_T), ubound(InData%FAIR_T)) + call RegPack(Buf, InData%FAIR_T) + end if + call RegPack(Buf, allocated(InData%ANCH_ANG)) + if (allocated(InData%ANCH_ANG)) then + call RegPackBounds(Buf, 2, lbound(InData%ANCH_ANG), ubound(InData%ANCH_ANG)) + call RegPack(Buf, InData%ANCH_ANG) + end if + call RegPack(Buf, allocated(InData%ANCH_T)) + if (allocated(InData%ANCH_T)) then + call RegPackBounds(Buf, 1, lbound(InData%ANCH_T), ubound(InData%ANCH_T)) + call RegPack(Buf, InData%ANCH_T) + end if + call RegPack(Buf, allocated(InData%Line_Coordinate)) + if (allocated(InData%Line_Coordinate)) then + call RegPackBounds(Buf, 3, lbound(InData%Line_Coordinate), ubound(InData%Line_Coordinate)) + call RegPack(Buf, InData%Line_Coordinate) + end if + call RegPack(Buf, allocated(InData%Line_Tangent)) + if (allocated(InData%Line_Tangent)) then + call RegPackBounds(Buf, 3, lbound(InData%Line_Tangent), ubound(InData%Line_Tangent)) + call RegPack(Buf, InData%Line_Tangent) + end if + call RegPack(Buf, allocated(InData%F_Lines)) + if (allocated(InData%F_Lines)) then + call RegPackBounds(Buf, 2, lbound(InData%F_Lines), ubound(InData%F_Lines)) + call RegPack(Buf, InData%F_Lines) + end if + call RegPack(Buf, InData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackMisc' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%GLF)) deallocate(OutData%GLF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GLF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GLF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%GLK)) deallocate(OutData%GLK) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GLK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLK.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GLK) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%EMASS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ESTIF) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%FAST_FP)) deallocate(OutData%FAST_FP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FAST_FP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FAST_FP) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%FORCE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%U) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%U0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DU) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DDU) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%R) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RHSR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SLIN) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%STIFR) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%FAIR_ANG)) deallocate(OutData%FAIR_ANG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FAIR_ANG(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_ANG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FAIR_ANG) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FAIR_T)) deallocate(OutData%FAIR_T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FAIR_T(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FAIR_T) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ANCH_ANG)) deallocate(OutData%ANCH_ANG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ANCH_ANG(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_ANG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ANCH_ANG) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ANCH_T)) deallocate(OutData%ANCH_T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ANCH_T(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ANCH_T) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Line_Coordinate)) deallocate(OutData%Line_Coordinate) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Line_Coordinate(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line_Coordinate.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Line_Coordinate) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Line_Tangent)) deallocate(OutData%Line_Tangent) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Line_Tangent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line_Tangent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Line_Tangent) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_Lines)) deallocate(OutData%F_Lines) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_Lines(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Lines.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_Lines) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_ParameterType), intent(in) :: SrcParamData + type(FEAM_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%GRAV = SrcParamData%GRAV + DstParamData%Eps = SrcParamData%Eps + DstParamData%Gravity = SrcParamData%Gravity + DstParamData%WtrDens = SrcParamData%WtrDens + DstParamData%MaxIter = SrcParamData%MaxIter + DstParamData%NHBD = SrcParamData%NHBD + DstParamData%NDIM = SrcParamData%NDIM + if (allocated(SrcParamData%NEQ)) then + LB(1:1) = lbound(SrcParamData%NEQ) + UB(1:1) = ubound(SrcParamData%NEQ) + if (.not. allocated(DstParamData%NEQ)) then + allocate(DstParamData%NEQ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NEQ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%NEQ = SrcParamData%NEQ + end if + DstParamData%NBAND = SrcParamData%NBAND + DstParamData%NumLines = SrcParamData%NumLines + DstParamData%NumElems = SrcParamData%NumElems + DstParamData%NumNodes = SrcParamData%NumNodes + if (allocated(SrcParamData%GSL)) then + LB(1:3) = lbound(SrcParamData%GSL) + UB(1:3) = ubound(SrcParamData%GSL) + if (.not. allocated(DstParamData%GSL)) then + allocate(DstParamData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GSL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%GSL = SrcParamData%GSL + end if + if (allocated(SrcParamData%GP)) then + LB(1:2) = lbound(SrcParamData%GP) + UB(1:2) = ubound(SrcParamData%GP) + if (.not. allocated(DstParamData%GP)) then + allocate(DstParamData%GP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%GP = SrcParamData%GP + end if + if (allocated(SrcParamData%Elength)) then + LB(1:1) = lbound(SrcParamData%Elength) + UB(1:1) = ubound(SrcParamData%Elength) + if (.not. allocated(DstParamData%Elength)) then + allocate(DstParamData%Elength(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elength.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Elength = SrcParamData%Elength + end if + if (allocated(SrcParamData%BottmElev)) then + LB(1:1) = lbound(SrcParamData%BottmElev) + UB(1:1) = ubound(SrcParamData%BottmElev) + if (.not. allocated(DstParamData%BottmElev)) then + allocate(DstParamData%BottmElev(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BottmElev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BottmElev = SrcParamData%BottmElev + end if + if (allocated(SrcParamData%BottmStiff)) then + LB(1:1) = lbound(SrcParamData%BottmStiff) + UB(1:1) = ubound(SrcParamData%BottmStiff) + if (.not. allocated(DstParamData%BottmStiff)) then + allocate(DstParamData%BottmStiff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BottmStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BottmStiff = SrcParamData%BottmStiff + end if + if (allocated(SrcParamData%LMassDen)) then + LB(1:1) = lbound(SrcParamData%LMassDen) + UB(1:1) = ubound(SrcParamData%LMassDen) + if (.not. allocated(DstParamData%LMassDen)) then + allocate(DstParamData%LMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%LMassDen = SrcParamData%LMassDen + end if + if (allocated(SrcParamData%LDMassDen)) then + LB(1:1) = lbound(SrcParamData%LDMassDen) + UB(1:1) = ubound(SrcParamData%LDMassDen) + if (.not. allocated(DstParamData%LDMassDen)) then + allocate(DstParamData%LDMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LDMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%LDMassDen = SrcParamData%LDMassDen + end if + if (allocated(SrcParamData%LEAStiff)) then + LB(1:1) = lbound(SrcParamData%LEAStiff) + UB(1:1) = ubound(SrcParamData%LEAStiff) + if (.not. allocated(DstParamData%LEAStiff)) then + allocate(DstParamData%LEAStiff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LEAStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%LEAStiff = SrcParamData%LEAStiff + end if + if (allocated(SrcParamData%LineCI)) then + LB(1:1) = lbound(SrcParamData%LineCI) + UB(1:1) = ubound(SrcParamData%LineCI) + if (.not. allocated(DstParamData%LineCI)) then + allocate(DstParamData%LineCI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LineCI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%LineCI = SrcParamData%LineCI + end if + if (allocated(SrcParamData%LineCD)) then + LB(1:1) = lbound(SrcParamData%LineCD) + UB(1:1) = ubound(SrcParamData%LineCD) + if (.not. allocated(DstParamData%LineCD)) then + allocate(DstParamData%LineCD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LineCD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%LineCD = SrcParamData%LineCD + end if + if (allocated(SrcParamData%Bvp)) then + LB(1:2) = lbound(SrcParamData%Bvp) + UB(1:2) = ubound(SrcParamData%Bvp) + if (.not. allocated(DstParamData%Bvp)) then + allocate(DstParamData%Bvp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Bvp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Bvp = SrcParamData%Bvp + end if + if (allocated(SrcParamData%WaveAcc0)) then + LB(1:3) = lbound(SrcParamData%WaveAcc0) + UB(1:3) = ubound(SrcParamData%WaveAcc0) + if (.not. allocated(DstParamData%WaveAcc0)) then + allocate(DstParamData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), 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 + end if + if (allocated(SrcParamData%WaveTime)) then + LB(1:1) = lbound(SrcParamData%WaveTime) + UB(1:1) = ubound(SrcParamData%WaveTime) + if (.not. allocated(DstParamData%WaveTime)) then + allocate(DstParamData%WaveTime(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%WaveVel0)) then + LB(1:3) = lbound(SrcParamData%WaveVel0) + UB(1:3) = ubound(SrcParamData%WaveVel0) + if (.not. allocated(DstParamData%WaveVel0)) then + allocate(DstParamData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), 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 + end if + DstParamData%NStepWave = SrcParamData%NStepWave + DstParamData%SHAP = SrcParamData%SHAP + DstParamData%SHAPS = SrcParamData%SHAPS + DstParamData%GAUSSW = SrcParamData%GAUSSW + DstParamData%NGAUSS = SrcParamData%NGAUSS + DstParamData%SHAPT = SrcParamData%SHAPT + DstParamData%SHAPTS = SrcParamData%SHAPTS + DstParamData%NTRAP = SrcParamData%NTRAP + DstParamData%SBEND = SrcParamData%SBEND + DstParamData%STEN = SrcParamData%STEN + DstParamData%RMASS = SrcParamData%RMASS + DstParamData%RADDM = SrcParamData%RADDM + DstParamData%PMPN = SrcParamData%PMPN + DstParamData%AM = SrcParamData%AM + DstParamData%PM = SrcParamData%PM + DstParamData%IDOF = SrcParamData%IDOF + DstParamData%JDOF = SrcParamData%JDOF + DstParamData%PPA = SrcParamData%PPA + DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + DstParamData%Delim = SrcParamData%Delim + if (allocated(SrcParamData%GLUZR)) then + LB(1:3) = lbound(SrcParamData%GLUZR) + UB(1:3) = ubound(SrcParamData%GLUZR) + if (.not. allocated(DstParamData%GLUZR)) then + allocate(DstParamData%GLUZR(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GLUZR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%GLUZR = SrcParamData%GLUZR + end if + if (allocated(SrcParamData%GTZER)) then + LB(1:2) = lbound(SrcParamData%GTZER) + UB(1:2) = ubound(SrcParamData%GTZER) + if (.not. allocated(DstParamData%GTZER)) then + allocate(DstParamData%GTZER(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GTZER.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%GTZER = SrcParamData%GTZER + end if +end subroutine + +subroutine FEAM_DestroyParam(ParamData, ErrStat, ErrMsg) + type(FEAM_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%NEQ)) then + deallocate(ParamData%NEQ) + end if + if (allocated(ParamData%GSL)) then + deallocate(ParamData%GSL) + end if + if (allocated(ParamData%GP)) then + deallocate(ParamData%GP) + end if + if (allocated(ParamData%Elength)) then + deallocate(ParamData%Elength) + end if + if (allocated(ParamData%BottmElev)) then + deallocate(ParamData%BottmElev) + end if + if (allocated(ParamData%BottmStiff)) then + deallocate(ParamData%BottmStiff) + end if + if (allocated(ParamData%LMassDen)) then + deallocate(ParamData%LMassDen) + end if + if (allocated(ParamData%LDMassDen)) then + deallocate(ParamData%LDMassDen) + end if + if (allocated(ParamData%LEAStiff)) then + deallocate(ParamData%LEAStiff) + end if + if (allocated(ParamData%LineCI)) then + deallocate(ParamData%LineCI) + end if + if (allocated(ParamData%LineCD)) then + deallocate(ParamData%LineCD) + end if + if (allocated(ParamData%Bvp)) then + deallocate(ParamData%Bvp) + end if + if (allocated(ParamData%WaveAcc0)) then + deallocate(ParamData%WaveAcc0) + end if + if (allocated(ParamData%WaveTime)) then + deallocate(ParamData%WaveTime) + end if + if (allocated(ParamData%WaveVel0)) then + deallocate(ParamData%WaveVel0) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%GLUZR)) then + deallocate(ParamData%GLUZR) + end if + if (allocated(ParamData%GTZER)) then + deallocate(ParamData%GTZER) + end if +end subroutine + +subroutine FEAM_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackParam' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%GRAV) + call RegPack(Buf, InData%Eps) + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%WtrDens) + call RegPack(Buf, InData%MaxIter) + call RegPack(Buf, InData%NHBD) + call RegPack(Buf, InData%NDIM) + call RegPack(Buf, allocated(InData%NEQ)) + if (allocated(InData%NEQ)) then + call RegPackBounds(Buf, 1, lbound(InData%NEQ), ubound(InData%NEQ)) + call RegPack(Buf, InData%NEQ) + end if + call RegPack(Buf, InData%NBAND) + call RegPack(Buf, InData%NumLines) + call RegPack(Buf, InData%NumElems) + call RegPack(Buf, InData%NumNodes) + call RegPack(Buf, allocated(InData%GSL)) + if (allocated(InData%GSL)) then + call RegPackBounds(Buf, 3, lbound(InData%GSL), ubound(InData%GSL)) + call RegPack(Buf, InData%GSL) + end if + call RegPack(Buf, allocated(InData%GP)) + if (allocated(InData%GP)) then + call RegPackBounds(Buf, 2, lbound(InData%GP), ubound(InData%GP)) + call RegPack(Buf, InData%GP) + end if + call RegPack(Buf, allocated(InData%Elength)) + if (allocated(InData%Elength)) then + call RegPackBounds(Buf, 1, lbound(InData%Elength), ubound(InData%Elength)) + call RegPack(Buf, InData%Elength) + end if + call RegPack(Buf, allocated(InData%BottmElev)) + if (allocated(InData%BottmElev)) then + call RegPackBounds(Buf, 1, lbound(InData%BottmElev), ubound(InData%BottmElev)) + call RegPack(Buf, InData%BottmElev) + end if + call RegPack(Buf, allocated(InData%BottmStiff)) + if (allocated(InData%BottmStiff)) then + call RegPackBounds(Buf, 1, lbound(InData%BottmStiff), ubound(InData%BottmStiff)) + call RegPack(Buf, InData%BottmStiff) + end if + call RegPack(Buf, allocated(InData%LMassDen)) + if (allocated(InData%LMassDen)) then + call RegPackBounds(Buf, 1, lbound(InData%LMassDen), ubound(InData%LMassDen)) + call RegPack(Buf, InData%LMassDen) + end if + call RegPack(Buf, allocated(InData%LDMassDen)) + if (allocated(InData%LDMassDen)) then + call RegPackBounds(Buf, 1, lbound(InData%LDMassDen), ubound(InData%LDMassDen)) + call RegPack(Buf, InData%LDMassDen) + end if + call RegPack(Buf, allocated(InData%LEAStiff)) + if (allocated(InData%LEAStiff)) then + call RegPackBounds(Buf, 1, lbound(InData%LEAStiff), ubound(InData%LEAStiff)) + call RegPack(Buf, InData%LEAStiff) + end if + call RegPack(Buf, allocated(InData%LineCI)) + if (allocated(InData%LineCI)) then + call RegPackBounds(Buf, 1, lbound(InData%LineCI), ubound(InData%LineCI)) + call RegPack(Buf, InData%LineCI) + end if + call RegPack(Buf, allocated(InData%LineCD)) + if (allocated(InData%LineCD)) then + call RegPackBounds(Buf, 1, lbound(InData%LineCD), ubound(InData%LineCD)) + call RegPack(Buf, InData%LineCD) + end if + call RegPack(Buf, allocated(InData%Bvp)) + if (allocated(InData%Bvp)) then + call RegPackBounds(Buf, 2, lbound(InData%Bvp), ubound(InData%Bvp)) + call RegPack(Buf, InData%Bvp) + end if + call RegPack(Buf, allocated(InData%WaveAcc0)) + if (allocated(InData%WaveAcc0)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveAcc0), ubound(InData%WaveAcc0)) + call RegPack(Buf, InData%WaveAcc0) + end if + call RegPack(Buf, allocated(InData%WaveTime)) + if (allocated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPack(Buf, InData%WaveTime) + end if + call RegPack(Buf, allocated(InData%WaveVel0)) + if (allocated(InData%WaveVel0)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveVel0), ubound(InData%WaveVel0)) + call RegPack(Buf, InData%WaveVel0) + end if + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, InData%SHAP) + call RegPack(Buf, InData%SHAPS) + call RegPack(Buf, InData%GAUSSW) + call RegPack(Buf, InData%NGAUSS) + call RegPack(Buf, InData%SHAPT) + call RegPack(Buf, InData%SHAPTS) + call RegPack(Buf, InData%NTRAP) + call RegPack(Buf, InData%SBEND) + call RegPack(Buf, InData%STEN) + call RegPack(Buf, InData%RMASS) + call RegPack(Buf, InData%RADDM) + call RegPack(Buf, InData%PMPN) + call RegPack(Buf, InData%AM) + call RegPack(Buf, InData%PM) + call RegPack(Buf, InData%IDOF) + call RegPack(Buf, InData%JDOF) + call RegPack(Buf, InData%PPA) + call RegPack(Buf, InData%PtfmRefzt) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + call RegPack(Buf, InData%Delim) + call RegPack(Buf, allocated(InData%GLUZR)) + if (allocated(InData%GLUZR)) then + call RegPackBounds(Buf, 3, lbound(InData%GLUZR), ubound(InData%GLUZR)) + call RegPack(Buf, InData%GLUZR) + end if + call RegPack(Buf, allocated(InData%GTZER)) + if (allocated(InData%GTZER)) then + call RegPackBounds(Buf, 2, lbound(InData%GTZER), ubound(InData%GTZER)) + call RegPack(Buf, InData%GTZER) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackParam' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GRAV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Eps) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MaxIter) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NHBD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NDIM) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%NEQ)) deallocate(OutData%NEQ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NEQ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NEQ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NEQ) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NBAND) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumLines) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumElems) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumNodes) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%GSL)) deallocate(OutData%GSL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GSL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%GP)) deallocate(OutData%GP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Elength)) deallocate(OutData%Elength) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Elength(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elength.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Elength) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BottmElev)) deallocate(OutData%BottmElev) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BottmElev(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BottmElev) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BottmStiff)) deallocate(OutData%BottmStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BottmStiff(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BottmStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LMassDen)) deallocate(OutData%LMassDen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LMassDen(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LMassDen) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LDMassDen)) deallocate(OutData%LDMassDen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LDMassDen(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LDMassDen) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LEAStiff)) deallocate(OutData%LEAStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LEAStiff(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LEAStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LineCI)) deallocate(OutData%LineCI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineCI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LineCI) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LineCD)) deallocate(OutData%LineCD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineCD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LineCD) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Bvp)) deallocate(OutData%Bvp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Bvp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bvp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Bvp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveAcc0)) deallocate(OutData%WaveAcc0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveAcc0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveVel0)) deallocate(OutData%WaveVel0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveVel0) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SHAP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SHAPS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GAUSSW) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NGAUSS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SHAPT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SHAPTS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NTRAP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SBEND) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%STEN) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RMASS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RADDM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PMPN) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%JDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PPA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%GLUZR)) deallocate(OutData%GLUZR) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GLUZR(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLUZR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GLUZR) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%GTZER)) deallocate(OutData%GTZER) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GTZER(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GTZER.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GTZER) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FEAM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_InputType), intent(inout) :: SrcInputData + type(FEAM_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%HydroForceLineMesh, DstInputData%HydroForceLineMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%PtFairleadDisplacement, DstInputData%PtFairleadDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FEAM_DestroyInput(InputData, ErrStat, ErrMsg) + type(FEAM_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%HydroForceLineMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%PtFairleadDisplacement, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FEAM_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%HydroForceLineMesh) + call MeshPack(Buf, InData%PtFairleadDisplacement) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%HydroForceLineMesh) ! HydroForceLineMesh + call MeshUnpack(Buf, OutData%PtFairleadDisplacement) ! PtFairleadDisplacement +end subroutine + +subroutine FEAM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_OutputType), intent(inout) :: SrcOutputData + type(FEAM_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if + call MeshCopy(SrcOutputData%PtFairleadLoad, DstOutputData%PtFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%LineMeshPosition, DstOutputData%LineMeshPosition, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FEAM_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(FEAM_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + call MeshDestroy( OutputData%PtFairleadLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%LineMeshPosition, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FEAM_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + call MeshPack(Buf, InData%PtFairleadLoad) + call MeshPack(Buf, InData%LineMeshPosition) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + call MeshUnpack(Buf, OutData%PtFairleadLoad) ! PtFairleadLoad + call MeshUnpack(Buf, OutData%LineMeshPosition) ! LineMeshPosition +end subroutine + +subroutine FEAM_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(FEAM_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(FEAM_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 = 'FEAM_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 FEAM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL FEAM_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 FEAM_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 FEAM_Input_ExtrapInterp - - - SUBROUTINE FEAM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call FEAM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call FEAM_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call FEAM_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE FEAM_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. @@ -7061,43 +3327,44 @@ SUBROUTINE FEAM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(FEAM_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(FEAM_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(FEAM_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 + TYPE(FEAM_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(FEAM_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(FEAM_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 = 'FEAM_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(u1%HydroForceLineMesh, u2%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE FEAM_Input_ExtrapInterp1 - - - SUBROUTINE FEAM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%HydroForceLineMesh, u2%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE FEAM_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. @@ -7111,103 +3378,104 @@ SUBROUTINE FEAM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(FEAM_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(FEAM_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(FEAM_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(FEAM_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 + TYPE(FEAM_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(FEAM_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(FEAM_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(FEAM_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 = 'FEAM_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(u1%HydroForceLineMesh, u2%HydroForceLineMesh, u3%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, u3%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE FEAM_Input_ExtrapInterp2 - - - SUBROUTINE FEAM_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(FEAM_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(FEAM_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%HydroForceLineMesh, u2%HydroForceLineMesh, u3%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, u3%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine FEAM_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(FEAM_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(FEAM_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 = 'FEAM_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 FEAM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL FEAM_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 FEAM_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 FEAM_Output_ExtrapInterp - - - SUBROUTINE FEAM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call FEAM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call FEAM_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call FEAM_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE FEAM_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. @@ -7219,51 +3487,49 @@ SUBROUTINE FEAM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(FEAM_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(FEAM_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(FEAM_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 + TYPE(FEAM_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(FEAM_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(FEAM_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 = 'FEAM_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 - CALL MeshExtrapInterp1(y1%PtFairleadLoad, y2%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%LineMeshPosition, y2%LineMeshPosition, tin, y_out%LineMeshPosition, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE FEAM_Output_ExtrapInterp1 - - - SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%PtFairleadLoad, y2%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%LineMeshPosition, y2%LineMeshPosition, tin, y_out%LineMeshPosition, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE FEAM_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. @@ -7277,58 +3543,54 @@ SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(FEAM_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(FEAM_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(FEAM_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(FEAM_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 + TYPE(FEAM_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(FEAM_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(FEAM_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(FEAM_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 = 'FEAM_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_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 + 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 + 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 + 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 - CALL MeshExtrapInterp2(y1%PtFairleadLoad, y2%PtFairleadLoad, y3%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%LineMeshPosition, y2%LineMeshPosition, y3%LineMeshPosition, tin, y_out%LineMeshPosition, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE FEAM_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%PtFairleadLoad, y2%PtFairleadLoad, y3%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%LineMeshPosition, y2%LineMeshPosition, y3%LineMeshPosition, tin, y_out%LineMeshPosition, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE FEAMooring_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 5dedba9458..fe84e573c5 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -35,57 +35,57 @@ MODULE Conv_Radiation_Types IMPLICIT NONE ! ========= Conv_Rdtn_InitInputType ======= TYPE, PUBLIC :: Conv_Rdtn_InitInputType - REAL(DbKi) :: RdtnDT !< [-] + REAL(DbKi) :: RdtnDT = 0.0_R8Ki !< [-] CHARACTER(80) :: RdtnDTChr - INTEGER(IntKi) :: 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] [-] - REAL(ReKi) :: HighFreq !< [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=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] [-] + REAL(ReKi) :: HighFreq = 0.0_ReKi !< [-] CHARACTER(1024) :: WAMITFile !< [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: HdroAddMs !< [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: HdroFreq !< [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: HdroDmpng !< [-] - INTEGER(IntKi) :: NInpFreq !< [-] - REAL(DbKi) :: RdtnTMax !< [-] + INTEGER(IntKi) :: NInpFreq = 0_IntKi !< [-] + REAL(DbKi) :: RdtnTMax = 0.0_R8Ki !< [-] END TYPE Conv_Rdtn_InitInputType ! ======================= ! ========= Conv_Rdtn_InitOutputType ======= TYPE, PUBLIC :: Conv_Rdtn_InitOutputType - INTEGER(IntKi) :: DummyInitOut !< [-] + INTEGER(IntKi) :: DummyInitOut = 0_IntKi !< [-] END TYPE Conv_Rdtn_InitOutputType ! ======================= ! ========= Conv_Rdtn_ContinuousStateType ======= TYPE, PUBLIC :: Conv_Rdtn_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(SiKi) :: DummyContState = 0.0_R4Ki !< Remove this variable if you have continuous states [-] END TYPE Conv_Rdtn_ContinuousStateType ! ======================= ! ========= Conv_Rdtn_DiscreteStateType ======= TYPE, PUBLIC :: Conv_Rdtn_DiscreteStateType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: XDHistory !< [-] - REAL(DbKi) :: LastTime !< [-] + REAL(DbKi) :: LastTime = 0.0_R8Ki !< [-] END TYPE Conv_Rdtn_DiscreteStateType ! ======================= ! ========= Conv_Rdtn_ConstraintStateType ======= TYPE, PUBLIC :: Conv_Rdtn_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< Remove this variable if you have constraint states [-] END TYPE Conv_Rdtn_ConstraintStateType ! ======================= ! ========= Conv_Rdtn_OtherStateType ======= TYPE, PUBLIC :: Conv_Rdtn_OtherStateType - INTEGER(IntKi) :: IndRdtn !< [-] + INTEGER(IntKi) :: IndRdtn = 0_IntKi !< [-] END TYPE Conv_Rdtn_OtherStateType ! ======================= ! ========= Conv_Rdtn_MiscVarType ======= TYPE, PUBLIC :: Conv_Rdtn_MiscVarType - INTEGER(IntKi) :: LastIndRdtn !< [-] + INTEGER(IntKi) :: LastIndRdtn = 0_IntKi !< [-] END TYPE Conv_Rdtn_MiscVarType ! ======================= ! ========= Conv_Rdtn_ParameterType ======= TYPE, PUBLIC :: Conv_Rdtn_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - REAL(DbKi) :: RdtnDT !< [-] - INTEGER(IntKi) :: 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] [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: RdtnDT = 0.0_R8Ki !< [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=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] [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: RdtnKrnl !< [-] - INTEGER(IntKi) :: NStepRdtn !< [-] - INTEGER(IntKi) :: NStepRdtn1 !< [-] + INTEGER(IntKi) :: NStepRdtn = 0_IntKi !< [-] + INTEGER(IntKi) :: NStepRdtn1 = 0_IntKi !< [-] END TYPE Conv_Rdtn_ParameterType ! ======================= ! ========= Conv_Rdtn_InputType ======= @@ -99,1880 +99,745 @@ MODULE Conv_Radiation_Types END TYPE Conv_Rdtn_OutputType ! ======================= CONTAINS - SUBROUTINE Conv_Rdtn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Conv_Rdtn_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%RdtnDT = SrcInitInputData%RdtnDT - DstInitInputData%RdtnDTChr = SrcInitInputData%RdtnDTChr - DstInitInputData%NBody = SrcInitInputData%NBody - DstInitInputData%HighFreq = SrcInitInputData%HighFreq - DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile -IF (ALLOCATED(SrcInitInputData%HdroAddMs)) THEN - i1_l = LBOUND(SrcInitInputData%HdroAddMs,1) - i1_u = UBOUND(SrcInitInputData%HdroAddMs,1) - i2_l = LBOUND(SrcInitInputData%HdroAddMs,2) - i2_u = UBOUND(SrcInitInputData%HdroAddMs,2) - i3_l = LBOUND(SrcInitInputData%HdroAddMs,3) - i3_u = UBOUND(SrcInitInputData%HdroAddMs,3) - IF (.NOT. ALLOCATED(DstInitInputData%HdroAddMs)) THEN - ALLOCATE(DstInitInputData%HdroAddMs(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%HdroAddMs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%HdroAddMs = SrcInitInputData%HdroAddMs -ENDIF -IF (ALLOCATED(SrcInitInputData%HdroFreq)) THEN - i1_l = LBOUND(SrcInitInputData%HdroFreq,1) - i1_u = UBOUND(SrcInitInputData%HdroFreq,1) - IF (.NOT. ALLOCATED(DstInitInputData%HdroFreq)) THEN - ALLOCATE(DstInitInputData%HdroFreq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%HdroFreq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%HdroFreq = SrcInitInputData%HdroFreq -ENDIF -IF (ALLOCATED(SrcInitInputData%HdroDmpng)) THEN - i1_l = LBOUND(SrcInitInputData%HdroDmpng,1) - i1_u = UBOUND(SrcInitInputData%HdroDmpng,1) - i2_l = LBOUND(SrcInitInputData%HdroDmpng,2) - i2_u = UBOUND(SrcInitInputData%HdroDmpng,2) - i3_l = LBOUND(SrcInitInputData%HdroDmpng,3) - i3_u = UBOUND(SrcInitInputData%HdroDmpng,3) - IF (.NOT. ALLOCATED(DstInitInputData%HdroDmpng)) THEN - ALLOCATE(DstInitInputData%HdroDmpng(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%HdroDmpng.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%HdroDmpng = SrcInitInputData%HdroDmpng -ENDIF - DstInitInputData%NInpFreq = SrcInitInputData%NInpFreq - DstInitInputData%RdtnTMax = SrcInitInputData%RdtnTMax - END SUBROUTINE Conv_Rdtn_CopyInitInput - - SUBROUTINE Conv_Rdtn_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%HdroAddMs)) THEN - DEALLOCATE(InitInputData%HdroAddMs) -ENDIF -IF (ALLOCATED(InitInputData%HdroFreq)) THEN - DEALLOCATE(InitInputData%HdroFreq) -ENDIF -IF (ALLOCATED(InitInputData%HdroDmpng)) THEN - DEALLOCATE(InitInputData%HdroDmpng) -ENDIF - END SUBROUTINE Conv_Rdtn_DestroyInitInput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 - Db_BufSz = Db_BufSz + 1 ! RdtnDT - Int_BufSz = Int_BufSz + 1*LEN(InData%RdtnDTChr) ! RdtnDTChr - Int_BufSz = Int_BufSz + 1 ! NBody - Re_BufSz = Re_BufSz + 1 ! HighFreq - Int_BufSz = Int_BufSz + 1*LEN(InData%WAMITFile) ! WAMITFile - Int_BufSz = Int_BufSz + 1 ! HdroAddMs allocated yes/no - IF ( ALLOCATED(InData%HdroAddMs) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! HdroAddMs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HdroAddMs) ! HdroAddMs - END IF - Int_BufSz = Int_BufSz + 1 ! HdroFreq allocated yes/no - IF ( ALLOCATED(InData%HdroFreq) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HdroFreq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HdroFreq) ! HdroFreq - END IF - Int_BufSz = Int_BufSz + 1 ! HdroDmpng allocated yes/no - IF ( ALLOCATED(InData%HdroDmpng) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! HdroDmpng upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HdroDmpng) ! HdroDmpng - END IF - Int_BufSz = Int_BufSz + 1 ! NInpFreq - Db_BufSz = Db_BufSz + 1 ! RdtnTMax - 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%RdtnDT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RdtnDTChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%RdtnDTChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HighFreq - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%HdroAddMs) ) 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%HdroAddMs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAddMs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroAddMs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAddMs,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroAddMs,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAddMs,3) - Int_Xferred = Int_Xferred + 2 - DO i3 = LBOUND(InData%HdroAddMs,3), UBOUND(InData%HdroAddMs,3) - DO i2 = LBOUND(InData%HdroAddMs,2), UBOUND(InData%HdroAddMs,2) - DO i1 = LBOUND(InData%HdroAddMs,1), UBOUND(InData%HdroAddMs,1) - ReKiBuf(Re_Xferred) = InData%HdroAddMs(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HdroFreq) ) 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%HdroFreq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroFreq,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HdroFreq,1), UBOUND(InData%HdroFreq,1) - ReKiBuf(Re_Xferred) = InData%HdroFreq(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HdroDmpng) ) 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%HdroDmpng,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroDmpng,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroDmpng,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroDmpng,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroDmpng,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroDmpng,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%HdroDmpng,3), UBOUND(InData%HdroDmpng,3) - DO i2 = LBOUND(InData%HdroDmpng,2), UBOUND(InData%HdroDmpng,2) - DO i1 = LBOUND(InData%HdroDmpng,1), UBOUND(InData%HdroDmpng,1) - ReKiBuf(Re_Xferred) = InData%HdroDmpng(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NInpFreq - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%RdtnTMax - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackInitInput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_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%RdtnDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%RdtnDTChr) - OutData%RdtnDTChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HighFreq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroAddMs 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%HdroAddMs)) DEALLOCATE(OutData%HdroAddMs) - ALLOCATE(OutData%HdroAddMs(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%HdroAddMs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%HdroAddMs,3), UBOUND(OutData%HdroAddMs,3) - DO i2 = LBOUND(OutData%HdroAddMs,2), UBOUND(OutData%HdroAddMs,2) - DO i1 = LBOUND(OutData%HdroAddMs,1), UBOUND(OutData%HdroAddMs,1) - OutData%HdroAddMs(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 ! HdroFreq 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%HdroFreq)) DEALLOCATE(OutData%HdroFreq) - ALLOCATE(OutData%HdroFreq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroFreq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HdroFreq,1), UBOUND(OutData%HdroFreq,1) - OutData%HdroFreq(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroDmpng 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%HdroDmpng)) DEALLOCATE(OutData%HdroDmpng) - ALLOCATE(OutData%HdroDmpng(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%HdroDmpng.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%HdroDmpng,3), UBOUND(OutData%HdroDmpng,3) - DO i2 = LBOUND(OutData%HdroDmpng,2), UBOUND(OutData%HdroDmpng,2) - DO i1 = LBOUND(OutData%HdroDmpng,1), UBOUND(OutData%HdroDmpng,1) - OutData%HdroDmpng(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%NInpFreq = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RdtnTMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackInitInput - - SUBROUTINE Conv_Rdtn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Conv_Rdtn_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_CopyInitOutput' -! +subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_InitInputType), intent(in) :: SrcInitInputData + type(Conv_Rdtn_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut - END SUBROUTINE Conv_Rdtn_CopyInitOutput - - SUBROUTINE Conv_Rdtn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Conv_Rdtn_DestroyInitOutput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! DummyInitOut - 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%DummyInitOut - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackInitOutput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_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 - OutData%DummyInitOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackInitOutput - - SUBROUTINE Conv_Rdtn_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_CopyContState' -! + ErrMsg = '' + DstInitInputData%RdtnDT = SrcInitInputData%RdtnDT + DstInitInputData%RdtnDTChr = SrcInitInputData%RdtnDTChr + DstInitInputData%NBody = SrcInitInputData%NBody + DstInitInputData%HighFreq = SrcInitInputData%HighFreq + DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile + if (allocated(SrcInitInputData%HdroAddMs)) then + LB(1:3) = lbound(SrcInitInputData%HdroAddMs) + UB(1:3) = ubound(SrcInitInputData%HdroAddMs) + if (.not. allocated(DstInitInputData%HdroAddMs)) then + allocate(DstInitInputData%HdroAddMs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%HdroAddMs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%HdroAddMs = SrcInitInputData%HdroAddMs + end if + if (allocated(SrcInitInputData%HdroFreq)) then + LB(1:1) = lbound(SrcInitInputData%HdroFreq) + UB(1:1) = ubound(SrcInitInputData%HdroFreq) + if (.not. allocated(DstInitInputData%HdroFreq)) then + allocate(DstInitInputData%HdroFreq(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%HdroFreq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%HdroFreq = SrcInitInputData%HdroFreq + end if + if (allocated(SrcInitInputData%HdroDmpng)) then + LB(1:3) = lbound(SrcInitInputData%HdroDmpng) + UB(1:3) = ubound(SrcInitInputData%HdroDmpng) + if (.not. allocated(DstInitInputData%HdroDmpng)) then + allocate(DstInitInputData%HdroDmpng(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%HdroDmpng.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%HdroDmpng = SrcInitInputData%HdroDmpng + end if + DstInitInputData%NInpFreq = SrcInitInputData%NInpFreq + DstInitInputData%RdtnTMax = SrcInitInputData%RdtnTMax +end subroutine + +subroutine Conv_Rdtn_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Conv_Rdtn_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE Conv_Rdtn_CopyContState - - SUBROUTINE Conv_Rdtn_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Conv_Rdtn_DestroyContState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 Conv_Rdtn_PackContState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 Conv_Rdtn_UnPackContState - - SUBROUTINE Conv_Rdtn_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Conv_Rdtn_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) :: 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 = 'Conv_Rdtn_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitInputData%HdroAddMs)) then + deallocate(InitInputData%HdroAddMs) + end if + if (allocated(InitInputData%HdroFreq)) then + deallocate(InitInputData%HdroFreq) + end if + if (allocated(InitInputData%HdroDmpng)) then + deallocate(InitInputData%HdroDmpng) + end if +end subroutine + +subroutine Conv_Rdtn_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%RdtnDT) + call RegPack(Buf, InData%RdtnDTChr) + call RegPack(Buf, InData%NBody) + call RegPack(Buf, InData%HighFreq) + call RegPack(Buf, InData%WAMITFile) + call RegPack(Buf, allocated(InData%HdroAddMs)) + if (allocated(InData%HdroAddMs)) then + call RegPackBounds(Buf, 3, lbound(InData%HdroAddMs), ubound(InData%HdroAddMs)) + call RegPack(Buf, InData%HdroAddMs) + end if + call RegPack(Buf, allocated(InData%HdroFreq)) + if (allocated(InData%HdroFreq)) then + call RegPackBounds(Buf, 1, lbound(InData%HdroFreq), ubound(InData%HdroFreq)) + call RegPack(Buf, InData%HdroFreq) + end if + call RegPack(Buf, allocated(InData%HdroDmpng)) + if (allocated(InData%HdroDmpng)) then + call RegPackBounds(Buf, 3, lbound(InData%HdroDmpng), ubound(InData%HdroDmpng)) + call RegPack(Buf, InData%HdroDmpng) + end if + call RegPack(Buf, InData%NInpFreq) + call RegPack(Buf, InData%RdtnTMax) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%RdtnDT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RdtnDTChr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HighFreq) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WAMITFile) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%HdroAddMs)) deallocate(OutData%HdroAddMs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HdroAddMs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroAddMs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HdroAddMs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%HdroFreq)) deallocate(OutData%HdroFreq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HdroFreq(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroFreq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HdroFreq) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%HdroDmpng)) deallocate(OutData%HdroDmpng) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HdroDmpng(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroDmpng.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HdroDmpng) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NInpFreq) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RdtnTMax) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_InitOutputType), intent(in) :: SrcInitOutputData + type(Conv_Rdtn_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%XDHistory)) THEN - i1_l = LBOUND(SrcDiscStateData%XDHistory,1) - i1_u = UBOUND(SrcDiscStateData%XDHistory,1) - i2_l = LBOUND(SrcDiscStateData%XDHistory,2) - i2_u = UBOUND(SrcDiscStateData%XDHistory,2) - IF (.NOT. ALLOCATED(DstDiscStateData%XDHistory)) THEN - ALLOCATE(DstDiscStateData%XDHistory(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%XDHistory.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%XDHistory = SrcDiscStateData%XDHistory -ENDIF - DstDiscStateData%LastTime = SrcDiscStateData%LastTime - END SUBROUTINE Conv_Rdtn_CopyDiscState - - SUBROUTINE Conv_Rdtn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%XDHistory)) THEN - DEALLOCATE(DiscStateData%XDHistory) -ENDIF - END SUBROUTINE Conv_Rdtn_DestroyDiscState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 - Int_BufSz = Int_BufSz + 1 ! XDHistory allocated yes/no - IF ( ALLOCATED(InData%XDHistory) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! XDHistory upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%XDHistory) ! XDHistory - END IF - Db_BufSz = Db_BufSz + 1 ! LastTime - 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%XDHistory) ) 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%XDHistory,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XDHistory,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%XDHistory,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XDHistory,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%XDHistory,2), UBOUND(InData%XDHistory,2) - DO i1 = LBOUND(InData%XDHistory,1), UBOUND(InData%XDHistory,1) - ReKiBuf(Re_Xferred) = InData%XDHistory(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%LastTime - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackDiscState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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) :: 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 = 'Conv_Rdtn_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! XDHistory 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%XDHistory)) DEALLOCATE(OutData%XDHistory) - ALLOCATE(OutData%XDHistory(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%XDHistory.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%XDHistory,2), UBOUND(OutData%XDHistory,2) - DO i1 = LBOUND(OutData%XDHistory,1), UBOUND(OutData%XDHistory,1) - OutData%XDHistory(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%LastTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackDiscState - - SUBROUTINE Conv_Rdtn_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_CopyConstrState' -! + ErrMsg = '' + DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut +end subroutine + +subroutine Conv_Rdtn_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Conv_Rdtn_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Conv_Rdtn_CopyConstrState - - SUBROUTINE Conv_Rdtn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Conv_Rdtn_DestroyConstrState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 Conv_Rdtn_PackConstrState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 Conv_Rdtn_UnPackConstrState - - SUBROUTINE Conv_Rdtn_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_CopyOtherState' -! + ErrMsg = '' +end subroutine + +subroutine Conv_Rdtn_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyInitOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyInitOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_ContinuousStateType), intent(in) :: SrcContStateData + type(Conv_Rdtn_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%IndRdtn = SrcOtherStateData%IndRdtn - END SUBROUTINE Conv_Rdtn_CopyOtherState - - SUBROUTINE Conv_Rdtn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Conv_Rdtn_DestroyOtherState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! IndRdtn - 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%IndRdtn - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackOtherState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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%IndRdtn = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackOtherState - - SUBROUTINE Conv_Rdtn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_CopyMisc' -! + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine + +subroutine Conv_Rdtn_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(Conv_Rdtn_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%LastIndRdtn = SrcMiscData%LastIndRdtn - END SUBROUTINE Conv_Rdtn_CopyMisc - - SUBROUTINE Conv_Rdtn_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Conv_Rdtn_DestroyMisc - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! LastIndRdtn - 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%LastIndRdtn - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackMisc - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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%LastIndRdtn = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackMisc - - SUBROUTINE Conv_Rdtn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Conv_Rdtn_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_CopyParam' -! + ErrMsg = '' +end subroutine + +subroutine Conv_Rdtn_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_DiscreteStateType), intent(in) :: SrcDiscStateData + type(Conv_Rdtn_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%RdtnDT = SrcParamData%RdtnDT - DstParamData%NBody = SrcParamData%NBody -IF (ALLOCATED(SrcParamData%RdtnKrnl)) THEN - i1_l = LBOUND(SrcParamData%RdtnKrnl,1) - i1_u = UBOUND(SrcParamData%RdtnKrnl,1) - i2_l = LBOUND(SrcParamData%RdtnKrnl,2) - i2_u = UBOUND(SrcParamData%RdtnKrnl,2) - i3_l = LBOUND(SrcParamData%RdtnKrnl,3) - i3_u = UBOUND(SrcParamData%RdtnKrnl,3) - IF (.NOT. ALLOCATED(DstParamData%RdtnKrnl)) THEN - ALLOCATE(DstParamData%RdtnKrnl(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%RdtnKrnl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%RdtnKrnl = SrcParamData%RdtnKrnl -ENDIF - DstParamData%NStepRdtn = SrcParamData%NStepRdtn - DstParamData%NStepRdtn1 = SrcParamData%NStepRdtn1 - END SUBROUTINE Conv_Rdtn_CopyParam - - SUBROUTINE Conv_Rdtn_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%RdtnKrnl)) THEN - DEALLOCATE(ParamData%RdtnKrnl) -ENDIF - END SUBROUTINE Conv_Rdtn_DestroyParam - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! RdtnDT - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! RdtnKrnl allocated yes/no - IF ( ALLOCATED(InData%RdtnKrnl) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! RdtnKrnl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RdtnKrnl) ! RdtnKrnl - END IF - Int_BufSz = Int_BufSz + 1 ! NStepRdtn - Int_BufSz = Int_BufSz + 1 ! NStepRdtn1 - 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%RdtnDT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%RdtnKrnl) ) 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%RdtnKrnl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RdtnKrnl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RdtnKrnl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RdtnKrnl,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RdtnKrnl,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RdtnKrnl,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%RdtnKrnl,3), UBOUND(InData%RdtnKrnl,3) - DO i2 = LBOUND(InData%RdtnKrnl,2), UBOUND(InData%RdtnKrnl,2) - DO i1 = LBOUND(InData%RdtnKrnl,1), UBOUND(InData%RdtnKrnl,1) - ReKiBuf(Re_Xferred) = InData%RdtnKrnl(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NStepRdtn - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepRdtn1 - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackParam - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_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%RdtnDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RdtnKrnl 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%RdtnKrnl)) DEALLOCATE(OutData%RdtnKrnl) - ALLOCATE(OutData%RdtnKrnl(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%RdtnKrnl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%RdtnKrnl,3), UBOUND(OutData%RdtnKrnl,3) - DO i2 = LBOUND(OutData%RdtnKrnl,2), UBOUND(OutData%RdtnKrnl,2) - DO i1 = LBOUND(OutData%RdtnKrnl,1), UBOUND(OutData%RdtnKrnl,1) - OutData%RdtnKrnl(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%NStepRdtn = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepRdtn1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackParam - - SUBROUTINE Conv_Rdtn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: SrcInputData - TYPE(Conv_Rdtn_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_CopyInput' -! + ErrMsg = '' + if (allocated(SrcDiscStateData%XDHistory)) then + LB(1:2) = lbound(SrcDiscStateData%XDHistory) + UB(1:2) = ubound(SrcDiscStateData%XDHistory) + if (.not. allocated(DstDiscStateData%XDHistory)) then + allocate(DstDiscStateData%XDHistory(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%XDHistory.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%XDHistory = SrcDiscStateData%XDHistory + end if + DstDiscStateData%LastTime = SrcDiscStateData%LastTime +end subroutine + +subroutine Conv_Rdtn_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(Conv_Rdtn_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%Velocity)) THEN - i1_l = LBOUND(SrcInputData%Velocity,1) - i1_u = UBOUND(SrcInputData%Velocity,1) - IF (.NOT. ALLOCATED(DstInputData%Velocity)) THEN - ALLOCATE(DstInputData%Velocity(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Velocity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Velocity = SrcInputData%Velocity -ENDIF - END SUBROUTINE Conv_Rdtn_CopyInput - - SUBROUTINE Conv_Rdtn_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%Velocity)) THEN - DEALLOCATE(InputData%Velocity) -ENDIF - END SUBROUTINE Conv_Rdtn_DestroyInput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 - Int_BufSz = Int_BufSz + 1 ! Velocity allocated yes/no - IF ( ALLOCATED(InData%Velocity) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Velocity upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Velocity) ! Velocity - 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%Velocity) ) 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%Velocity,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Velocity,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Velocity,1), UBOUND(InData%Velocity,1) - ReKiBuf(Re_Xferred) = InData%Velocity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Conv_Rdtn_PackInput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Velocity 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%Velocity)) DEALLOCATE(OutData%Velocity) - ALLOCATE(OutData%Velocity(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Velocity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Velocity,1), UBOUND(OutData%Velocity,1) - OutData%Velocity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Conv_Rdtn_UnPackInput - - SUBROUTINE Conv_Rdtn_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: SrcOutputData - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_CopyOutput' -! + ErrMsg = '' + if (allocated(DiscStateData%XDHistory)) then + deallocate(DiscStateData%XDHistory) + end if +end subroutine + +subroutine Conv_Rdtn_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%XDHistory)) + if (allocated(InData%XDHistory)) then + call RegPackBounds(Buf, 2, lbound(InData%XDHistory), ubound(InData%XDHistory)) + call RegPack(Buf, InData%XDHistory) + end if + call RegPack(Buf, InData%LastTime) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackDiscState' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%XDHistory)) deallocate(OutData%XDHistory) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%XDHistory(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%XDHistory.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%XDHistory) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%LastTime) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_ConstraintStateType), intent(in) :: SrcConstrStateData + type(Conv_Rdtn_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%F_Rdtn)) THEN - i1_l = LBOUND(SrcOutputData%F_Rdtn,1) - i1_u = UBOUND(SrcOutputData%F_Rdtn,1) - IF (.NOT. ALLOCATED(DstOutputData%F_Rdtn)) THEN - ALLOCATE(DstOutputData%F_Rdtn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%F_Rdtn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%F_Rdtn = SrcOutputData%F_Rdtn -ENDIF - END SUBROUTINE Conv_Rdtn_CopyOutput - - SUBROUTINE Conv_Rdtn_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%F_Rdtn)) THEN - DEALLOCATE(OutputData%F_Rdtn) -ENDIF - END SUBROUTINE Conv_Rdtn_DestroyOutput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! F_Rdtn allocated yes/no - IF ( ALLOCATED(InData%F_Rdtn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_Rdtn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Rdtn) ! F_Rdtn - 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%F_Rdtn) ) 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%F_Rdtn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Rdtn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_Rdtn,1), UBOUND(InData%F_Rdtn,1) - ReKiBuf(Re_Xferred) = InData%F_Rdtn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Conv_Rdtn_PackOutput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! F_Rdtn 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%F_Rdtn)) DEALLOCATE(OutData%F_Rdtn) - ALLOCATE(OutData%F_Rdtn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Rdtn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_Rdtn,1), UBOUND(OutData%F_Rdtn,1) - OutData%F_Rdtn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Conv_Rdtn_UnPackOutput - - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Conv_Rdtn_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 + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine Conv_Rdtn_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(Conv_Rdtn_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Conv_Rdtn_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_OtherStateType), intent(in) :: SrcOtherStateData + type(Conv_Rdtn_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%IndRdtn = SrcOtherStateData%IndRdtn +end subroutine + +subroutine Conv_Rdtn_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(Conv_Rdtn_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Conv_Rdtn_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%IndRdtn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%IndRdtn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_MiscVarType), intent(in) :: SrcMiscData + type(Conv_Rdtn_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%LastIndRdtn = SrcMiscData%LastIndRdtn +end subroutine + +subroutine Conv_Rdtn_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Conv_Rdtn_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Conv_Rdtn_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%LastIndRdtn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%LastIndRdtn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_ParameterType), intent(in) :: SrcParamData + type(Conv_Rdtn_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%RdtnDT = SrcParamData%RdtnDT + DstParamData%NBody = SrcParamData%NBody + if (allocated(SrcParamData%RdtnKrnl)) then + LB(1:3) = lbound(SrcParamData%RdtnKrnl) + UB(1:3) = ubound(SrcParamData%RdtnKrnl) + if (.not. allocated(DstParamData%RdtnKrnl)) then + allocate(DstParamData%RdtnKrnl(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RdtnKrnl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%RdtnKrnl = SrcParamData%RdtnKrnl + end if + DstParamData%NStepRdtn = SrcParamData%NStepRdtn + DstParamData%NStepRdtn1 = SrcParamData%NStepRdtn1 +end subroutine + +subroutine Conv_Rdtn_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Conv_Rdtn_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%RdtnKrnl)) then + deallocate(ParamData%RdtnKrnl) + end if +end subroutine + +subroutine Conv_Rdtn_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%RdtnDT) + call RegPack(Buf, InData%NBody) + call RegPack(Buf, allocated(InData%RdtnKrnl)) + if (allocated(InData%RdtnKrnl)) then + call RegPackBounds(Buf, 3, lbound(InData%RdtnKrnl), ubound(InData%RdtnKrnl)) + call RegPack(Buf, InData%RdtnKrnl) + end if + call RegPack(Buf, InData%NStepRdtn) + call RegPack(Buf, InData%NStepRdtn1) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackParam' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RdtnDT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%RdtnKrnl)) deallocate(OutData%RdtnKrnl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RdtnKrnl(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RdtnKrnl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RdtnKrnl) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NStepRdtn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepRdtn1) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_InputType), intent(in) :: SrcInputData + type(Conv_Rdtn_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%Velocity)) then + LB(1:1) = lbound(SrcInputData%Velocity) + UB(1:1) = ubound(SrcInputData%Velocity) + if (.not. allocated(DstInputData%Velocity)) then + allocate(DstInputData%Velocity(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Velocity.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Velocity = SrcInputData%Velocity + end if +end subroutine + +subroutine Conv_Rdtn_DestroyInput(InputData, ErrStat, ErrMsg) + type(Conv_Rdtn_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%Velocity)) then + deallocate(InputData%Velocity) + end if +end subroutine + +subroutine Conv_Rdtn_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Velocity)) + if (allocated(InData%Velocity)) then + call RegPackBounds(Buf, 1, lbound(InData%Velocity), ubound(InData%Velocity)) + call RegPack(Buf, InData%Velocity) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Velocity)) deallocate(OutData%Velocity) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Velocity(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Velocity.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Velocity) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine Conv_Rdtn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_OutputType), intent(in) :: SrcOutputData + type(Conv_Rdtn_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%F_Rdtn)) then + LB(1:1) = lbound(SrcOutputData%F_Rdtn) + UB(1:1) = ubound(SrcOutputData%F_Rdtn) + if (.not. allocated(DstOutputData%F_Rdtn)) then + allocate(DstOutputData%F_Rdtn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%F_Rdtn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%F_Rdtn = SrcOutputData%F_Rdtn + end if +end subroutine + +subroutine Conv_Rdtn_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(Conv_Rdtn_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%F_Rdtn)) then + deallocate(OutputData%F_Rdtn) + end if +end subroutine + +subroutine Conv_Rdtn_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%F_Rdtn)) + if (allocated(InData%F_Rdtn)) then + call RegPackBounds(Buf, 1, lbound(InData%F_Rdtn), ubound(InData%F_Rdtn)) + call RegPack(Buf, InData%F_Rdtn) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%F_Rdtn)) deallocate(OutData%F_Rdtn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_Rdtn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Rdtn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine Conv_Rdtn_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(Conv_Rdtn_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(Conv_Rdtn_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 = 'Conv_Rdtn_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 Conv_Rdtn_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Conv_Rdtn_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 Conv_Rdtn_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 Conv_Rdtn_Input_ExtrapInterp - - - SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call Conv_Rdtn_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Conv_Rdtn_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Conv_Rdtn_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE Conv_Rdtn_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. @@ -1984,47 +849,45 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Conv_Rdtn_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 + TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_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 - 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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(u_out%Velocity) .AND. ALLOCATED(u1%Velocity)) THEN - DO i1 = LBOUND(u_out%Velocity,1),UBOUND(u_out%Velocity,1) - b = -(u1%Velocity(i1) - u2%Velocity(i1)) - u_out%Velocity(i1) = u1%Velocity(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1 - - - SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%Velocity) .AND. ALLOCATED(u1%Velocity)) THEN + u_out%Velocity = a1*u1%Velocity + a2*u2%Velocity + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE Conv_Rdtn_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. @@ -2038,108 +901,105 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSta ! !.................................................................................................................................. - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Conv_Rdtn_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 + TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_Input_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_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 + 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 + 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 + 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(u_out%Velocity) .AND. ALLOCATED(u1%Velocity)) THEN - DO i1 = LBOUND(u_out%Velocity,1),UBOUND(u_out%Velocity,1) - b = (t(3)**2*(u1%Velocity(i1) - u2%Velocity(i1)) + t(2)**2*(-u1%Velocity(i1) + u3%Velocity(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Velocity(i1) + t(3)*u2%Velocity(i1) - t(2)*u3%Velocity(i1) ) * scaleFactor - u_out%Velocity(i1) = u1%Velocity(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2 - - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Conv_Rdtn_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%Velocity) .AND. ALLOCATED(u1%Velocity)) THEN + u_out%Velocity = a1*u1%Velocity + a2*u2%Velocity + a3*u3%Velocity + END IF ! check if allocated +END SUBROUTINE + +subroutine Conv_Rdtn_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(Conv_Rdtn_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(Conv_Rdtn_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 = 'Conv_Rdtn_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 Conv_Rdtn_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Conv_Rdtn_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 Conv_Rdtn_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 Conv_Rdtn_Output_ExtrapInterp - - - SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call Conv_Rdtn_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Conv_Rdtn_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Conv_Rdtn_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE Conv_Rdtn_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. @@ -2151,47 +1011,45 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Conv_Rdtn_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 + TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%F_Rdtn) .AND. ALLOCATED(y1%F_Rdtn)) THEN - DO i1 = LBOUND(y_out%F_Rdtn,1),UBOUND(y_out%F_Rdtn,1) - b = -(y1%F_Rdtn(i1) - y2%F_Rdtn(i1)) - y_out%F_Rdtn(i1) = y1%F_Rdtn(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1 - - - SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%F_Rdtn) .AND. ALLOCATED(y1%F_Rdtn)) THEN + y_out%F_Rdtn = a1*y1%F_Rdtn + a2*y2%F_Rdtn + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE Conv_Rdtn_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. @@ -2205,54 +1063,50 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSt ! !.................................................................................................................................. - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Conv_Rdtn_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 + TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_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 + 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 + 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 + 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%F_Rdtn) .AND. ALLOCATED(y1%F_Rdtn)) THEN - DO i1 = LBOUND(y_out%F_Rdtn,1),UBOUND(y_out%F_Rdtn,1) - b = (t(3)**2*(y1%F_Rdtn(i1) - y2%F_Rdtn(i1)) + t(2)**2*(-y1%F_Rdtn(i1) + y3%F_Rdtn(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%F_Rdtn(i1) + t(3)*y2%F_Rdtn(i1) - t(2)*y3%F_Rdtn(i1) ) * scaleFactor - y_out%F_Rdtn(i1) = y1%F_Rdtn(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%F_Rdtn) .AND. ALLOCATED(y1%F_Rdtn)) THEN + y_out%F_Rdtn = a1*y1%F_Rdtn + a2*y2%F_Rdtn + a3*y3%F_Rdtn + END IF ! check if allocated +END SUBROUTINE END MODULE Conv_Radiation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index e195fcde9c..e70472aac7 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -44,19 +44,19 @@ MODULE HydroDyn_Types INTEGER(IntKi), PUBLIC, PARAMETER :: MaxUserOutputs = 5150 ! Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150 [-] ! ========= HydroDyn_InputFile ======= TYPE, PUBLIC :: HydroDyn_InputFile - LOGICAL :: EchoFlag !< Echo the input file [-] + LOGICAL :: EchoFlag = .false. !< Echo the input file [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AddF0 !< Additional pre-load forces and moments (N,N,N,N-m,N-m,N-m) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddCLin !< Additional stiffness matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBLin !< Additional linear damping matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBQuad !< Additional quadratic damping (drag) matrix [-] TYPE(SeaSt_InitInputType) :: SeaState !< Initialization data for SeaState module [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: PotFile !< The name of the root potential flow file (without extension for WAMIT, complete name for FIT) [-] - INTEGER(IntKi) :: nWAMITObj !< number of WAMIT input files. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] - INTEGER(IntKi) :: vecMultiplier !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] - INTEGER(IntKi) :: 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] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + INTEGER(IntKi) :: nWAMITObj = 0_IntKi !< number of WAMIT input files. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] + INTEGER(IntKi) :: vecMultiplier = 0_IntKi !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=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] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmVol0 !< [-] - LOGICAL :: HasWAMIT !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] + LOGICAL :: HasWAMIT = .false. !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WAMITULEN !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefxt !< The xt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefyt !< The yt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] @@ -67,16 +67,16 @@ MODULE HydroDyn_Types TYPE(WAMIT_InitInputType) :: WAMIT !< Initialization data for WAMIT module [-] TYPE(WAMIT2_InitInputType) :: WAMIT2 !< Initialization data for WAMIT2 module [-] TYPE(Morison_InitInputType) :: Morison !< Initialization data for Morison module [-] - LOGICAL :: Echo !< Echo the input files to a file with the same name as the input but with a .echo extension [T/F] [-] - INTEGER(IntKi) :: PotMod !< 1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model [-] - INTEGER(IntKi) :: NUserOutputs !< Number of Hydrodyn-level requested output channels [-] + LOGICAL :: Echo = .false. !< Echo the input files to a file with the same name as the input but with a .echo extension [T/F] [-] + INTEGER(IntKi) :: PotMod = 0_IntKi !< 1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model [-] + INTEGER(IntKi) :: NUserOutputs = 0_IntKi !< Number of Hydrodyn-level requested output channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: UserOutputs !< This should really be dimensioned with MaxOutPts [-] - INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] - LOGICAL :: OutAll !< Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F] [-] - INTEGER(IntKi) :: NumOuts !< The number of outputs for this module as requested in the input file [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] + LOGICAL :: OutAll = .false. !< Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F] [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< The number of outputs for this module as requested in the input file [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< The user-requested output channel labels for this modules. This should really be dimensioned with MaxOutPts [-] - LOGICAL :: HDSum !< Generate a HydroDyn summary file [T/F] [-] - INTEGER(IntKi) :: UnSum !< File unit for the HydroDyn summary file [-1 = no summary file] [-] + LOGICAL :: HDSum = .false. !< Generate a HydroDyn summary file [T/F] [-] + INTEGER(IntKi) :: UnSum = 0_IntKi !< File unit for the HydroDyn summary file [-1 = no summary file] [-] CHARACTER(20) :: OutFmt !< Output format for numerical results [-] CHARACTER(20) :: OutSFmt !< Output format for header strings [-] END TYPE HydroDyn_InputFile @@ -88,34 +88,34 @@ MODULE HydroDyn_Types TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] CHARACTER(1024) :: OutRootName !< Supplied by Driver: The name of the root file (without extension) including the full path [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - REAL(ReKi) :: Gravity !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDens !< Water density from the driver; may be overwritten [(kg/m^3)] - REAL(ReKi) :: WtrDpth !< Water depth from the driver; may be overwritten [m] - REAL(ReKi) :: MSL2SWL !< Mean sea level to still water level from the driver; may be overwritten [m] - REAL(DbKi) :: TMax !< Supplied by Driver: The total simulation time [(sec)] - REAL(ReKi) :: PtfmLocationX !< Supplied by Driver: X coordinate of platform location in the wave field [m] - REAL(ReKi) :: PtfmLocationY !< Supplied by Driver: Y coordinate of platform location in the wave field [m] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density from the driver; may be overwritten [(kg/m^3)] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth from the driver; may be overwritten [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean sea level to still water level from the driver; may be overwritten [m] + REAL(DbKi) :: TMax = 0.0_R8Ki !< Supplied by Driver: The total simulation time [(sec)] + REAL(ReKi) :: PtfmLocationX = 0.0_ReKi !< Supplied by Driver: X coordinate of platform location in the wave field [m] + REAL(ReKi) :: PtfmLocationY = 0.0_ReKi !< Supplied by Driver: Y coordinate of platform location in the wave field [m] INTEGER(IntKi) :: NStepWave = 0 !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0 !< NStepWave / 2 [-] - REAL(SiKi) :: RhoXg !< = WtrDens*Gravity [-] - 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 } [-] - 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} [-] - INTEGER(IntKi) :: WaveDirMod !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] - 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) :: 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)] - LOGICAL :: InvalidWithSSExctn !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] + REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] + INTEGER(IntKi) :: WaveMod = 0_IntKi !< 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 } [-] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] + INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] + REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< 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 = 0.0_R4Ki !< 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) :: WvLowCOffD = 0.0_R4Ki !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(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) :: 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)] - REAL(SiKi) :: MCFD !< Diameter of MacCamy-Fuchs members [(meters)] + REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] + REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] + REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] + LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] + REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] + REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of MacCamy-Fuchs members [(meters)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE HydroDyn_InitInputType ! ======================= @@ -167,11 +167,11 @@ MODULE HydroDyn_Types TYPE, PUBLIC :: HydroDyn_MiscVarType TYPE(MeshType) :: AllHdroOrigin !< An intermediate mesh used to transfer hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh [-] TYPE(HD_ModuleMapType) :: HD_MeshMap - INTEGER(IntKi) :: Decimate !< The output decimation counter [-] - REAL(DbKi) :: LastOutTime !< Last time step which was written to the output file (sec) [-] - INTEGER(IntKi) :: LastIndWave !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] + INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] + INTEGER(IntKi) :: LastIndWave = 0_IntKi !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_PtfmAdd !< The total forces and moments due to additional pre-load, stiffness, and damping [-] - REAL(ReKi) , DIMENSION(1:6) :: F_Hydro !< The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point [-] + REAL(ReKi) , DIMENSION(1:6) :: F_Hydro = 0.0_ReKi !< The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Waves !< The total waves forces on a WAMIT body calculated by first and second order methods (WAMIT and WAMIT2 modules) [-] TYPE(WAMIT_MiscVarType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< misc var information from the WAMIT module [-] TYPE(WAMIT2_MiscVarType) , DIMENSION(:), ALLOCATABLE :: WAMIT2 !< misc var information from the WAMIT2 module [-] @@ -181,39 +181,39 @@ MODULE HydroDyn_Types ! ======================= ! ========= HydroDyn_ParameterType ======= TYPE, PUBLIC :: HydroDyn_ParameterType - INTEGER(IntKi) :: nWAMITObj !< number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] - INTEGER(IntKi) :: vecMultiplier !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] + INTEGER(IntKi) :: nWAMITObj = 0_IntKi !< number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] + INTEGER(IntKi) :: vecMultiplier = 0_IntKi !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] TYPE(WAMIT_ParameterType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< Parameter data for the WAMIT module [-] TYPE(WAMIT2_ParameterType) , DIMENSION(:), ALLOCATABLE :: WAMIT2 !< Parameter data for the WAMIT2 module [-] LOGICAL :: WAMIT2used = .FALSE. !< Indicates when WAMIT2 is used. Shortcuts some calculations [-] TYPE(Morison_ParameterType) :: Morison !< Parameter data for the Morison module [-] - INTEGER(IntKi) :: PotMod !< 1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model [-] - INTEGER(IntKi) :: 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] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] - INTEGER(IntKi) :: totalStates !< Number of excitation and radiation states for all WAMIT bodies [-] - INTEGER(IntKi) :: totalExctnStates !< Number of excitation states for all WAMIT bodies [-] - INTEGER(IntKi) :: totalRdtnStates !< Number of radiation states for all WAMIT bodies [-] + INTEGER(IntKi) :: PotMod = 0_IntKi !< 1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=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] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + INTEGER(IntKi) :: totalStates = 0_IntKi !< Number of excitation and radiation states for all WAMIT bodies [-] + INTEGER(IntKi) :: totalExctnStates = 0_IntKi !< Number of excitation states for all WAMIT bodies [-] + INTEGER(IntKi) :: totalRdtnStates = 0_IntKi !< Number of radiation states for all WAMIT bodies [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Array of time samples, (sec) [-] - INTEGER(IntKi) :: NStepWave !< Number of data points in the wave kinematics arrays [-] - REAL(ReKi) :: WtrDpth !< Water depth [(m)] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of data points in the wave kinematics arrays [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(m)] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AddF0 !< Additional pre-load forces and moments (N,N,N,N-m,N-m,N-m) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddCLin !< Additional stiffness matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBLin !< Additional linear damping matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBQuad !< Additional quadratic damping (drag) matrix [-] - REAL(DbKi) :: DT !< Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] - INTEGER(IntKi) :: NumOuts !< Number of HydroDyn module-level outputs (not the total number including sub-modules [-] - INTEGER(IntKi) :: NumTotalOuts !< Number of all requested outputs including sub-modules [-] - INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of HydroDyn module-level outputs (not the total number including sub-modules [-] + INTEGER(IntKi) :: NumTotalOuts = 0_IntKi !< Number of all requested outputs including sub-modules [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] CHARACTER(20) :: OutFmt !< Output format for numerical results [-] CHARACTER(20) :: OutSFmt !< Output format for header strings [-] CHARACTER(ChanLen) :: Delim !< Delimiter string for outputs, defaults to tab-delimiters [-] - INTEGER(IntKi) :: UnOutFile !< File unit for the HydroDyn outputs [-] - INTEGER(IntKi) :: OutDec !< Write every OutDec time steps [-] + INTEGER(IntKi) :: UnOutFile = 0_IntKi !< File unit for the HydroDyn outputs [-] + INTEGER(IntKi) :: OutDec = 0_IntKi !< Write every OutDec time steps [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] LOGICAL :: PointsToSeaState = .TRUE. !< Flag that determines if the data contains pointers to SeaState module or if new copies (from restart) [-] END TYPE HydroDyn_ParameterType ! ======================= @@ -234,7820 +234,2820 @@ MODULE HydroDyn_Types END TYPE HydroDyn_OutputType ! ======================= CONTAINS - SUBROUTINE HydroDyn_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(HydroDyn_InputFile), INTENT(INOUT) :: DstInputFileData - 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 = 'HydroDyn_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag -IF (ALLOCATED(SrcInputFileData%AddF0)) THEN - i1_l = LBOUND(SrcInputFileData%AddF0,1) - i1_u = UBOUND(SrcInputFileData%AddF0,1) - i2_l = LBOUND(SrcInputFileData%AddF0,2) - i2_u = UBOUND(SrcInputFileData%AddF0,2) - IF (.NOT. ALLOCATED(DstInputFileData%AddF0)) THEN - ALLOCATE(DstInputFileData%AddF0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AddF0 = SrcInputFileData%AddF0 -ENDIF -IF (ALLOCATED(SrcInputFileData%AddCLin)) THEN - i1_l = LBOUND(SrcInputFileData%AddCLin,1) - i1_u = UBOUND(SrcInputFileData%AddCLin,1) - i2_l = LBOUND(SrcInputFileData%AddCLin,2) - i2_u = UBOUND(SrcInputFileData%AddCLin,2) - i3_l = LBOUND(SrcInputFileData%AddCLin,3) - i3_u = UBOUND(SrcInputFileData%AddCLin,3) - IF (.NOT. ALLOCATED(DstInputFileData%AddCLin)) THEN - ALLOCATE(DstInputFileData%AddCLin(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddCLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AddCLin = SrcInputFileData%AddCLin -ENDIF -IF (ALLOCATED(SrcInputFileData%AddBLin)) THEN - i1_l = LBOUND(SrcInputFileData%AddBLin,1) - i1_u = UBOUND(SrcInputFileData%AddBLin,1) - i2_l = LBOUND(SrcInputFileData%AddBLin,2) - i2_u = UBOUND(SrcInputFileData%AddBLin,2) - i3_l = LBOUND(SrcInputFileData%AddBLin,3) - i3_u = UBOUND(SrcInputFileData%AddBLin,3) - IF (.NOT. ALLOCATED(DstInputFileData%AddBLin)) THEN - ALLOCATE(DstInputFileData%AddBLin(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddBLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AddBLin = SrcInputFileData%AddBLin -ENDIF -IF (ALLOCATED(SrcInputFileData%AddBQuad)) THEN - i1_l = LBOUND(SrcInputFileData%AddBQuad,1) - i1_u = UBOUND(SrcInputFileData%AddBQuad,1) - i2_l = LBOUND(SrcInputFileData%AddBQuad,2) - i2_u = UBOUND(SrcInputFileData%AddBQuad,2) - i3_l = LBOUND(SrcInputFileData%AddBQuad,3) - i3_u = UBOUND(SrcInputFileData%AddBQuad,3) - IF (.NOT. ALLOCATED(DstInputFileData%AddBQuad)) THEN - ALLOCATE(DstInputFileData%AddBQuad(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddBQuad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AddBQuad = SrcInputFileData%AddBQuad -ENDIF - CALL SeaSt_CopyInitInput( SrcInputFileData%SeaState, DstInputFileData%SeaState, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputFileData%PotFile)) THEN - i1_l = LBOUND(SrcInputFileData%PotFile,1) - i1_u = UBOUND(SrcInputFileData%PotFile,1) - IF (.NOT. ALLOCATED(DstInputFileData%PotFile)) THEN - ALLOCATE(DstInputFileData%PotFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PotFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PotFile = SrcInputFileData%PotFile -ENDIF - DstInputFileData%nWAMITObj = SrcInputFileData%nWAMITObj - DstInputFileData%vecMultiplier = SrcInputFileData%vecMultiplier - DstInputFileData%NBody = SrcInputFileData%NBody - DstInputFileData%NBodyMod = SrcInputFileData%NBodyMod -IF (ALLOCATED(SrcInputFileData%PtfmVol0)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmVol0,1) - i1_u = UBOUND(SrcInputFileData%PtfmVol0,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmVol0)) THEN - ALLOCATE(DstInputFileData%PtfmVol0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmVol0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmVol0 = SrcInputFileData%PtfmVol0 -ENDIF - DstInputFileData%HasWAMIT = SrcInputFileData%HasWAMIT -IF (ALLOCATED(SrcInputFileData%WAMITULEN)) THEN - i1_l = LBOUND(SrcInputFileData%WAMITULEN,1) - i1_u = UBOUND(SrcInputFileData%WAMITULEN,1) - IF (.NOT. ALLOCATED(DstInputFileData%WAMITULEN)) THEN - ALLOCATE(DstInputFileData%WAMITULEN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WAMITULEN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WAMITULEN = SrcInputFileData%WAMITULEN -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmRefxt)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmRefxt,1) - i1_u = UBOUND(SrcInputFileData%PtfmRefxt,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmRefxt)) THEN - ALLOCATE(DstInputFileData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmRefxt = SrcInputFileData%PtfmRefxt -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmRefyt)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmRefyt,1) - i1_u = UBOUND(SrcInputFileData%PtfmRefyt,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmRefyt)) THEN - ALLOCATE(DstInputFileData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmRefyt = SrcInputFileData%PtfmRefyt -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmRefzt)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmRefzt,1) - i1_u = UBOUND(SrcInputFileData%PtfmRefzt,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmRefzt)) THEN - ALLOCATE(DstInputFileData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmRefztRot)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmRefztRot,1) - i1_u = UBOUND(SrcInputFileData%PtfmRefztRot,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmRefztRot)) THEN - ALLOCATE(DstInputFileData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmRefztRot = SrcInputFileData%PtfmRefztRot -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmCOBxt)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmCOBxt,1) - i1_u = UBOUND(SrcInputFileData%PtfmCOBxt,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmCOBxt)) THEN - ALLOCATE(DstInputFileData%PtfmCOBxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmCOBxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmCOBxt = SrcInputFileData%PtfmCOBxt -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmCOByt)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmCOByt,1) - i1_u = UBOUND(SrcInputFileData%PtfmCOByt,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmCOByt)) THEN - ALLOCATE(DstInputFileData%PtfmCOByt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmCOByt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmCOByt = SrcInputFileData%PtfmCOByt -ENDIF - CALL WAMIT_CopyInitInput( SrcInputFileData%WAMIT, DstInputFileData%WAMIT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WAMIT2_CopyInitInput( SrcInputFileData%WAMIT2, DstInputFileData%WAMIT2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Morison_CopyInitInput( SrcInputFileData%Morison, DstInputFileData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%PotMod = SrcInputFileData%PotMod - DstInputFileData%NUserOutputs = SrcInputFileData%NUserOutputs -IF (ALLOCATED(SrcInputFileData%UserOutputs)) THEN - i1_l = LBOUND(SrcInputFileData%UserOutputs,1) - i1_u = UBOUND(SrcInputFileData%UserOutputs,1) - IF (.NOT. ALLOCATED(DstInputFileData%UserOutputs)) THEN - ALLOCATE(DstInputFileData%UserOutputs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%UserOutputs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%UserOutputs = SrcInputFileData%UserOutputs -ENDIF - DstInputFileData%OutSwtch = SrcInputFileData%OutSwtch - DstInputFileData%OutAll = SrcInputFileData%OutAll - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%HDSum = SrcInputFileData%HDSum - DstInputFileData%UnSum = SrcInputFileData%UnSum - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt - END SUBROUTINE HydroDyn_CopyInputFile - - SUBROUTINE HydroDyn_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(HydroDyn_InputFile), INTENT(INOUT) :: InputFileData - 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 = 'HydroDyn_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%AddF0)) THEN - DEALLOCATE(InputFileData%AddF0) -ENDIF -IF (ALLOCATED(InputFileData%AddCLin)) THEN - DEALLOCATE(InputFileData%AddCLin) -ENDIF -IF (ALLOCATED(InputFileData%AddBLin)) THEN - DEALLOCATE(InputFileData%AddBLin) -ENDIF -IF (ALLOCATED(InputFileData%AddBQuad)) THEN - DEALLOCATE(InputFileData%AddBQuad) -ENDIF - CALL SeaSt_DestroyInitInput( InputFileData%SeaState, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputFileData%PotFile)) THEN - DEALLOCATE(InputFileData%PotFile) -ENDIF -IF (ALLOCATED(InputFileData%PtfmVol0)) THEN - DEALLOCATE(InputFileData%PtfmVol0) -ENDIF -IF (ALLOCATED(InputFileData%WAMITULEN)) THEN - DEALLOCATE(InputFileData%WAMITULEN) -ENDIF -IF (ALLOCATED(InputFileData%PtfmRefxt)) THEN - DEALLOCATE(InputFileData%PtfmRefxt) -ENDIF -IF (ALLOCATED(InputFileData%PtfmRefyt)) THEN - DEALLOCATE(InputFileData%PtfmRefyt) -ENDIF -IF (ALLOCATED(InputFileData%PtfmRefzt)) THEN - DEALLOCATE(InputFileData%PtfmRefzt) -ENDIF -IF (ALLOCATED(InputFileData%PtfmRefztRot)) THEN - DEALLOCATE(InputFileData%PtfmRefztRot) -ENDIF -IF (ALLOCATED(InputFileData%PtfmCOBxt)) THEN - DEALLOCATE(InputFileData%PtfmCOBxt) -ENDIF -IF (ALLOCATED(InputFileData%PtfmCOByt)) THEN - DEALLOCATE(InputFileData%PtfmCOByt) -ENDIF - CALL WAMIT_DestroyInitInput( InputFileData%WAMIT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WAMIT2_DestroyInitInput( InputFileData%WAMIT2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Morison_DestroyInitInput( InputFileData%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputFileData%UserOutputs)) THEN - DEALLOCATE(InputFileData%UserOutputs) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF - END SUBROUTINE HydroDyn_DestroyInputFile - - SUBROUTINE HydroDyn_PackInputFile( 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(HydroDyn_InputFile), 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 = 'HydroDyn_PackInputFile' - ! 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 ! EchoFlag - Int_BufSz = Int_BufSz + 1 ! AddF0 allocated yes/no - IF ( ALLOCATED(InData%AddF0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AddF0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddF0) ! AddF0 - END IF - Int_BufSz = Int_BufSz + 1 ! AddCLin allocated yes/no - IF ( ALLOCATED(InData%AddCLin) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddCLin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddCLin) ! AddCLin - END IF - Int_BufSz = Int_BufSz + 1 ! AddBLin allocated yes/no - IF ( ALLOCATED(InData%AddBLin) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddBLin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddBLin) ! AddBLin - END IF - Int_BufSz = Int_BufSz + 1 ! AddBQuad allocated yes/no - IF ( ALLOCATED(InData%AddBQuad) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddBQuad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddBQuad) ! AddBQuad - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SeaState: size of buffers for each call to pack subtype - CALL SeaSt_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%SeaState, ErrStat2, ErrMsg2, .TRUE. ) ! SeaState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaState - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaState - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaState - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! PotFile allocated yes/no - IF ( ALLOCATED(InData%PotFile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PotFile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PotFile)*LEN(InData%PotFile) ! PotFile - END IF - Int_BufSz = Int_BufSz + 1 ! nWAMITObj - Int_BufSz = Int_BufSz + 1 ! vecMultiplier - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Int_BufSz = Int_BufSz + 1 ! PtfmVol0 allocated yes/no - IF ( ALLOCATED(InData%PtfmVol0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmVol0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmVol0) ! PtfmVol0 - END IF - Int_BufSz = Int_BufSz + 1 ! HasWAMIT - Int_BufSz = Int_BufSz + 1 ! WAMITULEN allocated yes/no - IF ( ALLOCATED(InData%WAMITULEN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMITULEN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WAMITULEN) ! WAMITULEN - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefxt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefxt) ! PtfmRefxt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefyt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefyt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefyt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefyt) ! PtfmRefyt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefzt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefzt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefzt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefzt) ! PtfmRefzt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefztRot allocated yes/no - 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 ! PtfmCOBxt allocated yes/no - IF ( ALLOCATED(InData%PtfmCOBxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmCOBxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmCOBxt) ! PtfmCOBxt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmCOByt allocated yes/no - IF ( ALLOCATED(InData%PtfmCOByt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmCOByt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmCOByt) ! PtfmCOByt - END IF - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2, ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! PotMod - Int_BufSz = Int_BufSz + 1 ! NUserOutputs - Int_BufSz = Int_BufSz + 1 ! UserOutputs allocated yes/no - IF ( ALLOCATED(InData%UserOutputs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UserOutputs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UserOutputs)*LEN(InData%UserOutputs) ! UserOutputs - END IF - Int_BufSz = Int_BufSz + 1 ! OutSwtch - Int_BufSz = Int_BufSz + 1 ! OutAll - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1 ! HDSum - Int_BufSz = Int_BufSz + 1 ! UnSum - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - 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) = TRANSFER(InData%EchoFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AddF0) ) 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%AddF0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddF0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddF0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddF0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AddF0,2), UBOUND(InData%AddF0,2) - DO i1 = LBOUND(InData%AddF0,1), UBOUND(InData%AddF0,1) - ReKiBuf(Re_Xferred) = InData%AddF0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddCLin) ) 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%AddCLin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddCLin,3), UBOUND(InData%AddCLin,3) - DO i2 = LBOUND(InData%AddCLin,2), UBOUND(InData%AddCLin,2) - DO i1 = LBOUND(InData%AddCLin,1), UBOUND(InData%AddCLin,1) - ReKiBuf(Re_Xferred) = InData%AddCLin(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddBLin) ) 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%AddBLin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddBLin,3), UBOUND(InData%AddBLin,3) - DO i2 = LBOUND(InData%AddBLin,2), UBOUND(InData%AddBLin,2) - DO i1 = LBOUND(InData%AddBLin,1), UBOUND(InData%AddBLin,1) - ReKiBuf(Re_Xferred) = InData%AddBLin(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddBQuad) ) 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%AddBQuad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddBQuad,3), UBOUND(InData%AddBQuad,3) - DO i2 = LBOUND(InData%AddBQuad,2), UBOUND(InData%AddBQuad,2) - DO i1 = LBOUND(InData%AddBQuad,1), UBOUND(InData%AddBQuad,1) - ReKiBuf(Re_Xferred) = InData%AddBQuad(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - CALL SeaSt_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%SeaState, ErrStat2, ErrMsg2, OnlySize ) ! SeaState - 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 - IF ( .NOT. ALLOCATED(InData%PotFile) ) 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%PotFile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PotFile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PotFile,1), UBOUND(InData%PotFile,1) - DO I = 1, LEN(InData%PotFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%PotFile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nWAMITObj - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%vecMultiplier - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmVol0) ) 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%PtfmVol0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmVol0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmVol0,1), UBOUND(InData%PtfmVol0,1) - ReKiBuf(Re_Xferred) = InData%PtfmVol0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%HasWAMIT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WAMITULEN) ) 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%WAMITULEN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMITULEN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMITULEN,1), UBOUND(InData%WAMITULEN,1) - ReKiBuf(Re_Xferred) = InData%WAMITULEN(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefxt) ) 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%PtfmRefxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefxt,1), UBOUND(InData%PtfmRefxt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefyt) ) 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%PtfmRefyt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefyt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefyt,1), UBOUND(InData%PtfmRefyt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefyt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefzt) ) 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%PtfmRefzt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefzt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefzt,1), UBOUND(InData%PtfmRefzt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefzt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefztRot) ) 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%PtfmRefztRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefztRot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefztRot,1), UBOUND(InData%PtfmRefztRot,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmCOBxt) ) 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%PtfmCOBxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmCOBxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmCOBxt,1), UBOUND(InData%PtfmCOBxt,1) - ReKiBuf(Re_Xferred) = InData%PtfmCOBxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmCOByt) ) 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%PtfmCOByt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmCOByt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmCOByt,1), UBOUND(InData%PtfmCOByt,1) - ReKiBuf(Re_Xferred) = InData%PtfmCOByt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL WAMIT_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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 - CALL WAMIT2_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - 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 - CALL Morison_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PotMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NUserOutputs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UserOutputs) ) 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%UserOutputs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserOutputs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UserOutputs,1), UBOUND(InData%UserOutputs,1) - DO I = 1, LEN(InData%UserOutputs) - IntKiBuf(Int_Xferred) = ICHAR(InData%UserOutputs(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) 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%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - 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 - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%HDSum, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnSum - 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 - END SUBROUTINE HydroDyn_PackInputFile - - SUBROUTINE HydroDyn_UnPackInputFile( 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(HydroDyn_InputFile), 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 = 'HydroDyn_UnPackInputFile' - ! 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%EchoFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%EchoFlag) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddF0 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%AddF0)) DEALLOCATE(OutData%AddF0) - ALLOCATE(OutData%AddF0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AddF0,2), UBOUND(OutData%AddF0,2) - DO i1 = LBOUND(OutData%AddF0,1), UBOUND(OutData%AddF0,1) - OutData%AddF0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddCLin 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%AddCLin)) DEALLOCATE(OutData%AddCLin) - ALLOCATE(OutData%AddCLin(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%AddCLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddCLin,3), UBOUND(OutData%AddCLin,3) - DO i2 = LBOUND(OutData%AddCLin,2), UBOUND(OutData%AddCLin,2) - DO i1 = LBOUND(OutData%AddCLin,1), UBOUND(OutData%AddCLin,1) - OutData%AddCLin(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddBLin 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%AddBLin)) DEALLOCATE(OutData%AddBLin) - ALLOCATE(OutData%AddBLin(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%AddBLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddBLin,3), UBOUND(OutData%AddBLin,3) - DO i2 = LBOUND(OutData%AddBLin,2), UBOUND(OutData%AddBLin,2) - DO i1 = LBOUND(OutData%AddBLin,1), UBOUND(OutData%AddBLin,1) - OutData%AddBLin(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddBQuad 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%AddBQuad)) DEALLOCATE(OutData%AddBQuad) - ALLOCATE(OutData%AddBQuad(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%AddBQuad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddBQuad,3), UBOUND(OutData%AddBQuad,3) - DO i2 = LBOUND(OutData%AddBQuad,2), UBOUND(OutData%AddBQuad,2) - DO i1 = LBOUND(OutData%AddBQuad,1), UBOUND(OutData%AddBQuad,1) - OutData%AddBQuad(i1,i2,i3) = ReKiBuf(Re_Xferred) - 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_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%SeaState, ErrStat2, ErrMsg2 ) ! SeaState - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PotFile 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%PotFile)) DEALLOCATE(OutData%PotFile) - ALLOCATE(OutData%PotFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PotFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PotFile,1), UBOUND(OutData%PotFile,1) - DO I = 1, LEN(OutData%PotFile) - OutData%PotFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%nWAMITObj = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%vecMultiplier = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmVol0 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%PtfmVol0)) DEALLOCATE(OutData%PtfmVol0) - ALLOCATE(OutData%PtfmVol0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmVol0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmVol0,1), UBOUND(OutData%PtfmVol0,1) - OutData%PtfmVol0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%HasWAMIT = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasWAMIT) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMITULEN 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%WAMITULEN)) DEALLOCATE(OutData%WAMITULEN) - ALLOCATE(OutData%WAMITULEN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMITULEN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMITULEN,1), UBOUND(OutData%WAMITULEN,1) - OutData%WAMITULEN(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefxt 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%PtfmRefxt)) DEALLOCATE(OutData%PtfmRefxt) - ALLOCATE(OutData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefxt,1), UBOUND(OutData%PtfmRefxt,1) - OutData%PtfmRefxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefyt 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%PtfmRefyt)) DEALLOCATE(OutData%PtfmRefyt) - ALLOCATE(OutData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefyt,1), UBOUND(OutData%PtfmRefyt,1) - OutData%PtfmRefyt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefzt 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%PtfmRefzt)) DEALLOCATE(OutData%PtfmRefzt) - ALLOCATE(OutData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefzt,1), UBOUND(OutData%PtfmRefzt,1) - OutData%PtfmRefzt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefztRot 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%PtfmRefztRot)) DEALLOCATE(OutData%PtfmRefztRot) - ALLOCATE(OutData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefztRot,1), UBOUND(OutData%PtfmRefztRot,1) - OutData%PtfmRefztRot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmCOBxt 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%PtfmCOBxt)) DEALLOCATE(OutData%PtfmCOBxt) - ALLOCATE(OutData%PtfmCOBxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOBxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmCOBxt,1), UBOUND(OutData%PtfmCOBxt,1) - OutData%PtfmCOBxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmCOByt 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%PtfmCOByt)) DEALLOCATE(OutData%PtfmCOByt) - ALLOCATE(OutData%PtfmCOByt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOByt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmCOByt,1), UBOUND(OutData%PtfmCOByt,1) - OutData%PtfmCOByt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 WAMIT_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT, ErrStat2, ErrMsg2 ) ! WAMIT - 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) - 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 WAMIT2_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2, ErrStat2, ErrMsg2 ) ! WAMIT2 - 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) - 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_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%PotMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NUserOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserOutputs 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%UserOutputs)) DEALLOCATE(OutData%UserOutputs) - ALLOCATE(OutData%UserOutputs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserOutputs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UserOutputs,1), UBOUND(OutData%UserOutputs,1) - DO I = 1, LEN(OutData%UserOutputs) - OutData%UserOutputs(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%OutSwtch = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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%HDSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%HDSum) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = 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 - END SUBROUTINE HydroDyn_UnPackInputFile - - SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(HydroDyn_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyInitInput' -! +subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_InputFile), intent(in) :: SrcInputFileData + type(HydroDyn_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%OutRootName = SrcInitInputData%OutRootName - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%TMax = SrcInitInputData%TMax - DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX - DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%RhoXg = SrcInitInputData%RhoXg - DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod - DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod - DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff - DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff - DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD - DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD - DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS - DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS - DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn -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 -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%WaveDirMin = SrcInitInputData%WaveDirMin - DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir - DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega - DstInitInputData%MCFD = SrcInitInputData%MCFD - DstInitInputData%WaveField => SrcInitInputData%WaveField - END SUBROUTINE HydroDyn_CopyInitInput - - SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(HydroDyn_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 = 'HydroDyn_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitInputData%WaveElev0)) THEN - DEALLOCATE(InitInputData%WaveElev0) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevC)) THEN - DEALLOCATE(InitInputData%WaveElevC) -ENDIF -NULLIFY(InitInputData%WaveField) - END SUBROUTINE HydroDyn_DestroyInitInput - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%OutRootName) ! OutRootName - Int_BufSz = Int_BufSz + 1 ! Linearize - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Db_BufSz = Db_BufSz + 1 ! TMax - Re_BufSz = Re_BufSz + 1 ! PtfmLocationX - Re_BufSz = Re_BufSz + 1 ! PtfmLocationY - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - Re_BufSz = Re_BufSz + 1 ! RhoXg - Int_BufSz = Int_BufSz + 1 ! WaveMod - Int_BufSz = Int_BufSz + 1 ! WaveStMod - Int_BufSz = Int_BufSz + 1 ! WaveDirMod - Re_BufSz = Re_BufSz + 1 ! WvLowCOff - Re_BufSz = Re_BufSz + 1 ! WvHiCOff - 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 + 1 ! InvalidWithSSExctn - 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 - 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 - Re_BufSz = Re_BufSz + 1 ! MCFD - 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 - 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 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 - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - 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 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMax - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationY - 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%RhoXg - Re_Xferred = Re_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 - 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 - 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 - ReKiBuf(Re_Xferred) = InData%MCFD - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE HydroDyn_PackInitInput - - SUBROUTINE HydroDyn_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(HydroDyn_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) :: 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 ! 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 ! 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 - 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 - OutData%MCFD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - NULLIFY(OutData%WaveField) - END SUBROUTINE HydroDyn_UnPackInitInput - - SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(HydroDyn_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 = 'HydroDyn_CopyInitOutput' -! + ErrMsg = '' + DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag + if (allocated(SrcInputFileData%AddF0)) then + LB(1:2) = lbound(SrcInputFileData%AddF0) + UB(1:2) = ubound(SrcInputFileData%AddF0) + if (.not. allocated(DstInputFileData%AddF0)) then + allocate(DstInputFileData%AddF0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddF0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AddF0 = SrcInputFileData%AddF0 + end if + if (allocated(SrcInputFileData%AddCLin)) then + LB(1:3) = lbound(SrcInputFileData%AddCLin) + UB(1:3) = ubound(SrcInputFileData%AddCLin) + if (.not. allocated(DstInputFileData%AddCLin)) then + allocate(DstInputFileData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddCLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AddCLin = SrcInputFileData%AddCLin + end if + if (allocated(SrcInputFileData%AddBLin)) then + LB(1:3) = lbound(SrcInputFileData%AddBLin) + UB(1:3) = ubound(SrcInputFileData%AddBLin) + if (.not. allocated(DstInputFileData%AddBLin)) then + allocate(DstInputFileData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddBLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AddBLin = SrcInputFileData%AddBLin + end if + if (allocated(SrcInputFileData%AddBQuad)) then + LB(1:3) = lbound(SrcInputFileData%AddBQuad) + UB(1:3) = ubound(SrcInputFileData%AddBQuad) + if (.not. allocated(DstInputFileData%AddBQuad)) then + allocate(DstInputFileData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddBQuad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AddBQuad = SrcInputFileData%AddBQuad + end if + call SeaSt_CopyInitInput(SrcInputFileData%SeaState, DstInputFileData%SeaState, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputFileData%PotFile)) then + LB(1:1) = lbound(SrcInputFileData%PotFile) + UB(1:1) = ubound(SrcInputFileData%PotFile) + if (.not. allocated(DstInputFileData%PotFile)) then + allocate(DstInputFileData%PotFile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PotFile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PotFile = SrcInputFileData%PotFile + end if + DstInputFileData%nWAMITObj = SrcInputFileData%nWAMITObj + DstInputFileData%vecMultiplier = SrcInputFileData%vecMultiplier + DstInputFileData%NBody = SrcInputFileData%NBody + DstInputFileData%NBodyMod = SrcInputFileData%NBodyMod + if (allocated(SrcInputFileData%PtfmVol0)) then + LB(1:1) = lbound(SrcInputFileData%PtfmVol0) + UB(1:1) = ubound(SrcInputFileData%PtfmVol0) + if (.not. allocated(DstInputFileData%PtfmVol0)) then + allocate(DstInputFileData%PtfmVol0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmVol0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmVol0 = SrcInputFileData%PtfmVol0 + end if + DstInputFileData%HasWAMIT = SrcInputFileData%HasWAMIT + if (allocated(SrcInputFileData%WAMITULEN)) then + LB(1:1) = lbound(SrcInputFileData%WAMITULEN) + UB(1:1) = ubound(SrcInputFileData%WAMITULEN) + if (.not. allocated(DstInputFileData%WAMITULEN)) then + allocate(DstInputFileData%WAMITULEN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WAMITULEN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WAMITULEN = SrcInputFileData%WAMITULEN + end if + if (allocated(SrcInputFileData%PtfmRefxt)) then + LB(1:1) = lbound(SrcInputFileData%PtfmRefxt) + UB(1:1) = ubound(SrcInputFileData%PtfmRefxt) + if (.not. allocated(DstInputFileData%PtfmRefxt)) then + allocate(DstInputFileData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmRefxt = SrcInputFileData%PtfmRefxt + end if + if (allocated(SrcInputFileData%PtfmRefyt)) then + LB(1:1) = lbound(SrcInputFileData%PtfmRefyt) + UB(1:1) = ubound(SrcInputFileData%PtfmRefyt) + if (.not. allocated(DstInputFileData%PtfmRefyt)) then + allocate(DstInputFileData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefyt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmRefyt = SrcInputFileData%PtfmRefyt + end if + if (allocated(SrcInputFileData%PtfmRefzt)) then + LB(1:1) = lbound(SrcInputFileData%PtfmRefzt) + UB(1:1) = ubound(SrcInputFileData%PtfmRefzt) + if (.not. allocated(DstInputFileData%PtfmRefzt)) then + allocate(DstInputFileData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefzt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt + end if + if (allocated(SrcInputFileData%PtfmRefztRot)) then + LB(1:1) = lbound(SrcInputFileData%PtfmRefztRot) + UB(1:1) = ubound(SrcInputFileData%PtfmRefztRot) + if (.not. allocated(DstInputFileData%PtfmRefztRot)) then + allocate(DstInputFileData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefztRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmRefztRot = SrcInputFileData%PtfmRefztRot + end if + if (allocated(SrcInputFileData%PtfmCOBxt)) then + LB(1:1) = lbound(SrcInputFileData%PtfmCOBxt) + UB(1:1) = ubound(SrcInputFileData%PtfmCOBxt) + if (.not. allocated(DstInputFileData%PtfmCOBxt)) then + allocate(DstInputFileData%PtfmCOBxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmCOBxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmCOBxt = SrcInputFileData%PtfmCOBxt + end if + if (allocated(SrcInputFileData%PtfmCOByt)) then + LB(1:1) = lbound(SrcInputFileData%PtfmCOByt) + UB(1:1) = ubound(SrcInputFileData%PtfmCOByt) + if (.not. allocated(DstInputFileData%PtfmCOByt)) then + allocate(DstInputFileData%PtfmCOByt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmCOByt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmCOByt = SrcInputFileData%PtfmCOByt + end if + call WAMIT_CopyInitInput(SrcInputFileData%WAMIT, DstInputFileData%WAMIT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WAMIT2_CopyInitInput(SrcInputFileData%WAMIT2, DstInputFileData%WAMIT2, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Morison_CopyInitInput(SrcInputFileData%Morison, DstInputFileData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%PotMod = SrcInputFileData%PotMod + DstInputFileData%NUserOutputs = SrcInputFileData%NUserOutputs + if (allocated(SrcInputFileData%UserOutputs)) then + LB(1:1) = lbound(SrcInputFileData%UserOutputs) + UB(1:1) = ubound(SrcInputFileData%UserOutputs) + if (.not. allocated(DstInputFileData%UserOutputs)) then + allocate(DstInputFileData%UserOutputs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%UserOutputs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%UserOutputs = SrcInputFileData%UserOutputs + end if + DstInputFileData%OutSwtch = SrcInputFileData%OutSwtch + DstInputFileData%OutAll = SrcInputFileData%OutAll + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + end if + DstInputFileData%HDSum = SrcInputFileData%HDSum + DstInputFileData%UnSum = SrcInputFileData%UnSum + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt +end subroutine + +subroutine HydroDyn_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(HydroDyn_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyInputFile' ErrStat = ErrID_None - ErrMsg = "" - CALL Morison_CopyInitOutput( SrcInitOutputData%Morison, DstInitOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -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 - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF - END SUBROUTINE HydroDyn_CopyInitOutput - - SUBROUTINE HydroDyn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(HydroDyn_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 = 'HydroDyn_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL Morison_DestroyInitOutput( InitOutputData%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF - END SUBROUTINE HydroDyn_DestroyInitOutput - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 + 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - 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 - - CALL Morison_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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 - 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) 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%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) 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%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) 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%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) 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%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) 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%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE HydroDyn_PackInitOutput - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 - 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_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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) - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y 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%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(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 ! LinNames_x 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%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(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 ! LinNames_u 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%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(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 ! DerivOrder_x 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%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u 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%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE HydroDyn_UnPackInitOutput - - SUBROUTINE HydroDyn_CopyHD_ModuleMapType( SrcHD_ModuleMapTypeData, DstHD_ModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HD_ModuleMapType), INTENT(INOUT) :: SrcHD_ModuleMapTypeData - TYPE(HD_ModuleMapType), INTENT(INOUT) :: DstHD_ModuleMapTypeData - 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 = 'HydroDyn_CopyHD_ModuleMapType' -! + ErrMsg = '' + if (allocated(InputFileData%AddF0)) then + deallocate(InputFileData%AddF0) + end if + if (allocated(InputFileData%AddCLin)) then + deallocate(InputFileData%AddCLin) + end if + if (allocated(InputFileData%AddBLin)) then + deallocate(InputFileData%AddBLin) + end if + if (allocated(InputFileData%AddBQuad)) then + deallocate(InputFileData%AddBQuad) + end if + call SeaSt_DestroyInitInput(InputFileData%SeaState, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputFileData%PotFile)) then + deallocate(InputFileData%PotFile) + end if + if (allocated(InputFileData%PtfmVol0)) then + deallocate(InputFileData%PtfmVol0) + end if + if (allocated(InputFileData%WAMITULEN)) then + deallocate(InputFileData%WAMITULEN) + end if + if (allocated(InputFileData%PtfmRefxt)) then + deallocate(InputFileData%PtfmRefxt) + end if + if (allocated(InputFileData%PtfmRefyt)) then + deallocate(InputFileData%PtfmRefyt) + end if + if (allocated(InputFileData%PtfmRefzt)) then + deallocate(InputFileData%PtfmRefzt) + end if + if (allocated(InputFileData%PtfmRefztRot)) then + deallocate(InputFileData%PtfmRefztRot) + end if + if (allocated(InputFileData%PtfmCOBxt)) then + deallocate(InputFileData%PtfmCOBxt) + end if + if (allocated(InputFileData%PtfmCOByt)) then + deallocate(InputFileData%PtfmCOByt) + end if + call WAMIT_DestroyInitInput(InputFileData%WAMIT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WAMIT2_DestroyInitInput(InputFileData%WAMIT2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Morison_DestroyInitInput(InputFileData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputFileData%UserOutputs)) then + deallocate(InputFileData%UserOutputs) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if +end subroutine + +subroutine HydroDyn_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%EchoFlag) + call RegPack(Buf, allocated(InData%AddF0)) + if (allocated(InData%AddF0)) then + call RegPackBounds(Buf, 2, lbound(InData%AddF0), ubound(InData%AddF0)) + call RegPack(Buf, InData%AddF0) + end if + call RegPack(Buf, allocated(InData%AddCLin)) + if (allocated(InData%AddCLin)) then + call RegPackBounds(Buf, 3, lbound(InData%AddCLin), ubound(InData%AddCLin)) + call RegPack(Buf, InData%AddCLin) + end if + call RegPack(Buf, allocated(InData%AddBLin)) + if (allocated(InData%AddBLin)) then + call RegPackBounds(Buf, 3, lbound(InData%AddBLin), ubound(InData%AddBLin)) + call RegPack(Buf, InData%AddBLin) + end if + call RegPack(Buf, allocated(InData%AddBQuad)) + if (allocated(InData%AddBQuad)) then + call RegPackBounds(Buf, 3, lbound(InData%AddBQuad), ubound(InData%AddBQuad)) + call RegPack(Buf, InData%AddBQuad) + end if + call SeaSt_PackInitInput(Buf, InData%SeaState) + call RegPack(Buf, allocated(InData%PotFile)) + if (allocated(InData%PotFile)) then + call RegPackBounds(Buf, 1, lbound(InData%PotFile), ubound(InData%PotFile)) + call RegPack(Buf, InData%PotFile) + end if + call RegPack(Buf, InData%nWAMITObj) + call RegPack(Buf, InData%vecMultiplier) + call RegPack(Buf, InData%NBody) + call RegPack(Buf, InData%NBodyMod) + call RegPack(Buf, allocated(InData%PtfmVol0)) + if (allocated(InData%PtfmVol0)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmVol0), ubound(InData%PtfmVol0)) + call RegPack(Buf, InData%PtfmVol0) + end if + call RegPack(Buf, InData%HasWAMIT) + call RegPack(Buf, allocated(InData%WAMITULEN)) + if (allocated(InData%WAMITULEN)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMITULEN), ubound(InData%WAMITULEN)) + call RegPack(Buf, InData%WAMITULEN) + end if + call RegPack(Buf, allocated(InData%PtfmRefxt)) + if (allocated(InData%PtfmRefxt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt), ubound(InData%PtfmRefxt)) + call RegPack(Buf, InData%PtfmRefxt) + end if + call RegPack(Buf, allocated(InData%PtfmRefyt)) + if (allocated(InData%PtfmRefyt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt), ubound(InData%PtfmRefyt)) + call RegPack(Buf, InData%PtfmRefyt) + end if + call RegPack(Buf, allocated(InData%PtfmRefzt)) + if (allocated(InData%PtfmRefzt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt), ubound(InData%PtfmRefzt)) + call RegPack(Buf, InData%PtfmRefzt) + end if + call RegPack(Buf, allocated(InData%PtfmRefztRot)) + if (allocated(InData%PtfmRefztRot)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) + call RegPack(Buf, InData%PtfmRefztRot) + end if + call RegPack(Buf, allocated(InData%PtfmCOBxt)) + if (allocated(InData%PtfmCOBxt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmCOBxt), ubound(InData%PtfmCOBxt)) + call RegPack(Buf, InData%PtfmCOBxt) + end if + call RegPack(Buf, allocated(InData%PtfmCOByt)) + if (allocated(InData%PtfmCOByt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmCOByt), ubound(InData%PtfmCOByt)) + call RegPack(Buf, InData%PtfmCOByt) + end if + call WAMIT_PackInitInput(Buf, InData%WAMIT) + call WAMIT2_PackInitInput(Buf, InData%WAMIT2) + call Morison_PackInitInput(Buf, InData%Morison) + call RegPack(Buf, InData%Echo) + call RegPack(Buf, InData%PotMod) + call RegPack(Buf, InData%NUserOutputs) + call RegPack(Buf, allocated(InData%UserOutputs)) + if (allocated(InData%UserOutputs)) then + call RegPackBounds(Buf, 1, lbound(InData%UserOutputs), ubound(InData%UserOutputs)) + call RegPack(Buf, InData%UserOutputs) + end if + call RegPack(Buf, InData%OutSwtch) + call RegPack(Buf, InData%OutAll) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + call RegPack(Buf, InData%HDSum) + call RegPack(Buf, InData%UnSum) + call RegPack(Buf, InData%OutFmt) + call RegPack(Buf, InData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackInputFile' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%EchoFlag) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AddF0)) deallocate(OutData%AddF0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddF0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddF0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AddCLin)) deallocate(OutData%AddCLin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddCLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddCLin) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AddBLin)) deallocate(OutData%AddBLin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddBLin) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AddBQuad)) deallocate(OutData%AddBQuad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBQuad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddBQuad) + if (RegCheckErr(Buf, RoutineName)) return + end if + call SeaSt_UnpackInitInput(Buf, OutData%SeaState) ! SeaState + if (allocated(OutData%PotFile)) deallocate(OutData%PotFile) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PotFile(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PotFile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PotFile) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%nWAMITObj) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%vecMultiplier) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PtfmVol0)) deallocate(OutData%PtfmVol0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmVol0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmVol0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmVol0) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%HasWAMIT) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WAMITULEN)) deallocate(OutData%WAMITULEN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMITULEN(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMITULEN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WAMITULEN) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PtfmRefxt)) deallocate(OutData%PtfmRefxt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefxt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefxt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PtfmRefyt)) deallocate(OutData%PtfmRefyt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefyt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefyt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PtfmRefzt)) deallocate(OutData%PtfmRefzt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefzt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefztRot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefztRot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PtfmCOBxt)) deallocate(OutData%PtfmCOBxt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmCOBxt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOBxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmCOBxt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PtfmCOByt)) deallocate(OutData%PtfmCOByt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmCOByt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOByt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmCOByt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call WAMIT_UnpackInitInput(Buf, OutData%WAMIT) ! WAMIT + call WAMIT2_UnpackInitInput(Buf, OutData%WAMIT2) ! WAMIT2 + call Morison_UnpackInitInput(Buf, OutData%Morison) ! Morison + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PotMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NUserOutputs) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%UserOutputs)) deallocate(OutData%UserOutputs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UserOutputs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserOutputs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UserOutputs) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutAll) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%HDSum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnSum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_InitInputType), intent(in) :: SrcInitInputData + type(HydroDyn_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copymeshmaptype( SrcHD_ModuleMapTypeData%uW_P_2_PRP_P, DstHD_ModuleMapTypeData%uW_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcHD_ModuleMapTypeData%W_P_2_PRP_P, DstHD_ModuleMapTypeData%W_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcHD_ModuleMapTypeData%M_P_2_PRP_P, DstHD_ModuleMapTypeData%M_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyHD_ModuleMapType - - SUBROUTINE HydroDyn_DestroyHD_ModuleMapType( HD_ModuleMapTypeData, ErrStat, ErrMsg ) - TYPE(HD_ModuleMapType), INTENT(INOUT) :: HD_ModuleMapTypeData - 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 = 'HydroDyn_DestroyHD_ModuleMapType' - - ErrStat = ErrID_None - ErrMsg = "" - - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 - - SUBROUTINE HydroDyn_PackHD_ModuleMapType( 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(HD_ModuleMapType), 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 = 'HydroDyn_PackHD_ModuleMapType' - ! 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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! uW_P_2_PRP_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! uW_P_2_PRP_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! uW_P_2_PRP_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W_P_2_PRP_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W_P_2_PRP_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W_P_2_PRP_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! M_P_2_PRP_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! M_P_2_PRP_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! M_P_2_PRP_P - 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 - - 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 - - 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 - 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 - - 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 - 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 - - 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_PackHD_ModuleMapType - - SUBROUTINE HydroDyn_UnPackHD_ModuleMapType( 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(HD_ModuleMapType), 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 = 'HydroDyn_UnPackHD_ModuleMapType' - ! 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 - 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_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 - - 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 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 - - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE HydroDyn_UnPackHD_ModuleMapType - - SUBROUTINE HydroDyn_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(HydroDyn_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyContState' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%OutRootName = SrcInitInputData%OutRootName + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%WtrDens = SrcInitInputData%WtrDens + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%TMax = SrcInitInputData%TMax + DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX + DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY + DstInitInputData%NStepWave = SrcInitInputData%NStepWave + DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 + DstInitInputData%RhoXg = SrcInitInputData%RhoXg + DstInitInputData%WaveMod = SrcInitInputData%WaveMod + DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod + DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod + DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff + DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff + DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD + DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD + DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS + DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS + DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn + if (allocated(SrcInitInputData%WaveElev0)) then + LB(1:1) = lbound(SrcInitInputData%WaveElev0) + UB(1:1) = ubound(SrcInitInputData%WaveElev0) + if (.not. allocated(DstInitInputData%WaveElev0)) then + allocate(DstInitInputData%WaveElev0(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitInputData%WaveElevC)) then + LB(1:3) = lbound(SrcInitInputData%WaveElevC) + UB(1:3) = ubound(SrcInitInputData%WaveElevC) + if (.not. allocated(DstInitInputData%WaveElevC)) then + allocate(DstInitInputData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), 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 + end if + DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin + DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax + DstInitInputData%WaveDir = SrcInitInputData%WaveDir + DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir + DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega + DstInitInputData%MCFD = SrcInitInputData%MCFD + DstInitInputData%WaveField => SrcInitInputData%WaveField +end subroutine + +subroutine HydroDyn_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(HydroDyn_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%WAMIT)) THEN - i1_l = LBOUND(SrcContStateData%WAMIT,1) - i1_u = UBOUND(SrcContStateData%WAMIT,1) - IF (.NOT. ALLOCATED(DstContStateData%WAMIT)) THEN - ALLOCATE(DstContStateData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%WAMIT,1), UBOUND(SrcContStateData%WAMIT,1) - CALL WAMIT_CopyContState( SrcContStateData%WAMIT(i1), DstContStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Morison_CopyContState( SrcContStateData%Morison, DstContStateData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyContState - - SUBROUTINE HydroDyn_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(HydroDyn_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 = 'HydroDyn_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%WAMIT)) THEN -DO i1 = LBOUND(ContStateData%WAMIT,1), UBOUND(ContStateData%WAMIT,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyContState - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 - Int_BufSz = Int_BufSz + 1 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - 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 - - IF ( .NOT. ALLOCATED(InData%WAMIT) ) 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%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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 - CALL Morison_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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_PackContState - - SUBROUTINE HydroDyn_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(HydroDyn_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT 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%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,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 WAMIT_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - 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 - 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_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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_UnPackContState - - SUBROUTINE HydroDyn_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(HydroDyn_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyDiscState' -! + ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitInputData%WaveElev0)) then + deallocate(InitInputData%WaveElev0) + end if + if (allocated(InitInputData%WaveElevC)) then + deallocate(InitInputData%WaveElevC) + end if + nullify(InitInputData%WaveField) +end subroutine + +subroutine HydroDyn_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackInitInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) + call RegPack(Buf, InData%OutRootName) + call RegPack(Buf, InData%Linearize) + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%WtrDens) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%MSL2SWL) + call RegPack(Buf, InData%TMax) + call RegPack(Buf, InData%PtfmLocationX) + call RegPack(Buf, InData%PtfmLocationY) + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, InData%NStepWave2) + call RegPack(Buf, InData%RhoXg) + call RegPack(Buf, InData%WaveMod) + call RegPack(Buf, InData%WaveStMod) + call RegPack(Buf, InData%WaveDirMod) + call RegPack(Buf, InData%WvLowCOff) + call RegPack(Buf, InData%WvHiCOff) + call RegPack(Buf, InData%WvLowCOffD) + call RegPack(Buf, InData%WvHiCOffD) + call RegPack(Buf, InData%WvLowCOffS) + call RegPack(Buf, InData%WvHiCOffS) + call RegPack(Buf, InData%InvalidWithSSExctn) + call RegPack(Buf, allocated(InData%WaveElev0)) + if (allocated(InData%WaveElev0)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) + call RegPack(Buf, InData%WaveElev0) + end if + call RegPack(Buf, allocated(InData%WaveElevC)) + if (allocated(InData%WaveElevC)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) + call RegPack(Buf, InData%WaveElevC) + end if + call RegPack(Buf, InData%WaveDirMin) + call RegPack(Buf, InData%WaveDirMax) + call RegPack(Buf, InData%WaveDir) + call RegPack(Buf, InData%WaveMultiDir) + call RegPack(Buf, InData%WaveDOmega) + call RegPack(Buf, InData%MCFD) + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData + call RegUnpack(Buf, OutData%OutRootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmLocationX) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmLocationY) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RhoXg) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDirMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOffD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOffD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOffS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InvalidWithSSExctn) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevC) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MCFD) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if +end subroutine + +subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_InitOutputType), intent(in) :: SrcInitOutputData + type(HydroDyn_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%WAMIT)) THEN - i1_l = LBOUND(SrcDiscStateData%WAMIT,1) - i1_u = UBOUND(SrcDiscStateData%WAMIT,1) - IF (.NOT. ALLOCATED(DstDiscStateData%WAMIT)) THEN - ALLOCATE(DstDiscStateData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%WAMIT,1), UBOUND(SrcDiscStateData%WAMIT,1) - CALL WAMIT_CopyDiscState( SrcDiscStateData%WAMIT(i1), DstDiscStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Morison_CopyDiscState( SrcDiscStateData%Morison, DstDiscStateData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyDiscState - - SUBROUTINE HydroDyn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(HydroDyn_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 = 'HydroDyn_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%WAMIT)) THEN -DO i1 = LBOUND(DiscStateData%WAMIT,1), UBOUND(DiscStateData%WAMIT,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyDiscState - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 - Int_BufSz = Int_BufSz + 1 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - 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 - - IF ( .NOT. ALLOCATED(InData%WAMIT) ) 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%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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 - CALL Morison_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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_PackDiscState - - SUBROUTINE HydroDyn_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(HydroDyn_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT 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%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,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 WAMIT_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - 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 - 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_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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_UnPackDiscState - - SUBROUTINE HydroDyn_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(HydroDyn_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 = 'HydroDyn_CopyConstrState' -! + ErrMsg = '' + call Morison_CopyInitOutput(SrcInitOutputData%Morison, DstInitOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + end if +end subroutine + +subroutine HydroDyn_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(HydroDyn_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL WAMIT_CopyConstrState( SrcConstrStateData%WAMIT, DstConstrStateData%WAMIT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Morison_CopyConstrState( SrcConstrStateData%Morison, DstConstrStateData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyConstrState - - SUBROUTINE HydroDyn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(HydroDyn_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 = 'HydroDyn_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL WAMIT_DestroyConstrState( ConstrStateData%WAMIT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Morison_DestroyConstrState( ConstrStateData%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyConstrState - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - 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 - - CALL WAMIT_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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 - CALL Morison_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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_PackConstrState - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 - 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 WAMIT_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT, ErrStat2, ErrMsg2 ) ! WAMIT - 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) - 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_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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_UnPackConstrState - - SUBROUTINE HydroDyn_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(HydroDyn_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyOtherState' -! + ErrMsg = '' + call Morison_DestroyInitOutput(InitOutputData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + 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) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if +end subroutine + +subroutine HydroDyn_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call Morison_PackInitOutput(Buf, InData%Morison) + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call Morison_UnpackInitOutput(Buf, OutData%Morison) ! Morison + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine HydroDyn_CopyHD_ModuleMapType(SrcHD_ModuleMapTypeData, DstHD_ModuleMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(HD_ModuleMapType), intent(inout) :: SrcHD_ModuleMapTypeData + type(HD_ModuleMapType), intent(inout) :: DstHD_ModuleMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyHD_ModuleMapType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%WAMIT)) THEN - i1_l = LBOUND(SrcOtherStateData%WAMIT,1) - i1_u = UBOUND(SrcOtherStateData%WAMIT,1) - IF (.NOT. ALLOCATED(DstOtherStateData%WAMIT)) THEN - ALLOCATE(DstOtherStateData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%WAMIT,1), UBOUND(SrcOtherStateData%WAMIT,1) - CALL WAMIT_CopyOtherState( SrcOtherStateData%WAMIT(i1), DstOtherStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Morison_CopyOtherState( SrcOtherStateData%Morison, DstOtherStateData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyOtherState - - SUBROUTINE HydroDyn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(HydroDyn_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 = 'HydroDyn_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%WAMIT)) THEN -DO i1 = LBOUND(OtherStateData%WAMIT,1), UBOUND(OtherStateData%WAMIT,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyOtherState - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - 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 - - IF ( .NOT. ALLOCATED(InData%WAMIT) ) 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%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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 - CALL Morison_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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_PackOtherState - - SUBROUTINE HydroDyn_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(HydroDyn_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT 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%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,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 WAMIT_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - 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 - 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_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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_UnPackOtherState - - SUBROUTINE HydroDyn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(HydroDyn_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyMisc' -! + ErrMsg = '' + call NWTC_Library_CopyMeshMapType(SrcHD_ModuleMapTypeData%uW_P_2_PRP_P, DstHD_ModuleMapTypeData%uW_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcHD_ModuleMapTypeData%W_P_2_PRP_P, DstHD_ModuleMapTypeData%W_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcHD_ModuleMapTypeData%M_P_2_PRP_P, DstHD_ModuleMapTypeData%M_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine HydroDyn_DestroyHD_ModuleMapType(HD_ModuleMapTypeData, ErrStat, ErrMsg) + type(HD_ModuleMapType), intent(inout) :: HD_ModuleMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyHD_ModuleMapType' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcMiscData%AllHdroOrigin, DstMiscData%AllHdroOrigin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_Copyhd_modulemaptype( SrcMiscData%HD_MeshMap, DstMiscData%HD_MeshMap, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%Decimate = SrcMiscData%Decimate - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%LastIndWave = SrcMiscData%LastIndWave -IF (ALLOCATED(SrcMiscData%F_PtfmAdd)) THEN - i1_l = LBOUND(SrcMiscData%F_PtfmAdd,1) - i1_u = UBOUND(SrcMiscData%F_PtfmAdd,1) - IF (.NOT. ALLOCATED(DstMiscData%F_PtfmAdd)) THEN - ALLOCATE(DstMiscData%F_PtfmAdd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAdd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_PtfmAdd = SrcMiscData%F_PtfmAdd -ENDIF - DstMiscData%F_Hydro = SrcMiscData%F_Hydro -IF (ALLOCATED(SrcMiscData%F_Waves)) THEN - i1_l = LBOUND(SrcMiscData%F_Waves,1) - i1_u = UBOUND(SrcMiscData%F_Waves,1) - IF (.NOT. ALLOCATED(DstMiscData%F_Waves)) THEN - ALLOCATE(DstMiscData%F_Waves(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Waves = SrcMiscData%F_Waves -ENDIF -IF (ALLOCATED(SrcMiscData%WAMIT)) THEN - i1_l = LBOUND(SrcMiscData%WAMIT,1) - i1_u = UBOUND(SrcMiscData%WAMIT,1) - IF (.NOT. ALLOCATED(DstMiscData%WAMIT)) THEN - ALLOCATE(DstMiscData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%WAMIT,1), UBOUND(SrcMiscData%WAMIT,1) - CALL WAMIT_CopyMisc( SrcMiscData%WAMIT(i1), DstMiscData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%WAMIT2)) THEN - i1_l = LBOUND(SrcMiscData%WAMIT2,1) - i1_u = UBOUND(SrcMiscData%WAMIT2,1) - IF (.NOT. ALLOCATED(DstMiscData%WAMIT2)) THEN - ALLOCATE(DstMiscData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%WAMIT2,1), UBOUND(SrcMiscData%WAMIT2,1) - CALL WAMIT2_CopyMisc( SrcMiscData%WAMIT2(i1), DstMiscData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Morison_CopyMisc( SrcMiscData%Morison, DstMiscData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%u_WAMIT)) THEN - i1_l = LBOUND(SrcMiscData%u_WAMIT,1) - i1_u = UBOUND(SrcMiscData%u_WAMIT,1) - IF (.NOT. ALLOCATED(DstMiscData%u_WAMIT)) THEN - ALLOCATE(DstMiscData%u_WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%u_WAMIT,1), UBOUND(SrcMiscData%u_WAMIT,1) - CALL WAMIT_CopyInput( SrcMiscData%u_WAMIT(i1), DstMiscData%u_WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE HydroDyn_CopyMisc - - SUBROUTINE HydroDyn_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(HydroDyn_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 = 'HydroDyn_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( MiscData%AllHdroOrigin, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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) -ENDIF -IF (ALLOCATED(MiscData%F_Waves)) THEN - DEALLOCATE(MiscData%F_Waves) -ENDIF -IF (ALLOCATED(MiscData%WAMIT)) THEN -DO i1 = LBOUND(MiscData%WAMIT,1), UBOUND(MiscData%WAMIT,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%WAMIT2) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%u_WAMIT) -ENDIF - END SUBROUTINE HydroDyn_DestroyMisc - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AllHdroOrigin: size of buffers for each call to pack subtype - CALL MeshPack( InData%AllHdroOrigin, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! AllHdroOrigin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AllHdroOrigin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AllHdroOrigin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AllHdroOrigin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HD_MeshMap - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_MeshMap - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_MeshMap - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Decimate - Db_BufSz = Db_BufSz + 1 ! LastOutTime - Int_BufSz = Int_BufSz + 1 ! LastIndWave - Int_BufSz = Int_BufSz + 1 ! F_PtfmAdd allocated yes/no - IF ( ALLOCATED(InData%F_PtfmAdd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_PtfmAdd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_PtfmAdd) ! F_PtfmAdd - END IF - Re_BufSz = Re_BufSz + SIZE(InData%F_Hydro) ! F_Hydro - Int_BufSz = Int_BufSz + 1 ! F_Waves allocated yes/no - IF ( ALLOCATED(InData%F_Waves) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_Waves upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Waves) ! F_Waves - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2 allocated yes/no - IF ( ALLOCATED(InData%WAMIT2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! u_WAMIT allocated yes/no - IF ( ALLOCATED(InData%u_WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_WAMIT upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_WAMIT,1), UBOUND(InData%u_WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! u_WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - - CALL MeshPack( InData%AllHdroOrigin, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! AllHdroOrigin - 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 - 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 - - 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%Decimate - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%F_PtfmAdd) ) 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%F_PtfmAdd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_PtfmAdd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_PtfmAdd,1), UBOUND(InData%F_PtfmAdd,1) - ReKiBuf(Re_Xferred) = InData%F_PtfmAdd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%F_Hydro,1), UBOUND(InData%F_Hydro,1) - ReKiBuf(Re_Xferred) = InData%F_Hydro(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%F_Waves) ) 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%F_Waves,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Waves,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_Waves,1), UBOUND(InData%F_Waves,1) - ReKiBuf(Re_Xferred) = InData%F_Waves(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WAMIT) ) 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%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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 - IF ( .NOT. ALLOCATED(InData%WAMIT2) ) 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%WAMIT2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - CALL WAMIT2_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - 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 - CALL Morison_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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 - IF ( .NOT. ALLOCATED(InData%u_WAMIT) ) 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%u_WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_WAMIT,1), UBOUND(InData%u_WAMIT,1) - CALL WAMIT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_WAMIT - 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 - END SUBROUTINE HydroDyn_PackMisc - - SUBROUTINE HydroDyn_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(HydroDyn_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_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 - 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 MeshUnpack( OutData%AllHdroOrigin, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! AllHdroOrigin - 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) - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Decimate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LastOutTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_PtfmAdd 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%F_PtfmAdd)) DEALLOCATE(OutData%F_PtfmAdd) - ALLOCATE(OutData%F_PtfmAdd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_PtfmAdd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_PtfmAdd,1), UBOUND(OutData%F_PtfmAdd,1) - OutData%F_PtfmAdd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%F_Hydro,1) - i1_u = UBOUND(OutData%F_Hydro,1) - DO i1 = LBOUND(OutData%F_Hydro,1), UBOUND(OutData%F_Hydro,1) - OutData%F_Hydro(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Waves 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%F_Waves)) DEALLOCATE(OutData%F_Waves) - ALLOCATE(OutData%F_Waves(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_Waves,1), UBOUND(OutData%F_Waves,1) - OutData%F_Waves(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT 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%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,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 WAMIT_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - 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 ! WAMIT2 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%WAMIT2)) DEALLOCATE(OutData%WAMIT2) - ALLOCATE(OutData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT2,1), UBOUND(OutData%WAMIT2,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 WAMIT2_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2(i1), ErrStat2, ErrMsg2 ) ! WAMIT2 - 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 - 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_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_WAMIT 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%u_WAMIT)) DEALLOCATE(OutData%u_WAMIT) - ALLOCATE(OutData%u_WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_WAMIT,1), UBOUND(OutData%u_WAMIT,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 WAMIT_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_WAMIT(i1), ErrStat2, ErrMsg2 ) ! u_WAMIT - 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 - END SUBROUTINE HydroDyn_UnPackMisc - - SUBROUTINE HydroDyn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_ParameterType), INTENT(IN) :: SrcParamData - TYPE(HydroDyn_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyParam' -! + ErrMsg = '' + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(HD_ModuleMapTypeData%M_P_2_PRP_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine HydroDyn_PackHD_ModuleMapType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HD_ModuleMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackHD_ModuleMapType' + if (Buf%ErrStat >= AbortErrLev) return + call NWTC_Library_PackMeshMapType(Buf, InData%uW_P_2_PRP_P) + call NWTC_Library_PackMeshMapType(Buf, InData%W_P_2_PRP_P) + call NWTC_Library_PackMeshMapType(Buf, InData%M_P_2_PRP_P) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackHD_ModuleMapType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HD_ModuleMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackHD_ModuleMapType' + if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackMeshMapType(Buf, OutData%uW_P_2_PRP_P) ! uW_P_2_PRP_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%W_P_2_PRP_P) ! W_P_2_PRP_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%M_P_2_PRP_P) ! M_P_2_PRP_P +end subroutine + +subroutine HydroDyn_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_ContinuousStateType), intent(in) :: SrcContStateData + type(HydroDyn_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%nWAMITObj = SrcParamData%nWAMITObj - DstParamData%vecMultiplier = SrcParamData%vecMultiplier -IF (ALLOCATED(SrcParamData%WAMIT)) THEN - i1_l = LBOUND(SrcParamData%WAMIT,1) - i1_u = UBOUND(SrcParamData%WAMIT,1) - IF (.NOT. ALLOCATED(DstParamData%WAMIT)) THEN - ALLOCATE(DstParamData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%WAMIT,1), UBOUND(SrcParamData%WAMIT,1) - CALL WAMIT_CopyParam( SrcParamData%WAMIT(i1), DstParamData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%WAMIT2)) THEN - i1_l = LBOUND(SrcParamData%WAMIT2,1) - i1_u = UBOUND(SrcParamData%WAMIT2,1) - IF (.NOT. ALLOCATED(DstParamData%WAMIT2)) THEN - ALLOCATE(DstParamData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%WAMIT2,1), UBOUND(SrcParamData%WAMIT2,1) - CALL WAMIT2_CopyParam( SrcParamData%WAMIT2(i1), DstParamData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%WAMIT2used = SrcParamData%WAMIT2used - CALL Morison_CopyParam( SrcParamData%Morison, DstParamData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%PotMod = SrcParamData%PotMod - DstParamData%NBody = SrcParamData%NBody - DstParamData%NBodyMod = SrcParamData%NBodyMod - DstParamData%totalStates = SrcParamData%totalStates - DstParamData%totalExctnStates = SrcParamData%totalExctnStates - DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates - DstParamData%WaveTime => SrcParamData%WaveTime - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%WtrDpth = SrcParamData%WtrDpth -IF (ALLOCATED(SrcParamData%AddF0)) THEN - i1_l = LBOUND(SrcParamData%AddF0,1) - i1_u = UBOUND(SrcParamData%AddF0,1) - i2_l = LBOUND(SrcParamData%AddF0,2) - i2_u = UBOUND(SrcParamData%AddF0,2) - IF (.NOT. ALLOCATED(DstParamData%AddF0)) THEN - ALLOCATE(DstParamData%AddF0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AddF0 = SrcParamData%AddF0 -ENDIF -IF (ALLOCATED(SrcParamData%AddCLin)) THEN - i1_l = LBOUND(SrcParamData%AddCLin,1) - i1_u = UBOUND(SrcParamData%AddCLin,1) - i2_l = LBOUND(SrcParamData%AddCLin,2) - i2_u = UBOUND(SrcParamData%AddCLin,2) - i3_l = LBOUND(SrcParamData%AddCLin,3) - i3_u = UBOUND(SrcParamData%AddCLin,3) - IF (.NOT. ALLOCATED(DstParamData%AddCLin)) THEN - ALLOCATE(DstParamData%AddCLin(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%AddCLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AddCLin = SrcParamData%AddCLin -ENDIF -IF (ALLOCATED(SrcParamData%AddBLin)) THEN - i1_l = LBOUND(SrcParamData%AddBLin,1) - i1_u = UBOUND(SrcParamData%AddBLin,1) - i2_l = LBOUND(SrcParamData%AddBLin,2) - i2_u = UBOUND(SrcParamData%AddBLin,2) - i3_l = LBOUND(SrcParamData%AddBLin,3) - i3_u = UBOUND(SrcParamData%AddBLin,3) - IF (.NOT. ALLOCATED(DstParamData%AddBLin)) THEN - ALLOCATE(DstParamData%AddBLin(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%AddBLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AddBLin = SrcParamData%AddBLin -ENDIF -IF (ALLOCATED(SrcParamData%AddBQuad)) THEN - i1_l = LBOUND(SrcParamData%AddBQuad,1) - i1_u = UBOUND(SrcParamData%AddBQuad,1) - i2_l = LBOUND(SrcParamData%AddBQuad,2) - i2_u = UBOUND(SrcParamData%AddBQuad,2) - i3_l = LBOUND(SrcParamData%AddBQuad,3) - i3_u = UBOUND(SrcParamData%AddBQuad,3) - IF (.NOT. ALLOCATED(DstParamData%AddBQuad)) THEN - ALLOCATE(DstParamData%AddBQuad(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%AddBQuad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AddBQuad = SrcParamData%AddBQuad -ENDIF - DstParamData%DT = SrcParamData%DT -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%NumTotalOuts = SrcParamData%NumTotalOuts - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - DstParamData%Delim = SrcParamData%Delim - DstParamData%UnOutFile = SrcParamData%UnOutFile - DstParamData%OutDec = SrcParamData%OutDec -IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_u_indx,1) - i1_u = UBOUND(SrcParamData%Jac_u_indx,1) - i2_l = LBOUND(SrcParamData%Jac_u_indx,2) - i2_u = UBOUND(SrcParamData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN - ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcParamData%du)) THEN - i1_l = LBOUND(SrcParamData%du,1) - i1_u = UBOUND(SrcParamData%du,1) - IF (.NOT. ALLOCATED(DstParamData%du)) THEN - ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%du = SrcParamData%du -ENDIF -IF (ALLOCATED(SrcParamData%dx)) THEN - i1_l = LBOUND(SrcParamData%dx,1) - i1_u = UBOUND(SrcParamData%dx,1) - IF (.NOT. ALLOCATED(DstParamData%dx)) THEN - ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dx = SrcParamData%dx -ENDIF - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%PointsToSeaState = SrcParamData%PointsToSeaState - END SUBROUTINE HydroDyn_CopyParam - - SUBROUTINE HydroDyn_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(HydroDyn_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 = 'HydroDyn_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%WAMIT)) THEN -DO i1 = LBOUND(ParamData%WAMIT,1), UBOUND(ParamData%WAMIT,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%WAMIT2) -ENDIF - CALL Morison_DestroyParam( ParamData%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -NULLIFY(ParamData%WaveTime) -IF (ALLOCATED(ParamData%AddF0)) THEN - DEALLOCATE(ParamData%AddF0) -ENDIF -IF (ALLOCATED(ParamData%AddCLin)) THEN - DEALLOCATE(ParamData%AddCLin) -ENDIF -IF (ALLOCATED(ParamData%AddBLin)) THEN - DEALLOCATE(ParamData%AddBLin) -ENDIF -IF (ALLOCATED(ParamData%AddBQuad)) THEN - DEALLOCATE(ParamData%AddBQuad) -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 -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF -IF (ALLOCATED(ParamData%dx)) THEN - DEALLOCATE(ParamData%dx) -ENDIF - END SUBROUTINE HydroDyn_DestroyParam - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 - Int_BufSz = Int_BufSz + 1 ! nWAMITObj - Int_BufSz = Int_BufSz + 1 ! vecMultiplier - Int_BufSz = Int_BufSz + 1 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2 allocated yes/no - IF ( ALLOCATED(InData%WAMIT2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2used - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! PotMod - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Int_BufSz = Int_BufSz + 1 ! totalStates - Int_BufSz = Int_BufSz + 1 ! totalExctnStates - Int_BufSz = Int_BufSz + 1 ! totalRdtnStates - Int_BufSz = Int_BufSz + 1 ! NStepWave - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! AddF0 allocated yes/no - IF ( ALLOCATED(InData%AddF0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AddF0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddF0) ! AddF0 - END IF - Int_BufSz = Int_BufSz + 1 ! AddCLin allocated yes/no - IF ( ALLOCATED(InData%AddCLin) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddCLin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddCLin) ! AddCLin - END IF - Int_BufSz = Int_BufSz + 1 ! AddBLin allocated yes/no - IF ( ALLOCATED(InData%AddBLin) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddBLin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddBLin) ! AddBLin - END IF - Int_BufSz = Int_BufSz + 1 ! AddBQuad allocated yes/no - IF ( ALLOCATED(InData%AddBQuad) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddBQuad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddBQuad) ! AddBQuad - END IF - Db_BufSz = Db_BufSz + 1 ! DT - 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 - 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 ! NumTotalOuts - Int_BufSz = Int_BufSz + 1 ! OutSwtch - 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 - Int_BufSz = Int_BufSz + 1 ! OutDec - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%du) ! du - END IF - Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no - IF ( ALLOCATED(InData%dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! PointsToSeaState - 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%nWAMITObj - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%vecMultiplier - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WAMIT) ) 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%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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 - IF ( .NOT. ALLOCATED(InData%WAMIT2) ) 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%WAMIT2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - CALL WAMIT2_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - 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) = TRANSFER(InData%WAMIT2used, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL Morison_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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%PotMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%totalStates - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%totalExctnStates - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%totalRdtnStates - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AddF0) ) 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%AddF0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddF0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddF0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddF0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AddF0,2), UBOUND(InData%AddF0,2) - DO i1 = LBOUND(InData%AddF0,1), UBOUND(InData%AddF0,1) - ReKiBuf(Re_Xferred) = InData%AddF0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddCLin) ) 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%AddCLin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddCLin,3), UBOUND(InData%AddCLin,3) - DO i2 = LBOUND(InData%AddCLin,2), UBOUND(InData%AddCLin,2) - DO i1 = LBOUND(InData%AddCLin,1), UBOUND(InData%AddCLin,1) - ReKiBuf(Re_Xferred) = InData%AddCLin(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddBLin) ) 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%AddBLin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddBLin,3), UBOUND(InData%AddBLin,3) - DO i2 = LBOUND(InData%AddBLin,2), UBOUND(InData%AddBLin,2) - DO i1 = LBOUND(InData%AddBLin,1), UBOUND(InData%AddBLin,1) - ReKiBuf(Re_Xferred) = InData%AddBLin(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddBQuad) ) 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%AddBQuad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddBQuad,3), UBOUND(InData%AddBQuad,3) - DO i2 = LBOUND(InData%AddBQuad,2), UBOUND(InData%AddBQuad,2) - DO i1 = LBOUND(InData%AddBQuad,1), UBOUND(InData%AddBQuad,1) - ReKiBuf(Re_Xferred) = InData%AddBQuad(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - 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%NumTotalOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutSwtch - 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 - IntKiBuf(Int_Xferred) = InData%OutDec - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) 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%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%du) ) 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%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - DbKiBuf(Db_Xferred) = InData%du(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dx) ) 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%dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - DbKiBuf(Db_Xferred) = InData%dx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PointsToSeaState, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE HydroDyn_PackParam - - SUBROUTINE HydroDyn_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(HydroDyn_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_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%nWAMITObj = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%vecMultiplier = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT 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%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,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 WAMIT_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - 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 ! WAMIT2 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%WAMIT2)) DEALLOCATE(OutData%WAMIT2) - ALLOCATE(OutData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT2,1), UBOUND(OutData%WAMIT2,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 WAMIT2_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2(i1), ErrStat2, ErrMsg2 ) ! WAMIT2 - 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%WAMIT2used = TRANSFER(IntKiBuf(Int_Xferred), OutData%WAMIT2used) - 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 Morison_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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%PotMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%totalStates = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%totalExctnStates = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%totalRdtnStates = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - NULLIFY(OutData%WaveTime) - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddF0 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%AddF0)) DEALLOCATE(OutData%AddF0) - ALLOCATE(OutData%AddF0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AddF0,2), UBOUND(OutData%AddF0,2) - DO i1 = LBOUND(OutData%AddF0,1), UBOUND(OutData%AddF0,1) - OutData%AddF0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddCLin 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%AddCLin)) DEALLOCATE(OutData%AddCLin) - ALLOCATE(OutData%AddCLin(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%AddCLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddCLin,3), UBOUND(OutData%AddCLin,3) - DO i2 = LBOUND(OutData%AddCLin,2), UBOUND(OutData%AddCLin,2) - DO i1 = LBOUND(OutData%AddCLin,1), UBOUND(OutData%AddCLin,1) - OutData%AddCLin(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddBLin 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%AddBLin)) DEALLOCATE(OutData%AddBLin) - ALLOCATE(OutData%AddBLin(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%AddBLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddBLin,3), UBOUND(OutData%AddBLin,3) - DO i2 = LBOUND(OutData%AddBLin,2), UBOUND(OutData%AddBLin,2) - DO i1 = LBOUND(OutData%AddBLin,1), UBOUND(OutData%AddBLin,1) - OutData%AddBLin(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddBQuad 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%AddBQuad)) DEALLOCATE(OutData%AddBQuad) - ALLOCATE(OutData%AddBQuad(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%AddBQuad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddBQuad,3), UBOUND(OutData%AddBQuad,3) - DO i2 = LBOUND(OutData%AddBQuad,2), UBOUND(OutData%AddBQuad,2) - DO i1 = LBOUND(OutData%AddBQuad,1), UBOUND(OutData%AddBQuad,1) - OutData%AddBQuad(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - 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%NumTotalOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = 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 - OutData%OutDec = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx 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%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du 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%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx 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%dx)) DEALLOCATE(OutData%dx) - ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PointsToSeaState = TRANSFER(IntKiBuf(Int_Xferred), OutData%PointsToSeaState) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE HydroDyn_UnPackParam - - SUBROUTINE HydroDyn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_InputType), INTENT(INOUT) :: SrcInputData - TYPE(HydroDyn_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 = 'HydroDyn_CopyInput' -! + ErrMsg = '' + if (allocated(SrcContStateData%WAMIT)) then + LB(1:1) = lbound(SrcContStateData%WAMIT) + UB(1:1) = ubound(SrcContStateData%WAMIT) + if (.not. allocated(DstContStateData%WAMIT)) then + allocate(DstContStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyContState(SrcContStateData%WAMIT(i1), DstContStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Morison_CopyContState(SrcContStateData%Morison, DstContStateData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine HydroDyn_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(HydroDyn_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL Morison_CopyInput( SrcInputData%Morison, DstInputData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%WAMITMesh, DstInputData%WAMITMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%PRPMesh, DstInputData%PRPMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyInput - - SUBROUTINE HydroDyn_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(HydroDyn_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 = 'HydroDyn_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - 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) - CALL MeshDestroy( InputData%PRPMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyInput - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! WAMITMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WAMITMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMITMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMITMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMITMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! PRPMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PRPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PRPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PRPMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PRPMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PRPMesh - 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 - - CALL Morison_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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 - CALL MeshPack( InData%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WAMITMesh - 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 - CALL MeshPack( InData%PRPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PRPMesh - 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_PackInput - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 - 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_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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) - 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 MeshUnpack( OutData%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WAMITMesh - 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) - 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 MeshUnpack( OutData%PRPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PRPMesh - 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_UnPackInput - - SUBROUTINE HydroDyn_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(HydroDyn_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 = 'HydroDyn_CopyOutput' -! + ErrMsg = '' + if (allocated(ContStateData%WAMIT)) then + LB(1:1) = lbound(ContStateData%WAMIT) + UB(1:1) = ubound(ContStateData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyContState(ContStateData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%WAMIT) + end if + call Morison_DestroyContState(ContStateData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine HydroDyn_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackContState(Buf, InData%WAMIT(i1)) + end do + end if + call Morison_PackContState(Buf, InData%Morison) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackContState(Buf, OutData%WAMIT(i1)) ! WAMIT + end do + end if + call Morison_UnpackContState(Buf, OutData%Morison) ! Morison +end subroutine + +subroutine HydroDyn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_DiscreteStateType), intent(in) :: SrcDiscStateData + type(HydroDyn_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%WAMIT)) THEN - i1_l = LBOUND(SrcOutputData%WAMIT,1) - i1_u = UBOUND(SrcOutputData%WAMIT,1) - IF (.NOT. ALLOCATED(DstOutputData%WAMIT)) THEN - ALLOCATE(DstOutputData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%WAMIT,1), UBOUND(SrcOutputData%WAMIT,1) - CALL WAMIT_CopyOutput( SrcOutputData%WAMIT(i1), DstOutputData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%WAMIT2)) THEN - i1_l = LBOUND(SrcOutputData%WAMIT2,1) - i1_u = UBOUND(SrcOutputData%WAMIT2,1) - IF (.NOT. ALLOCATED(DstOutputData%WAMIT2)) THEN - ALLOCATE(DstOutputData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%WAMIT2,1), UBOUND(SrcOutputData%WAMIT2,1) - CALL WAMIT2_CopyOutput( SrcOutputData%WAMIT2(i1), DstOutputData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Morison_CopyOutput( SrcOutputData%Morison, DstOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%WAMITMesh, DstOutputData%WAMITMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -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 HydroDyn_CopyOutput - - SUBROUTINE HydroDyn_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(HydroDyn_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 = 'HydroDyn_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%WAMIT)) THEN -DO i1 = LBOUND(OutputData%WAMIT,1), UBOUND(OutputData%WAMIT,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%WAMIT2) -ENDIF - 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) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE HydroDyn_DestroyOutput - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2 allocated yes/no - IF ( ALLOCATED(InData%WAMIT2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! WAMITMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WAMITMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMITMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMITMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMITMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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%WAMIT) ) 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%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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 - IF ( .NOT. ALLOCATED(InData%WAMIT2) ) 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%WAMIT2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - CALL WAMIT2_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - 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 - CALL Morison_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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 - CALL MeshPack( InData%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WAMITMesh - 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 - 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 HydroDyn_PackOutput - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! WAMIT 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%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,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 WAMIT_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - 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 ! WAMIT2 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%WAMIT2)) DEALLOCATE(OutData%WAMIT2) - ALLOCATE(OutData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT2,1), UBOUND(OutData%WAMIT2,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 WAMIT2_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2(i1), ErrStat2, ErrMsg2 ) ! WAMIT2 - 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 - 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_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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) - 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 MeshUnpack( OutData%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WAMITMesh - 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) - 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 HydroDyn_UnPackOutput - - - SUBROUTINE HydroDyn_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(HydroDyn_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(HydroDyn_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 + ErrMsg = '' + if (allocated(SrcDiscStateData%WAMIT)) then + LB(1:1) = lbound(SrcDiscStateData%WAMIT) + UB(1:1) = ubound(SrcDiscStateData%WAMIT) + if (.not. allocated(DstDiscStateData%WAMIT)) then + allocate(DstDiscStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyDiscState(SrcDiscStateData%WAMIT(i1), DstDiscStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Morison_CopyDiscState(SrcDiscStateData%Morison, DstDiscStateData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine HydroDyn_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(HydroDyn_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%WAMIT)) then + LB(1:1) = lbound(DiscStateData%WAMIT) + UB(1:1) = ubound(DiscStateData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyDiscState(DiscStateData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%WAMIT) + end if + call Morison_DestroyDiscState(DiscStateData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine HydroDyn_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackDiscState(Buf, InData%WAMIT(i1)) + end do + end if + call Morison_PackDiscState(Buf, InData%Morison) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackDiscState(Buf, OutData%WAMIT(i1)) ! WAMIT + end do + end if + call Morison_UnpackDiscState(Buf, OutData%Morison) ! Morison +end subroutine + +subroutine HydroDyn_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_ConstraintStateType), intent(in) :: SrcConstrStateData + type(HydroDyn_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + call WAMIT_CopyConstrState(SrcConstrStateData%WAMIT, DstConstrStateData%WAMIT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Morison_CopyConstrState(SrcConstrStateData%Morison, DstConstrStateData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine HydroDyn_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(HydroDyn_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + call WAMIT_DestroyConstrState(ConstrStateData%WAMIT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Morison_DestroyConstrState(ConstrStateData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine HydroDyn_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call WAMIT_PackConstrState(Buf, InData%WAMIT) + call Morison_PackConstrState(Buf, InData%Morison) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call WAMIT_UnpackConstrState(Buf, OutData%WAMIT) ! WAMIT + call Morison_UnpackConstrState(Buf, OutData%Morison) ! Morison +end subroutine + +subroutine HydroDyn_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_OtherStateType), intent(in) :: SrcOtherStateData + type(HydroDyn_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%WAMIT)) then + LB(1:1) = lbound(SrcOtherStateData%WAMIT) + UB(1:1) = ubound(SrcOtherStateData%WAMIT) + if (.not. allocated(DstOtherStateData%WAMIT)) then + allocate(DstOtherStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyOtherState(SrcOtherStateData%WAMIT(i1), DstOtherStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Morison_CopyOtherState(SrcOtherStateData%Morison, DstOtherStateData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine HydroDyn_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(HydroDyn_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%WAMIT)) then + LB(1:1) = lbound(OtherStateData%WAMIT) + UB(1:1) = ubound(OtherStateData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyOtherState(OtherStateData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%WAMIT) + end if + call Morison_DestroyOtherState(OtherStateData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine HydroDyn_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackOtherState(Buf, InData%WAMIT(i1)) + end do + end if + call Morison_PackOtherState(Buf, InData%Morison) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackOtherState(Buf, OutData%WAMIT(i1)) ! WAMIT + end do + end if + call Morison_UnpackOtherState(Buf, OutData%Morison) ! Morison +end subroutine + +subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_MiscVarType), intent(inout) :: SrcMiscData + type(HydroDyn_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcMiscData%AllHdroOrigin, DstMiscData%AllHdroOrigin, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyHD_ModuleMapType(SrcMiscData%HD_MeshMap, DstMiscData%HD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%Decimate = SrcMiscData%Decimate + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + if (allocated(SrcMiscData%F_PtfmAdd)) then + LB(1:1) = lbound(SrcMiscData%F_PtfmAdd) + UB(1:1) = ubound(SrcMiscData%F_PtfmAdd) + if (.not. allocated(DstMiscData%F_PtfmAdd)) then + allocate(DstMiscData%F_PtfmAdd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAdd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_PtfmAdd = SrcMiscData%F_PtfmAdd + end if + DstMiscData%F_Hydro = SrcMiscData%F_Hydro + if (allocated(SrcMiscData%F_Waves)) then + LB(1:1) = lbound(SrcMiscData%F_Waves) + UB(1:1) = ubound(SrcMiscData%F_Waves) + if (.not. allocated(DstMiscData%F_Waves)) then + allocate(DstMiscData%F_Waves(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Waves = SrcMiscData%F_Waves + end if + if (allocated(SrcMiscData%WAMIT)) then + LB(1:1) = lbound(SrcMiscData%WAMIT) + UB(1:1) = ubound(SrcMiscData%WAMIT) + if (.not. allocated(DstMiscData%WAMIT)) then + allocate(DstMiscData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyMisc(SrcMiscData%WAMIT(i1), DstMiscData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%WAMIT2)) then + LB(1:1) = lbound(SrcMiscData%WAMIT2) + UB(1:1) = ubound(SrcMiscData%WAMIT2) + if (.not. allocated(DstMiscData%WAMIT2)) then + allocate(DstMiscData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT2_CopyMisc(SrcMiscData%WAMIT2(i1), DstMiscData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Morison_CopyMisc(SrcMiscData%Morison, DstMiscData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%u_WAMIT)) then + LB(1:1) = lbound(SrcMiscData%u_WAMIT) + UB(1:1) = ubound(SrcMiscData%u_WAMIT) + if (.not. allocated(DstMiscData%u_WAMIT)) then + allocate(DstMiscData%u_WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyInput(SrcMiscData%u_WAMIT(i1), DstMiscData%u_WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(HydroDyn_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( MiscData%AllHdroOrigin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + end if + if (allocated(MiscData%F_Waves)) then + deallocate(MiscData%F_Waves) + end if + if (allocated(MiscData%WAMIT)) then + LB(1:1) = lbound(MiscData%WAMIT) + UB(1:1) = ubound(MiscData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyMisc(MiscData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%WAMIT) + end if + if (allocated(MiscData%WAMIT2)) then + LB(1:1) = lbound(MiscData%WAMIT2) + UB(1:1) = ubound(MiscData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_DestroyMisc(MiscData%WAMIT2(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%WAMIT2) + end if + call Morison_DestroyMisc(MiscData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%u_WAMIT)) then + LB(1:1) = lbound(MiscData%u_WAMIT) + UB(1:1) = ubound(MiscData%u_WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyInput(MiscData%u_WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%u_WAMIT) + end if +end subroutine + +subroutine HydroDyn_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%AllHdroOrigin) + call HydroDyn_PackHD_ModuleMapType(Buf, InData%HD_MeshMap) + call RegPack(Buf, InData%Decimate) + call RegPack(Buf, InData%LastOutTime) + call RegPack(Buf, InData%LastIndWave) + call RegPack(Buf, allocated(InData%F_PtfmAdd)) + if (allocated(InData%F_PtfmAdd)) then + call RegPackBounds(Buf, 1, lbound(InData%F_PtfmAdd), ubound(InData%F_PtfmAdd)) + call RegPack(Buf, InData%F_PtfmAdd) + end if + call RegPack(Buf, InData%F_Hydro) + call RegPack(Buf, allocated(InData%F_Waves)) + if (allocated(InData%F_Waves)) then + call RegPackBounds(Buf, 1, lbound(InData%F_Waves), ubound(InData%F_Waves)) + call RegPack(Buf, InData%F_Waves) + end if + call RegPack(Buf, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackMisc(Buf, InData%WAMIT(i1)) + end do + end if + call RegPack(Buf, allocated(InData%WAMIT2)) + if (allocated(InData%WAMIT2)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) + LB(1:1) = lbound(InData%WAMIT2) + UB(1:1) = ubound(InData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_PackMisc(Buf, InData%WAMIT2(i1)) + end do + end if + call Morison_PackMisc(Buf, InData%Morison) + call RegPack(Buf, allocated(InData%u_WAMIT)) + if (allocated(InData%u_WAMIT)) then + call RegPackBounds(Buf, 1, lbound(InData%u_WAMIT), ubound(InData%u_WAMIT)) + LB(1:1) = lbound(InData%u_WAMIT) + UB(1:1) = ubound(InData%u_WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackInput(Buf, InData%u_WAMIT(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%AllHdroOrigin) ! AllHdroOrigin + call HydroDyn_UnpackHD_ModuleMapType(Buf, OutData%HD_MeshMap) ! HD_MeshMap + call RegUnpack(Buf, OutData%Decimate) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LastOutTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%F_PtfmAdd)) deallocate(OutData%F_PtfmAdd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_PtfmAdd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_PtfmAdd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_PtfmAdd) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%F_Hydro) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%F_Waves)) deallocate(OutData%F_Waves) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_Waves(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_Waves) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackMisc(Buf, OutData%WAMIT(i1)) ! WAMIT + end do + end if + if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT2_UnpackMisc(Buf, OutData%WAMIT2(i1)) ! WAMIT2 + end do + end if + call Morison_UnpackMisc(Buf, OutData%Morison) ! Morison + if (allocated(OutData%u_WAMIT)) deallocate(OutData%u_WAMIT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackInput(Buf, OutData%u_WAMIT(i1)) ! u_WAMIT + end do + end if +end subroutine + +subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_ParameterType), intent(in) :: SrcParamData + type(HydroDyn_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%nWAMITObj = SrcParamData%nWAMITObj + DstParamData%vecMultiplier = SrcParamData%vecMultiplier + if (allocated(SrcParamData%WAMIT)) then + LB(1:1) = lbound(SrcParamData%WAMIT) + UB(1:1) = ubound(SrcParamData%WAMIT) + if (.not. allocated(DstParamData%WAMIT)) then + allocate(DstParamData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyParam(SrcParamData%WAMIT(i1), DstParamData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%WAMIT2)) then + LB(1:1) = lbound(SrcParamData%WAMIT2) + UB(1:1) = ubound(SrcParamData%WAMIT2) + if (.not. allocated(DstParamData%WAMIT2)) then + allocate(DstParamData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT2_CopyParam(SrcParamData%WAMIT2(i1), DstParamData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%WAMIT2used = SrcParamData%WAMIT2used + call Morison_CopyParam(SrcParamData%Morison, DstParamData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%PotMod = SrcParamData%PotMod + DstParamData%NBody = SrcParamData%NBody + DstParamData%NBodyMod = SrcParamData%NBodyMod + DstParamData%totalStates = SrcParamData%totalStates + DstParamData%totalExctnStates = SrcParamData%totalExctnStates + DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates + DstParamData%WaveTime => SrcParamData%WaveTime + DstParamData%NStepWave = SrcParamData%NStepWave + DstParamData%WtrDpth = SrcParamData%WtrDpth + if (allocated(SrcParamData%AddF0)) then + LB(1:2) = lbound(SrcParamData%AddF0) + UB(1:2) = ubound(SrcParamData%AddF0) + if (.not. allocated(DstParamData%AddF0)) then + allocate(DstParamData%AddF0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddF0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddF0 = SrcParamData%AddF0 + end if + if (allocated(SrcParamData%AddCLin)) then + LB(1:3) = lbound(SrcParamData%AddCLin) + UB(1:3) = ubound(SrcParamData%AddCLin) + if (.not. allocated(DstParamData%AddCLin)) then + allocate(DstParamData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddCLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddCLin = SrcParamData%AddCLin + end if + if (allocated(SrcParamData%AddBLin)) then + LB(1:3) = lbound(SrcParamData%AddBLin) + UB(1:3) = ubound(SrcParamData%AddBLin) + if (.not. allocated(DstParamData%AddBLin)) then + allocate(DstParamData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddBLin = SrcParamData%AddBLin + end if + if (allocated(SrcParamData%AddBQuad)) then + LB(1:3) = lbound(SrcParamData%AddBQuad) + UB(1:3) = ubound(SrcParamData%AddBQuad) + if (.not. allocated(DstParamData%AddBQuad)) then + allocate(DstParamData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBQuad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddBQuad = SrcParamData%AddBQuad + end if + DstParamData%DT = SrcParamData%DT + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumTotalOuts = SrcParamData%NumTotalOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + DstParamData%Delim = SrcParamData%Delim + DstParamData%UnOutFile = SrcParamData%UnOutFile + DstParamData%OutDec = SrcParamData%OutDec + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du + end if + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx + end if + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%PointsToSeaState = SrcParamData%PointsToSeaState +end subroutine + +subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) + type(HydroDyn_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%WAMIT)) then + LB(1:1) = lbound(ParamData%WAMIT) + UB(1:1) = ubound(ParamData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyParam(ParamData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%WAMIT) + end if + if (allocated(ParamData%WAMIT2)) then + LB(1:1) = lbound(ParamData%WAMIT2) + UB(1:1) = ubound(ParamData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_DestroyParam(ParamData%WAMIT2(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%WAMIT2) + end if + call Morison_DestroyParam(ParamData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(ParamData%WaveTime) + if (allocated(ParamData%AddF0)) then + deallocate(ParamData%AddF0) + end if + if (allocated(ParamData%AddCLin)) then + deallocate(ParamData%AddCLin) + end if + if (allocated(ParamData%AddBLin)) then + deallocate(ParamData%AddBLin) + end if + if (allocated(ParamData%AddBQuad)) then + deallocate(ParamData%AddBQuad) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) + end if +end subroutine + +subroutine HydroDyn_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%nWAMITObj) + call RegPack(Buf, InData%vecMultiplier) + call RegPack(Buf, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackParam(Buf, InData%WAMIT(i1)) + end do + end if + call RegPack(Buf, allocated(InData%WAMIT2)) + if (allocated(InData%WAMIT2)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) + LB(1:1) = lbound(InData%WAMIT2) + UB(1:1) = ubound(InData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_PackParam(Buf, InData%WAMIT2(i1)) + end do + end if + call RegPack(Buf, InData%WAMIT2used) + call Morison_PackParam(Buf, InData%Morison) + call RegPack(Buf, InData%PotMod) + call RegPack(Buf, InData%NBody) + call RegPack(Buf, InData%NBodyMod) + call RegPack(Buf, InData%totalStates) + call RegPack(Buf, InData%totalExctnStates) + call RegPack(Buf, InData%totalRdtnStates) + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, allocated(InData%AddF0)) + if (allocated(InData%AddF0)) then + call RegPackBounds(Buf, 2, lbound(InData%AddF0), ubound(InData%AddF0)) + call RegPack(Buf, InData%AddF0) + end if + call RegPack(Buf, allocated(InData%AddCLin)) + if (allocated(InData%AddCLin)) then + call RegPackBounds(Buf, 3, lbound(InData%AddCLin), ubound(InData%AddCLin)) + call RegPack(Buf, InData%AddCLin) + end if + call RegPack(Buf, allocated(InData%AddBLin)) + if (allocated(InData%AddBLin)) then + call RegPackBounds(Buf, 3, lbound(InData%AddBLin), ubound(InData%AddBLin)) + call RegPack(Buf, InData%AddBLin) + end if + call RegPack(Buf, allocated(InData%AddBQuad)) + if (allocated(InData%AddBQuad)) then + call RegPackBounds(Buf, 3, lbound(InData%AddBQuad), ubound(InData%AddBQuad)) + call RegPack(Buf, InData%AddBQuad) + end if + call RegPack(Buf, InData%DT) + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%NumTotalOuts) + call RegPack(Buf, InData%OutSwtch) + call RegPack(Buf, InData%OutFmt) + call RegPack(Buf, InData%OutSFmt) + call RegPack(Buf, InData%Delim) + call RegPack(Buf, InData%UnOutFile) + call RegPack(Buf, InData%OutDec) + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + call RegPack(Buf, allocated(InData%du)) + if (allocated(InData%du)) then + call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPack(Buf, InData%du) + end if + call RegPack(Buf, allocated(InData%dx)) + if (allocated(InData%dx)) then + call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) + call RegPack(Buf, InData%dx) + end if + call RegPack(Buf, InData%Jac_ny) + call RegPack(Buf, InData%PointsToSeaState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%nWAMITObj) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%vecMultiplier) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackParam(Buf, OutData%WAMIT(i1)) ! WAMIT + end do + end if + if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT2_UnpackParam(Buf, OutData%WAMIT2(i1)) ! WAMIT2 + end do + end if + call RegUnpack(Buf, OutData%WAMIT2used) + if (RegCheckErr(Buf, RoutineName)) return + call Morison_UnpackParam(Buf, OutData%Morison) ! Morison + call RegUnpack(Buf, OutData%PotMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%totalStates) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%totalExctnStates) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%totalRdtnStates) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AddF0)) deallocate(OutData%AddF0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddF0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddF0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AddCLin)) deallocate(OutData%AddCLin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddCLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddCLin) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AddBLin)) deallocate(OutData%AddBLin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddBLin) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AddBQuad)) deallocate(OutData%AddBQuad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBQuad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddBQuad) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumTotalOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnOutFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutDec) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%du)) deallocate(OutData%du) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%du(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dx)) deallocate(OutData%dx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PointsToSeaState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_InputType), intent(inout) :: SrcInputData + type(HydroDyn_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call Morison_CopyInput(SrcInputData%Morison, DstInputData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%WAMITMesh, DstInputData%WAMITMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%PRPMesh, DstInputData%PRPMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine HydroDyn_DestroyInput(InputData, ErrStat, ErrMsg) + type(HydroDyn_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + 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) + call MeshDestroy( InputData%PRPMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine HydroDyn_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call Morison_PackInput(Buf, InData%Morison) + call MeshPack(Buf, InData%WAMITMesh) + call MeshPack(Buf, InData%PRPMesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + call Morison_UnpackInput(Buf, OutData%Morison) ! Morison + call MeshUnpack(Buf, OutData%WAMITMesh) ! WAMITMesh + call MeshUnpack(Buf, OutData%PRPMesh) ! PRPMesh +end subroutine + +subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_OutputType), intent(inout) :: SrcOutputData + type(HydroDyn_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%WAMIT)) then + LB(1:1) = lbound(SrcOutputData%WAMIT) + UB(1:1) = ubound(SrcOutputData%WAMIT) + if (.not. allocated(DstOutputData%WAMIT)) then + allocate(DstOutputData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyOutput(SrcOutputData%WAMIT(i1), DstOutputData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%WAMIT2)) then + LB(1:1) = lbound(SrcOutputData%WAMIT2) + UB(1:1) = ubound(SrcOutputData%WAMIT2) + if (.not. allocated(DstOutputData%WAMIT2)) then + allocate(DstOutputData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT2_CopyOutput(SrcOutputData%WAMIT2(i1), DstOutputData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Morison_CopyOutput(SrcOutputData%Morison, DstOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%WAMITMesh, DstOutputData%WAMITMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine HydroDyn_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(HydroDyn_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WAMIT)) then + LB(1:1) = lbound(OutputData%WAMIT) + UB(1:1) = ubound(OutputData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyOutput(OutputData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%WAMIT) + end if + if (allocated(OutputData%WAMIT2)) then + LB(1:1) = lbound(OutputData%WAMIT2) + UB(1:1) = ubound(OutputData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_DestroyOutput(OutputData%WAMIT2(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%WAMIT2) + end if + 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) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine HydroDyn_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackOutput(Buf, InData%WAMIT(i1)) + end do + end if + call RegPack(Buf, allocated(InData%WAMIT2)) + if (allocated(InData%WAMIT2)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) + LB(1:1) = lbound(InData%WAMIT2) + UB(1:1) = ubound(InData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_PackOutput(Buf, InData%WAMIT2(i1)) + end do + end if + call Morison_PackOutput(Buf, InData%Morison) + call MeshPack(Buf, InData%WAMITMesh) + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackOutput(Buf, OutData%WAMIT(i1)) ! WAMIT + end do + end if + if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT2_UnpackOutput(Buf, OutData%WAMIT2(i1)) ! WAMIT2 + end do + end if + call Morison_UnpackOutput(Buf, OutData%Morison) ! Morison + call MeshUnpack(Buf, OutData%WAMITMesh) ! WAMITMesh + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine HydroDyn_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(HydroDyn_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(HydroDyn_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 = 'HydroDyn_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 HydroDyn_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL HydroDyn_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 HydroDyn_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 HydroDyn_Input_ExtrapInterp - - - SUBROUTINE HydroDyn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call HydroDyn_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call HydroDyn_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call HydroDyn_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE HydroDyn_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. @@ -8059,45 +3059,46 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(HydroDyn_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 + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(HydroDyn_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 = 'HydroDyn_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL Morison_Input_ExtrapInterp1( u1%Morison, u2%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%WAMITMesh, u2%WAMITMesh, tin, u_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%PRPMesh, u2%PRPMesh, tin, u_out%PRPMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE HydroDyn_Input_ExtrapInterp1 - - - SUBROUTINE HydroDyn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL Morison_Input_ExtrapInterp1( u1%Morison, u2%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%WAMITMesh, u2%WAMITMesh, tin, u_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%PRPMesh, u2%PRPMesh, tin, u_out%PRPMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE HydroDyn_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. @@ -8111,105 +3112,106 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat ! !.................................................................................................................................. - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(HydroDyn_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 + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(HydroDyn_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 = 'HydroDyn_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_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 + 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 + 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 + 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))) - CALL Morison_Input_ExtrapInterp2( u1%Morison, u2%Morison, u3%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%WAMITMesh, u2%WAMITMesh, u3%WAMITMesh, tin, u_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%PRPMesh, u2%PRPMesh, u3%PRPMesh, tin, u_out%PRPMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE HydroDyn_Input_ExtrapInterp2 - - - SUBROUTINE HydroDyn_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(HydroDyn_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(HydroDyn_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL Morison_Input_ExtrapInterp2( u1%Morison, u2%Morison, u3%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%WAMITMesh, u2%WAMITMesh, u3%WAMITMesh, tin, u_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%PRPMesh, u2%PRPMesh, u3%PRPMesh, tin, u_out%PRPMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine HydroDyn_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(HydroDyn_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(HydroDyn_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 = 'HydroDyn_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 HydroDyn_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL HydroDyn_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 HydroDyn_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 HydroDyn_Output_ExtrapInterp - - - SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call HydroDyn_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call HydroDyn_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call HydroDyn_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE HydroDyn_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. @@ -8221,63 +3223,61 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(HydroDyn_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 + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(HydroDyn_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 = 'HydroDyn_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN - DO i1 = LBOUND(y_out%WAMIT,1),UBOUND(y_out%WAMIT,1) - CALL WAMIT_Output_ExtrapInterp1( y1%WAMIT(i1), y2%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN - DO i1 = LBOUND(y_out%WAMIT2,1),UBOUND(y_out%WAMIT2,1) - CALL WAMIT2_Output_ExtrapInterp1( y1%WAMIT2(i1), y2%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL Morison_Output_ExtrapInterp1( y1%Morison, y2%Morison, tin, y_out%Morison, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%WAMITMesh, y2%WAMITMesh, tin, y_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 HydroDyn_Output_ExtrapInterp1 - - - SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN + DO i1 = LBOUND(y_out%WAMIT,1),UBOUND(y_out%WAMIT,1) + CALL WAMIT_Output_ExtrapInterp1( y1%WAMIT(i1), y2%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN + DO i1 = LBOUND(y_out%WAMIT2,1),UBOUND(y_out%WAMIT2,1) + CALL WAMIT2_Output_ExtrapInterp1( y1%WAMIT2(i1), y2%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL Morison_Output_ExtrapInterp1( y1%Morison, y2%Morison, tin, y_out%Morison, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%WAMITMesh, y2%WAMITMesh, tin, y_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE HydroDyn_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. @@ -8291,70 +3291,66 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta ! !.................................................................................................................................. - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(HydroDyn_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 + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(HydroDyn_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 = 'HydroDyn_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_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 + 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 + 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 + 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%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN - DO i1 = LBOUND(y_out%WAMIT,1),UBOUND(y_out%WAMIT,1) - CALL WAMIT_Output_ExtrapInterp2( y1%WAMIT(i1), y2%WAMIT(i1), y3%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN - DO i1 = LBOUND(y_out%WAMIT2,1),UBOUND(y_out%WAMIT2,1) - CALL WAMIT2_Output_ExtrapInterp2( y1%WAMIT2(i1), y2%WAMIT2(i1), y3%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL Morison_Output_ExtrapInterp2( y1%Morison, y2%Morison, y3%Morison, tin, y_out%Morison, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%WAMITMesh, y2%WAMITMesh, y3%WAMITMesh, tin, y_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 HydroDyn_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN + DO i1 = LBOUND(y_out%WAMIT,1),UBOUND(y_out%WAMIT,1) + CALL WAMIT_Output_ExtrapInterp2( y1%WAMIT(i1), y2%WAMIT(i1), y3%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN + DO i1 = LBOUND(y_out%WAMIT2,1),UBOUND(y_out%WAMIT2,1) + CALL WAMIT2_Output_ExtrapInterp2( y1%WAMIT2(i1), y2%WAMIT2(i1), y3%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL Morison_Output_ExtrapInterp2( y1%Morison, y2%Morison, y3%Morison, tin, y_out%Morison, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%WAMITMesh, y2%WAMITMesh, y3%WAMITMesh, tin, y_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE HydroDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 165080b7af..e5e8242fdf 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -37,116 +37,116 @@ MODULE Morison_Types IMPLICIT NONE ! ========= Morison_JointType ======= TYPE, PUBLIC :: Morison_JointType - INTEGER(IntKi) :: JointID !< User-specified integer ID for the given joint [-] - REAL(ReKi) , DIMENSION(1:3) :: Position !< Undisplaced location of the joint in the platform coordinate system [m] - INTEGER(IntKi) :: JointAxID !< Axial ID (found in the user-supplied Axial Coefficients Table) for this joint: used to determine axial coefs [-] - INTEGER(IntKi) :: JointAxIDIndx !< The index into the Axial Coefs arrays corresponding to the above Axial ID [-] - INTEGER(IntKi) :: JointOvrlp !< Joint overlap code [Unused [-] - INTEGER(IntKi) :: NConnections !< Number of members connecting to this joint [-] - INTEGER(IntKi) , DIMENSION(1:50) :: ConnectionList !< List of Members connected to this joint. The member index is what is stored, not the Member ID [-] + INTEGER(IntKi) :: JointID = 0_IntKi !< User-specified integer ID for the given joint [-] + REAL(ReKi) , DIMENSION(1:3) :: Position = 0.0_ReKi !< Undisplaced location of the joint in the platform coordinate system [m] + INTEGER(IntKi) :: JointAxID = 0_IntKi !< Axial ID (found in the user-supplied Axial Coefficients Table) for this joint: used to determine axial coefs [-] + INTEGER(IntKi) :: JointAxIDIndx = 0_IntKi !< The index into the Axial Coefs arrays corresponding to the above Axial ID [-] + INTEGER(IntKi) :: JointOvrlp = 0_IntKi !< Joint overlap code [Unused [-] + INTEGER(IntKi) :: NConnections = 0_IntKi !< Number of members connecting to this joint [-] + INTEGER(IntKi) , DIMENSION(1:50) :: ConnectionList = 0_IntKi !< List of Members connected to this joint. The member index is what is stored, not the Member ID [-] END TYPE Morison_JointType ! ======================= ! ========= Morison_MemberPropType ======= TYPE, PUBLIC :: Morison_MemberPropType - INTEGER(IntKi) :: PropSetID !< User-specified integer ID for this group of properties [-] - REAL(ReKi) :: PropD !< Diameter [m] - REAL(ReKi) :: PropThck !< Wall thickness [m] + INTEGER(IntKi) :: PropSetID = 0_IntKi !< User-specified integer ID for this group of properties [-] + REAL(ReKi) :: PropD = 0.0_ReKi !< Diameter [m] + REAL(ReKi) :: PropThck = 0.0_ReKi !< Wall thickness [m] END TYPE Morison_MemberPropType ! ======================= ! ========= Morison_FilledGroupType ======= TYPE, PUBLIC :: Morison_FilledGroupType - INTEGER(IntKi) :: FillNumM !< Number of members in the Fill Group [-] + INTEGER(IntKi) :: FillNumM = 0_IntKi !< Number of members in the Fill Group [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FillMList !< List of Member IDs for the members in this fill group [-] - REAL(ReKi) :: FillFSLoc !< The free-surface location (in Z) for this fill group [m] + REAL(ReKi) :: FillFSLoc = 0.0_ReKi !< The free-surface location (in Z) for this fill group [m] CHARACTER(80) :: FillDensChr !< String version of the Fill density [can be DEFAULT which sets the fill density to WtrDens] [kg/m^3] - REAL(ReKi) :: FillDens !< Numerical fill density [kg/m^3] + REAL(ReKi) :: FillDens = 0.0_ReKi !< Numerical fill density [kg/m^3] END TYPE Morison_FilledGroupType ! ======================= ! ========= Morison_CoefDpths ======= TYPE, PUBLIC :: Morison_CoefDpths - REAL(ReKi) :: Dpth !< Depth location for these depth-based hydrodynamic coefs [m] - REAL(ReKi) :: DpthCd !< Depth-based drag coef [-] - REAL(ReKi) :: DpthCdMG !< Depth-based drag coef for marine growth [-] - REAL(ReKi) :: DpthCa !< Depth-based Ca [-] - REAL(ReKi) :: DpthCaMG !< Depth-based Ca for marine growth [-] - REAL(ReKi) :: DpthCp !< Depth-based Cp [-] - REAL(ReKi) :: DpthCpMG !< Depth-based Cp for marine growth [-] - REAL(ReKi) :: DpthAxCd !< Depth-based Axial Cd [-] - REAL(ReKi) :: DpthAxCdMG !< Depth-based Axial Cd for marine growth [-] - REAL(ReKi) :: DpthAxCa !< Depth-based Axial Ca [-] - REAL(ReKi) :: DpthAxCaMG !< Depth-based Axial Ca for marine growth [-] - REAL(ReKi) :: DpthAxCp !< Depth-based Axial Cp [-] - REAL(ReKi) :: DpthAxCpMG !< Depth-based Axial Cp for marine growth [-] - REAL(ReKi) :: DpthCb !< Simple model hydrostatic/buoyancy load coefficient [-] - REAL(ReKi) :: DpthCbMg !< Simple model hydrostatic/buoyancy load coefficient for marine growth [-] - LOGICAL :: DpthMCF !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] + REAL(ReKi) :: Dpth = 0.0_ReKi !< Depth location for these depth-based hydrodynamic coefs [m] + REAL(ReKi) :: DpthCd = 0.0_ReKi !< Depth-based drag coef [-] + REAL(ReKi) :: DpthCdMG = 0.0_ReKi !< Depth-based drag coef for marine growth [-] + REAL(ReKi) :: DpthCa = 0.0_ReKi !< Depth-based Ca [-] + REAL(ReKi) :: DpthCaMG = 0.0_ReKi !< Depth-based Ca for marine growth [-] + REAL(ReKi) :: DpthCp = 0.0_ReKi !< Depth-based Cp [-] + REAL(ReKi) :: DpthCpMG = 0.0_ReKi !< Depth-based Cp for marine growth [-] + REAL(ReKi) :: DpthAxCd = 0.0_ReKi !< Depth-based Axial Cd [-] + REAL(ReKi) :: DpthAxCdMG = 0.0_ReKi !< Depth-based Axial Cd for marine growth [-] + REAL(ReKi) :: DpthAxCa = 0.0_ReKi !< Depth-based Axial Ca [-] + REAL(ReKi) :: DpthAxCaMG = 0.0_ReKi !< Depth-based Axial Ca for marine growth [-] + REAL(ReKi) :: DpthAxCp = 0.0_ReKi !< Depth-based Axial Cp [-] + REAL(ReKi) :: DpthAxCpMG = 0.0_ReKi !< Depth-based Axial Cp for marine growth [-] + REAL(ReKi) :: DpthCb = 0.0_ReKi !< Simple model hydrostatic/buoyancy load coefficient [-] + REAL(ReKi) :: DpthCbMg = 0.0_ReKi !< Simple model hydrostatic/buoyancy load coefficient for marine growth [-] + LOGICAL :: DpthMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] END TYPE Morison_CoefDpths ! ======================= ! ========= Morison_AxialCoefType ======= TYPE, PUBLIC :: Morison_AxialCoefType - INTEGER(IntKi) :: AxCoefID !< User-supplied integer ID for this set of Axial coefs [-] - REAL(ReKi) :: AxCd !< Axial Cd [-] - REAL(ReKi) :: AxCa !< Axial Ca [-] - REAL(ReKi) :: AxCp !< Axial Cp [-] - REAL(ReKi) :: AxVnCOff !< High-pass cut-off frequency for normal velocity when computing axial drag force [-] - REAL(ReKi) :: AxFDLoFSc !< Scaling factor for low frequency axial drag force [-] - INTEGER(IntKi) :: AxFDMod !< Switch for the axial drag formulation {0: original formulation, 1: Away from member only} [-] + INTEGER(IntKi) :: AxCoefID = 0_IntKi !< User-supplied integer ID for this set of Axial coefs [-] + REAL(ReKi) :: AxCd = 0.0_ReKi !< Axial Cd [-] + REAL(ReKi) :: AxCa = 0.0_ReKi !< Axial Ca [-] + REAL(ReKi) :: AxCp = 0.0_ReKi !< Axial Cp [-] + REAL(ReKi) :: AxVnCOff = 0.0_ReKi !< High-pass cut-off frequency for normal velocity when computing axial drag force [-] + REAL(ReKi) :: AxFDLoFSc = 0.0_ReKi !< Scaling factor for low frequency axial drag force [-] + INTEGER(IntKi) :: AxFDMod = 0_IntKi !< Switch for the axial drag formulation {0: original formulation, 1: Away from member only} [-] END TYPE Morison_AxialCoefType ! ======================= ! ========= Morison_MemberInputType ======= TYPE, PUBLIC :: Morison_MemberInputType - INTEGER(IntKi) :: MemberID !< User-supplied integer ID for this member [-] + INTEGER(IntKi) :: MemberID = 0_IntKi !< User-supplied integer ID for this member [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeIndx !< Index of each of the member's nodes in the master node list [-] - INTEGER(IntKi) :: MJointID1 !< Joint ID for start of member [-] - INTEGER(IntKi) :: MJointID2 !< Joint ID for end of member [-] - INTEGER(IntKi) :: MJointID1Indx !< Index into the joint table for the start of this member [-] - INTEGER(IntKi) :: MJointID2Indx !< Index into the joint table for the end of this member [-] - INTEGER(IntKi) :: MPropSetID1 !< Property set ID for the start of this member [-] - INTEGER(IntKi) :: MPropSetID2 !< Property set ID for the end of this member [-] - INTEGER(IntKi) :: MPropSetID1Indx !< Index into the Property table for the start of this member [-] - INTEGER(IntKi) :: MPropSetID2Indx !< Index into the Property table for the end of this member [-] - REAL(ReKi) :: MDivSize !< User-specified desired member discretization size for the final element [m] - INTEGER(IntKi) :: MCoefMod !< Which coef. model is being used for this member [1=simple, 2=depth-based, 3=member-based] [-] - INTEGER(IntKi) :: MHstLMod !< Which hydrostatic model is being used for this member [1=column-type, 2=ship-type] [-] - INTEGER(IntKi) :: MmbrCoefIDIndx !< Index into the appropriate coefs table for this member's properties [-] - INTEGER(IntKi) :: MmbrFilledIDIndx !< Index into the filled group table if this is a filled member [-] - LOGICAL :: PropPot !< Flag T/F for whether the member is modeled with potential flow theory [-] - LOGICAL :: PropMCF !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] - INTEGER(IntKi) :: NElements !< number of elements in this member [-] - REAL(ReKi) :: RefLength !< the reference total length for this member [m] - REAL(ReKi) :: dl !< the reference element length for this member (may be less than MDivSize to achieve uniform element lengths) [m] + INTEGER(IntKi) :: MJointID1 = 0_IntKi !< Joint ID for start of member [-] + INTEGER(IntKi) :: MJointID2 = 0_IntKi !< Joint ID for end of member [-] + INTEGER(IntKi) :: MJointID1Indx = 0_IntKi !< Index into the joint table for the start of this member [-] + INTEGER(IntKi) :: MJointID2Indx = 0_IntKi !< Index into the joint table for the end of this member [-] + INTEGER(IntKi) :: MPropSetID1 = 0_IntKi !< Property set ID for the start of this member [-] + INTEGER(IntKi) :: MPropSetID2 = 0_IntKi !< Property set ID for the end of this member [-] + INTEGER(IntKi) :: MPropSetID1Indx = 0_IntKi !< Index into the Property table for the start of this member [-] + INTEGER(IntKi) :: MPropSetID2Indx = 0_IntKi !< Index into the Property table for the end of this member [-] + REAL(ReKi) :: MDivSize = 0.0_ReKi !< User-specified desired member discretization size for the final element [m] + INTEGER(IntKi) :: MCoefMod = 0_IntKi !< Which coef. model is being used for this member [1=simple, 2=depth-based, 3=member-based] [-] + INTEGER(IntKi) :: MHstLMod = 0_IntKi !< Which hydrostatic model is being used for this member [1=column-type, 2=ship-type] [-] + INTEGER(IntKi) :: MmbrCoefIDIndx = 0_IntKi !< Index into the appropriate coefs table for this member's properties [-] + INTEGER(IntKi) :: MmbrFilledIDIndx = 0_IntKi !< Index into the filled group table if this is a filled member [-] + LOGICAL :: PropPot = .false. !< Flag T/F for whether the member is modeled with potential flow theory [-] + LOGICAL :: PropMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] + INTEGER(IntKi) :: NElements = 0_IntKi !< number of elements in this member [-] + REAL(ReKi) :: RefLength = 0.0_ReKi !< the reference total length for this member [m] + REAL(ReKi) :: dl = 0.0_ReKi !< the reference element length for this member (may be less than MDivSize to achieve uniform element lengths) [m] END TYPE Morison_MemberInputType ! ======================= ! ========= Morison_NodeType ======= TYPE, PUBLIC :: Morison_NodeType - INTEGER(IntKi) :: JointIndx !< Joint index from the user joint table that this node corresponds to. If the software created this node, index is set to -1 [-] - REAL(ReKi) , DIMENSION(1:3) :: Position !< Position of the node in global coordinates [m] - INTEGER(IntKi) :: JointOvrlp !< [-] - INTEGER(IntKi) :: JointAxIDIndx !< [-] - INTEGER(IntKi) :: NConnections !< Number of elements connecting to this node [-] - INTEGER(IntKi) , DIMENSION(1:50) :: ConnectionList !< Indices of all the members connected to this node (positive if end 1, negative if end 2) [-] - REAL(ReKi) :: JAxCd !< Nodal lumped (joint) axial Cd [-] - REAL(ReKi) :: JAxCa !< Nodal lumped (joint) axial Cp [-] - REAL(ReKi) :: JAxCp !< Nodal lumped (joint) axial Ca [-] - REAL(ReKi) :: JAxVnCOff !< High-pass cut-off frequency for normal velocity when computing axial drag force [-] - REAL(ReKi) :: JAxFDLoFSc !< Scaling factor for low frequency axial drag force [-] - INTEGER(IntKi) :: JAxFDMod !< Switch for the axial drag formulation {0: original formulation, 1: Away from member only} [-] - REAL(ReKi) :: FillDensity !< Fill fluid density [kg/m^3] - REAL(ReKi) :: tMG !< Nodal thickness with marine growth [m] - REAL(ReKi) :: MGdensity !< Nodal density of marine growth [kg/m^3] + INTEGER(IntKi) :: JointIndx = 0_IntKi !< Joint index from the user joint table that this node corresponds to. If the software created this node, index is set to -1 [-] + REAL(ReKi) , DIMENSION(1:3) :: Position = 0.0_ReKi !< Position of the node in global coordinates [m] + INTEGER(IntKi) :: JointOvrlp = 0_IntKi !< [-] + INTEGER(IntKi) :: JointAxIDIndx = 0_IntKi !< [-] + INTEGER(IntKi) :: NConnections = 0_IntKi !< Number of elements connecting to this node [-] + INTEGER(IntKi) , DIMENSION(1:50) :: ConnectionList = 0_IntKi !< Indices of all the members connected to this node (positive if end 1, negative if end 2) [-] + REAL(ReKi) :: JAxCd = 0.0_ReKi !< Nodal lumped (joint) axial Cd [-] + REAL(ReKi) :: JAxCa = 0.0_ReKi !< Nodal lumped (joint) axial Cp [-] + REAL(ReKi) :: JAxCp = 0.0_ReKi !< Nodal lumped (joint) axial Ca [-] + REAL(ReKi) :: JAxVnCOff = 0.0_ReKi !< High-pass cut-off frequency for normal velocity when computing axial drag force [-] + REAL(ReKi) :: JAxFDLoFSc = 0.0_ReKi !< Scaling factor for low frequency axial drag force [-] + INTEGER(IntKi) :: JAxFDMod = 0_IntKi !< Switch for the axial drag formulation {0: original formulation, 1: Away from member only} [-] + REAL(ReKi) :: FillDensity = 0.0_ReKi !< Fill fluid density [kg/m^3] + REAL(ReKi) :: tMG = 0.0_ReKi !< Nodal thickness with marine growth [m] + REAL(ReKi) :: MGdensity = 0.0_ReKi !< Nodal density of marine growth [kg/m^3] END TYPE Morison_NodeType ! ======================= ! ========= Morison_MemberType ======= TYPE, PUBLIC :: Morison_MemberType INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeIndx !< Index of each of the member's nodes in the master node list [-] - INTEGER(IntKi) :: MemberID !< User-supplied integer ID for this member [-] - INTEGER(IntKi) :: NElements !< number of elements in this member [-] - REAL(ReKi) :: RefLength !< the reference total length for this member [m] - REAL(ReKi) :: cosPhi_ref !< the reference cosine of the inclination angle of the member [-] - REAL(ReKi) :: dl !< the reference element length for this member (may be less than MDivSize to achieve uniform element lengths) [m] - REAL(ReKi) , DIMENSION(1:3) :: k !< unit vector of the member's orientation (may be changed to per-element once additional flexibility is accounted for in HydroDyn) [m] - REAL(ReKi) , DIMENSION(1:3,1:3) :: kkt !< matrix of matmul(k_hat, transpose(k_hat) [-] - REAL(ReKi) , DIMENSION(1:3,1:3) :: Ak !< matrix of I - kkt [-] + INTEGER(IntKi) :: MemberID = 0_IntKi !< User-supplied integer ID for this member [-] + INTEGER(IntKi) :: NElements = 0_IntKi !< number of elements in this member [-] + REAL(ReKi) :: RefLength = 0.0_ReKi !< the reference total length for this member [m] + REAL(ReKi) :: cosPhi_ref = 0.0_ReKi !< the reference cosine of the inclination angle of the member [-] + REAL(ReKi) :: dl = 0.0_ReKi !< the reference element length for this member (may be less than MDivSize to achieve uniform element lengths) [m] + REAL(ReKi) , DIMENSION(1:3) :: k = 0.0_ReKi !< unit vector of the member's orientation (may be changed to per-element once additional flexibility is accounted for in HydroDyn) [m] + REAL(ReKi) , DIMENSION(1:3,1:3) :: kkt = 0.0_ReKi !< matrix of matmul(k_hat, transpose(k_hat) [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: Ak = 0.0_ReKi !< matrix of I - kkt [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: R !< outer member radius at each node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RMG !< radius at each node including marine growth [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RMGB !< radius at each node including marine growth scaled by sqrt(Cb) [m] @@ -156,17 +156,17 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dRdl_mg !< taper dr/dl of outer surface including marine growth of each element [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dRdl_mg_b !< taper dr/dl of outer surface including marine growth of each element with scaling of sqrt(Cb) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dRdl_in !< taper dr/dl of interior surface of each element [-] - REAL(ReKi) :: Vinner !< Member volume without marine growth [m^3] - REAL(ReKi) :: Vouter !< Member volume including marine growth [m^3] - REAL(ReKi) :: Vballast !< Member ballast volume [m^3] - REAL(ReKi) :: Vsubmerged !< Submerged volume corresponding to portion of Member in the water [m^3] - REAL(ReKi) :: l_fill !< fill length along member axis from start node 1 [m] - REAL(ReKi) :: h_fill !< fill length of partially flooded element [m] - REAL(ReKi) :: z_overfill !< if member is fully filled, the head height of the fill pressure at the end node N+1. Zero if member is partially filled. [m] - REAL(ReKi) :: h_floor !< the distance from the node to the seabed along the member axis (negative value) [m] - INTEGER(IntKi) :: i_floor !< the number of the element that pierces the seabed (zero if the member doesn't pierce it) [-] - LOGICAL :: doEndBuoyancy !< compute the end plate effect for the hightest node of this member [-] - INTEGER(IntKi) :: memfloodstatus !< Member-level flooded status for each elemen: 0 unflooded or fully below seabed, 2 partially flooded, 1 fully flooded [-] + REAL(ReKi) :: Vinner = 0.0_ReKi !< Member volume without marine growth [m^3] + REAL(ReKi) :: Vouter = 0.0_ReKi !< Member volume including marine growth [m^3] + REAL(ReKi) :: Vballast = 0.0_ReKi !< Member ballast volume [m^3] + REAL(ReKi) :: Vsubmerged = 0.0_ReKi !< Submerged volume corresponding to portion of Member in the water [m^3] + REAL(ReKi) :: l_fill = 0.0_ReKi !< fill length along member axis from start node 1 [m] + REAL(ReKi) :: h_fill = 0.0_ReKi !< fill length of partially flooded element [m] + REAL(ReKi) :: z_overfill = 0.0_ReKi !< if member is fully filled, the head height of the fill pressure at the end node N+1. Zero if member is partially filled. [m] + REAL(ReKi) :: h_floor = 0.0_ReKi !< the distance from the node to the seabed along the member axis (negative value) [m] + INTEGER(IntKi) :: i_floor = 0_IntKi !< the number of the element that pierces the seabed (zero if the member doesn't pierce it) [-] + LOGICAL :: doEndBuoyancy = .false. !< compute the end plate effect for the hightest node of this member [-] + INTEGER(IntKi) :: memfloodstatus = 0_IntKi !< Member-level flooded status for each elemen: 0 unflooded or fully below seabed, 2 partially flooded, 1 fully flooded [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: floodstatus !< flooded status for each element: 0 unflooded or fully below seabed, 1 fully flooded, 2 partially flooded [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: alpha !< relative volume centroid of each element including marine growth, from node i to node i+1 [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: alpha_fb !< relative volume centroid of each element's flooded ballast, from node i to node i+1 [-] @@ -197,17 +197,17 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Cfl_fb !< axial force constant due to flooded ballast, for each element [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Cfr_fb !< radial force constant due to flooded ballast, for each element [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CM0_fb !< moment constant due to flooded ballast, for each element about lower node [Nm] - REAL(ReKi) :: MGvolume !< Volume of marine growth material for this member/element [m^3] - REAL(ReKi) :: MDivSize !< User-requested final element length (actual length may vary from this request) [m] - INTEGER(IntKi) :: MCoefMod !< Coefs model for member: 1 = simple, 2 =depth, 3 = member-based [-] - INTEGER(IntKi) :: MmbrCoefIDIndx !< If MCoefMod=3, then this is the index for the member's coefs in the master Member Coefs Table [-] - INTEGER(IntKi) :: MmbrFilledIDIndx !< If this member is part of a fill group, this is the index into the master fill group table, if not = -1 [-] - INTEGER(IntKi) :: MHstLMod !< Hydrostatic model for member [1=column-type, 2=ship-type] [-] - REAL(ReKi) :: FillFSLoc !< Z-location of the filled free-surface [m] - REAL(ReKi) :: FillDens !< Filled fluid density [kg/m^3] - LOGICAL :: PropPot !< Is this element/member modeled with potential flow theory T/F [-] - LOGICAL :: PropMCF !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] - LOGICAL :: Flipped !< Was the member flipped in a reordering event? Need to know this to get the correct normal vector to the ends [-] + REAL(ReKi) :: MGvolume = 0.0_ReKi !< Volume of marine growth material for this member/element [m^3] + REAL(ReKi) :: MDivSize = 0.0_ReKi !< User-requested final element length (actual length may vary from this request) [m] + INTEGER(IntKi) :: MCoefMod = 0_IntKi !< Coefs model for member: 1 = simple, 2 =depth, 3 = member-based [-] + INTEGER(IntKi) :: MmbrCoefIDIndx = 0_IntKi !< If MCoefMod=3, then this is the index for the member's coefs in the master Member Coefs Table [-] + INTEGER(IntKi) :: MmbrFilledIDIndx = 0_IntKi !< If this member is part of a fill group, this is the index into the master fill group table, if not = -1 [-] + INTEGER(IntKi) :: MHstLMod = 0_IntKi !< Hydrostatic model for member [1=column-type, 2=ship-type] [-] + REAL(ReKi) :: FillFSLoc = 0.0_ReKi !< Z-location of the filled free-surface [m] + REAL(ReKi) :: FillDens = 0.0_ReKi !< Filled fluid density [kg/m^3] + LOGICAL :: PropPot = .false. !< Is this element/member modeled with potential flow theory T/F [-] + LOGICAL :: PropMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] + LOGICAL :: Flipped = .false. !< Was the member flipped in a reordering event? Need to know this to get the correct normal vector to the ends [-] END TYPE Morison_MemberType ! ======================= ! ========= Morison_MemberLoads ======= @@ -227,51 +227,51 @@ MODULE Morison_Types ! ======================= ! ========= Morison_CoefMembers ======= TYPE, PUBLIC :: Morison_CoefMembers - INTEGER(IntKi) :: MemberID !< User-specified integer id for the Member-based coefs [-] - REAL(ReKi) :: MemberCd1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCd2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCdMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCdMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCa1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCa2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCaMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCaMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCp1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCp2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCpMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCpMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCd1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCd2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCdMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCdMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCa1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCa2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCaMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCaMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCp1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCp2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCpMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCpMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCb1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCb2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCbMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCbMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - LOGICAL :: MemberMCF !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] + INTEGER(IntKi) :: MemberID = 0_IntKi !< User-specified integer id for the Member-based coefs [-] + REAL(ReKi) :: MemberCd1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCd2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCdMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCdMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCa1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCa2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCaMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCaMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCp1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCp2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCpMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCpMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCd1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCd2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCdMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCdMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCa1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCa2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCaMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCaMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCp1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCp2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCpMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCpMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCb1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCb2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCbMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCbMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + LOGICAL :: MemberMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] END TYPE Morison_CoefMembers ! ======================= ! ========= Morison_MGDepthsType ======= TYPE, PUBLIC :: Morison_MGDepthsType - REAL(ReKi) :: MGDpth !< Marine growth depth location for these properties [m] - REAL(ReKi) :: MGThck !< Marine growth thickness [m] - REAL(ReKi) :: MGDens !< Marine growth density [kg/m^3] + REAL(ReKi) :: MGDpth = 0.0_ReKi !< Marine growth depth location for these properties [m] + REAL(ReKi) :: MGThck = 0.0_ReKi !< Marine growth thickness [m] + REAL(ReKi) :: MGDens = 0.0_ReKi !< Marine growth density [kg/m^3] END TYPE Morison_MGDepthsType ! ======================= ! ========= Morison_MOutput ======= TYPE, PUBLIC :: Morison_MOutput - INTEGER(IntKi) :: MemberID !< Member ID for requested output [-] - INTEGER(IntKi) :: NOutLoc !< The number of requested output locations [-] + INTEGER(IntKi) :: MemberID = 0_IntKi !< Member ID for requested output [-] + INTEGER(IntKi) :: NOutLoc = 0_IntKi !< The number of requested output locations [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NodeLocs !< Normalized locations along user-specified member for the outputs [-] - INTEGER(IntKi) :: MemberIDIndx !< Index for member in the master list [-] + INTEGER(IntKi) :: MemberIDIndx = 0_IntKi !< Index for member in the master list [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: MeshIndx1 !< Index of node in Mesh for the start of the member element [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: MeshIndx2 !< Index of node in Mesh for the end of the member element [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: MemberIndx1 !< Index of Member nodes for the start of the member element [-] @@ -281,63 +281,63 @@ MODULE Morison_Types ! ======================= ! ========= Morison_JOutput ======= TYPE, PUBLIC :: Morison_JOutput - INTEGER(IntKi) :: JointID !< Joint ID for the requested output [-] - INTEGER(IntKi) :: JointIDIndx !< Joint index in the master list [-] + INTEGER(IntKi) :: JointID = 0_IntKi !< Joint ID for the requested output [-] + INTEGER(IntKi) :: JointIDIndx = 0_IntKi !< Joint index in the master list [-] END TYPE Morison_JOutput ! ======================= ! ========= Morison_InitInputType ======= TYPE, PUBLIC :: Morison_InitInputType - REAL(ReKi) :: Gravity !< Gravity (scalar, positive-valued) [m/s^2] - REAL(ReKi) :: WtrDens !< Water density [kg/m^3] - REAL(ReKi) :: WtrDpth !< Water depth (positive-valued) [m] - REAL(ReKi) :: MSL2SWL !< Mean Sea Level to Still Water Level offset [m] - INTEGER(IntKi) :: WaveDisp !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] - INTEGER(IntKi) :: 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] [-] - INTEGER(IntKi) :: NJoints !< Number of user-specified joints [-] - INTEGER(IntKi) :: NNodes !< Total number of nodes in the final software model [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity (scalar, positive-valued) [m/s^2] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [kg/m^3] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean Sea Level to Still Water Level offset [m] + INTEGER(IntKi) :: WaveDisp = 0_IntKi !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] + INTEGER(IntKi) :: AMMod = 0_IntKi !< 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] [-] + INTEGER(IntKi) :: NJoints = 0_IntKi !< Number of user-specified joints [-] + INTEGER(IntKi) :: NNodes = 0_IntKi !< Total number of nodes in the final software model [-] TYPE(Morison_JointType) , DIMENSION(:), ALLOCATABLE :: InpJoints !< Array of user-specified joints [-] TYPE(Morison_NodeType) , DIMENSION(:), ALLOCATABLE :: Nodes !< Array of simulation node (some correspond to user-specified joints, others are created by software) [-] - INTEGER(IntKi) :: NAxCoefs !< Number of axial Coefs entries in input file table [-] + INTEGER(IntKi) :: NAxCoefs = 0_IntKi !< Number of axial Coefs entries in input file table [-] TYPE(Morison_AxialCoefType) , DIMENSION(:), ALLOCATABLE :: AxialCoefs !< List of axial coefs [-] - INTEGER(IntKi) :: NPropSets !< Number of member property sets [-] + INTEGER(IntKi) :: NPropSets = 0_IntKi !< Number of member property sets [-] TYPE(Morison_MemberPropType) , DIMENSION(:), ALLOCATABLE :: MPropSets !< List of Member property sets [-] - REAL(ReKi) :: SimplCd !< Simple model drag coef [-] - REAL(ReKi) :: SimplCdMG !< Simple model drag coef for marine growth [-] - REAL(ReKi) :: SimplCa !< Simple model Ca [-] - REAL(ReKi) :: SimplCaMG !< Simple model Ca for marine growth [-] - REAL(ReKi) :: SimplCp !< Simple model Cp [-] - REAL(ReKi) :: SimplCpMG !< Simple model Cp for marine growth [-] - REAL(ReKi) :: SimplAxCd !< Simple model Axial Cd [-] - REAL(ReKi) :: SimplAxCdMG !< Simple model Axial Cd for marine growth [-] - REAL(ReKi) :: SimplAxCa !< Simple model Axial Ca [-] - REAL(ReKi) :: SimplAxCaMG !< Simple model Axial Ca for marine growth [-] - REAL(ReKi) :: SimplAxCp !< Simple model Axial Cp [-] - REAL(ReKi) :: SimplAxCpMG !< Simple model Axial Cp for marine growth [-] - REAL(ReKi) :: SimplCb !< Simple model hydrostatic/buoyancy load coefficient [-] - REAL(ReKi) :: SimplCbMg !< Simple model hydrostatic/buoyancy load coefficient for marine growth [-] - LOGICAL :: SimplMCF !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] - INTEGER(IntKi) :: NCoefDpth !< [-] + REAL(ReKi) :: SimplCd = 0.0_ReKi !< Simple model drag coef [-] + REAL(ReKi) :: SimplCdMG = 0.0_ReKi !< Simple model drag coef for marine growth [-] + REAL(ReKi) :: SimplCa = 0.0_ReKi !< Simple model Ca [-] + REAL(ReKi) :: SimplCaMG = 0.0_ReKi !< Simple model Ca for marine growth [-] + REAL(ReKi) :: SimplCp = 0.0_ReKi !< Simple model Cp [-] + REAL(ReKi) :: SimplCpMG = 0.0_ReKi !< Simple model Cp for marine growth [-] + REAL(ReKi) :: SimplAxCd = 0.0_ReKi !< Simple model Axial Cd [-] + REAL(ReKi) :: SimplAxCdMG = 0.0_ReKi !< Simple model Axial Cd for marine growth [-] + REAL(ReKi) :: SimplAxCa = 0.0_ReKi !< Simple model Axial Ca [-] + REAL(ReKi) :: SimplAxCaMG = 0.0_ReKi !< Simple model Axial Ca for marine growth [-] + REAL(ReKi) :: SimplAxCp = 0.0_ReKi !< Simple model Axial Cp [-] + REAL(ReKi) :: SimplAxCpMG = 0.0_ReKi !< Simple model Axial Cp for marine growth [-] + REAL(ReKi) :: SimplCb = 0.0_ReKi !< Simple model hydrostatic/buoyancy load coefficient [-] + REAL(ReKi) :: SimplCbMg = 0.0_ReKi !< Simple model hydrostatic/buoyancy load coefficient for marine growth [-] + LOGICAL :: SimplMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] + INTEGER(IntKi) :: NCoefDpth = 0_IntKi !< [-] TYPE(Morison_CoefDpths) , DIMENSION(:), ALLOCATABLE :: CoefDpths !< [-] - INTEGER(IntKi) :: NCoefMembers !< [-] + INTEGER(IntKi) :: NCoefMembers = 0_IntKi !< [-] TYPE(Morison_CoefMembers) , DIMENSION(:), ALLOCATABLE :: CoefMembers !< [-] - INTEGER(IntKi) :: NMembers !< Number of user-specified members in the input file [-] + INTEGER(IntKi) :: NMembers = 0_IntKi !< Number of user-specified members in the input file [-] TYPE(Morison_MemberInputType) , DIMENSION(:), ALLOCATABLE :: InpMembers !< Array of user-specified members [-] - INTEGER(IntKi) :: NFillGroups !< [-] + INTEGER(IntKi) :: NFillGroups = 0_IntKi !< [-] TYPE(Morison_FilledGroupType) , DIMENSION(:), ALLOCATABLE :: FilledGroups !< [-] - INTEGER(IntKi) :: NMGDepths !< [-] + INTEGER(IntKi) :: NMGDepths = 0_IntKi !< [-] TYPE(Morison_MGDepthsType) , DIMENSION(:), ALLOCATABLE :: MGDepths !< [-] - REAL(ReKi) :: MGTop !< [-] - REAL(ReKi) :: MGBottom !< [-] - INTEGER(IntKi) :: NMOutputs !< [-] + REAL(ReKi) :: MGTop = 0.0_ReKi !< [-] + REAL(ReKi) :: MGBottom = 0.0_ReKi !< [-] + INTEGER(IntKi) :: NMOutputs = 0_IntKi !< [-] TYPE(Morison_MOutput) , DIMENSION(:), ALLOCATABLE :: MOutLst !< [-] - INTEGER(IntKi) :: NJOutputs !< [-] + INTEGER(IntKi) :: NJOutputs = 0_IntKi !< [-] 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 [-] - INTEGER(IntKi) :: NumOuts !< [-] - INTEGER(IntKi) :: UnSum !< [-] - INTEGER(IntKi) :: NStepWave !< [-] - INTEGER(IntKi) :: WaveStMod !< [-] - REAL(SiKi) :: MCFD !< Diameter of the MacCamy-Fuchs member. [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< [-] + INTEGER(IntKi) :: UnSum = 0_IntKi !< [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< [-] + REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of the MacCamy-Fuchs member. [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE Morison_InitInputType ! ======================= @@ -349,7 +349,7 @@ MODULE Morison_Types ! ======================= ! ========= Morison_ContinuousStateType ======= TYPE, PUBLIC :: Morison_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(SiKi) :: DummyContState = 0.0_R4Ki !< Remove this variable if you have continuous states [-] END TYPE Morison_ContinuousStateType ! ======================= ! ========= Morison_DiscreteStateType ======= @@ -359,12 +359,12 @@ MODULE Morison_Types ! ======================= ! ========= Morison_ConstraintStateType ======= TYPE, PUBLIC :: Morison_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< Remove this variable if you have constraint states [-] END TYPE Morison_ConstraintStateType ! ======================= ! ========= Morison_OtherStateType ======= TYPE, PUBLIC :: Morison_OtherStateType - INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] + INTEGER(IntKi) :: DummyOtherState = 0_IntKi !< Remove this variable if you have other states [-] END TYPE Morison_OtherStateType ! ======================= ! ========= Morison_MiscVarType ======= @@ -389,22 +389,22 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_BF_End !< [-] 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 [-] + INTEGER(IntKi) :: LastIndWave = 0_IntKi !< Last time index used in the wave kinematics arrays [-] END TYPE Morison_MiscVarType ! ======================= ! ========= Morison_ParameterType ======= TYPE, PUBLIC :: Morison_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [(sec)] - REAL(ReKi) :: Gravity !< Gravity (scalar, positive-valued) [m/s^2] - REAL(ReKi) :: WtrDens !< Water density [kg/m^3] - REAL(ReKi) :: WtrDpth !< Water depth (positive-valued) [m] - REAL(ReKi) :: MSL2SWL !< Mean Sea Level to Still Water Level offset [m] - INTEGER(IntKi) :: WaveDisp !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] - INTEGER(IntKi) :: 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] [-] - INTEGER(IntKi) :: NMembers !< number of members [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [(sec)] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity (scalar, positive-valued) [m/s^2] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [kg/m^3] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean Sea Level to Still Water Level offset [m] + INTEGER(IntKi) :: WaveDisp = 0_IntKi !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] + INTEGER(IntKi) :: AMMod = 0_IntKi !< 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] [-] + INTEGER(IntKi) :: NMembers = 0_IntKi !< number of members [-] TYPE(Morison_MemberType) , DIMENSION(:), ALLOCATABLE :: Members !< Array of Morison members used during simulation [-] - INTEGER(IntKi) :: NNodes !< [-] - INTEGER(IntKi) :: NJoints !< Number of user-specified joints [-] + INTEGER(IntKi) :: NNodes = 0_IntKi !< [-] + INTEGER(IntKi) :: NJoints = 0_IntKi !< Number of user-specified joints [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: I_MG_End !< Inertial matrix associated with marine growth mass at joint [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: An_End !< directional area vector of each joint [m^2] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DragConst_End !< [-] @@ -415,14 +415,14 @@ 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] - INTEGER(IntKi) :: NStepWave !< [-] - INTEGER(IntKi) :: NMOutputs !< [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] + INTEGER(IntKi) :: NMOutputs = 0_IntKi !< [-] TYPE(Morison_MOutput) , DIMENSION(:), ALLOCATABLE :: MOutLst !< [-] - INTEGER(IntKi) :: NJOutputs !< [-] + INTEGER(IntKi) :: NJOutputs = 0_IntKi !< [-] TYPE(Morison_JOutput) , DIMENSION(:), ALLOCATABLE :: JOutLst !< [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] - INTEGER(IntKi) :: NumOuts !< [-] - INTEGER(IntKi) :: WaveStMod !< [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< [-] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< SeaState wave field [-] END TYPE Morison_ParameterType ! ======================= @@ -438,11944 +438,5766 @@ MODULE Morison_Types END TYPE Morison_OutputType ! ======================= CONTAINS - SUBROUTINE Morison_CopyJointType( SrcJointTypeData, DstJointTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_JointType), INTENT(IN) :: SrcJointTypeData - TYPE(Morison_JointType), INTENT(INOUT) :: DstJointTypeData - 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 = 'Morison_CopyJointType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstJointTypeData%JointID = SrcJointTypeData%JointID - DstJointTypeData%Position = SrcJointTypeData%Position - DstJointTypeData%JointAxID = SrcJointTypeData%JointAxID - DstJointTypeData%JointAxIDIndx = SrcJointTypeData%JointAxIDIndx - DstJointTypeData%JointOvrlp = SrcJointTypeData%JointOvrlp - DstJointTypeData%NConnections = SrcJointTypeData%NConnections - DstJointTypeData%ConnectionList = SrcJointTypeData%ConnectionList - END SUBROUTINE Morison_CopyJointType - - SUBROUTINE Morison_DestroyJointType( JointTypeData, ErrStat, ErrMsg ) - TYPE(Morison_JointType), INTENT(INOUT) :: JointTypeData - 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 = 'Morison_DestroyJointType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyJointType - - SUBROUTINE Morison_PackJointType( 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(Morison_JointType), 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 = 'Morison_PackJointType' - ! 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 ! JointID - Re_BufSz = Re_BufSz + SIZE(InData%Position) ! Position - Int_BufSz = Int_BufSz + 1 ! JointAxID - Int_BufSz = Int_BufSz + 1 ! JointAxIDIndx - Int_BufSz = Int_BufSz + 1 ! JointOvrlp - Int_BufSz = Int_BufSz + 1 ! NConnections - Int_BufSz = Int_BufSz + SIZE(InData%ConnectionList) ! ConnectionList - 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%JointID - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%Position,1), UBOUND(InData%Position,1) - ReKiBuf(Re_Xferred) = InData%Position(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%JointAxID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%JointAxIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%JointOvrlp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NConnections - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%ConnectionList,1), UBOUND(InData%ConnectionList,1) - IntKiBuf(Int_Xferred) = InData%ConnectionList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END SUBROUTINE Morison_PackJointType - - SUBROUTINE Morison_UnPackJointType( 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_JointType), 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 = 'Morison_UnPackJointType' - ! 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%JointID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%Position,1) - i1_u = UBOUND(OutData%Position,1) - DO i1 = LBOUND(OutData%Position,1), UBOUND(OutData%Position,1) - OutData%Position(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%JointAxID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%JointAxIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%JointOvrlp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NConnections = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%ConnectionList,1) - i1_u = UBOUND(OutData%ConnectionList,1) - DO i1 = LBOUND(OutData%ConnectionList,1), UBOUND(OutData%ConnectionList,1) - OutData%ConnectionList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END SUBROUTINE Morison_UnPackJointType - - SUBROUTINE Morison_CopyMemberPropType( SrcMemberPropTypeData, DstMemberPropTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MemberPropType), INTENT(IN) :: SrcMemberPropTypeData - TYPE(Morison_MemberPropType), INTENT(INOUT) :: DstMemberPropTypeData - 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 = 'Morison_CopyMemberPropType' -! +subroutine Morison_CopyJointType(SrcJointTypeData, DstJointTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_JointType), intent(in) :: SrcJointTypeData + type(Morison_JointType), intent(inout) :: DstJointTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyJointType' ErrStat = ErrID_None - ErrMsg = "" - DstMemberPropTypeData%PropSetID = SrcMemberPropTypeData%PropSetID - DstMemberPropTypeData%PropD = SrcMemberPropTypeData%PropD - DstMemberPropTypeData%PropThck = SrcMemberPropTypeData%PropThck - END SUBROUTINE Morison_CopyMemberPropType - - SUBROUTINE Morison_DestroyMemberPropType( MemberPropTypeData, ErrStat, ErrMsg ) - TYPE(Morison_MemberPropType), INTENT(INOUT) :: MemberPropTypeData - 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 = 'Morison_DestroyMemberPropType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyMemberPropType - - SUBROUTINE Morison_PackMemberPropType( 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(Morison_MemberPropType), 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 = 'Morison_PackMemberPropType' - ! 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 ! PropSetID - Re_BufSz = Re_BufSz + 1 ! PropD - Re_BufSz = Re_BufSz + 1 ! PropThck - 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%PropSetID - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PropD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PropThck - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackMemberPropType - - SUBROUTINE Morison_UnPackMemberPropType( 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_MemberPropType), 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 = 'Morison_UnPackMemberPropType' - ! 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%PropSetID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PropD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PropThck = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackMemberPropType - - SUBROUTINE Morison_CopyFilledGroupType( SrcFilledGroupTypeData, DstFilledGroupTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_FilledGroupType), INTENT(IN) :: SrcFilledGroupTypeData - TYPE(Morison_FilledGroupType), INTENT(INOUT) :: DstFilledGroupTypeData - 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 = 'Morison_CopyFilledGroupType' -! + ErrMsg = '' + DstJointTypeData%JointID = SrcJointTypeData%JointID + DstJointTypeData%Position = SrcJointTypeData%Position + DstJointTypeData%JointAxID = SrcJointTypeData%JointAxID + DstJointTypeData%JointAxIDIndx = SrcJointTypeData%JointAxIDIndx + DstJointTypeData%JointOvrlp = SrcJointTypeData%JointOvrlp + DstJointTypeData%NConnections = SrcJointTypeData%NConnections + DstJointTypeData%ConnectionList = SrcJointTypeData%ConnectionList +end subroutine + +subroutine Morison_DestroyJointType(JointTypeData, ErrStat, ErrMsg) + type(Morison_JointType), intent(inout) :: JointTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyJointType' ErrStat = ErrID_None - ErrMsg = "" - DstFilledGroupTypeData%FillNumM = SrcFilledGroupTypeData%FillNumM -IF (ALLOCATED(SrcFilledGroupTypeData%FillMList)) THEN - i1_l = LBOUND(SrcFilledGroupTypeData%FillMList,1) - i1_u = UBOUND(SrcFilledGroupTypeData%FillMList,1) - IF (.NOT. ALLOCATED(DstFilledGroupTypeData%FillMList)) THEN - ALLOCATE(DstFilledGroupTypeData%FillMList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFilledGroupTypeData%FillMList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFilledGroupTypeData%FillMList = SrcFilledGroupTypeData%FillMList -ENDIF - DstFilledGroupTypeData%FillFSLoc = SrcFilledGroupTypeData%FillFSLoc - DstFilledGroupTypeData%FillDensChr = SrcFilledGroupTypeData%FillDensChr - DstFilledGroupTypeData%FillDens = SrcFilledGroupTypeData%FillDens - END SUBROUTINE Morison_CopyFilledGroupType - - SUBROUTINE Morison_DestroyFilledGroupType( FilledGroupTypeData, ErrStat, ErrMsg ) - TYPE(Morison_FilledGroupType), INTENT(INOUT) :: FilledGroupTypeData - 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 = 'Morison_DestroyFilledGroupType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(FilledGroupTypeData%FillMList)) THEN - DEALLOCATE(FilledGroupTypeData%FillMList) -ENDIF - END SUBROUTINE Morison_DestroyFilledGroupType - - SUBROUTINE Morison_PackFilledGroupType( 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(Morison_FilledGroupType), 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 = 'Morison_PackFilledGroupType' - ! 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 ! FillNumM - Int_BufSz = Int_BufSz + 1 ! FillMList allocated yes/no - IF ( ALLOCATED(InData%FillMList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FillMList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FillMList) ! FillMList - END IF - Re_BufSz = Re_BufSz + 1 ! FillFSLoc - Int_BufSz = Int_BufSz + 1*LEN(InData%FillDensChr) ! FillDensChr - Re_BufSz = Re_BufSz + 1 ! FillDens - 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%FillNumM - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FillMList) ) 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%FillMList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FillMList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FillMList,1), UBOUND(InData%FillMList,1) - IntKiBuf(Int_Xferred) = InData%FillMList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%FillFSLoc - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%FillDensChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%FillDensChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%FillDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackFilledGroupType - - SUBROUTINE Morison_UnPackFilledGroupType( 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_FilledGroupType), 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 = 'Morison_UnPackFilledGroupType' - ! 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%FillNumM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FillMList 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%FillMList)) DEALLOCATE(OutData%FillMList) - ALLOCATE(OutData%FillMList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FillMList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FillMList,1), UBOUND(OutData%FillMList,1) - OutData%FillMList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%FillFSLoc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%FillDensChr) - OutData%FillDensChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%FillDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackFilledGroupType - - SUBROUTINE Morison_CopyCoefDpths( SrcCoefDpthsData, DstCoefDpthsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_CoefDpths), INTENT(IN) :: SrcCoefDpthsData - TYPE(Morison_CoefDpths), INTENT(INOUT) :: DstCoefDpthsData - 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 = 'Morison_CopyCoefDpths' -! + ErrMsg = '' +end subroutine + +subroutine Morison_PackJointType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_JointType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackJointType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%JointID) + call RegPack(Buf, InData%Position) + call RegPack(Buf, InData%JointAxID) + call RegPack(Buf, InData%JointAxIDIndx) + call RegPack(Buf, InData%JointOvrlp) + call RegPack(Buf, InData%NConnections) + call RegPack(Buf, InData%ConnectionList) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackJointType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_JointType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackJointType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%JointID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Position) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%JointAxID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%JointAxIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%JointOvrlp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NConnections) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ConnectionList) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_CopyMemberPropType(SrcMemberPropTypeData, DstMemberPropTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MemberPropType), intent(in) :: SrcMemberPropTypeData + type(Morison_MemberPropType), intent(inout) :: DstMemberPropTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyMemberPropType' ErrStat = ErrID_None - ErrMsg = "" - DstCoefDpthsData%Dpth = SrcCoefDpthsData%Dpth - DstCoefDpthsData%DpthCd = SrcCoefDpthsData%DpthCd - DstCoefDpthsData%DpthCdMG = SrcCoefDpthsData%DpthCdMG - DstCoefDpthsData%DpthCa = SrcCoefDpthsData%DpthCa - DstCoefDpthsData%DpthCaMG = SrcCoefDpthsData%DpthCaMG - DstCoefDpthsData%DpthCp = SrcCoefDpthsData%DpthCp - DstCoefDpthsData%DpthCpMG = SrcCoefDpthsData%DpthCpMG - DstCoefDpthsData%DpthAxCd = SrcCoefDpthsData%DpthAxCd - DstCoefDpthsData%DpthAxCdMG = SrcCoefDpthsData%DpthAxCdMG - DstCoefDpthsData%DpthAxCa = SrcCoefDpthsData%DpthAxCa - DstCoefDpthsData%DpthAxCaMG = SrcCoefDpthsData%DpthAxCaMG - DstCoefDpthsData%DpthAxCp = SrcCoefDpthsData%DpthAxCp - DstCoefDpthsData%DpthAxCpMG = SrcCoefDpthsData%DpthAxCpMG - DstCoefDpthsData%DpthCb = SrcCoefDpthsData%DpthCb - DstCoefDpthsData%DpthCbMg = SrcCoefDpthsData%DpthCbMg - DstCoefDpthsData%DpthMCF = SrcCoefDpthsData%DpthMCF - END SUBROUTINE Morison_CopyCoefDpths - - SUBROUTINE Morison_DestroyCoefDpths( CoefDpthsData, ErrStat, ErrMsg ) - TYPE(Morison_CoefDpths), INTENT(INOUT) :: CoefDpthsData - 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 = 'Morison_DestroyCoefDpths' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyCoefDpths - - SUBROUTINE Morison_PackCoefDpths( 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(Morison_CoefDpths), 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 = 'Morison_PackCoefDpths' - ! 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 ! Dpth - Re_BufSz = Re_BufSz + 1 ! DpthCd - Re_BufSz = Re_BufSz + 1 ! DpthCdMG - Re_BufSz = Re_BufSz + 1 ! DpthCa - Re_BufSz = Re_BufSz + 1 ! DpthCaMG - Re_BufSz = Re_BufSz + 1 ! DpthCp - Re_BufSz = Re_BufSz + 1 ! DpthCpMG - Re_BufSz = Re_BufSz + 1 ! DpthAxCd - Re_BufSz = Re_BufSz + 1 ! DpthAxCdMG - Re_BufSz = Re_BufSz + 1 ! DpthAxCa - Re_BufSz = Re_BufSz + 1 ! DpthAxCaMG - Re_BufSz = Re_BufSz + 1 ! DpthAxCp - Re_BufSz = Re_BufSz + 1 ! DpthAxCpMG - Re_BufSz = Re_BufSz + 1 ! DpthCb - Re_BufSz = Re_BufSz + 1 ! DpthCbMg - Int_BufSz = Int_BufSz + 1 ! DpthMCF - 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%Dpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCbMg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DpthMCF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackCoefDpths - - SUBROUTINE Morison_UnPackCoefDpths( 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_CoefDpths), 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 = 'Morison_UnPackCoefDpths' - ! 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%Dpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCdMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCaMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCpMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCdMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCaMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCpMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCbMg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthMCF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DpthMCF) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackCoefDpths - - SUBROUTINE Morison_CopyAxialCoefType( SrcAxialCoefTypeData, DstAxialCoefTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_AxialCoefType), INTENT(IN) :: SrcAxialCoefTypeData - TYPE(Morison_AxialCoefType), INTENT(INOUT) :: DstAxialCoefTypeData - 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 = 'Morison_CopyAxialCoefType' -! + ErrMsg = '' + DstMemberPropTypeData%PropSetID = SrcMemberPropTypeData%PropSetID + DstMemberPropTypeData%PropD = SrcMemberPropTypeData%PropD + DstMemberPropTypeData%PropThck = SrcMemberPropTypeData%PropThck +end subroutine + +subroutine Morison_DestroyMemberPropType(MemberPropTypeData, ErrStat, ErrMsg) + type(Morison_MemberPropType), intent(inout) :: MemberPropTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMemberPropType' ErrStat = ErrID_None - ErrMsg = "" - DstAxialCoefTypeData%AxCoefID = SrcAxialCoefTypeData%AxCoefID - DstAxialCoefTypeData%AxCd = SrcAxialCoefTypeData%AxCd - DstAxialCoefTypeData%AxCa = SrcAxialCoefTypeData%AxCa - DstAxialCoefTypeData%AxCp = SrcAxialCoefTypeData%AxCp - DstAxialCoefTypeData%AxVnCOff = SrcAxialCoefTypeData%AxVnCOff - DstAxialCoefTypeData%AxFDLoFSc = SrcAxialCoefTypeData%AxFDLoFSc - DstAxialCoefTypeData%AxFDMod = SrcAxialCoefTypeData%AxFDMod - END SUBROUTINE Morison_CopyAxialCoefType - - SUBROUTINE Morison_DestroyAxialCoefType( AxialCoefTypeData, ErrStat, ErrMsg ) - TYPE(Morison_AxialCoefType), INTENT(INOUT) :: AxialCoefTypeData - 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 = 'Morison_DestroyAxialCoefType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyAxialCoefType - - SUBROUTINE Morison_PackAxialCoefType( 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(Morison_AxialCoefType), 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 = 'Morison_PackAxialCoefType' - ! 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 ! AxCoefID - Re_BufSz = Re_BufSz + 1 ! AxCd - Re_BufSz = Re_BufSz + 1 ! AxCa - Re_BufSz = Re_BufSz + 1 ! AxCp - Re_BufSz = Re_BufSz + 1 ! AxVnCOff - Re_BufSz = Re_BufSz + 1 ! AxFDLoFSc - Int_BufSz = Int_BufSz + 1 ! AxFDMod - 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%AxCoefID - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AxVnCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AxFDLoFSc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AxFDMod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackAxialCoefType - - SUBROUTINE Morison_UnPackAxialCoefType( 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_AxialCoefType), 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 = 'Morison_UnPackAxialCoefType' - ! 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%AxCoefID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AxCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AxCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AxCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AxVnCOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AxFDLoFSc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AxFDMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackAxialCoefType - - SUBROUTINE Morison_CopyMemberInputType( SrcMemberInputTypeData, DstMemberInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MemberInputType), INTENT(IN) :: SrcMemberInputTypeData - TYPE(Morison_MemberInputType), INTENT(INOUT) :: DstMemberInputTypeData - 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 = 'Morison_CopyMemberInputType' -! + ErrMsg = '' +end subroutine + +subroutine Morison_PackMemberPropType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberPropType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMemberPropType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%PropSetID) + call RegPack(Buf, InData%PropD) + call RegPack(Buf, InData%PropThck) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMemberPropType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberPropType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMemberPropType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%PropSetID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PropD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PropThck) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_CopyFilledGroupType(SrcFilledGroupTypeData, DstFilledGroupTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_FilledGroupType), intent(in) :: SrcFilledGroupTypeData + type(Morison_FilledGroupType), intent(inout) :: DstFilledGroupTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyFilledGroupType' ErrStat = ErrID_None - ErrMsg = "" - DstMemberInputTypeData%MemberID = SrcMemberInputTypeData%MemberID -IF (ALLOCATED(SrcMemberInputTypeData%NodeIndx)) THEN - i1_l = LBOUND(SrcMemberInputTypeData%NodeIndx,1) - i1_u = UBOUND(SrcMemberInputTypeData%NodeIndx,1) - IF (.NOT. ALLOCATED(DstMemberInputTypeData%NodeIndx)) THEN - ALLOCATE(DstMemberInputTypeData%NodeIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberInputTypeData%NodeIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberInputTypeData%NodeIndx = SrcMemberInputTypeData%NodeIndx -ENDIF - DstMemberInputTypeData%MJointID1 = SrcMemberInputTypeData%MJointID1 - DstMemberInputTypeData%MJointID2 = SrcMemberInputTypeData%MJointID2 - DstMemberInputTypeData%MJointID1Indx = SrcMemberInputTypeData%MJointID1Indx - DstMemberInputTypeData%MJointID2Indx = SrcMemberInputTypeData%MJointID2Indx - DstMemberInputTypeData%MPropSetID1 = SrcMemberInputTypeData%MPropSetID1 - DstMemberInputTypeData%MPropSetID2 = SrcMemberInputTypeData%MPropSetID2 - DstMemberInputTypeData%MPropSetID1Indx = SrcMemberInputTypeData%MPropSetID1Indx - DstMemberInputTypeData%MPropSetID2Indx = SrcMemberInputTypeData%MPropSetID2Indx - DstMemberInputTypeData%MDivSize = SrcMemberInputTypeData%MDivSize - DstMemberInputTypeData%MCoefMod = SrcMemberInputTypeData%MCoefMod - DstMemberInputTypeData%MHstLMod = SrcMemberInputTypeData%MHstLMod - DstMemberInputTypeData%MmbrCoefIDIndx = SrcMemberInputTypeData%MmbrCoefIDIndx - DstMemberInputTypeData%MmbrFilledIDIndx = SrcMemberInputTypeData%MmbrFilledIDIndx - DstMemberInputTypeData%PropPot = SrcMemberInputTypeData%PropPot - DstMemberInputTypeData%PropMCF = SrcMemberInputTypeData%PropMCF - DstMemberInputTypeData%NElements = SrcMemberInputTypeData%NElements - DstMemberInputTypeData%RefLength = SrcMemberInputTypeData%RefLength - DstMemberInputTypeData%dl = SrcMemberInputTypeData%dl - END SUBROUTINE Morison_CopyMemberInputType - - SUBROUTINE Morison_DestroyMemberInputType( MemberInputTypeData, ErrStat, ErrMsg ) - TYPE(Morison_MemberInputType), INTENT(INOUT) :: MemberInputTypeData - 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 = 'Morison_DestroyMemberInputType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MemberInputTypeData%NodeIndx)) THEN - DEALLOCATE(MemberInputTypeData%NodeIndx) -ENDIF - END SUBROUTINE Morison_DestroyMemberInputType - - SUBROUTINE Morison_PackMemberInputType( 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(Morison_MemberInputType), 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 = 'Morison_PackMemberInputType' - ! 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 ! MemberID - Int_BufSz = Int_BufSz + 1 ! NodeIndx allocated yes/no - IF ( ALLOCATED(InData%NodeIndx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeIndx) ! NodeIndx - END IF - Int_BufSz = Int_BufSz + 1 ! MJointID1 - Int_BufSz = Int_BufSz + 1 ! MJointID2 - Int_BufSz = Int_BufSz + 1 ! MJointID1Indx - Int_BufSz = Int_BufSz + 1 ! MJointID2Indx - Int_BufSz = Int_BufSz + 1 ! MPropSetID1 - Int_BufSz = Int_BufSz + 1 ! MPropSetID2 - Int_BufSz = Int_BufSz + 1 ! MPropSetID1Indx - Int_BufSz = Int_BufSz + 1 ! MPropSetID2Indx - Re_BufSz = Re_BufSz + 1 ! MDivSize - Int_BufSz = Int_BufSz + 1 ! MCoefMod - Int_BufSz = Int_BufSz + 1 ! MHstLMod - Int_BufSz = Int_BufSz + 1 ! MmbrCoefIDIndx - Int_BufSz = Int_BufSz + 1 ! MmbrFilledIDIndx - Int_BufSz = Int_BufSz + 1 ! PropPot - Int_BufSz = Int_BufSz + 1 ! PropMCF - Int_BufSz = Int_BufSz + 1 ! NElements - Re_BufSz = Re_BufSz + 1 ! RefLength - Re_BufSz = Re_BufSz + 1 ! dl - 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%MemberID - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NodeIndx) ) 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%NodeIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeIndx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeIndx,1), UBOUND(InData%NodeIndx,1) - IntKiBuf(Int_Xferred) = InData%NodeIndx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%MJointID1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MJointID2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MJointID1Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MJointID2Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MPropSetID1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MPropSetID2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MPropSetID1Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MPropSetID2Indx - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MDivSize - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MCoefMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHstLMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MmbrCoefIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MmbrFilledIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PropPot, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PropMCF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NElements - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dl - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackMemberInputType - - SUBROUTINE Morison_UnPackMemberInputType( 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_MemberInputType), 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 = 'Morison_UnPackMemberInputType' - ! 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%MemberID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeIndx 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%NodeIndx)) DEALLOCATE(OutData%NodeIndx) - ALLOCATE(OutData%NodeIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeIndx,1), UBOUND(OutData%NodeIndx,1) - OutData%NodeIndx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%MJointID1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID1Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID2Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID1Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID2Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MDivSize = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MCoefMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MHstLMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrCoefIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrFilledIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PropPot = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropPot) - Int_Xferred = Int_Xferred + 1 - OutData%PropMCF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropMCF) - Int_Xferred = Int_Xferred + 1 - OutData%NElements = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackMemberInputType - - SUBROUTINE Morison_CopyNodeType( SrcNodeTypeData, DstNodeTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_NodeType), INTENT(IN) :: SrcNodeTypeData - TYPE(Morison_NodeType), INTENT(INOUT) :: DstNodeTypeData - 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 = 'Morison_CopyNodeType' -! + ErrMsg = '' + DstFilledGroupTypeData%FillNumM = SrcFilledGroupTypeData%FillNumM + if (allocated(SrcFilledGroupTypeData%FillMList)) then + LB(1:1) = lbound(SrcFilledGroupTypeData%FillMList) + UB(1:1) = ubound(SrcFilledGroupTypeData%FillMList) + if (.not. allocated(DstFilledGroupTypeData%FillMList)) then + allocate(DstFilledGroupTypeData%FillMList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFilledGroupTypeData%FillMList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFilledGroupTypeData%FillMList = SrcFilledGroupTypeData%FillMList + end if + DstFilledGroupTypeData%FillFSLoc = SrcFilledGroupTypeData%FillFSLoc + DstFilledGroupTypeData%FillDensChr = SrcFilledGroupTypeData%FillDensChr + DstFilledGroupTypeData%FillDens = SrcFilledGroupTypeData%FillDens +end subroutine + +subroutine Morison_DestroyFilledGroupType(FilledGroupTypeData, ErrStat, ErrMsg) + type(Morison_FilledGroupType), intent(inout) :: FilledGroupTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyFilledGroupType' ErrStat = ErrID_None - ErrMsg = "" - DstNodeTypeData%JointIndx = SrcNodeTypeData%JointIndx - DstNodeTypeData%Position = SrcNodeTypeData%Position - DstNodeTypeData%JointOvrlp = SrcNodeTypeData%JointOvrlp - DstNodeTypeData%JointAxIDIndx = SrcNodeTypeData%JointAxIDIndx - DstNodeTypeData%NConnections = SrcNodeTypeData%NConnections - DstNodeTypeData%ConnectionList = SrcNodeTypeData%ConnectionList - DstNodeTypeData%JAxCd = SrcNodeTypeData%JAxCd - DstNodeTypeData%JAxCa = SrcNodeTypeData%JAxCa - DstNodeTypeData%JAxCp = SrcNodeTypeData%JAxCp - DstNodeTypeData%JAxVnCOff = SrcNodeTypeData%JAxVnCOff - DstNodeTypeData%JAxFDLoFSc = SrcNodeTypeData%JAxFDLoFSc - DstNodeTypeData%JAxFDMod = SrcNodeTypeData%JAxFDMod - DstNodeTypeData%FillDensity = SrcNodeTypeData%FillDensity - DstNodeTypeData%tMG = SrcNodeTypeData%tMG - DstNodeTypeData%MGdensity = SrcNodeTypeData%MGdensity - END SUBROUTINE Morison_CopyNodeType - - SUBROUTINE Morison_DestroyNodeType( NodeTypeData, ErrStat, ErrMsg ) - TYPE(Morison_NodeType), INTENT(INOUT) :: NodeTypeData - 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 = 'Morison_DestroyNodeType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyNodeType - - SUBROUTINE Morison_PackNodeType( 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(Morison_NodeType), 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 = 'Morison_PackNodeType' - ! 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 ! JointIndx - Re_BufSz = Re_BufSz + SIZE(InData%Position) ! Position - Int_BufSz = Int_BufSz + 1 ! JointOvrlp - Int_BufSz = Int_BufSz + 1 ! JointAxIDIndx - Int_BufSz = Int_BufSz + 1 ! NConnections - Int_BufSz = Int_BufSz + SIZE(InData%ConnectionList) ! ConnectionList - Re_BufSz = Re_BufSz + 1 ! JAxCd - Re_BufSz = Re_BufSz + 1 ! JAxCa - Re_BufSz = Re_BufSz + 1 ! JAxCp - Re_BufSz = Re_BufSz + 1 ! JAxVnCOff - Re_BufSz = Re_BufSz + 1 ! JAxFDLoFSc - Int_BufSz = Int_BufSz + 1 ! JAxFDMod - Re_BufSz = Re_BufSz + 1 ! FillDensity - Re_BufSz = Re_BufSz + 1 ! tMG - Re_BufSz = Re_BufSz + 1 ! MGdensity - 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%JointIndx - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%Position,1), UBOUND(InData%Position,1) - ReKiBuf(Re_Xferred) = InData%Position(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%JointOvrlp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%JointAxIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NConnections - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%ConnectionList,1), UBOUND(InData%ConnectionList,1) - IntKiBuf(Int_Xferred) = InData%ConnectionList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%JAxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%JAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%JAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%JAxVnCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%JAxFDLoFSc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%JAxFDMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FillDensity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MGdensity - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackNodeType - - SUBROUTINE Morison_UnPackNodeType( 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_NodeType), 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 = 'Morison_UnPackNodeType' - ! 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%JointIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%Position,1) - i1_u = UBOUND(OutData%Position,1) - DO i1 = LBOUND(OutData%Position,1), UBOUND(OutData%Position,1) - OutData%Position(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%JointOvrlp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%JointAxIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NConnections = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%ConnectionList,1) - i1_u = UBOUND(OutData%ConnectionList,1) - DO i1 = LBOUND(OutData%ConnectionList,1), UBOUND(OutData%ConnectionList,1) - OutData%ConnectionList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%JAxCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%JAxCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%JAxCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%JAxVnCOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%JAxFDLoFSc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%JAxFDMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FillDensity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MGdensity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackNodeType - - SUBROUTINE Morison_CopyMemberType( SrcMemberTypeData, DstMemberTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MemberType), INTENT(IN) :: SrcMemberTypeData - TYPE(Morison_MemberType), INTENT(INOUT) :: DstMemberTypeData - 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 = 'Morison_CopyMemberType' -! + ErrMsg = '' + if (allocated(FilledGroupTypeData%FillMList)) then + deallocate(FilledGroupTypeData%FillMList) + end if +end subroutine + +subroutine Morison_PackFilledGroupType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_FilledGroupType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackFilledGroupType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%FillNumM) + call RegPack(Buf, allocated(InData%FillMList)) + if (allocated(InData%FillMList)) then + call RegPackBounds(Buf, 1, lbound(InData%FillMList), ubound(InData%FillMList)) + call RegPack(Buf, InData%FillMList) + end if + call RegPack(Buf, InData%FillFSLoc) + call RegPack(Buf, InData%FillDensChr) + call RegPack(Buf, InData%FillDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackFilledGroupType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_FilledGroupType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackFilledGroupType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%FillNumM) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%FillMList)) deallocate(OutData%FillMList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FillMList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FillMList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FillMList) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%FillFSLoc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FillDensChr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FillDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_CopyCoefDpths(SrcCoefDpthsData, DstCoefDpthsData, CtrlCode, ErrStat, ErrMsg) + type(Morison_CoefDpths), intent(in) :: SrcCoefDpthsData + type(Morison_CoefDpths), intent(inout) :: DstCoefDpthsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyCoefDpths' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMemberTypeData%NodeIndx)) THEN - i1_l = LBOUND(SrcMemberTypeData%NodeIndx,1) - i1_u = UBOUND(SrcMemberTypeData%NodeIndx,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%NodeIndx)) THEN - ALLOCATE(DstMemberTypeData%NodeIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%NodeIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%NodeIndx = SrcMemberTypeData%NodeIndx -ENDIF - DstMemberTypeData%MemberID = SrcMemberTypeData%MemberID - DstMemberTypeData%NElements = SrcMemberTypeData%NElements - DstMemberTypeData%RefLength = SrcMemberTypeData%RefLength - DstMemberTypeData%cosPhi_ref = SrcMemberTypeData%cosPhi_ref - DstMemberTypeData%dl = SrcMemberTypeData%dl - DstMemberTypeData%k = SrcMemberTypeData%k - DstMemberTypeData%kkt = SrcMemberTypeData%kkt - DstMemberTypeData%Ak = SrcMemberTypeData%Ak -IF (ALLOCATED(SrcMemberTypeData%R)) THEN - i1_l = LBOUND(SrcMemberTypeData%R,1) - i1_u = UBOUND(SrcMemberTypeData%R,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%R)) THEN - ALLOCATE(DstMemberTypeData%R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%R = SrcMemberTypeData%R -ENDIF -IF (ALLOCATED(SrcMemberTypeData%RMG)) THEN - i1_l = LBOUND(SrcMemberTypeData%RMG,1) - i1_u = UBOUND(SrcMemberTypeData%RMG,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%RMG)) THEN - ALLOCATE(DstMemberTypeData%RMG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%RMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%RMG = SrcMemberTypeData%RMG -ENDIF -IF (ALLOCATED(SrcMemberTypeData%RMGB)) THEN - i1_l = LBOUND(SrcMemberTypeData%RMGB,1) - i1_u = UBOUND(SrcMemberTypeData%RMGB,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%RMGB)) THEN - ALLOCATE(DstMemberTypeData%RMGB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%RMGB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%RMGB = SrcMemberTypeData%RMGB -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Rin)) THEN - i1_l = LBOUND(SrcMemberTypeData%Rin,1) - i1_u = UBOUND(SrcMemberTypeData%Rin,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Rin)) THEN - ALLOCATE(DstMemberTypeData%Rin(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Rin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Rin = SrcMemberTypeData%Rin -ENDIF -IF (ALLOCATED(SrcMemberTypeData%tMG)) THEN - i1_l = LBOUND(SrcMemberTypeData%tMG,1) - i1_u = UBOUND(SrcMemberTypeData%tMG,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%tMG)) THEN - ALLOCATE(DstMemberTypeData%tMG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%tMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%tMG = SrcMemberTypeData%tMG -ENDIF -IF (ALLOCATED(SrcMemberTypeData%MGdensity)) THEN - i1_l = LBOUND(SrcMemberTypeData%MGdensity,1) - i1_u = UBOUND(SrcMemberTypeData%MGdensity,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%MGdensity)) THEN - ALLOCATE(DstMemberTypeData%MGdensity(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%MGdensity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%MGdensity = SrcMemberTypeData%MGdensity -ENDIF -IF (ALLOCATED(SrcMemberTypeData%dRdl_mg)) THEN - i1_l = LBOUND(SrcMemberTypeData%dRdl_mg,1) - i1_u = UBOUND(SrcMemberTypeData%dRdl_mg,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%dRdl_mg)) THEN - ALLOCATE(DstMemberTypeData%dRdl_mg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_mg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%dRdl_mg = SrcMemberTypeData%dRdl_mg -ENDIF -IF (ALLOCATED(SrcMemberTypeData%dRdl_mg_b)) THEN - i1_l = LBOUND(SrcMemberTypeData%dRdl_mg_b,1) - i1_u = UBOUND(SrcMemberTypeData%dRdl_mg_b,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%dRdl_mg_b)) THEN - ALLOCATE(DstMemberTypeData%dRdl_mg_b(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_mg_b.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%dRdl_mg_b = SrcMemberTypeData%dRdl_mg_b -ENDIF -IF (ALLOCATED(SrcMemberTypeData%dRdl_in)) THEN - i1_l = LBOUND(SrcMemberTypeData%dRdl_in,1) - i1_u = UBOUND(SrcMemberTypeData%dRdl_in,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%dRdl_in)) THEN - ALLOCATE(DstMemberTypeData%dRdl_in(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_in.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%dRdl_in = SrcMemberTypeData%dRdl_in -ENDIF - DstMemberTypeData%Vinner = SrcMemberTypeData%Vinner - DstMemberTypeData%Vouter = SrcMemberTypeData%Vouter - DstMemberTypeData%Vballast = SrcMemberTypeData%Vballast - DstMemberTypeData%Vsubmerged = SrcMemberTypeData%Vsubmerged - DstMemberTypeData%l_fill = SrcMemberTypeData%l_fill - DstMemberTypeData%h_fill = SrcMemberTypeData%h_fill - DstMemberTypeData%z_overfill = SrcMemberTypeData%z_overfill - DstMemberTypeData%h_floor = SrcMemberTypeData%h_floor - DstMemberTypeData%i_floor = SrcMemberTypeData%i_floor - DstMemberTypeData%doEndBuoyancy = SrcMemberTypeData%doEndBuoyancy - DstMemberTypeData%memfloodstatus = SrcMemberTypeData%memfloodstatus -IF (ALLOCATED(SrcMemberTypeData%floodstatus)) THEN - i1_l = LBOUND(SrcMemberTypeData%floodstatus,1) - i1_u = UBOUND(SrcMemberTypeData%floodstatus,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%floodstatus)) THEN - ALLOCATE(DstMemberTypeData%floodstatus(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%floodstatus.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%floodstatus = SrcMemberTypeData%floodstatus -ENDIF -IF (ALLOCATED(SrcMemberTypeData%alpha)) THEN - i1_l = LBOUND(SrcMemberTypeData%alpha,1) - i1_u = UBOUND(SrcMemberTypeData%alpha,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%alpha)) THEN - ALLOCATE(DstMemberTypeData%alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%alpha = SrcMemberTypeData%alpha -ENDIF -IF (ALLOCATED(SrcMemberTypeData%alpha_fb)) THEN - i1_l = LBOUND(SrcMemberTypeData%alpha_fb,1) - i1_u = UBOUND(SrcMemberTypeData%alpha_fb,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%alpha_fb)) THEN - ALLOCATE(DstMemberTypeData%alpha_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%alpha_fb = SrcMemberTypeData%alpha_fb -ENDIF -IF (ALLOCATED(SrcMemberTypeData%alpha_fb_star)) THEN - i1_l = LBOUND(SrcMemberTypeData%alpha_fb_star,1) - i1_u = UBOUND(SrcMemberTypeData%alpha_fb_star,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%alpha_fb_star)) THEN - ALLOCATE(DstMemberTypeData%alpha_fb_star(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha_fb_star.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%alpha_fb_star = SrcMemberTypeData%alpha_fb_star -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Cd)) THEN - i1_l = LBOUND(SrcMemberTypeData%Cd,1) - i1_u = UBOUND(SrcMemberTypeData%Cd,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Cd)) THEN - ALLOCATE(DstMemberTypeData%Cd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Cd = SrcMemberTypeData%Cd -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Ca)) THEN - i1_l = LBOUND(SrcMemberTypeData%Ca,1) - i1_u = UBOUND(SrcMemberTypeData%Ca,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Ca)) THEN - ALLOCATE(DstMemberTypeData%Ca(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Ca.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Ca = SrcMemberTypeData%Ca -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Cp)) THEN - i1_l = LBOUND(SrcMemberTypeData%Cp,1) - i1_u = UBOUND(SrcMemberTypeData%Cp,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Cp)) THEN - ALLOCATE(DstMemberTypeData%Cp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Cp = SrcMemberTypeData%Cp -ENDIF -IF (ALLOCATED(SrcMemberTypeData%AxCd)) THEN - i1_l = LBOUND(SrcMemberTypeData%AxCd,1) - i1_u = UBOUND(SrcMemberTypeData%AxCd,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%AxCd)) THEN - ALLOCATE(DstMemberTypeData%AxCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%AxCd = SrcMemberTypeData%AxCd -ENDIF -IF (ALLOCATED(SrcMemberTypeData%AxCa)) THEN - i1_l = LBOUND(SrcMemberTypeData%AxCa,1) - i1_u = UBOUND(SrcMemberTypeData%AxCa,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%AxCa)) THEN - ALLOCATE(DstMemberTypeData%AxCa(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%AxCa = SrcMemberTypeData%AxCa -ENDIF -IF (ALLOCATED(SrcMemberTypeData%AxCp)) THEN - i1_l = LBOUND(SrcMemberTypeData%AxCp,1) - i1_u = UBOUND(SrcMemberTypeData%AxCp,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%AxCp)) THEN - ALLOCATE(DstMemberTypeData%AxCp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%AxCp = SrcMemberTypeData%AxCp -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Cb)) THEN - i1_l = LBOUND(SrcMemberTypeData%Cb,1) - i1_u = UBOUND(SrcMemberTypeData%Cb,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Cb)) THEN - ALLOCATE(DstMemberTypeData%Cb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Cb = SrcMemberTypeData%Cb -ENDIF -IF (ALLOCATED(SrcMemberTypeData%m_fb_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%m_fb_l,1) - i1_u = UBOUND(SrcMemberTypeData%m_fb_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%m_fb_l)) THEN - ALLOCATE(DstMemberTypeData%m_fb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_fb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%m_fb_l = SrcMemberTypeData%m_fb_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%m_fb_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%m_fb_u,1) - i1_u = UBOUND(SrcMemberTypeData%m_fb_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%m_fb_u)) THEN - ALLOCATE(DstMemberTypeData%m_fb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_fb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%m_fb_u = SrcMemberTypeData%m_fb_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%h_cfb_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%h_cfb_l,1) - i1_u = UBOUND(SrcMemberTypeData%h_cfb_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%h_cfb_l)) THEN - ALLOCATE(DstMemberTypeData%h_cfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%h_cfb_l = SrcMemberTypeData%h_cfb_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%h_cfb_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%h_cfb_u,1) - i1_u = UBOUND(SrcMemberTypeData%h_cfb_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%h_cfb_u)) THEN - ALLOCATE(DstMemberTypeData%h_cfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%h_cfb_u = SrcMemberTypeData%h_cfb_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_lfb_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_lfb_l,1) - i1_u = UBOUND(SrcMemberTypeData%I_lfb_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_lfb_l)) THEN - ALLOCATE(DstMemberTypeData%I_lfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_lfb_l = SrcMemberTypeData%I_lfb_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_lfb_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_lfb_u,1) - i1_u = UBOUND(SrcMemberTypeData%I_lfb_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_lfb_u)) THEN - ALLOCATE(DstMemberTypeData%I_lfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_lfb_u = SrcMemberTypeData%I_lfb_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_rfb_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_rfb_l,1) - i1_u = UBOUND(SrcMemberTypeData%I_rfb_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_rfb_l)) THEN - ALLOCATE(DstMemberTypeData%I_rfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_rfb_l = SrcMemberTypeData%I_rfb_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_rfb_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_rfb_u,1) - i1_u = UBOUND(SrcMemberTypeData%I_rfb_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_rfb_u)) THEN - ALLOCATE(DstMemberTypeData%I_rfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_rfb_u = SrcMemberTypeData%I_rfb_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%m_mg_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%m_mg_l,1) - i1_u = UBOUND(SrcMemberTypeData%m_mg_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%m_mg_l)) THEN - ALLOCATE(DstMemberTypeData%m_mg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_mg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%m_mg_l = SrcMemberTypeData%m_mg_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%m_mg_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%m_mg_u,1) - i1_u = UBOUND(SrcMemberTypeData%m_mg_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%m_mg_u)) THEN - ALLOCATE(DstMemberTypeData%m_mg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_mg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%m_mg_u = SrcMemberTypeData%m_mg_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%h_cmg_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%h_cmg_l,1) - i1_u = UBOUND(SrcMemberTypeData%h_cmg_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%h_cmg_l)) THEN - ALLOCATE(DstMemberTypeData%h_cmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%h_cmg_l = SrcMemberTypeData%h_cmg_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%h_cmg_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%h_cmg_u,1) - i1_u = UBOUND(SrcMemberTypeData%h_cmg_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%h_cmg_u)) THEN - ALLOCATE(DstMemberTypeData%h_cmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%h_cmg_u = SrcMemberTypeData%h_cmg_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_lmg_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_lmg_l,1) - i1_u = UBOUND(SrcMemberTypeData%I_lmg_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_lmg_l)) THEN - ALLOCATE(DstMemberTypeData%I_lmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_lmg_l = SrcMemberTypeData%I_lmg_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_lmg_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_lmg_u,1) - i1_u = UBOUND(SrcMemberTypeData%I_lmg_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_lmg_u)) THEN - ALLOCATE(DstMemberTypeData%I_lmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_lmg_u = SrcMemberTypeData%I_lmg_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_rmg_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_rmg_l,1) - i1_u = UBOUND(SrcMemberTypeData%I_rmg_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_rmg_l)) THEN - ALLOCATE(DstMemberTypeData%I_rmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_rmg_l = SrcMemberTypeData%I_rmg_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_rmg_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_rmg_u,1) - i1_u = UBOUND(SrcMemberTypeData%I_rmg_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_rmg_u)) THEN - ALLOCATE(DstMemberTypeData%I_rmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_rmg_u = SrcMemberTypeData%I_rmg_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Cfl_fb)) THEN - i1_l = LBOUND(SrcMemberTypeData%Cfl_fb,1) - i1_u = UBOUND(SrcMemberTypeData%Cfl_fb,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Cfl_fb)) THEN - ALLOCATE(DstMemberTypeData%Cfl_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cfl_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Cfl_fb = SrcMemberTypeData%Cfl_fb -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Cfr_fb)) THEN - i1_l = LBOUND(SrcMemberTypeData%Cfr_fb,1) - i1_u = UBOUND(SrcMemberTypeData%Cfr_fb,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Cfr_fb)) THEN - ALLOCATE(DstMemberTypeData%Cfr_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cfr_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Cfr_fb = SrcMemberTypeData%Cfr_fb -ENDIF -IF (ALLOCATED(SrcMemberTypeData%CM0_fb)) THEN - i1_l = LBOUND(SrcMemberTypeData%CM0_fb,1) - i1_u = UBOUND(SrcMemberTypeData%CM0_fb,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%CM0_fb)) THEN - ALLOCATE(DstMemberTypeData%CM0_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%CM0_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%CM0_fb = SrcMemberTypeData%CM0_fb -ENDIF - DstMemberTypeData%MGvolume = SrcMemberTypeData%MGvolume - DstMemberTypeData%MDivSize = SrcMemberTypeData%MDivSize - DstMemberTypeData%MCoefMod = SrcMemberTypeData%MCoefMod - DstMemberTypeData%MmbrCoefIDIndx = SrcMemberTypeData%MmbrCoefIDIndx - DstMemberTypeData%MmbrFilledIDIndx = SrcMemberTypeData%MmbrFilledIDIndx - DstMemberTypeData%MHstLMod = SrcMemberTypeData%MHstLMod - DstMemberTypeData%FillFSLoc = SrcMemberTypeData%FillFSLoc - DstMemberTypeData%FillDens = SrcMemberTypeData%FillDens - DstMemberTypeData%PropPot = SrcMemberTypeData%PropPot - DstMemberTypeData%PropMCF = SrcMemberTypeData%PropMCF - DstMemberTypeData%Flipped = SrcMemberTypeData%Flipped - END SUBROUTINE Morison_CopyMemberType - - SUBROUTINE Morison_DestroyMemberType( MemberTypeData, ErrStat, ErrMsg ) - TYPE(Morison_MemberType), INTENT(INOUT) :: MemberTypeData - 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 = 'Morison_DestroyMemberType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MemberTypeData%NodeIndx)) THEN - DEALLOCATE(MemberTypeData%NodeIndx) -ENDIF -IF (ALLOCATED(MemberTypeData%R)) THEN - DEALLOCATE(MemberTypeData%R) -ENDIF -IF (ALLOCATED(MemberTypeData%RMG)) THEN - DEALLOCATE(MemberTypeData%RMG) -ENDIF -IF (ALLOCATED(MemberTypeData%RMGB)) THEN - DEALLOCATE(MemberTypeData%RMGB) -ENDIF -IF (ALLOCATED(MemberTypeData%Rin)) THEN - DEALLOCATE(MemberTypeData%Rin) -ENDIF -IF (ALLOCATED(MemberTypeData%tMG)) THEN - DEALLOCATE(MemberTypeData%tMG) -ENDIF -IF (ALLOCATED(MemberTypeData%MGdensity)) THEN - DEALLOCATE(MemberTypeData%MGdensity) -ENDIF -IF (ALLOCATED(MemberTypeData%dRdl_mg)) THEN - DEALLOCATE(MemberTypeData%dRdl_mg) -ENDIF -IF (ALLOCATED(MemberTypeData%dRdl_mg_b)) THEN - DEALLOCATE(MemberTypeData%dRdl_mg_b) -ENDIF -IF (ALLOCATED(MemberTypeData%dRdl_in)) THEN - DEALLOCATE(MemberTypeData%dRdl_in) -ENDIF -IF (ALLOCATED(MemberTypeData%floodstatus)) THEN - DEALLOCATE(MemberTypeData%floodstatus) -ENDIF -IF (ALLOCATED(MemberTypeData%alpha)) THEN - DEALLOCATE(MemberTypeData%alpha) -ENDIF -IF (ALLOCATED(MemberTypeData%alpha_fb)) THEN - DEALLOCATE(MemberTypeData%alpha_fb) -ENDIF -IF (ALLOCATED(MemberTypeData%alpha_fb_star)) THEN - DEALLOCATE(MemberTypeData%alpha_fb_star) -ENDIF -IF (ALLOCATED(MemberTypeData%Cd)) THEN - DEALLOCATE(MemberTypeData%Cd) -ENDIF -IF (ALLOCATED(MemberTypeData%Ca)) THEN - DEALLOCATE(MemberTypeData%Ca) -ENDIF -IF (ALLOCATED(MemberTypeData%Cp)) THEN - DEALLOCATE(MemberTypeData%Cp) -ENDIF -IF (ALLOCATED(MemberTypeData%AxCd)) THEN - DEALLOCATE(MemberTypeData%AxCd) -ENDIF -IF (ALLOCATED(MemberTypeData%AxCa)) THEN - DEALLOCATE(MemberTypeData%AxCa) -ENDIF -IF (ALLOCATED(MemberTypeData%AxCp)) THEN - DEALLOCATE(MemberTypeData%AxCp) -ENDIF -IF (ALLOCATED(MemberTypeData%Cb)) THEN - DEALLOCATE(MemberTypeData%Cb) -ENDIF -IF (ALLOCATED(MemberTypeData%m_fb_l)) THEN - DEALLOCATE(MemberTypeData%m_fb_l) -ENDIF -IF (ALLOCATED(MemberTypeData%m_fb_u)) THEN - DEALLOCATE(MemberTypeData%m_fb_u) -ENDIF -IF (ALLOCATED(MemberTypeData%h_cfb_l)) THEN - DEALLOCATE(MemberTypeData%h_cfb_l) -ENDIF -IF (ALLOCATED(MemberTypeData%h_cfb_u)) THEN - DEALLOCATE(MemberTypeData%h_cfb_u) -ENDIF -IF (ALLOCATED(MemberTypeData%I_lfb_l)) THEN - DEALLOCATE(MemberTypeData%I_lfb_l) -ENDIF -IF (ALLOCATED(MemberTypeData%I_lfb_u)) THEN - DEALLOCATE(MemberTypeData%I_lfb_u) -ENDIF -IF (ALLOCATED(MemberTypeData%I_rfb_l)) THEN - DEALLOCATE(MemberTypeData%I_rfb_l) -ENDIF -IF (ALLOCATED(MemberTypeData%I_rfb_u)) THEN - DEALLOCATE(MemberTypeData%I_rfb_u) -ENDIF -IF (ALLOCATED(MemberTypeData%m_mg_l)) THEN - DEALLOCATE(MemberTypeData%m_mg_l) -ENDIF -IF (ALLOCATED(MemberTypeData%m_mg_u)) THEN - DEALLOCATE(MemberTypeData%m_mg_u) -ENDIF -IF (ALLOCATED(MemberTypeData%h_cmg_l)) THEN - DEALLOCATE(MemberTypeData%h_cmg_l) -ENDIF -IF (ALLOCATED(MemberTypeData%h_cmg_u)) THEN - DEALLOCATE(MemberTypeData%h_cmg_u) -ENDIF -IF (ALLOCATED(MemberTypeData%I_lmg_l)) THEN - DEALLOCATE(MemberTypeData%I_lmg_l) -ENDIF -IF (ALLOCATED(MemberTypeData%I_lmg_u)) THEN - DEALLOCATE(MemberTypeData%I_lmg_u) -ENDIF -IF (ALLOCATED(MemberTypeData%I_rmg_l)) THEN - DEALLOCATE(MemberTypeData%I_rmg_l) -ENDIF -IF (ALLOCATED(MemberTypeData%I_rmg_u)) THEN - DEALLOCATE(MemberTypeData%I_rmg_u) -ENDIF -IF (ALLOCATED(MemberTypeData%Cfl_fb)) THEN - DEALLOCATE(MemberTypeData%Cfl_fb) -ENDIF -IF (ALLOCATED(MemberTypeData%Cfr_fb)) THEN - DEALLOCATE(MemberTypeData%Cfr_fb) -ENDIF -IF (ALLOCATED(MemberTypeData%CM0_fb)) THEN - DEALLOCATE(MemberTypeData%CM0_fb) -ENDIF - END SUBROUTINE Morison_DestroyMemberType - - SUBROUTINE Morison_PackMemberType( 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(Morison_MemberType), 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 = 'Morison_PackMemberType' - ! 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 ! NodeIndx allocated yes/no - IF ( ALLOCATED(InData%NodeIndx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeIndx) ! NodeIndx - END IF - Int_BufSz = Int_BufSz + 1 ! MemberID - Int_BufSz = Int_BufSz + 1 ! NElements - Re_BufSz = Re_BufSz + 1 ! RefLength - Re_BufSz = Re_BufSz + 1 ! cosPhi_ref - Re_BufSz = Re_BufSz + 1 ! dl - Re_BufSz = Re_BufSz + SIZE(InData%k) ! k - Re_BufSz = Re_BufSz + SIZE(InData%kkt) ! kkt - Re_BufSz = Re_BufSz + SIZE(InData%Ak) ! Ak - Int_BufSz = Int_BufSz + 1 ! R allocated yes/no - IF ( ALLOCATED(InData%R) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! R upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%R) ! R - END IF - Int_BufSz = Int_BufSz + 1 ! RMG allocated yes/no - IF ( ALLOCATED(InData%RMG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RMG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RMG) ! RMG - END IF - Int_BufSz = Int_BufSz + 1 ! RMGB allocated yes/no - IF ( ALLOCATED(InData%RMGB) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RMGB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RMGB) ! RMGB - END IF - Int_BufSz = Int_BufSz + 1 ! Rin allocated yes/no - IF ( ALLOCATED(InData%Rin) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Rin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Rin) ! Rin - END IF - Int_BufSz = Int_BufSz + 1 ! tMG allocated yes/no - IF ( ALLOCATED(InData%tMG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! tMG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tMG) ! tMG - END IF - Int_BufSz = Int_BufSz + 1 ! MGdensity allocated yes/no - IF ( ALLOCATED(InData%MGdensity) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MGdensity upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MGdensity) ! MGdensity - END IF - Int_BufSz = Int_BufSz + 1 ! dRdl_mg allocated yes/no - IF ( ALLOCATED(InData%dRdl_mg) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dRdl_mg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dRdl_mg) ! dRdl_mg - END IF - Int_BufSz = Int_BufSz + 1 ! dRdl_mg_b allocated yes/no - IF ( ALLOCATED(InData%dRdl_mg_b) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dRdl_mg_b upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dRdl_mg_b) ! dRdl_mg_b - END IF - Int_BufSz = Int_BufSz + 1 ! dRdl_in allocated yes/no - IF ( ALLOCATED(InData%dRdl_in) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dRdl_in upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dRdl_in) ! dRdl_in - END IF - Re_BufSz = Re_BufSz + 1 ! Vinner - Re_BufSz = Re_BufSz + 1 ! Vouter - Re_BufSz = Re_BufSz + 1 ! Vballast - Re_BufSz = Re_BufSz + 1 ! Vsubmerged - Re_BufSz = Re_BufSz + 1 ! l_fill - Re_BufSz = Re_BufSz + 1 ! h_fill - Re_BufSz = Re_BufSz + 1 ! z_overfill - Re_BufSz = Re_BufSz + 1 ! h_floor - Int_BufSz = Int_BufSz + 1 ! i_floor - Int_BufSz = Int_BufSz + 1 ! doEndBuoyancy - Int_BufSz = Int_BufSz + 1 ! memfloodstatus - Int_BufSz = Int_BufSz + 1 ! floodstatus allocated yes/no - IF ( ALLOCATED(InData%floodstatus) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! floodstatus upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%floodstatus) ! floodstatus - END IF - Int_BufSz = Int_BufSz + 1 ! alpha allocated yes/no - IF ( ALLOCATED(InData%alpha) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! alpha upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha) ! alpha - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_fb allocated yes/no - IF ( ALLOCATED(InData%alpha_fb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! alpha_fb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_fb) ! alpha_fb - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_fb_star allocated yes/no - IF ( ALLOCATED(InData%alpha_fb_star) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! alpha_fb_star upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_fb_star) ! alpha_fb_star - END IF - Int_BufSz = Int_BufSz + 1 ! Cd allocated yes/no - IF ( ALLOCATED(InData%Cd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cd) ! Cd - END IF - Int_BufSz = Int_BufSz + 1 ! Ca allocated yes/no - IF ( ALLOCATED(InData%Ca) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Ca upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Ca) ! Ca - END IF - Int_BufSz = Int_BufSz + 1 ! Cp allocated yes/no - IF ( ALLOCATED(InData%Cp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cp) ! Cp - END IF - Int_BufSz = Int_BufSz + 1 ! AxCd allocated yes/no - IF ( ALLOCATED(InData%AxCd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AxCd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxCd) ! AxCd - END IF - Int_BufSz = Int_BufSz + 1 ! AxCa allocated yes/no - IF ( ALLOCATED(InData%AxCa) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AxCa upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxCa) ! AxCa - END IF - Int_BufSz = Int_BufSz + 1 ! AxCp allocated yes/no - IF ( ALLOCATED(InData%AxCp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AxCp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxCp) ! AxCp - END IF - Int_BufSz = Int_BufSz + 1 ! Cb allocated yes/no - IF ( ALLOCATED(InData%Cb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cb) ! Cb - END IF - Int_BufSz = Int_BufSz + 1 ! m_fb_l allocated yes/no - IF ( ALLOCATED(InData%m_fb_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m_fb_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%m_fb_l) ! m_fb_l - END IF - Int_BufSz = Int_BufSz + 1 ! m_fb_u allocated yes/no - IF ( ALLOCATED(InData%m_fb_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m_fb_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%m_fb_u) ! m_fb_u - END IF - Int_BufSz = Int_BufSz + 1 ! h_cfb_l allocated yes/no - IF ( ALLOCATED(InData%h_cfb_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! h_cfb_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%h_cfb_l) ! h_cfb_l - END IF - Int_BufSz = Int_BufSz + 1 ! h_cfb_u allocated yes/no - IF ( ALLOCATED(InData%h_cfb_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! h_cfb_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%h_cfb_u) ! h_cfb_u - END IF - Int_BufSz = Int_BufSz + 1 ! I_lfb_l allocated yes/no - IF ( ALLOCATED(InData%I_lfb_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_lfb_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_lfb_l) ! I_lfb_l - END IF - Int_BufSz = Int_BufSz + 1 ! I_lfb_u allocated yes/no - IF ( ALLOCATED(InData%I_lfb_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_lfb_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_lfb_u) ! I_lfb_u - END IF - Int_BufSz = Int_BufSz + 1 ! I_rfb_l allocated yes/no - IF ( ALLOCATED(InData%I_rfb_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_rfb_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_rfb_l) ! I_rfb_l - END IF - Int_BufSz = Int_BufSz + 1 ! I_rfb_u allocated yes/no - IF ( ALLOCATED(InData%I_rfb_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_rfb_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_rfb_u) ! I_rfb_u - END IF - Int_BufSz = Int_BufSz + 1 ! m_mg_l allocated yes/no - IF ( ALLOCATED(InData%m_mg_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m_mg_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%m_mg_l) ! m_mg_l - END IF - Int_BufSz = Int_BufSz + 1 ! m_mg_u allocated yes/no - IF ( ALLOCATED(InData%m_mg_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m_mg_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%m_mg_u) ! m_mg_u - END IF - Int_BufSz = Int_BufSz + 1 ! h_cmg_l allocated yes/no - IF ( ALLOCATED(InData%h_cmg_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! h_cmg_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%h_cmg_l) ! h_cmg_l - END IF - Int_BufSz = Int_BufSz + 1 ! h_cmg_u allocated yes/no - IF ( ALLOCATED(InData%h_cmg_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! h_cmg_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%h_cmg_u) ! h_cmg_u - END IF - Int_BufSz = Int_BufSz + 1 ! I_lmg_l allocated yes/no - IF ( ALLOCATED(InData%I_lmg_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_lmg_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_lmg_l) ! I_lmg_l - END IF - Int_BufSz = Int_BufSz + 1 ! I_lmg_u allocated yes/no - IF ( ALLOCATED(InData%I_lmg_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_lmg_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_lmg_u) ! I_lmg_u - END IF - Int_BufSz = Int_BufSz + 1 ! I_rmg_l allocated yes/no - IF ( ALLOCATED(InData%I_rmg_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_rmg_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_rmg_l) ! I_rmg_l - END IF - Int_BufSz = Int_BufSz + 1 ! I_rmg_u allocated yes/no - IF ( ALLOCATED(InData%I_rmg_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_rmg_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_rmg_u) ! I_rmg_u - END IF - Int_BufSz = Int_BufSz + 1 ! Cfl_fb allocated yes/no - IF ( ALLOCATED(InData%Cfl_fb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cfl_fb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cfl_fb) ! Cfl_fb - END IF - Int_BufSz = Int_BufSz + 1 ! Cfr_fb allocated yes/no - IF ( ALLOCATED(InData%Cfr_fb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cfr_fb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cfr_fb) ! Cfr_fb - END IF - Int_BufSz = Int_BufSz + 1 ! CM0_fb allocated yes/no - IF ( ALLOCATED(InData%CM0_fb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CM0_fb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CM0_fb) ! CM0_fb - END IF - Re_BufSz = Re_BufSz + 1 ! MGvolume - Re_BufSz = Re_BufSz + 1 ! MDivSize - Int_BufSz = Int_BufSz + 1 ! MCoefMod - Int_BufSz = Int_BufSz + 1 ! MmbrCoefIDIndx - Int_BufSz = Int_BufSz + 1 ! MmbrFilledIDIndx - Int_BufSz = Int_BufSz + 1 ! MHstLMod - Re_BufSz = Re_BufSz + 1 ! FillFSLoc - Re_BufSz = Re_BufSz + 1 ! FillDens - Int_BufSz = Int_BufSz + 1 ! PropPot - Int_BufSz = Int_BufSz + 1 ! PropMCF - Int_BufSz = Int_BufSz + 1 ! Flipped - 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%NodeIndx) ) 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%NodeIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeIndx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeIndx,1), UBOUND(InData%NodeIndx,1) - IntKiBuf(Int_Xferred) = InData%NodeIndx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NElements - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%cosPhi_ref - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dl - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%k,1), UBOUND(InData%k,1) - ReKiBuf(Re_Xferred) = InData%k(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%kkt,2), UBOUND(InData%kkt,2) - DO i1 = LBOUND(InData%kkt,1), UBOUND(InData%kkt,1) - ReKiBuf(Re_Xferred) = InData%kkt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%Ak,2), UBOUND(InData%Ak,2) - DO i1 = LBOUND(InData%Ak,1), UBOUND(InData%Ak,1) - ReKiBuf(Re_Xferred) = InData%Ak(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%R) ) 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%R,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%R,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%R,1), UBOUND(InData%R,1) - ReKiBuf(Re_Xferred) = InData%R(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RMG) ) 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%RMG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RMG,1), UBOUND(InData%RMG,1) - ReKiBuf(Re_Xferred) = InData%RMG(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RMGB) ) 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%RMGB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMGB,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RMGB,1), UBOUND(InData%RMGB,1) - ReKiBuf(Re_Xferred) = InData%RMGB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Rin) ) 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%Rin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Rin,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Rin,1), UBOUND(InData%Rin,1) - ReKiBuf(Re_Xferred) = InData%Rin(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tMG) ) 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%tMG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tMG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%tMG,1), UBOUND(InData%tMG,1) - ReKiBuf(Re_Xferred) = InData%tMG(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MGdensity) ) 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%MGdensity,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MGdensity,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MGdensity,1), UBOUND(InData%MGdensity,1) - ReKiBuf(Re_Xferred) = InData%MGdensity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dRdl_mg) ) 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%dRdl_mg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dRdl_mg,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dRdl_mg,1), UBOUND(InData%dRdl_mg,1) - ReKiBuf(Re_Xferred) = InData%dRdl_mg(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dRdl_mg_b) ) 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%dRdl_mg_b,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dRdl_mg_b,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dRdl_mg_b,1), UBOUND(InData%dRdl_mg_b,1) - ReKiBuf(Re_Xferred) = InData%dRdl_mg_b(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dRdl_in) ) 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%dRdl_in,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dRdl_in,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dRdl_in,1), UBOUND(InData%dRdl_in,1) - ReKiBuf(Re_Xferred) = InData%dRdl_in(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Vinner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vouter - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vballast - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vsubmerged - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%l_fill - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%h_fill - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%z_overfill - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%h_floor - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%i_floor - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%doEndBuoyancy, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%memfloodstatus - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%floodstatus) ) 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%floodstatus,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%floodstatus,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%floodstatus,1), UBOUND(InData%floodstatus,1) - IntKiBuf(Int_Xferred) = InData%floodstatus(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha) ) 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%alpha,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%alpha,1), UBOUND(InData%alpha,1) - ReKiBuf(Re_Xferred) = InData%alpha(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_fb) ) 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%alpha_fb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_fb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%alpha_fb,1), UBOUND(InData%alpha_fb,1) - ReKiBuf(Re_Xferred) = InData%alpha_fb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_fb_star) ) 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%alpha_fb_star,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_fb_star,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%alpha_fb_star,1), UBOUND(InData%alpha_fb_star,1) - ReKiBuf(Re_Xferred) = InData%alpha_fb_star(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cd) ) 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%Cd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cd,1), UBOUND(InData%Cd,1) - ReKiBuf(Re_Xferred) = InData%Cd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ca) ) 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%Ca,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ca,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Ca,1), UBOUND(InData%Ca,1) - ReKiBuf(Re_Xferred) = InData%Ca(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cp) ) 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%Cp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cp,1), UBOUND(InData%Cp,1) - ReKiBuf(Re_Xferred) = InData%Cp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxCd) ) 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%AxCd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxCd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AxCd,1), UBOUND(InData%AxCd,1) - ReKiBuf(Re_Xferred) = InData%AxCd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxCa) ) 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%AxCa,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxCa,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AxCa,1), UBOUND(InData%AxCa,1) - ReKiBuf(Re_Xferred) = InData%AxCa(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxCp) ) 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%AxCp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxCp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AxCp,1), UBOUND(InData%AxCp,1) - ReKiBuf(Re_Xferred) = InData%AxCp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cb) ) 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%Cb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cb,1), UBOUND(InData%Cb,1) - ReKiBuf(Re_Xferred) = InData%Cb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m_fb_l) ) 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%m_fb_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m_fb_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m_fb_l,1), UBOUND(InData%m_fb_l,1) - ReKiBuf(Re_Xferred) = InData%m_fb_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m_fb_u) ) 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%m_fb_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m_fb_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m_fb_u,1), UBOUND(InData%m_fb_u,1) - ReKiBuf(Re_Xferred) = InData%m_fb_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%h_cfb_l) ) 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%h_cfb_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%h_cfb_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%h_cfb_l,1), UBOUND(InData%h_cfb_l,1) - ReKiBuf(Re_Xferred) = InData%h_cfb_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%h_cfb_u) ) 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%h_cfb_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%h_cfb_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%h_cfb_u,1), UBOUND(InData%h_cfb_u,1) - ReKiBuf(Re_Xferred) = InData%h_cfb_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_lfb_l) ) 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%I_lfb_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_lfb_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_lfb_l,1), UBOUND(InData%I_lfb_l,1) - ReKiBuf(Re_Xferred) = InData%I_lfb_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_lfb_u) ) 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%I_lfb_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_lfb_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_lfb_u,1), UBOUND(InData%I_lfb_u,1) - ReKiBuf(Re_Xferred) = InData%I_lfb_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_rfb_l) ) 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%I_rfb_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_rfb_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_rfb_l,1), UBOUND(InData%I_rfb_l,1) - ReKiBuf(Re_Xferred) = InData%I_rfb_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_rfb_u) ) 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%I_rfb_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_rfb_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_rfb_u,1), UBOUND(InData%I_rfb_u,1) - ReKiBuf(Re_Xferred) = InData%I_rfb_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m_mg_l) ) 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%m_mg_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m_mg_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m_mg_l,1), UBOUND(InData%m_mg_l,1) - ReKiBuf(Re_Xferred) = InData%m_mg_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m_mg_u) ) 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%m_mg_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m_mg_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m_mg_u,1), UBOUND(InData%m_mg_u,1) - ReKiBuf(Re_Xferred) = InData%m_mg_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%h_cmg_l) ) 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%h_cmg_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%h_cmg_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%h_cmg_l,1), UBOUND(InData%h_cmg_l,1) - ReKiBuf(Re_Xferred) = InData%h_cmg_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%h_cmg_u) ) 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%h_cmg_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%h_cmg_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%h_cmg_u,1), UBOUND(InData%h_cmg_u,1) - ReKiBuf(Re_Xferred) = InData%h_cmg_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_lmg_l) ) 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%I_lmg_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_lmg_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_lmg_l,1), UBOUND(InData%I_lmg_l,1) - ReKiBuf(Re_Xferred) = InData%I_lmg_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_lmg_u) ) 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%I_lmg_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_lmg_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_lmg_u,1), UBOUND(InData%I_lmg_u,1) - ReKiBuf(Re_Xferred) = InData%I_lmg_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_rmg_l) ) 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%I_rmg_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_rmg_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_rmg_l,1), UBOUND(InData%I_rmg_l,1) - ReKiBuf(Re_Xferred) = InData%I_rmg_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_rmg_u) ) 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%I_rmg_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_rmg_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_rmg_u,1), UBOUND(InData%I_rmg_u,1) - ReKiBuf(Re_Xferred) = InData%I_rmg_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cfl_fb) ) 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%Cfl_fb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cfl_fb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cfl_fb,1), UBOUND(InData%Cfl_fb,1) - ReKiBuf(Re_Xferred) = InData%Cfl_fb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cfr_fb) ) 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%Cfr_fb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cfr_fb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cfr_fb,1), UBOUND(InData%Cfr_fb,1) - ReKiBuf(Re_Xferred) = InData%Cfr_fb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CM0_fb) ) 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%CM0_fb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM0_fb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CM0_fb,1), UBOUND(InData%CM0_fb,1) - ReKiBuf(Re_Xferred) = InData%CM0_fb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%MGvolume - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MDivSize - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MCoefMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MmbrCoefIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MmbrFilledIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHstLMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FillFSLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FillDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PropPot, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PropMCF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Flipped, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackMemberType - - SUBROUTINE Morison_UnPackMemberType( 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_MemberType), 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 = 'Morison_UnPackMemberType' - ! 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 ! NodeIndx 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%NodeIndx)) DEALLOCATE(OutData%NodeIndx) - ALLOCATE(OutData%NodeIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeIndx,1), UBOUND(OutData%NodeIndx,1) - OutData%NodeIndx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%MemberID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NElements = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%cosPhi_ref = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%k,1) - i1_u = UBOUND(OutData%k,1) - DO i1 = LBOUND(OutData%k,1), UBOUND(OutData%k,1) - OutData%k(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%kkt,1) - i1_u = UBOUND(OutData%kkt,1) - i2_l = LBOUND(OutData%kkt,2) - i2_u = UBOUND(OutData%kkt,2) - DO i2 = LBOUND(OutData%kkt,2), UBOUND(OutData%kkt,2) - DO i1 = LBOUND(OutData%kkt,1), UBOUND(OutData%kkt,1) - OutData%kkt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%Ak,1) - i1_u = UBOUND(OutData%Ak,1) - i2_l = LBOUND(OutData%Ak,2) - i2_u = UBOUND(OutData%Ak,2) - DO i2 = LBOUND(OutData%Ak,2), UBOUND(OutData%Ak,2) - DO i1 = LBOUND(OutData%Ak,1), UBOUND(OutData%Ak,1) - OutData%Ak(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! R 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%R)) DEALLOCATE(OutData%R) - ALLOCATE(OutData%R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%R,1), UBOUND(OutData%R,1) - OutData%R(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RMG 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%RMG)) DEALLOCATE(OutData%RMG) - ALLOCATE(OutData%RMG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RMG,1), UBOUND(OutData%RMG,1) - OutData%RMG(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RMGB 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%RMGB)) DEALLOCATE(OutData%RMGB) - ALLOCATE(OutData%RMGB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMGB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RMGB,1), UBOUND(OutData%RMGB,1) - OutData%RMGB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Rin 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%Rin)) DEALLOCATE(OutData%Rin) - ALLOCATE(OutData%Rin(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Rin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Rin,1), UBOUND(OutData%Rin,1) - OutData%Rin(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tMG 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%tMG)) DEALLOCATE(OutData%tMG) - ALLOCATE(OutData%tMG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%tMG,1), UBOUND(OutData%tMG,1) - OutData%tMG(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MGdensity 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%MGdensity)) DEALLOCATE(OutData%MGdensity) - ALLOCATE(OutData%MGdensity(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MGdensity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MGdensity,1), UBOUND(OutData%MGdensity,1) - OutData%MGdensity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dRdl_mg 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%dRdl_mg)) DEALLOCATE(OutData%dRdl_mg) - ALLOCATE(OutData%dRdl_mg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_mg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dRdl_mg,1), UBOUND(OutData%dRdl_mg,1) - OutData%dRdl_mg(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dRdl_mg_b 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%dRdl_mg_b)) DEALLOCATE(OutData%dRdl_mg_b) - ALLOCATE(OutData%dRdl_mg_b(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_mg_b.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dRdl_mg_b,1), UBOUND(OutData%dRdl_mg_b,1) - OutData%dRdl_mg_b(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dRdl_in 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%dRdl_in)) DEALLOCATE(OutData%dRdl_in) - ALLOCATE(OutData%dRdl_in(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_in.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dRdl_in,1), UBOUND(OutData%dRdl_in,1) - OutData%dRdl_in(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Vinner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vouter = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vballast = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vsubmerged = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%l_fill = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%h_fill = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%z_overfill = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%h_floor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%i_floor = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%doEndBuoyancy = TRANSFER(IntKiBuf(Int_Xferred), OutData%doEndBuoyancy) - Int_Xferred = Int_Xferred + 1 - OutData%memfloodstatus = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! floodstatus 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%floodstatus)) DEALLOCATE(OutData%floodstatus) - ALLOCATE(OutData%floodstatus(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%floodstatus.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%floodstatus,1), UBOUND(OutData%floodstatus,1) - OutData%floodstatus(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha 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%alpha)) DEALLOCATE(OutData%alpha) - ALLOCATE(OutData%alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%alpha,1), UBOUND(OutData%alpha,1) - OutData%alpha(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_fb 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%alpha_fb)) DEALLOCATE(OutData%alpha_fb) - ALLOCATE(OutData%alpha_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%alpha_fb,1), UBOUND(OutData%alpha_fb,1) - OutData%alpha_fb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_fb_star 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%alpha_fb_star)) DEALLOCATE(OutData%alpha_fb_star) - ALLOCATE(OutData%alpha_fb_star(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_fb_star.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%alpha_fb_star,1), UBOUND(OutData%alpha_fb_star,1) - OutData%alpha_fb_star(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cd 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%Cd)) DEALLOCATE(OutData%Cd) - ALLOCATE(OutData%Cd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cd,1), UBOUND(OutData%Cd,1) - OutData%Cd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ca 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%Ca)) DEALLOCATE(OutData%Ca) - ALLOCATE(OutData%Ca(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ca.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Ca,1), UBOUND(OutData%Ca,1) - OutData%Ca(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cp 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%Cp)) DEALLOCATE(OutData%Cp) - ALLOCATE(OutData%Cp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cp,1), UBOUND(OutData%Cp,1) - OutData%Cp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxCd 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%AxCd)) DEALLOCATE(OutData%AxCd) - ALLOCATE(OutData%AxCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AxCd,1), UBOUND(OutData%AxCd,1) - OutData%AxCd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxCa 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%AxCa)) DEALLOCATE(OutData%AxCa) - ALLOCATE(OutData%AxCa(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AxCa,1), UBOUND(OutData%AxCa,1) - OutData%AxCa(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxCp 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%AxCp)) DEALLOCATE(OutData%AxCp) - ALLOCATE(OutData%AxCp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AxCp,1), UBOUND(OutData%AxCp,1) - OutData%AxCp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cb 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%Cb)) DEALLOCATE(OutData%Cb) - ALLOCATE(OutData%Cb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cb,1), UBOUND(OutData%Cb,1) - OutData%Cb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m_fb_l 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%m_fb_l)) DEALLOCATE(OutData%m_fb_l) - ALLOCATE(OutData%m_fb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_fb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m_fb_l,1), UBOUND(OutData%m_fb_l,1) - OutData%m_fb_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m_fb_u 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%m_fb_u)) DEALLOCATE(OutData%m_fb_u) - ALLOCATE(OutData%m_fb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_fb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m_fb_u,1), UBOUND(OutData%m_fb_u,1) - OutData%m_fb_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! h_cfb_l 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%h_cfb_l)) DEALLOCATE(OutData%h_cfb_l) - ALLOCATE(OutData%h_cfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%h_cfb_l,1), UBOUND(OutData%h_cfb_l,1) - OutData%h_cfb_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! h_cfb_u 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%h_cfb_u)) DEALLOCATE(OutData%h_cfb_u) - ALLOCATE(OutData%h_cfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%h_cfb_u,1), UBOUND(OutData%h_cfb_u,1) - OutData%h_cfb_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_lfb_l 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%I_lfb_l)) DEALLOCATE(OutData%I_lfb_l) - ALLOCATE(OutData%I_lfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_lfb_l,1), UBOUND(OutData%I_lfb_l,1) - OutData%I_lfb_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_lfb_u 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%I_lfb_u)) DEALLOCATE(OutData%I_lfb_u) - ALLOCATE(OutData%I_lfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_lfb_u,1), UBOUND(OutData%I_lfb_u,1) - OutData%I_lfb_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_rfb_l 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%I_rfb_l)) DEALLOCATE(OutData%I_rfb_l) - ALLOCATE(OutData%I_rfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_rfb_l,1), UBOUND(OutData%I_rfb_l,1) - OutData%I_rfb_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_rfb_u 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%I_rfb_u)) DEALLOCATE(OutData%I_rfb_u) - ALLOCATE(OutData%I_rfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_rfb_u,1), UBOUND(OutData%I_rfb_u,1) - OutData%I_rfb_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m_mg_l 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%m_mg_l)) DEALLOCATE(OutData%m_mg_l) - ALLOCATE(OutData%m_mg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_mg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m_mg_l,1), UBOUND(OutData%m_mg_l,1) - OutData%m_mg_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m_mg_u 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%m_mg_u)) DEALLOCATE(OutData%m_mg_u) - ALLOCATE(OutData%m_mg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_mg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m_mg_u,1), UBOUND(OutData%m_mg_u,1) - OutData%m_mg_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! h_cmg_l 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%h_cmg_l)) DEALLOCATE(OutData%h_cmg_l) - ALLOCATE(OutData%h_cmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%h_cmg_l,1), UBOUND(OutData%h_cmg_l,1) - OutData%h_cmg_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! h_cmg_u 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%h_cmg_u)) DEALLOCATE(OutData%h_cmg_u) - ALLOCATE(OutData%h_cmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%h_cmg_u,1), UBOUND(OutData%h_cmg_u,1) - OutData%h_cmg_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_lmg_l 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%I_lmg_l)) DEALLOCATE(OutData%I_lmg_l) - ALLOCATE(OutData%I_lmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_lmg_l,1), UBOUND(OutData%I_lmg_l,1) - OutData%I_lmg_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_lmg_u 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%I_lmg_u)) DEALLOCATE(OutData%I_lmg_u) - ALLOCATE(OutData%I_lmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_lmg_u,1), UBOUND(OutData%I_lmg_u,1) - OutData%I_lmg_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_rmg_l 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%I_rmg_l)) DEALLOCATE(OutData%I_rmg_l) - ALLOCATE(OutData%I_rmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_rmg_l,1), UBOUND(OutData%I_rmg_l,1) - OutData%I_rmg_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_rmg_u 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%I_rmg_u)) DEALLOCATE(OutData%I_rmg_u) - ALLOCATE(OutData%I_rmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_rmg_u,1), UBOUND(OutData%I_rmg_u,1) - OutData%I_rmg_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cfl_fb 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%Cfl_fb)) DEALLOCATE(OutData%Cfl_fb) - ALLOCATE(OutData%Cfl_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cfl_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cfl_fb,1), UBOUND(OutData%Cfl_fb,1) - OutData%Cfl_fb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cfr_fb 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%Cfr_fb)) DEALLOCATE(OutData%Cfr_fb) - ALLOCATE(OutData%Cfr_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cfr_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cfr_fb,1), UBOUND(OutData%Cfr_fb,1) - OutData%Cfr_fb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CM0_fb 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%CM0_fb)) DEALLOCATE(OutData%CM0_fb) - ALLOCATE(OutData%CM0_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CM0_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CM0_fb,1), UBOUND(OutData%CM0_fb,1) - OutData%CM0_fb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%MGvolume = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MDivSize = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MCoefMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrCoefIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrFilledIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MHstLMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FillFSLoc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FillDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PropPot = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropPot) - Int_Xferred = Int_Xferred + 1 - OutData%PropMCF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropMCF) - Int_Xferred = Int_Xferred + 1 - OutData%Flipped = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flipped) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackMemberType - - SUBROUTINE Morison_CopyMemberLoads( SrcMemberLoadsData, DstMemberLoadsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MemberLoads), INTENT(IN) :: SrcMemberLoadsData - TYPE(Morison_MemberLoads), INTENT(INOUT) :: DstMemberLoadsData - 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 = 'Morison_CopyMemberLoads' -! + ErrMsg = '' + DstCoefDpthsData%Dpth = SrcCoefDpthsData%Dpth + DstCoefDpthsData%DpthCd = SrcCoefDpthsData%DpthCd + DstCoefDpthsData%DpthCdMG = SrcCoefDpthsData%DpthCdMG + DstCoefDpthsData%DpthCa = SrcCoefDpthsData%DpthCa + DstCoefDpthsData%DpthCaMG = SrcCoefDpthsData%DpthCaMG + DstCoefDpthsData%DpthCp = SrcCoefDpthsData%DpthCp + DstCoefDpthsData%DpthCpMG = SrcCoefDpthsData%DpthCpMG + DstCoefDpthsData%DpthAxCd = SrcCoefDpthsData%DpthAxCd + DstCoefDpthsData%DpthAxCdMG = SrcCoefDpthsData%DpthAxCdMG + DstCoefDpthsData%DpthAxCa = SrcCoefDpthsData%DpthAxCa + DstCoefDpthsData%DpthAxCaMG = SrcCoefDpthsData%DpthAxCaMG + DstCoefDpthsData%DpthAxCp = SrcCoefDpthsData%DpthAxCp + DstCoefDpthsData%DpthAxCpMG = SrcCoefDpthsData%DpthAxCpMG + DstCoefDpthsData%DpthCb = SrcCoefDpthsData%DpthCb + DstCoefDpthsData%DpthCbMg = SrcCoefDpthsData%DpthCbMg + DstCoefDpthsData%DpthMCF = SrcCoefDpthsData%DpthMCF +end subroutine + +subroutine Morison_DestroyCoefDpths(CoefDpthsData, ErrStat, ErrMsg) + type(Morison_CoefDpths), intent(inout) :: CoefDpthsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyCoefDpths' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMemberLoadsData%F_D)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_D,1) - i1_u = UBOUND(SrcMemberLoadsData%F_D,1) - i2_l = LBOUND(SrcMemberLoadsData%F_D,2) - i2_u = UBOUND(SrcMemberLoadsData%F_D,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_D)) THEN - ALLOCATE(DstMemberLoadsData%F_D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_D = SrcMemberLoadsData%F_D -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_I)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_I,1) - i1_u = UBOUND(SrcMemberLoadsData%F_I,1) - i2_l = LBOUND(SrcMemberLoadsData%F_I,2) - i2_u = UBOUND(SrcMemberLoadsData%F_I,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_I)) THEN - ALLOCATE(DstMemberLoadsData%F_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_I.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_I = SrcMemberLoadsData%F_I -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_A)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_A,1) - i1_u = UBOUND(SrcMemberLoadsData%F_A,1) - i2_l = LBOUND(SrcMemberLoadsData%F_A,2) - i2_u = UBOUND(SrcMemberLoadsData%F_A,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_A)) THEN - ALLOCATE(DstMemberLoadsData%F_A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_A = SrcMemberLoadsData%F_A -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_B)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_B,1) - i1_u = UBOUND(SrcMemberLoadsData%F_B,1) - i2_l = LBOUND(SrcMemberLoadsData%F_B,2) - i2_u = UBOUND(SrcMemberLoadsData%F_B,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_B)) THEN - ALLOCATE(DstMemberLoadsData%F_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_B = SrcMemberLoadsData%F_B -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_BF)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_BF,1) - i1_u = UBOUND(SrcMemberLoadsData%F_BF,1) - i2_l = LBOUND(SrcMemberLoadsData%F_BF,2) - i2_u = UBOUND(SrcMemberLoadsData%F_BF,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_BF)) THEN - ALLOCATE(DstMemberLoadsData%F_BF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_BF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_BF = SrcMemberLoadsData%F_BF -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_If)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_If,1) - i1_u = UBOUND(SrcMemberLoadsData%F_If,1) - i2_l = LBOUND(SrcMemberLoadsData%F_If,2) - i2_u = UBOUND(SrcMemberLoadsData%F_If,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_If)) THEN - ALLOCATE(DstMemberLoadsData%F_If(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_If.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_If = SrcMemberLoadsData%F_If -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_WMG)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_WMG,1) - i1_u = UBOUND(SrcMemberLoadsData%F_WMG,1) - i2_l = LBOUND(SrcMemberLoadsData%F_WMG,2) - i2_u = UBOUND(SrcMemberLoadsData%F_WMG,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_WMG)) THEN - ALLOCATE(DstMemberLoadsData%F_WMG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_WMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_WMG = SrcMemberLoadsData%F_WMG -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_IMG)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_IMG,1) - i1_u = UBOUND(SrcMemberLoadsData%F_IMG,1) - i2_l = LBOUND(SrcMemberLoadsData%F_IMG,2) - i2_u = UBOUND(SrcMemberLoadsData%F_IMG,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_IMG)) THEN - ALLOCATE(DstMemberLoadsData%F_IMG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_IMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_IMG = SrcMemberLoadsData%F_IMG -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%FV)) THEN - i1_l = LBOUND(SrcMemberLoadsData%FV,1) - i1_u = UBOUND(SrcMemberLoadsData%FV,1) - i2_l = LBOUND(SrcMemberLoadsData%FV,2) - i2_u = UBOUND(SrcMemberLoadsData%FV,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%FV)) THEN - ALLOCATE(DstMemberLoadsData%FV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%FV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%FV = SrcMemberLoadsData%FV -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%FA)) THEN - i1_l = LBOUND(SrcMemberLoadsData%FA,1) - i1_u = UBOUND(SrcMemberLoadsData%FA,1) - i2_l = LBOUND(SrcMemberLoadsData%FA,2) - i2_u = UBOUND(SrcMemberLoadsData%FA,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%FA)) THEN - ALLOCATE(DstMemberLoadsData%FA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%FA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%FA = SrcMemberLoadsData%FA -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_DP)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_DP,1) - i1_u = UBOUND(SrcMemberLoadsData%F_DP,1) - i2_l = LBOUND(SrcMemberLoadsData%F_DP,2) - i2_u = UBOUND(SrcMemberLoadsData%F_DP,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_DP)) THEN - ALLOCATE(DstMemberLoadsData%F_DP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_DP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_DP = SrcMemberLoadsData%F_DP -ENDIF - END SUBROUTINE Morison_CopyMemberLoads - - SUBROUTINE Morison_DestroyMemberLoads( MemberLoadsData, ErrStat, ErrMsg ) - TYPE(Morison_MemberLoads), INTENT(INOUT) :: MemberLoadsData - 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 = 'Morison_DestroyMemberLoads' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MemberLoadsData%F_D)) THEN - DEALLOCATE(MemberLoadsData%F_D) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_I)) THEN - DEALLOCATE(MemberLoadsData%F_I) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_A)) THEN - DEALLOCATE(MemberLoadsData%F_A) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_B)) THEN - DEALLOCATE(MemberLoadsData%F_B) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_BF)) THEN - DEALLOCATE(MemberLoadsData%F_BF) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_If)) THEN - DEALLOCATE(MemberLoadsData%F_If) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_WMG)) THEN - DEALLOCATE(MemberLoadsData%F_WMG) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_IMG)) THEN - DEALLOCATE(MemberLoadsData%F_IMG) -ENDIF -IF (ALLOCATED(MemberLoadsData%FV)) THEN - DEALLOCATE(MemberLoadsData%FV) -ENDIF -IF (ALLOCATED(MemberLoadsData%FA)) THEN - DEALLOCATE(MemberLoadsData%FA) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_DP)) THEN - DEALLOCATE(MemberLoadsData%F_DP) -ENDIF - END SUBROUTINE Morison_DestroyMemberLoads - - SUBROUTINE Morison_PackMemberLoads( 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(Morison_MemberLoads), 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 = 'Morison_PackMemberLoads' - ! 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 ! F_D allocated yes/no - IF ( ALLOCATED(InData%F_D) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_D upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_D) ! F_D - END IF - Int_BufSz = Int_BufSz + 1 ! F_I allocated yes/no - IF ( ALLOCATED(InData%F_I) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_I upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_I) ! F_I - END IF - Int_BufSz = Int_BufSz + 1 ! F_A allocated yes/no - IF ( ALLOCATED(InData%F_A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_A upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_A) ! F_A - END IF - Int_BufSz = Int_BufSz + 1 ! F_B allocated yes/no - IF ( ALLOCATED(InData%F_B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_B upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_B) ! F_B - END IF - Int_BufSz = Int_BufSz + 1 ! F_BF allocated yes/no - IF ( ALLOCATED(InData%F_BF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_BF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_BF) ! F_BF - END IF - Int_BufSz = Int_BufSz + 1 ! F_If allocated yes/no - IF ( ALLOCATED(InData%F_If) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_If upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_If) ! F_If - END IF - Int_BufSz = Int_BufSz + 1 ! F_WMG allocated yes/no - IF ( ALLOCATED(InData%F_WMG) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_WMG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_WMG) ! F_WMG - END IF - Int_BufSz = Int_BufSz + 1 ! F_IMG allocated yes/no - IF ( ALLOCATED(InData%F_IMG) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_IMG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_IMG) ! F_IMG - END IF - Int_BufSz = Int_BufSz + 1 ! FV allocated yes/no - IF ( ALLOCATED(InData%FV) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FV) ! FV - END IF - Int_BufSz = Int_BufSz + 1 ! FA allocated yes/no - IF ( ALLOCATED(InData%FA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FA) ! FA - END IF - Int_BufSz = Int_BufSz + 1 ! F_DP allocated yes/no - IF ( ALLOCATED(InData%F_DP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_DP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_DP) ! F_DP - 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%F_D) ) 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%F_D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_D,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_D,2), UBOUND(InData%F_D,2) - DO i1 = LBOUND(InData%F_D,1), UBOUND(InData%F_D,1) - ReKiBuf(Re_Xferred) = InData%F_D(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_I) ) 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%F_I,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_I,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_I,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_I,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_I,2), UBOUND(InData%F_I,2) - DO i1 = LBOUND(InData%F_I,1), UBOUND(InData%F_I,1) - ReKiBuf(Re_Xferred) = InData%F_I(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_A) ) 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%F_A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_A,2), UBOUND(InData%F_A,2) - DO i1 = LBOUND(InData%F_A,1), UBOUND(InData%F_A,1) - ReKiBuf(Re_Xferred) = InData%F_A(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_B) ) 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%F_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_B,2), UBOUND(InData%F_B,2) - DO i1 = LBOUND(InData%F_B,1), UBOUND(InData%F_B,1) - ReKiBuf(Re_Xferred) = InData%F_B(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_BF) ) 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%F_BF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_BF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_BF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_BF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_BF,2), UBOUND(InData%F_BF,2) - DO i1 = LBOUND(InData%F_BF,1), UBOUND(InData%F_BF,1) - ReKiBuf(Re_Xferred) = InData%F_BF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_If) ) 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%F_If,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_If,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_If,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_If,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_If,2), UBOUND(InData%F_If,2) - DO i1 = LBOUND(InData%F_If,1), UBOUND(InData%F_If,1) - ReKiBuf(Re_Xferred) = InData%F_If(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_WMG) ) 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%F_WMG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_WMG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_WMG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_WMG,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_WMG,2), UBOUND(InData%F_WMG,2) - DO i1 = LBOUND(InData%F_WMG,1), UBOUND(InData%F_WMG,1) - ReKiBuf(Re_Xferred) = InData%F_WMG(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_IMG) ) 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%F_IMG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_IMG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_IMG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_IMG,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_IMG,2), UBOUND(InData%F_IMG,2) - DO i1 = LBOUND(InData%F_IMG,1), UBOUND(InData%F_IMG,1) - ReKiBuf(Re_Xferred) = InData%F_IMG(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FV) ) 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%FV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FV,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FV,2), UBOUND(InData%FV,2) - DO i1 = LBOUND(InData%FV,1), UBOUND(InData%FV,1) - ReKiBuf(Re_Xferred) = InData%FV(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FA) ) 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%FA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FA,2), UBOUND(InData%FA,2) - DO i1 = LBOUND(InData%FA,1), UBOUND(InData%FA,1) - ReKiBuf(Re_Xferred) = InData%FA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_DP) ) 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%F_DP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_DP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_DP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_DP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_DP,2), UBOUND(InData%F_DP,2) - DO i1 = LBOUND(InData%F_DP,1), UBOUND(InData%F_DP,1) - ReKiBuf(Re_Xferred) = InData%F_DP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE Morison_PackMemberLoads - - SUBROUTINE Morison_UnPackMemberLoads( 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_MemberLoads), 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 = 'Morison_UnPackMemberLoads' - ! 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 ! F_D 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%F_D)) DEALLOCATE(OutData%F_D) - ALLOCATE(OutData%F_D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_D,2), UBOUND(OutData%F_D,2) - DO i1 = LBOUND(OutData%F_D,1), UBOUND(OutData%F_D,1) - OutData%F_D(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_I 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%F_I)) DEALLOCATE(OutData%F_I) - ALLOCATE(OutData%F_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_I.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_I,2), UBOUND(OutData%F_I,2) - DO i1 = LBOUND(OutData%F_I,1), UBOUND(OutData%F_I,1) - OutData%F_I(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_A 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%F_A)) DEALLOCATE(OutData%F_A) - ALLOCATE(OutData%F_A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_A,2), UBOUND(OutData%F_A,2) - DO i1 = LBOUND(OutData%F_A,1), UBOUND(OutData%F_A,1) - OutData%F_A(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_B 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%F_B)) DEALLOCATE(OutData%F_B) - ALLOCATE(OutData%F_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_B,2), UBOUND(OutData%F_B,2) - DO i1 = LBOUND(OutData%F_B,1), UBOUND(OutData%F_B,1) - OutData%F_B(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_BF 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%F_BF)) DEALLOCATE(OutData%F_BF) - ALLOCATE(OutData%F_BF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_BF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_BF,2), UBOUND(OutData%F_BF,2) - DO i1 = LBOUND(OutData%F_BF,1), UBOUND(OutData%F_BF,1) - OutData%F_BF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_If 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%F_If)) DEALLOCATE(OutData%F_If) - ALLOCATE(OutData%F_If(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_If.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_If,2), UBOUND(OutData%F_If,2) - DO i1 = LBOUND(OutData%F_If,1), UBOUND(OutData%F_If,1) - OutData%F_If(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_WMG 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%F_WMG)) DEALLOCATE(OutData%F_WMG) - ALLOCATE(OutData%F_WMG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_WMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_WMG,2), UBOUND(OutData%F_WMG,2) - DO i1 = LBOUND(OutData%F_WMG,1), UBOUND(OutData%F_WMG,1) - OutData%F_WMG(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_IMG 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%F_IMG)) DEALLOCATE(OutData%F_IMG) - ALLOCATE(OutData%F_IMG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_IMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_IMG,2), UBOUND(OutData%F_IMG,2) - DO i1 = LBOUND(OutData%F_IMG,1), UBOUND(OutData%F_IMG,1) - OutData%F_IMG(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FV 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%FV)) DEALLOCATE(OutData%FV) - ALLOCATE(OutData%FV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FV,2), UBOUND(OutData%FV,2) - DO i1 = LBOUND(OutData%FV,1), UBOUND(OutData%FV,1) - OutData%FV(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FA 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%FA)) DEALLOCATE(OutData%FA) - ALLOCATE(OutData%FA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FA,2), UBOUND(OutData%FA,2) - DO i1 = LBOUND(OutData%FA,1), UBOUND(OutData%FA,1) - OutData%FA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_DP 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%F_DP)) DEALLOCATE(OutData%F_DP) - ALLOCATE(OutData%F_DP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_DP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_DP,2), UBOUND(OutData%F_DP,2) - DO i1 = LBOUND(OutData%F_DP,1), UBOUND(OutData%F_DP,1) - OutData%F_DP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE Morison_UnPackMemberLoads - - SUBROUTINE Morison_CopyCoefMembers( SrcCoefMembersData, DstCoefMembersData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_CoefMembers), INTENT(IN) :: SrcCoefMembersData - TYPE(Morison_CoefMembers), INTENT(INOUT) :: DstCoefMembersData - 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 = 'Morison_CopyCoefMembers' -! + ErrMsg = '' +end subroutine + +subroutine Morison_PackCoefDpths(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_CoefDpths), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackCoefDpths' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Dpth) + call RegPack(Buf, InData%DpthCd) + call RegPack(Buf, InData%DpthCdMG) + call RegPack(Buf, InData%DpthCa) + call RegPack(Buf, InData%DpthCaMG) + call RegPack(Buf, InData%DpthCp) + call RegPack(Buf, InData%DpthCpMG) + call RegPack(Buf, InData%DpthAxCd) + call RegPack(Buf, InData%DpthAxCdMG) + call RegPack(Buf, InData%DpthAxCa) + call RegPack(Buf, InData%DpthAxCaMG) + call RegPack(Buf, InData%DpthAxCp) + call RegPack(Buf, InData%DpthAxCpMG) + call RegPack(Buf, InData%DpthCb) + call RegPack(Buf, InData%DpthCbMg) + call RegPack(Buf, InData%DpthMCF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackCoefDpths(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_CoefDpths), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackCoefDpths' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Dpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DpthCd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DpthCdMG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DpthCa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DpthCaMG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DpthCp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DpthCpMG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DpthAxCd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DpthAxCdMG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DpthAxCa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DpthAxCaMG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DpthAxCp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DpthAxCpMG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DpthCb) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DpthCbMg) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DpthMCF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_CopyAxialCoefType(SrcAxialCoefTypeData, DstAxialCoefTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_AxialCoefType), intent(in) :: SrcAxialCoefTypeData + type(Morison_AxialCoefType), intent(inout) :: DstAxialCoefTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyAxialCoefType' ErrStat = ErrID_None - ErrMsg = "" - DstCoefMembersData%MemberID = SrcCoefMembersData%MemberID - DstCoefMembersData%MemberCd1 = SrcCoefMembersData%MemberCd1 - DstCoefMembersData%MemberCd2 = SrcCoefMembersData%MemberCd2 - DstCoefMembersData%MemberCdMG1 = SrcCoefMembersData%MemberCdMG1 - DstCoefMembersData%MemberCdMG2 = SrcCoefMembersData%MemberCdMG2 - DstCoefMembersData%MemberCa1 = SrcCoefMembersData%MemberCa1 - DstCoefMembersData%MemberCa2 = SrcCoefMembersData%MemberCa2 - DstCoefMembersData%MemberCaMG1 = SrcCoefMembersData%MemberCaMG1 - DstCoefMembersData%MemberCaMG2 = SrcCoefMembersData%MemberCaMG2 - DstCoefMembersData%MemberCp1 = SrcCoefMembersData%MemberCp1 - DstCoefMembersData%MemberCp2 = SrcCoefMembersData%MemberCp2 - DstCoefMembersData%MemberCpMG1 = SrcCoefMembersData%MemberCpMG1 - DstCoefMembersData%MemberCpMG2 = SrcCoefMembersData%MemberCpMG2 - DstCoefMembersData%MemberAxCd1 = SrcCoefMembersData%MemberAxCd1 - DstCoefMembersData%MemberAxCd2 = SrcCoefMembersData%MemberAxCd2 - DstCoefMembersData%MemberAxCdMG1 = SrcCoefMembersData%MemberAxCdMG1 - DstCoefMembersData%MemberAxCdMG2 = SrcCoefMembersData%MemberAxCdMG2 - DstCoefMembersData%MemberAxCa1 = SrcCoefMembersData%MemberAxCa1 - DstCoefMembersData%MemberAxCa2 = SrcCoefMembersData%MemberAxCa2 - DstCoefMembersData%MemberAxCaMG1 = SrcCoefMembersData%MemberAxCaMG1 - DstCoefMembersData%MemberAxCaMG2 = SrcCoefMembersData%MemberAxCaMG2 - DstCoefMembersData%MemberAxCp1 = SrcCoefMembersData%MemberAxCp1 - DstCoefMembersData%MemberAxCp2 = SrcCoefMembersData%MemberAxCp2 - DstCoefMembersData%MemberAxCpMG1 = SrcCoefMembersData%MemberAxCpMG1 - DstCoefMembersData%MemberAxCpMG2 = SrcCoefMembersData%MemberAxCpMG2 - DstCoefMembersData%MemberCb1 = SrcCoefMembersData%MemberCb1 - DstCoefMembersData%MemberCb2 = SrcCoefMembersData%MemberCb2 - DstCoefMembersData%MemberCbMG1 = SrcCoefMembersData%MemberCbMG1 - DstCoefMembersData%MemberCbMG2 = SrcCoefMembersData%MemberCbMG2 - DstCoefMembersData%MemberMCF = SrcCoefMembersData%MemberMCF - END SUBROUTINE Morison_CopyCoefMembers - - SUBROUTINE Morison_DestroyCoefMembers( CoefMembersData, ErrStat, ErrMsg ) - TYPE(Morison_CoefMembers), INTENT(INOUT) :: CoefMembersData - 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 = 'Morison_DestroyCoefMembers' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyCoefMembers - - SUBROUTINE Morison_PackCoefMembers( 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(Morison_CoefMembers), 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 = 'Morison_PackCoefMembers' - ! 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 ! MemberID - Re_BufSz = Re_BufSz + 1 ! MemberCd1 - Re_BufSz = Re_BufSz + 1 ! MemberCd2 - Re_BufSz = Re_BufSz + 1 ! MemberCdMG1 - Re_BufSz = Re_BufSz + 1 ! MemberCdMG2 - Re_BufSz = Re_BufSz + 1 ! MemberCa1 - Re_BufSz = Re_BufSz + 1 ! MemberCa2 - Re_BufSz = Re_BufSz + 1 ! MemberCaMG1 - Re_BufSz = Re_BufSz + 1 ! MemberCaMG2 - Re_BufSz = Re_BufSz + 1 ! MemberCp1 - Re_BufSz = Re_BufSz + 1 ! MemberCp2 - Re_BufSz = Re_BufSz + 1 ! MemberCpMG1 - Re_BufSz = Re_BufSz + 1 ! MemberCpMG2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCd1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCd2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCdMG1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCdMG2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCa1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCa2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCaMG1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCaMG2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCp1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCp2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCpMG1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCpMG2 - Re_BufSz = Re_BufSz + 1 ! MemberCb1 - Re_BufSz = Re_BufSz + 1 ! MemberCb2 - Re_BufSz = Re_BufSz + 1 ! MemberCbMG1 - Re_BufSz = Re_BufSz + 1 ! MemberCbMG2 - Int_BufSz = Int_BufSz + 1 ! MemberMCF - 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%MemberID - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCd1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCd2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCdMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCdMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCa1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCa2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCpMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCd1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCd2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCdMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCdMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCa1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCa2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCpMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCb1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCb2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCbMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCbMG2 - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%MemberMCF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackCoefMembers - - SUBROUTINE Morison_UnPackCoefMembers( 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_CoefMembers), 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 = 'Morison_UnPackCoefMembers' - ! 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%MemberID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MemberCd1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCd2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCdMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCdMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCa1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCa2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCaMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCaMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCp1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCp2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCpMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCpMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCd1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCd2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCdMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCdMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCa1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCa2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCaMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCaMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCp1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCp2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCpMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCpMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCb1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCb2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCbMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCbMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberMCF = TRANSFER(IntKiBuf(Int_Xferred), OutData%MemberMCF) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackCoefMembers - - SUBROUTINE Morison_CopyMGDepthsType( SrcMGDepthsTypeData, DstMGDepthsTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MGDepthsType), INTENT(IN) :: SrcMGDepthsTypeData - TYPE(Morison_MGDepthsType), INTENT(INOUT) :: DstMGDepthsTypeData - 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 = 'Morison_CopyMGDepthsType' -! + ErrMsg = '' + DstAxialCoefTypeData%AxCoefID = SrcAxialCoefTypeData%AxCoefID + DstAxialCoefTypeData%AxCd = SrcAxialCoefTypeData%AxCd + DstAxialCoefTypeData%AxCa = SrcAxialCoefTypeData%AxCa + DstAxialCoefTypeData%AxCp = SrcAxialCoefTypeData%AxCp + DstAxialCoefTypeData%AxVnCOff = SrcAxialCoefTypeData%AxVnCOff + DstAxialCoefTypeData%AxFDLoFSc = SrcAxialCoefTypeData%AxFDLoFSc + DstAxialCoefTypeData%AxFDMod = SrcAxialCoefTypeData%AxFDMod +end subroutine + +subroutine Morison_DestroyAxialCoefType(AxialCoefTypeData, ErrStat, ErrMsg) + type(Morison_AxialCoefType), intent(inout) :: AxialCoefTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyAxialCoefType' ErrStat = ErrID_None - ErrMsg = "" - DstMGDepthsTypeData%MGDpth = SrcMGDepthsTypeData%MGDpth - DstMGDepthsTypeData%MGThck = SrcMGDepthsTypeData%MGThck - DstMGDepthsTypeData%MGDens = SrcMGDepthsTypeData%MGDens - END SUBROUTINE Morison_CopyMGDepthsType - - SUBROUTINE Morison_DestroyMGDepthsType( MGDepthsTypeData, ErrStat, ErrMsg ) - TYPE(Morison_MGDepthsType), INTENT(INOUT) :: MGDepthsTypeData - 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 = 'Morison_DestroyMGDepthsType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyMGDepthsType - - SUBROUTINE Morison_PackMGDepthsType( 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(Morison_MGDepthsType), 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 = 'Morison_PackMGDepthsType' - ! 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 ! MGDpth - Re_BufSz = Re_BufSz + 1 ! MGThck - Re_BufSz = Re_BufSz + 1 ! MGDens - 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%MGDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MGThck - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MGDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackMGDepthsType - - SUBROUTINE Morison_UnPackMGDepthsType( 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_MGDepthsType), 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 = 'Morison_UnPackMGDepthsType' - ! 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%MGDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MGThck = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MGDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackMGDepthsType - - SUBROUTINE Morison_CopyMOutput( SrcMOutputData, DstMOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MOutput), INTENT(IN) :: SrcMOutputData - TYPE(Morison_MOutput), INTENT(INOUT) :: DstMOutputData - 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 = 'Morison_CopyMOutput' -! + ErrMsg = '' +end subroutine + +subroutine Morison_PackAxialCoefType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_AxialCoefType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackAxialCoefType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%AxCoefID) + call RegPack(Buf, InData%AxCd) + call RegPack(Buf, InData%AxCa) + call RegPack(Buf, InData%AxCp) + call RegPack(Buf, InData%AxVnCOff) + call RegPack(Buf, InData%AxFDLoFSc) + call RegPack(Buf, InData%AxFDMod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackAxialCoefType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_AxialCoefType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackAxialCoefType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%AxCoefID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AxCd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AxCa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AxCp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AxVnCOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AxFDLoFSc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AxFDMod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_CopyMemberInputType(SrcMemberInputTypeData, DstMemberInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MemberInputType), intent(in) :: SrcMemberInputTypeData + type(Morison_MemberInputType), intent(inout) :: DstMemberInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyMemberInputType' ErrStat = ErrID_None - ErrMsg = "" - DstMOutputData%MemberID = SrcMOutputData%MemberID - DstMOutputData%NOutLoc = SrcMOutputData%NOutLoc -IF (ALLOCATED(SrcMOutputData%NodeLocs)) THEN - i1_l = LBOUND(SrcMOutputData%NodeLocs,1) - i1_u = UBOUND(SrcMOutputData%NodeLocs,1) - IF (.NOT. ALLOCATED(DstMOutputData%NodeLocs)) THEN - ALLOCATE(DstMOutputData%NodeLocs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%NodeLocs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%NodeLocs = SrcMOutputData%NodeLocs -ENDIF - DstMOutputData%MemberIDIndx = SrcMOutputData%MemberIDIndx -IF (ALLOCATED(SrcMOutputData%MeshIndx1)) THEN - i1_l = LBOUND(SrcMOutputData%MeshIndx1,1) - i1_u = UBOUND(SrcMOutputData%MeshIndx1,1) - IF (.NOT. ALLOCATED(DstMOutputData%MeshIndx1)) THEN - ALLOCATE(DstMOutputData%MeshIndx1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MeshIndx1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%MeshIndx1 = SrcMOutputData%MeshIndx1 -ENDIF -IF (ALLOCATED(SrcMOutputData%MeshIndx2)) THEN - i1_l = LBOUND(SrcMOutputData%MeshIndx2,1) - i1_u = UBOUND(SrcMOutputData%MeshIndx2,1) - IF (.NOT. ALLOCATED(DstMOutputData%MeshIndx2)) THEN - ALLOCATE(DstMOutputData%MeshIndx2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MeshIndx2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%MeshIndx2 = SrcMOutputData%MeshIndx2 -ENDIF -IF (ALLOCATED(SrcMOutputData%MemberIndx1)) THEN - i1_l = LBOUND(SrcMOutputData%MemberIndx1,1) - i1_u = UBOUND(SrcMOutputData%MemberIndx1,1) - IF (.NOT. ALLOCATED(DstMOutputData%MemberIndx1)) THEN - ALLOCATE(DstMOutputData%MemberIndx1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MemberIndx1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%MemberIndx1 = SrcMOutputData%MemberIndx1 -ENDIF -IF (ALLOCATED(SrcMOutputData%MemberIndx2)) THEN - i1_l = LBOUND(SrcMOutputData%MemberIndx2,1) - i1_u = UBOUND(SrcMOutputData%MemberIndx2,1) - IF (.NOT. ALLOCATED(DstMOutputData%MemberIndx2)) THEN - ALLOCATE(DstMOutputData%MemberIndx2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MemberIndx2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%MemberIndx2 = SrcMOutputData%MemberIndx2 -ENDIF -IF (ALLOCATED(SrcMOutputData%s)) THEN - i1_l = LBOUND(SrcMOutputData%s,1) - i1_u = UBOUND(SrcMOutputData%s,1) - IF (.NOT. ALLOCATED(DstMOutputData%s)) THEN - ALLOCATE(DstMOutputData%s(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%s = SrcMOutputData%s -ENDIF - END SUBROUTINE Morison_CopyMOutput - - SUBROUTINE Morison_DestroyMOutput( MOutputData, ErrStat, ErrMsg ) - TYPE(Morison_MOutput), INTENT(INOUT) :: MOutputData - 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 = 'Morison_DestroyMOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MOutputData%NodeLocs)) THEN - DEALLOCATE(MOutputData%NodeLocs) -ENDIF -IF (ALLOCATED(MOutputData%MeshIndx1)) THEN - DEALLOCATE(MOutputData%MeshIndx1) -ENDIF -IF (ALLOCATED(MOutputData%MeshIndx2)) THEN - DEALLOCATE(MOutputData%MeshIndx2) -ENDIF -IF (ALLOCATED(MOutputData%MemberIndx1)) THEN - DEALLOCATE(MOutputData%MemberIndx1) -ENDIF -IF (ALLOCATED(MOutputData%MemberIndx2)) THEN - DEALLOCATE(MOutputData%MemberIndx2) -ENDIF -IF (ALLOCATED(MOutputData%s)) THEN - DEALLOCATE(MOutputData%s) -ENDIF - END SUBROUTINE Morison_DestroyMOutput - - SUBROUTINE Morison_PackMOutput( 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(Morison_MOutput), 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 = 'Morison_PackMOutput' - ! 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 ! MemberID - Int_BufSz = Int_BufSz + 1 ! NOutLoc - Int_BufSz = Int_BufSz + 1 ! NodeLocs allocated yes/no - IF ( ALLOCATED(InData%NodeLocs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeLocs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%NodeLocs) ! NodeLocs - END IF - Int_BufSz = Int_BufSz + 1 ! MemberIDIndx - Int_BufSz = Int_BufSz + 1 ! MeshIndx1 allocated yes/no - IF ( ALLOCATED(InData%MeshIndx1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MeshIndx1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MeshIndx1) ! MeshIndx1 - END IF - Int_BufSz = Int_BufSz + 1 ! MeshIndx2 allocated yes/no - IF ( ALLOCATED(InData%MeshIndx2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MeshIndx2 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MeshIndx2) ! MeshIndx2 - END IF - Int_BufSz = Int_BufSz + 1 ! MemberIndx1 allocated yes/no - IF ( ALLOCATED(InData%MemberIndx1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MemberIndx1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MemberIndx1) ! MemberIndx1 - END IF - Int_BufSz = Int_BufSz + 1 ! MemberIndx2 allocated yes/no - IF ( ALLOCATED(InData%MemberIndx2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MemberIndx2 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MemberIndx2) ! MemberIndx2 - END IF - Int_BufSz = Int_BufSz + 1 ! s allocated yes/no - IF ( ALLOCATED(InData%s) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! s upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%s) ! s - 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 - - IntKiBuf(Int_Xferred) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutLoc - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NodeLocs) ) 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%NodeLocs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeLocs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeLocs,1), UBOUND(InData%NodeLocs,1) - ReKiBuf(Re_Xferred) = InData%NodeLocs(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%MemberIDIndx - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%MeshIndx1) ) 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%MeshIndx1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeshIndx1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MeshIndx1,1), UBOUND(InData%MeshIndx1,1) - IntKiBuf(Int_Xferred) = InData%MeshIndx1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MeshIndx2) ) 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%MeshIndx2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeshIndx2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MeshIndx2,1), UBOUND(InData%MeshIndx2,1) - IntKiBuf(Int_Xferred) = InData%MeshIndx2(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MemberIndx1) ) 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%MemberIndx1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberIndx1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MemberIndx1,1), UBOUND(InData%MemberIndx1,1) - IntKiBuf(Int_Xferred) = InData%MemberIndx1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MemberIndx2) ) 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%MemberIndx2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberIndx2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MemberIndx2,1), UBOUND(InData%MemberIndx2,1) - IntKiBuf(Int_Xferred) = InData%MemberIndx2(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%s) ) 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%s,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%s,1), UBOUND(InData%s,1) - ReKiBuf(Re_Xferred) = InData%s(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Morison_PackMOutput - - SUBROUTINE Morison_UnPackMOutput( 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_MOutput), 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 = 'Morison_UnPackMOutput' - ! 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%MemberID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutLoc = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeLocs 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%NodeLocs)) DEALLOCATE(OutData%NodeLocs) - ALLOCATE(OutData%NodeLocs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeLocs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeLocs,1), UBOUND(OutData%NodeLocs,1) - OutData%NodeLocs(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%MemberIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeshIndx1 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%MeshIndx1)) DEALLOCATE(OutData%MeshIndx1) - ALLOCATE(OutData%MeshIndx1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeshIndx1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MeshIndx1,1), UBOUND(OutData%MeshIndx1,1) - OutData%MeshIndx1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeshIndx2 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%MeshIndx2)) DEALLOCATE(OutData%MeshIndx2) - ALLOCATE(OutData%MeshIndx2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeshIndx2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MeshIndx2,1), UBOUND(OutData%MeshIndx2,1) - OutData%MeshIndx2(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MemberIndx1 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%MemberIndx1)) DEALLOCATE(OutData%MemberIndx1) - ALLOCATE(OutData%MemberIndx1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberIndx1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MemberIndx1,1), UBOUND(OutData%MemberIndx1,1) - OutData%MemberIndx1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MemberIndx2 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%MemberIndx2)) DEALLOCATE(OutData%MemberIndx2) - ALLOCATE(OutData%MemberIndx2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberIndx2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MemberIndx2,1), UBOUND(OutData%MemberIndx2,1) - OutData%MemberIndx2(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s 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%s)) DEALLOCATE(OutData%s) - ALLOCATE(OutData%s(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%s,1), UBOUND(OutData%s,1) - OutData%s(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Morison_UnPackMOutput - - SUBROUTINE Morison_CopyJOutput( SrcJOutputData, DstJOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_JOutput), INTENT(IN) :: SrcJOutputData - TYPE(Morison_JOutput), INTENT(INOUT) :: DstJOutputData - 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 = 'Morison_CopyJOutput' -! + ErrMsg = '' + DstMemberInputTypeData%MemberID = SrcMemberInputTypeData%MemberID + if (allocated(SrcMemberInputTypeData%NodeIndx)) then + LB(1:1) = lbound(SrcMemberInputTypeData%NodeIndx) + UB(1:1) = ubound(SrcMemberInputTypeData%NodeIndx) + if (.not. allocated(DstMemberInputTypeData%NodeIndx)) then + allocate(DstMemberInputTypeData%NodeIndx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberInputTypeData%NodeIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberInputTypeData%NodeIndx = SrcMemberInputTypeData%NodeIndx + end if + DstMemberInputTypeData%MJointID1 = SrcMemberInputTypeData%MJointID1 + DstMemberInputTypeData%MJointID2 = SrcMemberInputTypeData%MJointID2 + DstMemberInputTypeData%MJointID1Indx = SrcMemberInputTypeData%MJointID1Indx + DstMemberInputTypeData%MJointID2Indx = SrcMemberInputTypeData%MJointID2Indx + DstMemberInputTypeData%MPropSetID1 = SrcMemberInputTypeData%MPropSetID1 + DstMemberInputTypeData%MPropSetID2 = SrcMemberInputTypeData%MPropSetID2 + DstMemberInputTypeData%MPropSetID1Indx = SrcMemberInputTypeData%MPropSetID1Indx + DstMemberInputTypeData%MPropSetID2Indx = SrcMemberInputTypeData%MPropSetID2Indx + DstMemberInputTypeData%MDivSize = SrcMemberInputTypeData%MDivSize + DstMemberInputTypeData%MCoefMod = SrcMemberInputTypeData%MCoefMod + DstMemberInputTypeData%MHstLMod = SrcMemberInputTypeData%MHstLMod + DstMemberInputTypeData%MmbrCoefIDIndx = SrcMemberInputTypeData%MmbrCoefIDIndx + DstMemberInputTypeData%MmbrFilledIDIndx = SrcMemberInputTypeData%MmbrFilledIDIndx + DstMemberInputTypeData%PropPot = SrcMemberInputTypeData%PropPot + DstMemberInputTypeData%PropMCF = SrcMemberInputTypeData%PropMCF + DstMemberInputTypeData%NElements = SrcMemberInputTypeData%NElements + DstMemberInputTypeData%RefLength = SrcMemberInputTypeData%RefLength + DstMemberInputTypeData%dl = SrcMemberInputTypeData%dl +end subroutine + +subroutine Morison_DestroyMemberInputType(MemberInputTypeData, ErrStat, ErrMsg) + type(Morison_MemberInputType), intent(inout) :: MemberInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMemberInputType' ErrStat = ErrID_None - ErrMsg = "" - DstJOutputData%JointID = SrcJOutputData%JointID - DstJOutputData%JointIDIndx = SrcJOutputData%JointIDIndx - END SUBROUTINE Morison_CopyJOutput - - SUBROUTINE Morison_DestroyJOutput( JOutputData, ErrStat, ErrMsg ) - TYPE(Morison_JOutput), INTENT(INOUT) :: JOutputData - 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 = 'Morison_DestroyJOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyJOutput - - SUBROUTINE Morison_PackJOutput( 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(Morison_JOutput), 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 = 'Morison_PackJOutput' - ! 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 ! JointID - Int_BufSz = Int_BufSz + 1 ! JointIDIndx - 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%JointID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%JointIDIndx - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackJOutput - - SUBROUTINE Morison_UnPackJOutput( 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_JOutput), 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 = 'Morison_UnPackJOutput' - ! 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%JointID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%JointIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackJOutput - - SUBROUTINE Morison_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Morison_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 = 'Morison_CopyInitInput' -! + ErrMsg = '' + if (allocated(MemberInputTypeData%NodeIndx)) then + deallocate(MemberInputTypeData%NodeIndx) + end if +end subroutine + +subroutine Morison_PackMemberInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMemberInputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%MemberID) + call RegPack(Buf, allocated(InData%NodeIndx)) + if (allocated(InData%NodeIndx)) then + call RegPackBounds(Buf, 1, lbound(InData%NodeIndx), ubound(InData%NodeIndx)) + call RegPack(Buf, InData%NodeIndx) + end if + call RegPack(Buf, InData%MJointID1) + call RegPack(Buf, InData%MJointID2) + call RegPack(Buf, InData%MJointID1Indx) + call RegPack(Buf, InData%MJointID2Indx) + call RegPack(Buf, InData%MPropSetID1) + call RegPack(Buf, InData%MPropSetID2) + call RegPack(Buf, InData%MPropSetID1Indx) + call RegPack(Buf, InData%MPropSetID2Indx) + call RegPack(Buf, InData%MDivSize) + call RegPack(Buf, InData%MCoefMod) + call RegPack(Buf, InData%MHstLMod) + call RegPack(Buf, InData%MmbrCoefIDIndx) + call RegPack(Buf, InData%MmbrFilledIDIndx) + call RegPack(Buf, InData%PropPot) + call RegPack(Buf, InData%PropMCF) + call RegPack(Buf, InData%NElements) + call RegPack(Buf, InData%RefLength) + call RegPack(Buf, InData%dl) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMemberInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMemberInputType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%MemberID) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%NodeIndx)) deallocate(OutData%NodeIndx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodeIndx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodeIndx) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%MJointID1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MJointID2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MJointID1Indx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MJointID2Indx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MPropSetID1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MPropSetID2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MPropSetID1Indx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MPropSetID2Indx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MDivSize) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MCoefMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MHstLMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MmbrCoefIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MmbrFilledIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PropPot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PropMCF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NElements) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dl) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_CopyNodeType(SrcNodeTypeData, DstNodeTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_NodeType), intent(in) :: SrcNodeTypeData + type(Morison_NodeType), intent(inout) :: DstNodeTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyNodeType' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%WaveDisp = SrcInitInputData%WaveDisp - DstInitInputData%AMMod = SrcInitInputData%AMMod - DstInitInputData%NJoints = SrcInitInputData%NJoints - DstInitInputData%NNodes = SrcInitInputData%NNodes -IF (ALLOCATED(SrcInitInputData%InpJoints)) THEN - i1_l = LBOUND(SrcInitInputData%InpJoints,1) - i1_u = UBOUND(SrcInitInputData%InpJoints,1) - IF (.NOT. ALLOCATED(DstInitInputData%InpJoints)) THEN - ALLOCATE(DstInitInputData%InpJoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InpJoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%InpJoints,1), UBOUND(SrcInitInputData%InpJoints,1) - CALL Morison_Copyjointtype( SrcInitInputData%InpJoints(i1), DstInitInputData%InpJoints(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInitInputData%Nodes)) THEN - i1_l = LBOUND(SrcInitInputData%Nodes,1) - i1_u = UBOUND(SrcInitInputData%Nodes,1) - IF (.NOT. ALLOCATED(DstInitInputData%Nodes)) THEN - ALLOCATE(DstInitInputData%Nodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%Nodes,1), UBOUND(SrcInitInputData%Nodes,1) - CALL Morison_Copynodetype( SrcInitInputData%Nodes(i1), DstInitInputData%Nodes(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NAxCoefs = SrcInitInputData%NAxCoefs -IF (ALLOCATED(SrcInitInputData%AxialCoefs)) THEN - i1_l = LBOUND(SrcInitInputData%AxialCoefs,1) - i1_u = UBOUND(SrcInitInputData%AxialCoefs,1) - IF (.NOT. ALLOCATED(DstInitInputData%AxialCoefs)) THEN - ALLOCATE(DstInitInputData%AxialCoefs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AxialCoefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%AxialCoefs,1), UBOUND(SrcInitInputData%AxialCoefs,1) - CALL Morison_Copyaxialcoeftype( SrcInitInputData%AxialCoefs(i1), DstInitInputData%AxialCoefs(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NPropSets = SrcInitInputData%NPropSets -IF (ALLOCATED(SrcInitInputData%MPropSets)) THEN - i1_l = LBOUND(SrcInitInputData%MPropSets,1) - i1_u = UBOUND(SrcInitInputData%MPropSets,1) - IF (.NOT. ALLOCATED(DstInitInputData%MPropSets)) THEN - ALLOCATE(DstInitInputData%MPropSets(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MPropSets.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%MPropSets,1), UBOUND(SrcInitInputData%MPropSets,1) - CALL Morison_Copymemberproptype( SrcInitInputData%MPropSets(i1), DstInitInputData%MPropSets(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%SimplCd = SrcInitInputData%SimplCd - DstInitInputData%SimplCdMG = SrcInitInputData%SimplCdMG - DstInitInputData%SimplCa = SrcInitInputData%SimplCa - DstInitInputData%SimplCaMG = SrcInitInputData%SimplCaMG - DstInitInputData%SimplCp = SrcInitInputData%SimplCp - DstInitInputData%SimplCpMG = SrcInitInputData%SimplCpMG - DstInitInputData%SimplAxCd = SrcInitInputData%SimplAxCd - DstInitInputData%SimplAxCdMG = SrcInitInputData%SimplAxCdMG - DstInitInputData%SimplAxCa = SrcInitInputData%SimplAxCa - DstInitInputData%SimplAxCaMG = SrcInitInputData%SimplAxCaMG - DstInitInputData%SimplAxCp = SrcInitInputData%SimplAxCp - DstInitInputData%SimplAxCpMG = SrcInitInputData%SimplAxCpMG - DstInitInputData%SimplCb = SrcInitInputData%SimplCb - DstInitInputData%SimplCbMg = SrcInitInputData%SimplCbMg - DstInitInputData%SimplMCF = SrcInitInputData%SimplMCF - DstInitInputData%NCoefDpth = SrcInitInputData%NCoefDpth -IF (ALLOCATED(SrcInitInputData%CoefDpths)) THEN - i1_l = LBOUND(SrcInitInputData%CoefDpths,1) - i1_u = UBOUND(SrcInitInputData%CoefDpths,1) - IF (.NOT. ALLOCATED(DstInitInputData%CoefDpths)) THEN - ALLOCATE(DstInitInputData%CoefDpths(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CoefDpths.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%CoefDpths,1), UBOUND(SrcInitInputData%CoefDpths,1) - CALL Morison_Copycoefdpths( SrcInitInputData%CoefDpths(i1), DstInitInputData%CoefDpths(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NCoefMembers = SrcInitInputData%NCoefMembers -IF (ALLOCATED(SrcInitInputData%CoefMembers)) THEN - i1_l = LBOUND(SrcInitInputData%CoefMembers,1) - i1_u = UBOUND(SrcInitInputData%CoefMembers,1) - IF (.NOT. ALLOCATED(DstInitInputData%CoefMembers)) THEN - ALLOCATE(DstInitInputData%CoefMembers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CoefMembers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%CoefMembers,1), UBOUND(SrcInitInputData%CoefMembers,1) - CALL Morison_Copycoefmembers( SrcInitInputData%CoefMembers(i1), DstInitInputData%CoefMembers(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NMembers = SrcInitInputData%NMembers -IF (ALLOCATED(SrcInitInputData%InpMembers)) THEN - i1_l = LBOUND(SrcInitInputData%InpMembers,1) - i1_u = UBOUND(SrcInitInputData%InpMembers,1) - IF (.NOT. ALLOCATED(DstInitInputData%InpMembers)) THEN - ALLOCATE(DstInitInputData%InpMembers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InpMembers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%InpMembers,1), UBOUND(SrcInitInputData%InpMembers,1) - CALL Morison_Copymemberinputtype( SrcInitInputData%InpMembers(i1), DstInitInputData%InpMembers(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NFillGroups = SrcInitInputData%NFillGroups -IF (ALLOCATED(SrcInitInputData%FilledGroups)) THEN - i1_l = LBOUND(SrcInitInputData%FilledGroups,1) - i1_u = UBOUND(SrcInitInputData%FilledGroups,1) - IF (.NOT. ALLOCATED(DstInitInputData%FilledGroups)) THEN - ALLOCATE(DstInitInputData%FilledGroups(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%FilledGroups.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%FilledGroups,1), UBOUND(SrcInitInputData%FilledGroups,1) - CALL Morison_Copyfilledgrouptype( SrcInitInputData%FilledGroups(i1), DstInitInputData%FilledGroups(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NMGDepths = SrcInitInputData%NMGDepths -IF (ALLOCATED(SrcInitInputData%MGDepths)) THEN - i1_l = LBOUND(SrcInitInputData%MGDepths,1) - i1_u = UBOUND(SrcInitInputData%MGDepths,1) - IF (.NOT. ALLOCATED(DstInitInputData%MGDepths)) THEN - ALLOCATE(DstInitInputData%MGDepths(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MGDepths.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%MGDepths,1), UBOUND(SrcInitInputData%MGDepths,1) - CALL Morison_Copymgdepthstype( SrcInitInputData%MGDepths(i1), DstInitInputData%MGDepths(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%MGTop = SrcInitInputData%MGTop - DstInitInputData%MGBottom = SrcInitInputData%MGBottom - DstInitInputData%NMOutputs = SrcInitInputData%NMOutputs -IF (ALLOCATED(SrcInitInputData%MOutLst)) THEN - i1_l = LBOUND(SrcInitInputData%MOutLst,1) - i1_u = UBOUND(SrcInitInputData%MOutLst,1) - IF (.NOT. ALLOCATED(DstInitInputData%MOutLst)) THEN - ALLOCATE(DstInitInputData%MOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%MOutLst,1), UBOUND(SrcInitInputData%MOutLst,1) - CALL Morison_Copymoutput( SrcInitInputData%MOutLst(i1), DstInitInputData%MOutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NJOutputs = SrcInitInputData%NJOutputs -IF (ALLOCATED(SrcInitInputData%JOutLst)) THEN - i1_l = LBOUND(SrcInitInputData%JOutLst,1) - i1_u = UBOUND(SrcInitInputData%JOutLst,1) - IF (.NOT. ALLOCATED(DstInitInputData%JOutLst)) THEN - ALLOCATE(DstInitInputData%JOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%JOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%JOutLst,1), UBOUND(SrcInitInputData%JOutLst,1) - CALL Morison_Copyjoutput( SrcInitInputData%JOutLst(i1), DstInitInputData%JOutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInitInputData%OutList)) THEN - i1_l = LBOUND(SrcInitInputData%OutList,1) - i1_u = UBOUND(SrcInitInputData%OutList,1) - IF (.NOT. ALLOCATED(DstInitInputData%OutList)) THEN - ALLOCATE(DstInitInputData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%OutList = SrcInitInputData%OutList -ENDIF - DstInitInputData%NumOuts = SrcInitInputData%NumOuts - DstInitInputData%UnSum = SrcInitInputData%UnSum - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod - DstInitInputData%MCFD = SrcInitInputData%MCFD - DstInitInputData%WaveField => SrcInitInputData%WaveField - END SUBROUTINE Morison_CopyInitInput - - SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(Morison_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 = 'Morison_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%InpJoints)) THEN -DO i1 = LBOUND(InitInputData%InpJoints,1), UBOUND(InitInputData%InpJoints,1) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%JOutLst) -ENDIF -IF (ALLOCATED(InitInputData%OutList)) THEN - DEALLOCATE(InitInputData%OutList) -ENDIF -NULLIFY(InitInputData%WaveField) - END SUBROUTINE Morison_DestroyInitInput - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! WaveDisp - Int_BufSz = Int_BufSz + 1 ! AMMod - Int_BufSz = Int_BufSz + 1 ! NJoints - Int_BufSz = Int_BufSz + 1 ! NNodes - Int_BufSz = Int_BufSz + 1 ! InpJoints allocated yes/no - IF ( ALLOCATED(InData%InpJoints) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InpJoints upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InpJoints - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InpJoints - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InpJoints - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Nodes allocated yes/no - IF ( ALLOCATED(InData%Nodes) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Nodes - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Nodes - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Nodes - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NAxCoefs - Int_BufSz = Int_BufSz + 1 ! AxialCoefs allocated yes/no - IF ( ALLOCATED(InData%AxialCoefs) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AxialCoefs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AxialCoefs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AxialCoefs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NPropSets - Int_BufSz = Int_BufSz + 1 ! MPropSets allocated yes/no - IF ( ALLOCATED(InData%MPropSets) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MPropSets - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MPropSets - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MPropSets - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Re_BufSz = Re_BufSz + 1 ! SimplCd - Re_BufSz = Re_BufSz + 1 ! SimplCdMG - Re_BufSz = Re_BufSz + 1 ! SimplCa - Re_BufSz = Re_BufSz + 1 ! SimplCaMG - Re_BufSz = Re_BufSz + 1 ! SimplCp - Re_BufSz = Re_BufSz + 1 ! SimplCpMG - Re_BufSz = Re_BufSz + 1 ! SimplAxCd - Re_BufSz = Re_BufSz + 1 ! SimplAxCdMG - Re_BufSz = Re_BufSz + 1 ! SimplAxCa - Re_BufSz = Re_BufSz + 1 ! SimplAxCaMG - Re_BufSz = Re_BufSz + 1 ! SimplAxCp - Re_BufSz = Re_BufSz + 1 ! SimplAxCpMG - Re_BufSz = Re_BufSz + 1 ! SimplCb - Re_BufSz = Re_BufSz + 1 ! SimplCbMg - Int_BufSz = Int_BufSz + 1 ! SimplMCF - Int_BufSz = Int_BufSz + 1 ! NCoefDpth - Int_BufSz = Int_BufSz + 1 ! CoefDpths allocated yes/no - IF ( ALLOCATED(InData%CoefDpths) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CoefDpths - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CoefDpths - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CoefDpths - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NCoefMembers - Int_BufSz = Int_BufSz + 1 ! CoefMembers allocated yes/no - IF ( ALLOCATED(InData%CoefMembers) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CoefMembers - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CoefMembers - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CoefMembers - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NMembers - Int_BufSz = Int_BufSz + 1 ! InpMembers allocated yes/no - IF ( ALLOCATED(InData%InpMembers) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InpMembers - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InpMembers - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InpMembers - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NFillGroups - Int_BufSz = Int_BufSz + 1 ! FilledGroups allocated yes/no - IF ( ALLOCATED(InData%FilledGroups) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FilledGroups - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FilledGroups - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FilledGroups - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NMGDepths - Int_BufSz = Int_BufSz + 1 ! MGDepths allocated yes/no - IF ( ALLOCATED(InData%MGDepths) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MGDepths - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MGDepths - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MGDepths - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Re_BufSz = Re_BufSz + 1 ! MGTop - Re_BufSz = Re_BufSz + 1 ! MGBottom - Int_BufSz = Int_BufSz + 1 ! NMOutputs - Int_BufSz = Int_BufSz + 1 ! MOutLst allocated yes/no - IF ( ALLOCATED(InData%MOutLst) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MOutLst - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MOutLst - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MOutLst - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NJOutputs - Int_BufSz = Int_BufSz + 1 ! JOutLst allocated yes/no - IF ( ALLOCATED(InData%JOutLst) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! JOutLst - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! JOutLst - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! JOutLst - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! UnSum - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! WaveStMod - Re_BufSz = Re_BufSz + 1 ! MCFD - 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%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 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveDisp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AMMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NNodes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%InpJoints) ) 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%InpJoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InpJoints,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%Nodes) ) 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%Nodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes,1) - 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 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%NAxCoefs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AxialCoefs) ) 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%AxialCoefs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxialCoefs,1) - 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 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%NPropSets - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%MPropSets) ) 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%MPropSets,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MPropSets,1) - 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 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 - ReKiBuf(Re_Xferred) = InData%SimplCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCbMg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SimplMCF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NCoefDpth - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CoefDpths) ) 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%CoefDpths,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CoefDpths,1) - 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 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%NCoefMembers - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CoefMembers) ) 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%CoefMembers,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CoefMembers,1) - 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 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%NMembers - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%InpMembers) ) 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%InpMembers,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InpMembers,1) - 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 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%NFillGroups - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FilledGroups) ) 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%FilledGroups,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FilledGroups,1) - 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 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%NMGDepths - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%MGDepths) ) 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%MGDepths,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MGDepths,1) - 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 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 - ReKiBuf(Re_Xferred) = InData%MGTop - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MGBottom - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%MOutLst) ) 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%MOutLst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MOutLst,1) - 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 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%NJOutputs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%JOutLst) ) 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%JOutLst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%JOutLst,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%OutList) ) 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%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - 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 - END IF - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MCFD - Re_Xferred = Re_Xferred + 1 - 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) :: 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) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InpJoints)) DEALLOCATE(OutData%InpJoints) - ALLOCATE(OutData%InpJoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpJoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InpJoints,1), UBOUND(OutData%InpJoints,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_UnpackJointType( Re_Buf, Db_Buf, Int_Buf, OutData%InpJoints(i1), ErrStat2, ErrMsg2 ) ! InpJoints - 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 ! Nodes 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%Nodes)) DEALLOCATE(OutData%Nodes) - ALLOCATE(OutData%Nodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Nodes,1), UBOUND(OutData%Nodes,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_UnpackNodeType( Re_Buf, Db_Buf, Int_Buf, OutData%Nodes(i1), ErrStat2, ErrMsg2 ) ! Nodes - 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%NAxCoefs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxialCoefs 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%AxialCoefs)) DEALLOCATE(OutData%AxialCoefs) - ALLOCATE(OutData%AxialCoefs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxialCoefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AxialCoefs,1), UBOUND(OutData%AxialCoefs,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_UnpackAxialCoefType( Re_Buf, Db_Buf, Int_Buf, OutData%AxialCoefs(i1), ErrStat2, ErrMsg2 ) ! AxialCoefs - 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%NPropSets = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MPropSets 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%MPropSets)) DEALLOCATE(OutData%MPropSets) - ALLOCATE(OutData%MPropSets(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MPropSets.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MPropSets,1), UBOUND(OutData%MPropSets,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_UnpackMemberPropType( Re_Buf, Db_Buf, Int_Buf, OutData%MPropSets(i1), ErrStat2, ErrMsg2 ) ! MPropSets - 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%SimplCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCdMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCaMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCpMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCdMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCaMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCpMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCbMg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplMCF = TRANSFER(IntKiBuf(Int_Xferred), OutData%SimplMCF) - Int_Xferred = Int_Xferred + 1 - OutData%NCoefDpth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoefDpths 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%CoefDpths)) DEALLOCATE(OutData%CoefDpths) - ALLOCATE(OutData%CoefDpths(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefDpths.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CoefDpths,1), UBOUND(OutData%CoefDpths,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_UnpackCoefDpths( Re_Buf, Db_Buf, Int_Buf, OutData%CoefDpths(i1), ErrStat2, ErrMsg2 ) ! CoefDpths - 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%NCoefMembers = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoefMembers 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%CoefMembers)) DEALLOCATE(OutData%CoefMembers) - ALLOCATE(OutData%CoefMembers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefMembers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CoefMembers,1), UBOUND(OutData%CoefMembers,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_UnpackCoefMembers( Re_Buf, Db_Buf, Int_Buf, OutData%CoefMembers(i1), ErrStat2, ErrMsg2 ) ! CoefMembers - 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%NMembers = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpMembers 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%InpMembers)) DEALLOCATE(OutData%InpMembers) - ALLOCATE(OutData%InpMembers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpMembers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InpMembers,1), UBOUND(OutData%InpMembers,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_UnpackMemberInputType( Re_Buf, Db_Buf, Int_Buf, OutData%InpMembers(i1), ErrStat2, ErrMsg2 ) ! InpMembers - 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%NFillGroups = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FilledGroups 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%FilledGroups)) DEALLOCATE(OutData%FilledGroups) - ALLOCATE(OutData%FilledGroups(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FilledGroups.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FilledGroups,1), UBOUND(OutData%FilledGroups,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_UnpackFilledGroupType( Re_Buf, Db_Buf, Int_Buf, OutData%FilledGroups(i1), ErrStat2, ErrMsg2 ) ! FilledGroups - 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%NMGDepths = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MGDepths 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%MGDepths)) DEALLOCATE(OutData%MGDepths) - ALLOCATE(OutData%MGDepths(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MGDepths.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MGDepths,1), UBOUND(OutData%MGDepths,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_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 - OutData%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MCFD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - NULLIFY(OutData%WaveField) - END SUBROUTINE Morison_UnPackInitInput - - SUBROUTINE Morison_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Morison_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 = 'Morison_CopyInitOutput' -! + ErrMsg = '' + DstNodeTypeData%JointIndx = SrcNodeTypeData%JointIndx + DstNodeTypeData%Position = SrcNodeTypeData%Position + DstNodeTypeData%JointOvrlp = SrcNodeTypeData%JointOvrlp + DstNodeTypeData%JointAxIDIndx = SrcNodeTypeData%JointAxIDIndx + DstNodeTypeData%NConnections = SrcNodeTypeData%NConnections + DstNodeTypeData%ConnectionList = SrcNodeTypeData%ConnectionList + DstNodeTypeData%JAxCd = SrcNodeTypeData%JAxCd + DstNodeTypeData%JAxCa = SrcNodeTypeData%JAxCa + DstNodeTypeData%JAxCp = SrcNodeTypeData%JAxCp + DstNodeTypeData%JAxVnCOff = SrcNodeTypeData%JAxVnCOff + DstNodeTypeData%JAxFDLoFSc = SrcNodeTypeData%JAxFDLoFSc + DstNodeTypeData%JAxFDMod = SrcNodeTypeData%JAxFDMod + DstNodeTypeData%FillDensity = SrcNodeTypeData%FillDensity + DstNodeTypeData%tMG = SrcNodeTypeData%tMG + DstNodeTypeData%MGdensity = SrcNodeTypeData%MGdensity +end subroutine + +subroutine Morison_DestroyNodeType(NodeTypeData, ErrStat, ErrMsg) + type(Morison_NodeType), intent(inout) :: NodeTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyNodeType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Morison_PackNodeType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_NodeType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackNodeType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%JointIndx) + call RegPack(Buf, InData%Position) + call RegPack(Buf, InData%JointOvrlp) + call RegPack(Buf, InData%JointAxIDIndx) + call RegPack(Buf, InData%NConnections) + call RegPack(Buf, InData%ConnectionList) + call RegPack(Buf, InData%JAxCd) + call RegPack(Buf, InData%JAxCa) + call RegPack(Buf, InData%JAxCp) + call RegPack(Buf, InData%JAxVnCOff) + call RegPack(Buf, InData%JAxFDLoFSc) + call RegPack(Buf, InData%JAxFDMod) + call RegPack(Buf, InData%FillDensity) + call RegPack(Buf, InData%tMG) + call RegPack(Buf, InData%MGdensity) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackNodeType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_NodeType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackNodeType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%JointIndx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Position) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%JointOvrlp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%JointAxIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NConnections) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ConnectionList) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%JAxCd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%JAxCa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%JAxCp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%JAxVnCOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%JAxFDLoFSc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%JAxFDMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FillDensity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tMG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MGdensity) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MemberType), intent(in) :: SrcMemberTypeData + type(Morison_MemberType), intent(inout) :: DstMemberTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyMemberType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMemberTypeData%NodeIndx)) then + LB(1:1) = lbound(SrcMemberTypeData%NodeIndx) + UB(1:1) = ubound(SrcMemberTypeData%NodeIndx) + if (.not. allocated(DstMemberTypeData%NodeIndx)) then + allocate(DstMemberTypeData%NodeIndx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%NodeIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%NodeIndx = SrcMemberTypeData%NodeIndx + end if + DstMemberTypeData%MemberID = SrcMemberTypeData%MemberID + DstMemberTypeData%NElements = SrcMemberTypeData%NElements + DstMemberTypeData%RefLength = SrcMemberTypeData%RefLength + DstMemberTypeData%cosPhi_ref = SrcMemberTypeData%cosPhi_ref + DstMemberTypeData%dl = SrcMemberTypeData%dl + DstMemberTypeData%k = SrcMemberTypeData%k + DstMemberTypeData%kkt = SrcMemberTypeData%kkt + DstMemberTypeData%Ak = SrcMemberTypeData%Ak + if (allocated(SrcMemberTypeData%R)) then + LB(1:1) = lbound(SrcMemberTypeData%R) + UB(1:1) = ubound(SrcMemberTypeData%R) + if (.not. allocated(DstMemberTypeData%R)) then + allocate(DstMemberTypeData%R(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%R.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%R = SrcMemberTypeData%R + end if + if (allocated(SrcMemberTypeData%RMG)) then + LB(1:1) = lbound(SrcMemberTypeData%RMG) + UB(1:1) = ubound(SrcMemberTypeData%RMG) + if (.not. allocated(DstMemberTypeData%RMG)) then + allocate(DstMemberTypeData%RMG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%RMG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%RMG = SrcMemberTypeData%RMG + end if + if (allocated(SrcMemberTypeData%RMGB)) then + LB(1:1) = lbound(SrcMemberTypeData%RMGB) + UB(1:1) = ubound(SrcMemberTypeData%RMGB) + if (.not. allocated(DstMemberTypeData%RMGB)) then + allocate(DstMemberTypeData%RMGB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%RMGB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%RMGB = SrcMemberTypeData%RMGB + end if + if (allocated(SrcMemberTypeData%Rin)) then + LB(1:1) = lbound(SrcMemberTypeData%Rin) + UB(1:1) = ubound(SrcMemberTypeData%Rin) + if (.not. allocated(DstMemberTypeData%Rin)) then + allocate(DstMemberTypeData%Rin(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Rin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Rin = SrcMemberTypeData%Rin + end if + if (allocated(SrcMemberTypeData%tMG)) then + LB(1:1) = lbound(SrcMemberTypeData%tMG) + UB(1:1) = ubound(SrcMemberTypeData%tMG) + if (.not. allocated(DstMemberTypeData%tMG)) then + allocate(DstMemberTypeData%tMG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%tMG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%tMG = SrcMemberTypeData%tMG + end if + if (allocated(SrcMemberTypeData%MGdensity)) then + LB(1:1) = lbound(SrcMemberTypeData%MGdensity) + UB(1:1) = ubound(SrcMemberTypeData%MGdensity) + if (.not. allocated(DstMemberTypeData%MGdensity)) then + allocate(DstMemberTypeData%MGdensity(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%MGdensity.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%MGdensity = SrcMemberTypeData%MGdensity + end if + if (allocated(SrcMemberTypeData%dRdl_mg)) then + LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg) + if (.not. allocated(DstMemberTypeData%dRdl_mg)) then + allocate(DstMemberTypeData%dRdl_mg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_mg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%dRdl_mg = SrcMemberTypeData%dRdl_mg + end if + if (allocated(SrcMemberTypeData%dRdl_mg_b)) then + LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg_b) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg_b) + if (.not. allocated(DstMemberTypeData%dRdl_mg_b)) then + allocate(DstMemberTypeData%dRdl_mg_b(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_mg_b.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%dRdl_mg_b = SrcMemberTypeData%dRdl_mg_b + end if + if (allocated(SrcMemberTypeData%dRdl_in)) then + LB(1:1) = lbound(SrcMemberTypeData%dRdl_in) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_in) + if (.not. allocated(DstMemberTypeData%dRdl_in)) then + allocate(DstMemberTypeData%dRdl_in(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_in.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%dRdl_in = SrcMemberTypeData%dRdl_in + end if + DstMemberTypeData%Vinner = SrcMemberTypeData%Vinner + DstMemberTypeData%Vouter = SrcMemberTypeData%Vouter + DstMemberTypeData%Vballast = SrcMemberTypeData%Vballast + DstMemberTypeData%Vsubmerged = SrcMemberTypeData%Vsubmerged + DstMemberTypeData%l_fill = SrcMemberTypeData%l_fill + DstMemberTypeData%h_fill = SrcMemberTypeData%h_fill + DstMemberTypeData%z_overfill = SrcMemberTypeData%z_overfill + DstMemberTypeData%h_floor = SrcMemberTypeData%h_floor + DstMemberTypeData%i_floor = SrcMemberTypeData%i_floor + DstMemberTypeData%doEndBuoyancy = SrcMemberTypeData%doEndBuoyancy + DstMemberTypeData%memfloodstatus = SrcMemberTypeData%memfloodstatus + if (allocated(SrcMemberTypeData%floodstatus)) then + LB(1:1) = lbound(SrcMemberTypeData%floodstatus) + UB(1:1) = ubound(SrcMemberTypeData%floodstatus) + if (.not. allocated(DstMemberTypeData%floodstatus)) then + allocate(DstMemberTypeData%floodstatus(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%floodstatus.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%floodstatus = SrcMemberTypeData%floodstatus + end if + if (allocated(SrcMemberTypeData%alpha)) then + LB(1:1) = lbound(SrcMemberTypeData%alpha) + UB(1:1) = ubound(SrcMemberTypeData%alpha) + if (.not. allocated(DstMemberTypeData%alpha)) then + allocate(DstMemberTypeData%alpha(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%alpha = SrcMemberTypeData%alpha + end if + if (allocated(SrcMemberTypeData%alpha_fb)) then + LB(1:1) = lbound(SrcMemberTypeData%alpha_fb) + UB(1:1) = ubound(SrcMemberTypeData%alpha_fb) + if (.not. allocated(DstMemberTypeData%alpha_fb)) then + allocate(DstMemberTypeData%alpha_fb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha_fb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%alpha_fb = SrcMemberTypeData%alpha_fb + end if + if (allocated(SrcMemberTypeData%alpha_fb_star)) then + LB(1:1) = lbound(SrcMemberTypeData%alpha_fb_star) + UB(1:1) = ubound(SrcMemberTypeData%alpha_fb_star) + if (.not. allocated(DstMemberTypeData%alpha_fb_star)) then + allocate(DstMemberTypeData%alpha_fb_star(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha_fb_star.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%alpha_fb_star = SrcMemberTypeData%alpha_fb_star + end if + if (allocated(SrcMemberTypeData%Cd)) then + LB(1:1) = lbound(SrcMemberTypeData%Cd) + UB(1:1) = ubound(SrcMemberTypeData%Cd) + if (.not. allocated(DstMemberTypeData%Cd)) then + allocate(DstMemberTypeData%Cd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Cd = SrcMemberTypeData%Cd + end if + if (allocated(SrcMemberTypeData%Ca)) then + LB(1:1) = lbound(SrcMemberTypeData%Ca) + UB(1:1) = ubound(SrcMemberTypeData%Ca) + if (.not. allocated(DstMemberTypeData%Ca)) then + allocate(DstMemberTypeData%Ca(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Ca.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Ca = SrcMemberTypeData%Ca + end if + if (allocated(SrcMemberTypeData%Cp)) then + LB(1:1) = lbound(SrcMemberTypeData%Cp) + UB(1:1) = ubound(SrcMemberTypeData%Cp) + if (.not. allocated(DstMemberTypeData%Cp)) then + allocate(DstMemberTypeData%Cp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Cp = SrcMemberTypeData%Cp + end if + if (allocated(SrcMemberTypeData%AxCd)) then + LB(1:1) = lbound(SrcMemberTypeData%AxCd) + UB(1:1) = ubound(SrcMemberTypeData%AxCd) + if (.not. allocated(DstMemberTypeData%AxCd)) then + allocate(DstMemberTypeData%AxCd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%AxCd = SrcMemberTypeData%AxCd + end if + if (allocated(SrcMemberTypeData%AxCa)) then + LB(1:1) = lbound(SrcMemberTypeData%AxCa) + UB(1:1) = ubound(SrcMemberTypeData%AxCa) + if (.not. allocated(DstMemberTypeData%AxCa)) then + allocate(DstMemberTypeData%AxCa(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCa.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%AxCa = SrcMemberTypeData%AxCa + end if + if (allocated(SrcMemberTypeData%AxCp)) then + LB(1:1) = lbound(SrcMemberTypeData%AxCp) + UB(1:1) = ubound(SrcMemberTypeData%AxCp) + if (.not. allocated(DstMemberTypeData%AxCp)) then + allocate(DstMemberTypeData%AxCp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%AxCp = SrcMemberTypeData%AxCp + end if + if (allocated(SrcMemberTypeData%Cb)) then + LB(1:1) = lbound(SrcMemberTypeData%Cb) + UB(1:1) = ubound(SrcMemberTypeData%Cb) + if (.not. allocated(DstMemberTypeData%Cb)) then + allocate(DstMemberTypeData%Cb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Cb = SrcMemberTypeData%Cb + end if + if (allocated(SrcMemberTypeData%m_fb_l)) then + LB(1:1) = lbound(SrcMemberTypeData%m_fb_l) + UB(1:1) = ubound(SrcMemberTypeData%m_fb_l) + if (.not. allocated(DstMemberTypeData%m_fb_l)) then + allocate(DstMemberTypeData%m_fb_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_fb_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%m_fb_l = SrcMemberTypeData%m_fb_l + end if + if (allocated(SrcMemberTypeData%m_fb_u)) then + LB(1:1) = lbound(SrcMemberTypeData%m_fb_u) + UB(1:1) = ubound(SrcMemberTypeData%m_fb_u) + if (.not. allocated(DstMemberTypeData%m_fb_u)) then + allocate(DstMemberTypeData%m_fb_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_fb_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%m_fb_u = SrcMemberTypeData%m_fb_u + end if + if (allocated(SrcMemberTypeData%h_cfb_l)) then + LB(1:1) = lbound(SrcMemberTypeData%h_cfb_l) + UB(1:1) = ubound(SrcMemberTypeData%h_cfb_l) + if (.not. allocated(DstMemberTypeData%h_cfb_l)) then + allocate(DstMemberTypeData%h_cfb_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cfb_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%h_cfb_l = SrcMemberTypeData%h_cfb_l + end if + if (allocated(SrcMemberTypeData%h_cfb_u)) then + LB(1:1) = lbound(SrcMemberTypeData%h_cfb_u) + UB(1:1) = ubound(SrcMemberTypeData%h_cfb_u) + if (.not. allocated(DstMemberTypeData%h_cfb_u)) then + allocate(DstMemberTypeData%h_cfb_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cfb_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%h_cfb_u = SrcMemberTypeData%h_cfb_u + end if + if (allocated(SrcMemberTypeData%I_lfb_l)) then + LB(1:1) = lbound(SrcMemberTypeData%I_lfb_l) + UB(1:1) = ubound(SrcMemberTypeData%I_lfb_l) + if (.not. allocated(DstMemberTypeData%I_lfb_l)) then + allocate(DstMemberTypeData%I_lfb_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lfb_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_lfb_l = SrcMemberTypeData%I_lfb_l + end if + if (allocated(SrcMemberTypeData%I_lfb_u)) then + LB(1:1) = lbound(SrcMemberTypeData%I_lfb_u) + UB(1:1) = ubound(SrcMemberTypeData%I_lfb_u) + if (.not. allocated(DstMemberTypeData%I_lfb_u)) then + allocate(DstMemberTypeData%I_lfb_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lfb_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_lfb_u = SrcMemberTypeData%I_lfb_u + end if + if (allocated(SrcMemberTypeData%I_rfb_l)) then + LB(1:1) = lbound(SrcMemberTypeData%I_rfb_l) + UB(1:1) = ubound(SrcMemberTypeData%I_rfb_l) + if (.not. allocated(DstMemberTypeData%I_rfb_l)) then + allocate(DstMemberTypeData%I_rfb_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rfb_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_rfb_l = SrcMemberTypeData%I_rfb_l + end if + if (allocated(SrcMemberTypeData%I_rfb_u)) then + LB(1:1) = lbound(SrcMemberTypeData%I_rfb_u) + UB(1:1) = ubound(SrcMemberTypeData%I_rfb_u) + if (.not. allocated(DstMemberTypeData%I_rfb_u)) then + allocate(DstMemberTypeData%I_rfb_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rfb_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_rfb_u = SrcMemberTypeData%I_rfb_u + end if + if (allocated(SrcMemberTypeData%m_mg_l)) then + LB(1:1) = lbound(SrcMemberTypeData%m_mg_l) + UB(1:1) = ubound(SrcMemberTypeData%m_mg_l) + if (.not. allocated(DstMemberTypeData%m_mg_l)) then + allocate(DstMemberTypeData%m_mg_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_mg_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%m_mg_l = SrcMemberTypeData%m_mg_l + end if + if (allocated(SrcMemberTypeData%m_mg_u)) then + LB(1:1) = lbound(SrcMemberTypeData%m_mg_u) + UB(1:1) = ubound(SrcMemberTypeData%m_mg_u) + if (.not. allocated(DstMemberTypeData%m_mg_u)) then + allocate(DstMemberTypeData%m_mg_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_mg_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%m_mg_u = SrcMemberTypeData%m_mg_u + end if + if (allocated(SrcMemberTypeData%h_cmg_l)) then + LB(1:1) = lbound(SrcMemberTypeData%h_cmg_l) + UB(1:1) = ubound(SrcMemberTypeData%h_cmg_l) + if (.not. allocated(DstMemberTypeData%h_cmg_l)) then + allocate(DstMemberTypeData%h_cmg_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cmg_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%h_cmg_l = SrcMemberTypeData%h_cmg_l + end if + if (allocated(SrcMemberTypeData%h_cmg_u)) then + LB(1:1) = lbound(SrcMemberTypeData%h_cmg_u) + UB(1:1) = ubound(SrcMemberTypeData%h_cmg_u) + if (.not. allocated(DstMemberTypeData%h_cmg_u)) then + allocate(DstMemberTypeData%h_cmg_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cmg_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%h_cmg_u = SrcMemberTypeData%h_cmg_u + end if + if (allocated(SrcMemberTypeData%I_lmg_l)) then + LB(1:1) = lbound(SrcMemberTypeData%I_lmg_l) + UB(1:1) = ubound(SrcMemberTypeData%I_lmg_l) + if (.not. allocated(DstMemberTypeData%I_lmg_l)) then + allocate(DstMemberTypeData%I_lmg_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lmg_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_lmg_l = SrcMemberTypeData%I_lmg_l + end if + if (allocated(SrcMemberTypeData%I_lmg_u)) then + LB(1:1) = lbound(SrcMemberTypeData%I_lmg_u) + UB(1:1) = ubound(SrcMemberTypeData%I_lmg_u) + if (.not. allocated(DstMemberTypeData%I_lmg_u)) then + allocate(DstMemberTypeData%I_lmg_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lmg_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_lmg_u = SrcMemberTypeData%I_lmg_u + end if + if (allocated(SrcMemberTypeData%I_rmg_l)) then + LB(1:1) = lbound(SrcMemberTypeData%I_rmg_l) + UB(1:1) = ubound(SrcMemberTypeData%I_rmg_l) + if (.not. allocated(DstMemberTypeData%I_rmg_l)) then + allocate(DstMemberTypeData%I_rmg_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rmg_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_rmg_l = SrcMemberTypeData%I_rmg_l + end if + if (allocated(SrcMemberTypeData%I_rmg_u)) then + LB(1:1) = lbound(SrcMemberTypeData%I_rmg_u) + UB(1:1) = ubound(SrcMemberTypeData%I_rmg_u) + if (.not. allocated(DstMemberTypeData%I_rmg_u)) then + allocate(DstMemberTypeData%I_rmg_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rmg_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_rmg_u = SrcMemberTypeData%I_rmg_u + end if + if (allocated(SrcMemberTypeData%Cfl_fb)) then + LB(1:1) = lbound(SrcMemberTypeData%Cfl_fb) + UB(1:1) = ubound(SrcMemberTypeData%Cfl_fb) + if (.not. allocated(DstMemberTypeData%Cfl_fb)) then + allocate(DstMemberTypeData%Cfl_fb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cfl_fb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Cfl_fb = SrcMemberTypeData%Cfl_fb + end if + if (allocated(SrcMemberTypeData%Cfr_fb)) then + LB(1:1) = lbound(SrcMemberTypeData%Cfr_fb) + UB(1:1) = ubound(SrcMemberTypeData%Cfr_fb) + if (.not. allocated(DstMemberTypeData%Cfr_fb)) then + allocate(DstMemberTypeData%Cfr_fb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cfr_fb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Cfr_fb = SrcMemberTypeData%Cfr_fb + end if + if (allocated(SrcMemberTypeData%CM0_fb)) then + LB(1:1) = lbound(SrcMemberTypeData%CM0_fb) + UB(1:1) = ubound(SrcMemberTypeData%CM0_fb) + if (.not. allocated(DstMemberTypeData%CM0_fb)) then + allocate(DstMemberTypeData%CM0_fb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%CM0_fb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%CM0_fb = SrcMemberTypeData%CM0_fb + end if + DstMemberTypeData%MGvolume = SrcMemberTypeData%MGvolume + DstMemberTypeData%MDivSize = SrcMemberTypeData%MDivSize + DstMemberTypeData%MCoefMod = SrcMemberTypeData%MCoefMod + DstMemberTypeData%MmbrCoefIDIndx = SrcMemberTypeData%MmbrCoefIDIndx + DstMemberTypeData%MmbrFilledIDIndx = SrcMemberTypeData%MmbrFilledIDIndx + DstMemberTypeData%MHstLMod = SrcMemberTypeData%MHstLMod + DstMemberTypeData%FillFSLoc = SrcMemberTypeData%FillFSLoc + DstMemberTypeData%FillDens = SrcMemberTypeData%FillDens + DstMemberTypeData%PropPot = SrcMemberTypeData%PropPot + DstMemberTypeData%PropMCF = SrcMemberTypeData%PropMCF + DstMemberTypeData%Flipped = SrcMemberTypeData%Flipped +end subroutine + +subroutine Morison_DestroyMemberType(MemberTypeData, ErrStat, ErrMsg) + type(Morison_MemberType), intent(inout) :: MemberTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMemberType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MemberTypeData%NodeIndx)) then + deallocate(MemberTypeData%NodeIndx) + end if + if (allocated(MemberTypeData%R)) then + deallocate(MemberTypeData%R) + end if + if (allocated(MemberTypeData%RMG)) then + deallocate(MemberTypeData%RMG) + end if + if (allocated(MemberTypeData%RMGB)) then + deallocate(MemberTypeData%RMGB) + end if + if (allocated(MemberTypeData%Rin)) then + deallocate(MemberTypeData%Rin) + end if + if (allocated(MemberTypeData%tMG)) then + deallocate(MemberTypeData%tMG) + end if + if (allocated(MemberTypeData%MGdensity)) then + deallocate(MemberTypeData%MGdensity) + end if + if (allocated(MemberTypeData%dRdl_mg)) then + deallocate(MemberTypeData%dRdl_mg) + end if + if (allocated(MemberTypeData%dRdl_mg_b)) then + deallocate(MemberTypeData%dRdl_mg_b) + end if + if (allocated(MemberTypeData%dRdl_in)) then + deallocate(MemberTypeData%dRdl_in) + end if + if (allocated(MemberTypeData%floodstatus)) then + deallocate(MemberTypeData%floodstatus) + end if + if (allocated(MemberTypeData%alpha)) then + deallocate(MemberTypeData%alpha) + end if + if (allocated(MemberTypeData%alpha_fb)) then + deallocate(MemberTypeData%alpha_fb) + end if + if (allocated(MemberTypeData%alpha_fb_star)) then + deallocate(MemberTypeData%alpha_fb_star) + end if + if (allocated(MemberTypeData%Cd)) then + deallocate(MemberTypeData%Cd) + end if + if (allocated(MemberTypeData%Ca)) then + deallocate(MemberTypeData%Ca) + end if + if (allocated(MemberTypeData%Cp)) then + deallocate(MemberTypeData%Cp) + end if + if (allocated(MemberTypeData%AxCd)) then + deallocate(MemberTypeData%AxCd) + end if + if (allocated(MemberTypeData%AxCa)) then + deallocate(MemberTypeData%AxCa) + end if + if (allocated(MemberTypeData%AxCp)) then + deallocate(MemberTypeData%AxCp) + end if + if (allocated(MemberTypeData%Cb)) then + deallocate(MemberTypeData%Cb) + end if + if (allocated(MemberTypeData%m_fb_l)) then + deallocate(MemberTypeData%m_fb_l) + end if + if (allocated(MemberTypeData%m_fb_u)) then + deallocate(MemberTypeData%m_fb_u) + end if + if (allocated(MemberTypeData%h_cfb_l)) then + deallocate(MemberTypeData%h_cfb_l) + end if + if (allocated(MemberTypeData%h_cfb_u)) then + deallocate(MemberTypeData%h_cfb_u) + end if + if (allocated(MemberTypeData%I_lfb_l)) then + deallocate(MemberTypeData%I_lfb_l) + end if + if (allocated(MemberTypeData%I_lfb_u)) then + deallocate(MemberTypeData%I_lfb_u) + end if + if (allocated(MemberTypeData%I_rfb_l)) then + deallocate(MemberTypeData%I_rfb_l) + end if + if (allocated(MemberTypeData%I_rfb_u)) then + deallocate(MemberTypeData%I_rfb_u) + end if + if (allocated(MemberTypeData%m_mg_l)) then + deallocate(MemberTypeData%m_mg_l) + end if + if (allocated(MemberTypeData%m_mg_u)) then + deallocate(MemberTypeData%m_mg_u) + end if + if (allocated(MemberTypeData%h_cmg_l)) then + deallocate(MemberTypeData%h_cmg_l) + end if + if (allocated(MemberTypeData%h_cmg_u)) then + deallocate(MemberTypeData%h_cmg_u) + end if + if (allocated(MemberTypeData%I_lmg_l)) then + deallocate(MemberTypeData%I_lmg_l) + end if + if (allocated(MemberTypeData%I_lmg_u)) then + deallocate(MemberTypeData%I_lmg_u) + end if + if (allocated(MemberTypeData%I_rmg_l)) then + deallocate(MemberTypeData%I_rmg_l) + end if + if (allocated(MemberTypeData%I_rmg_u)) then + deallocate(MemberTypeData%I_rmg_u) + end if + if (allocated(MemberTypeData%Cfl_fb)) then + deallocate(MemberTypeData%Cfl_fb) + end if + if (allocated(MemberTypeData%Cfr_fb)) then + deallocate(MemberTypeData%Cfr_fb) + end if + if (allocated(MemberTypeData%CM0_fb)) then + deallocate(MemberTypeData%CM0_fb) + end if +end subroutine + +subroutine Morison_PackMemberType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMemberType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%NodeIndx)) + if (allocated(InData%NodeIndx)) then + call RegPackBounds(Buf, 1, lbound(InData%NodeIndx), ubound(InData%NodeIndx)) + call RegPack(Buf, InData%NodeIndx) + end if + call RegPack(Buf, InData%MemberID) + call RegPack(Buf, InData%NElements) + call RegPack(Buf, InData%RefLength) + call RegPack(Buf, InData%cosPhi_ref) + call RegPack(Buf, InData%dl) + call RegPack(Buf, InData%k) + call RegPack(Buf, InData%kkt) + call RegPack(Buf, InData%Ak) + call RegPack(Buf, allocated(InData%R)) + if (allocated(InData%R)) then + call RegPackBounds(Buf, 1, lbound(InData%R), ubound(InData%R)) + call RegPack(Buf, InData%R) + end if + call RegPack(Buf, allocated(InData%RMG)) + if (allocated(InData%RMG)) then + call RegPackBounds(Buf, 1, lbound(InData%RMG), ubound(InData%RMG)) + call RegPack(Buf, InData%RMG) + end if + call RegPack(Buf, allocated(InData%RMGB)) + if (allocated(InData%RMGB)) then + call RegPackBounds(Buf, 1, lbound(InData%RMGB), ubound(InData%RMGB)) + call RegPack(Buf, InData%RMGB) + end if + call RegPack(Buf, allocated(InData%Rin)) + if (allocated(InData%Rin)) then + call RegPackBounds(Buf, 1, lbound(InData%Rin), ubound(InData%Rin)) + call RegPack(Buf, InData%Rin) + end if + call RegPack(Buf, allocated(InData%tMG)) + if (allocated(InData%tMG)) then + call RegPackBounds(Buf, 1, lbound(InData%tMG), ubound(InData%tMG)) + call RegPack(Buf, InData%tMG) + end if + call RegPack(Buf, allocated(InData%MGdensity)) + if (allocated(InData%MGdensity)) then + call RegPackBounds(Buf, 1, lbound(InData%MGdensity), ubound(InData%MGdensity)) + call RegPack(Buf, InData%MGdensity) + end if + call RegPack(Buf, allocated(InData%dRdl_mg)) + if (allocated(InData%dRdl_mg)) then + call RegPackBounds(Buf, 1, lbound(InData%dRdl_mg), ubound(InData%dRdl_mg)) + call RegPack(Buf, InData%dRdl_mg) + end if + call RegPack(Buf, allocated(InData%dRdl_mg_b)) + if (allocated(InData%dRdl_mg_b)) then + call RegPackBounds(Buf, 1, lbound(InData%dRdl_mg_b), ubound(InData%dRdl_mg_b)) + call RegPack(Buf, InData%dRdl_mg_b) + end if + call RegPack(Buf, allocated(InData%dRdl_in)) + if (allocated(InData%dRdl_in)) then + call RegPackBounds(Buf, 1, lbound(InData%dRdl_in), ubound(InData%dRdl_in)) + call RegPack(Buf, InData%dRdl_in) + end if + call RegPack(Buf, InData%Vinner) + call RegPack(Buf, InData%Vouter) + call RegPack(Buf, InData%Vballast) + call RegPack(Buf, InData%Vsubmerged) + call RegPack(Buf, InData%l_fill) + call RegPack(Buf, InData%h_fill) + call RegPack(Buf, InData%z_overfill) + call RegPack(Buf, InData%h_floor) + call RegPack(Buf, InData%i_floor) + call RegPack(Buf, InData%doEndBuoyancy) + call RegPack(Buf, InData%memfloodstatus) + call RegPack(Buf, allocated(InData%floodstatus)) + if (allocated(InData%floodstatus)) then + call RegPackBounds(Buf, 1, lbound(InData%floodstatus), ubound(InData%floodstatus)) + call RegPack(Buf, InData%floodstatus) + end if + call RegPack(Buf, allocated(InData%alpha)) + if (allocated(InData%alpha)) then + call RegPackBounds(Buf, 1, lbound(InData%alpha), ubound(InData%alpha)) + call RegPack(Buf, InData%alpha) + end if + call RegPack(Buf, allocated(InData%alpha_fb)) + if (allocated(InData%alpha_fb)) then + call RegPackBounds(Buf, 1, lbound(InData%alpha_fb), ubound(InData%alpha_fb)) + call RegPack(Buf, InData%alpha_fb) + end if + call RegPack(Buf, allocated(InData%alpha_fb_star)) + if (allocated(InData%alpha_fb_star)) then + call RegPackBounds(Buf, 1, lbound(InData%alpha_fb_star), ubound(InData%alpha_fb_star)) + call RegPack(Buf, InData%alpha_fb_star) + end if + call RegPack(Buf, allocated(InData%Cd)) + if (allocated(InData%Cd)) then + call RegPackBounds(Buf, 1, lbound(InData%Cd), ubound(InData%Cd)) + call RegPack(Buf, InData%Cd) + end if + call RegPack(Buf, allocated(InData%Ca)) + if (allocated(InData%Ca)) then + call RegPackBounds(Buf, 1, lbound(InData%Ca), ubound(InData%Ca)) + call RegPack(Buf, InData%Ca) + end if + call RegPack(Buf, allocated(InData%Cp)) + if (allocated(InData%Cp)) then + call RegPackBounds(Buf, 1, lbound(InData%Cp), ubound(InData%Cp)) + call RegPack(Buf, InData%Cp) + end if + call RegPack(Buf, allocated(InData%AxCd)) + if (allocated(InData%AxCd)) then + call RegPackBounds(Buf, 1, lbound(InData%AxCd), ubound(InData%AxCd)) + call RegPack(Buf, InData%AxCd) + end if + call RegPack(Buf, allocated(InData%AxCa)) + if (allocated(InData%AxCa)) then + call RegPackBounds(Buf, 1, lbound(InData%AxCa), ubound(InData%AxCa)) + call RegPack(Buf, InData%AxCa) + end if + call RegPack(Buf, allocated(InData%AxCp)) + if (allocated(InData%AxCp)) then + call RegPackBounds(Buf, 1, lbound(InData%AxCp), ubound(InData%AxCp)) + call RegPack(Buf, InData%AxCp) + end if + call RegPack(Buf, allocated(InData%Cb)) + if (allocated(InData%Cb)) then + call RegPackBounds(Buf, 1, lbound(InData%Cb), ubound(InData%Cb)) + call RegPack(Buf, InData%Cb) + end if + call RegPack(Buf, allocated(InData%m_fb_l)) + if (allocated(InData%m_fb_l)) then + call RegPackBounds(Buf, 1, lbound(InData%m_fb_l), ubound(InData%m_fb_l)) + call RegPack(Buf, InData%m_fb_l) + end if + call RegPack(Buf, allocated(InData%m_fb_u)) + if (allocated(InData%m_fb_u)) then + call RegPackBounds(Buf, 1, lbound(InData%m_fb_u), ubound(InData%m_fb_u)) + call RegPack(Buf, InData%m_fb_u) + end if + call RegPack(Buf, allocated(InData%h_cfb_l)) + if (allocated(InData%h_cfb_l)) then + call RegPackBounds(Buf, 1, lbound(InData%h_cfb_l), ubound(InData%h_cfb_l)) + call RegPack(Buf, InData%h_cfb_l) + end if + call RegPack(Buf, allocated(InData%h_cfb_u)) + if (allocated(InData%h_cfb_u)) then + call RegPackBounds(Buf, 1, lbound(InData%h_cfb_u), ubound(InData%h_cfb_u)) + call RegPack(Buf, InData%h_cfb_u) + end if + call RegPack(Buf, allocated(InData%I_lfb_l)) + if (allocated(InData%I_lfb_l)) then + call RegPackBounds(Buf, 1, lbound(InData%I_lfb_l), ubound(InData%I_lfb_l)) + call RegPack(Buf, InData%I_lfb_l) + end if + call RegPack(Buf, allocated(InData%I_lfb_u)) + if (allocated(InData%I_lfb_u)) then + call RegPackBounds(Buf, 1, lbound(InData%I_lfb_u), ubound(InData%I_lfb_u)) + call RegPack(Buf, InData%I_lfb_u) + end if + call RegPack(Buf, allocated(InData%I_rfb_l)) + if (allocated(InData%I_rfb_l)) then + call RegPackBounds(Buf, 1, lbound(InData%I_rfb_l), ubound(InData%I_rfb_l)) + call RegPack(Buf, InData%I_rfb_l) + end if + call RegPack(Buf, allocated(InData%I_rfb_u)) + if (allocated(InData%I_rfb_u)) then + call RegPackBounds(Buf, 1, lbound(InData%I_rfb_u), ubound(InData%I_rfb_u)) + call RegPack(Buf, InData%I_rfb_u) + end if + call RegPack(Buf, allocated(InData%m_mg_l)) + if (allocated(InData%m_mg_l)) then + call RegPackBounds(Buf, 1, lbound(InData%m_mg_l), ubound(InData%m_mg_l)) + call RegPack(Buf, InData%m_mg_l) + end if + call RegPack(Buf, allocated(InData%m_mg_u)) + if (allocated(InData%m_mg_u)) then + call RegPackBounds(Buf, 1, lbound(InData%m_mg_u), ubound(InData%m_mg_u)) + call RegPack(Buf, InData%m_mg_u) + end if + call RegPack(Buf, allocated(InData%h_cmg_l)) + if (allocated(InData%h_cmg_l)) then + call RegPackBounds(Buf, 1, lbound(InData%h_cmg_l), ubound(InData%h_cmg_l)) + call RegPack(Buf, InData%h_cmg_l) + end if + call RegPack(Buf, allocated(InData%h_cmg_u)) + if (allocated(InData%h_cmg_u)) then + call RegPackBounds(Buf, 1, lbound(InData%h_cmg_u), ubound(InData%h_cmg_u)) + call RegPack(Buf, InData%h_cmg_u) + end if + call RegPack(Buf, allocated(InData%I_lmg_l)) + if (allocated(InData%I_lmg_l)) then + call RegPackBounds(Buf, 1, lbound(InData%I_lmg_l), ubound(InData%I_lmg_l)) + call RegPack(Buf, InData%I_lmg_l) + end if + call RegPack(Buf, allocated(InData%I_lmg_u)) + if (allocated(InData%I_lmg_u)) then + call RegPackBounds(Buf, 1, lbound(InData%I_lmg_u), ubound(InData%I_lmg_u)) + call RegPack(Buf, InData%I_lmg_u) + end if + call RegPack(Buf, allocated(InData%I_rmg_l)) + if (allocated(InData%I_rmg_l)) then + call RegPackBounds(Buf, 1, lbound(InData%I_rmg_l), ubound(InData%I_rmg_l)) + call RegPack(Buf, InData%I_rmg_l) + end if + call RegPack(Buf, allocated(InData%I_rmg_u)) + if (allocated(InData%I_rmg_u)) then + call RegPackBounds(Buf, 1, lbound(InData%I_rmg_u), ubound(InData%I_rmg_u)) + call RegPack(Buf, InData%I_rmg_u) + end if + call RegPack(Buf, allocated(InData%Cfl_fb)) + if (allocated(InData%Cfl_fb)) then + call RegPackBounds(Buf, 1, lbound(InData%Cfl_fb), ubound(InData%Cfl_fb)) + call RegPack(Buf, InData%Cfl_fb) + end if + call RegPack(Buf, allocated(InData%Cfr_fb)) + if (allocated(InData%Cfr_fb)) then + call RegPackBounds(Buf, 1, lbound(InData%Cfr_fb), ubound(InData%Cfr_fb)) + call RegPack(Buf, InData%Cfr_fb) + end if + call RegPack(Buf, allocated(InData%CM0_fb)) + if (allocated(InData%CM0_fb)) then + call RegPackBounds(Buf, 1, lbound(InData%CM0_fb), ubound(InData%CM0_fb)) + call RegPack(Buf, InData%CM0_fb) + end if + call RegPack(Buf, InData%MGvolume) + call RegPack(Buf, InData%MDivSize) + call RegPack(Buf, InData%MCoefMod) + call RegPack(Buf, InData%MmbrCoefIDIndx) + call RegPack(Buf, InData%MmbrFilledIDIndx) + call RegPack(Buf, InData%MHstLMod) + call RegPack(Buf, InData%FillFSLoc) + call RegPack(Buf, InData%FillDens) + call RegPack(Buf, InData%PropPot) + call RegPack(Buf, InData%PropMCF) + call RegPack(Buf, InData%Flipped) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMemberType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMemberType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%NodeIndx)) deallocate(OutData%NodeIndx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodeIndx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodeIndx) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%MemberID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NElements) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%cosPhi_ref) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%kkt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ak) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%R)) deallocate(OutData%R) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%R(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%R.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%R) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RMG)) deallocate(OutData%RMG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RMG(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RMG) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RMGB)) deallocate(OutData%RMGB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RMGB(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMGB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RMGB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Rin)) deallocate(OutData%Rin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Rin(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Rin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Rin) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%tMG)) deallocate(OutData%tMG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%tMG(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tMG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%tMG) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MGdensity)) deallocate(OutData%MGdensity) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MGdensity(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MGdensity.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MGdensity) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dRdl_mg)) deallocate(OutData%dRdl_mg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dRdl_mg(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_mg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dRdl_mg) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dRdl_mg_b)) deallocate(OutData%dRdl_mg_b) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dRdl_mg_b(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_mg_b.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dRdl_mg_b) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dRdl_in)) deallocate(OutData%dRdl_in) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dRdl_in(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_in.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dRdl_in) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Vinner) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Vouter) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Vballast) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Vsubmerged) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%l_fill) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%h_fill) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%z_overfill) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%h_floor) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%i_floor) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%doEndBuoyancy) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%memfloodstatus) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%floodstatus)) deallocate(OutData%floodstatus) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%floodstatus(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%floodstatus.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%floodstatus) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%alpha)) deallocate(OutData%alpha) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%alpha_fb)) deallocate(OutData%alpha_fb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_fb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_fb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_fb) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%alpha_fb_star)) deallocate(OutData%alpha_fb_star) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_fb_star(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_fb_star.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_fb_star) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cd)) deallocate(OutData%Cd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Ca)) deallocate(OutData%Ca) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ca(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ca.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ca) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cp)) deallocate(OutData%Cp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AxCd)) deallocate(OutData%AxCd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxCd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxCd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AxCa)) deallocate(OutData%AxCa) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxCa(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCa.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxCa) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AxCp)) deallocate(OutData%AxCp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxCp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxCp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cb)) deallocate(OutData%Cb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cb) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%m_fb_l)) deallocate(OutData%m_fb_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m_fb_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_fb_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%m_fb_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%m_fb_u)) deallocate(OutData%m_fb_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m_fb_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_fb_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%m_fb_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%h_cfb_l)) deallocate(OutData%h_cfb_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%h_cfb_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cfb_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%h_cfb_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%h_cfb_u)) deallocate(OutData%h_cfb_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%h_cfb_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cfb_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%h_cfb_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%I_lfb_l)) deallocate(OutData%I_lfb_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_lfb_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lfb_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_lfb_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%I_lfb_u)) deallocate(OutData%I_lfb_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_lfb_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lfb_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_lfb_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%I_rfb_l)) deallocate(OutData%I_rfb_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_rfb_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rfb_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_rfb_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%I_rfb_u)) deallocate(OutData%I_rfb_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_rfb_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rfb_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_rfb_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%m_mg_l)) deallocate(OutData%m_mg_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m_mg_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_mg_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%m_mg_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%m_mg_u)) deallocate(OutData%m_mg_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m_mg_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_mg_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%m_mg_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%h_cmg_l)) deallocate(OutData%h_cmg_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%h_cmg_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cmg_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%h_cmg_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%h_cmg_u)) deallocate(OutData%h_cmg_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%h_cmg_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cmg_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%h_cmg_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%I_lmg_l)) deallocate(OutData%I_lmg_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_lmg_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lmg_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_lmg_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%I_lmg_u)) deallocate(OutData%I_lmg_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_lmg_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lmg_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_lmg_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%I_rmg_l)) deallocate(OutData%I_rmg_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_rmg_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rmg_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_rmg_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%I_rmg_u)) deallocate(OutData%I_rmg_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_rmg_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rmg_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_rmg_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cfl_fb)) deallocate(OutData%Cfl_fb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cfl_fb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cfl_fb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cfl_fb) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cfr_fb)) deallocate(OutData%Cfr_fb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cfr_fb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cfr_fb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cfr_fb) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CM0_fb)) deallocate(OutData%CM0_fb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CM0_fb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CM0_fb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CM0_fb) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%MGvolume) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MDivSize) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MCoefMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MmbrCoefIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MmbrFilledIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MHstLMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FillFSLoc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FillDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PropPot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PropMCF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Flipped) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MemberLoads), intent(in) :: SrcMemberLoadsData + type(Morison_MemberLoads), intent(inout) :: DstMemberLoadsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyMemberLoads' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMemberLoadsData%F_D)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_D) + UB(1:2) = ubound(SrcMemberLoadsData%F_D) + if (.not. allocated(DstMemberLoadsData%F_D)) then + allocate(DstMemberLoadsData%F_D(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_D.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_D = SrcMemberLoadsData%F_D + end if + if (allocated(SrcMemberLoadsData%F_I)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_I) + UB(1:2) = ubound(SrcMemberLoadsData%F_I) + if (.not. allocated(DstMemberLoadsData%F_I)) then + allocate(DstMemberLoadsData%F_I(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_I.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_I = SrcMemberLoadsData%F_I + end if + if (allocated(SrcMemberLoadsData%F_A)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_A) + UB(1:2) = ubound(SrcMemberLoadsData%F_A) + if (.not. allocated(DstMemberLoadsData%F_A)) then + allocate(DstMemberLoadsData%F_A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_A = SrcMemberLoadsData%F_A + end if + if (allocated(SrcMemberLoadsData%F_B)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_B) + UB(1:2) = ubound(SrcMemberLoadsData%F_B) + if (.not. allocated(DstMemberLoadsData%F_B)) then + allocate(DstMemberLoadsData%F_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_B = SrcMemberLoadsData%F_B + end if + if (allocated(SrcMemberLoadsData%F_BF)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_BF) + UB(1:2) = ubound(SrcMemberLoadsData%F_BF) + if (.not. allocated(DstMemberLoadsData%F_BF)) then + allocate(DstMemberLoadsData%F_BF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_BF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_BF = SrcMemberLoadsData%F_BF + end if + if (allocated(SrcMemberLoadsData%F_If)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_If) + UB(1:2) = ubound(SrcMemberLoadsData%F_If) + if (.not. allocated(DstMemberLoadsData%F_If)) then + allocate(DstMemberLoadsData%F_If(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_If.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_If = SrcMemberLoadsData%F_If + end if + if (allocated(SrcMemberLoadsData%F_WMG)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_WMG) + UB(1:2) = ubound(SrcMemberLoadsData%F_WMG) + if (.not. allocated(DstMemberLoadsData%F_WMG)) then + allocate(DstMemberLoadsData%F_WMG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_WMG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_WMG = SrcMemberLoadsData%F_WMG + end if + if (allocated(SrcMemberLoadsData%F_IMG)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_IMG) + UB(1:2) = ubound(SrcMemberLoadsData%F_IMG) + if (.not. allocated(DstMemberLoadsData%F_IMG)) then + allocate(DstMemberLoadsData%F_IMG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_IMG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_IMG = SrcMemberLoadsData%F_IMG + end if + if (allocated(SrcMemberLoadsData%FV)) then + LB(1:2) = lbound(SrcMemberLoadsData%FV) + UB(1:2) = ubound(SrcMemberLoadsData%FV) + if (.not. allocated(DstMemberLoadsData%FV)) then + allocate(DstMemberLoadsData%FV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%FV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%FV = SrcMemberLoadsData%FV + end if + if (allocated(SrcMemberLoadsData%FA)) then + LB(1:2) = lbound(SrcMemberLoadsData%FA) + UB(1:2) = ubound(SrcMemberLoadsData%FA) + if (.not. allocated(DstMemberLoadsData%FA)) then + allocate(DstMemberLoadsData%FA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%FA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%FA = SrcMemberLoadsData%FA + end if + if (allocated(SrcMemberLoadsData%F_DP)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_DP) + UB(1:2) = ubound(SrcMemberLoadsData%F_DP) + if (.not. allocated(DstMemberLoadsData%F_DP)) then + allocate(DstMemberLoadsData%F_DP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_DP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_DP = SrcMemberLoadsData%F_DP + end if +end subroutine + +subroutine Morison_DestroyMemberLoads(MemberLoadsData, ErrStat, ErrMsg) + type(Morison_MemberLoads), intent(inout) :: MemberLoadsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMemberLoads' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MemberLoadsData%F_D)) then + deallocate(MemberLoadsData%F_D) + end if + if (allocated(MemberLoadsData%F_I)) then + deallocate(MemberLoadsData%F_I) + end if + if (allocated(MemberLoadsData%F_A)) then + deallocate(MemberLoadsData%F_A) + end if + if (allocated(MemberLoadsData%F_B)) then + deallocate(MemberLoadsData%F_B) + end if + if (allocated(MemberLoadsData%F_BF)) then + deallocate(MemberLoadsData%F_BF) + end if + if (allocated(MemberLoadsData%F_If)) then + deallocate(MemberLoadsData%F_If) + end if + if (allocated(MemberLoadsData%F_WMG)) then + deallocate(MemberLoadsData%F_WMG) + end if + if (allocated(MemberLoadsData%F_IMG)) then + deallocate(MemberLoadsData%F_IMG) + end if + if (allocated(MemberLoadsData%FV)) then + deallocate(MemberLoadsData%FV) + end if + if (allocated(MemberLoadsData%FA)) then + deallocate(MemberLoadsData%FA) + end if + if (allocated(MemberLoadsData%F_DP)) then + deallocate(MemberLoadsData%F_DP) + end if +end subroutine + +subroutine Morison_PackMemberLoads(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberLoads), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMemberLoads' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%F_D)) + if (allocated(InData%F_D)) then + call RegPackBounds(Buf, 2, lbound(InData%F_D), ubound(InData%F_D)) + call RegPack(Buf, InData%F_D) + end if + call RegPack(Buf, allocated(InData%F_I)) + if (allocated(InData%F_I)) then + call RegPackBounds(Buf, 2, lbound(InData%F_I), ubound(InData%F_I)) + call RegPack(Buf, InData%F_I) + end if + call RegPack(Buf, allocated(InData%F_A)) + if (allocated(InData%F_A)) then + call RegPackBounds(Buf, 2, lbound(InData%F_A), ubound(InData%F_A)) + call RegPack(Buf, InData%F_A) + end if + call RegPack(Buf, allocated(InData%F_B)) + if (allocated(InData%F_B)) then + call RegPackBounds(Buf, 2, lbound(InData%F_B), ubound(InData%F_B)) + call RegPack(Buf, InData%F_B) + end if + call RegPack(Buf, allocated(InData%F_BF)) + if (allocated(InData%F_BF)) then + call RegPackBounds(Buf, 2, lbound(InData%F_BF), ubound(InData%F_BF)) + call RegPack(Buf, InData%F_BF) + end if + call RegPack(Buf, allocated(InData%F_If)) + if (allocated(InData%F_If)) then + call RegPackBounds(Buf, 2, lbound(InData%F_If), ubound(InData%F_If)) + call RegPack(Buf, InData%F_If) + end if + call RegPack(Buf, allocated(InData%F_WMG)) + if (allocated(InData%F_WMG)) then + call RegPackBounds(Buf, 2, lbound(InData%F_WMG), ubound(InData%F_WMG)) + call RegPack(Buf, InData%F_WMG) + end if + call RegPack(Buf, allocated(InData%F_IMG)) + if (allocated(InData%F_IMG)) then + call RegPackBounds(Buf, 2, lbound(InData%F_IMG), ubound(InData%F_IMG)) + call RegPack(Buf, InData%F_IMG) + end if + call RegPack(Buf, allocated(InData%FV)) + if (allocated(InData%FV)) then + call RegPackBounds(Buf, 2, lbound(InData%FV), ubound(InData%FV)) + call RegPack(Buf, InData%FV) + end if + call RegPack(Buf, allocated(InData%FA)) + if (allocated(InData%FA)) then + call RegPackBounds(Buf, 2, lbound(InData%FA), ubound(InData%FA)) + call RegPack(Buf, InData%FA) + end if + call RegPack(Buf, allocated(InData%F_DP)) + if (allocated(InData%F_DP)) then + call RegPackBounds(Buf, 2, lbound(InData%F_DP), ubound(InData%F_DP)) + call RegPack(Buf, InData%F_DP) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMemberLoads(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberLoads), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMemberLoads' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%F_D)) deallocate(OutData%F_D) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_D(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_D) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_I)) deallocate(OutData%F_I) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_I(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_I.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_I) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_A)) deallocate(OutData%F_A) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_A(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_A) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_B)) deallocate(OutData%F_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_B) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_BF)) deallocate(OutData%F_BF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_BF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_BF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_BF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_If)) deallocate(OutData%F_If) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_If(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_If.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_If) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_WMG)) deallocate(OutData%F_WMG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_WMG(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_WMG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_WMG) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_IMG)) deallocate(OutData%F_IMG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_IMG(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_IMG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_IMG) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FV)) deallocate(OutData%FV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FV(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FV) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FA)) deallocate(OutData%FA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FA(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FA) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_DP)) deallocate(OutData%F_DP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_DP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_DP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_DP) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine Morison_CopyCoefMembers(SrcCoefMembersData, DstCoefMembersData, CtrlCode, ErrStat, ErrMsg) + type(Morison_CoefMembers), intent(in) :: SrcCoefMembersData + type(Morison_CoefMembers), intent(inout) :: DstCoefMembersData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyCoefMembers' + ErrStat = ErrID_None + ErrMsg = '' + DstCoefMembersData%MemberID = SrcCoefMembersData%MemberID + DstCoefMembersData%MemberCd1 = SrcCoefMembersData%MemberCd1 + DstCoefMembersData%MemberCd2 = SrcCoefMembersData%MemberCd2 + DstCoefMembersData%MemberCdMG1 = SrcCoefMembersData%MemberCdMG1 + DstCoefMembersData%MemberCdMG2 = SrcCoefMembersData%MemberCdMG2 + DstCoefMembersData%MemberCa1 = SrcCoefMembersData%MemberCa1 + DstCoefMembersData%MemberCa2 = SrcCoefMembersData%MemberCa2 + DstCoefMembersData%MemberCaMG1 = SrcCoefMembersData%MemberCaMG1 + DstCoefMembersData%MemberCaMG2 = SrcCoefMembersData%MemberCaMG2 + DstCoefMembersData%MemberCp1 = SrcCoefMembersData%MemberCp1 + DstCoefMembersData%MemberCp2 = SrcCoefMembersData%MemberCp2 + DstCoefMembersData%MemberCpMG1 = SrcCoefMembersData%MemberCpMG1 + DstCoefMembersData%MemberCpMG2 = SrcCoefMembersData%MemberCpMG2 + DstCoefMembersData%MemberAxCd1 = SrcCoefMembersData%MemberAxCd1 + DstCoefMembersData%MemberAxCd2 = SrcCoefMembersData%MemberAxCd2 + DstCoefMembersData%MemberAxCdMG1 = SrcCoefMembersData%MemberAxCdMG1 + DstCoefMembersData%MemberAxCdMG2 = SrcCoefMembersData%MemberAxCdMG2 + DstCoefMembersData%MemberAxCa1 = SrcCoefMembersData%MemberAxCa1 + DstCoefMembersData%MemberAxCa2 = SrcCoefMembersData%MemberAxCa2 + DstCoefMembersData%MemberAxCaMG1 = SrcCoefMembersData%MemberAxCaMG1 + DstCoefMembersData%MemberAxCaMG2 = SrcCoefMembersData%MemberAxCaMG2 + DstCoefMembersData%MemberAxCp1 = SrcCoefMembersData%MemberAxCp1 + DstCoefMembersData%MemberAxCp2 = SrcCoefMembersData%MemberAxCp2 + DstCoefMembersData%MemberAxCpMG1 = SrcCoefMembersData%MemberAxCpMG1 + DstCoefMembersData%MemberAxCpMG2 = SrcCoefMembersData%MemberAxCpMG2 + DstCoefMembersData%MemberCb1 = SrcCoefMembersData%MemberCb1 + DstCoefMembersData%MemberCb2 = SrcCoefMembersData%MemberCb2 + DstCoefMembersData%MemberCbMG1 = SrcCoefMembersData%MemberCbMG1 + DstCoefMembersData%MemberCbMG2 = SrcCoefMembersData%MemberCbMG2 + DstCoefMembersData%MemberMCF = SrcCoefMembersData%MemberMCF +end subroutine + +subroutine Morison_DestroyCoefMembers(CoefMembersData, ErrStat, ErrMsg) + type(Morison_CoefMembers), intent(inout) :: CoefMembersData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyCoefMembers' 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 - END SUBROUTINE Morison_CopyInitOutput - - SUBROUTINE Morison_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(Morison_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 = 'Morison_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE Morison_DestroyInitOutput - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 - 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 - END SUBROUTINE Morison_PackInitOutput - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 - END SUBROUTINE Morison_UnPackInitOutput - - SUBROUTINE Morison_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Morison_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 = 'Morison_CopyContState' -! + ErrMsg = '' +end subroutine + +subroutine Morison_PackCoefMembers(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_CoefMembers), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackCoefMembers' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%MemberID) + call RegPack(Buf, InData%MemberCd1) + call RegPack(Buf, InData%MemberCd2) + call RegPack(Buf, InData%MemberCdMG1) + call RegPack(Buf, InData%MemberCdMG2) + call RegPack(Buf, InData%MemberCa1) + call RegPack(Buf, InData%MemberCa2) + call RegPack(Buf, InData%MemberCaMG1) + call RegPack(Buf, InData%MemberCaMG2) + call RegPack(Buf, InData%MemberCp1) + call RegPack(Buf, InData%MemberCp2) + call RegPack(Buf, InData%MemberCpMG1) + call RegPack(Buf, InData%MemberCpMG2) + call RegPack(Buf, InData%MemberAxCd1) + call RegPack(Buf, InData%MemberAxCd2) + call RegPack(Buf, InData%MemberAxCdMG1) + call RegPack(Buf, InData%MemberAxCdMG2) + call RegPack(Buf, InData%MemberAxCa1) + call RegPack(Buf, InData%MemberAxCa2) + call RegPack(Buf, InData%MemberAxCaMG1) + call RegPack(Buf, InData%MemberAxCaMG2) + call RegPack(Buf, InData%MemberAxCp1) + call RegPack(Buf, InData%MemberAxCp2) + call RegPack(Buf, InData%MemberAxCpMG1) + call RegPack(Buf, InData%MemberAxCpMG2) + call RegPack(Buf, InData%MemberCb1) + call RegPack(Buf, InData%MemberCb2) + call RegPack(Buf, InData%MemberCbMG1) + call RegPack(Buf, InData%MemberCbMG2) + call RegPack(Buf, InData%MemberMCF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackCoefMembers(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_CoefMembers), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackCoefMembers' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%MemberID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCd1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCd2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCdMG1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCdMG2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCa1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCa2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCaMG1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCaMG2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCp1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCp2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCpMG1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCpMG2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberAxCd1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberAxCd2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberAxCdMG1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberAxCdMG2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberAxCa1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberAxCa2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberAxCaMG1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberAxCaMG2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberAxCp1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberAxCp2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberAxCpMG1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberAxCpMG2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCb1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCb2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCbMG1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberCbMG2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MemberMCF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_CopyMGDepthsType(SrcMGDepthsTypeData, DstMGDepthsTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MGDepthsType), intent(in) :: SrcMGDepthsTypeData + type(Morison_MGDepthsType), intent(inout) :: DstMGDepthsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyMGDepthsType' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE Morison_CopyContState - - SUBROUTINE Morison_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(Morison_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 = 'Morison_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyContState - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 Morison_PackContState - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 Morison_UnPackContState - - SUBROUTINE Morison_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Morison_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyDiscState' -! + ErrMsg = '' + DstMGDepthsTypeData%MGDpth = SrcMGDepthsTypeData%MGDpth + DstMGDepthsTypeData%MGThck = SrcMGDepthsTypeData%MGThck + DstMGDepthsTypeData%MGDens = SrcMGDepthsTypeData%MGDens +end subroutine + +subroutine Morison_DestroyMGDepthsType(MGDepthsTypeData, ErrStat, ErrMsg) + type(Morison_MGDepthsType), intent(inout) :: MGDepthsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMGDepthsType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%V_rel_n_FiltStat)) THEN - i1_l = LBOUND(SrcDiscStateData%V_rel_n_FiltStat,1) - i1_u = UBOUND(SrcDiscStateData%V_rel_n_FiltStat,1) - IF (.NOT. ALLOCATED(DstDiscStateData%V_rel_n_FiltStat)) THEN - ALLOCATE(DstDiscStateData%V_rel_n_FiltStat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%V_rel_n_FiltStat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%V_rel_n_FiltStat = SrcDiscStateData%V_rel_n_FiltStat -ENDIF - END SUBROUTINE Morison_CopyDiscState - - SUBROUTINE Morison_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(Morison_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 = 'Morison_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%V_rel_n_FiltStat)) THEN - DEALLOCATE(DiscStateData%V_rel_n_FiltStat) -ENDIF - END SUBROUTINE Morison_DestroyDiscState - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 - Int_BufSz = Int_BufSz + 1 ! V_rel_n_FiltStat allocated yes/no - IF ( ALLOCATED(InData%V_rel_n_FiltStat) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V_rel_n_FiltStat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_rel_n_FiltStat) ! V_rel_n_FiltStat - 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%V_rel_n_FiltStat) ) 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%V_rel_n_FiltStat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_rel_n_FiltStat,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V_rel_n_FiltStat,1), UBOUND(InData%V_rel_n_FiltStat,1) - ReKiBuf(Re_Xferred) = InData%V_rel_n_FiltStat(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Morison_PackDiscState - - SUBROUTINE Morison_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(Morison_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_rel_n_FiltStat 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%V_rel_n_FiltStat)) DEALLOCATE(OutData%V_rel_n_FiltStat) - ALLOCATE(OutData%V_rel_n_FiltStat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n_FiltStat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%V_rel_n_FiltStat,1), UBOUND(OutData%V_rel_n_FiltStat,1) - OutData%V_rel_n_FiltStat(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Morison_UnPackDiscState - - SUBROUTINE Morison_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Morison_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 = 'Morison_CopyConstrState' -! + ErrMsg = '' +end subroutine + +subroutine Morison_PackMGDepthsType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MGDepthsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMGDepthsType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%MGDpth) + call RegPack(Buf, InData%MGThck) + call RegPack(Buf, InData%MGDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMGDepthsType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MGDepthsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMGDepthsType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%MGDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MGThck) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MGDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MOutput), intent(in) :: SrcMOutputData + type(Morison_MOutput), intent(inout) :: DstMOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyMOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Morison_CopyConstrState - - SUBROUTINE Morison_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(Morison_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 = 'Morison_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyConstrState - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 Morison_PackConstrState - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 Morison_UnPackConstrState - - SUBROUTINE Morison_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Morison_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 = 'Morison_CopyOtherState' -! + ErrMsg = '' + DstMOutputData%MemberID = SrcMOutputData%MemberID + DstMOutputData%NOutLoc = SrcMOutputData%NOutLoc + if (allocated(SrcMOutputData%NodeLocs)) then + LB(1:1) = lbound(SrcMOutputData%NodeLocs) + UB(1:1) = ubound(SrcMOutputData%NodeLocs) + if (.not. allocated(DstMOutputData%NodeLocs)) then + allocate(DstMOutputData%NodeLocs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%NodeLocs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%NodeLocs = SrcMOutputData%NodeLocs + end if + DstMOutputData%MemberIDIndx = SrcMOutputData%MemberIDIndx + if (allocated(SrcMOutputData%MeshIndx1)) then + LB(1:1) = lbound(SrcMOutputData%MeshIndx1) + UB(1:1) = ubound(SrcMOutputData%MeshIndx1) + if (.not. allocated(DstMOutputData%MeshIndx1)) then + allocate(DstMOutputData%MeshIndx1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MeshIndx1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%MeshIndx1 = SrcMOutputData%MeshIndx1 + end if + if (allocated(SrcMOutputData%MeshIndx2)) then + LB(1:1) = lbound(SrcMOutputData%MeshIndx2) + UB(1:1) = ubound(SrcMOutputData%MeshIndx2) + if (.not. allocated(DstMOutputData%MeshIndx2)) then + allocate(DstMOutputData%MeshIndx2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MeshIndx2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%MeshIndx2 = SrcMOutputData%MeshIndx2 + end if + if (allocated(SrcMOutputData%MemberIndx1)) then + LB(1:1) = lbound(SrcMOutputData%MemberIndx1) + UB(1:1) = ubound(SrcMOutputData%MemberIndx1) + if (.not. allocated(DstMOutputData%MemberIndx1)) then + allocate(DstMOutputData%MemberIndx1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MemberIndx1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%MemberIndx1 = SrcMOutputData%MemberIndx1 + end if + if (allocated(SrcMOutputData%MemberIndx2)) then + LB(1:1) = lbound(SrcMOutputData%MemberIndx2) + UB(1:1) = ubound(SrcMOutputData%MemberIndx2) + if (.not. allocated(DstMOutputData%MemberIndx2)) then + allocate(DstMOutputData%MemberIndx2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MemberIndx2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%MemberIndx2 = SrcMOutputData%MemberIndx2 + end if + if (allocated(SrcMOutputData%s)) then + LB(1:1) = lbound(SrcMOutputData%s) + UB(1:1) = ubound(SrcMOutputData%s) + if (.not. allocated(DstMOutputData%s)) then + allocate(DstMOutputData%s(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%s.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%s = SrcMOutputData%s + end if +end subroutine + +subroutine Morison_DestroyMOutput(MOutputData, ErrStat, ErrMsg) + type(Morison_MOutput), intent(inout) :: MOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMOutput' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Morison_CopyOtherState - - SUBROUTINE Morison_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(Morison_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 = 'Morison_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyOtherState - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 Morison_PackOtherState - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 Morison_UnPackOtherState - - SUBROUTINE Morison_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Morison_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) :: 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 = 'Morison_CopyMisc' -! + ErrMsg = '' + if (allocated(MOutputData%NodeLocs)) then + deallocate(MOutputData%NodeLocs) + end if + if (allocated(MOutputData%MeshIndx1)) then + deallocate(MOutputData%MeshIndx1) + end if + if (allocated(MOutputData%MeshIndx2)) then + deallocate(MOutputData%MeshIndx2) + end if + if (allocated(MOutputData%MemberIndx1)) then + deallocate(MOutputData%MemberIndx1) + end if + if (allocated(MOutputData%MemberIndx2)) then + deallocate(MOutputData%MemberIndx2) + end if + if (allocated(MOutputData%s)) then + deallocate(MOutputData%s) + end if +end subroutine + +subroutine Morison_PackMOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MOutput), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%MemberID) + call RegPack(Buf, InData%NOutLoc) + call RegPack(Buf, allocated(InData%NodeLocs)) + if (allocated(InData%NodeLocs)) then + call RegPackBounds(Buf, 1, lbound(InData%NodeLocs), ubound(InData%NodeLocs)) + call RegPack(Buf, InData%NodeLocs) + end if + call RegPack(Buf, InData%MemberIDIndx) + call RegPack(Buf, allocated(InData%MeshIndx1)) + if (allocated(InData%MeshIndx1)) then + call RegPackBounds(Buf, 1, lbound(InData%MeshIndx1), ubound(InData%MeshIndx1)) + call RegPack(Buf, InData%MeshIndx1) + end if + call RegPack(Buf, allocated(InData%MeshIndx2)) + if (allocated(InData%MeshIndx2)) then + call RegPackBounds(Buf, 1, lbound(InData%MeshIndx2), ubound(InData%MeshIndx2)) + call RegPack(Buf, InData%MeshIndx2) + end if + call RegPack(Buf, allocated(InData%MemberIndx1)) + if (allocated(InData%MemberIndx1)) then + call RegPackBounds(Buf, 1, lbound(InData%MemberIndx1), ubound(InData%MemberIndx1)) + call RegPack(Buf, InData%MemberIndx1) + end if + call RegPack(Buf, allocated(InData%MemberIndx2)) + if (allocated(InData%MemberIndx2)) then + call RegPackBounds(Buf, 1, lbound(InData%MemberIndx2), ubound(InData%MemberIndx2)) + call RegPack(Buf, InData%MemberIndx2) + end if + call RegPack(Buf, allocated(InData%s)) + if (allocated(InData%s)) then + call RegPackBounds(Buf, 1, lbound(InData%s), ubound(InData%s)) + call RegPack(Buf, InData%s) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MOutput), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%MemberID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NOutLoc) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%NodeLocs)) deallocate(OutData%NodeLocs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodeLocs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeLocs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodeLocs) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%MemberIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%MeshIndx1)) deallocate(OutData%MeshIndx1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MeshIndx1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeshIndx1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MeshIndx1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MeshIndx2)) deallocate(OutData%MeshIndx2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MeshIndx2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeshIndx2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MeshIndx2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MemberIndx1)) deallocate(OutData%MemberIndx1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MemberIndx1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberIndx1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MemberIndx1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MemberIndx2)) deallocate(OutData%MemberIndx2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MemberIndx2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberIndx2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MemberIndx2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%s)) deallocate(OutData%s) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%s(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%s.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%s) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine Morison_CopyJOutput(SrcJOutputData, DstJOutputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_JOutput), intent(in) :: SrcJOutputData + type(Morison_JOutput), intent(inout) :: DstJOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyJOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%DispNodePosHdn)) THEN - i1_l = LBOUND(SrcMiscData%DispNodePosHdn,1) - i1_u = UBOUND(SrcMiscData%DispNodePosHdn,1) - i2_l = LBOUND(SrcMiscData%DispNodePosHdn,2) - i2_u = UBOUND(SrcMiscData%DispNodePosHdn,2) - IF (.NOT. ALLOCATED(DstMiscData%DispNodePosHdn)) THEN - ALLOCATE(DstMiscData%DispNodePosHdn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DispNodePosHdn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DispNodePosHdn = SrcMiscData%DispNodePosHdn -ENDIF -IF (ALLOCATED(SrcMiscData%DispNodePosHst)) THEN - i1_l = LBOUND(SrcMiscData%DispNodePosHst,1) - i1_u = UBOUND(SrcMiscData%DispNodePosHst,1) - i2_l = LBOUND(SrcMiscData%DispNodePosHst,2) - i2_u = UBOUND(SrcMiscData%DispNodePosHst,2) - IF (.NOT. ALLOCATED(DstMiscData%DispNodePosHst)) THEN - ALLOCATE(DstMiscData%DispNodePosHst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DispNodePosHst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DispNodePosHst = SrcMiscData%DispNodePosHst -ENDIF -IF (ALLOCATED(SrcMiscData%FV)) THEN - i1_l = LBOUND(SrcMiscData%FV,1) - i1_u = UBOUND(SrcMiscData%FV,1) - i2_l = LBOUND(SrcMiscData%FV,2) - i2_u = UBOUND(SrcMiscData%FV,2) - IF (.NOT. ALLOCATED(DstMiscData%FV)) THEN - ALLOCATE(DstMiscData%FV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FV = SrcMiscData%FV -ENDIF -IF (ALLOCATED(SrcMiscData%FA)) THEN - i1_l = LBOUND(SrcMiscData%FA,1) - i1_u = UBOUND(SrcMiscData%FA,1) - i2_l = LBOUND(SrcMiscData%FA,2) - i2_u = UBOUND(SrcMiscData%FA,2) - IF (.NOT. ALLOCATED(DstMiscData%FA)) THEN - ALLOCATE(DstMiscData%FA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FA = SrcMiscData%FA -ENDIF -IF (ALLOCATED(SrcMiscData%FAMCF)) THEN - i1_l = LBOUND(SrcMiscData%FAMCF,1) - i1_u = UBOUND(SrcMiscData%FAMCF,1) - i2_l = LBOUND(SrcMiscData%FAMCF,2) - i2_u = UBOUND(SrcMiscData%FAMCF,2) - IF (.NOT. ALLOCATED(DstMiscData%FAMCF)) THEN - ALLOCATE(DstMiscData%FAMCF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FAMCF = SrcMiscData%FAMCF -ENDIF -IF (ALLOCATED(SrcMiscData%FDynP)) THEN - i1_l = LBOUND(SrcMiscData%FDynP,1) - i1_u = UBOUND(SrcMiscData%FDynP,1) - IF (.NOT. ALLOCATED(DstMiscData%FDynP)) THEN - ALLOCATE(DstMiscData%FDynP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FDynP = SrcMiscData%FDynP -ENDIF -IF (ALLOCATED(SrcMiscData%WaveElev)) THEN - i1_l = LBOUND(SrcMiscData%WaveElev,1) - i1_u = UBOUND(SrcMiscData%WaveElev,1) - IF (.NOT. ALLOCATED(DstMiscData%WaveElev)) THEN - ALLOCATE(DstMiscData%WaveElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WaveElev = SrcMiscData%WaveElev -ENDIF -IF (ALLOCATED(SrcMiscData%WaveElev1)) THEN - i1_l = LBOUND(SrcMiscData%WaveElev1,1) - i1_u = UBOUND(SrcMiscData%WaveElev1,1) - IF (.NOT. ALLOCATED(DstMiscData%WaveElev1)) THEN - ALLOCATE(DstMiscData%WaveElev1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WaveElev1 = SrcMiscData%WaveElev1 -ENDIF -IF (ALLOCATED(SrcMiscData%WaveElev2)) THEN - i1_l = LBOUND(SrcMiscData%WaveElev2,1) - i1_u = UBOUND(SrcMiscData%WaveElev2,1) - IF (.NOT. ALLOCATED(DstMiscData%WaveElev2)) THEN - ALLOCATE(DstMiscData%WaveElev2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WaveElev2 = SrcMiscData%WaveElev2 -ENDIF -IF (ALLOCATED(SrcMiscData%vrel)) THEN - i1_l = LBOUND(SrcMiscData%vrel,1) - i1_u = UBOUND(SrcMiscData%vrel,1) - i2_l = LBOUND(SrcMiscData%vrel,2) - i2_u = UBOUND(SrcMiscData%vrel,2) - IF (.NOT. ALLOCATED(DstMiscData%vrel)) THEN - ALLOCATE(DstMiscData%vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vrel = SrcMiscData%vrel -ENDIF -IF (ALLOCATED(SrcMiscData%nodeInWater)) THEN - i1_l = LBOUND(SrcMiscData%nodeInWater,1) - i1_u = UBOUND(SrcMiscData%nodeInWater,1) - IF (.NOT. ALLOCATED(DstMiscData%nodeInWater)) THEN - ALLOCATE(DstMiscData%nodeInWater(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%nodeInWater = SrcMiscData%nodeInWater -ENDIF -IF (ALLOCATED(SrcMiscData%memberLoads)) THEN - i1_l = LBOUND(SrcMiscData%memberLoads,1) - i1_u = UBOUND(SrcMiscData%memberLoads,1) - IF (.NOT. ALLOCATED(DstMiscData%memberLoads)) THEN - ALLOCATE(DstMiscData%memberLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%memberLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%memberLoads,1), UBOUND(SrcMiscData%memberLoads,1) - CALL Morison_Copymemberloads( SrcMiscData%memberLoads(i1), DstMiscData%memberLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%F_B_End)) THEN - i1_l = LBOUND(SrcMiscData%F_B_End,1) - i1_u = UBOUND(SrcMiscData%F_B_End,1) - i2_l = LBOUND(SrcMiscData%F_B_End,2) - i2_u = UBOUND(SrcMiscData%F_B_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_B_End)) THEN - ALLOCATE(DstMiscData%F_B_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_B_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_B_End = SrcMiscData%F_B_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_D_End)) THEN - i1_l = LBOUND(SrcMiscData%F_D_End,1) - i1_u = UBOUND(SrcMiscData%F_D_End,1) - i2_l = LBOUND(SrcMiscData%F_D_End,2) - i2_u = UBOUND(SrcMiscData%F_D_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_D_End)) THEN - ALLOCATE(DstMiscData%F_D_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_D_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_D_End = SrcMiscData%F_D_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_I_End)) THEN - i1_l = LBOUND(SrcMiscData%F_I_End,1) - i1_u = UBOUND(SrcMiscData%F_I_End,1) - i2_l = LBOUND(SrcMiscData%F_I_End,2) - i2_u = UBOUND(SrcMiscData%F_I_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_I_End)) THEN - ALLOCATE(DstMiscData%F_I_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_I_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_I_End = SrcMiscData%F_I_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_IMG_End)) THEN - i1_l = LBOUND(SrcMiscData%F_IMG_End,1) - i1_u = UBOUND(SrcMiscData%F_IMG_End,1) - i2_l = LBOUND(SrcMiscData%F_IMG_End,2) - i2_u = UBOUND(SrcMiscData%F_IMG_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_IMG_End)) THEN - ALLOCATE(DstMiscData%F_IMG_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_IMG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_IMG_End = SrcMiscData%F_IMG_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_A_End)) THEN - i1_l = LBOUND(SrcMiscData%F_A_End,1) - i1_u = UBOUND(SrcMiscData%F_A_End,1) - i2_l = LBOUND(SrcMiscData%F_A_End,2) - i2_u = UBOUND(SrcMiscData%F_A_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_A_End)) THEN - ALLOCATE(DstMiscData%F_A_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_A_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_A_End = SrcMiscData%F_A_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_BF_End)) THEN - i1_l = LBOUND(SrcMiscData%F_BF_End,1) - i1_u = UBOUND(SrcMiscData%F_BF_End,1) - i2_l = LBOUND(SrcMiscData%F_BF_End,2) - i2_u = UBOUND(SrcMiscData%F_BF_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_BF_End)) THEN - ALLOCATE(DstMiscData%F_BF_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_BF_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_BF_End = SrcMiscData%F_BF_End -ENDIF -IF (ALLOCATED(SrcMiscData%V_rel_n)) THEN - i1_l = LBOUND(SrcMiscData%V_rel_n,1) - i1_u = UBOUND(SrcMiscData%V_rel_n,1) - IF (.NOT. ALLOCATED(DstMiscData%V_rel_n)) THEN - ALLOCATE(DstMiscData%V_rel_n(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%V_rel_n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%V_rel_n = SrcMiscData%V_rel_n -ENDIF -IF (ALLOCATED(SrcMiscData%V_rel_n_HiPass)) THEN - i1_l = LBOUND(SrcMiscData%V_rel_n_HiPass,1) - i1_u = UBOUND(SrcMiscData%V_rel_n_HiPass,1) - IF (.NOT. ALLOCATED(DstMiscData%V_rel_n_HiPass)) THEN - ALLOCATE(DstMiscData%V_rel_n_HiPass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%V_rel_n_HiPass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%V_rel_n_HiPass = SrcMiscData%V_rel_n_HiPass -ENDIF - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - END SUBROUTINE Morison_CopyMisc - - SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(Morison_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 = 'Morison_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%DispNodePosHdn)) THEN - DEALLOCATE(MiscData%DispNodePosHdn) -ENDIF -IF (ALLOCATED(MiscData%DispNodePosHst)) THEN - DEALLOCATE(MiscData%DispNodePosHst) -ENDIF -IF (ALLOCATED(MiscData%FV)) THEN - DEALLOCATE(MiscData%FV) -ENDIF -IF (ALLOCATED(MiscData%FA)) THEN - DEALLOCATE(MiscData%FA) -ENDIF -IF (ALLOCATED(MiscData%FAMCF)) THEN - DEALLOCATE(MiscData%FAMCF) -ENDIF -IF (ALLOCATED(MiscData%FDynP)) THEN - DEALLOCATE(MiscData%FDynP) -ENDIF -IF (ALLOCATED(MiscData%WaveElev)) THEN - DEALLOCATE(MiscData%WaveElev) -ENDIF -IF (ALLOCATED(MiscData%WaveElev1)) THEN - DEALLOCATE(MiscData%WaveElev1) -ENDIF -IF (ALLOCATED(MiscData%WaveElev2)) THEN - DEALLOCATE(MiscData%WaveElev2) -ENDIF -IF (ALLOCATED(MiscData%vrel)) THEN - DEALLOCATE(MiscData%vrel) -ENDIF -IF (ALLOCATED(MiscData%nodeInWater)) THEN - DEALLOCATE(MiscData%nodeInWater) -ENDIF -IF (ALLOCATED(MiscData%memberLoads)) THEN -DO i1 = LBOUND(MiscData%memberLoads,1), UBOUND(MiscData%memberLoads,1) - CALL Morison_DestroyMemberLoads( MiscData%memberLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%memberLoads) -ENDIF -IF (ALLOCATED(MiscData%F_B_End)) THEN - DEALLOCATE(MiscData%F_B_End) -ENDIF -IF (ALLOCATED(MiscData%F_D_End)) THEN - DEALLOCATE(MiscData%F_D_End) -ENDIF -IF (ALLOCATED(MiscData%F_I_End)) THEN - DEALLOCATE(MiscData%F_I_End) -ENDIF -IF (ALLOCATED(MiscData%F_IMG_End)) THEN - DEALLOCATE(MiscData%F_IMG_End) -ENDIF -IF (ALLOCATED(MiscData%F_A_End)) THEN - DEALLOCATE(MiscData%F_A_End) -ENDIF -IF (ALLOCATED(MiscData%F_BF_End)) THEN - DEALLOCATE(MiscData%F_BF_End) -ENDIF -IF (ALLOCATED(MiscData%V_rel_n)) THEN - DEALLOCATE(MiscData%V_rel_n) -ENDIF -IF (ALLOCATED(MiscData%V_rel_n_HiPass)) THEN - DEALLOCATE(MiscData%V_rel_n_HiPass) -ENDIF - END SUBROUTINE Morison_DestroyMisc - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 ! DispNodePosHdn allocated yes/no - IF ( ALLOCATED(InData%DispNodePosHdn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DispNodePosHdn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DispNodePosHdn) ! DispNodePosHdn - END IF - Int_BufSz = Int_BufSz + 1 ! DispNodePosHst allocated yes/no - IF ( ALLOCATED(InData%DispNodePosHst) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DispNodePosHst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DispNodePosHst) ! DispNodePosHst - END IF - Int_BufSz = Int_BufSz + 1 ! FV allocated yes/no - IF ( ALLOCATED(InData%FV) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FV) ! FV - END IF - Int_BufSz = Int_BufSz + 1 ! FA allocated yes/no - IF ( ALLOCATED(InData%FA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FA) ! FA - END IF - Int_BufSz = Int_BufSz + 1 ! FAMCF allocated yes/no - IF ( ALLOCATED(InData%FAMCF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FAMCF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAMCF) ! FAMCF - END IF - Int_BufSz = Int_BufSz + 1 ! FDynP allocated yes/no - IF ( ALLOCATED(InData%FDynP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FDynP) ! FDynP - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev allocated yes/no - IF ( ALLOCATED(InData%WaveElev) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev) ! WaveElev - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no - IF ( ALLOCATED(InData%WaveElev1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! 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*1 ! WaveElev2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 - END IF - Int_BufSz = Int_BufSz + 1 ! vrel allocated yes/no - IF ( ALLOCATED(InData%vrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vrel) ! vrel - END IF - Int_BufSz = Int_BufSz + 1 ! nodeInWater allocated yes/no - IF ( ALLOCATED(InData%nodeInWater) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nodeInWater upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nodeInWater) ! nodeInWater - END IF - Int_BufSz = Int_BufSz + 1 ! memberLoads allocated yes/no - IF ( ALLOCATED(InData%memberLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! memberLoads upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! memberLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! memberLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! memberLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! F_B_End allocated yes/no - IF ( ALLOCATED(InData%F_B_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_B_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_B_End) ! F_B_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_D_End allocated yes/no - IF ( ALLOCATED(InData%F_D_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_D_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_D_End) ! F_D_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_I_End allocated yes/no - IF ( ALLOCATED(InData%F_I_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_I_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_I_End) ! F_I_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_IMG_End allocated yes/no - IF ( ALLOCATED(InData%F_IMG_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_IMG_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_IMG_End) ! F_IMG_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_A_End allocated yes/no - IF ( ALLOCATED(InData%F_A_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_A_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_A_End) ! F_A_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_BF_End allocated yes/no - IF ( ALLOCATED(InData%F_BF_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_BF_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_BF_End) ! F_BF_End - END IF - Int_BufSz = Int_BufSz + 1 ! V_rel_n allocated yes/no - IF ( ALLOCATED(InData%V_rel_n) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V_rel_n upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_rel_n) ! V_rel_n - END IF - Int_BufSz = Int_BufSz + 1 ! V_rel_n_HiPass allocated yes/no - IF ( ALLOCATED(InData%V_rel_n_HiPass) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V_rel_n_HiPass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_rel_n_HiPass) ! V_rel_n_HiPass - END IF - 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 - - IF ( .NOT. ALLOCATED(InData%DispNodePosHdn) ) 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%DispNodePosHdn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DispNodePosHdn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DispNodePosHdn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DispNodePosHdn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DispNodePosHdn,2), UBOUND(InData%DispNodePosHdn,2) - DO i1 = LBOUND(InData%DispNodePosHdn,1), UBOUND(InData%DispNodePosHdn,1) - ReKiBuf(Re_Xferred) = InData%DispNodePosHdn(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DispNodePosHst) ) 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%DispNodePosHst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DispNodePosHst,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DispNodePosHst,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DispNodePosHst,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DispNodePosHst,2), UBOUND(InData%DispNodePosHst,2) - DO i1 = LBOUND(InData%DispNodePosHst,1), UBOUND(InData%DispNodePosHst,1) - ReKiBuf(Re_Xferred) = InData%DispNodePosHst(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FV) ) 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%FV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FV,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FV,2), UBOUND(InData%FV,2) - DO i1 = LBOUND(InData%FV,1), UBOUND(InData%FV,1) - ReKiBuf(Re_Xferred) = InData%FV(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FA) ) 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%FA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FA,2), UBOUND(InData%FA,2) - DO i1 = LBOUND(InData%FA,1), UBOUND(InData%FA,1) - ReKiBuf(Re_Xferred) = InData%FA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FAMCF) ) 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%FAMCF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAMCF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAMCF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAMCF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FAMCF,2), UBOUND(InData%FAMCF,2) - DO i1 = LBOUND(InData%FAMCF,1), UBOUND(InData%FAMCF,1) - ReKiBuf(Re_Xferred) = InData%FAMCF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FDynP) ) 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%FDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FDynP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FDynP,1), UBOUND(InData%FDynP,1) - ReKiBuf(Re_Xferred) = InData%FDynP(i1) - Re_Xferred = Re_Xferred + 1 - 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 - - DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) - ReKiBuf(Re_Xferred) = InData%WaveElev(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 - 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 - - DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) - ReKiBuf(Re_Xferred) = InData%WaveElev1(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 - - DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) - ReKiBuf(Re_Xferred) = InData%WaveElev2(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vrel) ) 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%vrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vrel,2), UBOUND(InData%vrel,2) - DO i1 = LBOUND(InData%vrel,1), UBOUND(InData%vrel,1) - ReKiBuf(Re_Xferred) = InData%vrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - 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 - - DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) - IntKiBuf(Int_Xferred) = InData%nodeInWater(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%memberLoads) ) 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%memberLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%memberLoads,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%F_B_End) ) 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%F_B_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_B_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_B_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_B_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_B_End,2), UBOUND(InData%F_B_End,2) - DO i1 = LBOUND(InData%F_B_End,1), UBOUND(InData%F_B_End,1) - ReKiBuf(Re_Xferred) = InData%F_B_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_D_End) ) 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%F_D_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_D_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_D_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_D_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_D_End,2), UBOUND(InData%F_D_End,2) - DO i1 = LBOUND(InData%F_D_End,1), UBOUND(InData%F_D_End,1) - ReKiBuf(Re_Xferred) = InData%F_D_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_I_End) ) 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%F_I_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_I_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_I_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_I_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_I_End,2), UBOUND(InData%F_I_End,2) - DO i1 = LBOUND(InData%F_I_End,1), UBOUND(InData%F_I_End,1) - ReKiBuf(Re_Xferred) = InData%F_I_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_IMG_End) ) 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%F_IMG_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_IMG_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_IMG_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_IMG_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_IMG_End,2), UBOUND(InData%F_IMG_End,2) - DO i1 = LBOUND(InData%F_IMG_End,1), UBOUND(InData%F_IMG_End,1) - ReKiBuf(Re_Xferred) = InData%F_IMG_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_A_End) ) 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%F_A_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_A_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_A_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_A_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_A_End,2), UBOUND(InData%F_A_End,2) - DO i1 = LBOUND(InData%F_A_End,1), UBOUND(InData%F_A_End,1) - ReKiBuf(Re_Xferred) = InData%F_A_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_BF_End) ) 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%F_BF_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_BF_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_BF_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_BF_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_BF_End,2), UBOUND(InData%F_BF_End,2) - DO i1 = LBOUND(InData%F_BF_End,1), UBOUND(InData%F_BF_End,1) - ReKiBuf(Re_Xferred) = InData%F_BF_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%V_rel_n) ) 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%V_rel_n,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_rel_n,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V_rel_n,1), UBOUND(InData%V_rel_n,1) - ReKiBuf(Re_Xferred) = InData%V_rel_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%V_rel_n_HiPass) ) 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%V_rel_n_HiPass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_rel_n_HiPass,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V_rel_n_HiPass,1), UBOUND(InData%V_rel_n_HiPass,1) - ReKiBuf(Re_Xferred) = InData%V_rel_n_HiPass(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackMisc - - SUBROUTINE Morison_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(Morison_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) :: 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 = 'Morison_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DispNodePosHdn 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%DispNodePosHdn)) DEALLOCATE(OutData%DispNodePosHdn) - ALLOCATE(OutData%DispNodePosHdn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DispNodePosHdn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DispNodePosHdn,2), UBOUND(OutData%DispNodePosHdn,2) - DO i1 = LBOUND(OutData%DispNodePosHdn,1), UBOUND(OutData%DispNodePosHdn,1) - OutData%DispNodePosHdn(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DispNodePosHst 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%DispNodePosHst)) DEALLOCATE(OutData%DispNodePosHst) - ALLOCATE(OutData%DispNodePosHst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DispNodePosHst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DispNodePosHst,2), UBOUND(OutData%DispNodePosHst,2) - DO i1 = LBOUND(OutData%DispNodePosHst,1), UBOUND(OutData%DispNodePosHst,1) - OutData%DispNodePosHst(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FV 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%FV)) DEALLOCATE(OutData%FV) - ALLOCATE(OutData%FV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FV,2), UBOUND(OutData%FV,2) - DO i1 = LBOUND(OutData%FV,1), UBOUND(OutData%FV,1) - OutData%FV(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FA 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%FA)) DEALLOCATE(OutData%FA) - ALLOCATE(OutData%FA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FA,2), UBOUND(OutData%FA,2) - DO i1 = LBOUND(OutData%FA,1), UBOUND(OutData%FA,1) - OutData%FA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAMCF 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%FAMCF)) DEALLOCATE(OutData%FAMCF) - ALLOCATE(OutData%FAMCF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FAMCF,2), UBOUND(OutData%FAMCF,2) - DO i1 = LBOUND(OutData%FAMCF,1), UBOUND(OutData%FAMCF,1) - OutData%FAMCF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FDynP 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%FDynP)) DEALLOCATE(OutData%FDynP) - ALLOCATE(OutData%FDynP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FDynP,1), UBOUND(OutData%FDynP,1) - OutData%FDynP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 - IF (ALLOCATED(OutData%WaveElev)) DEALLOCATE(OutData%WaveElev) - ALLOCATE(OutData%WaveElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) - OutData%WaveElev(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 - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev1)) DEALLOCATE(OutData%WaveElev1) - ALLOCATE(OutData%WaveElev1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) - OutData%WaveElev1(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 - IF (ALLOCATED(OutData%WaveElev2)) DEALLOCATE(OutData%WaveElev2) - ALLOCATE(OutData%WaveElev2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) - OutData%WaveElev2(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vrel 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%vrel)) DEALLOCATE(OutData%vrel) - ALLOCATE(OutData%vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vrel,2), UBOUND(OutData%vrel,2) - DO i1 = LBOUND(OutData%vrel,1), UBOUND(OutData%vrel,1) - OutData%vrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - 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 - IF (ALLOCATED(OutData%nodeInWater)) DEALLOCATE(OutData%nodeInWater) - ALLOCATE(OutData%nodeInWater(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) - OutData%nodeInWater(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! memberLoads 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%memberLoads)) DEALLOCATE(OutData%memberLoads) - ALLOCATE(OutData%memberLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%memberLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%memberLoads,1), UBOUND(OutData%memberLoads,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_UnpackMemberLoads( Re_Buf, Db_Buf, Int_Buf, OutData%memberLoads(i1), ErrStat2, ErrMsg2 ) ! memberLoads - 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 ! F_B_End 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%F_B_End)) DEALLOCATE(OutData%F_B_End) - ALLOCATE(OutData%F_B_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_B_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_B_End,2), UBOUND(OutData%F_B_End,2) - DO i1 = LBOUND(OutData%F_B_End,1), UBOUND(OutData%F_B_End,1) - OutData%F_B_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_D_End 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%F_D_End)) DEALLOCATE(OutData%F_D_End) - ALLOCATE(OutData%F_D_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_D_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_D_End,2), UBOUND(OutData%F_D_End,2) - DO i1 = LBOUND(OutData%F_D_End,1), UBOUND(OutData%F_D_End,1) - OutData%F_D_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_I_End 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%F_I_End)) DEALLOCATE(OutData%F_I_End) - ALLOCATE(OutData%F_I_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_I_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_I_End,2), UBOUND(OutData%F_I_End,2) - DO i1 = LBOUND(OutData%F_I_End,1), UBOUND(OutData%F_I_End,1) - OutData%F_I_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_IMG_End 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%F_IMG_End)) DEALLOCATE(OutData%F_IMG_End) - ALLOCATE(OutData%F_IMG_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_IMG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_IMG_End,2), UBOUND(OutData%F_IMG_End,2) - DO i1 = LBOUND(OutData%F_IMG_End,1), UBOUND(OutData%F_IMG_End,1) - OutData%F_IMG_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_A_End 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%F_A_End)) DEALLOCATE(OutData%F_A_End) - ALLOCATE(OutData%F_A_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_A_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_A_End,2), UBOUND(OutData%F_A_End,2) - DO i1 = LBOUND(OutData%F_A_End,1), UBOUND(OutData%F_A_End,1) - OutData%F_A_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_BF_End 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%F_BF_End)) DEALLOCATE(OutData%F_BF_End) - ALLOCATE(OutData%F_BF_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_BF_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_BF_End,2), UBOUND(OutData%F_BF_End,2) - DO i1 = LBOUND(OutData%F_BF_End,1), UBOUND(OutData%F_BF_End,1) - OutData%F_BF_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_rel_n 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%V_rel_n)) DEALLOCATE(OutData%V_rel_n) - ALLOCATE(OutData%V_rel_n(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%V_rel_n,1), UBOUND(OutData%V_rel_n,1) - OutData%V_rel_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_rel_n_HiPass 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%V_rel_n_HiPass)) DEALLOCATE(OutData%V_rel_n_HiPass) - ALLOCATE(OutData%V_rel_n_HiPass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n_HiPass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%V_rel_n_HiPass,1), UBOUND(OutData%V_rel_n_HiPass,1) - OutData%V_rel_n_HiPass(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackMisc - - SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Morison_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyParam' -! + ErrMsg = '' + DstJOutputData%JointID = SrcJOutputData%JointID + DstJOutputData%JointIDIndx = SrcJOutputData%JointIDIndx +end subroutine + +subroutine Morison_DestroyJOutput(JOutputData, ErrStat, ErrMsg) + type(Morison_JOutput), intent(inout) :: JOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyJOutput' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%Gravity = SrcParamData%Gravity - DstParamData%WtrDens = SrcParamData%WtrDens - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%MSL2SWL = SrcParamData%MSL2SWL - DstParamData%WaveDisp = SrcParamData%WaveDisp - DstParamData%AMMod = SrcParamData%AMMod - DstParamData%NMembers = SrcParamData%NMembers -IF (ALLOCATED(SrcParamData%Members)) THEN - i1_l = LBOUND(SrcParamData%Members,1) - i1_u = UBOUND(SrcParamData%Members,1) - IF (.NOT. ALLOCATED(DstParamData%Members)) THEN - ALLOCATE(DstParamData%Members(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Members.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%Members,1), UBOUND(SrcParamData%Members,1) - CALL Morison_Copymembertype( SrcParamData%Members(i1), DstParamData%Members(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%NNodes = SrcParamData%NNodes - DstParamData%NJoints = SrcParamData%NJoints -IF (ALLOCATED(SrcParamData%I_MG_End)) THEN - i1_l = LBOUND(SrcParamData%I_MG_End,1) - i1_u = UBOUND(SrcParamData%I_MG_End,1) - i2_l = LBOUND(SrcParamData%I_MG_End,2) - i2_u = UBOUND(SrcParamData%I_MG_End,2) - i3_l = LBOUND(SrcParamData%I_MG_End,3) - i3_u = UBOUND(SrcParamData%I_MG_End,3) - IF (.NOT. ALLOCATED(DstParamData%I_MG_End)) THEN - ALLOCATE(DstParamData%I_MG_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%I_MG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%I_MG_End = SrcParamData%I_MG_End -ENDIF -IF (ALLOCATED(SrcParamData%An_End)) THEN - i1_l = LBOUND(SrcParamData%An_End,1) - i1_u = UBOUND(SrcParamData%An_End,1) - i2_l = LBOUND(SrcParamData%An_End,2) - i2_u = UBOUND(SrcParamData%An_End,2) - IF (.NOT. ALLOCATED(DstParamData%An_End)) THEN - ALLOCATE(DstParamData%An_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%An_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%An_End = SrcParamData%An_End -ENDIF -IF (ALLOCATED(SrcParamData%DragConst_End)) THEN - i1_l = LBOUND(SrcParamData%DragConst_End,1) - i1_u = UBOUND(SrcParamData%DragConst_End,1) - IF (.NOT. ALLOCATED(DstParamData%DragConst_End)) THEN - ALLOCATE(DstParamData%DragConst_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragConst_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DragConst_End = SrcParamData%DragConst_End -ENDIF -IF (ALLOCATED(SrcParamData%VRelNFiltConst)) THEN - i1_l = LBOUND(SrcParamData%VRelNFiltConst,1) - i1_u = UBOUND(SrcParamData%VRelNFiltConst,1) - IF (.NOT. ALLOCATED(DstParamData%VRelNFiltConst)) THEN - ALLOCATE(DstParamData%VRelNFiltConst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%VRelNFiltConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%VRelNFiltConst = SrcParamData%VRelNFiltConst -ENDIF -IF (ALLOCATED(SrcParamData%DragMod_End)) THEN - i1_l = LBOUND(SrcParamData%DragMod_End,1) - i1_u = UBOUND(SrcParamData%DragMod_End,1) - IF (.NOT. ALLOCATED(DstParamData%DragMod_End)) THEN - ALLOCATE(DstParamData%DragMod_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragMod_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DragMod_End = SrcParamData%DragMod_End -ENDIF -IF (ALLOCATED(SrcParamData%DragLoFSc_End)) THEN - i1_l = LBOUND(SrcParamData%DragLoFSc_End,1) - i1_u = UBOUND(SrcParamData%DragLoFSc_End,1) - IF (.NOT. ALLOCATED(DstParamData%DragLoFSc_End)) THEN - ALLOCATE(DstParamData%DragLoFSc_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragLoFSc_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DragLoFSc_End = SrcParamData%DragLoFSc_End -ENDIF -IF (ALLOCATED(SrcParamData%F_WMG_End)) THEN - i1_l = LBOUND(SrcParamData%F_WMG_End,1) - i1_u = UBOUND(SrcParamData%F_WMG_End,1) - i2_l = LBOUND(SrcParamData%F_WMG_End,2) - i2_u = UBOUND(SrcParamData%F_WMG_End,2) - IF (.NOT. ALLOCATED(DstParamData%F_WMG_End)) THEN - ALLOCATE(DstParamData%F_WMG_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_WMG_End.', ErrStat, ErrMsg,RoutineName) - 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 - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%NMOutputs = SrcParamData%NMOutputs -IF (ALLOCATED(SrcParamData%MOutLst)) THEN - i1_l = LBOUND(SrcParamData%MOutLst,1) - i1_u = UBOUND(SrcParamData%MOutLst,1) - IF (.NOT. ALLOCATED(DstParamData%MOutLst)) THEN - ALLOCATE(DstParamData%MOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%MOutLst,1), UBOUND(SrcParamData%MOutLst,1) - CALL Morison_Copymoutput( SrcParamData%MOutLst(i1), DstParamData%MOutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%NJOutputs = SrcParamData%NJOutputs -IF (ALLOCATED(SrcParamData%JOutLst)) THEN - i1_l = LBOUND(SrcParamData%JOutLst,1) - i1_u = UBOUND(SrcParamData%JOutLst,1) - IF (.NOT. ALLOCATED(DstParamData%JOutLst)) THEN - ALLOCATE(DstParamData%JOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%JOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%JOutLst,1), UBOUND(SrcParamData%JOutLst,1) - CALL Morison_Copyjoutput( SrcParamData%JOutLst(i1), DstParamData%JOutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -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%WaveStMod = SrcParamData%WaveStMod - DstParamData%WaveField => SrcParamData%WaveField - END SUBROUTINE Morison_CopyParam - - SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(Morison_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 = 'Morison_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%Members)) THEN -DO i1 = LBOUND(ParamData%Members,1), UBOUND(ParamData%Members,1) - CALL Morison_DestroyMemberType( ParamData%Members(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%Members) -ENDIF -IF (ALLOCATED(ParamData%I_MG_End)) THEN - DEALLOCATE(ParamData%I_MG_End) -ENDIF -IF (ALLOCATED(ParamData%An_End)) THEN - DEALLOCATE(ParamData%An_End) -ENDIF -IF (ALLOCATED(ParamData%DragConst_End)) THEN - DEALLOCATE(ParamData%DragConst_End) -ENDIF -IF (ALLOCATED(ParamData%VRelNFiltConst)) THEN - DEALLOCATE(ParamData%VRelNFiltConst) -ENDIF -IF (ALLOCATED(ParamData%DragMod_End)) THEN - DEALLOCATE(ParamData%DragMod_End) -ENDIF -IF (ALLOCATED(ParamData%DragLoFSc_End)) THEN - DEALLOCATE(ParamData%DragLoFSc_End) -ENDIF -IF (ALLOCATED(ParamData%F_WMG_End)) THEN - DEALLOCATE(ParamData%F_WMG_End) -ENDIF -IF (ALLOCATED(ParamData%DP_Const_End)) THEN - DEALLOCATE(ParamData%DP_Const_End) -ENDIF -IF (ALLOCATED(ParamData%Mass_MG_End)) THEN - DEALLOCATE(ParamData%Mass_MG_End) -ENDIF -IF (ALLOCATED(ParamData%AM_End)) THEN - DEALLOCATE(ParamData%AM_End) -ENDIF -IF (ALLOCATED(ParamData%MOutLst)) THEN -DO i1 = LBOUND(ParamData%MOutLst,1), UBOUND(ParamData%MOutLst,1) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -NULLIFY(ParamData%WaveField) - END SUBROUTINE Morison_DestroyParam - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! WaveDisp - Int_BufSz = Int_BufSz + 1 ! AMMod - Int_BufSz = Int_BufSz + 1 ! NMembers - Int_BufSz = Int_BufSz + 1 ! Members allocated yes/no - IF ( ALLOCATED(InData%Members) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Members upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Members - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Members - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Members - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NNodes - Int_BufSz = Int_BufSz + 1 ! NJoints - Int_BufSz = Int_BufSz + 1 ! I_MG_End allocated yes/no - IF ( ALLOCATED(InData%I_MG_End) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! I_MG_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_MG_End) ! I_MG_End - END IF - Int_BufSz = Int_BufSz + 1 ! An_End allocated yes/no - IF ( ALLOCATED(InData%An_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! An_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%An_End) ! An_End - END IF - Int_BufSz = Int_BufSz + 1 ! DragConst_End allocated yes/no - IF ( ALLOCATED(InData%DragConst_End) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DragConst_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DragConst_End) ! DragConst_End - END IF - Int_BufSz = Int_BufSz + 1 ! VRelNFiltConst allocated yes/no - IF ( ALLOCATED(InData%VRelNFiltConst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VRelNFiltConst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VRelNFiltConst) ! VRelNFiltConst - END IF - Int_BufSz = Int_BufSz + 1 ! DragMod_End allocated yes/no - IF ( ALLOCATED(InData%DragMod_End) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DragMod_End upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DragMod_End) ! DragMod_End - END IF - Int_BufSz = Int_BufSz + 1 ! DragLoFSc_End allocated yes/no - IF ( ALLOCATED(InData%DragLoFSc_End) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DragLoFSc_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DragLoFSc_End) ! DragLoFSc_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_WMG_End allocated yes/no - IF ( ALLOCATED(InData%F_WMG_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_WMG_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_WMG_End) ! F_WMG_End - END IF - Int_BufSz = Int_BufSz + 1 ! DP_Const_End allocated yes/no - IF ( ALLOCATED(InData%DP_Const_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DP_Const_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DP_Const_End) ! DP_Const_End - END IF - Int_BufSz = Int_BufSz + 1 ! Mass_MG_End allocated yes/no - IF ( ALLOCATED(InData%Mass_MG_End) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Mass_MG_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Mass_MG_End) ! Mass_MG_End - END IF - Int_BufSz = Int_BufSz + 1 ! AM_End allocated yes/no - 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 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NMOutputs - Int_BufSz = Int_BufSz + 1 ! MOutLst allocated yes/no - IF ( ALLOCATED(InData%MOutLst) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MOutLst - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MOutLst - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MOutLst - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NJOutputs - Int_BufSz = Int_BufSz + 1 ! JOutLst allocated yes/no - IF ( ALLOCATED(InData%JOutLst) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! JOutLst - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! JOutLst - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! JOutLst - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - 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 ! WaveStMod - 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 - 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 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveDisp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AMMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NMembers - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Members) ) 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%Members,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Members,1) - 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 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%NNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%I_MG_End) ) 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%I_MG_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_MG_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_MG_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_MG_End,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_MG_End,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_MG_End,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%I_MG_End,3), UBOUND(InData%I_MG_End,3) - DO i2 = LBOUND(InData%I_MG_End,2), UBOUND(InData%I_MG_End,2) - DO i1 = LBOUND(InData%I_MG_End,1), UBOUND(InData%I_MG_End,1) - ReKiBuf(Re_Xferred) = InData%I_MG_End(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%An_End) ) 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%An_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%An_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%An_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%An_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%An_End,2), UBOUND(InData%An_End,2) - DO i1 = LBOUND(InData%An_End,1), UBOUND(InData%An_End,1) - ReKiBuf(Re_Xferred) = InData%An_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DragConst_End) ) 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%DragConst_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DragConst_End,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DragConst_End,1), UBOUND(InData%DragConst_End,1) - ReKiBuf(Re_Xferred) = InData%DragConst_End(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VRelNFiltConst) ) 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%VRelNFiltConst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VRelNFiltConst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VRelNFiltConst,1), UBOUND(InData%VRelNFiltConst,1) - ReKiBuf(Re_Xferred) = InData%VRelNFiltConst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DragMod_End) ) 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%DragMod_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DragMod_End,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DragMod_End,1), UBOUND(InData%DragMod_End,1) - IntKiBuf(Int_Xferred) = InData%DragMod_End(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DragLoFSc_End) ) 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%DragLoFSc_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DragLoFSc_End,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DragLoFSc_End,1), UBOUND(InData%DragLoFSc_End,1) - ReKiBuf(Re_Xferred) = InData%DragLoFSc_End(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_WMG_End) ) 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%F_WMG_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_WMG_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_WMG_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_WMG_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_WMG_End,2), UBOUND(InData%F_WMG_End,2) - DO i1 = LBOUND(InData%F_WMG_End,1), UBOUND(InData%F_WMG_End,1) - ReKiBuf(Re_Xferred) = InData%F_WMG_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DP_Const_End) ) 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%DP_Const_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP_Const_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DP_Const_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP_Const_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DP_Const_End,2), UBOUND(InData%DP_Const_End,2) - DO i1 = LBOUND(InData%DP_Const_End,1), UBOUND(InData%DP_Const_End,1) - ReKiBuf(Re_Xferred) = InData%DP_Const_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mass_MG_End) ) 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%Mass_MG_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass_MG_End,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Mass_MG_End,1), UBOUND(InData%Mass_MG_End,1) - ReKiBuf(Re_Xferred) = InData%Mass_MG_End(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AM_End) ) 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%AM_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM_End,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM_End,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM_End,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AM_End,3), UBOUND(InData%AM_End,3) - DO i2 = LBOUND(InData%AM_End,2), UBOUND(InData%AM_End,2) - DO i1 = LBOUND(InData%AM_End,1), UBOUND(InData%AM_End,1) - ReKiBuf(Re_Xferred) = InData%AM_End(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 - IntKiBuf(Int_Xferred) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%MOutLst) ) 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%MOutLst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MOutLst,1) - 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 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%NJOutputs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%JOutLst) ) 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%JOutLst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%JOutLst,1) - 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 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 - 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%WaveStMod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackParam - - SUBROUTINE Morison_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(Morison_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_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%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%NMembers = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Members 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%Members)) DEALLOCATE(OutData%Members) - ALLOCATE(OutData%Members(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Members,1), UBOUND(OutData%Members,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_UnpackMemberType( Re_Buf, Db_Buf, Int_Buf, OutData%Members(i1), ErrStat2, ErrMsg2 ) ! Members - 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%NNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NJoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_MG_End 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%I_MG_End)) DEALLOCATE(OutData%I_MG_End) - ALLOCATE(OutData%I_MG_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 OutData%I_MG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%I_MG_End,3), UBOUND(OutData%I_MG_End,3) - DO i2 = LBOUND(OutData%I_MG_End,2), UBOUND(OutData%I_MG_End,2) - DO i1 = LBOUND(OutData%I_MG_End,1), UBOUND(OutData%I_MG_End,1) - OutData%I_MG_End(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! An_End 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%An_End)) DEALLOCATE(OutData%An_End) - ALLOCATE(OutData%An_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%An_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%An_End,2), UBOUND(OutData%An_End,2) - DO i1 = LBOUND(OutData%An_End,1), UBOUND(OutData%An_End,1) - OutData%An_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DragConst_End 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%DragConst_End)) DEALLOCATE(OutData%DragConst_End) - ALLOCATE(OutData%DragConst_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragConst_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DragConst_End,1), UBOUND(OutData%DragConst_End,1) - OutData%DragConst_End(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VRelNFiltConst 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%VRelNFiltConst)) DEALLOCATE(OutData%VRelNFiltConst) - ALLOCATE(OutData%VRelNFiltConst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VRelNFiltConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VRelNFiltConst,1), UBOUND(OutData%VRelNFiltConst,1) - OutData%VRelNFiltConst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DragMod_End 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%DragMod_End)) DEALLOCATE(OutData%DragMod_End) - ALLOCATE(OutData%DragMod_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragMod_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DragMod_End,1), UBOUND(OutData%DragMod_End,1) - OutData%DragMod_End(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DragLoFSc_End 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%DragLoFSc_End)) DEALLOCATE(OutData%DragLoFSc_End) - ALLOCATE(OutData%DragLoFSc_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragLoFSc_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DragLoFSc_End,1), UBOUND(OutData%DragLoFSc_End,1) - OutData%DragLoFSc_End(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_WMG_End 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%F_WMG_End)) DEALLOCATE(OutData%F_WMG_End) - ALLOCATE(OutData%F_WMG_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_WMG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_WMG_End,2), UBOUND(OutData%F_WMG_End,2) - DO i1 = LBOUND(OutData%F_WMG_End,1), UBOUND(OutData%F_WMG_End,1) - OutData%F_WMG_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DP_Const_End 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%DP_Const_End)) DEALLOCATE(OutData%DP_Const_End) - ALLOCATE(OutData%DP_Const_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DP_Const_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DP_Const_End,2), UBOUND(OutData%DP_Const_End,2) - DO i1 = LBOUND(OutData%DP_Const_End,1), UBOUND(OutData%DP_Const_End,1) - OutData%DP_Const_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mass_MG_End 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%Mass_MG_End)) DEALLOCATE(OutData%Mass_MG_End) - ALLOCATE(OutData%Mass_MG_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass_MG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Mass_MG_End,1), UBOUND(OutData%Mass_MG_End,1) - OutData%Mass_MG_End(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM_End 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%AM_End)) DEALLOCATE(OutData%AM_End) - ALLOCATE(OutData%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 OutData%AM_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AM_End,3), UBOUND(OutData%AM_End,3) - DO i2 = LBOUND(OutData%AM_End,2), UBOUND(OutData%AM_End,2) - DO i1 = LBOUND(OutData%AM_End,1), UBOUND(OutData%AM_End,1) - OutData%AM_End(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_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 ! 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%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - NULLIFY(OutData%WaveField) - END SUBROUTINE Morison_UnPackParam - - SUBROUTINE Morison_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_InputType), INTENT(INOUT) :: SrcInputData - TYPE(Morison_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 = 'Morison_CopyInput' -! + ErrMsg = '' +end subroutine + +subroutine Morison_PackJOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_JOutput), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackJOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%JointID) + call RegPack(Buf, InData%JointIDIndx) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackJOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_JOutput), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackJOutput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%JointID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%JointIDIndx) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_InitInputType), intent(in) :: SrcInitInputData + type(Morison_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%Mesh, DstInputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE Morison_CopyInput - - SUBROUTINE Morison_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(Morison_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 = 'Morison_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( InputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Morison_DestroyInput - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - 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 - - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - 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_PackInput - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 - 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 MeshUnpack( OutData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - 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_UnPackInput - - SUBROUTINE Morison_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(Morison_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 = 'Morison_CopyOutput' -! + ErrMsg = '' + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%WtrDens = SrcInitInputData%WtrDens + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%WaveDisp = SrcInitInputData%WaveDisp + DstInitInputData%AMMod = SrcInitInputData%AMMod + DstInitInputData%NJoints = SrcInitInputData%NJoints + DstInitInputData%NNodes = SrcInitInputData%NNodes + if (allocated(SrcInitInputData%InpJoints)) then + LB(1:1) = lbound(SrcInitInputData%InpJoints) + UB(1:1) = ubound(SrcInitInputData%InpJoints) + if (.not. allocated(DstInitInputData%InpJoints)) then + allocate(DstInitInputData%InpJoints(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InpJoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyJointType(SrcInitInputData%InpJoints(i1), DstInitInputData%InpJoints(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInitInputData%Nodes)) then + LB(1:1) = lbound(SrcInitInputData%Nodes) + UB(1:1) = ubound(SrcInitInputData%Nodes) + if (.not. allocated(DstInitInputData%Nodes)) then + allocate(DstInitInputData%Nodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%Nodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyNodeType(SrcInitInputData%Nodes(i1), DstInitInputData%Nodes(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%NAxCoefs = SrcInitInputData%NAxCoefs + if (allocated(SrcInitInputData%AxialCoefs)) then + LB(1:1) = lbound(SrcInitInputData%AxialCoefs) + UB(1:1) = ubound(SrcInitInputData%AxialCoefs) + if (.not. allocated(DstInitInputData%AxialCoefs)) then + allocate(DstInitInputData%AxialCoefs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AxialCoefs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyAxialCoefType(SrcInitInputData%AxialCoefs(i1), DstInitInputData%AxialCoefs(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%NPropSets = SrcInitInputData%NPropSets + if (allocated(SrcInitInputData%MPropSets)) then + LB(1:1) = lbound(SrcInitInputData%MPropSets) + UB(1:1) = ubound(SrcInitInputData%MPropSets) + if (.not. allocated(DstInitInputData%MPropSets)) then + allocate(DstInitInputData%MPropSets(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MPropSets.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMemberPropType(SrcInitInputData%MPropSets(i1), DstInitInputData%MPropSets(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%SimplCd = SrcInitInputData%SimplCd + DstInitInputData%SimplCdMG = SrcInitInputData%SimplCdMG + DstInitInputData%SimplCa = SrcInitInputData%SimplCa + DstInitInputData%SimplCaMG = SrcInitInputData%SimplCaMG + DstInitInputData%SimplCp = SrcInitInputData%SimplCp + DstInitInputData%SimplCpMG = SrcInitInputData%SimplCpMG + DstInitInputData%SimplAxCd = SrcInitInputData%SimplAxCd + DstInitInputData%SimplAxCdMG = SrcInitInputData%SimplAxCdMG + DstInitInputData%SimplAxCa = SrcInitInputData%SimplAxCa + DstInitInputData%SimplAxCaMG = SrcInitInputData%SimplAxCaMG + DstInitInputData%SimplAxCp = SrcInitInputData%SimplAxCp + DstInitInputData%SimplAxCpMG = SrcInitInputData%SimplAxCpMG + DstInitInputData%SimplCb = SrcInitInputData%SimplCb + DstInitInputData%SimplCbMg = SrcInitInputData%SimplCbMg + DstInitInputData%SimplMCF = SrcInitInputData%SimplMCF + DstInitInputData%NCoefDpth = SrcInitInputData%NCoefDpth + if (allocated(SrcInitInputData%CoefDpths)) then + LB(1:1) = lbound(SrcInitInputData%CoefDpths) + UB(1:1) = ubound(SrcInitInputData%CoefDpths) + if (.not. allocated(DstInitInputData%CoefDpths)) then + allocate(DstInitInputData%CoefDpths(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CoefDpths.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyCoefDpths(SrcInitInputData%CoefDpths(i1), DstInitInputData%CoefDpths(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%NCoefMembers = SrcInitInputData%NCoefMembers + if (allocated(SrcInitInputData%CoefMembers)) then + LB(1:1) = lbound(SrcInitInputData%CoefMembers) + UB(1:1) = ubound(SrcInitInputData%CoefMembers) + if (.not. allocated(DstInitInputData%CoefMembers)) then + allocate(DstInitInputData%CoefMembers(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CoefMembers.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyCoefMembers(SrcInitInputData%CoefMembers(i1), DstInitInputData%CoefMembers(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%NMembers = SrcInitInputData%NMembers + if (allocated(SrcInitInputData%InpMembers)) then + LB(1:1) = lbound(SrcInitInputData%InpMembers) + UB(1:1) = ubound(SrcInitInputData%InpMembers) + if (.not. allocated(DstInitInputData%InpMembers)) then + allocate(DstInitInputData%InpMembers(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InpMembers.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMemberInputType(SrcInitInputData%InpMembers(i1), DstInitInputData%InpMembers(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%NFillGroups = SrcInitInputData%NFillGroups + if (allocated(SrcInitInputData%FilledGroups)) then + LB(1:1) = lbound(SrcInitInputData%FilledGroups) + UB(1:1) = ubound(SrcInitInputData%FilledGroups) + if (.not. allocated(DstInitInputData%FilledGroups)) then + allocate(DstInitInputData%FilledGroups(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%FilledGroups.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyFilledGroupType(SrcInitInputData%FilledGroups(i1), DstInitInputData%FilledGroups(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%NMGDepths = SrcInitInputData%NMGDepths + if (allocated(SrcInitInputData%MGDepths)) then + LB(1:1) = lbound(SrcInitInputData%MGDepths) + UB(1:1) = ubound(SrcInitInputData%MGDepths) + if (.not. allocated(DstInitInputData%MGDepths)) then + allocate(DstInitInputData%MGDepths(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MGDepths.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMGDepthsType(SrcInitInputData%MGDepths(i1), DstInitInputData%MGDepths(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%MGTop = SrcInitInputData%MGTop + DstInitInputData%MGBottom = SrcInitInputData%MGBottom + DstInitInputData%NMOutputs = SrcInitInputData%NMOutputs + if (allocated(SrcInitInputData%MOutLst)) then + LB(1:1) = lbound(SrcInitInputData%MOutLst) + UB(1:1) = ubound(SrcInitInputData%MOutLst) + if (.not. allocated(DstInitInputData%MOutLst)) then + allocate(DstInitInputData%MOutLst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MOutLst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMOutput(SrcInitInputData%MOutLst(i1), DstInitInputData%MOutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%NJOutputs = SrcInitInputData%NJOutputs + if (allocated(SrcInitInputData%JOutLst)) then + LB(1:1) = lbound(SrcInitInputData%JOutLst) + UB(1:1) = ubound(SrcInitInputData%JOutLst) + if (.not. allocated(DstInitInputData%JOutLst)) then + allocate(DstInitInputData%JOutLst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%JOutLst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyJOutput(SrcInitInputData%JOutLst(i1), DstInitInputData%JOutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInitInputData%OutList)) then + LB(1:1) = lbound(SrcInitInputData%OutList) + UB(1:1) = ubound(SrcInitInputData%OutList) + if (.not. allocated(DstInitInputData%OutList)) then + allocate(DstInitInputData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%OutList = SrcInitInputData%OutList + end if + DstInitInputData%NumOuts = SrcInitInputData%NumOuts + DstInitInputData%UnSum = SrcInitInputData%UnSum + DstInitInputData%NStepWave = SrcInitInputData%NStepWave + DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod + DstInitInputData%MCFD = SrcInitInputData%MCFD + DstInitInputData%WaveField => SrcInitInputData%WaveField +end subroutine + +subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Morison_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -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 Morison_CopyOutput - - SUBROUTINE Morison_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(Morison_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 = 'Morison_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE Morison_DestroyOutput - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 - - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - 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 - 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 Morison_PackOutput - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 - 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 MeshUnpack( OutData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - 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) - 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 Morison_UnPackOutput - - - SUBROUTINE Morison_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(Morison_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Morison_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 + ErrMsg = '' + if (allocated(InitInputData%InpJoints)) then + LB(1:1) = lbound(InitInputData%InpJoints) + UB(1:1) = ubound(InitInputData%InpJoints) + do i1 = LB(1), UB(1) + call Morison_DestroyJointType(InitInputData%InpJoints(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%InpJoints) + end if + if (allocated(InitInputData%Nodes)) then + LB(1:1) = lbound(InitInputData%Nodes) + UB(1:1) = ubound(InitInputData%Nodes) + do i1 = LB(1), UB(1) + call Morison_DestroyNodeType(InitInputData%Nodes(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%Nodes) + end if + if (allocated(InitInputData%AxialCoefs)) then + LB(1:1) = lbound(InitInputData%AxialCoefs) + UB(1:1) = ubound(InitInputData%AxialCoefs) + do i1 = LB(1), UB(1) + call Morison_DestroyAxialCoefType(InitInputData%AxialCoefs(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%AxialCoefs) + end if + if (allocated(InitInputData%MPropSets)) then + LB(1:1) = lbound(InitInputData%MPropSets) + UB(1:1) = ubound(InitInputData%MPropSets) + do i1 = LB(1), UB(1) + call Morison_DestroyMemberPropType(InitInputData%MPropSets(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%MPropSets) + end if + if (allocated(InitInputData%CoefDpths)) then + LB(1:1) = lbound(InitInputData%CoefDpths) + UB(1:1) = ubound(InitInputData%CoefDpths) + do i1 = LB(1), UB(1) + call Morison_DestroyCoefDpths(InitInputData%CoefDpths(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%CoefDpths) + end if + if (allocated(InitInputData%CoefMembers)) then + LB(1:1) = lbound(InitInputData%CoefMembers) + UB(1:1) = ubound(InitInputData%CoefMembers) + do i1 = LB(1), UB(1) + call Morison_DestroyCoefMembers(InitInputData%CoefMembers(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%CoefMembers) + end if + if (allocated(InitInputData%InpMembers)) then + LB(1:1) = lbound(InitInputData%InpMembers) + UB(1:1) = ubound(InitInputData%InpMembers) + do i1 = LB(1), UB(1) + call Morison_DestroyMemberInputType(InitInputData%InpMembers(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%InpMembers) + end if + if (allocated(InitInputData%FilledGroups)) then + LB(1:1) = lbound(InitInputData%FilledGroups) + UB(1:1) = ubound(InitInputData%FilledGroups) + do i1 = LB(1), UB(1) + call Morison_DestroyFilledGroupType(InitInputData%FilledGroups(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%FilledGroups) + end if + if (allocated(InitInputData%MGDepths)) then + LB(1:1) = lbound(InitInputData%MGDepths) + UB(1:1) = ubound(InitInputData%MGDepths) + do i1 = LB(1), UB(1) + call Morison_DestroyMGDepthsType(InitInputData%MGDepths(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%MGDepths) + end if + if (allocated(InitInputData%MOutLst)) then + LB(1:1) = lbound(InitInputData%MOutLst) + UB(1:1) = ubound(InitInputData%MOutLst) + do i1 = LB(1), UB(1) + call Morison_DestroyMOutput(InitInputData%MOutLst(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%MOutLst) + end if + if (allocated(InitInputData%JOutLst)) then + LB(1:1) = lbound(InitInputData%JOutLst) + UB(1:1) = ubound(InitInputData%JOutLst) + do i1 = LB(1), UB(1) + call Morison_DestroyJOutput(InitInputData%JOutLst(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%JOutLst) + end if + if (allocated(InitInputData%OutList)) then + deallocate(InitInputData%OutList) + end if + nullify(InitInputData%WaveField) +end subroutine + +subroutine Morison_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackInitInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%WtrDens) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%MSL2SWL) + call RegPack(Buf, InData%WaveDisp) + call RegPack(Buf, InData%AMMod) + call RegPack(Buf, InData%NJoints) + call RegPack(Buf, InData%NNodes) + call RegPack(Buf, allocated(InData%InpJoints)) + if (allocated(InData%InpJoints)) then + call RegPackBounds(Buf, 1, lbound(InData%InpJoints), ubound(InData%InpJoints)) + LB(1:1) = lbound(InData%InpJoints) + UB(1:1) = ubound(InData%InpJoints) + do i1 = LB(1), UB(1) + call Morison_PackJointType(Buf, InData%InpJoints(i1)) + end do + end if + call RegPack(Buf, allocated(InData%Nodes)) + if (allocated(InData%Nodes)) then + call RegPackBounds(Buf, 1, lbound(InData%Nodes), ubound(InData%Nodes)) + LB(1:1) = lbound(InData%Nodes) + UB(1:1) = ubound(InData%Nodes) + do i1 = LB(1), UB(1) + call Morison_PackNodeType(Buf, InData%Nodes(i1)) + end do + end if + call RegPack(Buf, InData%NAxCoefs) + call RegPack(Buf, allocated(InData%AxialCoefs)) + if (allocated(InData%AxialCoefs)) then + call RegPackBounds(Buf, 1, lbound(InData%AxialCoefs), ubound(InData%AxialCoefs)) + LB(1:1) = lbound(InData%AxialCoefs) + UB(1:1) = ubound(InData%AxialCoefs) + do i1 = LB(1), UB(1) + call Morison_PackAxialCoefType(Buf, InData%AxialCoefs(i1)) + end do + end if + call RegPack(Buf, InData%NPropSets) + call RegPack(Buf, allocated(InData%MPropSets)) + if (allocated(InData%MPropSets)) then + call RegPackBounds(Buf, 1, lbound(InData%MPropSets), ubound(InData%MPropSets)) + LB(1:1) = lbound(InData%MPropSets) + UB(1:1) = ubound(InData%MPropSets) + do i1 = LB(1), UB(1) + call Morison_PackMemberPropType(Buf, InData%MPropSets(i1)) + end do + end if + call RegPack(Buf, InData%SimplCd) + call RegPack(Buf, InData%SimplCdMG) + call RegPack(Buf, InData%SimplCa) + call RegPack(Buf, InData%SimplCaMG) + call RegPack(Buf, InData%SimplCp) + call RegPack(Buf, InData%SimplCpMG) + call RegPack(Buf, InData%SimplAxCd) + call RegPack(Buf, InData%SimplAxCdMG) + call RegPack(Buf, InData%SimplAxCa) + call RegPack(Buf, InData%SimplAxCaMG) + call RegPack(Buf, InData%SimplAxCp) + call RegPack(Buf, InData%SimplAxCpMG) + call RegPack(Buf, InData%SimplCb) + call RegPack(Buf, InData%SimplCbMg) + call RegPack(Buf, InData%SimplMCF) + call RegPack(Buf, InData%NCoefDpth) + call RegPack(Buf, allocated(InData%CoefDpths)) + if (allocated(InData%CoefDpths)) then + call RegPackBounds(Buf, 1, lbound(InData%CoefDpths), ubound(InData%CoefDpths)) + LB(1:1) = lbound(InData%CoefDpths) + UB(1:1) = ubound(InData%CoefDpths) + do i1 = LB(1), UB(1) + call Morison_PackCoefDpths(Buf, InData%CoefDpths(i1)) + end do + end if + call RegPack(Buf, InData%NCoefMembers) + call RegPack(Buf, allocated(InData%CoefMembers)) + if (allocated(InData%CoefMembers)) then + call RegPackBounds(Buf, 1, lbound(InData%CoefMembers), ubound(InData%CoefMembers)) + LB(1:1) = lbound(InData%CoefMembers) + UB(1:1) = ubound(InData%CoefMembers) + do i1 = LB(1), UB(1) + call Morison_PackCoefMembers(Buf, InData%CoefMembers(i1)) + end do + end if + call RegPack(Buf, InData%NMembers) + call RegPack(Buf, allocated(InData%InpMembers)) + if (allocated(InData%InpMembers)) then + call RegPackBounds(Buf, 1, lbound(InData%InpMembers), ubound(InData%InpMembers)) + LB(1:1) = lbound(InData%InpMembers) + UB(1:1) = ubound(InData%InpMembers) + do i1 = LB(1), UB(1) + call Morison_PackMemberInputType(Buf, InData%InpMembers(i1)) + end do + end if + call RegPack(Buf, InData%NFillGroups) + call RegPack(Buf, allocated(InData%FilledGroups)) + if (allocated(InData%FilledGroups)) then + call RegPackBounds(Buf, 1, lbound(InData%FilledGroups), ubound(InData%FilledGroups)) + LB(1:1) = lbound(InData%FilledGroups) + UB(1:1) = ubound(InData%FilledGroups) + do i1 = LB(1), UB(1) + call Morison_PackFilledGroupType(Buf, InData%FilledGroups(i1)) + end do + end if + call RegPack(Buf, InData%NMGDepths) + call RegPack(Buf, allocated(InData%MGDepths)) + if (allocated(InData%MGDepths)) then + call RegPackBounds(Buf, 1, lbound(InData%MGDepths), ubound(InData%MGDepths)) + LB(1:1) = lbound(InData%MGDepths) + UB(1:1) = ubound(InData%MGDepths) + do i1 = LB(1), UB(1) + call Morison_PackMGDepthsType(Buf, InData%MGDepths(i1)) + end do + end if + call RegPack(Buf, InData%MGTop) + call RegPack(Buf, InData%MGBottom) + call RegPack(Buf, InData%NMOutputs) + call RegPack(Buf, allocated(InData%MOutLst)) + if (allocated(InData%MOutLst)) then + call RegPackBounds(Buf, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) + LB(1:1) = lbound(InData%MOutLst) + UB(1:1) = ubound(InData%MOutLst) + do i1 = LB(1), UB(1) + call Morison_PackMOutput(Buf, InData%MOutLst(i1)) + end do + end if + call RegPack(Buf, InData%NJOutputs) + call RegPack(Buf, allocated(InData%JOutLst)) + if (allocated(InData%JOutLst)) then + call RegPackBounds(Buf, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) + LB(1:1) = lbound(InData%JOutLst) + UB(1:1) = ubound(InData%JOutLst) + do i1 = LB(1), UB(1) + call Morison_PackJOutput(Buf, InData%JOutLst(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%UnSum) + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, InData%WaveStMod) + call RegPack(Buf, InData%MCFD) + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackInitInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDisp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AMMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NJoints) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NNodes) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%InpJoints)) deallocate(OutData%InpJoints) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InpJoints(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpJoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackJointType(Buf, OutData%InpJoints(i1)) ! InpJoints + end do + end if + if (allocated(OutData%Nodes)) deallocate(OutData%Nodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackNodeType(Buf, OutData%Nodes(i1)) ! Nodes + end do + end if + call RegUnpack(Buf, OutData%NAxCoefs) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AxialCoefs)) deallocate(OutData%AxialCoefs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxialCoefs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxialCoefs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackAxialCoefType(Buf, OutData%AxialCoefs(i1)) ! AxialCoefs + end do + end if + call RegUnpack(Buf, OutData%NPropSets) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%MPropSets)) deallocate(OutData%MPropSets) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MPropSets(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MPropSets.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMemberPropType(Buf, OutData%MPropSets(i1)) ! MPropSets + end do + end if + call RegUnpack(Buf, OutData%SimplCd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimplCdMG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimplCa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimplCaMG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimplCp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimplCpMG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimplAxCd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimplAxCdMG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimplAxCa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimplAxCaMG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimplAxCp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimplAxCpMG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimplCb) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimplCbMg) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimplMCF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NCoefDpth) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%CoefDpths)) deallocate(OutData%CoefDpths) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CoefDpths(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefDpths.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackCoefDpths(Buf, OutData%CoefDpths(i1)) ! CoefDpths + end do + end if + call RegUnpack(Buf, OutData%NCoefMembers) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%CoefMembers)) deallocate(OutData%CoefMembers) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CoefMembers(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefMembers.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackCoefMembers(Buf, OutData%CoefMembers(i1)) ! CoefMembers + end do + end if + call RegUnpack(Buf, OutData%NMembers) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%InpMembers)) deallocate(OutData%InpMembers) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InpMembers(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpMembers.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMemberInputType(Buf, OutData%InpMembers(i1)) ! InpMembers + end do + end if + call RegUnpack(Buf, OutData%NFillGroups) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%FilledGroups)) deallocate(OutData%FilledGroups) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FilledGroups(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FilledGroups.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackFilledGroupType(Buf, OutData%FilledGroups(i1)) ! FilledGroups + end do + end if + call RegUnpack(Buf, OutData%NMGDepths) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%MGDepths)) deallocate(OutData%MGDepths) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MGDepths(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MGDepths.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMGDepthsType(Buf, OutData%MGDepths(i1)) ! MGDepths + end do + end if + call RegUnpack(Buf, OutData%MGTop) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MGBottom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NMOutputs) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%MOutLst)) deallocate(OutData%MOutLst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MOutLst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MOutLst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMOutput(Buf, OutData%MOutLst(i1)) ! MOutLst + end do + end if + call RegUnpack(Buf, OutData%NJOutputs) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%JOutLst)) deallocate(OutData%JOutLst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%JOutLst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackJOutput(Buf, OutData%JOutLst(i1)) ! JOutLst + end do + end if + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnSum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MCFD) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if +end subroutine + +subroutine Morison_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_InitOutputType), intent(in) :: SrcInitOutputData + type(Morison_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine Morison_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Morison_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine + +subroutine Morison_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine Morison_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(Morison_ContinuousStateType), intent(in) :: SrcContStateData + type(Morison_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine + +subroutine Morison_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(Morison_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Morison_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(Morison_DiscreteStateType), intent(in) :: SrcDiscStateData + type(Morison_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDiscStateData%V_rel_n_FiltStat)) then + LB(1:1) = lbound(SrcDiscStateData%V_rel_n_FiltStat) + UB(1:1) = ubound(SrcDiscStateData%V_rel_n_FiltStat) + if (.not. allocated(DstDiscStateData%V_rel_n_FiltStat)) then + allocate(DstDiscStateData%V_rel_n_FiltStat(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%V_rel_n_FiltStat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%V_rel_n_FiltStat = SrcDiscStateData%V_rel_n_FiltStat + end if +end subroutine + +subroutine Morison_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(Morison_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%V_rel_n_FiltStat)) then + deallocate(DiscStateData%V_rel_n_FiltStat) + end if +end subroutine + +subroutine Morison_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%V_rel_n_FiltStat)) + if (allocated(InData%V_rel_n_FiltStat)) then + call RegPackBounds(Buf, 1, lbound(InData%V_rel_n_FiltStat), ubound(InData%V_rel_n_FiltStat)) + call RegPack(Buf, InData%V_rel_n_FiltStat) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackDiscState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%V_rel_n_FiltStat)) deallocate(OutData%V_rel_n_FiltStat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V_rel_n_FiltStat(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n_FiltStat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V_rel_n_FiltStat) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine Morison_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(Morison_ConstraintStateType), intent(in) :: SrcConstrStateData + type(Morison_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine Morison_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(Morison_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Morison_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(Morison_OtherStateType), intent(in) :: SrcOtherStateData + type(Morison_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +subroutine Morison_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(Morison_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Morison_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MiscVarType), intent(in) :: SrcMiscData + type(Morison_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%DispNodePosHdn)) then + LB(1:2) = lbound(SrcMiscData%DispNodePosHdn) + UB(1:2) = ubound(SrcMiscData%DispNodePosHdn) + if (.not. allocated(DstMiscData%DispNodePosHdn)) then + allocate(DstMiscData%DispNodePosHdn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DispNodePosHdn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DispNodePosHdn = SrcMiscData%DispNodePosHdn + end if + if (allocated(SrcMiscData%DispNodePosHst)) then + LB(1:2) = lbound(SrcMiscData%DispNodePosHst) + UB(1:2) = ubound(SrcMiscData%DispNodePosHst) + if (.not. allocated(DstMiscData%DispNodePosHst)) then + allocate(DstMiscData%DispNodePosHst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DispNodePosHst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DispNodePosHst = SrcMiscData%DispNodePosHst + end if + if (allocated(SrcMiscData%FV)) then + LB(1:2) = lbound(SrcMiscData%FV) + UB(1:2) = ubound(SrcMiscData%FV) + if (.not. allocated(DstMiscData%FV)) then + allocate(DstMiscData%FV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FV = SrcMiscData%FV + end if + if (allocated(SrcMiscData%FA)) then + LB(1:2) = lbound(SrcMiscData%FA) + UB(1:2) = ubound(SrcMiscData%FA) + if (.not. allocated(DstMiscData%FA)) then + allocate(DstMiscData%FA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FA = SrcMiscData%FA + end if + if (allocated(SrcMiscData%FAMCF)) then + LB(1:2) = lbound(SrcMiscData%FAMCF) + UB(1:2) = ubound(SrcMiscData%FAMCF) + if (.not. allocated(DstMiscData%FAMCF)) then + allocate(DstMiscData%FAMCF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAMCF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FAMCF = SrcMiscData%FAMCF + end if + if (allocated(SrcMiscData%FDynP)) then + LB(1:1) = lbound(SrcMiscData%FDynP) + UB(1:1) = ubound(SrcMiscData%FDynP) + if (.not. allocated(DstMiscData%FDynP)) then + allocate(DstMiscData%FDynP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FDynP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FDynP = SrcMiscData%FDynP + end if + if (allocated(SrcMiscData%WaveElev)) then + LB(1:1) = lbound(SrcMiscData%WaveElev) + UB(1:1) = ubound(SrcMiscData%WaveElev) + if (.not. allocated(DstMiscData%WaveElev)) then + allocate(DstMiscData%WaveElev(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WaveElev = SrcMiscData%WaveElev + end if + if (allocated(SrcMiscData%WaveElev1)) then + LB(1:1) = lbound(SrcMiscData%WaveElev1) + UB(1:1) = ubound(SrcMiscData%WaveElev1) + if (.not. allocated(DstMiscData%WaveElev1)) then + allocate(DstMiscData%WaveElev1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WaveElev1 = SrcMiscData%WaveElev1 + end if + if (allocated(SrcMiscData%WaveElev2)) then + LB(1:1) = lbound(SrcMiscData%WaveElev2) + UB(1:1) = ubound(SrcMiscData%WaveElev2) + if (.not. allocated(DstMiscData%WaveElev2)) then + allocate(DstMiscData%WaveElev2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WaveElev2 = SrcMiscData%WaveElev2 + end if + if (allocated(SrcMiscData%vrel)) then + LB(1:2) = lbound(SrcMiscData%vrel) + UB(1:2) = ubound(SrcMiscData%vrel) + if (.not. allocated(DstMiscData%vrel)) then + allocate(DstMiscData%vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vrel = SrcMiscData%vrel + end if + if (allocated(SrcMiscData%nodeInWater)) then + LB(1:1) = lbound(SrcMiscData%nodeInWater) + UB(1:1) = ubound(SrcMiscData%nodeInWater) + if (.not. allocated(DstMiscData%nodeInWater)) then + allocate(DstMiscData%nodeInWater(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nodeInWater.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%nodeInWater = SrcMiscData%nodeInWater + end if + if (allocated(SrcMiscData%memberLoads)) then + LB(1:1) = lbound(SrcMiscData%memberLoads) + UB(1:1) = ubound(SrcMiscData%memberLoads) + if (.not. allocated(DstMiscData%memberLoads)) then + allocate(DstMiscData%memberLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%memberLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMemberLoads(SrcMiscData%memberLoads(i1), DstMiscData%memberLoads(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%F_B_End)) then + LB(1:2) = lbound(SrcMiscData%F_B_End) + UB(1:2) = ubound(SrcMiscData%F_B_End) + if (.not. allocated(DstMiscData%F_B_End)) then + allocate(DstMiscData%F_B_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_B_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_B_End = SrcMiscData%F_B_End + end if + if (allocated(SrcMiscData%F_D_End)) then + LB(1:2) = lbound(SrcMiscData%F_D_End) + UB(1:2) = ubound(SrcMiscData%F_D_End) + if (.not. allocated(DstMiscData%F_D_End)) then + allocate(DstMiscData%F_D_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_D_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_D_End = SrcMiscData%F_D_End + end if + if (allocated(SrcMiscData%F_I_End)) then + LB(1:2) = lbound(SrcMiscData%F_I_End) + UB(1:2) = ubound(SrcMiscData%F_I_End) + if (.not. allocated(DstMiscData%F_I_End)) then + allocate(DstMiscData%F_I_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_I_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_I_End = SrcMiscData%F_I_End + end if + if (allocated(SrcMiscData%F_IMG_End)) then + LB(1:2) = lbound(SrcMiscData%F_IMG_End) + UB(1:2) = ubound(SrcMiscData%F_IMG_End) + if (.not. allocated(DstMiscData%F_IMG_End)) then + allocate(DstMiscData%F_IMG_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_IMG_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_IMG_End = SrcMiscData%F_IMG_End + end if + if (allocated(SrcMiscData%F_A_End)) then + LB(1:2) = lbound(SrcMiscData%F_A_End) + UB(1:2) = ubound(SrcMiscData%F_A_End) + if (.not. allocated(DstMiscData%F_A_End)) then + allocate(DstMiscData%F_A_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_A_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_A_End = SrcMiscData%F_A_End + end if + if (allocated(SrcMiscData%F_BF_End)) then + LB(1:2) = lbound(SrcMiscData%F_BF_End) + UB(1:2) = ubound(SrcMiscData%F_BF_End) + if (.not. allocated(DstMiscData%F_BF_End)) then + allocate(DstMiscData%F_BF_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_BF_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_BF_End = SrcMiscData%F_BF_End + end if + if (allocated(SrcMiscData%V_rel_n)) then + LB(1:1) = lbound(SrcMiscData%V_rel_n) + UB(1:1) = ubound(SrcMiscData%V_rel_n) + if (.not. allocated(DstMiscData%V_rel_n)) then + allocate(DstMiscData%V_rel_n(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%V_rel_n.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%V_rel_n = SrcMiscData%V_rel_n + end if + if (allocated(SrcMiscData%V_rel_n_HiPass)) then + LB(1:1) = lbound(SrcMiscData%V_rel_n_HiPass) + UB(1:1) = ubound(SrcMiscData%V_rel_n_HiPass) + if (.not. allocated(DstMiscData%V_rel_n_HiPass)) then + allocate(DstMiscData%V_rel_n_HiPass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%V_rel_n_HiPass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%V_rel_n_HiPass = SrcMiscData%V_rel_n_HiPass + end if + DstMiscData%LastIndWave = SrcMiscData%LastIndWave +end subroutine + +subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Morison_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%DispNodePosHdn)) then + deallocate(MiscData%DispNodePosHdn) + end if + if (allocated(MiscData%DispNodePosHst)) then + deallocate(MiscData%DispNodePosHst) + end if + if (allocated(MiscData%FV)) then + deallocate(MiscData%FV) + end if + if (allocated(MiscData%FA)) then + deallocate(MiscData%FA) + end if + if (allocated(MiscData%FAMCF)) then + deallocate(MiscData%FAMCF) + end if + if (allocated(MiscData%FDynP)) then + deallocate(MiscData%FDynP) + end if + if (allocated(MiscData%WaveElev)) then + deallocate(MiscData%WaveElev) + end if + if (allocated(MiscData%WaveElev1)) then + deallocate(MiscData%WaveElev1) + end if + if (allocated(MiscData%WaveElev2)) then + deallocate(MiscData%WaveElev2) + end if + if (allocated(MiscData%vrel)) then + deallocate(MiscData%vrel) + end if + if (allocated(MiscData%nodeInWater)) then + deallocate(MiscData%nodeInWater) + end if + if (allocated(MiscData%memberLoads)) then + LB(1:1) = lbound(MiscData%memberLoads) + UB(1:1) = ubound(MiscData%memberLoads) + do i1 = LB(1), UB(1) + call Morison_DestroyMemberLoads(MiscData%memberLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%memberLoads) + end if + if (allocated(MiscData%F_B_End)) then + deallocate(MiscData%F_B_End) + end if + if (allocated(MiscData%F_D_End)) then + deallocate(MiscData%F_D_End) + end if + if (allocated(MiscData%F_I_End)) then + deallocate(MiscData%F_I_End) + end if + if (allocated(MiscData%F_IMG_End)) then + deallocate(MiscData%F_IMG_End) + end if + if (allocated(MiscData%F_A_End)) then + deallocate(MiscData%F_A_End) + end if + if (allocated(MiscData%F_BF_End)) then + deallocate(MiscData%F_BF_End) + end if + if (allocated(MiscData%V_rel_n)) then + deallocate(MiscData%V_rel_n) + end if + if (allocated(MiscData%V_rel_n_HiPass)) then + deallocate(MiscData%V_rel_n_HiPass) + end if +end subroutine + +subroutine Morison_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%DispNodePosHdn)) + if (allocated(InData%DispNodePosHdn)) then + call RegPackBounds(Buf, 2, lbound(InData%DispNodePosHdn), ubound(InData%DispNodePosHdn)) + call RegPack(Buf, InData%DispNodePosHdn) + end if + call RegPack(Buf, allocated(InData%DispNodePosHst)) + if (allocated(InData%DispNodePosHst)) then + call RegPackBounds(Buf, 2, lbound(InData%DispNodePosHst), ubound(InData%DispNodePosHst)) + call RegPack(Buf, InData%DispNodePosHst) + end if + call RegPack(Buf, allocated(InData%FV)) + if (allocated(InData%FV)) then + call RegPackBounds(Buf, 2, lbound(InData%FV), ubound(InData%FV)) + call RegPack(Buf, InData%FV) + end if + call RegPack(Buf, allocated(InData%FA)) + if (allocated(InData%FA)) then + call RegPackBounds(Buf, 2, lbound(InData%FA), ubound(InData%FA)) + call RegPack(Buf, InData%FA) + end if + call RegPack(Buf, allocated(InData%FAMCF)) + if (allocated(InData%FAMCF)) then + call RegPackBounds(Buf, 2, lbound(InData%FAMCF), ubound(InData%FAMCF)) + call RegPack(Buf, InData%FAMCF) + end if + call RegPack(Buf, allocated(InData%FDynP)) + if (allocated(InData%FDynP)) then + call RegPackBounds(Buf, 1, lbound(InData%FDynP), ubound(InData%FDynP)) + call RegPack(Buf, InData%FDynP) + end if + call RegPack(Buf, allocated(InData%WaveElev)) + if (allocated(InData%WaveElev)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev), ubound(InData%WaveElev)) + call RegPack(Buf, InData%WaveElev) + end if + call RegPack(Buf, allocated(InData%WaveElev1)) + if (allocated(InData%WaveElev1)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPack(Buf, InData%WaveElev1) + end if + call RegPack(Buf, allocated(InData%WaveElev2)) + if (allocated(InData%WaveElev2)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) + call RegPack(Buf, InData%WaveElev2) + end if + call RegPack(Buf, allocated(InData%vrel)) + if (allocated(InData%vrel)) then + call RegPackBounds(Buf, 2, lbound(InData%vrel), ubound(InData%vrel)) + call RegPack(Buf, InData%vrel) + end if + call RegPack(Buf, allocated(InData%nodeInWater)) + if (allocated(InData%nodeInWater)) then + call RegPackBounds(Buf, 1, lbound(InData%nodeInWater), ubound(InData%nodeInWater)) + call RegPack(Buf, InData%nodeInWater) + end if + call RegPack(Buf, allocated(InData%memberLoads)) + if (allocated(InData%memberLoads)) then + call RegPackBounds(Buf, 1, lbound(InData%memberLoads), ubound(InData%memberLoads)) + LB(1:1) = lbound(InData%memberLoads) + UB(1:1) = ubound(InData%memberLoads) + do i1 = LB(1), UB(1) + call Morison_PackMemberLoads(Buf, InData%memberLoads(i1)) + end do + end if + call RegPack(Buf, allocated(InData%F_B_End)) + if (allocated(InData%F_B_End)) then + call RegPackBounds(Buf, 2, lbound(InData%F_B_End), ubound(InData%F_B_End)) + call RegPack(Buf, InData%F_B_End) + end if + call RegPack(Buf, allocated(InData%F_D_End)) + if (allocated(InData%F_D_End)) then + call RegPackBounds(Buf, 2, lbound(InData%F_D_End), ubound(InData%F_D_End)) + call RegPack(Buf, InData%F_D_End) + end if + call RegPack(Buf, allocated(InData%F_I_End)) + if (allocated(InData%F_I_End)) then + call RegPackBounds(Buf, 2, lbound(InData%F_I_End), ubound(InData%F_I_End)) + call RegPack(Buf, InData%F_I_End) + end if + call RegPack(Buf, allocated(InData%F_IMG_End)) + if (allocated(InData%F_IMG_End)) then + call RegPackBounds(Buf, 2, lbound(InData%F_IMG_End), ubound(InData%F_IMG_End)) + call RegPack(Buf, InData%F_IMG_End) + end if + call RegPack(Buf, allocated(InData%F_A_End)) + if (allocated(InData%F_A_End)) then + call RegPackBounds(Buf, 2, lbound(InData%F_A_End), ubound(InData%F_A_End)) + call RegPack(Buf, InData%F_A_End) + end if + call RegPack(Buf, allocated(InData%F_BF_End)) + if (allocated(InData%F_BF_End)) then + call RegPackBounds(Buf, 2, lbound(InData%F_BF_End), ubound(InData%F_BF_End)) + call RegPack(Buf, InData%F_BF_End) + end if + call RegPack(Buf, allocated(InData%V_rel_n)) + if (allocated(InData%V_rel_n)) then + call RegPackBounds(Buf, 1, lbound(InData%V_rel_n), ubound(InData%V_rel_n)) + call RegPack(Buf, InData%V_rel_n) + end if + call RegPack(Buf, allocated(InData%V_rel_n_HiPass)) + if (allocated(InData%V_rel_n_HiPass)) then + call RegPackBounds(Buf, 1, lbound(InData%V_rel_n_HiPass), ubound(InData%V_rel_n_HiPass)) + call RegPack(Buf, InData%V_rel_n_HiPass) + end if + call RegPack(Buf, InData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%DispNodePosHdn)) deallocate(OutData%DispNodePosHdn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DispNodePosHdn(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DispNodePosHdn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DispNodePosHdn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DispNodePosHst)) deallocate(OutData%DispNodePosHst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DispNodePosHst(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DispNodePosHst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DispNodePosHst) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FV)) deallocate(OutData%FV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FV(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FV) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FA)) deallocate(OutData%FA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FA(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FA) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FAMCF)) deallocate(OutData%FAMCF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FAMCF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAMCF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FAMCF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FDynP)) deallocate(OutData%FDynP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FDynP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FDynP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveElev)) deallocate(OutData%WaveElev) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%vrel)) deallocate(OutData%vrel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vrel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vrel) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%nodeInWater)) deallocate(OutData%nodeInWater) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%nodeInWater(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%nodeInWater) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%memberLoads)) deallocate(OutData%memberLoads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%memberLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%memberLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMemberLoads(Buf, OutData%memberLoads(i1)) ! memberLoads + end do + end if + if (allocated(OutData%F_B_End)) deallocate(OutData%F_B_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_B_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_B_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_B_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_D_End)) deallocate(OutData%F_D_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_D_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_D_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_D_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_I_End)) deallocate(OutData%F_I_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_I_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_I_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_I_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_IMG_End)) deallocate(OutData%F_IMG_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_IMG_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_IMG_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_IMG_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_A_End)) deallocate(OutData%F_A_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_A_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_A_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_A_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_BF_End)) deallocate(OutData%F_BF_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_BF_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_BF_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_BF_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%V_rel_n)) deallocate(OutData%V_rel_n) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V_rel_n(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V_rel_n) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%V_rel_n_HiPass)) deallocate(OutData%V_rel_n_HiPass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V_rel_n_HiPass(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n_HiPass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V_rel_n_HiPass) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Morison_ParameterType), intent(in) :: SrcParamData + type(Morison_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%Gravity = SrcParamData%Gravity + DstParamData%WtrDens = SrcParamData%WtrDens + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%MSL2SWL = SrcParamData%MSL2SWL + DstParamData%WaveDisp = SrcParamData%WaveDisp + DstParamData%AMMod = SrcParamData%AMMod + DstParamData%NMembers = SrcParamData%NMembers + if (allocated(SrcParamData%Members)) then + LB(1:1) = lbound(SrcParamData%Members) + UB(1:1) = ubound(SrcParamData%Members) + if (.not. allocated(DstParamData%Members)) then + allocate(DstParamData%Members(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Members.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMemberType(SrcParamData%Members(i1), DstParamData%Members(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%NNodes = SrcParamData%NNodes + DstParamData%NJoints = SrcParamData%NJoints + if (allocated(SrcParamData%I_MG_End)) then + LB(1:3) = lbound(SrcParamData%I_MG_End) + UB(1:3) = ubound(SrcParamData%I_MG_End) + if (.not. allocated(DstParamData%I_MG_End)) then + allocate(DstParamData%I_MG_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%I_MG_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%I_MG_End = SrcParamData%I_MG_End + end if + if (allocated(SrcParamData%An_End)) then + LB(1:2) = lbound(SrcParamData%An_End) + UB(1:2) = ubound(SrcParamData%An_End) + if (.not. allocated(DstParamData%An_End)) then + allocate(DstParamData%An_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%An_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%An_End = SrcParamData%An_End + end if + if (allocated(SrcParamData%DragConst_End)) then + LB(1:1) = lbound(SrcParamData%DragConst_End) + UB(1:1) = ubound(SrcParamData%DragConst_End) + if (.not. allocated(DstParamData%DragConst_End)) then + allocate(DstParamData%DragConst_End(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragConst_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DragConst_End = SrcParamData%DragConst_End + end if + if (allocated(SrcParamData%VRelNFiltConst)) then + LB(1:1) = lbound(SrcParamData%VRelNFiltConst) + UB(1:1) = ubound(SrcParamData%VRelNFiltConst) + if (.not. allocated(DstParamData%VRelNFiltConst)) then + allocate(DstParamData%VRelNFiltConst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%VRelNFiltConst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%VRelNFiltConst = SrcParamData%VRelNFiltConst + end if + if (allocated(SrcParamData%DragMod_End)) then + LB(1:1) = lbound(SrcParamData%DragMod_End) + UB(1:1) = ubound(SrcParamData%DragMod_End) + if (.not. allocated(DstParamData%DragMod_End)) then + allocate(DstParamData%DragMod_End(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragMod_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DragMod_End = SrcParamData%DragMod_End + end if + if (allocated(SrcParamData%DragLoFSc_End)) then + LB(1:1) = lbound(SrcParamData%DragLoFSc_End) + UB(1:1) = ubound(SrcParamData%DragLoFSc_End) + if (.not. allocated(DstParamData%DragLoFSc_End)) then + allocate(DstParamData%DragLoFSc_End(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragLoFSc_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DragLoFSc_End = SrcParamData%DragLoFSc_End + end if + if (allocated(SrcParamData%F_WMG_End)) then + LB(1:2) = lbound(SrcParamData%F_WMG_End) + UB(1:2) = ubound(SrcParamData%F_WMG_End) + if (.not. allocated(DstParamData%F_WMG_End)) then + allocate(DstParamData%F_WMG_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_WMG_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%F_WMG_End = SrcParamData%F_WMG_End + end if + if (allocated(SrcParamData%DP_Const_End)) then + LB(1:2) = lbound(SrcParamData%DP_Const_End) + UB(1:2) = ubound(SrcParamData%DP_Const_End) + if (.not. allocated(DstParamData%DP_Const_End)) then + allocate(DstParamData%DP_Const_End(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%Mass_MG_End)) then + LB(1:1) = lbound(SrcParamData%Mass_MG_End) + UB(1:1) = ubound(SrcParamData%Mass_MG_End) + if (.not. allocated(DstParamData%Mass_MG_End)) then + allocate(DstParamData%Mass_MG_End(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%AM_End)) then + LB(1:3) = lbound(SrcParamData%AM_End) + UB(1:3) = ubound(SrcParamData%AM_End) + if (.not. allocated(DstParamData%AM_End)) then + allocate(DstParamData%AM_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), 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 + end if + DstParamData%NStepWave = SrcParamData%NStepWave + DstParamData%NMOutputs = SrcParamData%NMOutputs + if (allocated(SrcParamData%MOutLst)) then + LB(1:1) = lbound(SrcParamData%MOutLst) + UB(1:1) = ubound(SrcParamData%MOutLst) + if (.not. allocated(DstParamData%MOutLst)) then + allocate(DstParamData%MOutLst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MOutLst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMOutput(SrcParamData%MOutLst(i1), DstParamData%MOutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%NJOutputs = SrcParamData%NJOutputs + if (allocated(SrcParamData%JOutLst)) then + LB(1:1) = lbound(SrcParamData%JOutLst) + UB(1:1) = ubound(SrcParamData%JOutLst) + if (.not. allocated(DstParamData%JOutLst)) then + allocate(DstParamData%JOutLst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%JOutLst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyJOutput(SrcParamData%JOutLst(i1), DstParamData%JOutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%WaveStMod = SrcParamData%WaveStMod + DstParamData%WaveField => SrcParamData%WaveField +end subroutine + +subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Morison_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%Members)) then + LB(1:1) = lbound(ParamData%Members) + UB(1:1) = ubound(ParamData%Members) + do i1 = LB(1), UB(1) + call Morison_DestroyMemberType(ParamData%Members(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%Members) + end if + if (allocated(ParamData%I_MG_End)) then + deallocate(ParamData%I_MG_End) + end if + if (allocated(ParamData%An_End)) then + deallocate(ParamData%An_End) + end if + if (allocated(ParamData%DragConst_End)) then + deallocate(ParamData%DragConst_End) + end if + if (allocated(ParamData%VRelNFiltConst)) then + deallocate(ParamData%VRelNFiltConst) + end if + if (allocated(ParamData%DragMod_End)) then + deallocate(ParamData%DragMod_End) + end if + if (allocated(ParamData%DragLoFSc_End)) then + deallocate(ParamData%DragLoFSc_End) + end if + if (allocated(ParamData%F_WMG_End)) then + deallocate(ParamData%F_WMG_End) + end if + if (allocated(ParamData%DP_Const_End)) then + deallocate(ParamData%DP_Const_End) + end if + if (allocated(ParamData%Mass_MG_End)) then + deallocate(ParamData%Mass_MG_End) + end if + if (allocated(ParamData%AM_End)) then + deallocate(ParamData%AM_End) + end if + if (allocated(ParamData%MOutLst)) then + LB(1:1) = lbound(ParamData%MOutLst) + UB(1:1) = ubound(ParamData%MOutLst) + do i1 = LB(1), UB(1) + call Morison_DestroyMOutput(ParamData%MOutLst(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%MOutLst) + end if + if (allocated(ParamData%JOutLst)) then + LB(1:1) = lbound(ParamData%JOutLst) + UB(1:1) = ubound(ParamData%JOutLst) + do i1 = LB(1), UB(1) + call Morison_DestroyJOutput(ParamData%JOutLst(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%JOutLst) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + nullify(ParamData%WaveField) +end subroutine + +subroutine Morison_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%WtrDens) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%MSL2SWL) + call RegPack(Buf, InData%WaveDisp) + call RegPack(Buf, InData%AMMod) + call RegPack(Buf, InData%NMembers) + call RegPack(Buf, allocated(InData%Members)) + if (allocated(InData%Members)) then + call RegPackBounds(Buf, 1, lbound(InData%Members), ubound(InData%Members)) + LB(1:1) = lbound(InData%Members) + UB(1:1) = ubound(InData%Members) + do i1 = LB(1), UB(1) + call Morison_PackMemberType(Buf, InData%Members(i1)) + end do + end if + call RegPack(Buf, InData%NNodes) + call RegPack(Buf, InData%NJoints) + call RegPack(Buf, allocated(InData%I_MG_End)) + if (allocated(InData%I_MG_End)) then + call RegPackBounds(Buf, 3, lbound(InData%I_MG_End), ubound(InData%I_MG_End)) + call RegPack(Buf, InData%I_MG_End) + end if + call RegPack(Buf, allocated(InData%An_End)) + if (allocated(InData%An_End)) then + call RegPackBounds(Buf, 2, lbound(InData%An_End), ubound(InData%An_End)) + call RegPack(Buf, InData%An_End) + end if + call RegPack(Buf, allocated(InData%DragConst_End)) + if (allocated(InData%DragConst_End)) then + call RegPackBounds(Buf, 1, lbound(InData%DragConst_End), ubound(InData%DragConst_End)) + call RegPack(Buf, InData%DragConst_End) + end if + call RegPack(Buf, allocated(InData%VRelNFiltConst)) + if (allocated(InData%VRelNFiltConst)) then + call RegPackBounds(Buf, 1, lbound(InData%VRelNFiltConst), ubound(InData%VRelNFiltConst)) + call RegPack(Buf, InData%VRelNFiltConst) + end if + call RegPack(Buf, allocated(InData%DragMod_End)) + if (allocated(InData%DragMod_End)) then + call RegPackBounds(Buf, 1, lbound(InData%DragMod_End), ubound(InData%DragMod_End)) + call RegPack(Buf, InData%DragMod_End) + end if + call RegPack(Buf, allocated(InData%DragLoFSc_End)) + if (allocated(InData%DragLoFSc_End)) then + call RegPackBounds(Buf, 1, lbound(InData%DragLoFSc_End), ubound(InData%DragLoFSc_End)) + call RegPack(Buf, InData%DragLoFSc_End) + end if + call RegPack(Buf, allocated(InData%F_WMG_End)) + if (allocated(InData%F_WMG_End)) then + call RegPackBounds(Buf, 2, lbound(InData%F_WMG_End), ubound(InData%F_WMG_End)) + call RegPack(Buf, InData%F_WMG_End) + end if + call RegPack(Buf, allocated(InData%DP_Const_End)) + if (allocated(InData%DP_Const_End)) then + call RegPackBounds(Buf, 2, lbound(InData%DP_Const_End), ubound(InData%DP_Const_End)) + call RegPack(Buf, InData%DP_Const_End) + end if + call RegPack(Buf, allocated(InData%Mass_MG_End)) + if (allocated(InData%Mass_MG_End)) then + call RegPackBounds(Buf, 1, lbound(InData%Mass_MG_End), ubound(InData%Mass_MG_End)) + call RegPack(Buf, InData%Mass_MG_End) + end if + call RegPack(Buf, allocated(InData%AM_End)) + if (allocated(InData%AM_End)) then + call RegPackBounds(Buf, 3, lbound(InData%AM_End), ubound(InData%AM_End)) + call RegPack(Buf, InData%AM_End) + end if + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, InData%NMOutputs) + call RegPack(Buf, allocated(InData%MOutLst)) + if (allocated(InData%MOutLst)) then + call RegPackBounds(Buf, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) + LB(1:1) = lbound(InData%MOutLst) + UB(1:1) = ubound(InData%MOutLst) + do i1 = LB(1), UB(1) + call Morison_PackMOutput(Buf, InData%MOutLst(i1)) + end do + end if + call RegPack(Buf, InData%NJOutputs) + call RegPack(Buf, allocated(InData%JOutLst)) + if (allocated(InData%JOutLst)) then + call RegPackBounds(Buf, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) + LB(1:1) = lbound(InData%JOutLst) + UB(1:1) = ubound(InData%JOutLst) + do i1 = LB(1), UB(1) + call Morison_PackJOutput(Buf, InData%JOutLst(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%WaveStMod) + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDisp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AMMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NMembers) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Members)) deallocate(OutData%Members) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Members(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMemberType(Buf, OutData%Members(i1)) ! Members + end do + end if + call RegUnpack(Buf, OutData%NNodes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NJoints) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%I_MG_End)) deallocate(OutData%I_MG_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_MG_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_MG_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_MG_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%An_End)) deallocate(OutData%An_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%An_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%An_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%An_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DragConst_End)) deallocate(OutData%DragConst_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DragConst_End(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragConst_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DragConst_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%VRelNFiltConst)) deallocate(OutData%VRelNFiltConst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VRelNFiltConst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VRelNFiltConst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VRelNFiltConst) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DragMod_End)) deallocate(OutData%DragMod_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DragMod_End(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragMod_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DragMod_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DragLoFSc_End)) deallocate(OutData%DragLoFSc_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DragLoFSc_End(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragLoFSc_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DragLoFSc_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_WMG_End)) deallocate(OutData%F_WMG_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_WMG_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_WMG_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_WMG_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DP_Const_End)) deallocate(OutData%DP_Const_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DP_Const_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DP_Const_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DP_Const_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Mass_MG_End)) deallocate(OutData%Mass_MG_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mass_MG_End(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass_MG_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Mass_MG_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AM_End)) deallocate(OutData%AM_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AM_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AM_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NMOutputs) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%MOutLst)) deallocate(OutData%MOutLst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MOutLst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MOutLst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMOutput(Buf, OutData%MOutLst(i1)) ! MOutLst + end do + end if + call RegUnpack(Buf, OutData%NJOutputs) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%JOutLst)) deallocate(OutData%JOutLst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%JOutLst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackJOutput(Buf, OutData%JOutLst(i1)) ! JOutLst + end do + end if + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if +end subroutine + +subroutine Morison_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_InputType), intent(inout) :: SrcInputData + type(Morison_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%Mesh, DstInputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine Morison_DestroyInput(InputData, ErrStat, ErrMsg) + type(Morison_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Morison_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%Mesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%Mesh) ! Mesh +end subroutine + +subroutine Morison_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_OutputType), intent(inout) :: SrcOutputData + type(Morison_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine Morison_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(Morison_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine Morison_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%Mesh) + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%Mesh) ! Mesh + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine Morison_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(Morison_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(Morison_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 = 'Morison_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 Morison_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Morison_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 Morison_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 Morison_Input_ExtrapInterp - - - SUBROUTINE Morison_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call Morison_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Morison_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Morison_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE Morison_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. @@ -12387,41 +6209,42 @@ SUBROUTINE Morison_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(Morison_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(Morison_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Morison_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 + TYPE(Morison_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(Morison_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(Morison_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 = 'Morison_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE Morison_Input_ExtrapInterp1 - - - SUBROUTINE Morison_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE Morison_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. @@ -12435,101 +6258,102 @@ SUBROUTINE Morison_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(Morison_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(Morison_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(Morison_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Morison_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 + TYPE(Morison_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(Morison_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(Morison_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(Morison_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 = 'Morison_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Morison_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE Morison_Input_ExtrapInterp2 - - - SUBROUTINE Morison_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(Morison_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Morison_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine Morison_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(Morison_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(Morison_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 = 'Morison_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 Morison_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Morison_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 Morison_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 Morison_Output_ExtrapInterp - - - SUBROUTINE Morison_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call Morison_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Morison_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Morison_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE Morison_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. @@ -12541,49 +6365,47 @@ SUBROUTINE Morison_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(Morison_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(Morison_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Morison_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 + TYPE(Morison_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(Morison_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(Morison_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 = 'Morison_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 Morison_Output_ExtrapInterp1 - - - SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE Morison_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. @@ -12597,56 +6419,52 @@ SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat ! !.................................................................................................................................. - TYPE(Morison_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(Morison_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(Morison_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Morison_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 + TYPE(Morison_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(Morison_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(Morison_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(Morison_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 = 'Morison_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Morison_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 Morison_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE Morison_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 9a98d197dc..84657838fe 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -37,10 +37,10 @@ MODULE SS_Excitation_Types ! ========= SS_Exc_InitInputType ======= TYPE, PUBLIC :: SS_Exc_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] - INTEGER(IntKi) :: NBody !< Number of WAMIT bodies for this State Space model [-] - INTEGER(IntKi) :: ExctnDisp !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] - REAL(ReKi) :: WaveDir !< Wave direction [rad] - INTEGER(IntKi) :: NStepWave !< Number of timesteps in the WaveTime array [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] + INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] + REAL(ReKi) :: WaveDir = 0.0_ReKi !< Wave direction [rad] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< 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(:), 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) [-] @@ -61,17 +61,17 @@ MODULE SS_Excitation_Types ! ======================= ! ========= SS_Exc_DiscreteStateType ======= TYPE, PUBLIC :: SS_Exc_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< [-] + REAL(SiKi) :: DummyDiscState = 0.0_R4Ki !< [-] END TYPE SS_Exc_DiscreteStateType ! ======================= ! ========= SS_Exc_ConstraintStateType ======= TYPE, PUBLIC :: SS_Exc_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< [-] END TYPE SS_Exc_ConstraintStateType ! ======================= ! ========= SS_Exc_OtherStateType ======= TYPE, PUBLIC :: SS_Exc_OtherStateType - INTEGER(IntKi) :: n !< Current Time step [-] + INTEGER(IntKi) :: n = 0_IntKi !< Current Time step [-] TYPE(SS_Exc_ContinuousStateType) , DIMENSION(1:4) :: xdot !< Old Values of dxdt to used by the solver (multistep method) [-] END TYPE SS_Exc_OtherStateType ! ======================= @@ -83,16 +83,16 @@ MODULE SS_Excitation_Types ! ======================= ! ========= SS_Exc_ParameterType ======= TYPE, PUBLIC :: SS_Exc_ParameterType - REAL(DbKi) :: DT !< Time step [s] - INTEGER(IntKi) :: NBody !< Number of WAMIT bodies for this State Space model [-] - INTEGER(IntKi) :: ExctnDisp !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] - INTEGER(IntKi) :: NStepWave !< Number of timesteps in the WaveTime array [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step [s] + INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] + INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of timesteps in the WaveTime array [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: spDOF !< States per DOF [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: A !< A matrix [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: B !< B matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C !< C matrix [-] INTEGER(IntKi) :: numStates = 0 !< Number of states [-] - REAL(DbKi) :: Tc !< Time shift [s] + REAL(DbKi) :: Tc = 0.0_R8Ki !< Time shift [s] 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] @@ -111,2428 +111,1150 @@ MODULE SS_Excitation_Types END TYPE SS_Exc_OutputType ! ======================= CONTAINS - SUBROUTINE SS_Exc_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SS_Exc_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%NBody = SrcInitInputData%NBody - DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%NStepWave = SrcInitInputData%NStepWave -IF (ALLOCATED(SrcInitInputData%PtfmRefztRot)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefztRot,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefztRot,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefztRot)) THEN - ALLOCATE(DstInitInputData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE SS_Exc_CopyInitInput - - SUBROUTINE SS_Exc_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SS_Exc_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 = 'SS_Exc_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%PtfmRefztRot)) THEN - DEALLOCATE(InitInputData%PtfmRefztRot) -ENDIF -NULLIFY(InitInputData%WaveElev0) -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 - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 ! NBody - Int_BufSz = Int_BufSz + 1 ! ExctnDisp - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! PtfmRefztRot allocated yes/no - 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 - ! 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 - 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 - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ExctnDisp - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmRefztRot) ) 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%PtfmRefztRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefztRot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefztRot,1), UBOUND(InData%PtfmRefztRot,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) - Db_Xferred = Db_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 - - 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 SS_Exc_PackInitInput - - SUBROUTINE SS_Exc_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(SS_Exc_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_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%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnDisp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefztRot 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%PtfmRefztRot)) DEALLOCATE(OutData%PtfmRefztRot) - ALLOCATE(OutData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefztRot,1), UBOUND(OutData%PtfmRefztRot,1) - OutData%PtfmRefztRot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - NULLIFY(OutData%WaveElev0) - NULLIFY(OutData%WaveElev1) - NULLIFY(OutData%WaveTime) - 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) - END SUBROUTINE SS_Exc_UnPackInitInput - - SUBROUTINE SS_Exc_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SS_Exc_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 = 'SS_Exc_CopyInitOutput' -! +subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_InitInputType), intent(in) :: SrcInitInputData + type(SS_Exc_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyInitInput' 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 - END SUBROUTINE SS_Exc_CopyInitOutput - - SUBROUTINE SS_Exc_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SS_Exc_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 = 'SS_Exc_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE SS_Exc_DestroyInitOutput - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 - 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 - END SUBROUTINE SS_Exc_PackInitOutput - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 - END SUBROUTINE SS_Exc_UnPackInitOutput - - SUBROUTINE SS_Exc_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SS_Exc_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyContState' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%NBody = SrcInitInputData%NBody + DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp + DstInitInputData%WaveDir = SrcInitInputData%WaveDir + DstInitInputData%NStepWave = SrcInitInputData%NStepWave + if (allocated(SrcInitInputData%PtfmRefztRot)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + if (.not. allocated(DstInitInputData%PtfmRefztRot)) then + allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot + end if + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine SS_Exc_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SS_Exc_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%x)) THEN - i1_l = LBOUND(SrcContStateData%x,1) - i1_u = UBOUND(SrcContStateData%x,1) - IF (.NOT. ALLOCATED(DstContStateData%x)) THEN - ALLOCATE(DstContStateData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%x = SrcContStateData%x -ENDIF - END SUBROUTINE SS_Exc_CopyContState - - SUBROUTINE SS_Exc_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(SS_Exc_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 = 'SS_Exc_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%x)) THEN - DEALLOCATE(ContStateData%x) -ENDIF - END SUBROUTINE SS_Exc_DestroyContState - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x) ! x - 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%x) ) 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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Exc_PackContState - - SUBROUTINE SS_Exc_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(SS_Exc_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x 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%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Exc_UnPackContState - - SUBROUTINE SS_Exc_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SS_Exc_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 = 'SS_Exc_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitInputData%PtfmRefztRot)) then + deallocate(InitInputData%PtfmRefztRot) + end if + nullify(InitInputData%WaveElev0) + 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 + +subroutine SS_Exc_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackInitInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%NBody) + call RegPack(Buf, InData%ExctnDisp) + call RegPack(Buf, InData%WaveDir) + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, allocated(InData%PtfmRefztRot)) + if (allocated(InData%PtfmRefztRot)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) + call RegPack(Buf, InData%PtfmRefztRot) + end if + call RegPack(Buf, associated(InData%WaveElev0)) + if (associated(InData%WaveElev0)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) + call RegPackPointer(Buf, c_loc(InData%WaveElev0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev0) + end if + end if + call RegPack(Buf, associated(InData%WaveElev1)) + if (associated(InData%WaveElev1)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPackPointer(Buf, c_loc(InData%WaveElev1), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev1) + end if + end if + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ExctnDisp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefztRot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefztRot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev0, UB(1:1)-LB(1:1)) + OutData%WaveElev0(LB(1):) => OutData%WaveElev0 + else + allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev0) + call RegUnpack(Buf, OutData%WaveElev0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev0 => null() + end if + if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev1, UB(1:3)-LB(1:3)) + OutData%WaveElev1(LB(1):,LB(2):,LB(3):) => OutData%WaveElev1 + else + allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev1) + call RegUnpack(Buf, OutData%WaveElev1) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev1 => null() + end if + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p +end subroutine + +subroutine SS_Exc_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_InitOutputType), intent(in) :: SrcInitOutputData + type(SS_Exc_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE SS_Exc_CopyDiscState - - SUBROUTINE SS_Exc_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(SS_Exc_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 = 'SS_Exc_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SS_Exc_DestroyDiscState - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 SS_Exc_PackDiscState - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 SS_Exc_UnPackDiscState - - SUBROUTINE SS_Exc_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SS_Exc_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 = 'SS_Exc_CopyConstrState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SS_Exc_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SS_Exc_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE SS_Exc_CopyConstrState - - SUBROUTINE SS_Exc_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(SS_Exc_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 = 'SS_Exc_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SS_Exc_DestroyConstrState - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 SS_Exc_PackConstrState - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 SS_Exc_UnPackConstrState - - SUBROUTINE SS_Exc_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SS_Exc_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyOtherState' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine + +subroutine SS_Exc_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SS_Exc_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_ContinuousStateType), intent(in) :: SrcContStateData + type(SS_Exc_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%n = SrcOtherStateData%n - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL SS_Exc_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - END SUBROUTINE SS_Exc_CopyOtherState - - SUBROUTINE SS_Exc_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(SS_Exc_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 = 'SS_Exc_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL SS_Exc_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - END SUBROUTINE SS_Exc_DestroyOtherState - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 ! n - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%n - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - 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 SUBROUTINE SS_Exc_PackOtherState - - SUBROUTINE SS_Exc_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(SS_Exc_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_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%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,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 SS_Exc_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - 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 SUBROUTINE SS_Exc_UnPackOtherState - - SUBROUTINE SS_Exc_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SS_Exc_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 = 'SS_Exc_CopyMisc' -! + ErrMsg = '' + if (allocated(SrcContStateData%x)) then + LB(1:1) = lbound(SrcContStateData%x) + UB(1:1) = ubound(SrcContStateData%x) + if (.not. allocated(DstContStateData%x)) then + allocate(DstContStateData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%x = SrcContStateData%x + end if +end subroutine + +subroutine SS_Exc_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SS_Exc_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - 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 SS_Exc_CopyMisc - - SUBROUTINE SS_Exc_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SS_Exc_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 = 'SS_Exc_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL SeaSt_Interp_DestroyMisc( MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SS_Exc_DestroyMisc - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - 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 - 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 - 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 SS_Exc_PackMisc - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 - 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 SS_Exc_UnPackMisc - - SUBROUTINE SS_Exc_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SS_Exc_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyParam' -! + ErrMsg = '' + if (allocated(ContStateData%x)) then + deallocate(ContStateData%x) + end if +end subroutine + +subroutine SS_Exc_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPack(Buf, InData%x) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackContState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SS_Exc_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SS_Exc_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%NBody = SrcParamData%NBody - DstParamData%ExctnDisp = SrcParamData%ExctnDisp - DstParamData%NStepWave = SrcParamData%NStepWave -IF (ALLOCATED(SrcParamData%spDOF)) THEN - i1_l = LBOUND(SrcParamData%spDOF,1) - i1_u = UBOUND(SrcParamData%spDOF,1) - IF (.NOT. ALLOCATED(DstParamData%spDOF)) THEN - ALLOCATE(DstParamData%spDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%spDOF = SrcParamData%spDOF -ENDIF -IF (ALLOCATED(SrcParamData%A)) THEN - i1_l = LBOUND(SrcParamData%A,1) - i1_u = UBOUND(SrcParamData%A,1) - i2_l = LBOUND(SrcParamData%A,2) - i2_u = UBOUND(SrcParamData%A,2) - IF (.NOT. ALLOCATED(DstParamData%A)) THEN - ALLOCATE(DstParamData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%A = SrcParamData%A -ENDIF -IF (ALLOCATED(SrcParamData%B)) THEN - i1_l = LBOUND(SrcParamData%B,1) - i1_u = UBOUND(SrcParamData%B,1) - IF (.NOT. ALLOCATED(DstParamData%B)) THEN - ALLOCATE(DstParamData%B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%B = SrcParamData%B -ENDIF -IF (ALLOCATED(SrcParamData%C)) THEN - i1_l = LBOUND(SrcParamData%C,1) - i1_u = UBOUND(SrcParamData%C,1) - i2_l = LBOUND(SrcParamData%C,2) - i2_u = UBOUND(SrcParamData%C,2) - IF (.NOT. ALLOCATED(DstParamData%C)) THEN - ALLOCATE(DstParamData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C = SrcParamData%C -ENDIF - DstParamData%numStates = SrcParamData%numStates - DstParamData%Tc = SrcParamData%Tc - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE SS_Exc_CopyParam - - SUBROUTINE SS_Exc_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SS_Exc_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 = 'SS_Exc_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%spDOF)) THEN - DEALLOCATE(ParamData%spDOF) -ENDIF -IF (ALLOCATED(ParamData%A)) THEN - DEALLOCATE(ParamData%A) -ENDIF -IF (ALLOCATED(ParamData%B)) THEN - DEALLOCATE(ParamData%B) -ENDIF -IF (ALLOCATED(ParamData%C)) THEN - DEALLOCATE(ParamData%C) -ENDIF -NULLIFY(ParamData%WaveElev0) -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 - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 ! NBody - Int_BufSz = Int_BufSz + 1 ! ExctnDisp - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! spDOF allocated yes/no - IF ( ALLOCATED(InData%spDOF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! spDOF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%spDOF) ! spDOF - END IF - Int_BufSz = Int_BufSz + 1 ! A allocated yes/no - IF ( ALLOCATED(InData%A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! A upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%A) ! A - END IF - Int_BufSz = Int_BufSz + 1 ! B allocated yes/no - IF ( ALLOCATED(InData%B) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! B upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%B) ! B - END IF - Int_BufSz = Int_BufSz + 1 ! C allocated yes/no - IF ( ALLOCATED(InData%C) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C) ! C - END IF - Int_BufSz = Int_BufSz + 1 ! numStates - Db_BufSz = Db_BufSz + 1 ! Tc - ! 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 - 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) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ExctnDisp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%spDOF) ) 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%spDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spDOF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%spDOF,1), UBOUND(InData%spDOF,1) - IntKiBuf(Int_Xferred) = InData%spDOF(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%A) ) 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%A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) - DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) - ReKiBuf(Re_Xferred) = InData%A(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%B) ) 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%B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) - ReKiBuf(Re_Xferred) = InData%B(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C) ) 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%C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) - DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) - ReKiBuf(Re_Xferred) = InData%C(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numStates - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Tc - Db_Xferred = Db_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 - END SUBROUTINE SS_Exc_PackParam - - SUBROUTINE SS_Exc_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(SS_Exc_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_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%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnDisp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! spDOF 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%spDOF)) DEALLOCATE(OutData%spDOF) - ALLOCATE(OutData%spDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%spDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%spDOF,1), UBOUND(OutData%spDOF,1) - OutData%spDOF(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A 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%A)) DEALLOCATE(OutData%A) - ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) - DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) - OutData%A(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B 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%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) - OutData%B(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C 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%C)) DEALLOCATE(OutData%C) - ALLOCATE(OutData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) - DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) - OutData%C(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numStates = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Tc = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - NULLIFY(OutData%WaveElev0) - NULLIFY(OutData%WaveElev1) - NULLIFY(OutData%WaveTime) - 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) - END SUBROUTINE SS_Exc_UnPackParam - - SUBROUTINE SS_Exc_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_InputType), INTENT(IN) :: SrcInputData - TYPE(SS_Exc_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) :: 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_Exc_CopyInput' -! + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine SS_Exc_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SS_Exc_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%PtfmPos)) THEN - i1_l = LBOUND(SrcInputData%PtfmPos,1) - i1_u = UBOUND(SrcInputData%PtfmPos,1) - i2_l = LBOUND(SrcInputData%PtfmPos,2) - i2_u = UBOUND(SrcInputData%PtfmPos,2) - IF (.NOT. ALLOCATED(DstInputData%PtfmPos)) THEN - ALLOCATE(DstInputData%PtfmPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%PtfmPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%PtfmPos = SrcInputData%PtfmPos -ENDIF - END SUBROUTINE SS_Exc_CopyInput - - SUBROUTINE SS_Exc_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SS_Exc_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 = 'SS_Exc_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%PtfmPos)) THEN - DEALLOCATE(InputData%PtfmPos) -ENDIF - END SUBROUTINE SS_Exc_DestroyInput - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 - Int_BufSz = Int_BufSz + 1 ! PtfmPos allocated yes/no - IF ( ALLOCATED(InData%PtfmPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PtfmPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmPos) ! PtfmPos - 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%PtfmPos) ) 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%PtfmPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PtfmPos,2), UBOUND(InData%PtfmPos,2) - DO i1 = LBOUND(InData%PtfmPos,1), UBOUND(InData%PtfmPos,1) - ReKiBuf(Re_Xferred) = InData%PtfmPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE SS_Exc_PackInput - - SUBROUTINE SS_Exc_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(SS_Exc_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) :: 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_Exc_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmPos 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%PtfmPos)) DEALLOCATE(OutData%PtfmPos) - ALLOCATE(OutData%PtfmPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PtfmPos,2), UBOUND(OutData%PtfmPos,2) - DO i1 = LBOUND(OutData%PtfmPos,1), UBOUND(OutData%PtfmPos,1) - OutData%PtfmPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE SS_Exc_UnPackInput - - SUBROUTINE SS_Exc_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_OutputType), INTENT(IN) :: SrcOutputData - TYPE(SS_Exc_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 = 'SS_Exc_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine SS_Exc_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SS_Exc_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%y)) THEN - i1_l = LBOUND(SrcOutputData%y,1) - i1_u = UBOUND(SrcOutputData%y,1) - IF (.NOT. ALLOCATED(DstOutputData%y)) THEN - ALLOCATE(DstOutputData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%y = SrcOutputData%y -ENDIF -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 SS_Exc_CopyOutput - - SUBROUTINE SS_Exc_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SS_Exc_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 = 'SS_Exc_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%y)) THEN - DEALLOCATE(OutputData%y) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE SS_Exc_DestroyOutput - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y) ! y - END IF - 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%y) ) 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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - ReKiBuf(Re_Xferred) = InData%y(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 SS_Exc_PackOutput - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 ! y 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 SS_Exc_UnPackOutput - - - SUBROUTINE SS_Exc_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(SS_Exc_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SS_Exc_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 + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine SS_Exc_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SS_Exc_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SS_Exc_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_OtherStateType), intent(in) :: SrcOtherStateData + type(SS_Exc_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%n = SrcOtherStateData%n + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + do i1 = LB(1), UB(1) + call SS_Exc_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do +end subroutine + +subroutine SS_Exc_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SS_Exc_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call SS_Exc_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do +end subroutine + +subroutine SS_Exc_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%n) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call SS_Exc_PackContState(Buf, InData%xdot(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call SS_Exc_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do +end subroutine + +subroutine SS_Exc_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_MiscVarType), intent(in) :: SrcMiscData + type(SS_Exc_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + 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 + +subroutine SS_Exc_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SS_Exc_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SS_Exc_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%LastIndWave) + call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return + call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m +end subroutine + +subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_ParameterType), intent(in) :: SrcParamData + type(SS_Exc_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%NBody = SrcParamData%NBody + DstParamData%ExctnDisp = SrcParamData%ExctnDisp + DstParamData%NStepWave = SrcParamData%NStepWave + if (allocated(SrcParamData%spDOF)) then + LB(1:1) = lbound(SrcParamData%spDOF) + UB(1:1) = ubound(SrcParamData%spDOF) + if (.not. allocated(DstParamData%spDOF)) then + allocate(DstParamData%spDOF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spDOF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%spDOF = SrcParamData%spDOF + end if + if (allocated(SrcParamData%A)) then + LB(1:2) = lbound(SrcParamData%A) + UB(1:2) = ubound(SrcParamData%A) + if (.not. allocated(DstParamData%A)) then + allocate(DstParamData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%A = SrcParamData%A + end if + if (allocated(SrcParamData%B)) then + LB(1:1) = lbound(SrcParamData%B) + UB(1:1) = ubound(SrcParamData%B) + if (.not. allocated(DstParamData%B)) then + allocate(DstParamData%B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%B = SrcParamData%B + end if + if (allocated(SrcParamData%C)) then + LB(1:2) = lbound(SrcParamData%C) + UB(1:2) = ubound(SrcParamData%C) + if (.not. allocated(DstParamData%C)) then + allocate(DstParamData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C = SrcParamData%C + end if + DstParamData%numStates = SrcParamData%numStates + DstParamData%Tc = SrcParamData%Tc + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine SS_Exc_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SS_Exc_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%spDOF)) then + deallocate(ParamData%spDOF) + end if + if (allocated(ParamData%A)) then + deallocate(ParamData%A) + end if + if (allocated(ParamData%B)) then + deallocate(ParamData%B) + end if + if (allocated(ParamData%C)) then + deallocate(ParamData%C) + end if + nullify(ParamData%WaveElev0) + 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 + +subroutine SS_Exc_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackParam' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%NBody) + call RegPack(Buf, InData%ExctnDisp) + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, allocated(InData%spDOF)) + if (allocated(InData%spDOF)) then + call RegPackBounds(Buf, 1, lbound(InData%spDOF), ubound(InData%spDOF)) + call RegPack(Buf, InData%spDOF) + end if + call RegPack(Buf, allocated(InData%A)) + if (allocated(InData%A)) then + call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) + call RegPack(Buf, InData%A) + end if + call RegPack(Buf, allocated(InData%B)) + if (allocated(InData%B)) then + call RegPackBounds(Buf, 1, lbound(InData%B), ubound(InData%B)) + call RegPack(Buf, InData%B) + end if + call RegPack(Buf, allocated(InData%C)) + if (allocated(InData%C)) then + call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) + call RegPack(Buf, InData%C) + end if + call RegPack(Buf, InData%numStates) + call RegPack(Buf, InData%Tc) + call RegPack(Buf, associated(InData%WaveElev0)) + if (associated(InData%WaveElev0)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) + call RegPackPointer(Buf, c_loc(InData%WaveElev0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev0) + end if + end if + call RegPack(Buf, associated(InData%WaveElev1)) + if (associated(InData%WaveElev1)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPackPointer(Buf, c_loc(InData%WaveElev1), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev1) + end if + end if + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackParam' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ExctnDisp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%spDOF)) deallocate(OutData%spDOF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%spDOF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%spDOF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%spDOF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%A)) deallocate(OutData%A) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%A(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%A) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%B)) deallocate(OutData%B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%B) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%C)) deallocate(OutData%C) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%numStates) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Tc) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev0, UB(1:1)-LB(1:1)) + OutData%WaveElev0(LB(1):) => OutData%WaveElev0 + else + allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev0) + call RegUnpack(Buf, OutData%WaveElev0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev0 => null() + end if + if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev1, UB(1:3)-LB(1:3)) + OutData%WaveElev1(LB(1):,LB(2):,LB(3):) => OutData%WaveElev1 + else + allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev1) + call RegUnpack(Buf, OutData%WaveElev1) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev1 => null() + end if + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p +end subroutine + +subroutine SS_Exc_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_InputType), intent(in) :: SrcInputData + type(SS_Exc_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%PtfmPos)) then + LB(1:2) = lbound(SrcInputData%PtfmPos) + UB(1:2) = ubound(SrcInputData%PtfmPos) + if (.not. allocated(DstInputData%PtfmPos)) then + allocate(DstInputData%PtfmPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%PtfmPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%PtfmPos = SrcInputData%PtfmPos + end if +end subroutine + +subroutine SS_Exc_DestroyInput(InputData, ErrStat, ErrMsg) + type(SS_Exc_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%PtfmPos)) then + deallocate(InputData%PtfmPos) + end if +end subroutine + +subroutine SS_Exc_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%PtfmPos)) + if (allocated(InData%PtfmPos)) then + call RegPackBounds(Buf, 2, lbound(InData%PtfmPos), ubound(InData%PtfmPos)) + call RegPack(Buf, InData%PtfmPos) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%PtfmPos)) deallocate(OutData%PtfmPos) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmPos) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SS_Exc_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_OutputType), intent(in) :: SrcOutputData + type(SS_Exc_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%y)) then + LB(1:1) = lbound(SrcOutputData%y) + UB(1:1) = ubound(SrcOutputData%y) + if (.not. allocated(DstOutputData%y)) then + allocate(DstOutputData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%y = SrcOutputData%y + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SS_Exc_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SS_Exc_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%y)) then + deallocate(OutputData%y) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine SS_Exc_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPack(Buf, InData%y) + end if + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SS_Exc_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(SS_Exc_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(SS_Exc_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 = 'SS_Exc_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 SS_Exc_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SS_Exc_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 SS_Exc_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 SS_Exc_Input_ExtrapInterp - - - SUBROUTINE SS_Exc_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SS_Exc_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SS_Exc_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SS_Exc_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SS_Exc_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. @@ -2544,51 +1266,47 @@ SUBROUTINE SS_Exc_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(SS_Exc_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(SS_Exc_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SS_Exc_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 + TYPE(SS_Exc_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(SS_Exc_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SS_Exc_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 = 'SS_Exc_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 - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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(u_out%PtfmPos) .AND. ALLOCATED(u1%PtfmPos)) THEN - DO i2 = LBOUND(u_out%PtfmPos,2),UBOUND(u_out%PtfmPos,2) - DO i1 = LBOUND(u_out%PtfmPos,1),UBOUND(u_out%PtfmPos,1) - b = -(u1%PtfmPos(i1,i2) - u2%PtfmPos(i1,i2)) - u_out%PtfmPos(i1,i2) = u1%PtfmPos(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE SS_Exc_Input_ExtrapInterp1 - - - SUBROUTINE SS_Exc_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%PtfmPos) .AND. ALLOCATED(u1%PtfmPos)) THEN + u_out%PtfmPos = a1*u1%PtfmPos + a2*u2%PtfmPos + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SS_Exc_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. @@ -2602,112 +1320,107 @@ SUBROUTINE SS_Exc_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(SS_Exc_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(SS_Exc_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(SS_Exc_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SS_Exc_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 + TYPE(SS_Exc_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(SS_Exc_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(SS_Exc_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SS_Exc_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 = 'SS_Exc_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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(u_out%PtfmPos) .AND. ALLOCATED(u1%PtfmPos)) THEN - DO i2 = LBOUND(u_out%PtfmPos,2),UBOUND(u_out%PtfmPos,2) - DO i1 = LBOUND(u_out%PtfmPos,1),UBOUND(u_out%PtfmPos,1) - b = (t(3)**2*(u1%PtfmPos(i1,i2) - u2%PtfmPos(i1,i2)) + t(2)**2*(-u1%PtfmPos(i1,i2) + u3%PtfmPos(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%PtfmPos(i1,i2) + t(3)*u2%PtfmPos(i1,i2) - t(2)*u3%PtfmPos(i1,i2) ) * scaleFactor - u_out%PtfmPos(i1,i2) = u1%PtfmPos(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE SS_Exc_Input_ExtrapInterp2 - - - SUBROUTINE SS_Exc_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(SS_Exc_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SS_Exc_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%PtfmPos) .AND. ALLOCATED(u1%PtfmPos)) THEN + u_out%PtfmPos = a1*u1%PtfmPos + a2*u2%PtfmPos + a3*u3%PtfmPos + END IF ! check if allocated +END SUBROUTINE + +subroutine SS_Exc_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(SS_Exc_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(SS_Exc_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 = 'SS_Exc_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 SS_Exc_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SS_Exc_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 SS_Exc_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 SS_Exc_Output_ExtrapInterp - - - SUBROUTINE SS_Exc_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SS_Exc_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SS_Exc_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SS_Exc_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SS_Exc_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. @@ -2719,53 +1432,48 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(SS_Exc_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(SS_Exc_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SS_Exc_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 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SS_Exc_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 = 'SS_Exc_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%y) .AND. ALLOCATED(y1%y)) THEN - DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) - b = -(y1%y(i1) - y2%y(i1)) - y_out%y(i1) = y1%y(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -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 SS_Exc_Output_ExtrapInterp1 - - - SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN + y_out%y = a1*y1%y + a2*y2%y + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SS_Exc_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. @@ -2779,61 +1487,53 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(SS_Exc_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(SS_Exc_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(SS_Exc_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SS_Exc_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 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SS_Exc_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 = 'SS_Exc_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_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 + 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 + 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 + 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%y) .AND. ALLOCATED(y1%y)) THEN - DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) - b = (t(3)**2*(y1%y(i1) - y2%y(i1)) + t(2)**2*(-y1%y(i1) + y3%y(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%y(i1) + t(3)*y2%y(i1) - t(2)*y3%y(i1) ) * scaleFactor - y_out%y(i1) = y1%y(i1) + b + c * t_out - END DO -END IF ! check if allocated -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 SS_Exc_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN + y_out%y = a1*y1%y + a2*y2%y + a3*y3%y + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE SS_Excitation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 24ba2c23a5..48280fc706 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -37,7 +37,7 @@ MODULE SS_Radiation_Types TYPE, PUBLIC :: SS_Rad_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: enabledDOFs !< Vector with enable platf. DOFs [(m/s] - INTEGER(IntKi) :: NBody !< Number of WAMIT bodies for this State Space model [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] END TYPE SS_Rad_InitInputType ! ======================= @@ -54,34 +54,34 @@ MODULE SS_Radiation_Types ! ======================= ! ========= SS_Rad_DiscreteStateType ======= TYPE, PUBLIC :: SS_Rad_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< [-] + REAL(SiKi) :: DummyDiscState = 0.0_R4Ki !< [-] END TYPE SS_Rad_DiscreteStateType ! ======================= ! ========= SS_Rad_ConstraintStateType ======= TYPE, PUBLIC :: SS_Rad_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< [-] END TYPE SS_Rad_ConstraintStateType ! ======================= ! ========= SS_Rad_OtherStateType ======= TYPE, PUBLIC :: SS_Rad_OtherStateType - INTEGER(IntKi) :: n !< Current Time step [-] + INTEGER(IntKi) :: n = 0_IntKi !< Current Time step [-] TYPE(SS_Rad_ContinuousStateType) , DIMENSION(1:4) :: xdot !< Old Values of dxdt to used by the solver (multistep method) [-] END TYPE SS_Rad_OtherStateType ! ======================= ! ========= SS_Rad_MiscVarType ======= TYPE, PUBLIC :: SS_Rad_MiscVarType - REAL(SiKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] + REAL(SiKi) :: DummyMiscVar = 0.0_R4Ki !< Remove this variable if you have misc/optimization variables [-] END TYPE SS_Rad_MiscVarType ! ======================= ! ========= SS_Rad_ParameterType ======= TYPE, PUBLIC :: SS_Rad_ParameterType - REAL(DbKi) :: DT !< Time step [(s)] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step [(s)] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: A !< A matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: B !< B matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C !< C matrix [-] INTEGER(IntKi) :: numStates = 0 !< Number of states [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: spdof !< States per dof [-] - INTEGER(IntKi) :: NBody !< Number of WAMIT bodies for this State Space model [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] END TYPE SS_Rad_ParameterType ! ======================= ! ========= SS_Rad_InputType ======= @@ -96,2146 +96,919 @@ MODULE SS_Radiation_Types END TYPE SS_Rad_OutputType ! ======================= CONTAINS - SUBROUTINE SS_Rad_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SS_Rad_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 = 'SS_Rad_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile -IF (ALLOCATED(SrcInitInputData%enabledDOFs)) THEN - i1_l = LBOUND(SrcInitInputData%enabledDOFs,1) - i1_u = UBOUND(SrcInitInputData%enabledDOFs,1) - IF (.NOT. ALLOCATED(DstInitInputData%enabledDOFs)) THEN - ALLOCATE(DstInitInputData%enabledDOFs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%enabledDOFs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%enabledDOFs = SrcInitInputData%enabledDOFs -ENDIF - DstInitInputData%NBody = SrcInitInputData%NBody -IF (ALLOCATED(SrcInitInputData%PtfmRefztRot)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefztRot,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefztRot,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefztRot)) THEN - ALLOCATE(DstInitInputData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot -ENDIF - END SUBROUTINE SS_Rad_CopyInitInput - - SUBROUTINE SS_Rad_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SS_Rad_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 = 'SS_Rad_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%enabledDOFs)) THEN - DEALLOCATE(InitInputData%enabledDOFs) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefztRot)) THEN - DEALLOCATE(InitInputData%PtfmRefztRot) -ENDIF - END SUBROUTINE SS_Rad_DestroyInitInput - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 ! enabledDOFs allocated yes/no - IF ( ALLOCATED(InData%enabledDOFs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! enabledDOFs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%enabledDOFs) ! enabledDOFs - END IF - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! PtfmRefztRot allocated yes/no - 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 - 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 - IF ( .NOT. ALLOCATED(InData%enabledDOFs) ) 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%enabledDOFs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%enabledDOFs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%enabledDOFs,1), UBOUND(InData%enabledDOFs,1) - ReKiBuf(Re_Xferred) = InData%enabledDOFs(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmRefztRot) ) 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%PtfmRefztRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefztRot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefztRot,1), UBOUND(InData%PtfmRefztRot,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_PackInitInput - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! enabledDOFs 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%enabledDOFs)) DEALLOCATE(OutData%enabledDOFs) - ALLOCATE(OutData%enabledDOFs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%enabledDOFs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%enabledDOFs,1), UBOUND(OutData%enabledDOFs,1) - OutData%enabledDOFs(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefztRot 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%PtfmRefztRot)) DEALLOCATE(OutData%PtfmRefztRot) - ALLOCATE(OutData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefztRot,1), UBOUND(OutData%PtfmRefztRot,1) - OutData%PtfmRefztRot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_UnPackInitInput - - SUBROUTINE SS_Rad_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SS_Rad_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 = 'SS_Rad_CopyInitOutput' -! +subroutine SS_Rad_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_InitInputType), intent(in) :: SrcInitInputData + type(SS_Rad_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyInitInput' 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 - END SUBROUTINE SS_Rad_CopyInitOutput - - SUBROUTINE SS_Rad_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SS_Rad_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 = 'SS_Rad_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE SS_Rad_DestroyInitOutput - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 - 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 - END SUBROUTINE SS_Rad_PackInitOutput - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 - END SUBROUTINE SS_Rad_UnPackInitOutput - - SUBROUTINE SS_Rad_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SS_Rad_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_CopyContState' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + if (allocated(SrcInitInputData%enabledDOFs)) then + LB(1:1) = lbound(SrcInitInputData%enabledDOFs) + UB(1:1) = ubound(SrcInitInputData%enabledDOFs) + if (.not. allocated(DstInitInputData%enabledDOFs)) then + allocate(DstInitInputData%enabledDOFs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%enabledDOFs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%enabledDOFs = SrcInitInputData%enabledDOFs + end if + DstInitInputData%NBody = SrcInitInputData%NBody + if (allocated(SrcInitInputData%PtfmRefztRot)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + if (.not. allocated(DstInitInputData%PtfmRefztRot)) then + allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot + end if +end subroutine + +subroutine SS_Rad_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SS_Rad_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%x)) THEN - i1_l = LBOUND(SrcContStateData%x,1) - i1_u = UBOUND(SrcContStateData%x,1) - IF (.NOT. ALLOCATED(DstContStateData%x)) THEN - ALLOCATE(DstContStateData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%x = SrcContStateData%x -ENDIF - END SUBROUTINE SS_Rad_CopyContState - - SUBROUTINE SS_Rad_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(SS_Rad_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 = 'SS_Rad_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%x)) THEN - DEALLOCATE(ContStateData%x) -ENDIF - END SUBROUTINE SS_Rad_DestroyContState - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x) ! x - 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%x) ) 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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_PackContState - - SUBROUTINE SS_Rad_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(SS_Rad_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x 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%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_UnPackContState - - SUBROUTINE SS_Rad_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SS_Rad_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 = 'SS_Rad_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitInputData%enabledDOFs)) then + deallocate(InitInputData%enabledDOFs) + end if + if (allocated(InitInputData%PtfmRefztRot)) then + deallocate(InitInputData%PtfmRefztRot) + end if +end subroutine + +subroutine SS_Rad_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, allocated(InData%enabledDOFs)) + if (allocated(InData%enabledDOFs)) then + call RegPackBounds(Buf, 1, lbound(InData%enabledDOFs), ubound(InData%enabledDOFs)) + call RegPack(Buf, InData%enabledDOFs) + end if + call RegPack(Buf, InData%NBody) + call RegPack(Buf, allocated(InData%PtfmRefztRot)) + if (allocated(InData%PtfmRefztRot)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) + call RegPack(Buf, InData%PtfmRefztRot) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackInitInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%enabledDOFs)) deallocate(OutData%enabledDOFs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%enabledDOFs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%enabledDOFs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%enabledDOFs) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefztRot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefztRot) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SS_Rad_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_InitOutputType), intent(in) :: SrcInitOutputData + type(SS_Rad_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE SS_Rad_CopyDiscState - - SUBROUTINE SS_Rad_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(SS_Rad_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 = 'SS_Rad_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SS_Rad_DestroyDiscState - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 SS_Rad_PackDiscState - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 SS_Rad_UnPackDiscState - - SUBROUTINE SS_Rad_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SS_Rad_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 = 'SS_Rad_CopyConstrState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SS_Rad_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SS_Rad_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE SS_Rad_CopyConstrState - - SUBROUTINE SS_Rad_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(SS_Rad_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 = 'SS_Rad_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SS_Rad_DestroyConstrState - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 SS_Rad_PackConstrState - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 SS_Rad_UnPackConstrState - - SUBROUTINE SS_Rad_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SS_Rad_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_CopyOtherState' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine + +subroutine SS_Rad_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SS_Rad_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_ContinuousStateType), intent(in) :: SrcContStateData + type(SS_Rad_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%n = SrcOtherStateData%n - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL SS_Rad_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - END SUBROUTINE SS_Rad_CopyOtherState - - SUBROUTINE SS_Rad_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(SS_Rad_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 = 'SS_Rad_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL SS_Rad_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - END SUBROUTINE SS_Rad_DestroyOtherState - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 ! n - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL SS_Rad_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%n - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL SS_Rad_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - 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 SUBROUTINE SS_Rad_PackOtherState - - SUBROUTINE SS_Rad_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(SS_Rad_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_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%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,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 SS_Rad_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - 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 SUBROUTINE SS_Rad_UnPackOtherState - - SUBROUTINE SS_Rad_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SS_Rad_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 = 'SS_Rad_CopyMisc' -! + ErrMsg = '' + if (allocated(SrcContStateData%x)) then + LB(1:1) = lbound(SrcContStateData%x) + UB(1:1) = ubound(SrcContStateData%x) + if (.not. allocated(DstContStateData%x)) then + allocate(DstContStateData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%x = SrcContStateData%x + end if +end subroutine + +subroutine SS_Rad_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SS_Rad_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE SS_Rad_CopyMisc - - SUBROUTINE SS_Rad_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SS_Rad_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 = 'SS_Rad_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SS_Rad_DestroyMisc - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 SS_Rad_PackMisc - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Rad_UnPackMisc - - SUBROUTINE SS_Rad_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SS_Rad_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 = 'SS_Rad_CopyParam' -! + ErrMsg = '' + if (allocated(ContStateData%x)) then + deallocate(ContStateData%x) + end if +end subroutine + +subroutine SS_Rad_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPack(Buf, InData%x) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackContState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SS_Rad_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SS_Rad_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT -IF (ALLOCATED(SrcParamData%A)) THEN - i1_l = LBOUND(SrcParamData%A,1) - i1_u = UBOUND(SrcParamData%A,1) - i2_l = LBOUND(SrcParamData%A,2) - i2_u = UBOUND(SrcParamData%A,2) - IF (.NOT. ALLOCATED(DstParamData%A)) THEN - ALLOCATE(DstParamData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%A = SrcParamData%A -ENDIF -IF (ALLOCATED(SrcParamData%B)) THEN - i1_l = LBOUND(SrcParamData%B,1) - i1_u = UBOUND(SrcParamData%B,1) - i2_l = LBOUND(SrcParamData%B,2) - i2_u = UBOUND(SrcParamData%B,2) - IF (.NOT. ALLOCATED(DstParamData%B)) THEN - ALLOCATE(DstParamData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%B = SrcParamData%B -ENDIF -IF (ALLOCATED(SrcParamData%C)) THEN - i1_l = LBOUND(SrcParamData%C,1) - i1_u = UBOUND(SrcParamData%C,1) - i2_l = LBOUND(SrcParamData%C,2) - i2_u = UBOUND(SrcParamData%C,2) - IF (.NOT. ALLOCATED(DstParamData%C)) THEN - ALLOCATE(DstParamData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C = SrcParamData%C -ENDIF - DstParamData%numStates = SrcParamData%numStates -IF (ALLOCATED(SrcParamData%spdof)) THEN - i1_l = LBOUND(SrcParamData%spdof,1) - i1_u = UBOUND(SrcParamData%spdof,1) - IF (.NOT. ALLOCATED(DstParamData%spdof)) THEN - ALLOCATE(DstParamData%spdof(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spdof.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%spdof = SrcParamData%spdof -ENDIF - DstParamData%NBody = SrcParamData%NBody - END SUBROUTINE SS_Rad_CopyParam - - SUBROUTINE SS_Rad_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SS_Rad_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 = 'SS_Rad_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%A)) THEN - DEALLOCATE(ParamData%A) -ENDIF -IF (ALLOCATED(ParamData%B)) THEN - DEALLOCATE(ParamData%B) -ENDIF -IF (ALLOCATED(ParamData%C)) THEN - DEALLOCATE(ParamData%C) -ENDIF -IF (ALLOCATED(ParamData%spdof)) THEN - DEALLOCATE(ParamData%spdof) -ENDIF - END SUBROUTINE SS_Rad_DestroyParam - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 ! A allocated yes/no - IF ( ALLOCATED(InData%A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! A upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%A) ! A - END IF - Int_BufSz = Int_BufSz + 1 ! B allocated yes/no - IF ( ALLOCATED(InData%B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%B) ! B - END IF - Int_BufSz = Int_BufSz + 1 ! C allocated yes/no - IF ( ALLOCATED(InData%C) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C) ! C - END IF - Int_BufSz = Int_BufSz + 1 ! numStates - Int_BufSz = Int_BufSz + 1 ! spdof allocated yes/no - IF ( ALLOCATED(InData%spdof) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! spdof upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%spdof) ! spdof - END IF - Int_BufSz = Int_BufSz + 1 ! NBody - 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 - IF ( .NOT. ALLOCATED(InData%A) ) 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%A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) - DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) - ReKiBuf(Re_Xferred) = InData%A(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%B) ) 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%B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) - DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) - ReKiBuf(Re_Xferred) = InData%B(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C) ) 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%C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) - DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) - ReKiBuf(Re_Xferred) = InData%C(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numStates - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%spdof) ) 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%spdof,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spdof,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%spdof,1), UBOUND(InData%spdof,1) - IntKiBuf(Int_Xferred) = InData%spdof(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SS_Rad_PackParam - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A 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%A)) DEALLOCATE(OutData%A) - ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) - DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) - OutData%A(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B 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%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) - DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) - OutData%B(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C 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%C)) DEALLOCATE(OutData%C) - ALLOCATE(OutData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) - DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) - OutData%C(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numStates = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! spdof 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%spdof)) DEALLOCATE(OutData%spdof) - ALLOCATE(OutData%spdof(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%spdof.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%spdof,1), UBOUND(OutData%spdof,1) - OutData%spdof(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SS_Rad_UnPackParam - - SUBROUTINE SS_Rad_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_InputType), INTENT(IN) :: SrcInputData - TYPE(SS_Rad_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_CopyInput' -! + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine SS_Rad_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SS_Rad_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%dq)) THEN - i1_l = LBOUND(SrcInputData%dq,1) - i1_u = UBOUND(SrcInputData%dq,1) - IF (.NOT. ALLOCATED(DstInputData%dq)) THEN - ALLOCATE(DstInputData%dq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%dq = SrcInputData%dq -ENDIF - END SUBROUTINE SS_Rad_CopyInput - - SUBROUTINE SS_Rad_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SS_Rad_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 = 'SS_Rad_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%dq)) THEN - DEALLOCATE(InputData%dq) -ENDIF - END SUBROUTINE SS_Rad_DestroyInput - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 - Int_BufSz = Int_BufSz + 1 ! dq allocated yes/no - IF ( ALLOCATED(InData%dq) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dq) ! dq - 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%dq) ) 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%dq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dq,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dq,1), UBOUND(InData%dq,1) - ReKiBuf(Re_Xferred) = InData%dq(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_PackInput - - SUBROUTINE SS_Rad_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(SS_Rad_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dq 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%dq)) DEALLOCATE(OutData%dq) - ALLOCATE(OutData%dq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dq,1), UBOUND(OutData%dq,1) - OutData%dq(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_UnPackInput - - SUBROUTINE SS_Rad_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_OutputType), INTENT(IN) :: SrcOutputData - TYPE(SS_Rad_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 = 'SS_Rad_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine SS_Rad_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SS_Rad_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%y)) THEN - i1_l = LBOUND(SrcOutputData%y,1) - i1_u = UBOUND(SrcOutputData%y,1) - IF (.NOT. ALLOCATED(DstOutputData%y)) THEN - ALLOCATE(DstOutputData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%y = SrcOutputData%y -ENDIF -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 SS_Rad_CopyOutput - - SUBROUTINE SS_Rad_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SS_Rad_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 = 'SS_Rad_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%y)) THEN - DEALLOCATE(OutputData%y) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE SS_Rad_DestroyOutput - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y) ! y - END IF - 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%y) ) 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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - ReKiBuf(Re_Xferred) = InData%y(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 SS_Rad_PackOutput - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 ! y 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 SS_Rad_UnPackOutput - - - SUBROUTINE SS_Rad_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(SS_Rad_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SS_Rad_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 + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine SS_Rad_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SS_Rad_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SS_Rad_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_OtherStateType), intent(in) :: SrcOtherStateData + type(SS_Rad_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%n = SrcOtherStateData%n + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + do i1 = LB(1), UB(1) + call SS_Rad_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do +end subroutine + +subroutine SS_Rad_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SS_Rad_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Rad_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call SS_Rad_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do +end subroutine + +subroutine SS_Rad_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%n) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call SS_Rad_PackContState(Buf, InData%xdot(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call SS_Rad_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do +end subroutine + +subroutine SS_Rad_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_MiscVarType), intent(in) :: SrcMiscData + type(SS_Rad_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar +end subroutine + +subroutine SS_Rad_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SS_Rad_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SS_Rad_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_ParameterType), intent(in) :: SrcParamData + type(SS_Rad_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + if (allocated(SrcParamData%A)) then + LB(1:2) = lbound(SrcParamData%A) + UB(1:2) = ubound(SrcParamData%A) + if (.not. allocated(DstParamData%A)) then + allocate(DstParamData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%A = SrcParamData%A + end if + if (allocated(SrcParamData%B)) then + LB(1:2) = lbound(SrcParamData%B) + UB(1:2) = ubound(SrcParamData%B) + if (.not. allocated(DstParamData%B)) then + allocate(DstParamData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%B = SrcParamData%B + end if + if (allocated(SrcParamData%C)) then + LB(1:2) = lbound(SrcParamData%C) + UB(1:2) = ubound(SrcParamData%C) + if (.not. allocated(DstParamData%C)) then + allocate(DstParamData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C = SrcParamData%C + end if + DstParamData%numStates = SrcParamData%numStates + if (allocated(SrcParamData%spdof)) then + LB(1:1) = lbound(SrcParamData%spdof) + UB(1:1) = ubound(SrcParamData%spdof) + if (.not. allocated(DstParamData%spdof)) then + allocate(DstParamData%spdof(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spdof.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%spdof = SrcParamData%spdof + end if + DstParamData%NBody = SrcParamData%NBody +end subroutine + +subroutine SS_Rad_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SS_Rad_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%A)) then + deallocate(ParamData%A) + end if + if (allocated(ParamData%B)) then + deallocate(ParamData%B) + end if + if (allocated(ParamData%C)) then + deallocate(ParamData%C) + end if + if (allocated(ParamData%spdof)) then + deallocate(ParamData%spdof) + end if +end subroutine + +subroutine SS_Rad_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, allocated(InData%A)) + if (allocated(InData%A)) then + call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) + call RegPack(Buf, InData%A) + end if + call RegPack(Buf, allocated(InData%B)) + if (allocated(InData%B)) then + call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) + call RegPack(Buf, InData%B) + end if + call RegPack(Buf, allocated(InData%C)) + if (allocated(InData%C)) then + call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) + call RegPack(Buf, InData%C) + end if + call RegPack(Buf, InData%numStates) + call RegPack(Buf, allocated(InData%spdof)) + if (allocated(InData%spdof)) then + call RegPackBounds(Buf, 1, lbound(InData%spdof), ubound(InData%spdof)) + call RegPack(Buf, InData%spdof) + end if + call RegPack(Buf, InData%NBody) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%A)) deallocate(OutData%A) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%A(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%A) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%B)) deallocate(OutData%B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%B) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%C)) deallocate(OutData%C) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%numStates) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%spdof)) deallocate(OutData%spdof) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%spdof(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%spdof.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%spdof) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_InputType), intent(in) :: SrcInputData + type(SS_Rad_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%dq)) then + LB(1:1) = lbound(SrcInputData%dq) + UB(1:1) = ubound(SrcInputData%dq) + if (.not. allocated(DstInputData%dq)) then + allocate(DstInputData%dq(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%dq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%dq = SrcInputData%dq + end if +end subroutine + +subroutine SS_Rad_DestroyInput(InputData, ErrStat, ErrMsg) + type(SS_Rad_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%dq)) then + deallocate(InputData%dq) + end if +end subroutine + +subroutine SS_Rad_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%dq)) + if (allocated(InData%dq)) then + call RegPackBounds(Buf, 1, lbound(InData%dq), ubound(InData%dq)) + call RegPack(Buf, InData%dq) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%dq)) deallocate(OutData%dq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dq(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dq) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SS_Rad_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_OutputType), intent(in) :: SrcOutputData + type(SS_Rad_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%y)) then + LB(1:1) = lbound(SrcOutputData%y) + UB(1:1) = ubound(SrcOutputData%y) + if (.not. allocated(DstOutputData%y)) then + allocate(DstOutputData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%y = SrcOutputData%y + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SS_Rad_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SS_Rad_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%y)) then + deallocate(OutputData%y) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine SS_Rad_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPack(Buf, InData%y) + end if + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SS_Rad_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(SS_Rad_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(SS_Rad_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 = 'SS_Rad_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 SS_Rad_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SS_Rad_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 SS_Rad_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 SS_Rad_Input_ExtrapInterp - - - SUBROUTINE SS_Rad_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SS_Rad_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SS_Rad_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SS_Rad_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SS_Rad_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. @@ -2247,47 +1020,45 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(SS_Rad_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(SS_Rad_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SS_Rad_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 + TYPE(SS_Rad_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(SS_Rad_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SS_Rad_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 = 'SS_Rad_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 - 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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(u_out%dq) .AND. ALLOCATED(u1%dq)) THEN - DO i1 = LBOUND(u_out%dq,1),UBOUND(u_out%dq,1) - b = -(u1%dq(i1) - u2%dq(i1)) - u_out%dq(i1) = u1%dq(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SS_Rad_Input_ExtrapInterp1 - - - SUBROUTINE SS_Rad_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%dq) .AND. ALLOCATED(u1%dq)) THEN + u_out%dq = a1*u1%dq + a2*u2%dq + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SS_Rad_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. @@ -2301,108 +1072,105 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(SS_Rad_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(SS_Rad_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(SS_Rad_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SS_Rad_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 + TYPE(SS_Rad_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(SS_Rad_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(SS_Rad_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SS_Rad_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 = 'SS_Rad_Input_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Input_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 + 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 + 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 + 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(u_out%dq) .AND. ALLOCATED(u1%dq)) THEN - DO i1 = LBOUND(u_out%dq,1),UBOUND(u_out%dq,1) - b = (t(3)**2*(u1%dq(i1) - u2%dq(i1)) + t(2)**2*(-u1%dq(i1) + u3%dq(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%dq(i1) + t(3)*u2%dq(i1) - t(2)*u3%dq(i1) ) * scaleFactor - u_out%dq(i1) = u1%dq(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SS_Rad_Input_ExtrapInterp2 - - - SUBROUTINE SS_Rad_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(SS_Rad_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SS_Rad_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%dq) .AND. ALLOCATED(u1%dq)) THEN + u_out%dq = a1*u1%dq + a2*u2%dq + a3*u3%dq + END IF ! check if allocated +END SUBROUTINE + +subroutine SS_Rad_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(SS_Rad_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(SS_Rad_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 = 'SS_Rad_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 SS_Rad_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SS_Rad_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 SS_Rad_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 SS_Rad_Output_ExtrapInterp - - - SUBROUTINE SS_Rad_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SS_Rad_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SS_Rad_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SS_Rad_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SS_Rad_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. @@ -2414,53 +1182,48 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(SS_Rad_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(SS_Rad_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SS_Rad_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 + TYPE(SS_Rad_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(SS_Rad_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SS_Rad_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 = 'SS_Rad_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%y) .AND. ALLOCATED(y1%y)) THEN - DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) - b = -(y1%y(i1) - y2%y(i1)) - y_out%y(i1) = y1%y(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -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 SS_Rad_Output_ExtrapInterp1 - - - SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN + y_out%y = a1*y1%y + a2*y2%y + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SS_Rad_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. @@ -2474,61 +1237,53 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(SS_Rad_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(SS_Rad_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(SS_Rad_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SS_Rad_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 + TYPE(SS_Rad_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(SS_Rad_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(SS_Rad_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SS_Rad_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 = 'SS_Rad_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_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 + 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 + 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 + 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%y) .AND. ALLOCATED(y1%y)) THEN - DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) - b = (t(3)**2*(y1%y(i1) - y2%y(i1)) + t(2)**2*(-y1%y(i1) + y3%y(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%y(i1) + t(3)*y2%y(i1) - t(2)*y3%y(i1) ) * scaleFactor - y_out%y(i1) = y1%y(i1) + b + c * t_out - END DO -END IF ! check if allocated -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 SS_Rad_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN + y_out%y = a1*y1%y + a2*y2%y + a3*y3%y + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE SS_Radiation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index c25f669f91..b29c74410f 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -36,43 +36,43 @@ MODULE WAMIT2_Types INTEGER(IntKi), PUBLIC, PARAMETER :: MaxWAMIT2Outputs = 6 ! [-] ! ========= WAMIT2_InitInputType ======= TYPE, PUBLIC :: WAMIT2_InitInputType - LOGICAL :: HasWAMIT !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] + LOGICAL :: HasWAMIT = .false. !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] CHARACTER(1024) :: WAMITFile !< Root of the filename for WAMIT2 outputs [-] - INTEGER(IntKi) :: 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] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=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] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefxt !< The xt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefyt !< The yt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefzt !< The zt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] - REAL(ReKi) :: WAMITULEN !< WAMIT unit length scale [-] - REAL(ReKi) :: RhoXg !< Density * Gravity -- from the Waves module. [-] - INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] - REAL(ReKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] - REAL(ReKi) :: WtrDens !< Water density [(kg/m^3)] - REAL(ReKi) :: Gravity !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDpth !< Water depth (positive-valued) [(m)] + REAL(ReKi) :: WAMITULEN = 0.0_ReKi !< WAMIT unit length scale [-] + REAL(ReKi) :: RhoXg = 0.0_ReKi !< Density * Gravity -- from the Waves module. [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] + INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] + REAL(ReKi) :: WaveDOmega = 0.0_ReKi !< Frequency step for incident wave calculations [(rad/s)] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [(kg/m^3)] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [(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 (points to SeaState module data) [(meters)] - REAL(SiKi) :: WaveDir !< Mean incident wave propagation heading direction [(degrees)] - LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] + REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Mean incident wave propagation heading direction [(degrees)] + LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction assigned to each frequency (points to SeaState module data) [(degrees)] - REAL(SiKi) :: WaveDirMin !< Minimum wave direction from Waves module [-] - REAL(SiKi) :: WaveDirMax !< Maximum wave direction from Waves module [-] - INTEGER(IntKi) :: WaveMod !< The wave model to use. This is for error checking -- ideally this would be done in the main calling routine, not here. [-] - INTEGER(IntKi) :: MnDrift !< Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] - INTEGER(IntKi) :: NewmanApp !< Slow drift forces computed with Newman approximation from WAMIT file:{0: No slow drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] - INTEGER(IntKi) :: DiffQTF !< Full Difference-Frequency forces computed with full QTF's from WAMIT file: {0: No diff-QTF; [10,11, or 12]: WAMIT file to use} [-] - INTEGER(IntKi) :: SumQTF !< Full Sum-Frequency forces computed with full QTF's from WAMIT file: {0: No sum-QTF; [10,11, or 12]: WAMIT file to use} [-] - LOGICAL :: MnDriftF !< Flag indicating mean drift force should be calculated [-] - LOGICAL :: NewmanAppF !< Flag indicating Newman approximation should be calculated [-] - LOGICAL :: DiffQTFF !< Flag indicating the full difference QTF should be calculated [-] - LOGICAL :: SumQTFF !< Flag indicating the full sum QTF should be calculated [-] - REAL(ReKi) :: 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(ReKi) :: 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(ReKi) :: WvLowCOffD !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(ReKi) :: WvHiCOffD !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(ReKi) :: WvLowCOffS !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - REAL(ReKi) :: WvHiCOffS !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction from Waves module [-] + REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction from Waves module [-] + INTEGER(IntKi) :: WaveMod = 0_IntKi !< The wave model to use. This is for error checking -- ideally this would be done in the main calling routine, not here. [-] + INTEGER(IntKi) :: MnDrift = 0_IntKi !< Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] + INTEGER(IntKi) :: NewmanApp = 0_IntKi !< Slow drift forces computed with Newman approximation from WAMIT file:{0: No slow drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] + INTEGER(IntKi) :: DiffQTF = 0_IntKi !< Full Difference-Frequency forces computed with full QTF's from WAMIT file: {0: No diff-QTF; [10,11, or 12]: WAMIT file to use} [-] + INTEGER(IntKi) :: SumQTF = 0_IntKi !< Full Sum-Frequency forces computed with full QTF's from WAMIT file: {0: No sum-QTF; [10,11, or 12]: WAMIT file to use} [-] + LOGICAL :: MnDriftF = .false. !< Flag indicating mean drift force should be calculated [-] + LOGICAL :: NewmanAppF = .false. !< Flag indicating Newman approximation should be calculated [-] + LOGICAL :: DiffQTFF = .false. !< Flag indicating the full difference QTF should be calculated [-] + LOGICAL :: SumQTFF = .false. !< Flag indicating the full sum QTF should be calculated [-] + REAL(ReKi) :: WvLowCOff = 0.0_ReKi !< 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(ReKi) :: WvHiCOff = 0.0_ReKi !< 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(ReKi) :: WvLowCOffD = 0.0_ReKi !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(ReKi) :: WvHiCOffD = 0.0_ReKi !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(ReKi) :: WvLowCOffS = 0.0_ReKi !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(ReKi) :: WvHiCOffS = 0.0_ReKi !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] END TYPE WAMIT2_InitInputType ! ======================= ! ========= WAMIT2_MiscVarType ======= @@ -83,18 +83,18 @@ MODULE WAMIT2_Types ! ======================= ! ========= WAMIT2_ParameterType ======= TYPE, PUBLIC :: WAMIT2_ParameterType - INTEGER(IntKi) :: NStepWave !< Number of wave time steps [-] - INTEGER(IntKi) :: 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] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of wave time steps [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=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] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveExctn2 !< Time series of the resulting 2nd order force (first index is timestep, second index is load component) [(N)] - LOGICAL , DIMENSION(1:6) :: MnDriftDims !< Flags for which dimensions to calculate in MnDrift calculations [-] - LOGICAL , DIMENSION(1:6) :: NewmanAppDims !< Flags for which dimensions to calculate in NewmanApp calculations [-] - LOGICAL , DIMENSION(1:6) :: DiffQTFDims !< Flags for which dimensions to calculate in DiffQTF calculations [-] - LOGICAL , DIMENSION(1:6) :: SumQTFDims !< Flags for which dimensions to calculate in SumQTF calculations [-] - LOGICAL :: MnDriftF !< Flag indicating mean drift force should be calculated [-] - LOGICAL :: NewmanAppF !< Flag indicating Newman approximation should be calculated [-] - LOGICAL :: DiffQTFF !< Flag indicating the full difference QTF should be calculated [-] - LOGICAL :: SumQTFF !< Flag indicating the full sum QTF should be calculated [-] + LOGICAL , DIMENSION(1:6) :: MnDriftDims = .false. !< Flags for which dimensions to calculate in MnDrift calculations [-] + LOGICAL , DIMENSION(1:6) :: NewmanAppDims = .false. !< Flags for which dimensions to calculate in NewmanApp calculations [-] + LOGICAL , DIMENSION(1:6) :: DiffQTFDims = .false. !< Flags for which dimensions to calculate in DiffQTF calculations [-] + LOGICAL , DIMENSION(1:6) :: SumQTFDims = .false. !< Flags for which dimensions to calculate in SumQTF calculations [-] + LOGICAL :: MnDriftF = .false. !< Flag indicating mean drift force should be calculated [-] + LOGICAL :: NewmanAppF = .false. !< Flag indicating Newman approximation should be calculated [-] + LOGICAL :: DiffQTFF = .false. !< Flag indicating the full difference QTF should be calculated [-] + LOGICAL :: SumQTFF = .false. !< Flag indicating the full sum QTF should be calculated [-] END TYPE WAMIT2_ParameterType ! ======================= ! ========= WAMIT2_OutputType ======= @@ -103,1321 +103,703 @@ MODULE WAMIT2_Types END TYPE WAMIT2_OutputType ! ======================= CONTAINS - SUBROUTINE WAMIT2_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(WAMIT2_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 = 'WAMIT2_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT - DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile - DstInitInputData%NBody = SrcInitInputData%NBody - DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod -IF (ALLOCATED(SrcInitInputData%PtfmRefxt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefxt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefxt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefxt)) THEN - ALLOCATE(DstInitInputData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefyt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefyt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefyt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefyt)) THEN - ALLOCATE(DstInitInputData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefzt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefzt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefzt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefzt)) THEN - ALLOCATE(DstInitInputData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefztRot)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefztRot,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefztRot,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefztRot)) THEN - ALLOCATE(DstInitInputData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot -ENDIF - DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN - DstInitInputData%RhoXg = SrcInitInputData%RhoXg - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir - DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr - DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin - DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax - DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%MnDrift = SrcInitInputData%MnDrift - DstInitInputData%NewmanApp = SrcInitInputData%NewmanApp - DstInitInputData%DiffQTF = SrcInitInputData%DiffQTF - DstInitInputData%SumQTF = SrcInitInputData%SumQTF - DstInitInputData%MnDriftF = SrcInitInputData%MnDriftF - DstInitInputData%NewmanAppF = SrcInitInputData%NewmanAppF - DstInitInputData%DiffQTFF = SrcInitInputData%DiffQTFF - DstInitInputData%SumQTFF = SrcInitInputData%SumQTFF - DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff - DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff - DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD - DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD - DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS - DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS - END SUBROUTINE WAMIT2_CopyInitInput - - SUBROUTINE WAMIT2_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(WAMIT2_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 = 'WAMIT2_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%PtfmRefxt)) THEN - DEALLOCATE(InitInputData%PtfmRefxt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefyt)) THEN - DEALLOCATE(InitInputData%PtfmRefyt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefzt)) THEN - DEALLOCATE(InitInputData%PtfmRefzt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefztRot)) THEN - DEALLOCATE(InitInputData%PtfmRefztRot) -ENDIF -NULLIFY(InitInputData%WaveElevC0) -NULLIFY(InitInputData%WaveDirArr) - END SUBROUTINE WAMIT2_DestroyInitInput - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 ! HasWAMIT - Int_BufSz = Int_BufSz + 1*LEN(InData%WAMITFile) ! WAMITFile - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Int_BufSz = Int_BufSz + 1 ! PtfmRefxt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefxt) ! PtfmRefxt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefyt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefyt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefyt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefyt) ! PtfmRefyt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefzt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefzt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefzt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefzt) ! PtfmRefzt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefztRot allocated yes/no - 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 - Re_BufSz = Re_BufSz + 1 ! WAMITULEN - Re_BufSz = Re_BufSz + 1 ! RhoXg - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - Re_BufSz = Re_BufSz + 1 ! WaveDirMin - Re_BufSz = Re_BufSz + 1 ! WaveDirMax - Int_BufSz = Int_BufSz + 1 ! WaveMod - Int_BufSz = Int_BufSz + 1 ! MnDrift - Int_BufSz = Int_BufSz + 1 ! NewmanApp - Int_BufSz = Int_BufSz + 1 ! DiffQTF - Int_BufSz = Int_BufSz + 1 ! SumQTF - Int_BufSz = Int_BufSz + 1 ! MnDriftF - Int_BufSz = Int_BufSz + 1 ! NewmanAppF - Int_BufSz = Int_BufSz + 1 ! DiffQTFF - Int_BufSz = Int_BufSz + 1 ! SumQTFF - Re_BufSz = Re_BufSz + 1 ! WvLowCOff - Re_BufSz = Re_BufSz + 1 ! WvHiCOff - Re_BufSz = Re_BufSz + 1 ! WvLowCOffD - Re_BufSz = Re_BufSz + 1 ! WvHiCOffD - Re_BufSz = Re_BufSz + 1 ! WvLowCOffS - Re_BufSz = Re_BufSz + 1 ! WvHiCOffS - 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) = TRANSFER(InData%HasWAMIT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmRefxt) ) 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%PtfmRefxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefxt,1), UBOUND(InData%PtfmRefxt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefyt) ) 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%PtfmRefyt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefyt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefyt,1), UBOUND(InData%PtfmRefyt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefyt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefzt) ) 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%PtfmRefzt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefzt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefzt,1), UBOUND(InData%PtfmRefzt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefzt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefztRot) ) 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%PtfmRefztRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefztRot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefztRot,1), UBOUND(InData%PtfmRefztRot,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%WAMITULEN - Re_Xferred = Re_Xferred + 1 - 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 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - 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%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MnDrift - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NewmanApp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DiffQTF - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SumQTF - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFF, IntKiBuf(1)) - 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 - END SUBROUTINE WAMIT2_PackInitInput - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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%HasWAMIT = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasWAMIT) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefxt 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%PtfmRefxt)) DEALLOCATE(OutData%PtfmRefxt) - ALLOCATE(OutData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefxt,1), UBOUND(OutData%PtfmRefxt,1) - OutData%PtfmRefxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefyt 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%PtfmRefyt)) DEALLOCATE(OutData%PtfmRefyt) - ALLOCATE(OutData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefyt,1), UBOUND(OutData%PtfmRefyt,1) - OutData%PtfmRefyt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefzt 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%PtfmRefzt)) DEALLOCATE(OutData%PtfmRefzt) - ALLOCATE(OutData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefzt,1), UBOUND(OutData%PtfmRefzt,1) - OutData%PtfmRefzt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefztRot 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%PtfmRefztRot)) DEALLOCATE(OutData%PtfmRefztRot) - ALLOCATE(OutData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefztRot,1), UBOUND(OutData%PtfmRefztRot,1) - OutData%PtfmRefztRot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%WAMITULEN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RhoXg = 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%WaveDOmega = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 - 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%WaveMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MnDrift = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanApp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MnDriftF = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftF) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanAppF = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppF) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%WvLowCOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WAMIT2_UnPackInitInput - - SUBROUTINE WAMIT2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(WAMIT2_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_CopyMisc' -! +subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT2_InitInputType), intent(in) :: SrcInitInputData + type(WAMIT2_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WAMIT2_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%LastIndWave)) THEN - i1_l = LBOUND(SrcMiscData%LastIndWave,1) - i1_u = UBOUND(SrcMiscData%LastIndWave,1) - IF (.NOT. ALLOCATED(DstMiscData%LastIndWave)) THEN - ALLOCATE(DstMiscData%LastIndWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LastIndWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LastIndWave = SrcMiscData%LastIndWave -ENDIF -IF (ALLOCATED(SrcMiscData%F_Waves2)) THEN - i1_l = LBOUND(SrcMiscData%F_Waves2,1) - i1_u = UBOUND(SrcMiscData%F_Waves2,1) - IF (.NOT. ALLOCATED(DstMiscData%F_Waves2)) THEN - ALLOCATE(DstMiscData%F_Waves2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Waves2 = SrcMiscData%F_Waves2 -ENDIF - END SUBROUTINE WAMIT2_CopyMisc - - SUBROUTINE WAMIT2_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(WAMIT2_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 = 'WAMIT2_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%LastIndWave)) THEN - DEALLOCATE(MiscData%LastIndWave) -ENDIF -IF (ALLOCATED(MiscData%F_Waves2)) THEN - DEALLOCATE(MiscData%F_Waves2) -ENDIF - END SUBROUTINE WAMIT2_DestroyMisc - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 allocated yes/no - IF ( ALLOCATED(InData%LastIndWave) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LastIndWave upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LastIndWave) ! LastIndWave - END IF - Int_BufSz = Int_BufSz + 1 ! F_Waves2 allocated yes/no - IF ( ALLOCATED(InData%F_Waves2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_Waves2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Waves2) ! F_Waves2 - 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%LastIndWave) ) 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%LastIndWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LastIndWave,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LastIndWave,1), UBOUND(InData%LastIndWave,1) - IntKiBuf(Int_Xferred) = InData%LastIndWave(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_Waves2) ) 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%F_Waves2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Waves2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_Waves2,1), UBOUND(InData%F_Waves2,1) - ReKiBuf(Re_Xferred) = InData%F_Waves2(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WAMIT2_PackMisc - - SUBROUTINE WAMIT2_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(WAMIT2_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LastIndWave 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%LastIndWave)) DEALLOCATE(OutData%LastIndWave) - ALLOCATE(OutData%LastIndWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LastIndWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LastIndWave,1), UBOUND(OutData%LastIndWave,1) - OutData%LastIndWave(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Waves2 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%F_Waves2)) DEALLOCATE(OutData%F_Waves2) - ALLOCATE(OutData%F_Waves2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_Waves2,1), UBOUND(OutData%F_Waves2,1) - OutData%F_Waves2(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WAMIT2_UnPackMisc - - SUBROUTINE WAMIT2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_ParameterType), INTENT(IN) :: SrcParamData - TYPE(WAMIT2_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 = 'WAMIT2_CopyParam' -! + ErrMsg = '' + DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT + DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile + DstInitInputData%NBody = SrcInitInputData%NBody + DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod + if (allocated(SrcInitInputData%PtfmRefxt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefxt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefxt) + if (.not. allocated(DstInitInputData%PtfmRefxt)) then + allocate(DstInitInputData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt + end if + if (allocated(SrcInitInputData%PtfmRefyt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefyt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefyt) + if (.not. allocated(DstInitInputData%PtfmRefyt)) then + allocate(DstInitInputData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefyt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt + end if + if (allocated(SrcInitInputData%PtfmRefzt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefzt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefzt) + if (.not. allocated(DstInitInputData%PtfmRefzt)) then + allocate(DstInitInputData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefzt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt + end if + if (allocated(SrcInitInputData%PtfmRefztRot)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + if (.not. allocated(DstInitInputData%PtfmRefztRot)) then + allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot + end if + DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN + DstInitInputData%RhoXg = SrcInitInputData%RhoXg + DstInitInputData%NStepWave = SrcInitInputData%NStepWave + DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 + DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega + DstInitInputData%WtrDens = SrcInitInputData%WtrDens + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 + DstInitInputData%WaveDir = SrcInitInputData%WaveDir + DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir + DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr + DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin + DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax + DstInitInputData%WaveMod = SrcInitInputData%WaveMod + DstInitInputData%MnDrift = SrcInitInputData%MnDrift + DstInitInputData%NewmanApp = SrcInitInputData%NewmanApp + DstInitInputData%DiffQTF = SrcInitInputData%DiffQTF + DstInitInputData%SumQTF = SrcInitInputData%SumQTF + DstInitInputData%MnDriftF = SrcInitInputData%MnDriftF + DstInitInputData%NewmanAppF = SrcInitInputData%NewmanAppF + DstInitInputData%DiffQTFF = SrcInitInputData%DiffQTFF + DstInitInputData%SumQTFF = SrcInitInputData%SumQTFF + DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff + DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff + DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD + DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD + DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS + DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS +end subroutine + +subroutine WAMIT2_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(WAMIT2_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WAMIT2_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%NBody = SrcParamData%NBody - DstParamData%NBodyMod = SrcParamData%NBodyMod -IF (ALLOCATED(SrcParamData%WaveExctn2)) THEN - i1_l = LBOUND(SrcParamData%WaveExctn2,1) - i1_u = UBOUND(SrcParamData%WaveExctn2,1) - i2_l = LBOUND(SrcParamData%WaveExctn2,2) - i2_u = UBOUND(SrcParamData%WaveExctn2,2) - IF (.NOT. ALLOCATED(DstParamData%WaveExctn2)) THEN - ALLOCATE(DstParamData%WaveExctn2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctn2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveExctn2 = SrcParamData%WaveExctn2 -ENDIF - DstParamData%MnDriftDims = SrcParamData%MnDriftDims - DstParamData%NewmanAppDims = SrcParamData%NewmanAppDims - DstParamData%DiffQTFDims = SrcParamData%DiffQTFDims - DstParamData%SumQTFDims = SrcParamData%SumQTFDims - DstParamData%MnDriftF = SrcParamData%MnDriftF - DstParamData%NewmanAppF = SrcParamData%NewmanAppF - DstParamData%DiffQTFF = SrcParamData%DiffQTFF - DstParamData%SumQTFF = SrcParamData%SumQTFF - END SUBROUTINE WAMIT2_CopyParam - - SUBROUTINE WAMIT2_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(WAMIT2_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 = 'WAMIT2_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%WaveExctn2)) THEN - DEALLOCATE(ParamData%WaveExctn2) -ENDIF - END SUBROUTINE WAMIT2_DestroyParam - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Int_BufSz = Int_BufSz + 1 ! WaveExctn2 allocated yes/no - IF ( ALLOCATED(InData%WaveExctn2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveExctn2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveExctn2) ! WaveExctn2 - END IF - Int_BufSz = Int_BufSz + SIZE(InData%MnDriftDims) ! MnDriftDims - Int_BufSz = Int_BufSz + SIZE(InData%NewmanAppDims) ! NewmanAppDims - Int_BufSz = Int_BufSz + SIZE(InData%DiffQTFDims) ! DiffQTFDims - Int_BufSz = Int_BufSz + SIZE(InData%SumQTFDims) ! SumQTFDims - Int_BufSz = Int_BufSz + 1 ! MnDriftF - Int_BufSz = Int_BufSz + 1 ! NewmanAppF - Int_BufSz = Int_BufSz + 1 ! DiffQTFF - Int_BufSz = Int_BufSz + 1 ! SumQTFF - 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%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveExctn2) ) 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%WaveExctn2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctn2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveExctn2,2), UBOUND(InData%WaveExctn2,2) - DO i1 = LBOUND(InData%WaveExctn2,1), UBOUND(InData%WaveExctn2,1) - ReKiBuf(Re_Xferred) = InData%WaveExctn2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%MnDriftDims,1), UBOUND(InData%MnDriftDims,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftDims(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%NewmanAppDims,1), UBOUND(InData%NewmanAppDims,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppDims(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%DiffQTFDims,1), UBOUND(InData%DiffQTFDims,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFDims(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%SumQTFDims,1), UBOUND(InData%SumQTFDims,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFDims(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WAMIT2_PackParam - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveExctn2 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%WaveExctn2)) DEALLOCATE(OutData%WaveExctn2) - ALLOCATE(OutData%WaveExctn2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveExctn2,2), UBOUND(OutData%WaveExctn2,2) - DO i1 = LBOUND(OutData%WaveExctn2,1), UBOUND(OutData%WaveExctn2,1) - OutData%WaveExctn2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%MnDriftDims,1) - i1_u = UBOUND(OutData%MnDriftDims,1) - DO i1 = LBOUND(OutData%MnDriftDims,1), UBOUND(OutData%MnDriftDims,1) - OutData%MnDriftDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftDims(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NewmanAppDims,1) - i1_u = UBOUND(OutData%NewmanAppDims,1) - DO i1 = LBOUND(OutData%NewmanAppDims,1), UBOUND(OutData%NewmanAppDims,1) - OutData%NewmanAppDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppDims(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%DiffQTFDims,1) - i1_u = UBOUND(OutData%DiffQTFDims,1) - DO i1 = LBOUND(OutData%DiffQTFDims,1), UBOUND(OutData%DiffQTFDims,1) - OutData%DiffQTFDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFDims(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%SumQTFDims,1) - i1_u = UBOUND(OutData%SumQTFDims,1) - DO i1 = LBOUND(OutData%SumQTFDims,1), UBOUND(OutData%SumQTFDims,1) - OutData%SumQTFDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFDims(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%MnDriftF = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftF) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanAppF = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppF) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFF) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WAMIT2_UnPackParam - - SUBROUTINE WAMIT2_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(WAMIT2_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 = 'WAMIT2_CopyOutput' -! + ErrMsg = '' + if (allocated(InitInputData%PtfmRefxt)) then + deallocate(InitInputData%PtfmRefxt) + end if + if (allocated(InitInputData%PtfmRefyt)) then + deallocate(InitInputData%PtfmRefyt) + end if + if (allocated(InitInputData%PtfmRefzt)) then + deallocate(InitInputData%PtfmRefzt) + end if + if (allocated(InitInputData%PtfmRefztRot)) then + deallocate(InitInputData%PtfmRefztRot) + end if + nullify(InitInputData%WaveElevC0) + nullify(InitInputData%WaveDirArr) +end subroutine + +subroutine WAMIT2_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT2_PackInitInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%HasWAMIT) + call RegPack(Buf, InData%WAMITFile) + call RegPack(Buf, InData%NBody) + call RegPack(Buf, InData%NBodyMod) + call RegPack(Buf, allocated(InData%PtfmRefxt)) + if (allocated(InData%PtfmRefxt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt), ubound(InData%PtfmRefxt)) + call RegPack(Buf, InData%PtfmRefxt) + end if + call RegPack(Buf, allocated(InData%PtfmRefyt)) + if (allocated(InData%PtfmRefyt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt), ubound(InData%PtfmRefyt)) + call RegPack(Buf, InData%PtfmRefyt) + end if + call RegPack(Buf, allocated(InData%PtfmRefzt)) + if (allocated(InData%PtfmRefzt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt), ubound(InData%PtfmRefzt)) + call RegPack(Buf, InData%PtfmRefzt) + end if + call RegPack(Buf, allocated(InData%PtfmRefztRot)) + if (allocated(InData%PtfmRefztRot)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) + call RegPack(Buf, InData%PtfmRefztRot) + end if + call RegPack(Buf, InData%WAMITULEN) + call RegPack(Buf, InData%RhoXg) + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, InData%NStepWave2) + call RegPack(Buf, InData%WaveDOmega) + call RegPack(Buf, InData%WtrDens) + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, associated(InData%WaveElevC0)) + if (associated(InData%WaveElevC0)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC0) + end if + end if + call RegPack(Buf, InData%WaveDir) + call RegPack(Buf, InData%WaveMultiDir) + call RegPack(Buf, associated(InData%WaveDirArr)) + if (associated(InData%WaveDirArr)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) + call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDirArr) + end if + end if + call RegPack(Buf, InData%WaveDirMin) + call RegPack(Buf, InData%WaveDirMax) + call RegPack(Buf, InData%WaveMod) + call RegPack(Buf, InData%MnDrift) + call RegPack(Buf, InData%NewmanApp) + call RegPack(Buf, InData%DiffQTF) + call RegPack(Buf, InData%SumQTF) + call RegPack(Buf, InData%MnDriftF) + call RegPack(Buf, InData%NewmanAppF) + call RegPack(Buf, InData%DiffQTFF) + call RegPack(Buf, InData%SumQTFF) + call RegPack(Buf, InData%WvLowCOff) + call RegPack(Buf, InData%WvHiCOff) + call RegPack(Buf, InData%WvLowCOffD) + call RegPack(Buf, InData%WvHiCOffD) + call RegPack(Buf, InData%WvLowCOffS) + call RegPack(Buf, InData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT2_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT2_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%HasWAMIT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WAMITFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PtfmRefxt)) deallocate(OutData%PtfmRefxt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefxt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefxt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PtfmRefyt)) deallocate(OutData%PtfmRefyt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefyt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefyt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PtfmRefzt)) deallocate(OutData%PtfmRefzt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefzt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefztRot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefztRot) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%WAMITULEN) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RhoXg) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) + OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 + else + allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) + call RegUnpack(Buf, OutData%WaveElevC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC0 => null() + end if + call RegUnpack(Buf, OutData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) + OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr + else + allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) + call RegUnpack(Buf, OutData%WaveDirArr) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDirArr => null() + end if + call RegUnpack(Buf, OutData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MnDrift) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NewmanApp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DiffQTF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SumQTF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MnDriftF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NewmanAppF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DiffQTFF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SumQTFF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOffD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOffD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOffS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT2_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT2_MiscVarType), intent(in) :: SrcMiscData + type(WAMIT2_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WAMIT2_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT2_CopyOutput - - SUBROUTINE WAMIT2_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(WAMIT2_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 = 'WAMIT2_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT2_DestroyOutput - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - 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 - - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - 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 WAMIT2_PackOutput - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 - 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 MeshUnpack( OutData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - 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 WAMIT2_UnPackOutput - - - SUBROUTINE WAMIT2_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(WAMIT2_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(WAMIT2_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 + ErrMsg = '' + if (allocated(SrcMiscData%LastIndWave)) then + LB(1:1) = lbound(SrcMiscData%LastIndWave) + UB(1:1) = ubound(SrcMiscData%LastIndWave) + if (.not. allocated(DstMiscData%LastIndWave)) then + allocate(DstMiscData%LastIndWave(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LastIndWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + end if + if (allocated(SrcMiscData%F_Waves2)) then + LB(1:1) = lbound(SrcMiscData%F_Waves2) + UB(1:1) = ubound(SrcMiscData%F_Waves2) + if (.not. allocated(DstMiscData%F_Waves2)) then + allocate(DstMiscData%F_Waves2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Waves2 = SrcMiscData%F_Waves2 + end if +end subroutine + +subroutine WAMIT2_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(WAMIT2_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WAMIT2_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%LastIndWave)) then + deallocate(MiscData%LastIndWave) + end if + if (allocated(MiscData%F_Waves2)) then + deallocate(MiscData%F_Waves2) + end if +end subroutine + +subroutine WAMIT2_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT2_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%LastIndWave)) + if (allocated(InData%LastIndWave)) then + call RegPackBounds(Buf, 1, lbound(InData%LastIndWave), ubound(InData%LastIndWave)) + call RegPack(Buf, InData%LastIndWave) + end if + call RegPack(Buf, allocated(InData%F_Waves2)) + if (allocated(InData%F_Waves2)) then + call RegPackBounds(Buf, 1, lbound(InData%F_Waves2), ubound(InData%F_Waves2)) + call RegPack(Buf, InData%F_Waves2) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT2_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT2_UnPackMisc' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%LastIndWave)) deallocate(OutData%LastIndWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LastIndWave(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LastIndWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_Waves2)) deallocate(OutData%F_Waves2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_Waves2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_Waves2) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine WAMIT2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT2_ParameterType), intent(in) :: SrcParamData + type(WAMIT2_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WAMIT2_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%NStepWave = SrcParamData%NStepWave + DstParamData%NBody = SrcParamData%NBody + DstParamData%NBodyMod = SrcParamData%NBodyMod + if (allocated(SrcParamData%WaveExctn2)) then + LB(1:2) = lbound(SrcParamData%WaveExctn2) + UB(1:2) = ubound(SrcParamData%WaveExctn2) + if (.not. allocated(DstParamData%WaveExctn2)) then + allocate(DstParamData%WaveExctn2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctn2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveExctn2 = SrcParamData%WaveExctn2 + end if + DstParamData%MnDriftDims = SrcParamData%MnDriftDims + DstParamData%NewmanAppDims = SrcParamData%NewmanAppDims + DstParamData%DiffQTFDims = SrcParamData%DiffQTFDims + DstParamData%SumQTFDims = SrcParamData%SumQTFDims + DstParamData%MnDriftF = SrcParamData%MnDriftF + DstParamData%NewmanAppF = SrcParamData%NewmanAppF + DstParamData%DiffQTFF = SrcParamData%DiffQTFF + DstParamData%SumQTFF = SrcParamData%SumQTFF +end subroutine + +subroutine WAMIT2_DestroyParam(ParamData, ErrStat, ErrMsg) + type(WAMIT2_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WAMIT2_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%WaveExctn2)) then + deallocate(ParamData%WaveExctn2) + end if +end subroutine + +subroutine WAMIT2_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT2_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, InData%NBody) + call RegPack(Buf, InData%NBodyMod) + call RegPack(Buf, allocated(InData%WaveExctn2)) + if (allocated(InData%WaveExctn2)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveExctn2), ubound(InData%WaveExctn2)) + call RegPack(Buf, InData%WaveExctn2) + end if + call RegPack(Buf, InData%MnDriftDims) + call RegPack(Buf, InData%NewmanAppDims) + call RegPack(Buf, InData%DiffQTFDims) + call RegPack(Buf, InData%SumQTFDims) + call RegPack(Buf, InData%MnDriftF) + call RegPack(Buf, InData%NewmanAppF) + call RegPack(Buf, InData%DiffQTFF) + call RegPack(Buf, InData%SumQTFF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT2_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT2_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WaveExctn2)) deallocate(OutData%WaveExctn2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveExctn2(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveExctn2) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%MnDriftDims) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NewmanAppDims) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DiffQTFDims) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SumQTFDims) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MnDriftF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NewmanAppF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DiffQTFF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SumQTFF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT2_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT2_OutputType), intent(inout) :: SrcOutputData + type(WAMIT2_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT2_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT2_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(WAMIT2_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT2_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT2_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT2_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%Mesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT2_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT2_UnPackOutput' + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%Mesh) ! Mesh +end subroutine + +subroutine WAMIT2_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(WAMIT2_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(WAMIT2_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 = 'WAMIT2_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 WAMIT2_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL WAMIT2_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 WAMIT2_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 WAMIT2_Output_ExtrapInterp - - - SUBROUTINE WAMIT2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call WAMIT2_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call WAMIT2_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call WAMIT2_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE WAMIT2_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. @@ -1429,41 +811,42 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(WAMIT2_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 + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(WAMIT2_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 = 'WAMIT2_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT2_Output_ExtrapInterp1 - - - SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE WAMIT2_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. @@ -1477,47 +860,47 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(WAMIT2_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 + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(WAMIT2_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 = 'WAMIT2_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT2_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE WAMIT2_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index b89a163f66..f09135bcc5 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -38,41 +38,41 @@ MODULE WAMIT_Types IMPLICIT NONE ! ========= WAMIT_InitInputType ======= TYPE, PUBLIC :: WAMIT_InitInputType - INTEGER(IntKi) :: 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] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] - REAL(ReKi) :: Gravity !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDpth !< Water depth (positive-valued) [m] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=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] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmVol0 !< [-] - LOGICAL :: HasWAMIT !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] - REAL(ReKi) :: WAMITULEN !< [-] + LOGICAL :: HasWAMIT = .false. !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] + REAL(ReKi) :: WAMITULEN = 0.0_ReKi !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefxt !< The xt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1 ] [(m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefyt !< The yt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1 ] [(m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefzt !< The zt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmCOBxt !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmCOByt !< [-] - INTEGER(IntKi) :: RdtnMod !< [-] - INTEGER(IntKi) :: ExctnMod !< [-] - INTEGER(IntKi) :: ExctnDisp !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] - REAL(ReKi) :: ExctnCutOff !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] - REAL(DbKi) :: RdtnTMax !< [-] - REAL(ReKi) :: WaveDir !< [-] + INTEGER(IntKi) :: RdtnMod = 0_IntKi !< [-] + INTEGER(IntKi) :: ExctnMod = 0_IntKi !< [-] + INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] + REAL(ReKi) :: ExctnCutOff = 0.0_ReKi !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] + REAL(DbKi) :: RdtnTMax = 0.0_R8Ki !< [-] + REAL(ReKi) :: WaveDir = 0.0_ReKi !< [-] CHARACTER(1024) :: WAMITFile !< [-] TYPE(Conv_Rdtn_InitInputType) :: Conv_Rdtn !< [-] - REAL(ReKi) :: Rhoxg !< [-] - INTEGER(IntKi) :: NStepWave !< [-] - INTEGER(IntKi) :: NStepWave2 !< [-] - REAL(ReKi) :: WaveDOmega !< [-] + REAL(ReKi) :: Rhoxg = 0.0_ReKi !< [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] + INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< [-] + REAL(ReKi) :: WaveDOmega = 0.0_ReKi !< [-] 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(:,:,:), 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 !< [-] + INTEGER(IntKi) :: WaveMod = 0_IntKi !< [-] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Array of wave directions (one per frequency) from the Waves module (points to SeaState module data) [-] - REAL(SiKi) :: WaveDirMin !< Minimum wave direction from Waves module [-] - REAL(SiKi) :: WaveDirMax !< Maximum wave direction from Waves module [-] + REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction from Waves module [-] + REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction from Waves module [-] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] END TYPE WAMIT_InitInputType ! ======================= @@ -107,7 +107,7 @@ MODULE WAMIT_Types ! ======================= ! ========= WAMIT_MiscVarType ======= TYPE, PUBLIC :: WAMIT_MiscVarType - INTEGER(IntKi) :: LastIndWave !< [-] + INTEGER(IntKi) :: LastIndWave = 0_IntKi !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_HS !< local variable in CalcOutput:Total load contribution from hydrostatics, including the effects of waterplane area and the center of buoyancy [(N, N-m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Waves1 !< local variable in CalcOutput:Total load contribution from incident waves (i.e., the diffraction problem) [(N, N-m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Rdtn !< local variable in CalcOutput:Total load contribution from wave radiation damping (i.e., the diffraction problem) [(N, N-m)] @@ -126,23 +126,23 @@ MODULE WAMIT_Types ! ======================= ! ========= WAMIT_ParameterType ======= TYPE, PUBLIC :: WAMIT_ParameterType - INTEGER(IntKi) :: 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] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=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] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_HS_Moment_Offset !< The offset moment due to the COB being offset from the WAMIT body's local location {matrix 3xNBody} [N-m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: HdroAdMsI !< [(sec)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: HdroSttc !< [-] - INTEGER(IntKi) :: RdtnMod !< [-] - INTEGER(IntKi) :: ExctnMod !< [-] - INTEGER(IntKi) :: ExctnDisp !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] - REAL(ReKi) :: ExctnCutOff !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] - REAL(ReKi) :: ExctnFiltConst !< Low-pass time filter constant computed from ExctnCutOff [-] + INTEGER(IntKi) :: RdtnMod = 0_IntKi !< [-] + INTEGER(IntKi) :: ExctnMod = 0_IntKi !< [-] + INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] + REAL(ReKi) :: ExctnCutOff = 0.0_ReKi !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] + REAL(ReKi) :: ExctnFiltConst = 0.0_ReKi !< Low-pass time filter constant computed from ExctnCutOff [-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveExctn !< [-] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WaveExctnGrid !< WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: Force component for eac WAMIT Body [-] - INTEGER(IntKi) :: NStepWave !< [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] TYPE(Conv_Rdtn_ParameterType) :: Conv_Rdtn !< [-] TYPE(SS_Rad_ParameterType) :: SS_Rdtn !< [-] TYPE(SS_Exc_ParameterType) :: SS_Exctn !< [-] - REAL(DbKi) :: DT !< [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< [-] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] END TYPE WAMIT_ParameterType ! ======================= @@ -157,5114 +157,1546 @@ MODULE WAMIT_Types END TYPE WAMIT_OutputType ! ======================= CONTAINS - SUBROUTINE WAMIT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(WAMIT_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%NBody = SrcInitInputData%NBody - DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth -IF (ALLOCATED(SrcInitInputData%PtfmVol0)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmVol0,1) - i1_u = UBOUND(SrcInitInputData%PtfmVol0,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmVol0)) THEN - ALLOCATE(DstInitInputData%PtfmVol0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmVol0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmVol0 = SrcInitInputData%PtfmVol0 -ENDIF - DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT - DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN -IF (ALLOCATED(SrcInitInputData%PtfmRefxt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefxt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefxt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefxt)) THEN - ALLOCATE(DstInitInputData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefyt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefyt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefyt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefyt)) THEN - ALLOCATE(DstInitInputData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefzt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefzt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefzt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefzt)) THEN - ALLOCATE(DstInitInputData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefztRot)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefztRot,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefztRot,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefztRot)) THEN - ALLOCATE(DstInitInputData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmCOBxt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmCOBxt,1) - i1_u = UBOUND(SrcInitInputData%PtfmCOBxt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmCOBxt)) THEN - ALLOCATE(DstInitInputData%PtfmCOBxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmCOBxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmCOBxt = SrcInitInputData%PtfmCOBxt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmCOByt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmCOByt,1) - i1_u = UBOUND(SrcInitInputData%PtfmCOByt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmCOByt)) THEN - ALLOCATE(DstInitInputData%PtfmCOByt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmCOByt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmCOByt = SrcInitInputData%PtfmCOByt -ENDIF - DstInitInputData%RdtnMod = SrcInitInputData%RdtnMod - DstInitInputData%ExctnMod = SrcInitInputData%ExctnMod - DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp - DstInitInputData%ExctnCutOff = SrcInitInputData%ExctnCutOff - DstInitInputData%RdtnTMax = SrcInitInputData%RdtnTMax - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile - CALL Conv_Rdtn_CopyInitInput( SrcInitInputData%Conv_Rdtn, DstInitInputData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%Rhoxg = SrcInitInputData%Rhoxg - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega - DstInitInputData%WaveElev0 => SrcInitInputData%WaveElev0 - DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 - DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 - DstInitInputData%WaveElevC => SrcInitInputData%WaveElevC - DstInitInputData%WaveTime => SrcInitInputData%WaveTime - DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyInitInput - - SUBROUTINE WAMIT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(WAMIT_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 = 'WAMIT_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%PtfmVol0)) THEN - DEALLOCATE(InitInputData%PtfmVol0) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefxt)) THEN - DEALLOCATE(InitInputData%PtfmRefxt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefyt)) THEN - DEALLOCATE(InitInputData%PtfmRefyt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefzt)) THEN - DEALLOCATE(InitInputData%PtfmRefzt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefztRot)) THEN - DEALLOCATE(InitInputData%PtfmRefztRot) -ENDIF -IF (ALLOCATED(InitInputData%PtfmCOBxt)) THEN - DEALLOCATE(InitInputData%PtfmCOBxt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmCOByt)) THEN - DEALLOCATE(InitInputData%PtfmCOByt) -ENDIF - CALL Conv_Rdtn_DestroyInitInput( InitInputData%Conv_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -NULLIFY(InitInputData%WaveElev0) -NULLIFY(InitInputData%WaveElev1) -NULLIFY(InitInputData%WaveElevC0) -NULLIFY(InitInputData%WaveElevC) -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 - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! PtfmVol0 allocated yes/no - IF ( ALLOCATED(InData%PtfmVol0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmVol0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmVol0) ! PtfmVol0 - END IF - Int_BufSz = Int_BufSz + 1 ! HasWAMIT - Re_BufSz = Re_BufSz + 1 ! WAMITULEN - Int_BufSz = Int_BufSz + 1 ! PtfmRefxt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefxt) ! PtfmRefxt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefyt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefyt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefyt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefyt) ! PtfmRefyt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefzt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefzt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefzt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefzt) ! PtfmRefzt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefztRot allocated yes/no - 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 ! PtfmCOBxt allocated yes/no - IF ( ALLOCATED(InData%PtfmCOBxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmCOBxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmCOBxt) ! PtfmCOBxt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmCOByt allocated yes/no - IF ( ALLOCATED(InData%PtfmCOByt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmCOByt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmCOByt) ! PtfmCOByt - END IF - Int_BufSz = Int_BufSz + 1 ! RdtnMod - Int_BufSz = Int_BufSz + 1 ! ExctnMod - Int_BufSz = Int_BufSz + 1 ! ExctnDisp - Re_BufSz = Re_BufSz + 1 ! ExctnCutOff - Db_BufSz = Db_BufSz + 1 ! RdtnTMax - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1*LEN(InData%WAMITFile) ! WAMITFile - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! Rhoxg - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Int_BufSz = Int_BufSz + 1 ! WaveMod - Re_BufSz = Re_BufSz + 1 ! WtrDens - 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 - 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 - 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%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmVol0) ) 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%PtfmVol0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmVol0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmVol0,1), UBOUND(InData%PtfmVol0,1) - ReKiBuf(Re_Xferred) = InData%PtfmVol0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%HasWAMIT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WAMITULEN - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmRefxt) ) 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%PtfmRefxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefxt,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%PtfmRefxt,1), UBOUND(InData%PtfmRefxt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefyt) ) 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%PtfmRefyt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefyt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefyt,1), UBOUND(InData%PtfmRefyt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefyt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefzt) ) 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%PtfmRefzt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefzt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefzt,1), UBOUND(InData%PtfmRefzt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefzt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefztRot) ) 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%PtfmRefztRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefztRot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefztRot,1), UBOUND(InData%PtfmRefztRot,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmCOBxt) ) 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%PtfmCOBxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmCOBxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmCOBxt,1), UBOUND(InData%PtfmCOBxt,1) - ReKiBuf(Re_Xferred) = InData%PtfmCOBxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmCOByt) ) 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%PtfmCOByt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmCOByt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmCOByt,1), UBOUND(InData%PtfmCOByt,1) - ReKiBuf(Re_Xferred) = InData%PtfmCOByt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%RdtnMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ExctnMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ExctnDisp - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExctnCutOff - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%RdtnTMax - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - CALL Conv_Rdtn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - 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%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 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMax - 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 - END SUBROUTINE WAMIT_PackInitInput - - SUBROUTINE WAMIT_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(WAMIT_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_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%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmVol0 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%PtfmVol0)) DEALLOCATE(OutData%PtfmVol0) - ALLOCATE(OutData%PtfmVol0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmVol0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmVol0,1), UBOUND(OutData%PtfmVol0,1) - OutData%PtfmVol0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%HasWAMIT = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasWAMIT) - Int_Xferred = Int_Xferred + 1 - OutData%WAMITULEN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefxt 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%PtfmRefxt)) DEALLOCATE(OutData%PtfmRefxt) - ALLOCATE(OutData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefxt,1), UBOUND(OutData%PtfmRefxt,1) - OutData%PtfmRefxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefyt 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%PtfmRefyt)) DEALLOCATE(OutData%PtfmRefyt) - ALLOCATE(OutData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefyt,1), UBOUND(OutData%PtfmRefyt,1) - OutData%PtfmRefyt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefzt 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%PtfmRefzt)) DEALLOCATE(OutData%PtfmRefzt) - ALLOCATE(OutData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefzt,1), UBOUND(OutData%PtfmRefzt,1) - OutData%PtfmRefzt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefztRot 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%PtfmRefztRot)) DEALLOCATE(OutData%PtfmRefztRot) - ALLOCATE(OutData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefztRot,1), UBOUND(OutData%PtfmRefztRot,1) - OutData%PtfmRefztRot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmCOBxt 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%PtfmCOBxt)) DEALLOCATE(OutData%PtfmCOBxt) - ALLOCATE(OutData%PtfmCOBxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOBxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmCOBxt,1), UBOUND(OutData%PtfmCOBxt,1) - OutData%PtfmCOBxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmCOByt 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%PtfmCOByt)) DEALLOCATE(OutData%PtfmCOByt) - ALLOCATE(OutData%PtfmCOByt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOByt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmCOByt,1), UBOUND(OutData%PtfmCOByt,1) - OutData%PtfmCOByt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%RdtnMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnDisp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnCutOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RdtnTMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WaveDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 Conv_Rdtn_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - 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%Rhoxg = 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%WaveDOmega = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - NULLIFY(OutData%WaveElev0) - NULLIFY(OutData%WaveElev1) - NULLIFY(OutData%WaveElevC0) - NULLIFY(OutData%WaveElevC) - NULLIFY(OutData%WaveTime) - OutData%WaveMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 - 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) - END SUBROUTINE WAMIT_UnPackInitInput - - SUBROUTINE WAMIT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(WAMIT_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 = 'WAMIT_CopyContState' -! +subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_InitInputType), intent(in) :: SrcInitInputData + type(WAMIT_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL SS_Rad_CopyContState( SrcContStateData%SS_Rdtn, DstContStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyContState( SrcContStateData%SS_Exctn, DstContStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Conv_Rdtn_CopyContState( SrcContStateData%Conv_Rdtn, DstContStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyContState - - SUBROUTINE WAMIT_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(WAMIT_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 = 'WAMIT_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyContState( ContStateData%Conv_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyContState - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - 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 - - CALL SS_Rad_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - 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 - CALL SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - 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 - CALL Conv_Rdtn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - 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 WAMIT_PackContState - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - 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 SS_Rad_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - 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) - 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 SS_Exc_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - 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) - 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 Conv_Rdtn_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - 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 WAMIT_UnPackContState - - SUBROUTINE WAMIT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(WAMIT_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) :: 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 = 'WAMIT_CopyDiscState' -! + ErrMsg = '' + DstInitInputData%NBody = SrcInitInputData%NBody + DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + if (allocated(SrcInitInputData%PtfmVol0)) then + LB(1:1) = lbound(SrcInitInputData%PtfmVol0) + UB(1:1) = ubound(SrcInitInputData%PtfmVol0) + if (.not. allocated(DstInitInputData%PtfmVol0)) then + allocate(DstInitInputData%PtfmVol0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmVol0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmVol0 = SrcInitInputData%PtfmVol0 + end if + DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT + DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN + if (allocated(SrcInitInputData%PtfmRefxt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefxt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefxt) + if (.not. allocated(DstInitInputData%PtfmRefxt)) then + allocate(DstInitInputData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt + end if + if (allocated(SrcInitInputData%PtfmRefyt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefyt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefyt) + if (.not. allocated(DstInitInputData%PtfmRefyt)) then + allocate(DstInitInputData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefyt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt + end if + if (allocated(SrcInitInputData%PtfmRefzt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefzt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefzt) + if (.not. allocated(DstInitInputData%PtfmRefzt)) then + allocate(DstInitInputData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefzt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt + end if + if (allocated(SrcInitInputData%PtfmRefztRot)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + if (.not. allocated(DstInitInputData%PtfmRefztRot)) then + allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot + end if + if (allocated(SrcInitInputData%PtfmCOBxt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmCOBxt) + UB(1:1) = ubound(SrcInitInputData%PtfmCOBxt) + if (.not. allocated(DstInitInputData%PtfmCOBxt)) then + allocate(DstInitInputData%PtfmCOBxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmCOBxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmCOBxt = SrcInitInputData%PtfmCOBxt + end if + if (allocated(SrcInitInputData%PtfmCOByt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmCOByt) + UB(1:1) = ubound(SrcInitInputData%PtfmCOByt) + if (.not. allocated(DstInitInputData%PtfmCOByt)) then + allocate(DstInitInputData%PtfmCOByt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmCOByt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmCOByt = SrcInitInputData%PtfmCOByt + end if + DstInitInputData%RdtnMod = SrcInitInputData%RdtnMod + DstInitInputData%ExctnMod = SrcInitInputData%ExctnMod + DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp + DstInitInputData%ExctnCutOff = SrcInitInputData%ExctnCutOff + DstInitInputData%RdtnTMax = SrcInitInputData%RdtnTMax + DstInitInputData%WaveDir = SrcInitInputData%WaveDir + DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile + call Conv_Rdtn_CopyInitInput(SrcInitInputData%Conv_Rdtn, DstInitInputData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%Rhoxg = SrcInitInputData%Rhoxg + DstInitInputData%NStepWave = SrcInitInputData%NStepWave + DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 + DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega + DstInitInputData%WaveElev0 => SrcInitInputData%WaveElev0 + DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 + DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 + DstInitInputData%WaveElevC => SrcInitInputData%WaveElevC + DstInitInputData%WaveTime => SrcInitInputData%WaveTime + DstInitInputData%WaveMod = SrcInitInputData%WaveMod + DstInitInputData%WtrDens = SrcInitInputData%WtrDens + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(WAMIT_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL Conv_Rdtn_CopyDiscState( SrcDiscStateData%Conv_Rdtn, DstDiscStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyDiscState( SrcDiscStateData%SS_Rdtn, DstDiscStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyDiscState( SrcDiscStateData%SS_Exctn, DstDiscStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcDiscStateData%BdyPosFilt)) THEN - i1_l = LBOUND(SrcDiscStateData%BdyPosFilt,1) - i1_u = UBOUND(SrcDiscStateData%BdyPosFilt,1) - i2_l = LBOUND(SrcDiscStateData%BdyPosFilt,2) - i2_u = UBOUND(SrcDiscStateData%BdyPosFilt,2) - i3_l = LBOUND(SrcDiscStateData%BdyPosFilt,3) - i3_u = UBOUND(SrcDiscStateData%BdyPosFilt,3) - IF (.NOT. ALLOCATED(DstDiscStateData%BdyPosFilt)) THEN - ALLOCATE(DstDiscStateData%BdyPosFilt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%BdyPosFilt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%BdyPosFilt = SrcDiscStateData%BdyPosFilt -ENDIF - END SUBROUTINE WAMIT_CopyDiscState - - SUBROUTINE WAMIT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(WAMIT_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 = 'WAMIT_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyDiscState( DiscStateData%SS_Exctn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(DiscStateData%BdyPosFilt)) THEN - DEALLOCATE(DiscStateData%BdyPosFilt) -ENDIF - END SUBROUTINE WAMIT_DestroyDiscState - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BdyPosFilt allocated yes/no - IF ( ALLOCATED(InData%BdyPosFilt) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BdyPosFilt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BdyPosFilt) ! BdyPosFilt - 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 - - CALL Conv_Rdtn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - 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 - CALL SS_Rad_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - 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 - CALL SS_Exc_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - 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 - IF ( .NOT. ALLOCATED(InData%BdyPosFilt) ) 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%BdyPosFilt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BdyPosFilt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BdyPosFilt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BdyPosFilt,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BdyPosFilt,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BdyPosFilt,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%BdyPosFilt,3), UBOUND(InData%BdyPosFilt,3) - DO i2 = LBOUND(InData%BdyPosFilt,2), UBOUND(InData%BdyPosFilt,2) - DO i1 = LBOUND(InData%BdyPosFilt,1), UBOUND(InData%BdyPosFilt,1) - ReKiBuf(Re_Xferred) = InData%BdyPosFilt(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE WAMIT_PackDiscState - - SUBROUTINE WAMIT_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(WAMIT_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) :: 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 = 'WAMIT_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 - 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 Conv_Rdtn_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - 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) - 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 SS_Rad_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - 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) - 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 SS_Exc_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BdyPosFilt 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%BdyPosFilt)) DEALLOCATE(OutData%BdyPosFilt) - ALLOCATE(OutData%BdyPosFilt(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%BdyPosFilt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%BdyPosFilt,3), UBOUND(OutData%BdyPosFilt,3) - DO i2 = LBOUND(OutData%BdyPosFilt,2), UBOUND(OutData%BdyPosFilt,2) - DO i1 = LBOUND(OutData%BdyPosFilt,1), UBOUND(OutData%BdyPosFilt,1) - OutData%BdyPosFilt(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE WAMIT_UnPackDiscState - - SUBROUTINE WAMIT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(WAMIT_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 = 'WAMIT_CopyConstrState' -! + ErrMsg = '' + if (allocated(InitInputData%PtfmVol0)) then + deallocate(InitInputData%PtfmVol0) + end if + if (allocated(InitInputData%PtfmRefxt)) then + deallocate(InitInputData%PtfmRefxt) + end if + if (allocated(InitInputData%PtfmRefyt)) then + deallocate(InitInputData%PtfmRefyt) + end if + if (allocated(InitInputData%PtfmRefzt)) then + deallocate(InitInputData%PtfmRefzt) + end if + if (allocated(InitInputData%PtfmRefztRot)) then + deallocate(InitInputData%PtfmRefztRot) + end if + if (allocated(InitInputData%PtfmCOBxt)) then + deallocate(InitInputData%PtfmCOBxt) + end if + if (allocated(InitInputData%PtfmCOByt)) then + deallocate(InitInputData%PtfmCOByt) + end if + call Conv_Rdtn_DestroyInitInput(InitInputData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitInputData%WaveElev0) + nullify(InitInputData%WaveElev1) + nullify(InitInputData%WaveElevC0) + nullify(InitInputData%WaveElevC) + 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 + +subroutine WAMIT_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackInitInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%NBody) + call RegPack(Buf, InData%NBodyMod) + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, allocated(InData%PtfmVol0)) + if (allocated(InData%PtfmVol0)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmVol0), ubound(InData%PtfmVol0)) + call RegPack(Buf, InData%PtfmVol0) + end if + call RegPack(Buf, InData%HasWAMIT) + call RegPack(Buf, InData%WAMITULEN) + call RegPack(Buf, allocated(InData%PtfmRefxt)) + if (allocated(InData%PtfmRefxt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt), ubound(InData%PtfmRefxt)) + call RegPack(Buf, InData%PtfmRefxt) + end if + call RegPack(Buf, allocated(InData%PtfmRefyt)) + if (allocated(InData%PtfmRefyt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt), ubound(InData%PtfmRefyt)) + call RegPack(Buf, InData%PtfmRefyt) + end if + call RegPack(Buf, allocated(InData%PtfmRefzt)) + if (allocated(InData%PtfmRefzt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt), ubound(InData%PtfmRefzt)) + call RegPack(Buf, InData%PtfmRefzt) + end if + call RegPack(Buf, allocated(InData%PtfmRefztRot)) + if (allocated(InData%PtfmRefztRot)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) + call RegPack(Buf, InData%PtfmRefztRot) + end if + call RegPack(Buf, allocated(InData%PtfmCOBxt)) + if (allocated(InData%PtfmCOBxt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmCOBxt), ubound(InData%PtfmCOBxt)) + call RegPack(Buf, InData%PtfmCOBxt) + end if + call RegPack(Buf, allocated(InData%PtfmCOByt)) + if (allocated(InData%PtfmCOByt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmCOByt), ubound(InData%PtfmCOByt)) + call RegPack(Buf, InData%PtfmCOByt) + end if + call RegPack(Buf, InData%RdtnMod) + call RegPack(Buf, InData%ExctnMod) + call RegPack(Buf, InData%ExctnDisp) + call RegPack(Buf, InData%ExctnCutOff) + call RegPack(Buf, InData%RdtnTMax) + call RegPack(Buf, InData%WaveDir) + call RegPack(Buf, InData%WAMITFile) + call Conv_Rdtn_PackInitInput(Buf, InData%Conv_Rdtn) + call RegPack(Buf, InData%Rhoxg) + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, InData%NStepWave2) + call RegPack(Buf, InData%WaveDOmega) + call RegPack(Buf, associated(InData%WaveElev0)) + if (associated(InData%WaveElev0)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) + call RegPackPointer(Buf, c_loc(InData%WaveElev0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev0) + end if + end if + call RegPack(Buf, associated(InData%WaveElev1)) + if (associated(InData%WaveElev1)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPackPointer(Buf, c_loc(InData%WaveElev1), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev1) + end if + end if + call RegPack(Buf, associated(InData%WaveElevC0)) + if (associated(InData%WaveElevC0)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC0) + end if + end if + call RegPack(Buf, associated(InData%WaveElevC)) + if (associated(InData%WaveElevC)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC) + end if + end if + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + call RegPack(Buf, InData%WaveMod) + call RegPack(Buf, InData%WtrDens) + call RegPack(Buf, associated(InData%WaveDirArr)) + if (associated(InData%WaveDirArr)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) + call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDirArr) + end if + end if + call RegPack(Buf, InData%WaveDirMin) + call RegPack(Buf, InData%WaveDirMax) + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PtfmVol0)) deallocate(OutData%PtfmVol0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmVol0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmVol0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmVol0) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%HasWAMIT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WAMITULEN) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PtfmRefxt)) deallocate(OutData%PtfmRefxt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefxt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefxt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PtfmRefyt)) deallocate(OutData%PtfmRefyt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefyt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefyt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PtfmRefzt)) deallocate(OutData%PtfmRefzt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefzt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefztRot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefztRot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PtfmCOBxt)) deallocate(OutData%PtfmCOBxt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmCOBxt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOBxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmCOBxt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PtfmCOByt)) deallocate(OutData%PtfmCOByt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmCOByt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOByt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmCOByt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%RdtnMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ExctnMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ExctnDisp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ExctnCutOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RdtnTMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WAMITFile) + if (RegCheckErr(Buf, RoutineName)) return + call Conv_Rdtn_UnpackInitInput(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn + call RegUnpack(Buf, OutData%Rhoxg) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev0, UB(1:1)-LB(1:1)) + OutData%WaveElev0(LB(1):) => OutData%WaveElev0 + else + allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev0) + call RegUnpack(Buf, OutData%WaveElev0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev0 => null() + end if + if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev1, UB(1:3)-LB(1:3)) + OutData%WaveElev1(LB(1):,LB(2):,LB(3):) => OutData%WaveElev1 + else + allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev1) + call RegUnpack(Buf, OutData%WaveElev1) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev1 => null() + end if + if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) + OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 + else + allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) + call RegUnpack(Buf, OutData%WaveElevC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC0 => null() + end if + if (associated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC, UB(1:3)-LB(1:3)) + OutData%WaveElevC(LB(1):,LB(2):,LB(3):) => OutData%WaveElevC + else + allocate(OutData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC) + call RegUnpack(Buf, OutData%WaveElevC) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC => null() + end if + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + call RegUnpack(Buf, OutData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) + OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr + else + allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) + call RegUnpack(Buf, OutData%WaveDirArr) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDirArr => null() + end if + call RegUnpack(Buf, OutData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p +end subroutine + +subroutine WAMIT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_ContinuousStateType), intent(in) :: SrcContStateData + type(WAMIT_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL Conv_Rdtn_CopyConstrState( SrcConstrStateData%Conv_Rdtn, DstConstrStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyConstrState( SrcConstrStateData%SS_Rdtn, DstConstrStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyConstrState( SrcConstrStateData%SS_Exctn, DstConstrStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyConstrState - - SUBROUTINE WAMIT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(WAMIT_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 = 'WAMIT_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyConstrState( ConstrStateData%SS_Exctn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyConstrState - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - 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 - - CALL Conv_Rdtn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - 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 - CALL SS_Rad_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - 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 - CALL SS_Exc_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - 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 WAMIT_PackConstrState - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - 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 Conv_Rdtn_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - 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) - 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 SS_Rad_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - 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) - 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 SS_Exc_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - 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 WAMIT_UnPackConstrState - - SUBROUTINE WAMIT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(WAMIT_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 = 'WAMIT_CopyOtherState' -! + ErrMsg = '' + call SS_Rad_CopyContState(SrcContStateData%SS_Rdtn, DstContStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyContState(SrcContStateData%SS_Exctn, DstContStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Conv_Rdtn_CopyContState(SrcContStateData%Conv_Rdtn, DstContStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(WAMIT_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL SS_Rad_CopyOtherState( SrcOtherStateData%SS_Rdtn, DstOtherStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyOtherState( SrcOtherStateData%SS_Exctn, DstOtherStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Conv_Rdtn_CopyOtherState( SrcOtherStateData%Conv_Rdtn, DstOtherStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyOtherState - - SUBROUTINE WAMIT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(WAMIT_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 = 'WAMIT_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyOtherState( OtherStateData%Conv_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyOtherState - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - 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 - - CALL SS_Rad_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - 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 - CALL SS_Exc_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - 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 - CALL Conv_Rdtn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - 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 WAMIT_PackOtherState - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - 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 SS_Rad_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - 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) - 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 SS_Exc_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - 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) - 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 Conv_Rdtn_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - 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 WAMIT_UnPackOtherState - - SUBROUTINE WAMIT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(WAMIT_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_CopyMisc' -! + ErrMsg = '' + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Conv_Rdtn_DestroyContState(ContStateData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call SS_Rad_PackContState(Buf, InData%SS_Rdtn) + call SS_Exc_PackContState(Buf, InData%SS_Exctn) + call Conv_Rdtn_PackContState(Buf, InData%Conv_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call SS_Rad_UnpackContState(Buf, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Exc_UnpackContState(Buf, OutData%SS_Exctn) ! SS_Exctn + call Conv_Rdtn_UnpackContState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn +end subroutine + +subroutine WAMIT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_DiscreteStateType), intent(in) :: SrcDiscStateData + type(WAMIT_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%LastIndWave = SrcMiscData%LastIndWave -IF (ALLOCATED(SrcMiscData%F_HS)) THEN - i1_l = LBOUND(SrcMiscData%F_HS,1) - i1_u = UBOUND(SrcMiscData%F_HS,1) - IF (.NOT. ALLOCATED(DstMiscData%F_HS)) THEN - ALLOCATE(DstMiscData%F_HS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_HS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_HS = SrcMiscData%F_HS -ENDIF -IF (ALLOCATED(SrcMiscData%F_Waves1)) THEN - i1_l = LBOUND(SrcMiscData%F_Waves1,1) - i1_u = UBOUND(SrcMiscData%F_Waves1,1) - IF (.NOT. ALLOCATED(DstMiscData%F_Waves1)) THEN - ALLOCATE(DstMiscData%F_Waves1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Waves1 = SrcMiscData%F_Waves1 -ENDIF -IF (ALLOCATED(SrcMiscData%F_Rdtn)) THEN - i1_l = LBOUND(SrcMiscData%F_Rdtn,1) - i1_u = UBOUND(SrcMiscData%F_Rdtn,1) - IF (.NOT. ALLOCATED(DstMiscData%F_Rdtn)) THEN - ALLOCATE(DstMiscData%F_Rdtn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Rdtn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Rdtn = SrcMiscData%F_Rdtn -ENDIF -IF (ALLOCATED(SrcMiscData%F_PtfmAM)) THEN - i1_l = LBOUND(SrcMiscData%F_PtfmAM,1) - i1_u = UBOUND(SrcMiscData%F_PtfmAM,1) - IF (.NOT. ALLOCATED(DstMiscData%F_PtfmAM)) THEN - ALLOCATE(DstMiscData%F_PtfmAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM -ENDIF - CALL SS_Rad_CopyMisc( SrcMiscData%SS_Rdtn, DstMiscData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyInput( SrcMiscData%SS_Rdtn_u, DstMiscData%SS_Rdtn_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyOutput( SrcMiscData%SS_Rdtn_y, DstMiscData%SS_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyMisc( SrcMiscData%SS_Exctn, DstMiscData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyInput( SrcMiscData%SS_Exctn_u, DstMiscData%SS_Exctn_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyOutput( SrcMiscData%SS_Exctn_y, DstMiscData%SS_Exctn_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Conv_Rdtn_CopyMisc( SrcMiscData%Conv_Rdtn, DstMiscData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Conv_Rdtn_CopyInput( SrcMiscData%Conv_Rdtn_u, DstMiscData%Conv_Rdtn_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Conv_Rdtn_CopyOutput( SrcMiscData%Conv_Rdtn_y, DstMiscData%Conv_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SeaSt_Interp_CopyMisc( SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyMisc - - SUBROUTINE WAMIT_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(WAMIT_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 = 'WAMIT_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%F_HS)) THEN - DEALLOCATE(MiscData%F_HS) -ENDIF -IF (ALLOCATED(MiscData%F_Waves1)) THEN - DEALLOCATE(MiscData%F_Waves1) -ENDIF -IF (ALLOCATED(MiscData%F_Rdtn)) THEN - DEALLOCATE(MiscData%F_Rdtn) -ENDIF -IF (ALLOCATED(MiscData%F_PtfmAM)) THEN - DEALLOCATE(MiscData%F_PtfmAM) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyOutput( MiscData%Conv_Rdtn_y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_Interp_DestroyMisc( MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyMisc - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - Int_BufSz = Int_BufSz + 1 ! F_HS allocated yes/no - IF ( ALLOCATED(InData%F_HS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_HS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_HS) ! F_HS - END IF - Int_BufSz = Int_BufSz + 1 ! F_Waves1 allocated yes/no - IF ( ALLOCATED(InData%F_Waves1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_Waves1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Waves1) ! F_Waves1 - END IF - Int_BufSz = Int_BufSz + 1 ! F_Rdtn allocated yes/no - IF ( ALLOCATED(InData%F_Rdtn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_Rdtn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Rdtn) ! F_Rdtn - END IF - Int_BufSz = Int_BufSz + 1 ! F_PtfmAM allocated yes/no - IF ( ALLOCATED(InData%F_PtfmAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_PtfmAM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_PtfmAM) ! F_PtfmAM - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn_u: size of buffers for each call to pack subtype - CALL SS_Rad_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn_u, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn_y: size of buffers for each call to pack subtype - CALL SS_Rad_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn_y, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn_u: size of buffers for each call to pack subtype - CALL SS_Exc_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_u, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn_y: size of buffers for each call to pack subtype - CALL SS_Exc_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_y, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn_u: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn_u, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn_y: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn_y, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 - 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 - IF ( .NOT. ALLOCATED(InData%F_HS) ) 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%F_HS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_HS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_HS,1), UBOUND(InData%F_HS,1) - ReKiBuf(Re_Xferred) = InData%F_HS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_Waves1) ) 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%F_Waves1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Waves1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_Waves1,1), UBOUND(InData%F_Waves1,1) - ReKiBuf(Re_Xferred) = InData%F_Waves1(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_Rdtn) ) 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%F_Rdtn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Rdtn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_Rdtn,1), UBOUND(InData%F_Rdtn,1) - ReKiBuf(Re_Xferred) = InData%F_Rdtn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_PtfmAM) ) 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%F_PtfmAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_PtfmAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_PtfmAM,1), UBOUND(InData%F_PtfmAM,1) - ReKiBuf(Re_Xferred) = InData%F_PtfmAM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL SS_Rad_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - 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 - CALL SS_Rad_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn_u, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn_u - 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 - CALL SS_Rad_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn_y, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn_y - 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 - CALL SS_Exc_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - 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 - CALL SS_Exc_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_u, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn_u - 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 - CALL SS_Exc_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_y, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn_y - 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 - CALL Conv_Rdtn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - 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 - CALL Conv_Rdtn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn_u, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn_u - 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 - CALL Conv_Rdtn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn_y, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn_y - 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 - 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 WAMIT_PackMisc - - SUBROUTINE WAMIT_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(WAMIT_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_HS 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%F_HS)) DEALLOCATE(OutData%F_HS) - ALLOCATE(OutData%F_HS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_HS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_HS,1), UBOUND(OutData%F_HS,1) - OutData%F_HS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Waves1 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%F_Waves1)) DEALLOCATE(OutData%F_Waves1) - ALLOCATE(OutData%F_Waves1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_Waves1,1), UBOUND(OutData%F_Waves1,1) - OutData%F_Waves1(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Rdtn 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%F_Rdtn)) DEALLOCATE(OutData%F_Rdtn) - ALLOCATE(OutData%F_Rdtn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Rdtn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_Rdtn,1), UBOUND(OutData%F_Rdtn,1) - OutData%F_Rdtn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_PtfmAM 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%F_PtfmAM)) DEALLOCATE(OutData%F_PtfmAM) - ALLOCATE(OutData%F_PtfmAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_PtfmAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_PtfmAM,1), UBOUND(OutData%F_PtfmAM,1) - OutData%F_PtfmAM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 SS_Rad_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - 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) - 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 SS_Rad_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn_u, ErrStat2, ErrMsg2 ) ! SS_Rdtn_u - 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) - 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 SS_Rad_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn_y, ErrStat2, ErrMsg2 ) ! SS_Rdtn_y - 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) - 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 SS_Exc_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - 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) - 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 SS_Exc_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn_u, ErrStat2, ErrMsg2 ) ! SS_Exctn_u - 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) - 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 SS_Exc_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn_y, ErrStat2, ErrMsg2 ) ! SS_Exctn_y - 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) - 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 Conv_Rdtn_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - 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) - 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 Conv_Rdtn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn_u, ErrStat2, ErrMsg2 ) ! Conv_Rdtn_u - 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) - 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 Conv_Rdtn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn_y, ErrStat2, ErrMsg2 ) ! Conv_Rdtn_y - 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) - 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 WAMIT_UnPackMisc - - SUBROUTINE WAMIT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_ParameterType), INTENT(IN) :: SrcParamData - TYPE(WAMIT_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_CopyParam' -! + ErrMsg = '' + call Conv_Rdtn_CopyDiscState(SrcDiscStateData%Conv_Rdtn, DstDiscStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Rad_CopyDiscState(SrcDiscStateData%SS_Rdtn, DstDiscStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyDiscState(SrcDiscStateData%SS_Exctn, DstDiscStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcDiscStateData%BdyPosFilt)) then + LB(1:3) = lbound(SrcDiscStateData%BdyPosFilt) + UB(1:3) = ubound(SrcDiscStateData%BdyPosFilt) + if (.not. allocated(DstDiscStateData%BdyPosFilt)) then + allocate(DstDiscStateData%BdyPosFilt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%BdyPosFilt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%BdyPosFilt = SrcDiscStateData%BdyPosFilt + end if +end subroutine + +subroutine WAMIT_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(WAMIT_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%NBody = SrcParamData%NBody - DstParamData%NBodyMod = SrcParamData%NBodyMod -IF (ALLOCATED(SrcParamData%F_HS_Moment_Offset)) THEN - i1_l = LBOUND(SrcParamData%F_HS_Moment_Offset,1) - i1_u = UBOUND(SrcParamData%F_HS_Moment_Offset,1) - i2_l = LBOUND(SrcParamData%F_HS_Moment_Offset,2) - i2_u = UBOUND(SrcParamData%F_HS_Moment_Offset,2) - IF (.NOT. ALLOCATED(DstParamData%F_HS_Moment_Offset)) THEN - ALLOCATE(DstParamData%F_HS_Moment_Offset(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_HS_Moment_Offset.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%F_HS_Moment_Offset = SrcParamData%F_HS_Moment_Offset -ENDIF -IF (ALLOCATED(SrcParamData%HdroAdMsI)) THEN - i1_l = LBOUND(SrcParamData%HdroAdMsI,1) - i1_u = UBOUND(SrcParamData%HdroAdMsI,1) - i2_l = LBOUND(SrcParamData%HdroAdMsI,2) - i2_u = UBOUND(SrcParamData%HdroAdMsI,2) - IF (.NOT. ALLOCATED(DstParamData%HdroAdMsI)) THEN - ALLOCATE(DstParamData%HdroAdMsI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HdroAdMsI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%HdroAdMsI = SrcParamData%HdroAdMsI -ENDIF -IF (ALLOCATED(SrcParamData%HdroSttc)) THEN - i1_l = LBOUND(SrcParamData%HdroSttc,1) - i1_u = UBOUND(SrcParamData%HdroSttc,1) - i2_l = LBOUND(SrcParamData%HdroSttc,2) - i2_u = UBOUND(SrcParamData%HdroSttc,2) - IF (.NOT. ALLOCATED(DstParamData%HdroSttc)) THEN - ALLOCATE(DstParamData%HdroSttc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HdroSttc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%HdroSttc = SrcParamData%HdroSttc -ENDIF - DstParamData%RdtnMod = SrcParamData%RdtnMod - DstParamData%ExctnMod = SrcParamData%ExctnMod - DstParamData%ExctnDisp = SrcParamData%ExctnDisp - DstParamData%ExctnCutOff = SrcParamData%ExctnCutOff - DstParamData%ExctnFiltConst = SrcParamData%ExctnFiltConst -IF (ALLOCATED(SrcParamData%WaveExctn)) THEN - i1_l = LBOUND(SrcParamData%WaveExctn,1) - i1_u = UBOUND(SrcParamData%WaveExctn,1) - i2_l = LBOUND(SrcParamData%WaveExctn,2) - i2_u = UBOUND(SrcParamData%WaveExctn,2) - IF (.NOT. ALLOCATED(DstParamData%WaveExctn)) THEN - ALLOCATE(DstParamData%WaveExctn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveExctn = SrcParamData%WaveExctn -ENDIF -IF (ALLOCATED(SrcParamData%WaveExctnGrid)) THEN - i1_l = LBOUND(SrcParamData%WaveExctnGrid,1) - i1_u = UBOUND(SrcParamData%WaveExctnGrid,1) - i2_l = LBOUND(SrcParamData%WaveExctnGrid,2) - i2_u = UBOUND(SrcParamData%WaveExctnGrid,2) - i3_l = LBOUND(SrcParamData%WaveExctnGrid,3) - i3_u = UBOUND(SrcParamData%WaveExctnGrid,3) - i4_l = LBOUND(SrcParamData%WaveExctnGrid,4) - i4_u = UBOUND(SrcParamData%WaveExctnGrid,4) - IF (.NOT. ALLOCATED(DstParamData%WaveExctnGrid)) THEN - ALLOCATE(DstParamData%WaveExctnGrid(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%WaveExctnGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveExctnGrid = SrcParamData%WaveExctnGrid -ENDIF - DstParamData%NStepWave = SrcParamData%NStepWave - CALL Conv_Rdtn_CopyParam( SrcParamData%Conv_Rdtn, DstParamData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyParam( SrcParamData%SS_Rdtn, DstParamData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyParam( SrcParamData%SS_Exctn, DstParamData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%DT = SrcParamData%DT - 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 WAMIT_CopyParam - - SUBROUTINE WAMIT_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(WAMIT_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 = 'WAMIT_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%F_HS_Moment_Offset)) THEN - DEALLOCATE(ParamData%F_HS_Moment_Offset) -ENDIF -IF (ALLOCATED(ParamData%HdroAdMsI)) THEN - DEALLOCATE(ParamData%HdroAdMsI) -ENDIF -IF (ALLOCATED(ParamData%HdroSttc)) THEN - DEALLOCATE(ParamData%HdroSttc) -ENDIF -IF (ALLOCATED(ParamData%WaveExctn)) THEN - DEALLOCATE(ParamData%WaveExctn) -ENDIF -IF (ALLOCATED(ParamData%WaveExctnGrid)) THEN - DEALLOCATE(ParamData%WaveExctnGrid) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyParam - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Int_BufSz = Int_BufSz + 1 ! F_HS_Moment_Offset allocated yes/no - IF ( ALLOCATED(InData%F_HS_Moment_Offset) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_HS_Moment_Offset upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_HS_Moment_Offset) ! F_HS_Moment_Offset - END IF - Int_BufSz = Int_BufSz + 1 ! HdroAdMsI allocated yes/no - IF ( ALLOCATED(InData%HdroAdMsI) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! HdroAdMsI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HdroAdMsI) ! HdroAdMsI - END IF - Int_BufSz = Int_BufSz + 1 ! HdroSttc allocated yes/no - IF ( ALLOCATED(InData%HdroSttc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! HdroSttc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HdroSttc) ! HdroSttc - END IF - Int_BufSz = Int_BufSz + 1 ! RdtnMod - Int_BufSz = Int_BufSz + 1 ! ExctnMod - Int_BufSz = Int_BufSz + 1 ! ExctnDisp - Re_BufSz = Re_BufSz + 1 ! ExctnCutOff - Re_BufSz = Re_BufSz + 1 ! ExctnFiltConst - Int_BufSz = Int_BufSz + 1 ! WaveExctn allocated yes/no - IF ( ALLOCATED(InData%WaveExctn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveExctn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveExctn) ! WaveExctn - END IF - Int_BufSz = Int_BufSz + 1 ! WaveExctnGrid allocated yes/no - IF ( ALLOCATED(InData%WaveExctnGrid) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WaveExctnGrid upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveExctnGrid) ! WaveExctnGrid - END IF - Int_BufSz = Int_BufSz + 1 ! NStepWave - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + 1 ! DT - 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 - 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%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%F_HS_Moment_Offset) ) 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%F_HS_Moment_Offset,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_HS_Moment_Offset,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_HS_Moment_Offset,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_HS_Moment_Offset,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_HS_Moment_Offset,2), UBOUND(InData%F_HS_Moment_Offset,2) - DO i1 = LBOUND(InData%F_HS_Moment_Offset,1), UBOUND(InData%F_HS_Moment_Offset,1) - ReKiBuf(Re_Xferred) = InData%F_HS_Moment_Offset(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HdroAdMsI) ) 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%HdroAdMsI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAdMsI,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroAdMsI,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAdMsI,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%HdroAdMsI,2), UBOUND(InData%HdroAdMsI,2) - DO i1 = LBOUND(InData%HdroAdMsI,1), UBOUND(InData%HdroAdMsI,1) - ReKiBuf(Re_Xferred) = InData%HdroAdMsI(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HdroSttc) ) 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%HdroSttc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroSttc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroSttc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroSttc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%HdroSttc,2), UBOUND(InData%HdroSttc,2) - DO i1 = LBOUND(InData%HdroSttc,1), UBOUND(InData%HdroSttc,1) - ReKiBuf(Re_Xferred) = InData%HdroSttc(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%RdtnMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ExctnMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ExctnDisp - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExctnCutOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExctnFiltConst - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveExctn) ) 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%WaveExctn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveExctn,2), UBOUND(InData%WaveExctn,2) - DO i1 = LBOUND(InData%WaveExctn,1), UBOUND(InData%WaveExctn,1) - ReKiBuf(Re_Xferred) = InData%WaveExctn(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveExctnGrid) ) 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%WaveExctnGrid,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctnGrid,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctnGrid,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctnGrid,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctnGrid,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctnGrid,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctnGrid,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctnGrid,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%WaveExctnGrid,4), UBOUND(InData%WaveExctnGrid,4) - DO i3 = LBOUND(InData%WaveExctnGrid,3), UBOUND(InData%WaveExctnGrid,3) - DO i2 = LBOUND(InData%WaveExctnGrid,2), UBOUND(InData%WaveExctnGrid,2) - DO i1 = LBOUND(InData%WaveExctnGrid,1), UBOUND(InData%WaveExctnGrid,1) - ReKiBuf(Re_Xferred) = InData%WaveExctnGrid(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - CALL Conv_Rdtn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - 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 - CALL SS_Rad_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - 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 - CALL SS_Exc_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - 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 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_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 - END SUBROUTINE WAMIT_PackParam - - SUBROUTINE WAMIT_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(WAMIT_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) :: 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_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%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_HS_Moment_Offset 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%F_HS_Moment_Offset)) DEALLOCATE(OutData%F_HS_Moment_Offset) - ALLOCATE(OutData%F_HS_Moment_Offset(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_HS_Moment_Offset.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_HS_Moment_Offset,2), UBOUND(OutData%F_HS_Moment_Offset,2) - DO i1 = LBOUND(OutData%F_HS_Moment_Offset,1), UBOUND(OutData%F_HS_Moment_Offset,1) - OutData%F_HS_Moment_Offset(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroAdMsI 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%HdroAdMsI)) DEALLOCATE(OutData%HdroAdMsI) - ALLOCATE(OutData%HdroAdMsI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroAdMsI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%HdroAdMsI,2), UBOUND(OutData%HdroAdMsI,2) - DO i1 = LBOUND(OutData%HdroAdMsI,1), UBOUND(OutData%HdroAdMsI,1) - OutData%HdroAdMsI(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroSttc 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%HdroSttc)) DEALLOCATE(OutData%HdroSttc) - ALLOCATE(OutData%HdroSttc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroSttc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%HdroSttc,2), UBOUND(OutData%HdroSttc,2) - DO i1 = LBOUND(OutData%HdroSttc,1), UBOUND(OutData%HdroSttc,1) - OutData%HdroSttc(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%RdtnMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnDisp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnCutOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ExctnFiltConst = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveExctn 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%WaveExctn)) DEALLOCATE(OutData%WaveExctn) - ALLOCATE(OutData%WaveExctn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveExctn,2), UBOUND(OutData%WaveExctn,2) - DO i1 = LBOUND(OutData%WaveExctn,1), UBOUND(OutData%WaveExctn,1) - OutData%WaveExctn(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveExctnGrid 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%WaveExctnGrid)) DEALLOCATE(OutData%WaveExctnGrid) - ALLOCATE(OutData%WaveExctnGrid(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%WaveExctnGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveExctnGrid,4), UBOUND(OutData%WaveExctnGrid,4) - DO i3 = LBOUND(OutData%WaveExctnGrid,3), UBOUND(OutData%WaveExctnGrid,3) - DO i2 = LBOUND(OutData%WaveExctnGrid,2), UBOUND(OutData%WaveExctnGrid,2) - DO i1 = LBOUND(OutData%WaveExctnGrid,1), UBOUND(OutData%WaveExctnGrid,1) - OutData%WaveExctnGrid(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 - 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 Conv_Rdtn_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - 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) - 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 SS_Rad_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - 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) - 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 SS_Exc_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - 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%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_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) - END SUBROUTINE WAMIT_UnPackParam - - SUBROUTINE WAMIT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_InputType), INTENT(INOUT) :: SrcInputData - TYPE(WAMIT_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 = 'WAMIT_CopyInput' -! + ErrMsg = '' + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyDiscState(DiscStateData%SS_Exctn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(DiscStateData%BdyPosFilt)) then + deallocate(DiscStateData%BdyPosFilt) + end if +end subroutine + +subroutine WAMIT_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call Conv_Rdtn_PackDiscState(Buf, InData%Conv_Rdtn) + call SS_Rad_PackDiscState(Buf, InData%SS_Rdtn) + call SS_Exc_PackDiscState(Buf, InData%SS_Exctn) + call RegPack(Buf, allocated(InData%BdyPosFilt)) + if (allocated(InData%BdyPosFilt)) then + call RegPackBounds(Buf, 3, lbound(InData%BdyPosFilt), ubound(InData%BdyPosFilt)) + call RegPack(Buf, InData%BdyPosFilt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackDiscState' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call Conv_Rdtn_UnpackDiscState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn + call SS_Rad_UnpackDiscState(Buf, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Exc_UnpackDiscState(Buf, OutData%SS_Exctn) ! SS_Exctn + if (allocated(OutData%BdyPosFilt)) deallocate(OutData%BdyPosFilt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BdyPosFilt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BdyPosFilt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BdyPosFilt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine WAMIT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_ConstraintStateType), intent(in) :: SrcConstrStateData + type(WAMIT_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%Mesh, DstInputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyInput - - SUBROUTINE WAMIT_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(WAMIT_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 = 'WAMIT_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( InputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyInput - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - 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 - - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - 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 WAMIT_PackInput - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - 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 MeshUnpack( OutData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - 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 WAMIT_UnPackInput - - SUBROUTINE WAMIT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(WAMIT_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 = 'WAMIT_CopyOutput' -! + ErrMsg = '' + call Conv_Rdtn_CopyConstrState(SrcConstrStateData%Conv_Rdtn, DstConstrStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Rad_CopyConstrState(SrcConstrStateData%SS_Rdtn, DstConstrStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyConstrState(SrcConstrStateData%SS_Exctn, DstConstrStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(WAMIT_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyConstrState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyOutput - - SUBROUTINE WAMIT_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(WAMIT_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 = 'WAMIT_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyOutput - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - 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 - - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - 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 WAMIT_PackOutput - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - 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 MeshUnpack( OutData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - 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 WAMIT_UnPackOutput - - - SUBROUTINE WAMIT_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(WAMIT_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(WAMIT_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 + ErrMsg = '' + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyConstrState(ConstrStateData%SS_Exctn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call Conv_Rdtn_PackConstrState(Buf, InData%Conv_Rdtn) + call SS_Rad_PackConstrState(Buf, InData%SS_Rdtn) + call SS_Exc_PackConstrState(Buf, InData%SS_Exctn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call Conv_Rdtn_UnpackConstrState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn + call SS_Rad_UnpackConstrState(Buf, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Exc_UnpackConstrState(Buf, OutData%SS_Exctn) ! SS_Exctn +end subroutine + +subroutine WAMIT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_OtherStateType), intent(in) :: SrcOtherStateData + type(WAMIT_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call SS_Rad_CopyOtherState(SrcOtherStateData%SS_Rdtn, DstOtherStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyOtherState(SrcOtherStateData%SS_Exctn, DstOtherStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Conv_Rdtn_CopyOtherState(SrcOtherStateData%Conv_Rdtn, DstOtherStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(WAMIT_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Conv_Rdtn_DestroyOtherState(OtherStateData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call SS_Rad_PackOtherState(Buf, InData%SS_Rdtn) + call SS_Exc_PackOtherState(Buf, InData%SS_Exctn) + call Conv_Rdtn_PackOtherState(Buf, InData%Conv_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call SS_Rad_UnpackOtherState(Buf, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Exc_UnpackOtherState(Buf, OutData%SS_Exctn) ! SS_Exctn + call Conv_Rdtn_UnpackOtherState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn +end subroutine + +subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_MiscVarType), intent(in) :: SrcMiscData + type(WAMIT_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + if (allocated(SrcMiscData%F_HS)) then + LB(1:1) = lbound(SrcMiscData%F_HS) + UB(1:1) = ubound(SrcMiscData%F_HS) + if (.not. allocated(DstMiscData%F_HS)) then + allocate(DstMiscData%F_HS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_HS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_HS = SrcMiscData%F_HS + end if + if (allocated(SrcMiscData%F_Waves1)) then + LB(1:1) = lbound(SrcMiscData%F_Waves1) + UB(1:1) = ubound(SrcMiscData%F_Waves1) + if (.not. allocated(DstMiscData%F_Waves1)) then + allocate(DstMiscData%F_Waves1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Waves1 = SrcMiscData%F_Waves1 + end if + if (allocated(SrcMiscData%F_Rdtn)) then + LB(1:1) = lbound(SrcMiscData%F_Rdtn) + UB(1:1) = ubound(SrcMiscData%F_Rdtn) + if (.not. allocated(DstMiscData%F_Rdtn)) then + allocate(DstMiscData%F_Rdtn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Rdtn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Rdtn = SrcMiscData%F_Rdtn + end if + if (allocated(SrcMiscData%F_PtfmAM)) then + LB(1:1) = lbound(SrcMiscData%F_PtfmAM) + UB(1:1) = ubound(SrcMiscData%F_PtfmAM) + if (.not. allocated(DstMiscData%F_PtfmAM)) then + allocate(DstMiscData%F_PtfmAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM + end if + call SS_Rad_CopyMisc(SrcMiscData%SS_Rdtn, DstMiscData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Rad_CopyInput(SrcMiscData%SS_Rdtn_u, DstMiscData%SS_Rdtn_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Rad_CopyOutput(SrcMiscData%SS_Rdtn_y, DstMiscData%SS_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyMisc(SrcMiscData%SS_Exctn, DstMiscData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyInput(SrcMiscData%SS_Exctn_u, DstMiscData%SS_Exctn_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyOutput(SrcMiscData%SS_Exctn_y, DstMiscData%SS_Exctn_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Conv_Rdtn_CopyMisc(SrcMiscData%Conv_Rdtn, DstMiscData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Conv_Rdtn_CopyInput(SrcMiscData%Conv_Rdtn_u, DstMiscData%Conv_Rdtn_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Conv_Rdtn_CopyOutput(SrcMiscData%Conv_Rdtn_y, DstMiscData%Conv_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_Interp_CopyMisc(SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(WAMIT_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%F_HS)) then + deallocate(MiscData%F_HS) + end if + if (allocated(MiscData%F_Waves1)) then + deallocate(MiscData%F_Waves1) + end if + if (allocated(MiscData%F_Rdtn)) then + deallocate(MiscData%F_Rdtn) + end if + if (allocated(MiscData%F_PtfmAM)) then + deallocate(MiscData%F_PtfmAM) + end if + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Conv_Rdtn_DestroyOutput(MiscData%Conv_Rdtn_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%LastIndWave) + call RegPack(Buf, allocated(InData%F_HS)) + if (allocated(InData%F_HS)) then + call RegPackBounds(Buf, 1, lbound(InData%F_HS), ubound(InData%F_HS)) + call RegPack(Buf, InData%F_HS) + end if + call RegPack(Buf, allocated(InData%F_Waves1)) + if (allocated(InData%F_Waves1)) then + call RegPackBounds(Buf, 1, lbound(InData%F_Waves1), ubound(InData%F_Waves1)) + call RegPack(Buf, InData%F_Waves1) + end if + call RegPack(Buf, allocated(InData%F_Rdtn)) + if (allocated(InData%F_Rdtn)) then + call RegPackBounds(Buf, 1, lbound(InData%F_Rdtn), ubound(InData%F_Rdtn)) + call RegPack(Buf, InData%F_Rdtn) + end if + call RegPack(Buf, allocated(InData%F_PtfmAM)) + if (allocated(InData%F_PtfmAM)) then + call RegPackBounds(Buf, 1, lbound(InData%F_PtfmAM), ubound(InData%F_PtfmAM)) + call RegPack(Buf, InData%F_PtfmAM) + end if + call SS_Rad_PackMisc(Buf, InData%SS_Rdtn) + call SS_Rad_PackInput(Buf, InData%SS_Rdtn_u) + call SS_Rad_PackOutput(Buf, InData%SS_Rdtn_y) + call SS_Exc_PackMisc(Buf, InData%SS_Exctn) + call SS_Exc_PackInput(Buf, InData%SS_Exctn_u) + call SS_Exc_PackOutput(Buf, InData%SS_Exctn_y) + call Conv_Rdtn_PackMisc(Buf, InData%Conv_Rdtn) + call Conv_Rdtn_PackInput(Buf, InData%Conv_Rdtn_u) + call Conv_Rdtn_PackOutput(Buf, InData%Conv_Rdtn_y) + call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackMisc' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%F_HS)) deallocate(OutData%F_HS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_HS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_HS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_HS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_Waves1)) deallocate(OutData%F_Waves1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_Waves1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_Waves1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_Rdtn)) deallocate(OutData%F_Rdtn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_Rdtn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Rdtn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_PtfmAM)) deallocate(OutData%F_PtfmAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_PtfmAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_PtfmAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_PtfmAM) + if (RegCheckErr(Buf, RoutineName)) return + end if + call SS_Rad_UnpackMisc(Buf, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Rad_UnpackInput(Buf, OutData%SS_Rdtn_u) ! SS_Rdtn_u + call SS_Rad_UnpackOutput(Buf, OutData%SS_Rdtn_y) ! SS_Rdtn_y + call SS_Exc_UnpackMisc(Buf, OutData%SS_Exctn) ! SS_Exctn + call SS_Exc_UnpackInput(Buf, OutData%SS_Exctn_u) ! SS_Exctn_u + call SS_Exc_UnpackOutput(Buf, OutData%SS_Exctn_y) ! SS_Exctn_y + call Conv_Rdtn_UnpackMisc(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn + call Conv_Rdtn_UnpackInput(Buf, OutData%Conv_Rdtn_u) ! Conv_Rdtn_u + call Conv_Rdtn_UnpackOutput(Buf, OutData%Conv_Rdtn_y) ! Conv_Rdtn_y + call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m +end subroutine + +subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_ParameterType), intent(in) :: SrcParamData + type(WAMIT_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%NBody = SrcParamData%NBody + DstParamData%NBodyMod = SrcParamData%NBodyMod + if (allocated(SrcParamData%F_HS_Moment_Offset)) then + LB(1:2) = lbound(SrcParamData%F_HS_Moment_Offset) + UB(1:2) = ubound(SrcParamData%F_HS_Moment_Offset) + if (.not. allocated(DstParamData%F_HS_Moment_Offset)) then + allocate(DstParamData%F_HS_Moment_Offset(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_HS_Moment_Offset.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%F_HS_Moment_Offset = SrcParamData%F_HS_Moment_Offset + end if + if (allocated(SrcParamData%HdroAdMsI)) then + LB(1:2) = lbound(SrcParamData%HdroAdMsI) + UB(1:2) = ubound(SrcParamData%HdroAdMsI) + if (.not. allocated(DstParamData%HdroAdMsI)) then + allocate(DstParamData%HdroAdMsI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HdroAdMsI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%HdroAdMsI = SrcParamData%HdroAdMsI + end if + if (allocated(SrcParamData%HdroSttc)) then + LB(1:2) = lbound(SrcParamData%HdroSttc) + UB(1:2) = ubound(SrcParamData%HdroSttc) + if (.not. allocated(DstParamData%HdroSttc)) then + allocate(DstParamData%HdroSttc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HdroSttc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%HdroSttc = SrcParamData%HdroSttc + end if + DstParamData%RdtnMod = SrcParamData%RdtnMod + DstParamData%ExctnMod = SrcParamData%ExctnMod + DstParamData%ExctnDisp = SrcParamData%ExctnDisp + DstParamData%ExctnCutOff = SrcParamData%ExctnCutOff + DstParamData%ExctnFiltConst = SrcParamData%ExctnFiltConst + if (allocated(SrcParamData%WaveExctn)) then + LB(1:2) = lbound(SrcParamData%WaveExctn) + UB(1:2) = ubound(SrcParamData%WaveExctn) + if (.not. allocated(DstParamData%WaveExctn)) then + allocate(DstParamData%WaveExctn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveExctn = SrcParamData%WaveExctn + end if + if (allocated(SrcParamData%WaveExctnGrid)) then + LB(1:4) = lbound(SrcParamData%WaveExctnGrid) + UB(1:4) = ubound(SrcParamData%WaveExctnGrid) + if (.not. allocated(DstParamData%WaveExctnGrid)) then + allocate(DstParamData%WaveExctnGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctnGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveExctnGrid = SrcParamData%WaveExctnGrid + end if + DstParamData%NStepWave = SrcParamData%NStepWave + call Conv_Rdtn_CopyParam(SrcParamData%Conv_Rdtn, DstParamData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Rad_CopyParam(SrcParamData%SS_Rdtn, DstParamData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyParam(SrcParamData%SS_Exctn, DstParamData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%DT = SrcParamData%DT + 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 + +subroutine WAMIT_DestroyParam(ParamData, ErrStat, ErrMsg) + type(WAMIT_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%F_HS_Moment_Offset)) then + deallocate(ParamData%F_HS_Moment_Offset) + end if + if (allocated(ParamData%HdroAdMsI)) then + deallocate(ParamData%HdroAdMsI) + end if + if (allocated(ParamData%HdroSttc)) then + deallocate(ParamData%HdroSttc) + end if + if (allocated(ParamData%WaveExctn)) then + deallocate(ParamData%WaveExctn) + end if + if (allocated(ParamData%WaveExctnGrid)) then + deallocate(ParamData%WaveExctnGrid) + end if + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%NBody) + call RegPack(Buf, InData%NBodyMod) + call RegPack(Buf, allocated(InData%F_HS_Moment_Offset)) + if (allocated(InData%F_HS_Moment_Offset)) then + call RegPackBounds(Buf, 2, lbound(InData%F_HS_Moment_Offset), ubound(InData%F_HS_Moment_Offset)) + call RegPack(Buf, InData%F_HS_Moment_Offset) + end if + call RegPack(Buf, allocated(InData%HdroAdMsI)) + if (allocated(InData%HdroAdMsI)) then + call RegPackBounds(Buf, 2, lbound(InData%HdroAdMsI), ubound(InData%HdroAdMsI)) + call RegPack(Buf, InData%HdroAdMsI) + end if + call RegPack(Buf, allocated(InData%HdroSttc)) + if (allocated(InData%HdroSttc)) then + call RegPackBounds(Buf, 2, lbound(InData%HdroSttc), ubound(InData%HdroSttc)) + call RegPack(Buf, InData%HdroSttc) + end if + call RegPack(Buf, InData%RdtnMod) + call RegPack(Buf, InData%ExctnMod) + call RegPack(Buf, InData%ExctnDisp) + call RegPack(Buf, InData%ExctnCutOff) + call RegPack(Buf, InData%ExctnFiltConst) + call RegPack(Buf, allocated(InData%WaveExctn)) + if (allocated(InData%WaveExctn)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveExctn), ubound(InData%WaveExctn)) + call RegPack(Buf, InData%WaveExctn) + end if + call RegPack(Buf, allocated(InData%WaveExctnGrid)) + if (allocated(InData%WaveExctnGrid)) then + call RegPackBounds(Buf, 4, lbound(InData%WaveExctnGrid), ubound(InData%WaveExctnGrid)) + call RegPack(Buf, InData%WaveExctnGrid) + end if + call RegPack(Buf, InData%NStepWave) + call Conv_Rdtn_PackParam(Buf, InData%Conv_Rdtn) + call SS_Rad_PackParam(Buf, InData%SS_Rdtn) + call SS_Exc_PackParam(Buf, InData%SS_Exctn) + call RegPack(Buf, InData%DT) + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackParam' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%F_HS_Moment_Offset)) deallocate(OutData%F_HS_Moment_Offset) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_HS_Moment_Offset(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_HS_Moment_Offset.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_HS_Moment_Offset) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%HdroAdMsI)) deallocate(OutData%HdroAdMsI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HdroAdMsI(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroAdMsI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HdroAdMsI) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%HdroSttc)) deallocate(OutData%HdroSttc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HdroSttc(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroSttc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HdroSttc) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%RdtnMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ExctnMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ExctnDisp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ExctnCutOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ExctnFiltConst) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WaveExctn)) deallocate(OutData%WaveExctn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveExctn(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveExctn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveExctnGrid)) deallocate(OutData%WaveExctnGrid) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveExctnGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctnGrid.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveExctnGrid) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + call Conv_Rdtn_UnpackParam(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn + call SS_Rad_UnpackParam(Buf, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Exc_UnpackParam(Buf, OutData%SS_Exctn) ! SS_Exctn + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p +end subroutine + +subroutine WAMIT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_InputType), intent(inout) :: SrcInputData + type(WAMIT_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%Mesh, DstInputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT_DestroyInput(InputData, ErrStat, ErrMsg) + type(WAMIT_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%Mesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%Mesh) ! Mesh +end subroutine + +subroutine WAMIT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_OutputType), intent(inout) :: SrcOutputData + type(WAMIT_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(WAMIT_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%Mesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackOutput' + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%Mesh) ! Mesh +end subroutine + +subroutine WAMIT_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(WAMIT_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(WAMIT_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 = 'WAMIT_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 WAMIT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL WAMIT_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 WAMIT_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 WAMIT_Input_ExtrapInterp - - - SUBROUTINE WAMIT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call WAMIT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call WAMIT_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call WAMIT_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE WAMIT_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. @@ -5276,41 +1708,42 @@ SUBROUTINE WAMIT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(WAMIT_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(WAMIT_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(WAMIT_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 + TYPE(WAMIT_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(WAMIT_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(WAMIT_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 = 'WAMIT_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT_Input_ExtrapInterp1 - - - SUBROUTINE WAMIT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE WAMIT_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. @@ -5324,101 +1757,102 @@ SUBROUTINE WAMIT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(WAMIT_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(WAMIT_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(WAMIT_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(WAMIT_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 + TYPE(WAMIT_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(WAMIT_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(WAMIT_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(WAMIT_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 = 'WAMIT_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT_Input_ExtrapInterp2 - - - SUBROUTINE WAMIT_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(WAMIT_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(WAMIT_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine WAMIT_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(WAMIT_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(WAMIT_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 = 'WAMIT_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 WAMIT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL WAMIT_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 WAMIT_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 WAMIT_Output_ExtrapInterp - - - SUBROUTINE WAMIT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call WAMIT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call WAMIT_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call WAMIT_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE WAMIT_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. @@ -5430,41 +1864,42 @@ SUBROUTINE WAMIT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(WAMIT_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 + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(WAMIT_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 = 'WAMIT_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT_Output_ExtrapInterp1 - - - SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE WAMIT_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. @@ -5478,47 +1913,47 @@ SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(WAMIT_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 + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(WAMIT_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 = 'WAMIT_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE WAMIT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Waves2_Types.f90 b/modules/hydrodyn/src/Waves2_Types.f90 deleted file mode 100644 index 1a50ae31dd..0000000000 --- a/modules/hydrodyn/src/Waves2_Types.f90 +++ /dev/null @@ -1,3841 +0,0 @@ -!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 deleted file mode 100644 index 6207cb31d2..0000000000 --- a/modules/hydrodyn/src/Waves_Types.f90 +++ /dev/null @@ -1,3586 +0,0 @@ -!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 52db504a7e..56e7b92ace 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -35,182 +35,182 @@ MODULE IceDyn_Types IMPLICIT NONE ! ========= IceD_InputFile ======= TYPE, PUBLIC :: IceD_InputFile - INTEGER(IntKi) :: IceModel !< The current ice model number [-] - INTEGER(IntKi) :: IceSubModel !< The current ice sub-model number [-] - REAL(ReKi) :: h !< Ice thickness [m] - REAL(ReKi) :: v !< Ice velocity [m/s] - REAL(ReKi) :: InitLoc !< Ice sheet initial location [m] - REAL(ReKi) :: t0 !< Ice load starting time [s] - REAL(ReKi) :: rhow !< Water mass density [kg/m^3] - REAL(ReKi) :: rhoi !< Ice mass density [kg/m^3] - INTEGER(IntKi) :: Seed1 !< Random seed 1 [-] - INTEGER(IntKi) :: Seed2 !< Random seed 2 [-] - INTEGER(IntKi) :: NumLegs !< Number of support structure legs in ice [-] + INTEGER(IntKi) :: IceModel = 0_IntKi !< The current ice model number [-] + INTEGER(IntKi) :: IceSubModel = 0_IntKi !< The current ice sub-model number [-] + REAL(ReKi) :: h = 0.0_ReKi !< Ice thickness [m] + REAL(ReKi) :: v = 0.0_ReKi !< Ice velocity [m/s] + REAL(ReKi) :: InitLoc = 0.0_ReKi !< Ice sheet initial location [m] + REAL(ReKi) :: t0 = 0.0_ReKi !< Ice load starting time [s] + REAL(ReKi) :: rhow = 0.0_ReKi !< Water mass density [kg/m^3] + REAL(ReKi) :: rhoi = 0.0_ReKi !< Ice mass density [kg/m^3] + INTEGER(IntKi) :: Seed1 = 0_IntKi !< Random seed 1 [-] + INTEGER(IntKi) :: Seed2 = 0_IntKi !< Random seed 2 [-] + INTEGER(IntKi) :: NumLegs = 0_IntKi !< Number of support structure legs in ice [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LegPosX !< global X position of legs 1-NumLegs [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LegPosY !< global Y position of legs 1-NumLegs [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: StrWd !< The width of the leg (structure) [m] - REAL(ReKi) :: Ikm !< Indentation factor [-] - REAL(ReKi) :: Ag !< Ice crystal type factor [MPa^-3s^-1] - REAL(ReKi) :: Qg !< Activation energy [kJ] - REAL(ReKi) :: Rg !< Universal gas constant [J] - REAL(ReKi) :: Tice !< Ice temperature [K] - REAL(ReKi) :: nu !< Poison ratio of ice [-] - REAL(ReKi) :: phi !< Ice wedge angle [degree] - REAL(ReKi) :: SigNm !< Nominal ice strength [MPa] - REAL(ReKi) :: Eice !< Elastic modulus of ice [GPa] - REAL(ReKi) :: IceStr2 !< Ice tooth brittle strength [MPa] - REAL(ReKi) :: Delmax2 !< Ice tooth maximum elastic deformation for model 2 [m] - REAL(ReKi) :: Pitch !< Distance between sequential ice teeth for model 2 [m] - REAL(ReKi) :: miuh !< Mean value of random ice thickness [m] - REAL(ReKi) :: varh !< Variance of random ice thicknesss [m^2] - REAL(ReKi) :: miuv !< Mean value of random ice velocity [m/s] - REAL(ReKi) :: varv !< Variance of random ice velocity [m^2/s^2] - REAL(ReKi) :: miut !< Mean value of ice loading event duration time [s] - REAL(ReKi) :: miubr !< Mean value of random ice brittle strength [MPa] - REAL(ReKi) :: varbr !< Variance of random ice brittle strength [MPa^2] - REAL(ReKi) :: miuDelm !< Mean value of random random maximum ice tooth tip displacement [MPa] - REAL(ReKi) :: varDelm !< Variance of random random maximum ice tooth tip displacement [MPa^2] - REAL(ReKi) :: miuP !< Mean value of random distance between sequential ice teeth [m] - REAL(ReKi) :: varP !< Variance of random distance between sequential ice teeth [m^2] - INTEGER(IntKi) :: Zn1 !< Number of failure zones along contact width [-] - INTEGER(IntKi) :: Zn2 !< Number of failure zones along contact height/thickness [-] - REAL(ReKi) :: ZonePitch !< Distance between sequential ice teeth [m] - REAL(ReKi) :: PrflMean !< Ice structure contact profile mean value [m] - REAL(ReKi) :: PrflSig !< Ice structure contact profile standard deviation [m] - REAL(ReKi) :: IceStr !< Ice failure strength [MPa] - REAL(ReKi) :: Delmax !< Ice teeth maximum elastic deformation [m] - REAL(ReKi) :: alpha !< slope angle of the cone [degree] - REAL(ReKi) :: Dwl !< cone waterline diameter [m] - REAL(ReKi) :: Dtp !< cone top diameter [m] - REAL(ReKi) :: hr !< ride-up ice thickness [m] - REAL(ReKi) :: mu !< friction coefficient between structure and ice [-] - REAL(ReKi) :: sigf !< flexural strength of ice [MPa] - REAL(ReKi) :: StrLim !< limit strain [-] - REAL(ReKi) :: StrRtLim !< limit strain rate [s^-1] - INTEGER(IntKi) :: UorD !< flag that indicates upward or downward breaking cone: 0,upward, 1,downward. [-] - REAL(ReKi) :: Ll !< Ice floe length [m] - REAL(ReKi) :: Lw !< Ice floe width [m] - REAL(ReKi) :: Cpa !< ice crushing strength pressure-area relation constant [-] - REAL(ReKi) :: dpa !< ice crushing strength pressure-area relation order [-] - REAL(ReKi) :: Fdr !< Constant external driving force [MN] - REAL(ReKi) :: Kic !< Fracture toughness of ice [kNm^(-3/2)] - REAL(ReKi) :: FspN !< Non-dimensional splitting load [-] + REAL(ReKi) :: Ikm = 0.0_ReKi !< Indentation factor [-] + REAL(ReKi) :: Ag = 0.0_ReKi !< Ice crystal type factor [MPa^-3s^-1] + REAL(ReKi) :: Qg = 0.0_ReKi !< Activation energy [kJ] + REAL(ReKi) :: Rg = 0.0_ReKi !< Universal gas constant [J] + REAL(ReKi) :: Tice = 0.0_ReKi !< Ice temperature [K] + REAL(ReKi) :: nu = 0.0_ReKi !< Poison ratio of ice [-] + REAL(ReKi) :: phi = 0.0_ReKi !< Ice wedge angle [degree] + REAL(ReKi) :: SigNm = 0.0_ReKi !< Nominal ice strength [MPa] + REAL(ReKi) :: Eice = 0.0_ReKi !< Elastic modulus of ice [GPa] + REAL(ReKi) :: IceStr2 = 0.0_ReKi !< Ice tooth brittle strength [MPa] + REAL(ReKi) :: Delmax2 = 0.0_ReKi !< Ice tooth maximum elastic deformation for model 2 [m] + REAL(ReKi) :: Pitch = 0.0_ReKi !< Distance between sequential ice teeth for model 2 [m] + REAL(ReKi) :: miuh = 0.0_ReKi !< Mean value of random ice thickness [m] + REAL(ReKi) :: varh = 0.0_ReKi !< Variance of random ice thicknesss [m^2] + REAL(ReKi) :: miuv = 0.0_ReKi !< Mean value of random ice velocity [m/s] + REAL(ReKi) :: varv = 0.0_ReKi !< Variance of random ice velocity [m^2/s^2] + REAL(ReKi) :: miut = 0.0_ReKi !< Mean value of ice loading event duration time [s] + REAL(ReKi) :: miubr = 0.0_ReKi !< Mean value of random ice brittle strength [MPa] + REAL(ReKi) :: varbr = 0.0_ReKi !< Variance of random ice brittle strength [MPa^2] + REAL(ReKi) :: miuDelm = 0.0_ReKi !< Mean value of random random maximum ice tooth tip displacement [MPa] + REAL(ReKi) :: varDelm = 0.0_ReKi !< Variance of random random maximum ice tooth tip displacement [MPa^2] + REAL(ReKi) :: miuP = 0.0_ReKi !< Mean value of random distance between sequential ice teeth [m] + REAL(ReKi) :: varP = 0.0_ReKi !< Variance of random distance between sequential ice teeth [m^2] + INTEGER(IntKi) :: Zn1 = 0_IntKi !< Number of failure zones along contact width [-] + INTEGER(IntKi) :: Zn2 = 0_IntKi !< Number of failure zones along contact height/thickness [-] + REAL(ReKi) :: ZonePitch = 0.0_ReKi !< Distance between sequential ice teeth [m] + REAL(ReKi) :: PrflMean = 0.0_ReKi !< Ice structure contact profile mean value [m] + REAL(ReKi) :: PrflSig = 0.0_ReKi !< Ice structure contact profile standard deviation [m] + REAL(ReKi) :: IceStr = 0.0_ReKi !< Ice failure strength [MPa] + REAL(ReKi) :: Delmax = 0.0_ReKi !< Ice teeth maximum elastic deformation [m] + REAL(ReKi) :: alpha = 0.0_ReKi !< slope angle of the cone [degree] + REAL(ReKi) :: Dwl = 0.0_ReKi !< cone waterline diameter [m] + REAL(ReKi) :: Dtp = 0.0_ReKi !< cone top diameter [m] + REAL(ReKi) :: hr = 0.0_ReKi !< ride-up ice thickness [m] + REAL(ReKi) :: mu = 0.0_ReKi !< friction coefficient between structure and ice [-] + REAL(ReKi) :: sigf = 0.0_ReKi !< flexural strength of ice [MPa] + REAL(ReKi) :: StrLim = 0.0_ReKi !< limit strain [-] + REAL(ReKi) :: StrRtLim = 0.0_ReKi !< limit strain rate [s^-1] + INTEGER(IntKi) :: UorD = 0_IntKi !< flag that indicates upward or downward breaking cone: 0,upward, 1,downward. [-] + REAL(ReKi) :: Ll = 0.0_ReKi !< Ice floe length [m] + REAL(ReKi) :: Lw = 0.0_ReKi !< Ice floe width [m] + REAL(ReKi) :: Cpa = 0.0_ReKi !< ice crushing strength pressure-area relation constant [-] + REAL(ReKi) :: dpa = 0.0_ReKi !< ice crushing strength pressure-area relation order [-] + REAL(ReKi) :: Fdr = 0.0_ReKi !< Constant external driving force [MN] + REAL(ReKi) :: Kic = 0.0_ReKi !< Fracture toughness of ice [kNm^(-3/2)] + REAL(ReKi) :: FspN = 0.0_ReKi !< Non-dimensional splitting load [-] END TYPE IceD_InputFile ! ======================= ! ========= IceD_InitInputType ======= TYPE, PUBLIC :: IceD_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] CHARACTER(1024) :: RootName !< Root name of the output file [-] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] - REAL(ReKi) :: WtrDens !< Density of water [kg/m^3] - REAL(ReKi) :: gravity !< Gravitational acceleration [m/s^2] - INTEGER(IntKi) :: LegNum !< Which number of legs on the turbine this is being initialized for [m] - REAL(DbKi) :: TMax !< Total simulation time [s] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Density of water [kg/m^3] + REAL(ReKi) :: gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + INTEGER(IntKi) :: LegNum = 0_IntKi !< Which number of legs on the turbine this is being initialized for [m] + REAL(DbKi) :: TMax = 0.0_R8Ki !< Total simulation time [s] END TYPE IceD_InitInputType ! ======================= ! ========= IceD_InitOutputType ======= TYPE, PUBLIC :: IceD_InitOutputType CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] - INTEGER(IntKi) :: numLegs !< Number of legs on the structure [-] + INTEGER(IntKi) :: numLegs = 0_IntKi !< Number of legs on the structure [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] END TYPE IceD_InitOutputType ! ======================= ! ========= IceD_ContinuousStateType ======= TYPE, PUBLIC :: IceD_ContinuousStateType - REAL(ReKi) :: q !< q - displacement of ice mass [m] - REAL(ReKi) :: dqdt !< dqdt - velocity of ice mass [m/s] + REAL(ReKi) :: q = 0.0_ReKi !< q - displacement of ice mass [m] + REAL(ReKi) :: dqdt = 0.0_ReKi !< dqdt - velocity of ice mass [m/s] END TYPE IceD_ContinuousStateType ! ======================= ! ========= IceD_DiscreteStateType ======= TYPE, PUBLIC :: IceD_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< A variable, Replace if you have discrete states [-] + REAL(SiKi) :: DummyDiscState = 0.0_R4Ki !< A variable, Replace if you have discrete states [-] END TYPE IceD_DiscreteStateType ! ======================= ! ========= IceD_ConstraintStateType ======= TYPE, PUBLIC :: IceD_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< A variable, Replace if you have constraint states [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< A variable, Replace if you have constraint states [-] END TYPE IceD_ConstraintStateType ! ======================= ! ========= IceD_OtherStateType ======= TYPE, PUBLIC :: IceD_OtherStateType - INTEGER(IntKi) :: IceTthNo2 !< Ice tooth number of the current ice tooth, for model 2 (updated in UpdateStates; used in CalcOutput) [-] + INTEGER(IntKi) :: IceTthNo2 = 0_IntKi !< Ice tooth number of the current ice tooth, for model 2 (updated in UpdateStates; used in CalcOutput) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: Nc !< Number of the current ice tooths number (time series) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Psum !< The sum of pitches of all broken ice teeth (time series) [m] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IceTthNo !< IceTthNo - the current numbers of ice teeth of each zone [-] - REAL(ReKi) :: Beta !< angle between broken ice sheet and level waterline [rad] - REAL(DbKi) :: Tinit !< Initial time of the current load cycle [s] - INTEGER(IntKi) :: Splitf !< flag to indicate if the ice floe has split (0 not splitted, 1 splitted) [-] - REAL(ReKi) :: dxc !< crushed depth of ice [m] + REAL(ReKi) :: Beta = 0.0_ReKi !< angle between broken ice sheet and level waterline [rad] + REAL(DbKi) :: Tinit = 0.0_R8Ki !< Initial time of the current load cycle [s] + INTEGER(IntKi) :: Splitf = 0_IntKi !< flag to indicate if the ice floe has split (0 not splitted, 1 splitted) [-] + REAL(ReKi) :: dxc = 0.0_ReKi !< crushed depth of ice [m] TYPE(IceD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: xdot !< previous state deriv for multi-step [m] - INTEGER(IntKi) :: n !< tracks time step for which OtherState was updated [-] + INTEGER(IntKi) :: n = 0_IntKi !< tracks time step for which OtherState was updated [-] END TYPE IceD_OtherStateType ! ======================= ! ========= IceD_MiscVarType ======= TYPE, PUBLIC :: IceD_MiscVarType - INTEGER(IntKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] + INTEGER(IntKi) :: DummyMiscVar = 0_IntKi !< Remove this variable if you have misc/optimization variables [-] END TYPE IceD_MiscVarType ! ======================= ! ========= IceD_ParameterType ======= TYPE, PUBLIC :: IceD_ParameterType - REAL(ReKi) :: h !< Ice thickness [m] - REAL(ReKi) :: v !< Ice velocity [m/s] - REAL(ReKi) :: t0 !< Ice load starting time [s] - REAL(ReKi) :: StrWd !< The width of the structure [m] - REAL(ReKi) :: dt !< Time interval for integration within the module [s] - REAL(ReKi) :: InitLoc !< Ice sheet initial location [m] - REAL(ReKi) :: tolerance !< Tolerance when calculating ice breaking force, etc. [-] - REAL(ReKi) :: Tmax !< Total simulation time [s] - INTEGER(IntKi) :: verif !< flag to indicate if verification is being peformed [-] - INTEGER(IntKi) :: ModNo !< The current ice model number [-] - INTEGER(IntKi) :: SubModNo !< The current ice sub-model number [-] - INTEGER(IntKi) :: NumOuts !< The number of output channels [-] - INTEGER(IntKi) :: method !< integration method: 1-RK4, 2-AB4, 3-ABM4 [-] - INTEGER(IntKi) :: TmStep !< Total time step [-] + REAL(ReKi) :: h = 0.0_ReKi !< Ice thickness [m] + REAL(ReKi) :: v = 0.0_ReKi !< Ice velocity [m/s] + REAL(ReKi) :: t0 = 0.0_ReKi !< Ice load starting time [s] + REAL(ReKi) :: StrWd = 0.0_ReKi !< The width of the structure [m] + REAL(ReKi) :: dt = 0.0_ReKi !< Time interval for integration within the module [s] + REAL(ReKi) :: InitLoc = 0.0_ReKi !< Ice sheet initial location [m] + REAL(ReKi) :: tolerance = 0.0_ReKi !< Tolerance when calculating ice breaking force, etc. [-] + REAL(ReKi) :: Tmax = 0.0_ReKi !< Total simulation time [s] + INTEGER(IntKi) :: verif = 0_IntKi !< flag to indicate if verification is being peformed [-] + INTEGER(IntKi) :: ModNo = 0_IntKi !< The current ice model number [-] + INTEGER(IntKi) :: SubModNo = 0_IntKi !< The current ice sub-model number [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< The number of output channels [-] + INTEGER(IntKi) :: method = 0_IntKi !< integration method: 1-RK4, 2-AB4, 3-ABM4 [-] + INTEGER(IntKi) :: TmStep = 0_IntKi !< Total time step [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutName !< Names of all requested output parameters [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutUnit !< Units of all requested output parameters [-] CHARACTER(1024) :: RootName !< Rootname [-] - REAL(ReKi) :: tm1a !< Time for the maximum force to be reached for model 1a [s] - REAL(ReKi) :: tm1b !< Time for the maximum force to be reached for model 1b [s] - REAL(ReKi) :: tm1c !< Time for the maximum force to be reached for model 1c [s] - REAL(ReKi) :: Fmax1a !< Maximum ice force of model 1a [N] - REAL(ReKi) :: Fmax1b !< Maximum ice force of model 1b [N] - REAL(ReKi) :: Fmax1c !< Maximum ice force of model 1c [N] - REAL(ReKi) :: Ikm !< Indentation factor [-] - REAL(ReKi) :: Cstr !< Constant when calculating creeping stresss [Pa*s^(-1/3)] - REAL(ReKi) :: EiPa !< Elastic modulus of ice [Pa] - REAL(ReKi) :: Delmax2 !< Ice tooth maximum elastic deformation for model 2 [m] - REAL(ReKi) :: Pitch !< Distance between sequential ice teeth [m] - REAL(ReKi) :: Kice2 !< Stiffness of ice teeth for model 2 [N/m] + REAL(ReKi) :: tm1a = 0.0_ReKi !< Time for the maximum force to be reached for model 1a [s] + REAL(ReKi) :: tm1b = 0.0_ReKi !< Time for the maximum force to be reached for model 1b [s] + REAL(ReKi) :: tm1c = 0.0_ReKi !< Time for the maximum force to be reached for model 1c [s] + REAL(ReKi) :: Fmax1a = 0.0_ReKi !< Maximum ice force of model 1a [N] + REAL(ReKi) :: Fmax1b = 0.0_ReKi !< Maximum ice force of model 1b [N] + REAL(ReKi) :: Fmax1c = 0.0_ReKi !< Maximum ice force of model 1c [N] + REAL(ReKi) :: Ikm = 0.0_ReKi !< Indentation factor [-] + REAL(ReKi) :: Cstr = 0.0_ReKi !< Constant when calculating creeping stresss [Pa*s^(-1/3)] + REAL(ReKi) :: EiPa = 0.0_ReKi !< Elastic modulus of ice [Pa] + REAL(ReKi) :: Delmax2 = 0.0_ReKi !< Ice tooth maximum elastic deformation for model 2 [m] + REAL(ReKi) :: Pitch = 0.0_ReKi !< Distance between sequential ice teeth [m] + REAL(ReKi) :: Kice2 = 0.0_ReKi !< Stiffness of ice teeth for model 2 [N/m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmFm !< Random maximum ice force time series [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmt0 !< Random ice loading event starting time [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmtm !< Random time when the maximum force is reached [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmDm !< Random maximum ice tooth tip displacement time series [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmP !< Random distance between sequential ice teeth [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmKi !< Random ice teeth stiffness [N/m] - REAL(ReKi) :: ZonePitch !< Distance between sequential ice teeth [m] - REAL(ReKi) :: Kice !< Stiffness of ice teeth [N/m] - REAL(ReKi) :: Delmax !< Ice teeth maximum elastic deformation [m] + REAL(ReKi) :: ZonePitch = 0.0_ReKi !< Distance between sequential ice teeth [m] + REAL(ReKi) :: Kice = 0.0_ReKi !< Stiffness of ice teeth [N/m] + REAL(ReKi) :: Delmax = 0.0_ReKi !< Ice teeth maximum elastic deformation [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y0 !< Ice structure contact profile initial location [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ContPrfl !< Ice structure contact profile [m] - INTEGER(IntKi) :: Zn !< Number of failure zones [-] - REAL(ReKi) :: rhoi !< Ice mass density [kg/m^3] - REAL(ReKi) :: rhow !< Water mass density [kg/m^3] - REAL(ReKi) :: alphaR !< Slope angle of the cone [rad] - REAL(ReKi) :: Dwl !< Cone waterline diameter [m] - REAL(ReKi) :: Zr !< Ice ride-up height [m] - REAL(ReKi) :: RHbr !< Horizontal breaking force [N] - REAL(ReKi) :: RVbr !< Vertical breaking force [N] - REAL(ReKi) :: Lbr !< Ice sheet breaking length [m] - REAL(ReKi) :: LovR !< Ratio of ice breaking length over cone radius [-] - REAL(ReKi) :: mu !< Friction coefficient between structure and ice [-] - REAL(ReKi) :: Wri !< Initial ride-up ice weight [kg] - REAL(ReKi) :: WL !< Broken ice piece weight [kg] - REAL(ReKi) :: Cpa !< ice crushing strength pressure-area relation constant [-] - REAL(ReKi) :: dpa !< ice crushing strength pressure-area relation order [-] - REAL(ReKi) :: FdrN !< Constant external driving force [N] - REAL(ReKi) :: Mice !< Ice floe mass [kg] - REAL(ReKi) :: Fsp !< Ice floe splitting force [N] + INTEGER(IntKi) :: Zn = 0_IntKi !< Number of failure zones [-] + REAL(ReKi) :: rhoi = 0.0_ReKi !< Ice mass density [kg/m^3] + REAL(ReKi) :: rhow = 0.0_ReKi !< Water mass density [kg/m^3] + REAL(ReKi) :: alphaR = 0.0_ReKi !< Slope angle of the cone [rad] + REAL(ReKi) :: Dwl = 0.0_ReKi !< Cone waterline diameter [m] + REAL(ReKi) :: Zr = 0.0_ReKi !< Ice ride-up height [m] + REAL(ReKi) :: RHbr = 0.0_ReKi !< Horizontal breaking force [N] + REAL(ReKi) :: RVbr = 0.0_ReKi !< Vertical breaking force [N] + REAL(ReKi) :: Lbr = 0.0_ReKi !< Ice sheet breaking length [m] + REAL(ReKi) :: LovR = 0.0_ReKi !< Ratio of ice breaking length over cone radius [-] + REAL(ReKi) :: mu = 0.0_ReKi !< Friction coefficient between structure and ice [-] + REAL(ReKi) :: Wri = 0.0_ReKi !< Initial ride-up ice weight [kg] + REAL(ReKi) :: WL = 0.0_ReKi !< Broken ice piece weight [kg] + REAL(ReKi) :: Cpa = 0.0_ReKi !< ice crushing strength pressure-area relation constant [-] + REAL(ReKi) :: dpa = 0.0_ReKi !< ice crushing strength pressure-area relation order [-] + REAL(ReKi) :: FdrN = 0.0_ReKi !< Constant external driving force [N] + REAL(ReKi) :: Mice = 0.0_ReKi !< Ice floe mass [kg] + REAL(ReKi) :: Fsp = 0.0_ReKi !< Ice floe splitting force [N] END TYPE IceD_ParameterType ! ======================= ! ========= IceD_InputType ======= @@ -225,3618 +225,1701 @@ MODULE IceDyn_Types END TYPE IceD_OutputType ! ======================= CONTAINS - SUBROUTINE IceD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(IceD_InputFile), INTENT(INOUT) :: DstInputFileData - 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 = 'IceD_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%IceModel = SrcInputFileData%IceModel - DstInputFileData%IceSubModel = SrcInputFileData%IceSubModel - DstInputFileData%h = SrcInputFileData%h - DstInputFileData%v = SrcInputFileData%v - DstInputFileData%InitLoc = SrcInputFileData%InitLoc - DstInputFileData%t0 = SrcInputFileData%t0 - DstInputFileData%rhow = SrcInputFileData%rhow - DstInputFileData%rhoi = SrcInputFileData%rhoi - DstInputFileData%Seed1 = SrcInputFileData%Seed1 - DstInputFileData%Seed2 = SrcInputFileData%Seed2 - DstInputFileData%NumLegs = SrcInputFileData%NumLegs -IF (ALLOCATED(SrcInputFileData%LegPosX)) THEN - i1_l = LBOUND(SrcInputFileData%LegPosX,1) - i1_u = UBOUND(SrcInputFileData%LegPosX,1) - IF (.NOT. ALLOCATED(DstInputFileData%LegPosX)) THEN - ALLOCATE(DstInputFileData%LegPosX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LegPosX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LegPosX = SrcInputFileData%LegPosX -ENDIF -IF (ALLOCATED(SrcInputFileData%LegPosY)) THEN - i1_l = LBOUND(SrcInputFileData%LegPosY,1) - i1_u = UBOUND(SrcInputFileData%LegPosY,1) - IF (.NOT. ALLOCATED(DstInputFileData%LegPosY)) THEN - ALLOCATE(DstInputFileData%LegPosY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LegPosY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LegPosY = SrcInputFileData%LegPosY -ENDIF -IF (ALLOCATED(SrcInputFileData%StrWd)) THEN - i1_l = LBOUND(SrcInputFileData%StrWd,1) - i1_u = UBOUND(SrcInputFileData%StrWd,1) - IF (.NOT. ALLOCATED(DstInputFileData%StrWd)) THEN - ALLOCATE(DstInputFileData%StrWd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StrWd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%StrWd = SrcInputFileData%StrWd -ENDIF - DstInputFileData%Ikm = SrcInputFileData%Ikm - DstInputFileData%Ag = SrcInputFileData%Ag - DstInputFileData%Qg = SrcInputFileData%Qg - DstInputFileData%Rg = SrcInputFileData%Rg - DstInputFileData%Tice = SrcInputFileData%Tice - DstInputFileData%nu = SrcInputFileData%nu - DstInputFileData%phi = SrcInputFileData%phi - DstInputFileData%SigNm = SrcInputFileData%SigNm - DstInputFileData%Eice = SrcInputFileData%Eice - DstInputFileData%IceStr2 = SrcInputFileData%IceStr2 - DstInputFileData%Delmax2 = SrcInputFileData%Delmax2 - DstInputFileData%Pitch = SrcInputFileData%Pitch - DstInputFileData%miuh = SrcInputFileData%miuh - DstInputFileData%varh = SrcInputFileData%varh - DstInputFileData%miuv = SrcInputFileData%miuv - DstInputFileData%varv = SrcInputFileData%varv - DstInputFileData%miut = SrcInputFileData%miut - DstInputFileData%miubr = SrcInputFileData%miubr - DstInputFileData%varbr = SrcInputFileData%varbr - DstInputFileData%miuDelm = SrcInputFileData%miuDelm - DstInputFileData%varDelm = SrcInputFileData%varDelm - DstInputFileData%miuP = SrcInputFileData%miuP - DstInputFileData%varP = SrcInputFileData%varP - DstInputFileData%Zn1 = SrcInputFileData%Zn1 - DstInputFileData%Zn2 = SrcInputFileData%Zn2 - DstInputFileData%ZonePitch = SrcInputFileData%ZonePitch - DstInputFileData%PrflMean = SrcInputFileData%PrflMean - DstInputFileData%PrflSig = SrcInputFileData%PrflSig - DstInputFileData%IceStr = SrcInputFileData%IceStr - DstInputFileData%Delmax = SrcInputFileData%Delmax - DstInputFileData%alpha = SrcInputFileData%alpha - DstInputFileData%Dwl = SrcInputFileData%Dwl - DstInputFileData%Dtp = SrcInputFileData%Dtp - DstInputFileData%hr = SrcInputFileData%hr - DstInputFileData%mu = SrcInputFileData%mu - DstInputFileData%sigf = SrcInputFileData%sigf - DstInputFileData%StrLim = SrcInputFileData%StrLim - DstInputFileData%StrRtLim = SrcInputFileData%StrRtLim - DstInputFileData%UorD = SrcInputFileData%UorD - DstInputFileData%Ll = SrcInputFileData%Ll - DstInputFileData%Lw = SrcInputFileData%Lw - DstInputFileData%Cpa = SrcInputFileData%Cpa - DstInputFileData%dpa = SrcInputFileData%dpa - DstInputFileData%Fdr = SrcInputFileData%Fdr - DstInputFileData%Kic = SrcInputFileData%Kic - DstInputFileData%FspN = SrcInputFileData%FspN - END SUBROUTINE IceD_CopyInputFile - - SUBROUTINE IceD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(IceD_InputFile), INTENT(INOUT) :: InputFileData - 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 = 'IceD_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%LegPosX)) THEN - DEALLOCATE(InputFileData%LegPosX) -ENDIF -IF (ALLOCATED(InputFileData%LegPosY)) THEN - DEALLOCATE(InputFileData%LegPosY) -ENDIF -IF (ALLOCATED(InputFileData%StrWd)) THEN - DEALLOCATE(InputFileData%StrWd) -ENDIF - END SUBROUTINE IceD_DestroyInputFile - - SUBROUTINE IceD_PackInputFile( 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(IceD_InputFile), 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 = 'IceD_PackInputFile' - ! 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 ! IceModel - Int_BufSz = Int_BufSz + 1 ! IceSubModel - Re_BufSz = Re_BufSz + 1 ! h - Re_BufSz = Re_BufSz + 1 ! v - Re_BufSz = Re_BufSz + 1 ! InitLoc - Re_BufSz = Re_BufSz + 1 ! t0 - Re_BufSz = Re_BufSz + 1 ! rhow - Re_BufSz = Re_BufSz + 1 ! rhoi - Int_BufSz = Int_BufSz + 1 ! Seed1 - Int_BufSz = Int_BufSz + 1 ! Seed2 - Int_BufSz = Int_BufSz + 1 ! NumLegs - Int_BufSz = Int_BufSz + 1 ! LegPosX allocated yes/no - IF ( ALLOCATED(InData%LegPosX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LegPosX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LegPosX) ! LegPosX - END IF - Int_BufSz = Int_BufSz + 1 ! LegPosY allocated yes/no - IF ( ALLOCATED(InData%LegPosY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LegPosY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LegPosY) ! LegPosY - END IF - Int_BufSz = Int_BufSz + 1 ! StrWd allocated yes/no - IF ( ALLOCATED(InData%StrWd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StrWd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StrWd) ! StrWd - END IF - Re_BufSz = Re_BufSz + 1 ! Ikm - Re_BufSz = Re_BufSz + 1 ! Ag - Re_BufSz = Re_BufSz + 1 ! Qg - Re_BufSz = Re_BufSz + 1 ! Rg - Re_BufSz = Re_BufSz + 1 ! Tice - Re_BufSz = Re_BufSz + 1 ! nu - Re_BufSz = Re_BufSz + 1 ! phi - Re_BufSz = Re_BufSz + 1 ! SigNm - Re_BufSz = Re_BufSz + 1 ! Eice - Re_BufSz = Re_BufSz + 1 ! IceStr2 - Re_BufSz = Re_BufSz + 1 ! Delmax2 - Re_BufSz = Re_BufSz + 1 ! Pitch - Re_BufSz = Re_BufSz + 1 ! miuh - Re_BufSz = Re_BufSz + 1 ! varh - Re_BufSz = Re_BufSz + 1 ! miuv - Re_BufSz = Re_BufSz + 1 ! varv - Re_BufSz = Re_BufSz + 1 ! miut - Re_BufSz = Re_BufSz + 1 ! miubr - Re_BufSz = Re_BufSz + 1 ! varbr - Re_BufSz = Re_BufSz + 1 ! miuDelm - Re_BufSz = Re_BufSz + 1 ! varDelm - Re_BufSz = Re_BufSz + 1 ! miuP - Re_BufSz = Re_BufSz + 1 ! varP - Int_BufSz = Int_BufSz + 1 ! Zn1 - Int_BufSz = Int_BufSz + 1 ! Zn2 - Re_BufSz = Re_BufSz + 1 ! ZonePitch - Re_BufSz = Re_BufSz + 1 ! PrflMean - Re_BufSz = Re_BufSz + 1 ! PrflSig - Re_BufSz = Re_BufSz + 1 ! IceStr - Re_BufSz = Re_BufSz + 1 ! Delmax - Re_BufSz = Re_BufSz + 1 ! alpha - Re_BufSz = Re_BufSz + 1 ! Dwl - Re_BufSz = Re_BufSz + 1 ! Dtp - Re_BufSz = Re_BufSz + 1 ! hr - Re_BufSz = Re_BufSz + 1 ! mu - Re_BufSz = Re_BufSz + 1 ! sigf - Re_BufSz = Re_BufSz + 1 ! StrLim - Re_BufSz = Re_BufSz + 1 ! StrRtLim - Int_BufSz = Int_BufSz + 1 ! UorD - Re_BufSz = Re_BufSz + 1 ! Ll - Re_BufSz = Re_BufSz + 1 ! Lw - Re_BufSz = Re_BufSz + 1 ! Cpa - Re_BufSz = Re_BufSz + 1 ! dpa - Re_BufSz = Re_BufSz + 1 ! Fdr - Re_BufSz = Re_BufSz + 1 ! Kic - Re_BufSz = Re_BufSz + 1 ! FspN - 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%IceModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IceSubModel - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%h - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%v - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InitLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%t0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhow - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhoi - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Seed1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Seed2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumLegs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LegPosX) ) 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%LegPosX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LegPosX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LegPosX,1), UBOUND(InData%LegPosX,1) - ReKiBuf(Re_Xferred) = InData%LegPosX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LegPosY) ) 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%LegPosY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LegPosY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LegPosY,1), UBOUND(InData%LegPosY,1) - ReKiBuf(Re_Xferred) = InData%LegPosY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StrWd) ) 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%StrWd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StrWd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StrWd,1), UBOUND(InData%StrWd,1) - ReKiBuf(Re_Xferred) = InData%StrWd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Ikm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ag - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Qg - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Rg - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Tice - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%nu - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%phi - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SigNm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Eice - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%IceStr2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Delmax2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miuh - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%varh - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miuv - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%varv - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miut - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miubr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%varbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miuDelm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%varDelm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miuP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%varP - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Zn1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Zn2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ZonePitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PrflMean - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PrflSig - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%IceStr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Delmax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Dwl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Dtp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%hr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%mu - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%sigf - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StrLim - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StrRtLim - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UorD - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ll - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Lw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Fdr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kic - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FspN - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_PackInputFile - SUBROUTINE IceD_UnPackInputFile( 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(IceD_InputFile), 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 = 'IceD_UnPackInputFile' - ! 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%IceModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%IceSubModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%h = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%v = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InitLoc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%t0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rhow = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rhoi = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Seed1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Seed2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumLegs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LegPosX 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%LegPosX)) DEALLOCATE(OutData%LegPosX) - ALLOCATE(OutData%LegPosX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LegPosX,1), UBOUND(OutData%LegPosX,1) - OutData%LegPosX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LegPosY 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%LegPosY)) DEALLOCATE(OutData%LegPosY) - ALLOCATE(OutData%LegPosY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LegPosY,1), UBOUND(OutData%LegPosY,1) - OutData%LegPosY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StrWd 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%StrWd)) DEALLOCATE(OutData%StrWd) - ALLOCATE(OutData%StrWd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrWd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StrWd,1), UBOUND(OutData%StrWd,1) - OutData%StrWd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Ikm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ag = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Qg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Rg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Tice = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nu = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%phi = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SigNm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Eice = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%IceStr2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miuh = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%varh = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miuv = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%varv = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miut = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miubr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%varbr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miuDelm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%varDelm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miuP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%varP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Zn1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Zn2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ZonePitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PrflMean = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PrflSig = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%IceStr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Dwl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Dtp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%hr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%mu = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%sigf = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StrLim = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StrRtLim = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UorD = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Ll = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Lw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cpa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dpa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Fdr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kic = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FspN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_UnPackInputFile - - SUBROUTINE IceD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(IceD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_CopyInitInput' -! +subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(IceD_InputFile), intent(in) :: SrcInputFileData + type(IceD_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IceD_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%gravity = SrcInitInputData%gravity - DstInitInputData%LegNum = SrcInitInputData%LegNum - DstInitInputData%TMax = SrcInitInputData%TMax - END SUBROUTINE IceD_CopyInitInput - - SUBROUTINE IceD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(IceD_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 = 'IceD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceD_DestroyInitInput - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! gravity - Int_BufSz = Int_BufSz + 1 ! LegNum - Db_BufSz = Db_BufSz + 1 ! TMax - 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%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%LegNum - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMax - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE IceD_PackInitInput - - SUBROUTINE IceD_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(IceD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_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%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LegNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE IceD_UnPackInitInput - - SUBROUTINE IceD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(IceD_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 = 'IceD_CopyInitOutput' -! + ErrMsg = '' + DstInputFileData%IceModel = SrcInputFileData%IceModel + DstInputFileData%IceSubModel = SrcInputFileData%IceSubModel + DstInputFileData%h = SrcInputFileData%h + DstInputFileData%v = SrcInputFileData%v + DstInputFileData%InitLoc = SrcInputFileData%InitLoc + DstInputFileData%t0 = SrcInputFileData%t0 + DstInputFileData%rhow = SrcInputFileData%rhow + DstInputFileData%rhoi = SrcInputFileData%rhoi + DstInputFileData%Seed1 = SrcInputFileData%Seed1 + DstInputFileData%Seed2 = SrcInputFileData%Seed2 + DstInputFileData%NumLegs = SrcInputFileData%NumLegs + if (allocated(SrcInputFileData%LegPosX)) then + LB(1:1) = lbound(SrcInputFileData%LegPosX) + UB(1:1) = ubound(SrcInputFileData%LegPosX) + if (.not. allocated(DstInputFileData%LegPosX)) then + allocate(DstInputFileData%LegPosX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LegPosX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LegPosX = SrcInputFileData%LegPosX + end if + if (allocated(SrcInputFileData%LegPosY)) then + LB(1:1) = lbound(SrcInputFileData%LegPosY) + UB(1:1) = ubound(SrcInputFileData%LegPosY) + if (.not. allocated(DstInputFileData%LegPosY)) then + allocate(DstInputFileData%LegPosY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LegPosY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LegPosY = SrcInputFileData%LegPosY + end if + if (allocated(SrcInputFileData%StrWd)) then + LB(1:1) = lbound(SrcInputFileData%StrWd) + UB(1:1) = ubound(SrcInputFileData%StrWd) + if (.not. allocated(DstInputFileData%StrWd)) then + allocate(DstInputFileData%StrWd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StrWd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%StrWd = SrcInputFileData%StrWd + end if + DstInputFileData%Ikm = SrcInputFileData%Ikm + DstInputFileData%Ag = SrcInputFileData%Ag + DstInputFileData%Qg = SrcInputFileData%Qg + DstInputFileData%Rg = SrcInputFileData%Rg + DstInputFileData%Tice = SrcInputFileData%Tice + DstInputFileData%nu = SrcInputFileData%nu + DstInputFileData%phi = SrcInputFileData%phi + DstInputFileData%SigNm = SrcInputFileData%SigNm + DstInputFileData%Eice = SrcInputFileData%Eice + DstInputFileData%IceStr2 = SrcInputFileData%IceStr2 + DstInputFileData%Delmax2 = SrcInputFileData%Delmax2 + DstInputFileData%Pitch = SrcInputFileData%Pitch + DstInputFileData%miuh = SrcInputFileData%miuh + DstInputFileData%varh = SrcInputFileData%varh + DstInputFileData%miuv = SrcInputFileData%miuv + DstInputFileData%varv = SrcInputFileData%varv + DstInputFileData%miut = SrcInputFileData%miut + DstInputFileData%miubr = SrcInputFileData%miubr + DstInputFileData%varbr = SrcInputFileData%varbr + DstInputFileData%miuDelm = SrcInputFileData%miuDelm + DstInputFileData%varDelm = SrcInputFileData%varDelm + DstInputFileData%miuP = SrcInputFileData%miuP + DstInputFileData%varP = SrcInputFileData%varP + DstInputFileData%Zn1 = SrcInputFileData%Zn1 + DstInputFileData%Zn2 = SrcInputFileData%Zn2 + DstInputFileData%ZonePitch = SrcInputFileData%ZonePitch + DstInputFileData%PrflMean = SrcInputFileData%PrflMean + DstInputFileData%PrflSig = SrcInputFileData%PrflSig + DstInputFileData%IceStr = SrcInputFileData%IceStr + DstInputFileData%Delmax = SrcInputFileData%Delmax + DstInputFileData%alpha = SrcInputFileData%alpha + DstInputFileData%Dwl = SrcInputFileData%Dwl + DstInputFileData%Dtp = SrcInputFileData%Dtp + DstInputFileData%hr = SrcInputFileData%hr + DstInputFileData%mu = SrcInputFileData%mu + DstInputFileData%sigf = SrcInputFileData%sigf + DstInputFileData%StrLim = SrcInputFileData%StrLim + DstInputFileData%StrRtLim = SrcInputFileData%StrRtLim + DstInputFileData%UorD = SrcInputFileData%UorD + DstInputFileData%Ll = SrcInputFileData%Ll + DstInputFileData%Lw = SrcInputFileData%Lw + DstInputFileData%Cpa = SrcInputFileData%Cpa + DstInputFileData%dpa = SrcInputFileData%dpa + DstInputFileData%Fdr = SrcInputFileData%Fdr + DstInputFileData%Kic = SrcInputFileData%Kic + DstInputFileData%FspN = SrcInputFileData%FspN +end subroutine + +subroutine IceD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(IceD_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyInputFile' 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 - DstInitOutputData%numLegs = SrcInitOutputData%numLegs - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE IceD_CopyInitOutput - - SUBROUTINE IceD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(IceD_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 = 'IceD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE IceD_DestroyInitOutput - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - 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 - - 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 - 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 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 IceD_PackInitOutput - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 - OutData%numLegs = 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 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) - END SUBROUTINE IceD_UnPackInitOutput - - SUBROUTINE IceD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(IceD_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 = 'IceD_CopyContState' -! + ErrMsg = '' + if (allocated(InputFileData%LegPosX)) then + deallocate(InputFileData%LegPosX) + end if + if (allocated(InputFileData%LegPosY)) then + deallocate(InputFileData%LegPosY) + end if + if (allocated(InputFileData%StrWd)) then + deallocate(InputFileData%StrWd) + end if +end subroutine + +subroutine IceD_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%IceModel) + call RegPack(Buf, InData%IceSubModel) + call RegPack(Buf, InData%h) + call RegPack(Buf, InData%v) + call RegPack(Buf, InData%InitLoc) + call RegPack(Buf, InData%t0) + call RegPack(Buf, InData%rhow) + call RegPack(Buf, InData%rhoi) + call RegPack(Buf, InData%Seed1) + call RegPack(Buf, InData%Seed2) + call RegPack(Buf, InData%NumLegs) + call RegPack(Buf, allocated(InData%LegPosX)) + if (allocated(InData%LegPosX)) then + call RegPackBounds(Buf, 1, lbound(InData%LegPosX), ubound(InData%LegPosX)) + call RegPack(Buf, InData%LegPosX) + end if + call RegPack(Buf, allocated(InData%LegPosY)) + if (allocated(InData%LegPosY)) then + call RegPackBounds(Buf, 1, lbound(InData%LegPosY), ubound(InData%LegPosY)) + call RegPack(Buf, InData%LegPosY) + end if + call RegPack(Buf, allocated(InData%StrWd)) + if (allocated(InData%StrWd)) then + call RegPackBounds(Buf, 1, lbound(InData%StrWd), ubound(InData%StrWd)) + call RegPack(Buf, InData%StrWd) + end if + call RegPack(Buf, InData%Ikm) + call RegPack(Buf, InData%Ag) + call RegPack(Buf, InData%Qg) + call RegPack(Buf, InData%Rg) + call RegPack(Buf, InData%Tice) + call RegPack(Buf, InData%nu) + call RegPack(Buf, InData%phi) + call RegPack(Buf, InData%SigNm) + call RegPack(Buf, InData%Eice) + call RegPack(Buf, InData%IceStr2) + call RegPack(Buf, InData%Delmax2) + call RegPack(Buf, InData%Pitch) + call RegPack(Buf, InData%miuh) + call RegPack(Buf, InData%varh) + call RegPack(Buf, InData%miuv) + call RegPack(Buf, InData%varv) + call RegPack(Buf, InData%miut) + call RegPack(Buf, InData%miubr) + call RegPack(Buf, InData%varbr) + call RegPack(Buf, InData%miuDelm) + call RegPack(Buf, InData%varDelm) + call RegPack(Buf, InData%miuP) + call RegPack(Buf, InData%varP) + call RegPack(Buf, InData%Zn1) + call RegPack(Buf, InData%Zn2) + call RegPack(Buf, InData%ZonePitch) + call RegPack(Buf, InData%PrflMean) + call RegPack(Buf, InData%PrflSig) + call RegPack(Buf, InData%IceStr) + call RegPack(Buf, InData%Delmax) + call RegPack(Buf, InData%alpha) + call RegPack(Buf, InData%Dwl) + call RegPack(Buf, InData%Dtp) + call RegPack(Buf, InData%hr) + call RegPack(Buf, InData%mu) + call RegPack(Buf, InData%sigf) + call RegPack(Buf, InData%StrLim) + call RegPack(Buf, InData%StrRtLim) + call RegPack(Buf, InData%UorD) + call RegPack(Buf, InData%Ll) + call RegPack(Buf, InData%Lw) + call RegPack(Buf, InData%Cpa) + call RegPack(Buf, InData%dpa) + call RegPack(Buf, InData%Fdr) + call RegPack(Buf, InData%Kic) + call RegPack(Buf, InData%FspN) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackInputFile' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%IceModel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IceSubModel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%h) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%v) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InitLoc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%t0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rhow) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rhoi) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Seed1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Seed2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumLegs) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%LegPosX)) deallocate(OutData%LegPosX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LegPosX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LegPosX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LegPosY)) deallocate(OutData%LegPosY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LegPosY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LegPosY) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StrWd)) deallocate(OutData%StrWd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StrWd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrWd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StrWd) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Ikm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Qg) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Rg) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Tice) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nu) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%phi) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SigNm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Eice) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IceStr2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Delmax2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Pitch) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%miuh) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%varh) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%miuv) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%varv) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%miut) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%miubr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%varbr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%miuDelm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%varDelm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%miuP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%varP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Zn1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Zn2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ZonePitch) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PrflMean) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PrflSig) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IceStr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Delmax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alpha) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Dwl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Dtp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%hr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%mu) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%sigf) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StrLim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StrRtLim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UorD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ll) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Lw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cpa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dpa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Fdr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Kic) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FspN) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(IceD_InitInputType), intent(in) :: SrcInitInputData + type(IceD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%q = SrcContStateData%q - DstContStateData%dqdt = SrcContStateData%dqdt - END SUBROUTINE IceD_CopyContState - - SUBROUTINE IceD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(IceD_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 = 'IceD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceD_DestroyContState - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 ! q - Re_BufSz = Re_BufSz + 1 ! dqdt - 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%q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dqdt - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_PackContState - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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%q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dqdt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_UnPackContState - - SUBROUTINE IceD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(IceD_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 = 'IceD_CopyDiscState' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%WtrDens = SrcInitInputData%WtrDens + DstInitInputData%gravity = SrcInitInputData%gravity + DstInitInputData%LegNum = SrcInitInputData%LegNum + DstInitInputData%TMax = SrcInitInputData%TMax +end subroutine + +subroutine IceD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(IceD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE IceD_CopyDiscState - - SUBROUTINE IceD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(IceD_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 = 'IceD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceD_DestroyDiscState - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 IceD_PackDiscState - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 IceD_UnPackDiscState - - SUBROUTINE IceD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(IceD_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 = 'IceD_CopyConstrState' -! + ErrMsg = '' +end subroutine + +subroutine IceD_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%MSL2SWL) + call RegPack(Buf, InData%WtrDens) + call RegPack(Buf, InData%gravity) + call RegPack(Buf, InData%LegNum) + call RegPack(Buf, InData%TMax) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LegNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TMax) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(IceD_InitOutputType), intent(in) :: SrcInitOutputData + type(IceD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE IceD_CopyConstrState - - SUBROUTINE IceD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(IceD_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 = 'IceD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceD_DestroyConstrState - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 IceD_PackConstrState - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 IceD_UnPackConstrState - - SUBROUTINE IceD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(IceD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_CopyOtherState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + DstInitOutputData%numLegs = SrcInitOutputData%numLegs + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine IceD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(IceD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%IceTthNo2 = SrcOtherStateData%IceTthNo2 -IF (ALLOCATED(SrcOtherStateData%Nc)) THEN - i1_l = LBOUND(SrcOtherStateData%Nc,1) - i1_u = UBOUND(SrcOtherStateData%Nc,1) - IF (.NOT. ALLOCATED(DstOtherStateData%Nc)) THEN - ALLOCATE(DstOtherStateData%Nc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Nc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%Nc = SrcOtherStateData%Nc -ENDIF -IF (ALLOCATED(SrcOtherStateData%Psum)) THEN - i1_l = LBOUND(SrcOtherStateData%Psum,1) - i1_u = UBOUND(SrcOtherStateData%Psum,1) - IF (.NOT. ALLOCATED(DstOtherStateData%Psum)) THEN - ALLOCATE(DstOtherStateData%Psum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Psum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%Psum = SrcOtherStateData%Psum -ENDIF -IF (ALLOCATED(SrcOtherStateData%IceTthNo)) THEN - i1_l = LBOUND(SrcOtherStateData%IceTthNo,1) - i1_u = UBOUND(SrcOtherStateData%IceTthNo,1) - IF (.NOT. ALLOCATED(DstOtherStateData%IceTthNo)) THEN - ALLOCATE(DstOtherStateData%IceTthNo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IceTthNo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%IceTthNo = SrcOtherStateData%IceTthNo -ENDIF - DstOtherStateData%Beta = SrcOtherStateData%Beta - DstOtherStateData%Tinit = SrcOtherStateData%Tinit - DstOtherStateData%Splitf = SrcOtherStateData%Splitf - DstOtherStateData%dxc = SrcOtherStateData%dxc -IF (ALLOCATED(SrcOtherStateData%xdot)) THEN - i1_l = LBOUND(SrcOtherStateData%xdot,1) - i1_u = UBOUND(SrcOtherStateData%xdot,1) - IF (.NOT. ALLOCATED(DstOtherStateData%xdot)) THEN - ALLOCATE(DstOtherStateData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL IceD_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstOtherStateData%n = SrcOtherStateData%n - END SUBROUTINE IceD_CopyOtherState - - SUBROUTINE IceD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(IceD_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 = 'IceD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%Nc)) THEN - DEALLOCATE(OtherStateData%Nc) -ENDIF -IF (ALLOCATED(OtherStateData%Psum)) THEN - DEALLOCATE(OtherStateData%Psum) -ENDIF -IF (ALLOCATED(OtherStateData%IceTthNo)) THEN - DEALLOCATE(OtherStateData%IceTthNo) -ENDIF -IF (ALLOCATED(OtherStateData%xdot)) THEN -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL IceD_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%xdot) -ENDIF - END SUBROUTINE IceD_DestroyOtherState - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 ! IceTthNo2 - Int_BufSz = Int_BufSz + 1 ! Nc allocated yes/no - IF ( ALLOCATED(InData%Nc) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Nc upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Nc) ! Nc - END IF - Int_BufSz = Int_BufSz + 1 ! Psum allocated yes/no - IF ( ALLOCATED(InData%Psum) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Psum upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Psum) ! Psum - END IF - Int_BufSz = Int_BufSz + 1 ! IceTthNo allocated yes/no - IF ( ALLOCATED(InData%IceTthNo) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IceTthNo upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IceTthNo) ! IceTthNo - END IF - Re_BufSz = Re_BufSz + 1 ! Beta - Db_BufSz = Db_BufSz + 1 ! Tinit - Int_BufSz = Int_BufSz + 1 ! Splitf - Re_BufSz = Re_BufSz + 1 ! dxc - Int_BufSz = Int_BufSz + 1 ! xdot allocated yes/no - IF ( ALLOCATED(InData%xdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xdot upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! n - 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%IceTthNo2 - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Nc) ) 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%Nc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nc,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Nc,1), UBOUND(InData%Nc,1) - IntKiBuf(Int_Xferred) = InData%Nc(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Psum) ) 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%Psum,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Psum,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Psum,1), UBOUND(InData%Psum,1) - ReKiBuf(Re_Xferred) = InData%Psum(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IceTthNo) ) 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%IceTthNo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IceTthNo,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IceTthNo,1), UBOUND(InData%IceTthNo,1) - IntKiBuf(Int_Xferred) = InData%IceTthNo(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Beta - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Tinit - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Splitf - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dxc - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%xdot) ) 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%xdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - 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%n - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceD_PackOtherState - - SUBROUTINE IceD_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(IceD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_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%IceTthNo2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nc 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%Nc)) DEALLOCATE(OutData%Nc) - ALLOCATE(OutData%Nc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Nc,1), UBOUND(OutData%Nc,1) - OutData%Nc(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Psum 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%Psum)) DEALLOCATE(OutData%Psum) - ALLOCATE(OutData%Psum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Psum,1), UBOUND(OutData%Psum,1) - OutData%Psum(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IceTthNo 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%IceTthNo)) DEALLOCATE(OutData%IceTthNo) - ALLOCATE(OutData%IceTthNo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceTthNo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IceTthNo,1), UBOUND(OutData%IceTthNo,1) - OutData%IceTthNo(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%Beta = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Tinit = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Splitf = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dxc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdot 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%xdot)) DEALLOCATE(OutData%xdot) - ALLOCATE(OutData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,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 IceD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - 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%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceD_UnPackOtherState - - SUBROUTINE IceD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(IceD_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 = 'IceD_CopyMisc' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine IceD_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call RegPack(Buf, InData%numLegs) + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%numLegs) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine + +subroutine IceD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(IceD_ContinuousStateType), intent(in) :: SrcContStateData + type(IceD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE IceD_CopyMisc - - SUBROUTINE IceD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(IceD_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 = 'IceD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceD_DestroyMisc - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 IceD_PackMisc - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 IceD_UnPackMisc - - SUBROUTINE IceD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(IceD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_CopyParam' -! + ErrMsg = '' + DstContStateData%q = SrcContStateData%q + DstContStateData%dqdt = SrcContStateData%dqdt +end subroutine + +subroutine IceD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(IceD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%h = SrcParamData%h - DstParamData%v = SrcParamData%v - DstParamData%t0 = SrcParamData%t0 - DstParamData%StrWd = SrcParamData%StrWd - DstParamData%dt = SrcParamData%dt - DstParamData%InitLoc = SrcParamData%InitLoc - DstParamData%tolerance = SrcParamData%tolerance - DstParamData%Tmax = SrcParamData%Tmax - DstParamData%verif = SrcParamData%verif - DstParamData%ModNo = SrcParamData%ModNo - DstParamData%SubModNo = SrcParamData%SubModNo - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%method = SrcParamData%method - DstParamData%TmStep = SrcParamData%TmStep -IF (ALLOCATED(SrcParamData%OutName)) THEN - i1_l = LBOUND(SrcParamData%OutName,1) - i1_u = UBOUND(SrcParamData%OutName,1) - IF (.NOT. ALLOCATED(DstParamData%OutName)) THEN - ALLOCATE(DstParamData%OutName(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutName.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutName = SrcParamData%OutName -ENDIF -IF (ALLOCATED(SrcParamData%OutUnit)) THEN - i1_l = LBOUND(SrcParamData%OutUnit,1) - i1_u = UBOUND(SrcParamData%OutUnit,1) - IF (.NOT. ALLOCATED(DstParamData%OutUnit)) THEN - ALLOCATE(DstParamData%OutUnit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutUnit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutUnit = SrcParamData%OutUnit -ENDIF - DstParamData%RootName = SrcParamData%RootName - DstParamData%tm1a = SrcParamData%tm1a - DstParamData%tm1b = SrcParamData%tm1b - DstParamData%tm1c = SrcParamData%tm1c - DstParamData%Fmax1a = SrcParamData%Fmax1a - DstParamData%Fmax1b = SrcParamData%Fmax1b - DstParamData%Fmax1c = SrcParamData%Fmax1c - DstParamData%Ikm = SrcParamData%Ikm - DstParamData%Cstr = SrcParamData%Cstr - DstParamData%EiPa = SrcParamData%EiPa - DstParamData%Delmax2 = SrcParamData%Delmax2 - DstParamData%Pitch = SrcParamData%Pitch - DstParamData%Kice2 = SrcParamData%Kice2 -IF (ALLOCATED(SrcParamData%rdmFm)) THEN - i1_l = LBOUND(SrcParamData%rdmFm,1) - i1_u = UBOUND(SrcParamData%rdmFm,1) - IF (.NOT. ALLOCATED(DstParamData%rdmFm)) THEN - ALLOCATE(DstParamData%rdmFm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmFm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmFm = SrcParamData%rdmFm -ENDIF -IF (ALLOCATED(SrcParamData%rdmt0)) THEN - i1_l = LBOUND(SrcParamData%rdmt0,1) - i1_u = UBOUND(SrcParamData%rdmt0,1) - IF (.NOT. ALLOCATED(DstParamData%rdmt0)) THEN - ALLOCATE(DstParamData%rdmt0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmt0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmt0 = SrcParamData%rdmt0 -ENDIF -IF (ALLOCATED(SrcParamData%rdmtm)) THEN - i1_l = LBOUND(SrcParamData%rdmtm,1) - i1_u = UBOUND(SrcParamData%rdmtm,1) - IF (.NOT. ALLOCATED(DstParamData%rdmtm)) THEN - ALLOCATE(DstParamData%rdmtm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmtm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmtm = SrcParamData%rdmtm -ENDIF -IF (ALLOCATED(SrcParamData%rdmDm)) THEN - i1_l = LBOUND(SrcParamData%rdmDm,1) - i1_u = UBOUND(SrcParamData%rdmDm,1) - IF (.NOT. ALLOCATED(DstParamData%rdmDm)) THEN - ALLOCATE(DstParamData%rdmDm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmDm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmDm = SrcParamData%rdmDm -ENDIF -IF (ALLOCATED(SrcParamData%rdmP)) THEN - i1_l = LBOUND(SrcParamData%rdmP,1) - i1_u = UBOUND(SrcParamData%rdmP,1) - IF (.NOT. ALLOCATED(DstParamData%rdmP)) THEN - ALLOCATE(DstParamData%rdmP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmP = SrcParamData%rdmP -ENDIF -IF (ALLOCATED(SrcParamData%rdmKi)) THEN - i1_l = LBOUND(SrcParamData%rdmKi,1) - i1_u = UBOUND(SrcParamData%rdmKi,1) - IF (.NOT. ALLOCATED(DstParamData%rdmKi)) THEN - ALLOCATE(DstParamData%rdmKi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmKi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmKi = SrcParamData%rdmKi -ENDIF - DstParamData%ZonePitch = SrcParamData%ZonePitch - DstParamData%Kice = SrcParamData%Kice - DstParamData%Delmax = SrcParamData%Delmax -IF (ALLOCATED(SrcParamData%Y0)) THEN - i1_l = LBOUND(SrcParamData%Y0,1) - i1_u = UBOUND(SrcParamData%Y0,1) - IF (.NOT. ALLOCATED(DstParamData%Y0)) THEN - ALLOCATE(DstParamData%Y0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Y0 = SrcParamData%Y0 -ENDIF -IF (ALLOCATED(SrcParamData%ContPrfl)) THEN - i1_l = LBOUND(SrcParamData%ContPrfl,1) - i1_u = UBOUND(SrcParamData%ContPrfl,1) - IF (.NOT. ALLOCATED(DstParamData%ContPrfl)) THEN - ALLOCATE(DstParamData%ContPrfl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ContPrfl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ContPrfl = SrcParamData%ContPrfl -ENDIF - DstParamData%Zn = SrcParamData%Zn - DstParamData%rhoi = SrcParamData%rhoi - DstParamData%rhow = SrcParamData%rhow - DstParamData%alphaR = SrcParamData%alphaR - DstParamData%Dwl = SrcParamData%Dwl - DstParamData%Zr = SrcParamData%Zr - DstParamData%RHbr = SrcParamData%RHbr - DstParamData%RVbr = SrcParamData%RVbr - DstParamData%Lbr = SrcParamData%Lbr - DstParamData%LovR = SrcParamData%LovR - DstParamData%mu = SrcParamData%mu - DstParamData%Wri = SrcParamData%Wri - DstParamData%WL = SrcParamData%WL - DstParamData%Cpa = SrcParamData%Cpa - DstParamData%dpa = SrcParamData%dpa - DstParamData%FdrN = SrcParamData%FdrN - DstParamData%Mice = SrcParamData%Mice - DstParamData%Fsp = SrcParamData%Fsp - END SUBROUTINE IceD_CopyParam - - SUBROUTINE IceD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(IceD_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 = 'IceD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%OutName)) THEN - DEALLOCATE(ParamData%OutName) -ENDIF -IF (ALLOCATED(ParamData%OutUnit)) THEN - DEALLOCATE(ParamData%OutUnit) -ENDIF -IF (ALLOCATED(ParamData%rdmFm)) THEN - DEALLOCATE(ParamData%rdmFm) -ENDIF -IF (ALLOCATED(ParamData%rdmt0)) THEN - DEALLOCATE(ParamData%rdmt0) -ENDIF -IF (ALLOCATED(ParamData%rdmtm)) THEN - DEALLOCATE(ParamData%rdmtm) -ENDIF -IF (ALLOCATED(ParamData%rdmDm)) THEN - DEALLOCATE(ParamData%rdmDm) -ENDIF -IF (ALLOCATED(ParamData%rdmP)) THEN - DEALLOCATE(ParamData%rdmP) -ENDIF -IF (ALLOCATED(ParamData%rdmKi)) THEN - DEALLOCATE(ParamData%rdmKi) -ENDIF -IF (ALLOCATED(ParamData%Y0)) THEN - DEALLOCATE(ParamData%Y0) -ENDIF -IF (ALLOCATED(ParamData%ContPrfl)) THEN - DEALLOCATE(ParamData%ContPrfl) -ENDIF - END SUBROUTINE IceD_DestroyParam - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 - Re_BufSz = Re_BufSz + 1 ! h - Re_BufSz = Re_BufSz + 1 ! v - Re_BufSz = Re_BufSz + 1 ! t0 - Re_BufSz = Re_BufSz + 1 ! StrWd - Re_BufSz = Re_BufSz + 1 ! dt - Re_BufSz = Re_BufSz + 1 ! InitLoc - Re_BufSz = Re_BufSz + 1 ! tolerance - Re_BufSz = Re_BufSz + 1 ! Tmax - Int_BufSz = Int_BufSz + 1 ! verif - Int_BufSz = Int_BufSz + 1 ! ModNo - Int_BufSz = Int_BufSz + 1 ! SubModNo - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! method - Int_BufSz = Int_BufSz + 1 ! TmStep - Int_BufSz = Int_BufSz + 1 ! OutName allocated yes/no - IF ( ALLOCATED(InData%OutName) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutName upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutName)*LEN(InData%OutName) ! OutName - END IF - Int_BufSz = Int_BufSz + 1 ! OutUnit allocated yes/no - IF ( ALLOCATED(InData%OutUnit) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutUnit upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutUnit)*LEN(InData%OutUnit) ! OutUnit - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! tm1a - Re_BufSz = Re_BufSz + 1 ! tm1b - Re_BufSz = Re_BufSz + 1 ! tm1c - Re_BufSz = Re_BufSz + 1 ! Fmax1a - Re_BufSz = Re_BufSz + 1 ! Fmax1b - Re_BufSz = Re_BufSz + 1 ! Fmax1c - Re_BufSz = Re_BufSz + 1 ! Ikm - Re_BufSz = Re_BufSz + 1 ! Cstr - Re_BufSz = Re_BufSz + 1 ! EiPa - Re_BufSz = Re_BufSz + 1 ! Delmax2 - Re_BufSz = Re_BufSz + 1 ! Pitch - Re_BufSz = Re_BufSz + 1 ! Kice2 - Int_BufSz = Int_BufSz + 1 ! rdmFm allocated yes/no - IF ( ALLOCATED(InData%rdmFm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmFm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmFm) ! rdmFm - END IF - Int_BufSz = Int_BufSz + 1 ! rdmt0 allocated yes/no - IF ( ALLOCATED(InData%rdmt0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmt0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmt0) ! rdmt0 - END IF - Int_BufSz = Int_BufSz + 1 ! rdmtm allocated yes/no - IF ( ALLOCATED(InData%rdmtm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmtm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmtm) ! rdmtm - END IF - Int_BufSz = Int_BufSz + 1 ! rdmDm allocated yes/no - IF ( ALLOCATED(InData%rdmDm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmDm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmDm) ! rdmDm - END IF - Int_BufSz = Int_BufSz + 1 ! rdmP allocated yes/no - IF ( ALLOCATED(InData%rdmP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmP) ! rdmP - END IF - Int_BufSz = Int_BufSz + 1 ! rdmKi allocated yes/no - IF ( ALLOCATED(InData%rdmKi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmKi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmKi) ! rdmKi - END IF - Re_BufSz = Re_BufSz + 1 ! ZonePitch - Re_BufSz = Re_BufSz + 1 ! Kice - Re_BufSz = Re_BufSz + 1 ! Delmax - Int_BufSz = Int_BufSz + 1 ! Y0 allocated yes/no - IF ( ALLOCATED(InData%Y0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y0) ! Y0 - END IF - Int_BufSz = Int_BufSz + 1 ! ContPrfl allocated yes/no - IF ( ALLOCATED(InData%ContPrfl) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ContPrfl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ContPrfl) ! ContPrfl - END IF - Int_BufSz = Int_BufSz + 1 ! Zn - Re_BufSz = Re_BufSz + 1 ! rhoi - Re_BufSz = Re_BufSz + 1 ! rhow - Re_BufSz = Re_BufSz + 1 ! alphaR - Re_BufSz = Re_BufSz + 1 ! Dwl - Re_BufSz = Re_BufSz + 1 ! Zr - Re_BufSz = Re_BufSz + 1 ! RHbr - Re_BufSz = Re_BufSz + 1 ! RVbr - Re_BufSz = Re_BufSz + 1 ! Lbr - Re_BufSz = Re_BufSz + 1 ! LovR - Re_BufSz = Re_BufSz + 1 ! mu - Re_BufSz = Re_BufSz + 1 ! Wri - Re_BufSz = Re_BufSz + 1 ! WL - Re_BufSz = Re_BufSz + 1 ! Cpa - Re_BufSz = Re_BufSz + 1 ! dpa - Re_BufSz = Re_BufSz + 1 ! FdrN - Re_BufSz = Re_BufSz + 1 ! Mice - Re_BufSz = Re_BufSz + 1 ! Fsp - 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%h - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%v - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%t0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StrWd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InitLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tolerance - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Tmax - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%verif - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ModNo - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SubModNo - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%method - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TmStep - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutName) ) 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%OutName,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutName,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutName,1), UBOUND(InData%OutName,1) - DO I = 1, LEN(InData%OutName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutName(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutUnit) ) 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%OutUnit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutUnit,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutUnit,1), UBOUND(InData%OutUnit,1) - DO I = 1, LEN(InData%OutUnit) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutUnit(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%tm1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tm1b - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tm1c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Fmax1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Fmax1b - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Fmax1c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ikm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cstr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%EiPa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Delmax2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kice2 - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%rdmFm) ) 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%rdmFm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmFm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmFm,1), UBOUND(InData%rdmFm,1) - ReKiBuf(Re_Xferred) = InData%rdmFm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdmt0) ) 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%rdmt0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmt0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmt0,1), UBOUND(InData%rdmt0,1) - ReKiBuf(Re_Xferred) = InData%rdmt0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdmtm) ) 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%rdmtm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmtm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmtm,1), UBOUND(InData%rdmtm,1) - ReKiBuf(Re_Xferred) = InData%rdmtm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdmDm) ) 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%rdmDm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmDm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmDm,1), UBOUND(InData%rdmDm,1) - ReKiBuf(Re_Xferred) = InData%rdmDm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdmP) ) 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%rdmP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmP,1), UBOUND(InData%rdmP,1) - ReKiBuf(Re_Xferred) = InData%rdmP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdmKi) ) 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%rdmKi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmKi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmKi,1), UBOUND(InData%rdmKi,1) - ReKiBuf(Re_Xferred) = InData%rdmKi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%ZonePitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kice - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Delmax - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Y0) ) 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%Y0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y0,1), UBOUND(InData%Y0,1) - ReKiBuf(Re_Xferred) = InData%Y0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ContPrfl) ) 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%ContPrfl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ContPrfl,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ContPrfl,1), UBOUND(InData%ContPrfl,1) - ReKiBuf(Re_Xferred) = InData%ContPrfl(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Zn - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhoi - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhow - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alphaR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Dwl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Zr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RHbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RVbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Lbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LovR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%mu - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Wri - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FdrN - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Mice - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Fsp - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_PackParam - - SUBROUTINE IceD_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(IceD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_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%h = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%v = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%t0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StrWd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InitLoc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tolerance = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Tmax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%verif = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ModNo = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SubModNo = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%method = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TmStep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutName 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%OutName)) DEALLOCATE(OutData%OutName) - ALLOCATE(OutData%OutName(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutName.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutName,1), UBOUND(OutData%OutName,1) - DO I = 1, LEN(OutData%OutName) - OutData%OutName(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 ! OutUnit 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%OutUnit)) DEALLOCATE(OutData%OutUnit) - ALLOCATE(OutData%OutUnit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutUnit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutUnit,1), UBOUND(OutData%OutUnit,1) - DO I = 1, LEN(OutData%OutUnit) - OutData%OutUnit(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%tm1a = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tm1b = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tm1c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1a = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1b = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ikm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cstr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%EiPa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kice2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmFm 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%rdmFm)) DEALLOCATE(OutData%rdmFm) - ALLOCATE(OutData%rdmFm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmFm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmFm,1), UBOUND(OutData%rdmFm,1) - OutData%rdmFm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmt0 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%rdmt0)) DEALLOCATE(OutData%rdmt0) - ALLOCATE(OutData%rdmt0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmt0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmt0,1), UBOUND(OutData%rdmt0,1) - OutData%rdmt0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmtm 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%rdmtm)) DEALLOCATE(OutData%rdmtm) - ALLOCATE(OutData%rdmtm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmtm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmtm,1), UBOUND(OutData%rdmtm,1) - OutData%rdmtm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmDm 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%rdmDm)) DEALLOCATE(OutData%rdmDm) - ALLOCATE(OutData%rdmDm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmDm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmDm,1), UBOUND(OutData%rdmDm,1) - OutData%rdmDm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmP 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%rdmP)) DEALLOCATE(OutData%rdmP) - ALLOCATE(OutData%rdmP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmP,1), UBOUND(OutData%rdmP,1) - OutData%rdmP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmKi 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%rdmKi)) DEALLOCATE(OutData%rdmKi) - ALLOCATE(OutData%rdmKi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmKi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmKi,1), UBOUND(OutData%rdmKi,1) - OutData%rdmKi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%ZonePitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kice = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y0 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%Y0)) DEALLOCATE(OutData%Y0) - ALLOCATE(OutData%Y0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y0,1), UBOUND(OutData%Y0,1) - OutData%Y0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ContPrfl 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%ContPrfl)) DEALLOCATE(OutData%ContPrfl) - ALLOCATE(OutData%ContPrfl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ContPrfl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ContPrfl,1), UBOUND(OutData%ContPrfl,1) - OutData%ContPrfl(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Zn = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%rhoi = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rhow = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alphaR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Dwl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Zr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RHbr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RVbr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Lbr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LovR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%mu = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Wri = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cpa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dpa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FdrN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Mice = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Fsp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_UnPackParam - - SUBROUTINE IceD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(IceD_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 = 'IceD_CopyInput' -! + ErrMsg = '' +end subroutine + +subroutine IceD_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%q) + call RegPack(Buf, InData%dqdt) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%q) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dqdt) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(IceD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(IceD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%PointMesh, DstInputData%PointMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE IceD_CopyInput - - SUBROUTINE IceD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(IceD_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 = 'IceD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( InputData%PointMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE IceD_DestroyInput - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PointMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PointMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PointMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PointMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PointMesh - 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 - - CALL MeshPack( InData%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PointMesh - 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 IceD_PackInput - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 - 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 MeshUnpack( OutData%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PointMesh - 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 IceD_UnPackInput - - SUBROUTINE IceD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(IceD_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 = 'IceD_CopyOutput' -! + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine IceD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(IceD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%PointMesh, DstOutputData%PointMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -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 IceD_CopyOutput - - SUBROUTINE IceD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(IceD_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 = 'IceD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%PointMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE IceD_DestroyOutput - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PointMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PointMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PointMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PointMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PointMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 - - CALL MeshPack( InData%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PointMesh - 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 - 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 IceD_PackOutput - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 - 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 MeshUnpack( OutData%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PointMesh - 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) - 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 IceD_UnPackOutput - - - SUBROUTINE IceD_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(IceD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(IceD_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 + ErrMsg = '' +end subroutine + +subroutine IceD_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(IceD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(IceD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine IceD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(IceD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine IceD_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(IceD_OtherStateType), intent(in) :: SrcOtherStateData + type(IceD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%IceTthNo2 = SrcOtherStateData%IceTthNo2 + if (allocated(SrcOtherStateData%Nc)) then + LB(1:1) = lbound(SrcOtherStateData%Nc) + UB(1:1) = ubound(SrcOtherStateData%Nc) + if (.not. allocated(DstOtherStateData%Nc)) then + allocate(DstOtherStateData%Nc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Nc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%Nc = SrcOtherStateData%Nc + end if + if (allocated(SrcOtherStateData%Psum)) then + LB(1:1) = lbound(SrcOtherStateData%Psum) + UB(1:1) = ubound(SrcOtherStateData%Psum) + if (.not. allocated(DstOtherStateData%Psum)) then + allocate(DstOtherStateData%Psum(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Psum.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%Psum = SrcOtherStateData%Psum + end if + if (allocated(SrcOtherStateData%IceTthNo)) then + LB(1:1) = lbound(SrcOtherStateData%IceTthNo) + UB(1:1) = ubound(SrcOtherStateData%IceTthNo) + if (.not. allocated(DstOtherStateData%IceTthNo)) then + allocate(DstOtherStateData%IceTthNo(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IceTthNo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%IceTthNo = SrcOtherStateData%IceTthNo + end if + DstOtherStateData%Beta = SrcOtherStateData%Beta + DstOtherStateData%Tinit = SrcOtherStateData%Tinit + DstOtherStateData%Splitf = SrcOtherStateData%Splitf + DstOtherStateData%dxc = SrcOtherStateData%dxc + if (allocated(SrcOtherStateData%xdot)) then + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + if (.not. allocated(DstOtherStateData%xdot)) then + allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceD_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstOtherStateData%n = SrcOtherStateData%n +end subroutine + +subroutine IceD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(IceD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%Nc)) then + deallocate(OtherStateData%Nc) + end if + if (allocated(OtherStateData%Psum)) then + deallocate(OtherStateData%Psum) + end if + if (allocated(OtherStateData%IceTthNo)) then + deallocate(OtherStateData%IceTthNo) + end if + if (allocated(OtherStateData%xdot)) then + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call IceD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%xdot) + end if +end subroutine + +subroutine IceD_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%IceTthNo2) + call RegPack(Buf, allocated(InData%Nc)) + if (allocated(InData%Nc)) then + call RegPackBounds(Buf, 1, lbound(InData%Nc), ubound(InData%Nc)) + call RegPack(Buf, InData%Nc) + end if + call RegPack(Buf, allocated(InData%Psum)) + if (allocated(InData%Psum)) then + call RegPackBounds(Buf, 1, lbound(InData%Psum), ubound(InData%Psum)) + call RegPack(Buf, InData%Psum) + end if + call RegPack(Buf, allocated(InData%IceTthNo)) + if (allocated(InData%IceTthNo)) then + call RegPackBounds(Buf, 1, lbound(InData%IceTthNo), ubound(InData%IceTthNo)) + call RegPack(Buf, InData%IceTthNo) + end if + call RegPack(Buf, InData%Beta) + call RegPack(Buf, InData%Tinit) + call RegPack(Buf, InData%Splitf) + call RegPack(Buf, InData%dxc) + call RegPack(Buf, allocated(InData%xdot)) + if (allocated(InData%xdot)) then + call RegPackBounds(Buf, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call IceD_PackContState(Buf, InData%xdot(i1)) + end do + end if + call RegPack(Buf, InData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%IceTthNo2) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Nc)) deallocate(OutData%Nc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nc(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Nc) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Psum)) deallocate(OutData%Psum) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Psum(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psum.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Psum) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IceTthNo)) deallocate(OutData%IceTthNo) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IceTthNo(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceTthNo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IceTthNo) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Beta) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Tinit) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Splitf) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dxc) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%xdot)) deallocate(OutData%xdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do + end if + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(IceD_MiscVarType), intent(in) :: SrcMiscData + type(IceD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar +end subroutine + +subroutine IceD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(IceD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine IceD_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(IceD_ParameterType), intent(in) :: SrcParamData + type(IceD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IceD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%h = SrcParamData%h + DstParamData%v = SrcParamData%v + DstParamData%t0 = SrcParamData%t0 + DstParamData%StrWd = SrcParamData%StrWd + DstParamData%dt = SrcParamData%dt + DstParamData%InitLoc = SrcParamData%InitLoc + DstParamData%tolerance = SrcParamData%tolerance + DstParamData%Tmax = SrcParamData%Tmax + DstParamData%verif = SrcParamData%verif + DstParamData%ModNo = SrcParamData%ModNo + DstParamData%SubModNo = SrcParamData%SubModNo + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%method = SrcParamData%method + DstParamData%TmStep = SrcParamData%TmStep + if (allocated(SrcParamData%OutName)) then + LB(1:1) = lbound(SrcParamData%OutName) + UB(1:1) = ubound(SrcParamData%OutName) + if (.not. allocated(DstParamData%OutName)) then + allocate(DstParamData%OutName(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutName.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutName = SrcParamData%OutName + end if + if (allocated(SrcParamData%OutUnit)) then + LB(1:1) = lbound(SrcParamData%OutUnit) + UB(1:1) = ubound(SrcParamData%OutUnit) + if (.not. allocated(DstParamData%OutUnit)) then + allocate(DstParamData%OutUnit(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutUnit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutUnit = SrcParamData%OutUnit + end if + DstParamData%RootName = SrcParamData%RootName + DstParamData%tm1a = SrcParamData%tm1a + DstParamData%tm1b = SrcParamData%tm1b + DstParamData%tm1c = SrcParamData%tm1c + DstParamData%Fmax1a = SrcParamData%Fmax1a + DstParamData%Fmax1b = SrcParamData%Fmax1b + DstParamData%Fmax1c = SrcParamData%Fmax1c + DstParamData%Ikm = SrcParamData%Ikm + DstParamData%Cstr = SrcParamData%Cstr + DstParamData%EiPa = SrcParamData%EiPa + DstParamData%Delmax2 = SrcParamData%Delmax2 + DstParamData%Pitch = SrcParamData%Pitch + DstParamData%Kice2 = SrcParamData%Kice2 + if (allocated(SrcParamData%rdmFm)) then + LB(1:1) = lbound(SrcParamData%rdmFm) + UB(1:1) = ubound(SrcParamData%rdmFm) + if (.not. allocated(DstParamData%rdmFm)) then + allocate(DstParamData%rdmFm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmFm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmFm = SrcParamData%rdmFm + end if + if (allocated(SrcParamData%rdmt0)) then + LB(1:1) = lbound(SrcParamData%rdmt0) + UB(1:1) = ubound(SrcParamData%rdmt0) + if (.not. allocated(DstParamData%rdmt0)) then + allocate(DstParamData%rdmt0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmt0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmt0 = SrcParamData%rdmt0 + end if + if (allocated(SrcParamData%rdmtm)) then + LB(1:1) = lbound(SrcParamData%rdmtm) + UB(1:1) = ubound(SrcParamData%rdmtm) + if (.not. allocated(DstParamData%rdmtm)) then + allocate(DstParamData%rdmtm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmtm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmtm = SrcParamData%rdmtm + end if + if (allocated(SrcParamData%rdmDm)) then + LB(1:1) = lbound(SrcParamData%rdmDm) + UB(1:1) = ubound(SrcParamData%rdmDm) + if (.not. allocated(DstParamData%rdmDm)) then + allocate(DstParamData%rdmDm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmDm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmDm = SrcParamData%rdmDm + end if + if (allocated(SrcParamData%rdmP)) then + LB(1:1) = lbound(SrcParamData%rdmP) + UB(1:1) = ubound(SrcParamData%rdmP) + if (.not. allocated(DstParamData%rdmP)) then + allocate(DstParamData%rdmP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmP = SrcParamData%rdmP + end if + if (allocated(SrcParamData%rdmKi)) then + LB(1:1) = lbound(SrcParamData%rdmKi) + UB(1:1) = ubound(SrcParamData%rdmKi) + if (.not. allocated(DstParamData%rdmKi)) then + allocate(DstParamData%rdmKi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmKi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmKi = SrcParamData%rdmKi + end if + DstParamData%ZonePitch = SrcParamData%ZonePitch + DstParamData%Kice = SrcParamData%Kice + DstParamData%Delmax = SrcParamData%Delmax + if (allocated(SrcParamData%Y0)) then + LB(1:1) = lbound(SrcParamData%Y0) + UB(1:1) = ubound(SrcParamData%Y0) + if (.not. allocated(DstParamData%Y0)) then + allocate(DstParamData%Y0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Y0 = SrcParamData%Y0 + end if + if (allocated(SrcParamData%ContPrfl)) then + LB(1:1) = lbound(SrcParamData%ContPrfl) + UB(1:1) = ubound(SrcParamData%ContPrfl) + if (.not. allocated(DstParamData%ContPrfl)) then + allocate(DstParamData%ContPrfl(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ContPrfl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ContPrfl = SrcParamData%ContPrfl + end if + DstParamData%Zn = SrcParamData%Zn + DstParamData%rhoi = SrcParamData%rhoi + DstParamData%rhow = SrcParamData%rhow + DstParamData%alphaR = SrcParamData%alphaR + DstParamData%Dwl = SrcParamData%Dwl + DstParamData%Zr = SrcParamData%Zr + DstParamData%RHbr = SrcParamData%RHbr + DstParamData%RVbr = SrcParamData%RVbr + DstParamData%Lbr = SrcParamData%Lbr + DstParamData%LovR = SrcParamData%LovR + DstParamData%mu = SrcParamData%mu + DstParamData%Wri = SrcParamData%Wri + DstParamData%WL = SrcParamData%WL + DstParamData%Cpa = SrcParamData%Cpa + DstParamData%dpa = SrcParamData%dpa + DstParamData%FdrN = SrcParamData%FdrN + DstParamData%Mice = SrcParamData%Mice + DstParamData%Fsp = SrcParamData%Fsp +end subroutine + +subroutine IceD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(IceD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%OutName)) then + deallocate(ParamData%OutName) + end if + if (allocated(ParamData%OutUnit)) then + deallocate(ParamData%OutUnit) + end if + if (allocated(ParamData%rdmFm)) then + deallocate(ParamData%rdmFm) + end if + if (allocated(ParamData%rdmt0)) then + deallocate(ParamData%rdmt0) + end if + if (allocated(ParamData%rdmtm)) then + deallocate(ParamData%rdmtm) + end if + if (allocated(ParamData%rdmDm)) then + deallocate(ParamData%rdmDm) + end if + if (allocated(ParamData%rdmP)) then + deallocate(ParamData%rdmP) + end if + if (allocated(ParamData%rdmKi)) then + deallocate(ParamData%rdmKi) + end if + if (allocated(ParamData%Y0)) then + deallocate(ParamData%Y0) + end if + if (allocated(ParamData%ContPrfl)) then + deallocate(ParamData%ContPrfl) + end if +end subroutine + +subroutine IceD_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%h) + call RegPack(Buf, InData%v) + call RegPack(Buf, InData%t0) + call RegPack(Buf, InData%StrWd) + call RegPack(Buf, InData%dt) + call RegPack(Buf, InData%InitLoc) + call RegPack(Buf, InData%tolerance) + call RegPack(Buf, InData%Tmax) + call RegPack(Buf, InData%verif) + call RegPack(Buf, InData%ModNo) + call RegPack(Buf, InData%SubModNo) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%method) + call RegPack(Buf, InData%TmStep) + call RegPack(Buf, allocated(InData%OutName)) + if (allocated(InData%OutName)) then + call RegPackBounds(Buf, 1, lbound(InData%OutName), ubound(InData%OutName)) + call RegPack(Buf, InData%OutName) + end if + call RegPack(Buf, allocated(InData%OutUnit)) + if (allocated(InData%OutUnit)) then + call RegPackBounds(Buf, 1, lbound(InData%OutUnit), ubound(InData%OutUnit)) + call RegPack(Buf, InData%OutUnit) + end if + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%tm1a) + call RegPack(Buf, InData%tm1b) + call RegPack(Buf, InData%tm1c) + call RegPack(Buf, InData%Fmax1a) + call RegPack(Buf, InData%Fmax1b) + call RegPack(Buf, InData%Fmax1c) + call RegPack(Buf, InData%Ikm) + call RegPack(Buf, InData%Cstr) + call RegPack(Buf, InData%EiPa) + call RegPack(Buf, InData%Delmax2) + call RegPack(Buf, InData%Pitch) + call RegPack(Buf, InData%Kice2) + call RegPack(Buf, allocated(InData%rdmFm)) + if (allocated(InData%rdmFm)) then + call RegPackBounds(Buf, 1, lbound(InData%rdmFm), ubound(InData%rdmFm)) + call RegPack(Buf, InData%rdmFm) + end if + call RegPack(Buf, allocated(InData%rdmt0)) + if (allocated(InData%rdmt0)) then + call RegPackBounds(Buf, 1, lbound(InData%rdmt0), ubound(InData%rdmt0)) + call RegPack(Buf, InData%rdmt0) + end if + call RegPack(Buf, allocated(InData%rdmtm)) + if (allocated(InData%rdmtm)) then + call RegPackBounds(Buf, 1, lbound(InData%rdmtm), ubound(InData%rdmtm)) + call RegPack(Buf, InData%rdmtm) + end if + call RegPack(Buf, allocated(InData%rdmDm)) + if (allocated(InData%rdmDm)) then + call RegPackBounds(Buf, 1, lbound(InData%rdmDm), ubound(InData%rdmDm)) + call RegPack(Buf, InData%rdmDm) + end if + call RegPack(Buf, allocated(InData%rdmP)) + if (allocated(InData%rdmP)) then + call RegPackBounds(Buf, 1, lbound(InData%rdmP), ubound(InData%rdmP)) + call RegPack(Buf, InData%rdmP) + end if + call RegPack(Buf, allocated(InData%rdmKi)) + if (allocated(InData%rdmKi)) then + call RegPackBounds(Buf, 1, lbound(InData%rdmKi), ubound(InData%rdmKi)) + call RegPack(Buf, InData%rdmKi) + end if + call RegPack(Buf, InData%ZonePitch) + call RegPack(Buf, InData%Kice) + call RegPack(Buf, InData%Delmax) + call RegPack(Buf, allocated(InData%Y0)) + if (allocated(InData%Y0)) then + call RegPackBounds(Buf, 1, lbound(InData%Y0), ubound(InData%Y0)) + call RegPack(Buf, InData%Y0) + end if + call RegPack(Buf, allocated(InData%ContPrfl)) + if (allocated(InData%ContPrfl)) then + call RegPackBounds(Buf, 1, lbound(InData%ContPrfl), ubound(InData%ContPrfl)) + call RegPack(Buf, InData%ContPrfl) + end if + call RegPack(Buf, InData%Zn) + call RegPack(Buf, InData%rhoi) + call RegPack(Buf, InData%rhow) + call RegPack(Buf, InData%alphaR) + call RegPack(Buf, InData%Dwl) + call RegPack(Buf, InData%Zr) + call RegPack(Buf, InData%RHbr) + call RegPack(Buf, InData%RVbr) + call RegPack(Buf, InData%Lbr) + call RegPack(Buf, InData%LovR) + call RegPack(Buf, InData%mu) + call RegPack(Buf, InData%Wri) + call RegPack(Buf, InData%WL) + call RegPack(Buf, InData%Cpa) + call RegPack(Buf, InData%dpa) + call RegPack(Buf, InData%FdrN) + call RegPack(Buf, InData%Mice) + call RegPack(Buf, InData%Fsp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackParam' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%h) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%v) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%t0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StrWd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InitLoc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tolerance) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%verif) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ModNo) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SubModNo) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%method) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TmStep) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutName)) deallocate(OutData%OutName) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutName(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutName.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutName) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OutUnit)) deallocate(OutData%OutUnit) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutUnit(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutUnit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutUnit) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tm1a) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tm1b) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%tm1c) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Fmax1a) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Fmax1b) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Fmax1c) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ikm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cstr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EiPa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Delmax2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Pitch) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Kice2) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%rdmFm)) deallocate(OutData%rdmFm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdmFm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmFm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdmFm) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rdmt0)) deallocate(OutData%rdmt0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdmt0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmt0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdmt0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rdmtm)) deallocate(OutData%rdmtm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdmtm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmtm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdmtm) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rdmDm)) deallocate(OutData%rdmDm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdmDm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmDm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdmDm) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rdmP)) deallocate(OutData%rdmP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdmP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdmP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rdmKi)) deallocate(OutData%rdmKi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdmKi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmKi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdmKi) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%ZonePitch) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Kice) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Delmax) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Y0)) deallocate(OutData%Y0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ContPrfl)) deallocate(OutData%ContPrfl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ContPrfl(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ContPrfl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ContPrfl) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Zn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rhoi) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rhow) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%alphaR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Dwl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Zr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RHbr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RVbr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Lbr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LovR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%mu) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Wri) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cpa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dpa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FdrN) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Mice) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Fsp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(IceD_InputType), intent(inout) :: SrcInputData + type(IceD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%PointMesh, DstInputData%PointMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine IceD_DestroyInput(InputData, ErrStat, ErrMsg) + type(IceD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%PointMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine IceD_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%PointMesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%PointMesh) ! PointMesh +end subroutine + +subroutine IceD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(IceD_OutputType), intent(inout) :: SrcOutputData + type(IceD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%PointMesh, DstOutputData%PointMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine IceD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(IceD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%PointMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine IceD_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%PointMesh) + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%PointMesh) ! PointMesh + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine IceD_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(IceD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(IceD_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 = 'IceD_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 IceD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL IceD_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 IceD_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 IceD_Input_ExtrapInterp - - - SUBROUTINE IceD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call IceD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call IceD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call IceD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE IceD_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. @@ -3848,41 +1931,42 @@ SUBROUTINE IceD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(IceD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(IceD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(IceD_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 + TYPE(IceD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(IceD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(IceD_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 = 'IceD_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(u1%PointMesh, u2%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE IceD_Input_ExtrapInterp1 - - - SUBROUTINE IceD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%PointMesh, u2%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE IceD_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. @@ -3896,101 +1980,102 @@ SUBROUTINE IceD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(IceD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(IceD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(IceD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(IceD_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 + TYPE(IceD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(IceD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(IceD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(IceD_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 = 'IceD_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'IceD_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(u1%PointMesh, u2%PointMesh, u3%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE IceD_Input_ExtrapInterp2 - - - SUBROUTINE IceD_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(IceD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(IceD_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%PointMesh, u2%PointMesh, u3%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine IceD_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(IceD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(IceD_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 = 'IceD_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 IceD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL IceD_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 IceD_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 IceD_Output_ExtrapInterp - - - SUBROUTINE IceD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call IceD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call IceD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call IceD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE IceD_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. @@ -4002,49 +2087,47 @@ SUBROUTINE IceD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(IceD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(IceD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(IceD_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 + TYPE(IceD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(IceD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(IceD_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 = 'IceD_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(y1%PointMesh, y2%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 IceD_Output_ExtrapInterp1 - - - SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%PointMesh, y2%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE IceD_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. @@ -4058,56 +2141,52 @@ SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(IceD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(IceD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(IceD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(IceD_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 + TYPE(IceD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(IceD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(IceD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(IceD_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 = 'IceD_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'IceD_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(y1%PointMesh, y2%PointMesh, y3%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 IceD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%PointMesh, y2%PointMesh, y3%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE IceDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index c010436746..2a7230ceb8 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -36,9 +36,9 @@ MODULE IceFloe_Types ! ========= IceFloe_InitInputType ======= TYPE, PUBLIC :: IceFloe_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] - REAL(ReKi) :: simLength !< Duration of simulation [sec] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] - REAL(ReKi) :: gravity !< Gravitational acceleration [m/s^2] + REAL(ReKi) :: simLength = 0.0_ReKi !< Duration of simulation [sec] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] + REAL(ReKi) :: gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] character(1024) :: RootName !< Output file root name [-] END TYPE IceFloe_InitInputType ! ======================= @@ -51,50 +51,50 @@ MODULE IceFloe_Types ! ======================= ! ========= IceFloe_ContinuousStateType ======= TYPE, PUBLIC :: IceFloe_ContinuousStateType - REAL(SiKi) :: DummyContStateVar !< None currently used [-] + REAL(SiKi) :: DummyContStateVar = 0.0_R4Ki !< None currently used [-] END TYPE IceFloe_ContinuousStateType ! ======================= ! ========= IceFloe_DiscreteStateType ======= TYPE, PUBLIC :: IceFloe_DiscreteStateType - REAL(SiKi) :: DummyDiscStateVar !< None currently used [-] + REAL(SiKi) :: DummyDiscStateVar = 0.0_R4Ki !< None currently used [-] END TYPE IceFloe_DiscreteStateType ! ======================= ! ========= IceFloe_ConstraintStateType ======= TYPE, PUBLIC :: IceFloe_ConstraintStateType - REAL(SiKi) :: DummyConstrStateVar !< None currently used [-] + REAL(SiKi) :: DummyConstrStateVar = 0.0_R4Ki !< None currently used [-] END TYPE IceFloe_ConstraintStateType ! ======================= ! ========= IceFloe_OtherStateType ======= TYPE, PUBLIC :: IceFloe_OtherStateType - INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] + INTEGER(IntKi) :: DummyOtherState = 0_IntKi !< Remove this variable if you have other states [-] END TYPE IceFloe_OtherStateType ! ======================= ! ========= IceFloe_MiscVarType ======= TYPE, PUBLIC :: IceFloe_MiscVarType - INTEGER(IntKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] + INTEGER(IntKi) :: DummyMiscVar = 0_IntKi !< Remove this variable if you have misc/optimization variables [-] END TYPE IceFloe_MiscVarType ! ======================= ! ========= IceFloe_ParameterType ======= TYPE, PUBLIC :: IceFloe_ParameterType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: loadSeries !< - [precalculated time series of ice loads for each leg] - REAL(ReKi) :: iceVel !< ice floe velocity [m/s] - REAL(ReKi) :: iceDirection !< ice floe direction [degrees] - REAL(ReKi) :: minStrength !< minimum dynamic ice strength [Pa] - REAL(ReKi) :: minStrengthNegVel !< minimum dynamic ice strength for negative velocity [Pa] - REAL(ReKi) :: defaultArea !< structure width to use in cpld crushin [m] - REAL(ReKi) :: crushArea !< cross sectional area of ice against tower [m^2] - REAL(ReKi) :: coeffStressRate !< coefficient to calc stress rate from relative vellocity [Pa/m] - REAL(ReKi) :: C(4) !< coefficient of cubic transition curve for negative stress rates [-] - REAL(ReKi) :: dt !< time step [sec] - REAL(ReKi) :: rampTime !< load ramp up time [sec] + REAL(ReKi) :: iceVel = 0.0_ReKi !< ice floe velocity [m/s] + REAL(ReKi) :: iceDirection = 0.0_ReKi !< ice floe direction [degrees] + REAL(ReKi) :: minStrength = 0.0_ReKi !< minimum dynamic ice strength [Pa] + REAL(ReKi) :: minStrengthNegVel = 0.0_ReKi !< minimum dynamic ice strength for negative velocity [Pa] + REAL(ReKi) :: defaultArea = 0.0_ReKi !< structure width to use in cpld crushin [m] + REAL(ReKi) :: crushArea = 0.0_ReKi !< cross sectional area of ice against tower [m^2] + REAL(ReKi) :: coeffStressRate = 0.0_ReKi !< coefficient to calc stress rate from relative vellocity [Pa/m] + REAL(ReKi) :: C(4) = 0.0_ReKi !< coefficient of cubic transition curve for negative stress rates [-] + REAL(ReKi) :: dt = 0.0_ReKi !< time step [sec] + REAL(ReKi) :: rampTime = 0.0_ReKi !< load ramp up time [sec] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: legX !< - [x position of each leg relative to structure center] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: legY !< - [y position of each leg relative to structure center] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ks !< - [shelter factor due to upstream leg] - INTEGER(IntKi) :: numLegs !< Number of tower legs (=1 for monopile) [-] - INTEGER(IntKi) :: iceType !< Type of ice Floe: flex, crush, etc. [-] - INTEGER(IntKi) :: logUnitNum !< Unit number for log file [-] - LOGICAL :: singleLoad !< Flag for load application at single point vs multiple legs [-] - LOGICAL :: initFlag !< Flag for successful initialization [-] + INTEGER(IntKi) :: numLegs = 0_IntKi !< Number of tower legs (=1 for monopile) [-] + INTEGER(IntKi) :: iceType = 0_IntKi !< Type of ice Floe: flex, crush, etc. [-] + INTEGER(IntKi) :: logUnitNum = 0_IntKi !< Unit number for log file [-] + LOGICAL :: singleLoad = .false. !< Flag for load application at single point vs multiple legs [-] + LOGICAL :: initFlag = .false. !< Flag for successful initialization [-] END TYPE IceFloe_ParameterType ! ======================= ! ========= IceFloe_InputType ======= @@ -109,2119 +109,794 @@ MODULE IceFloe_Types END TYPE IceFloe_OutputType ! ======================= CONTAINS - SUBROUTINE IceFloe_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(IceFloe_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%simLength = SrcInitInputData%simLength - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%gravity = SrcInitInputData%gravity - DstInitInputData%RootName = SrcInitInputData%RootName - END SUBROUTINE IceFloe_CopyInitInput - - SUBROUTINE IceFloe_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(IceFloe_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 = 'IceFloe_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceFloe_DestroyInitInput - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 - Re_BufSz = Re_BufSz + 1 ! simLength - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Re_BufSz = Re_BufSz + 1 ! gravity - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - 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 - ReKiBuf(Re_Xferred) = InData%simLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%gravity - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE IceFloe_PackInitInput - - SUBROUTINE IceFloe_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(IceFloe_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_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%simLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE IceFloe_UnPackInitInput - - SUBROUTINE IceFloe_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(IceFloe_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 = 'IceFloe_CopyInitOutput' -! +subroutine IceFloe_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_InitInputType), intent(in) :: SrcInitInputData + type(IceFloe_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyInitInput' 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 - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE IceFloe_CopyInitOutput - - SUBROUTINE IceFloe_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(IceFloe_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 = 'IceFloe_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE IceFloe_DestroyInitOutput - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - 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 - - 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 - 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 - - 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 IceFloe_PackInitOutput - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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) - END SUBROUTINE IceFloe_UnPackInitOutput - - SUBROUTINE IceFloe_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(IceFloe_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 = 'IceFloe_CopyContState' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%simLength = SrcInitInputData%simLength + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%gravity = SrcInitInputData%gravity + DstInitInputData%RootName = SrcInitInputData%RootName +end subroutine + +subroutine IceFloe_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(IceFloe_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContStateVar = SrcContStateData%DummyContStateVar - END SUBROUTINE IceFloe_CopyContState - - SUBROUTINE IceFloe_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(IceFloe_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 = 'IceFloe_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceFloe_DestroyContState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 ! DummyContStateVar - 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%DummyContStateVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_PackContState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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%DummyContStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_UnPackContState - - SUBROUTINE IceFloe_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(IceFloe_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 = 'IceFloe_CopyDiscState' -! + ErrMsg = '' +end subroutine + +subroutine IceFloe_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%simLength) + call RegPack(Buf, InData%MSL2SWL) + call RegPack(Buf, InData%gravity) + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%simLength) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_InitOutputType), intent(in) :: SrcInitOutputData + type(IceFloe_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscStateVar = SrcDiscStateData%DummyDiscStateVar - END SUBROUTINE IceFloe_CopyDiscState - - SUBROUTINE IceFloe_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(IceFloe_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 = 'IceFloe_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceFloe_DestroyDiscState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 ! DummyDiscStateVar - 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%DummyDiscStateVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_PackDiscState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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%DummyDiscStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_UnPackDiscState - - SUBROUTINE IceFloe_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(IceFloe_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 = 'IceFloe_CopyConstrState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine IceFloe_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(IceFloe_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrStateVar = SrcConstrStateData%DummyConstrStateVar - END SUBROUTINE IceFloe_CopyConstrState - - SUBROUTINE IceFloe_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(IceFloe_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 = 'IceFloe_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceFloe_DestroyConstrState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 ! DummyConstrStateVar - 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%DummyConstrStateVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_PackConstrState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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%DummyConstrStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_UnPackConstrState - - SUBROUTINE IceFloe_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(IceFloe_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 = 'IceFloe_CopyOtherState' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine IceFloe_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine + +subroutine IceFloe_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_ContinuousStateType), intent(in) :: SrcContStateData + type(IceFloe_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE IceFloe_CopyOtherState - - SUBROUTINE IceFloe_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(IceFloe_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 = 'IceFloe_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceFloe_DestroyOtherState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 IceFloe_PackOtherState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 IceFloe_UnPackOtherState - - SUBROUTINE IceFloe_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(IceFloe_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 = 'IceFloe_CopyMisc' -! + ErrMsg = '' + DstContStateData%DummyContStateVar = SrcContStateData%DummyContStateVar +end subroutine + +subroutine IceFloe_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(IceFloe_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE IceFloe_CopyMisc - - SUBROUTINE IceFloe_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(IceFloe_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 = 'IceFloe_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceFloe_DestroyMisc - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 IceFloe_PackMisc - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 IceFloe_UnPackMisc - - SUBROUTINE IceFloe_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_ParameterType), INTENT(IN) :: SrcParamData - TYPE(IceFloe_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 = 'IceFloe_CopyParam' -! + ErrMsg = '' +end subroutine + +subroutine IceFloe_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyContStateVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyContStateVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_DiscreteStateType), intent(in) :: SrcDiscStateData + type(IceFloe_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcParamData%loadSeries)) THEN - i1_l = LBOUND(SrcParamData%loadSeries,1) - i1_u = UBOUND(SrcParamData%loadSeries,1) - i2_l = LBOUND(SrcParamData%loadSeries,2) - i2_u = UBOUND(SrcParamData%loadSeries,2) - IF (.NOT. ALLOCATED(DstParamData%loadSeries)) THEN - ALLOCATE(DstParamData%loadSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%loadSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%loadSeries = SrcParamData%loadSeries -ENDIF - DstParamData%iceVel = SrcParamData%iceVel - DstParamData%iceDirection = SrcParamData%iceDirection - DstParamData%minStrength = SrcParamData%minStrength - DstParamData%minStrengthNegVel = SrcParamData%minStrengthNegVel - DstParamData%defaultArea = SrcParamData%defaultArea - DstParamData%crushArea = SrcParamData%crushArea - DstParamData%coeffStressRate = SrcParamData%coeffStressRate - DstParamData%C(4) = SrcParamData%C(4) - DstParamData%dt = SrcParamData%dt - DstParamData%rampTime = SrcParamData%rampTime -IF (ALLOCATED(SrcParamData%legX)) THEN - i1_l = LBOUND(SrcParamData%legX,1) - i1_u = UBOUND(SrcParamData%legX,1) - IF (.NOT. ALLOCATED(DstParamData%legX)) THEN - ALLOCATE(DstParamData%legX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%legX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%legX = SrcParamData%legX -ENDIF -IF (ALLOCATED(SrcParamData%legY)) THEN - i1_l = LBOUND(SrcParamData%legY,1) - i1_u = UBOUND(SrcParamData%legY,1) - IF (.NOT. ALLOCATED(DstParamData%legY)) THEN - ALLOCATE(DstParamData%legY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%legY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%legY = SrcParamData%legY -ENDIF -IF (ALLOCATED(SrcParamData%ks)) THEN - i1_l = LBOUND(SrcParamData%ks,1) - i1_u = UBOUND(SrcParamData%ks,1) - IF (.NOT. ALLOCATED(DstParamData%ks)) THEN - ALLOCATE(DstParamData%ks(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ks.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ks = SrcParamData%ks -ENDIF - DstParamData%numLegs = SrcParamData%numLegs - DstParamData%iceType = SrcParamData%iceType - DstParamData%logUnitNum = SrcParamData%logUnitNum - DstParamData%singleLoad = SrcParamData%singleLoad - DstParamData%initFlag = SrcParamData%initFlag - END SUBROUTINE IceFloe_CopyParam - - SUBROUTINE IceFloe_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(IceFloe_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 = 'IceFloe_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%loadSeries)) THEN - DEALLOCATE(ParamData%loadSeries) -ENDIF -IF (ALLOCATED(ParamData%legX)) THEN - DEALLOCATE(ParamData%legX) -ENDIF -IF (ALLOCATED(ParamData%legY)) THEN - DEALLOCATE(ParamData%legY) -ENDIF -IF (ALLOCATED(ParamData%ks)) THEN - DEALLOCATE(ParamData%ks) -ENDIF - END SUBROUTINE IceFloe_DestroyParam - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 - Int_BufSz = Int_BufSz + 1 ! loadSeries allocated yes/no - IF ( ALLOCATED(InData%loadSeries) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! loadSeries upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%loadSeries) ! loadSeries - END IF - Re_BufSz = Re_BufSz + 1 ! iceVel - Re_BufSz = Re_BufSz + 1 ! iceDirection - Re_BufSz = Re_BufSz + 1 ! minStrength - Re_BufSz = Re_BufSz + 1 ! minStrengthNegVel - Re_BufSz = Re_BufSz + 1 ! defaultArea - Re_BufSz = Re_BufSz + 1 ! crushArea - Re_BufSz = Re_BufSz + 1 ! coeffStressRate - Re_BufSz = Re_BufSz + 1 ! C(4) - Re_BufSz = Re_BufSz + 1 ! dt - Re_BufSz = Re_BufSz + 1 ! rampTime - Int_BufSz = Int_BufSz + 1 ! legX allocated yes/no - IF ( ALLOCATED(InData%legX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! legX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%legX) ! legX - END IF - Int_BufSz = Int_BufSz + 1 ! legY allocated yes/no - IF ( ALLOCATED(InData%legY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! legY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%legY) ! legY - END IF - Int_BufSz = Int_BufSz + 1 ! ks allocated yes/no - IF ( ALLOCATED(InData%ks) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ks upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ks) ! ks - END IF - Int_BufSz = Int_BufSz + 1 ! numLegs - Int_BufSz = Int_BufSz + 1 ! iceType - Int_BufSz = Int_BufSz + 1 ! logUnitNum - Int_BufSz = Int_BufSz + 1 ! singleLoad - Int_BufSz = Int_BufSz + 1 ! initFlag - 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%loadSeries) ) 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%loadSeries,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%loadSeries,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%loadSeries,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%loadSeries,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%loadSeries,2), UBOUND(InData%loadSeries,2) - DO i1 = LBOUND(InData%loadSeries,1), UBOUND(InData%loadSeries,1) - ReKiBuf(Re_Xferred) = InData%loadSeries(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%iceVel - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%iceDirection - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%minStrength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%minStrengthNegVel - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defaultArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%crushArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%coeffStressRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C(4) - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rampTime - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%legX) ) 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%legX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%legX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%legX,1), UBOUND(InData%legX,1) - ReKiBuf(Re_Xferred) = InData%legX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%legY) ) 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%legY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%legY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%legY,1), UBOUND(InData%legY,1) - ReKiBuf(Re_Xferred) = InData%legY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ks) ) 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%ks,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ks,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ks,1), UBOUND(InData%ks,1) - ReKiBuf(Re_Xferred) = InData%ks(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numLegs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iceType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%logUnitNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%singleLoad, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%initFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceFloe_PackParam - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! loadSeries 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%loadSeries)) DEALLOCATE(OutData%loadSeries) - ALLOCATE(OutData%loadSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%loadSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%loadSeries,2), UBOUND(OutData%loadSeries,2) - DO i1 = LBOUND(OutData%loadSeries,1), UBOUND(OutData%loadSeries,1) - OutData%loadSeries(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%iceVel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%iceDirection = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%minStrength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%minStrengthNegVel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defaultArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%crushArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%coeffStressRate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C(4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rampTime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! legX 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%legX)) DEALLOCATE(OutData%legX) - ALLOCATE(OutData%legX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%legX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%legX,1), UBOUND(OutData%legX,1) - OutData%legX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! legY 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%legY)) DEALLOCATE(OutData%legY) - ALLOCATE(OutData%legY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%legY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%legY,1), UBOUND(OutData%legY,1) - OutData%legY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ks 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%ks)) DEALLOCATE(OutData%ks) - ALLOCATE(OutData%ks(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ks.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ks,1), UBOUND(OutData%ks,1) - OutData%ks(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%numLegs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iceType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%logUnitNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%singleLoad = TRANSFER(IntKiBuf(Int_Xferred), OutData%singleLoad) - Int_Xferred = Int_Xferred + 1 - OutData%initFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%initFlag) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceFloe_UnPackParam - - SUBROUTINE IceFloe_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_InputType), INTENT(INOUT) :: SrcInputData - TYPE(IceFloe_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 = 'IceFloe_CopyInput' -! + ErrMsg = '' + DstDiscStateData%DummyDiscStateVar = SrcDiscStateData%DummyDiscStateVar +end subroutine + +subroutine IceFloe_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(IceFloe_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%iceMesh, DstInputData%iceMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE IceFloe_CopyInput - - SUBROUTINE IceFloe_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(IceFloe_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 = 'IceFloe_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( InputData%iceMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE IceFloe_DestroyInput - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! iceMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! iceMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! iceMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! iceMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! iceMesh - 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 - - CALL MeshPack( InData%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! iceMesh - 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 IceFloe_PackInput - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 - 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 MeshUnpack( OutData%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! iceMesh - 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 IceFloe_UnPackInput - - SUBROUTINE IceFloe_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(IceFloe_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 = 'IceFloe_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine IceFloe_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyDiscStateVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyDiscStateVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_ConstraintStateType), intent(in) :: SrcConstrStateData + type(IceFloe_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%iceMesh, DstOutputData%iceMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -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 IceFloe_CopyOutput - - SUBROUTINE IceFloe_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(IceFloe_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 = 'IceFloe_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%iceMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE IceFloe_DestroyOutput - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! iceMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! iceMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! iceMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! iceMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! iceMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 - - CALL MeshPack( InData%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! iceMesh - 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 - 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 IceFloe_PackOutput - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 - 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 MeshUnpack( OutData%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! iceMesh - 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) - 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 IceFloe_UnPackOutput - - - SUBROUTINE IceFloe_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(IceFloe_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(IceFloe_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 + ErrMsg = '' + DstConstrStateData%DummyConstrStateVar = SrcConstrStateData%DummyConstrStateVar +end subroutine + +subroutine IceFloe_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(IceFloe_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine IceFloe_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrStateVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrStateVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_OtherStateType), intent(in) :: SrcOtherStateData + type(IceFloe_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +subroutine IceFloe_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(IceFloe_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine IceFloe_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_MiscVarType), intent(in) :: SrcMiscData + type(IceFloe_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar +end subroutine + +subroutine IceFloe_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(IceFloe_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine IceFloe_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_ParameterType), intent(in) :: SrcParamData + type(IceFloe_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IceFloe_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcParamData%loadSeries)) then + LB(1:2) = lbound(SrcParamData%loadSeries) + UB(1:2) = ubound(SrcParamData%loadSeries) + if (.not. allocated(DstParamData%loadSeries)) then + allocate(DstParamData%loadSeries(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%loadSeries.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%loadSeries = SrcParamData%loadSeries + end if + DstParamData%iceVel = SrcParamData%iceVel + DstParamData%iceDirection = SrcParamData%iceDirection + DstParamData%minStrength = SrcParamData%minStrength + DstParamData%minStrengthNegVel = SrcParamData%minStrengthNegVel + DstParamData%defaultArea = SrcParamData%defaultArea + DstParamData%crushArea = SrcParamData%crushArea + DstParamData%coeffStressRate = SrcParamData%coeffStressRate + DstParamData%C(4) = SrcParamData%C(4) + DstParamData%dt = SrcParamData%dt + DstParamData%rampTime = SrcParamData%rampTime + if (allocated(SrcParamData%legX)) then + LB(1:1) = lbound(SrcParamData%legX) + UB(1:1) = ubound(SrcParamData%legX) + if (.not. allocated(DstParamData%legX)) then + allocate(DstParamData%legX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%legX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%legX = SrcParamData%legX + end if + if (allocated(SrcParamData%legY)) then + LB(1:1) = lbound(SrcParamData%legY) + UB(1:1) = ubound(SrcParamData%legY) + if (.not. allocated(DstParamData%legY)) then + allocate(DstParamData%legY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%legY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%legY = SrcParamData%legY + end if + if (allocated(SrcParamData%ks)) then + LB(1:1) = lbound(SrcParamData%ks) + UB(1:1) = ubound(SrcParamData%ks) + if (.not. allocated(DstParamData%ks)) then + allocate(DstParamData%ks(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ks.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ks = SrcParamData%ks + end if + DstParamData%numLegs = SrcParamData%numLegs + DstParamData%iceType = SrcParamData%iceType + DstParamData%logUnitNum = SrcParamData%logUnitNum + DstParamData%singleLoad = SrcParamData%singleLoad + DstParamData%initFlag = SrcParamData%initFlag +end subroutine + +subroutine IceFloe_DestroyParam(ParamData, ErrStat, ErrMsg) + type(IceFloe_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%loadSeries)) then + deallocate(ParamData%loadSeries) + end if + if (allocated(ParamData%legX)) then + deallocate(ParamData%legX) + end if + if (allocated(ParamData%legY)) then + deallocate(ParamData%legY) + end if + if (allocated(ParamData%ks)) then + deallocate(ParamData%ks) + end if +end subroutine + +subroutine IceFloe_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%loadSeries)) + if (allocated(InData%loadSeries)) then + call RegPackBounds(Buf, 2, lbound(InData%loadSeries), ubound(InData%loadSeries)) + call RegPack(Buf, InData%loadSeries) + end if + call RegPack(Buf, InData%iceVel) + call RegPack(Buf, InData%iceDirection) + call RegPack(Buf, InData%minStrength) + call RegPack(Buf, InData%minStrengthNegVel) + call RegPack(Buf, InData%defaultArea) + call RegPack(Buf, InData%crushArea) + call RegPack(Buf, InData%coeffStressRate) + call RegPack(Buf, InData%C(4)) + call RegPack(Buf, InData%dt) + call RegPack(Buf, InData%rampTime) + call RegPack(Buf, allocated(InData%legX)) + if (allocated(InData%legX)) then + call RegPackBounds(Buf, 1, lbound(InData%legX), ubound(InData%legX)) + call RegPack(Buf, InData%legX) + end if + call RegPack(Buf, allocated(InData%legY)) + if (allocated(InData%legY)) then + call RegPackBounds(Buf, 1, lbound(InData%legY), ubound(InData%legY)) + call RegPack(Buf, InData%legY) + end if + call RegPack(Buf, allocated(InData%ks)) + if (allocated(InData%ks)) then + call RegPackBounds(Buf, 1, lbound(InData%ks), ubound(InData%ks)) + call RegPack(Buf, InData%ks) + end if + call RegPack(Buf, InData%numLegs) + call RegPack(Buf, InData%iceType) + call RegPack(Buf, InData%logUnitNum) + call RegPack(Buf, InData%singleLoad) + call RegPack(Buf, InData%initFlag) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%loadSeries)) deallocate(OutData%loadSeries) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%loadSeries(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%loadSeries.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%loadSeries) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%iceVel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%iceDirection) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%minStrength) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%minStrengthNegVel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%defaultArea) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%crushArea) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%coeffStressRate) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C(4)) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rampTime) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%legX)) deallocate(OutData%legX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%legX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%legX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%legX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%legY)) deallocate(OutData%legY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%legY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%legY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%legY) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ks)) deallocate(OutData%ks) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ks(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ks.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ks) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%numLegs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%iceType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%logUnitNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%singleLoad) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%initFlag) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_InputType), intent(inout) :: SrcInputData + type(IceFloe_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%iceMesh, DstInputData%iceMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine IceFloe_DestroyInput(InputData, ErrStat, ErrMsg) + type(IceFloe_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%iceMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine IceFloe_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%iceMesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%iceMesh) ! iceMesh +end subroutine + +subroutine IceFloe_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_OutputType), intent(inout) :: SrcOutputData + type(IceFloe_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%iceMesh, DstOutputData%iceMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine IceFloe_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(IceFloe_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%iceMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine IceFloe_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%iceMesh) + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%iceMesh) ! iceMesh + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine IceFloe_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(IceFloe_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(IceFloe_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 = 'IceFloe_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 IceFloe_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL IceFloe_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 IceFloe_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 IceFloe_Input_ExtrapInterp - - - SUBROUTINE IceFloe_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call IceFloe_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call IceFloe_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call IceFloe_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE IceFloe_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. @@ -2233,41 +908,42 @@ SUBROUTINE IceFloe_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(IceFloe_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(IceFloe_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(IceFloe_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 + TYPE(IceFloe_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(IceFloe_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(IceFloe_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 = 'IceFloe_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(u1%iceMesh, u2%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE IceFloe_Input_ExtrapInterp1 - - - SUBROUTINE IceFloe_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%iceMesh, u2%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE IceFloe_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. @@ -2281,101 +957,102 @@ SUBROUTINE IceFloe_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(IceFloe_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(IceFloe_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(IceFloe_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(IceFloe_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 + TYPE(IceFloe_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(IceFloe_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(IceFloe_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(IceFloe_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 = 'IceFloe_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(u1%iceMesh, u2%iceMesh, u3%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE IceFloe_Input_ExtrapInterp2 - - - SUBROUTINE IceFloe_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(IceFloe_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(IceFloe_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%iceMesh, u2%iceMesh, u3%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine IceFloe_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(IceFloe_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(IceFloe_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 = 'IceFloe_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 IceFloe_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL IceFloe_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 IceFloe_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 IceFloe_Output_ExtrapInterp - - - SUBROUTINE IceFloe_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call IceFloe_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call IceFloe_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call IceFloe_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE IceFloe_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. @@ -2387,49 +1064,47 @@ SUBROUTINE IceFloe_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(IceFloe_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 + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(IceFloe_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 = 'IceFloe_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(y1%iceMesh, y2%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 IceFloe_Output_ExtrapInterp1 - - - SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%iceMesh, y2%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE IceFloe_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. @@ -2443,56 +1118,52 @@ SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat ! !.................................................................................................................................. - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(IceFloe_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 + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(IceFloe_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 = 'IceFloe_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(y1%iceMesh, y2%iceMesh, y3%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 IceFloe_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%iceMesh, y2%iceMesh, y3%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE IceFloe_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/IfW_FlowField.f90 b/modules/inflowwind/src/IfW_FlowField.f90 index e74b7a14f4..5a377cb28a 100644 --- a/modules/inflowwind/src/IfW_FlowField.f90 +++ b/modules/inflowwind/src/IfW_FlowField.f90 @@ -146,7 +146,6 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A end if ! Loop throuh points and calcualate velocity and acceleration - !$OMP PARALLEL DO SCHEDULE(RUNTIME) do i = 1, NumPoints if (Position(3, i) > 0.0_ReKi) then VelocityUVW(:, i) = UniformField_GetVel(FF%Uniform, UFopVel, Position(:, i)) @@ -160,7 +159,6 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A else ! Otherwise, only velocity requested ! Loop throuh points and calcualate velocity - !$OMP PARALLEL DO SCHEDULE(RUNTIME) do i = 1, NumPoints if (Position(3, i) > 0.0_ReKi) then VelocityUVW(:, i) = UniformField_GetVel(FF%Uniform, UFopVel, Position(:, i)) @@ -197,7 +195,6 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A AddMeanAfterInterp = FF%Grid3D%AddMeanAfterInterp ! Loop through points - !$OMP PARALLEL DO SCHEDULE(RUNTIME) do i = 1, NumPoints ! If height < zero, set velocity/acceleration to zero, continue @@ -257,7 +254,6 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A end if ! Loop through points - !$OMP PARALLEL DO SCHEDULE(RUNTIME) do i = 1, NumPoints ! If height greater than zero, calculate velocity, otherwise zero diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index f37bbc73cd..8f67708c28 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -41,9 +41,9 @@ MODULE IfW_FlowField_Types INTEGER(IntKi), PUBLIC, PARAMETER :: User_FieldType = 5 ! User FieldType configured by the user [-] ! ========= UniformFieldType ======= TYPE, PUBLIC :: UniformFieldType - REAL(ReKi) :: RefHeight !< reference height; used to center the wind [meters] - REAL(ReKi) :: RefLength !< reference length used to scale the linear shear [meters] - INTEGER(IntKi) :: DataSize !< size of data in HH file [-] + REAL(ReKi) :: RefHeight = 0.0_ReKi !< reference height; used to center the wind [meters] + REAL(ReKi) :: RefLength = 0.0_ReKi !< reference length used to scale the linear shear [meters] + INTEGER(IntKi) :: DataSize = 0_IntKi !< size of data in HH file [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Time !< HH time array [seconds] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: VelH !< HH horizontal wind speed [meters/sec] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: VelHDot !< Derivative of HH horizontal wind speed wrt time [meters/sec] @@ -65,31 +65,31 @@ MODULE IfW_FlowField_Types ! ======================= ! ========= UniformField_Interp ======= TYPE, PUBLIC :: UniformField_Interp - REAL(ReKi) :: VelH !< HH horizontal wind speed [meters/sec] - REAL(ReKi) :: VelHDot !< derivative of HH horizontal wind speed wrt Time [meters/sec] - REAL(ReKi) :: VelV !< HH vertical wind speed, including tower shadow [meters/sec] - REAL(ReKi) :: VelVDot !< derivative of HH vertical wind speed wrt Time [meters/sec] - REAL(ReKi) :: VelGust !< HH wind gust speed [-] - REAL(ReKi) :: VelGustDot !< derivative of HH wind gust speed wrt Time [-] - REAL(ReKi) :: AngleH !< HH wind direction angle [degrees] - REAL(ReKi) :: AngleHDot !< derivative of HH wind direction angle wrt Time [degrees] - REAL(ReKi) :: AngleV !< HH upflow angle [degrees] - REAL(ReKi) :: AngleVDot !< derivative of HH upflow angle wrt Time [degrees] - REAL(ReKi) :: ShrH !< HH horizontal linear shear [-] - REAL(ReKi) :: ShrHDot !< derivative of HH horizontal linear shear wrt Time [-] - REAL(ReKi) :: ShrV !< HH vertical shear exponent [-] - REAL(ReKi) :: ShrVDot !< derivative of HH vertical shear exponent wrt Time [-] - REAL(ReKi) :: LinShrV !< HH vertical linear shear [seconds] - REAL(ReKi) :: LinShrVDot !< derivative of HH vertical linear shear wrt Time [seconds] - REAL(ReKi) :: CosAngleH !< Horizontal angle components [-] - REAL(ReKi) :: SinAngleH !< Horizontal angle components [-] - REAL(ReKi) :: CosAngleV !< Vertical angle components [-] - REAL(ReKi) :: SinAngleV !< Vertical angle components [-] + REAL(ReKi) :: VelH = 0.0_ReKi !< HH horizontal wind speed [meters/sec] + REAL(ReKi) :: VelHDot = 0.0_ReKi !< derivative of HH horizontal wind speed wrt Time [meters/sec] + REAL(ReKi) :: VelV = 0.0_ReKi !< HH vertical wind speed, including tower shadow [meters/sec] + REAL(ReKi) :: VelVDot = 0.0_ReKi !< derivative of HH vertical wind speed wrt Time [meters/sec] + REAL(ReKi) :: VelGust = 0.0_ReKi !< HH wind gust speed [-] + REAL(ReKi) :: VelGustDot = 0.0_ReKi !< derivative of HH wind gust speed wrt Time [-] + REAL(ReKi) :: AngleH = 0.0_ReKi !< HH wind direction angle [degrees] + REAL(ReKi) :: AngleHDot = 0.0_ReKi !< derivative of HH wind direction angle wrt Time [degrees] + REAL(ReKi) :: AngleV = 0.0_ReKi !< HH upflow angle [degrees] + REAL(ReKi) :: AngleVDot = 0.0_ReKi !< derivative of HH upflow angle wrt Time [degrees] + REAL(ReKi) :: ShrH = 0.0_ReKi !< HH horizontal linear shear [-] + REAL(ReKi) :: ShrHDot = 0.0_ReKi !< derivative of HH horizontal linear shear wrt Time [-] + REAL(ReKi) :: ShrV = 0.0_ReKi !< HH vertical shear exponent [-] + REAL(ReKi) :: ShrVDot = 0.0_ReKi !< derivative of HH vertical shear exponent wrt Time [-] + REAL(ReKi) :: LinShrV = 0.0_ReKi !< HH vertical linear shear [seconds] + REAL(ReKi) :: LinShrVDot = 0.0_ReKi !< derivative of HH vertical linear shear wrt Time [seconds] + REAL(ReKi) :: CosAngleH = 0.0_ReKi !< Horizontal angle components [-] + REAL(ReKi) :: SinAngleH = 0.0_ReKi !< Horizontal angle components [-] + REAL(ReKi) :: CosAngleV = 0.0_ReKi !< Vertical angle components [-] + REAL(ReKi) :: SinAngleV = 0.0_ReKi !< Vertical angle components [-] END TYPE UniformField_Interp ! ======================= ! ========= Grid3DFieldType ======= TYPE, PUBLIC :: Grid3DFieldType - INTEGER(IntKi) :: WindFileFormat !< Binary file format description number [-] + INTEGER(IntKi) :: WindFileFormat = 0_IntKi !< Binary file format description number [-] INTEGER(IntKi) :: WindProfileType = -1 !< Wind profile type (0=constant;1=logarithmic;2=power law) [-] LOGICAL :: Periodic = .false. !< Flag to indicate if the wind file is periodic [-] LOGICAL :: InterpTower = .false. !< Flag to indicate if we should interpolate wind speeds below the tower [-] @@ -129,12 +129,12 @@ MODULE IfW_FlowField_Types ! ======================= ! ========= Grid4DFieldType ======= TYPE, PUBLIC :: Grid4DFieldType - INTEGER(IntKi) , DIMENSION(1:4) :: n !< number of evenly-spaced grid points in the x, y, z, and t directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta !< size between 2 consecutive grid points in each grid direction [m,m,m,s] - REAL(ReKi) , DIMENSION(1:3) :: pZero !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the x, y, z, and t directions [-] + REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [m,m,m,s] + REAL(ReKi) , DIMENSION(1:3) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: Vel => NULL() !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt] [-] - REAL(ReKi) :: TimeStart !< this is the time where the first time grid in m%V starts (i.e, the time associated with m%V(:,:,:,:,1)) [s] - REAL(ReKi) :: RefHeight !< reference height; used to center the wind [meters] + REAL(ReKi) :: TimeStart = 0.0_ReKi !< this is the time where the first time grid in m%V starts (i.e, the time associated with m%V(:,:,:,:,1)) [s] + REAL(ReKi) :: RefHeight = 0.0_ReKi !< reference height; used to center the wind [meters] END TYPE Grid4DFieldType ! ======================= ! ========= PointsFieldType ======= @@ -144,20 +144,20 @@ MODULE IfW_FlowField_Types ! ======================= ! ========= UserFieldType ======= TYPE, PUBLIC :: UserFieldType - REAL(ReKi) :: RefHeight !< reference height; used to center the wind [meters] + REAL(ReKi) :: RefHeight = 0.0_ReKi !< reference height; used to center the wind [meters] END TYPE UserFieldType ! ======================= ! ========= FlowFieldType ======= TYPE, PUBLIC :: FlowFieldType INTEGER(IntKi) :: FieldType = 0 !< Switch for flow field type {1=Uniform, 2=Grid, 3=User, 4=External} [-] - REAL(ReKi) , DIMENSION(1:3) :: RefPosition !< Reference position (point where box is rotated) [meters] - REAL(ReKi) :: PropagationDir !< Direction of wind propagation [radians] - REAL(ReKi) :: VFlowAngle !< Vertical (upflow) angle [radians] + REAL(ReKi) , DIMENSION(1:3) :: RefPosition = 0.0_ReKi !< Reference position (point where box is rotated) [meters] + REAL(ReKi) :: PropagationDir = 0.0_ReKi !< Direction of wind propagation [radians] + REAL(ReKi) :: VFlowAngle = 0.0_ReKi !< Vertical (upflow) angle [radians] LOGICAL :: VelInterpCubic = .false. !< Velocity interpolation order in time (1=linear; 3=cubic) [Used with WindType=2,3,4,5,7] [-] LOGICAL :: RotateWindBox = .false. !< flag indicating if the wind will be rotated [-] LOGICAL :: AccFieldValid = .false. !< flag indicating that acceleration field has been calculated [-] - REAL(ReKi) , DIMENSION(1:3,1:3) :: RotToWind !< Rotation matrix for rotating from the global XYZ coordinate system to the wind coordinate system (wind along X') [-] - REAL(ReKi) , DIMENSION(1:3,1:3) :: RotFromWind !< Rotation matrix for rotating from the wind coordinate system (wind along X') back to the global XYZ coordinate system. Equal to TRANSPOSE(RotToWind) [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: RotToWind = 0.0_ReKi !< Rotation matrix for rotating from the global XYZ coordinate system to the wind coordinate system (wind along X') [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: RotFromWind = 0.0_ReKi !< Rotation matrix for rotating from the wind coordinate system (wind along X') back to the global XYZ coordinate system. Equal to TRANSPOSE(RotToWind) [-] TYPE(UniformFieldType) :: Uniform !< Uniform Flow Data [-] TYPE(Grid3DFieldType) :: Grid3D !< Grid Field Wind Data [-] TYPE(Grid4DFieldType) :: Grid4D !< External Grid Flow Data [-] @@ -166,3256 +166,1434 @@ MODULE IfW_FlowField_Types END TYPE FlowFieldType ! ======================= CONTAINS - SUBROUTINE IfW_FlowField_CopyUniformFieldType( SrcUniformFieldTypeData, DstUniformFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UniformFieldType), INTENT(IN) :: SrcUniformFieldTypeData - TYPE(UniformFieldType), INTENT(INOUT) :: DstUniformFieldTypeData - 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 = 'IfW_FlowField_CopyUniformFieldType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstUniformFieldTypeData%RefHeight = SrcUniformFieldTypeData%RefHeight - DstUniformFieldTypeData%RefLength = SrcUniformFieldTypeData%RefLength - DstUniformFieldTypeData%DataSize = SrcUniformFieldTypeData%DataSize -IF (ALLOCATED(SrcUniformFieldTypeData%Time)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%Time,1) - i1_u = UBOUND(SrcUniformFieldTypeData%Time,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%Time)) THEN - ALLOCATE(DstUniformFieldTypeData%Time(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%Time.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%Time = SrcUniformFieldTypeData%Time -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelH)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelH,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelH,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelH)) THEN - ALLOCATE(DstUniformFieldTypeData%VelH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelH = SrcUniformFieldTypeData%VelH -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelHDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelHDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelHDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelHDot)) THEN - ALLOCATE(DstUniformFieldTypeData%VelHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelHDot = SrcUniformFieldTypeData%VelHDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelV)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelV,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelV,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelV)) THEN - ALLOCATE(DstUniformFieldTypeData%VelV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelV = SrcUniformFieldTypeData%VelV -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelVDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelVDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelVDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelVDot)) THEN - ALLOCATE(DstUniformFieldTypeData%VelVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelVDot = SrcUniformFieldTypeData%VelVDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelGust)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelGust,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelGust,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelGust)) THEN - ALLOCATE(DstUniformFieldTypeData%VelGust(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelGust.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelGust = SrcUniformFieldTypeData%VelGust -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelGustDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelGustDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelGustDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelGustDot)) THEN - ALLOCATE(DstUniformFieldTypeData%VelGustDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelGustDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelGustDot = SrcUniformFieldTypeData%VelGustDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%AngleH)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%AngleH,1) - i1_u = UBOUND(SrcUniformFieldTypeData%AngleH,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%AngleH)) THEN - ALLOCATE(DstUniformFieldTypeData%AngleH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%AngleH = SrcUniformFieldTypeData%AngleH -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%AngleHDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%AngleHDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%AngleHDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%AngleHDot)) THEN - ALLOCATE(DstUniformFieldTypeData%AngleHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%AngleHDot = SrcUniformFieldTypeData%AngleHDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%AngleV)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%AngleV,1) - i1_u = UBOUND(SrcUniformFieldTypeData%AngleV,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%AngleV)) THEN - ALLOCATE(DstUniformFieldTypeData%AngleV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%AngleV = SrcUniformFieldTypeData%AngleV -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%AngleVDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%AngleVDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%AngleVDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%AngleVDot)) THEN - ALLOCATE(DstUniformFieldTypeData%AngleVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%AngleVDot = SrcUniformFieldTypeData%AngleVDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%ShrH)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%ShrH,1) - i1_u = UBOUND(SrcUniformFieldTypeData%ShrH,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%ShrH)) THEN - ALLOCATE(DstUniformFieldTypeData%ShrH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%ShrH = SrcUniformFieldTypeData%ShrH -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%ShrHDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%ShrHDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%ShrHDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%ShrHDot)) THEN - ALLOCATE(DstUniformFieldTypeData%ShrHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%ShrHDot = SrcUniformFieldTypeData%ShrHDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%ShrV)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%ShrV,1) - i1_u = UBOUND(SrcUniformFieldTypeData%ShrV,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%ShrV)) THEN - ALLOCATE(DstUniformFieldTypeData%ShrV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%ShrV = SrcUniformFieldTypeData%ShrV -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%ShrVDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%ShrVDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%ShrVDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%ShrVDot)) THEN - ALLOCATE(DstUniformFieldTypeData%ShrVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%ShrVDot = SrcUniformFieldTypeData%ShrVDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%LinShrV)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%LinShrV,1) - i1_u = UBOUND(SrcUniformFieldTypeData%LinShrV,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%LinShrV)) THEN - ALLOCATE(DstUniformFieldTypeData%LinShrV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%LinShrV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%LinShrV = SrcUniformFieldTypeData%LinShrV -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%LinShrVDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%LinShrVDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%LinShrVDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%LinShrVDot)) THEN - ALLOCATE(DstUniformFieldTypeData%LinShrVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%LinShrVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%LinShrVDot = SrcUniformFieldTypeData%LinShrVDot -ENDIF - END SUBROUTINE IfW_FlowField_CopyUniformFieldType - - SUBROUTINE IfW_FlowField_DestroyUniformFieldType( UniformFieldTypeData, ErrStat, ErrMsg ) - TYPE(UniformFieldType), INTENT(INOUT) :: UniformFieldTypeData - 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 = 'IfW_FlowField_DestroyUniformFieldType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(UniformFieldTypeData%Time)) THEN - DEALLOCATE(UniformFieldTypeData%Time) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelH)) THEN - DEALLOCATE(UniformFieldTypeData%VelH) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelHDot)) THEN - DEALLOCATE(UniformFieldTypeData%VelHDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelV)) THEN - DEALLOCATE(UniformFieldTypeData%VelV) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelVDot)) THEN - DEALLOCATE(UniformFieldTypeData%VelVDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelGust)) THEN - DEALLOCATE(UniformFieldTypeData%VelGust) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelGustDot)) THEN - DEALLOCATE(UniformFieldTypeData%VelGustDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%AngleH)) THEN - DEALLOCATE(UniformFieldTypeData%AngleH) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%AngleHDot)) THEN - DEALLOCATE(UniformFieldTypeData%AngleHDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%AngleV)) THEN - DEALLOCATE(UniformFieldTypeData%AngleV) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%AngleVDot)) THEN - DEALLOCATE(UniformFieldTypeData%AngleVDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%ShrH)) THEN - DEALLOCATE(UniformFieldTypeData%ShrH) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%ShrHDot)) THEN - DEALLOCATE(UniformFieldTypeData%ShrHDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%ShrV)) THEN - DEALLOCATE(UniformFieldTypeData%ShrV) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%ShrVDot)) THEN - DEALLOCATE(UniformFieldTypeData%ShrVDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%LinShrV)) THEN - DEALLOCATE(UniformFieldTypeData%LinShrV) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%LinShrVDot)) THEN - DEALLOCATE(UniformFieldTypeData%LinShrVDot) -ENDIF - END SUBROUTINE IfW_FlowField_DestroyUniformFieldType - - SUBROUTINE IfW_FlowField_PackUniformFieldType( 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(UniformFieldType), 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 = 'IfW_FlowField_PackUniformFieldType' - ! 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 ! RefHeight - Re_BufSz = Re_BufSz + 1 ! RefLength - Int_BufSz = Int_BufSz + 1 ! DataSize - Int_BufSz = Int_BufSz + 1 ! Time allocated yes/no - IF ( ALLOCATED(InData%Time) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Time upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Time) ! Time - END IF - Int_BufSz = Int_BufSz + 1 ! VelH allocated yes/no - IF ( ALLOCATED(InData%VelH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelH) ! VelH - END IF - Int_BufSz = Int_BufSz + 1 ! VelHDot allocated yes/no - IF ( ALLOCATED(InData%VelHDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelHDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelHDot) ! VelHDot - END IF - Int_BufSz = Int_BufSz + 1 ! VelV allocated yes/no - IF ( ALLOCATED(InData%VelV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelV) ! VelV - END IF - Int_BufSz = Int_BufSz + 1 ! VelVDot allocated yes/no - IF ( ALLOCATED(InData%VelVDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelVDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelVDot) ! VelVDot - END IF - Int_BufSz = Int_BufSz + 1 ! VelGust allocated yes/no - IF ( ALLOCATED(InData%VelGust) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelGust upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelGust) ! VelGust - END IF - Int_BufSz = Int_BufSz + 1 ! VelGustDot allocated yes/no - IF ( ALLOCATED(InData%VelGustDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelGustDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelGustDot) ! VelGustDot - END IF - Int_BufSz = Int_BufSz + 1 ! AngleH allocated yes/no - IF ( ALLOCATED(InData%AngleH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AngleH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngleH) ! AngleH - END IF - Int_BufSz = Int_BufSz + 1 ! AngleHDot allocated yes/no - IF ( ALLOCATED(InData%AngleHDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AngleHDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngleHDot) ! AngleHDot - END IF - Int_BufSz = Int_BufSz + 1 ! AngleV allocated yes/no - IF ( ALLOCATED(InData%AngleV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AngleV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngleV) ! AngleV - END IF - Int_BufSz = Int_BufSz + 1 ! AngleVDot allocated yes/no - IF ( ALLOCATED(InData%AngleVDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AngleVDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngleVDot) ! AngleVDot - END IF - Int_BufSz = Int_BufSz + 1 ! ShrH allocated yes/no - IF ( ALLOCATED(InData%ShrH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ShrH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ShrH) ! ShrH - END IF - Int_BufSz = Int_BufSz + 1 ! ShrHDot allocated yes/no - IF ( ALLOCATED(InData%ShrHDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ShrHDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ShrHDot) ! ShrHDot - END IF - Int_BufSz = Int_BufSz + 1 ! ShrV allocated yes/no - IF ( ALLOCATED(InData%ShrV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ShrV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ShrV) ! ShrV - END IF - Int_BufSz = Int_BufSz + 1 ! ShrVDot allocated yes/no - IF ( ALLOCATED(InData%ShrVDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ShrVDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ShrVDot) ! ShrVDot - END IF - Int_BufSz = Int_BufSz + 1 ! LinShrV allocated yes/no - IF ( ALLOCATED(InData%LinShrV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinShrV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinShrV) ! LinShrV - END IF - Int_BufSz = Int_BufSz + 1 ! LinShrVDot allocated yes/no - IF ( ALLOCATED(InData%LinShrVDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinShrVDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinShrVDot) ! LinShrVDot - 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 - - ReKiBuf(Re_Xferred) = InData%RefHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DataSize - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Time) ) 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%Time,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Time,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Time,1), UBOUND(InData%Time,1) - ReKiBuf(Re_Xferred) = InData%Time(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelH) ) 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%VelH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelH,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelH,1), UBOUND(InData%VelH,1) - ReKiBuf(Re_Xferred) = InData%VelH(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelHDot) ) 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%VelHDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelHDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelHDot,1), UBOUND(InData%VelHDot,1) - ReKiBuf(Re_Xferred) = InData%VelHDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelV) ) 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%VelV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelV,1), UBOUND(InData%VelV,1) - ReKiBuf(Re_Xferred) = InData%VelV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelVDot) ) 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%VelVDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelVDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelVDot,1), UBOUND(InData%VelVDot,1) - ReKiBuf(Re_Xferred) = InData%VelVDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelGust) ) 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%VelGust,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelGust,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelGust,1), UBOUND(InData%VelGust,1) - ReKiBuf(Re_Xferred) = InData%VelGust(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelGustDot) ) 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%VelGustDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelGustDot,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%VelGustDot,1), UBOUND(InData%VelGustDot,1) - ReKiBuf(Re_Xferred) = InData%VelGustDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngleH) ) 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%AngleH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngleH,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AngleH,1), UBOUND(InData%AngleH,1) - ReKiBuf(Re_Xferred) = InData%AngleH(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngleHDot) ) 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%AngleHDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngleHDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AngleHDot,1), UBOUND(InData%AngleHDot,1) - ReKiBuf(Re_Xferred) = InData%AngleHDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngleV) ) 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%AngleV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngleV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AngleV,1), UBOUND(InData%AngleV,1) - ReKiBuf(Re_Xferred) = InData%AngleV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngleVDot) ) 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%AngleVDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngleVDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AngleVDot,1), UBOUND(InData%AngleVDot,1) - ReKiBuf(Re_Xferred) = InData%AngleVDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ShrH) ) 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%ShrH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShrH,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ShrH,1), UBOUND(InData%ShrH,1) - ReKiBuf(Re_Xferred) = InData%ShrH(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ShrHDot) ) 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%ShrHDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShrHDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ShrHDot,1), UBOUND(InData%ShrHDot,1) - ReKiBuf(Re_Xferred) = InData%ShrHDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ShrV) ) 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%ShrV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShrV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ShrV,1), UBOUND(InData%ShrV,1) - ReKiBuf(Re_Xferred) = InData%ShrV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ShrVDot) ) 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%ShrVDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShrVDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ShrVDot,1), UBOUND(InData%ShrVDot,1) - ReKiBuf(Re_Xferred) = InData%ShrVDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinShrV) ) 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%LinShrV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinShrV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinShrV,1), UBOUND(InData%LinShrV,1) - ReKiBuf(Re_Xferred) = InData%LinShrV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinShrVDot) ) 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%LinShrVDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinShrVDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinShrVDot,1), UBOUND(InData%LinShrVDot,1) - ReKiBuf(Re_Xferred) = InData%LinShrVDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE IfW_FlowField_PackUniformFieldType - - SUBROUTINE IfW_FlowField_UnPackUniformFieldType( 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(UniformFieldType), 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 = 'IfW_FlowField_UnPackUniformFieldType' - ! 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%RefHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DataSize = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Time 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%Time)) DEALLOCATE(OutData%Time) - ALLOCATE(OutData%Time(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Time.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Time,1), UBOUND(OutData%Time,1) - OutData%Time(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelH 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%VelH)) DEALLOCATE(OutData%VelH) - ALLOCATE(OutData%VelH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelH,1), UBOUND(OutData%VelH,1) - OutData%VelH(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelHDot 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%VelHDot)) DEALLOCATE(OutData%VelHDot) - ALLOCATE(OutData%VelHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelHDot,1), UBOUND(OutData%VelHDot,1) - OutData%VelHDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelV 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%VelV)) DEALLOCATE(OutData%VelV) - ALLOCATE(OutData%VelV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelV,1), UBOUND(OutData%VelV,1) - OutData%VelV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelVDot 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%VelVDot)) DEALLOCATE(OutData%VelVDot) - ALLOCATE(OutData%VelVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelVDot,1), UBOUND(OutData%VelVDot,1) - OutData%VelVDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelGust 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%VelGust)) DEALLOCATE(OutData%VelGust) - ALLOCATE(OutData%VelGust(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelGust.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelGust,1), UBOUND(OutData%VelGust,1) - OutData%VelGust(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelGustDot 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%VelGustDot)) DEALLOCATE(OutData%VelGustDot) - ALLOCATE(OutData%VelGustDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelGustDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelGustDot,1), UBOUND(OutData%VelGustDot,1) - OutData%VelGustDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngleH 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%AngleH)) DEALLOCATE(OutData%AngleH) - ALLOCATE(OutData%AngleH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AngleH,1), UBOUND(OutData%AngleH,1) - OutData%AngleH(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngleHDot 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%AngleHDot)) DEALLOCATE(OutData%AngleHDot) - ALLOCATE(OutData%AngleHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AngleHDot,1), UBOUND(OutData%AngleHDot,1) - OutData%AngleHDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngleV 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%AngleV)) DEALLOCATE(OutData%AngleV) - ALLOCATE(OutData%AngleV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AngleV,1), UBOUND(OutData%AngleV,1) - OutData%AngleV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngleVDot 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%AngleVDot)) DEALLOCATE(OutData%AngleVDot) - ALLOCATE(OutData%AngleVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AngleVDot,1), UBOUND(OutData%AngleVDot,1) - OutData%AngleVDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShrH 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%ShrH)) DEALLOCATE(OutData%ShrH) - ALLOCATE(OutData%ShrH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ShrH,1), UBOUND(OutData%ShrH,1) - OutData%ShrH(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShrHDot 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%ShrHDot)) DEALLOCATE(OutData%ShrHDot) - ALLOCATE(OutData%ShrHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ShrHDot,1), UBOUND(OutData%ShrHDot,1) - OutData%ShrHDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShrV 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%ShrV)) DEALLOCATE(OutData%ShrV) - ALLOCATE(OutData%ShrV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ShrV,1), UBOUND(OutData%ShrV,1) - OutData%ShrV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShrVDot 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%ShrVDot)) DEALLOCATE(OutData%ShrVDot) - ALLOCATE(OutData%ShrVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ShrVDot,1), UBOUND(OutData%ShrVDot,1) - OutData%ShrVDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinShrV 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%LinShrV)) DEALLOCATE(OutData%LinShrV) - ALLOCATE(OutData%LinShrV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinShrV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinShrV,1), UBOUND(OutData%LinShrV,1) - OutData%LinShrV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinShrVDot 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%LinShrVDot)) DEALLOCATE(OutData%LinShrVDot) - ALLOCATE(OutData%LinShrVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinShrVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinShrVDot,1), UBOUND(OutData%LinShrVDot,1) - OutData%LinShrVDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE IfW_FlowField_UnPackUniformFieldType - - SUBROUTINE IfW_FlowField_CopyUniformField_Interp( SrcUniformField_InterpData, DstUniformField_InterpData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UniformField_Interp), INTENT(IN) :: SrcUniformField_InterpData - TYPE(UniformField_Interp), INTENT(INOUT) :: DstUniformField_InterpData - 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 = 'IfW_FlowField_CopyUniformField_Interp' -! +subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUniformFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(UniformFieldType), intent(in) :: SrcUniformFieldTypeData + type(UniformFieldType), intent(inout) :: DstUniformFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyUniformFieldType' ErrStat = ErrID_None - ErrMsg = "" - DstUniformField_InterpData%VelH = SrcUniformField_InterpData%VelH - DstUniformField_InterpData%VelHDot = SrcUniformField_InterpData%VelHDot - DstUniformField_InterpData%VelV = SrcUniformField_InterpData%VelV - DstUniformField_InterpData%VelVDot = SrcUniformField_InterpData%VelVDot - DstUniformField_InterpData%VelGust = SrcUniformField_InterpData%VelGust - DstUniformField_InterpData%VelGustDot = SrcUniformField_InterpData%VelGustDot - DstUniformField_InterpData%AngleH = SrcUniformField_InterpData%AngleH - DstUniformField_InterpData%AngleHDot = SrcUniformField_InterpData%AngleHDot - DstUniformField_InterpData%AngleV = SrcUniformField_InterpData%AngleV - DstUniformField_InterpData%AngleVDot = SrcUniformField_InterpData%AngleVDot - DstUniformField_InterpData%ShrH = SrcUniformField_InterpData%ShrH - DstUniformField_InterpData%ShrHDot = SrcUniformField_InterpData%ShrHDot - DstUniformField_InterpData%ShrV = SrcUniformField_InterpData%ShrV - DstUniformField_InterpData%ShrVDot = SrcUniformField_InterpData%ShrVDot - DstUniformField_InterpData%LinShrV = SrcUniformField_InterpData%LinShrV - DstUniformField_InterpData%LinShrVDot = SrcUniformField_InterpData%LinShrVDot - DstUniformField_InterpData%CosAngleH = SrcUniformField_InterpData%CosAngleH - DstUniformField_InterpData%SinAngleH = SrcUniformField_InterpData%SinAngleH - DstUniformField_InterpData%CosAngleV = SrcUniformField_InterpData%CosAngleV - DstUniformField_InterpData%SinAngleV = SrcUniformField_InterpData%SinAngleV - END SUBROUTINE IfW_FlowField_CopyUniformField_Interp - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyUniformField_Interp' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IfW_FlowField_DestroyUniformField_Interp - - SUBROUTINE IfW_FlowField_PackUniformField_Interp( 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(UniformField_Interp), 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 = 'IfW_FlowField_PackUniformField_Interp' - ! 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 ! VelH - Re_BufSz = Re_BufSz + 1 ! VelHDot - Re_BufSz = Re_BufSz + 1 ! VelV - Re_BufSz = Re_BufSz + 1 ! VelVDot - Re_BufSz = Re_BufSz + 1 ! VelGust - Re_BufSz = Re_BufSz + 1 ! VelGustDot - Re_BufSz = Re_BufSz + 1 ! AngleH - Re_BufSz = Re_BufSz + 1 ! AngleHDot - Re_BufSz = Re_BufSz + 1 ! AngleV - Re_BufSz = Re_BufSz + 1 ! AngleVDot - Re_BufSz = Re_BufSz + 1 ! ShrH - Re_BufSz = Re_BufSz + 1 ! ShrHDot - Re_BufSz = Re_BufSz + 1 ! ShrV - Re_BufSz = Re_BufSz + 1 ! ShrVDot - Re_BufSz = Re_BufSz + 1 ! LinShrV - Re_BufSz = Re_BufSz + 1 ! LinShrVDot - Re_BufSz = Re_BufSz + 1 ! CosAngleH - Re_BufSz = Re_BufSz + 1 ! SinAngleH - Re_BufSz = Re_BufSz + 1 ! CosAngleV - Re_BufSz = Re_BufSz + 1 ! SinAngleV - 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%VelH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VelHDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VelV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VelVDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VelGust - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VelGustDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AngleH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AngleHDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AngleV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AngleVDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShrH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShrHDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShrV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShrVDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LinShrV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LinShrVDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CosAngleH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SinAngleH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CosAngleV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SinAngleV - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_PackUniformField_Interp - - SUBROUTINE IfW_FlowField_UnPackUniformField_Interp( 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(UniformField_Interp), 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 = 'IfW_FlowField_UnPackUniformField_Interp' - ! 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%VelH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelHDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelVDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelGust = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelGustDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AngleH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AngleHDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AngleV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AngleVDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShrH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShrHDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShrV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShrVDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LinShrV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LinShrVDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CosAngleH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SinAngleH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CosAngleV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SinAngleV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_UnPackUniformField_Interp - - SUBROUTINE IfW_FlowField_CopyGrid3DFieldType( SrcGrid3DFieldTypeData, DstGrid3DFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Grid3DFieldType), INTENT(IN) :: SrcGrid3DFieldTypeData - TYPE(Grid3DFieldType), INTENT(INOUT) :: DstGrid3DFieldTypeData - 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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_CopyGrid3DFieldType' -! + ErrMsg = '' + DstUniformFieldTypeData%RefHeight = SrcUniformFieldTypeData%RefHeight + DstUniformFieldTypeData%RefLength = SrcUniformFieldTypeData%RefLength + DstUniformFieldTypeData%DataSize = SrcUniformFieldTypeData%DataSize + if (allocated(SrcUniformFieldTypeData%Time)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%Time) + UB(1:1) = ubound(SrcUniformFieldTypeData%Time) + if (.not. allocated(DstUniformFieldTypeData%Time)) then + allocate(DstUniformFieldTypeData%Time(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%Time.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%Time = SrcUniformFieldTypeData%Time + end if + if (allocated(SrcUniformFieldTypeData%VelH)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelH) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelH) + if (.not. allocated(DstUniformFieldTypeData%VelH)) then + allocate(DstUniformFieldTypeData%VelH(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelH = SrcUniformFieldTypeData%VelH + end if + if (allocated(SrcUniformFieldTypeData%VelHDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelHDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelHDot) + if (.not. allocated(DstUniformFieldTypeData%VelHDot)) then + allocate(DstUniformFieldTypeData%VelHDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelHDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelHDot = SrcUniformFieldTypeData%VelHDot + end if + if (allocated(SrcUniformFieldTypeData%VelV)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelV) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelV) + if (.not. allocated(DstUniformFieldTypeData%VelV)) then + allocate(DstUniformFieldTypeData%VelV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelV = SrcUniformFieldTypeData%VelV + end if + if (allocated(SrcUniformFieldTypeData%VelVDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelVDot) + if (.not. allocated(DstUniformFieldTypeData%VelVDot)) then + allocate(DstUniformFieldTypeData%VelVDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelVDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelVDot = SrcUniformFieldTypeData%VelVDot + end if + if (allocated(SrcUniformFieldTypeData%VelGust)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelGust) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelGust) + if (.not. allocated(DstUniformFieldTypeData%VelGust)) then + allocate(DstUniformFieldTypeData%VelGust(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelGust.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelGust = SrcUniformFieldTypeData%VelGust + end if + if (allocated(SrcUniformFieldTypeData%VelGustDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelGustDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelGustDot) + if (.not. allocated(DstUniformFieldTypeData%VelGustDot)) then + allocate(DstUniformFieldTypeData%VelGustDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelGustDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelGustDot = SrcUniformFieldTypeData%VelGustDot + end if + if (allocated(SrcUniformFieldTypeData%AngleH)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleH) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleH) + if (.not. allocated(DstUniformFieldTypeData%AngleH)) then + allocate(DstUniformFieldTypeData%AngleH(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%AngleH = SrcUniformFieldTypeData%AngleH + end if + if (allocated(SrcUniformFieldTypeData%AngleHDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleHDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleHDot) + if (.not. allocated(DstUniformFieldTypeData%AngleHDot)) then + allocate(DstUniformFieldTypeData%AngleHDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleHDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%AngleHDot = SrcUniformFieldTypeData%AngleHDot + end if + if (allocated(SrcUniformFieldTypeData%AngleV)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleV) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleV) + if (.not. allocated(DstUniformFieldTypeData%AngleV)) then + allocate(DstUniformFieldTypeData%AngleV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%AngleV = SrcUniformFieldTypeData%AngleV + end if + if (allocated(SrcUniformFieldTypeData%AngleVDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleVDot) + if (.not. allocated(DstUniformFieldTypeData%AngleVDot)) then + allocate(DstUniformFieldTypeData%AngleVDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleVDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%AngleVDot = SrcUniformFieldTypeData%AngleVDot + end if + if (allocated(SrcUniformFieldTypeData%ShrH)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrH) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrH) + if (.not. allocated(DstUniformFieldTypeData%ShrH)) then + allocate(DstUniformFieldTypeData%ShrH(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%ShrH = SrcUniformFieldTypeData%ShrH + end if + if (allocated(SrcUniformFieldTypeData%ShrHDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrHDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrHDot) + if (.not. allocated(DstUniformFieldTypeData%ShrHDot)) then + allocate(DstUniformFieldTypeData%ShrHDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrHDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%ShrHDot = SrcUniformFieldTypeData%ShrHDot + end if + if (allocated(SrcUniformFieldTypeData%ShrV)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrV) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrV) + if (.not. allocated(DstUniformFieldTypeData%ShrV)) then + allocate(DstUniformFieldTypeData%ShrV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%ShrV = SrcUniformFieldTypeData%ShrV + end if + if (allocated(SrcUniformFieldTypeData%ShrVDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrVDot) + if (.not. allocated(DstUniformFieldTypeData%ShrVDot)) then + allocate(DstUniformFieldTypeData%ShrVDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrVDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%ShrVDot = SrcUniformFieldTypeData%ShrVDot + end if + if (allocated(SrcUniformFieldTypeData%LinShrV)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrV) + UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrV) + if (.not. allocated(DstUniformFieldTypeData%LinShrV)) then + allocate(DstUniformFieldTypeData%LinShrV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%LinShrV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%LinShrV = SrcUniformFieldTypeData%LinShrV + end if + if (allocated(SrcUniformFieldTypeData%LinShrVDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrVDot) + if (.not. allocated(DstUniformFieldTypeData%LinShrVDot)) then + allocate(DstUniformFieldTypeData%LinShrVDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%LinShrVDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%LinShrVDot = SrcUniformFieldTypeData%LinShrVDot + end if +end subroutine + +subroutine IfW_FlowField_DestroyUniformFieldType(UniformFieldTypeData, ErrStat, ErrMsg) + type(UniformFieldType), intent(inout) :: UniformFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyUniformFieldType' ErrStat = ErrID_None - ErrMsg = "" - DstGrid3DFieldTypeData%WindFileFormat = SrcGrid3DFieldTypeData%WindFileFormat - DstGrid3DFieldTypeData%WindProfileType = SrcGrid3DFieldTypeData%WindProfileType - DstGrid3DFieldTypeData%Periodic = SrcGrid3DFieldTypeData%Periodic - DstGrid3DFieldTypeData%InterpTower = SrcGrid3DFieldTypeData%InterpTower - DstGrid3DFieldTypeData%AddMeanAfterInterp = SrcGrid3DFieldTypeData%AddMeanAfterInterp - DstGrid3DFieldTypeData%RefHeight = SrcGrid3DFieldTypeData%RefHeight - DstGrid3DFieldTypeData%RefLength = SrcGrid3DFieldTypeData%RefLength -IF (ALLOCATED(SrcGrid3DFieldTypeData%Vel)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%Vel,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%Vel,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%Vel,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%Vel,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%Vel,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%Vel,3) - i4_l = LBOUND(SrcGrid3DFieldTypeData%Vel,4) - i4_u = UBOUND(SrcGrid3DFieldTypeData%Vel,4) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%Vel)) THEN - ALLOCATE(DstGrid3DFieldTypeData%Vel(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 DstGrid3DFieldTypeData%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%Vel = SrcGrid3DFieldTypeData%Vel -ENDIF -IF (ALLOCATED(SrcGrid3DFieldTypeData%Acc)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%Acc,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%Acc,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%Acc,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%Acc,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%Acc,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%Acc,3) - i4_l = LBOUND(SrcGrid3DFieldTypeData%Acc,4) - i4_u = UBOUND(SrcGrid3DFieldTypeData%Acc,4) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%Acc)) THEN - ALLOCATE(DstGrid3DFieldTypeData%Acc(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 DstGrid3DFieldTypeData%Acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%Acc = SrcGrid3DFieldTypeData%Acc -ENDIF -IF (ALLOCATED(SrcGrid3DFieldTypeData%VelTower)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%VelTower,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%VelTower,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%VelTower,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%VelTower,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%VelTower,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%VelTower,3) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%VelTower)) THEN - ALLOCATE(DstGrid3DFieldTypeData%VelTower(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%VelTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%VelTower = SrcGrid3DFieldTypeData%VelTower -ENDIF -IF (ALLOCATED(SrcGrid3DFieldTypeData%AccTower)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%AccTower,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%AccTower,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%AccTower,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%AccTower,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%AccTower,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%AccTower,3) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%AccTower)) THEN - ALLOCATE(DstGrid3DFieldTypeData%AccTower(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%AccTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%AccTower = SrcGrid3DFieldTypeData%AccTower -ENDIF -IF (ALLOCATED(SrcGrid3DFieldTypeData%VelAvg)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%VelAvg,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%VelAvg,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%VelAvg,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%VelAvg,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%VelAvg,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%VelAvg,3) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%VelAvg)) THEN - ALLOCATE(DstGrid3DFieldTypeData%VelAvg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%VelAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%VelAvg = SrcGrid3DFieldTypeData%VelAvg -ENDIF -IF (ALLOCATED(SrcGrid3DFieldTypeData%AccAvg)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%AccAvg,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%AccAvg,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%AccAvg,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%AccAvg,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%AccAvg,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%AccAvg,3) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%AccAvg)) THEN - ALLOCATE(DstGrid3DFieldTypeData%AccAvg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%AccAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%AccAvg = SrcGrid3DFieldTypeData%AccAvg -ENDIF - DstGrid3DFieldTypeData%DTime = SrcGrid3DFieldTypeData%DTime - DstGrid3DFieldTypeData%Rate = SrcGrid3DFieldTypeData%Rate - DstGrid3DFieldTypeData%YHWid = SrcGrid3DFieldTypeData%YHWid - DstGrid3DFieldTypeData%ZHWid = SrcGrid3DFieldTypeData%ZHWid - DstGrid3DFieldTypeData%GridBase = SrcGrid3DFieldTypeData%GridBase - DstGrid3DFieldTypeData%InitXPosition = SrcGrid3DFieldTypeData%InitXPosition - DstGrid3DFieldTypeData%InvDY = SrcGrid3DFieldTypeData%InvDY - DstGrid3DFieldTypeData%InvDZ = SrcGrid3DFieldTypeData%InvDZ - DstGrid3DFieldTypeData%MeanWS = SrcGrid3DFieldTypeData%MeanWS - DstGrid3DFieldTypeData%InvMWS = SrcGrid3DFieldTypeData%InvMWS - DstGrid3DFieldTypeData%TotalTime = SrcGrid3DFieldTypeData%TotalTime - DstGrid3DFieldTypeData%NComp = SrcGrid3DFieldTypeData%NComp - DstGrid3DFieldTypeData%NYGrids = SrcGrid3DFieldTypeData%NYGrids - DstGrid3DFieldTypeData%NZGrids = SrcGrid3DFieldTypeData%NZGrids - DstGrid3DFieldTypeData%NTGrids = SrcGrid3DFieldTypeData%NTGrids - DstGrid3DFieldTypeData%NSteps = SrcGrid3DFieldTypeData%NSteps - DstGrid3DFieldTypeData%PLExp = SrcGrid3DFieldTypeData%PLExp - DstGrid3DFieldTypeData%Z0 = SrcGrid3DFieldTypeData%Z0 - DstGrid3DFieldTypeData%VLinShr = SrcGrid3DFieldTypeData%VLinShr - DstGrid3DFieldTypeData%HLinShr = SrcGrid3DFieldTypeData%HLinShr - DstGrid3DFieldTypeData%BoxExceedAllowF = SrcGrid3DFieldTypeData%BoxExceedAllowF - DstGrid3DFieldTypeData%BoxExceedAllowIdx = SrcGrid3DFieldTypeData%BoxExceedAllowIdx - DstGrid3DFieldTypeData%BoxExceedWarned = SrcGrid3DFieldTypeData%BoxExceedWarned - END SUBROUTINE IfW_FlowField_CopyGrid3DFieldType - - SUBROUTINE IfW_FlowField_DestroyGrid3DFieldType( Grid3DFieldTypeData, ErrStat, ErrMsg ) - TYPE(Grid3DFieldType), INTENT(INOUT) :: Grid3DFieldTypeData - 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 = 'IfW_FlowField_DestroyGrid3DFieldType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Grid3DFieldTypeData%Vel)) THEN - DEALLOCATE(Grid3DFieldTypeData%Vel) -ENDIF -IF (ALLOCATED(Grid3DFieldTypeData%Acc)) THEN - DEALLOCATE(Grid3DFieldTypeData%Acc) -ENDIF -IF (ALLOCATED(Grid3DFieldTypeData%VelTower)) THEN - DEALLOCATE(Grid3DFieldTypeData%VelTower) -ENDIF -IF (ALLOCATED(Grid3DFieldTypeData%AccTower)) THEN - DEALLOCATE(Grid3DFieldTypeData%AccTower) -ENDIF -IF (ALLOCATED(Grid3DFieldTypeData%VelAvg)) THEN - DEALLOCATE(Grid3DFieldTypeData%VelAvg) -ENDIF -IF (ALLOCATED(Grid3DFieldTypeData%AccAvg)) THEN - DEALLOCATE(Grid3DFieldTypeData%AccAvg) -ENDIF - END SUBROUTINE IfW_FlowField_DestroyGrid3DFieldType - - SUBROUTINE IfW_FlowField_PackGrid3DFieldType( 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(Grid3DFieldType), 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 = 'IfW_FlowField_PackGrid3DFieldType' - ! 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 ! WindFileFormat - Int_BufSz = Int_BufSz + 1 ! WindProfileType - Int_BufSz = Int_BufSz + 1 ! Periodic - Int_BufSz = Int_BufSz + 1 ! InterpTower - Int_BufSz = Int_BufSz + 1 ! AddMeanAfterInterp - Re_BufSz = Re_BufSz + 1 ! RefHeight - Re_BufSz = Re_BufSz + 1 ! RefLength - Int_BufSz = Int_BufSz + 1 ! Vel allocated yes/no - IF ( ALLOCATED(InData%Vel) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vel) ! Vel - END IF - Int_BufSz = Int_BufSz + 1 ! Acc allocated yes/no - IF ( ALLOCATED(InData%Acc) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Acc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Acc) ! Acc - END IF - Int_BufSz = Int_BufSz + 1 ! VelTower allocated yes/no - IF ( ALLOCATED(InData%VelTower) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! VelTower upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelTower) ! VelTower - END IF - Int_BufSz = Int_BufSz + 1 ! AccTower allocated yes/no - IF ( ALLOCATED(InData%AccTower) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AccTower upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AccTower) ! AccTower - END IF - Int_BufSz = Int_BufSz + 1 ! VelAvg allocated yes/no - IF ( ALLOCATED(InData%VelAvg) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! VelAvg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelAvg) ! VelAvg - END IF - Int_BufSz = Int_BufSz + 1 ! AccAvg allocated yes/no - IF ( ALLOCATED(InData%AccAvg) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AccAvg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AccAvg) ! AccAvg - END IF - Re_BufSz = Re_BufSz + 1 ! DTime - Re_BufSz = Re_BufSz + 1 ! Rate - Re_BufSz = Re_BufSz + 1 ! YHWid - Re_BufSz = Re_BufSz + 1 ! ZHWid - Re_BufSz = Re_BufSz + 1 ! GridBase - Re_BufSz = Re_BufSz + 1 ! InitXPosition - Re_BufSz = Re_BufSz + 1 ! InvDY - Re_BufSz = Re_BufSz + 1 ! InvDZ - Re_BufSz = Re_BufSz + 1 ! MeanWS - Re_BufSz = Re_BufSz + 1 ! InvMWS - Re_BufSz = Re_BufSz + 1 ! TotalTime - Int_BufSz = Int_BufSz + 1 ! NComp - Int_BufSz = Int_BufSz + 1 ! NYGrids - Int_BufSz = Int_BufSz + 1 ! NZGrids - Int_BufSz = Int_BufSz + 1 ! NTGrids - Int_BufSz = Int_BufSz + 1 ! NSteps - Re_BufSz = Re_BufSz + 1 ! PLExp - Re_BufSz = Re_BufSz + 1 ! Z0 - Re_BufSz = Re_BufSz + 1 ! VLinShr - Re_BufSz = Re_BufSz + 1 ! HLinShr - Int_BufSz = Int_BufSz + 1 ! BoxExceedAllowF - Int_BufSz = Int_BufSz + 1 ! BoxExceedAllowIdx - Int_BufSz = Int_BufSz + 1 ! BoxExceedWarned - 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%WindFileFormat - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WindProfileType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Periodic, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%InterpTower, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%AddMeanAfterInterp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Vel) ) 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%Vel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vel,4), UBOUND(InData%Vel,4) - DO i3 = LBOUND(InData%Vel,3), UBOUND(InData%Vel,3) - DO i2 = LBOUND(InData%Vel,2), UBOUND(InData%Vel,2) - DO i1 = LBOUND(InData%Vel,1), UBOUND(InData%Vel,1) - ReKiBuf(Re_Xferred) = InData%Vel(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Acc) ) 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%Acc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Acc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Acc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Acc,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Acc,4), UBOUND(InData%Acc,4) - DO i3 = LBOUND(InData%Acc,3), UBOUND(InData%Acc,3) - DO i2 = LBOUND(InData%Acc,2), UBOUND(InData%Acc,2) - DO i1 = LBOUND(InData%Acc,1), UBOUND(InData%Acc,1) - ReKiBuf(Re_Xferred) = InData%Acc(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelTower) ) 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%VelTower,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelTower,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelTower,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelTower,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelTower,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelTower,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%VelTower,3), UBOUND(InData%VelTower,3) - DO i2 = LBOUND(InData%VelTower,2), UBOUND(InData%VelTower,2) - DO i1 = LBOUND(InData%VelTower,1), UBOUND(InData%VelTower,1) - ReKiBuf(Re_Xferred) = InData%VelTower(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AccTower) ) 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%AccTower,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccTower,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccTower,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccTower,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccTower,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccTower,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AccTower,3), UBOUND(InData%AccTower,3) - DO i2 = LBOUND(InData%AccTower,2), UBOUND(InData%AccTower,2) - DO i1 = LBOUND(InData%AccTower,1), UBOUND(InData%AccTower,1) - ReKiBuf(Re_Xferred) = InData%AccTower(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelAvg) ) 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%VelAvg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelAvg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelAvg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelAvg,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelAvg,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelAvg,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%VelAvg,3), UBOUND(InData%VelAvg,3) - DO i2 = LBOUND(InData%VelAvg,2), UBOUND(InData%VelAvg,2) - DO i1 = LBOUND(InData%VelAvg,1), UBOUND(InData%VelAvg,1) - ReKiBuf(Re_Xferred) = InData%VelAvg(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AccAvg) ) 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%AccAvg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccAvg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccAvg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccAvg,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccAvg,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccAvg,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AccAvg,3), UBOUND(InData%AccAvg,3) - DO i2 = LBOUND(InData%AccAvg,2), UBOUND(InData%AccAvg,2) - DO i1 = LBOUND(InData%AccAvg,1), UBOUND(InData%AccAvg,1) - ReKiBuf(Re_Xferred) = InData%AccAvg(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%DTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Rate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ZHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GridBase - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InitXPosition - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InvDY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InvDZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MeanWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InvMWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TotalTime - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NComp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NYGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NZGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NTGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NSteps - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VLinShr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HLinShr - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%BoxExceedAllowF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BoxExceedAllowIdx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%BoxExceedWarned, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IfW_FlowField_PackGrid3DFieldType - - SUBROUTINE IfW_FlowField_UnPackGrid3DFieldType( 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(Grid3DFieldType), 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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_UnPackGrid3DFieldType' - ! 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%WindFileFormat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WindProfileType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Periodic = TRANSFER(IntKiBuf(Int_Xferred), OutData%Periodic) - Int_Xferred = Int_Xferred + 1 - OutData%InterpTower = TRANSFER(IntKiBuf(Int_Xferred), OutData%InterpTower) - Int_Xferred = Int_Xferred + 1 - OutData%AddMeanAfterInterp = TRANSFER(IntKiBuf(Int_Xferred), OutData%AddMeanAfterInterp) - Int_Xferred = Int_Xferred + 1 - OutData%RefHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vel 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%Vel)) DEALLOCATE(OutData%Vel) - ALLOCATE(OutData%Vel(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%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vel,4), UBOUND(OutData%Vel,4) - DO i3 = LBOUND(OutData%Vel,3), UBOUND(OutData%Vel,3) - DO i2 = LBOUND(OutData%Vel,2), UBOUND(OutData%Vel,2) - DO i1 = LBOUND(OutData%Vel,1), UBOUND(OutData%Vel,1) - OutData%Vel(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 ! Acc 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%Acc)) DEALLOCATE(OutData%Acc) - ALLOCATE(OutData%Acc(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%Acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Acc,4), UBOUND(OutData%Acc,4) - DO i3 = LBOUND(OutData%Acc,3), UBOUND(OutData%Acc,3) - DO i2 = LBOUND(OutData%Acc,2), UBOUND(OutData%Acc,2) - DO i1 = LBOUND(OutData%Acc,1), UBOUND(OutData%Acc,1) - OutData%Acc(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 ! VelTower 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%VelTower)) DEALLOCATE(OutData%VelTower) - ALLOCATE(OutData%VelTower(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%VelTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%VelTower,3), UBOUND(OutData%VelTower,3) - DO i2 = LBOUND(OutData%VelTower,2), UBOUND(OutData%VelTower,2) - DO i1 = LBOUND(OutData%VelTower,1), UBOUND(OutData%VelTower,1) - OutData%VelTower(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 ! AccTower 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%AccTower)) DEALLOCATE(OutData%AccTower) - ALLOCATE(OutData%AccTower(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%AccTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AccTower,3), UBOUND(OutData%AccTower,3) - DO i2 = LBOUND(OutData%AccTower,2), UBOUND(OutData%AccTower,2) - DO i1 = LBOUND(OutData%AccTower,1), UBOUND(OutData%AccTower,1) - OutData%AccTower(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 ! VelAvg 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%VelAvg)) DEALLOCATE(OutData%VelAvg) - ALLOCATE(OutData%VelAvg(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%VelAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%VelAvg,3), UBOUND(OutData%VelAvg,3) - DO i2 = LBOUND(OutData%VelAvg,2), UBOUND(OutData%VelAvg,2) - DO i1 = LBOUND(OutData%VelAvg,1), UBOUND(OutData%VelAvg,1) - OutData%VelAvg(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 ! AccAvg 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%AccAvg)) DEALLOCATE(OutData%AccAvg) - ALLOCATE(OutData%AccAvg(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%AccAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AccAvg,3), UBOUND(OutData%AccAvg,3) - DO i2 = LBOUND(OutData%AccAvg,2), UBOUND(OutData%AccAvg,2) - DO i1 = LBOUND(OutData%AccAvg,1), UBOUND(OutData%AccAvg,1) - OutData%AccAvg(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%DTime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Rate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YHWid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ZHWid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GridBase = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InitXPosition = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InvDY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InvDZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MeanWS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InvMWS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TotalTime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NComp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NYGrids = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NZGrids = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NTGrids = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VLinShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HLinShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BoxExceedAllowF = TRANSFER(IntKiBuf(Int_Xferred), OutData%BoxExceedAllowF) - Int_Xferred = Int_Xferred + 1 - OutData%BoxExceedAllowIdx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BoxExceedWarned = TRANSFER(IntKiBuf(Int_Xferred), OutData%BoxExceedWarned) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IfW_FlowField_UnPackGrid3DFieldType - - SUBROUTINE IfW_FlowField_CopyGrid4DFieldType( SrcGrid4DFieldTypeData, DstGrid4DFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Grid4DFieldType), INTENT(IN) :: SrcGrid4DFieldTypeData - TYPE(Grid4DFieldType), INTENT(INOUT) :: DstGrid4DFieldTypeData - 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 = 'IfW_FlowField_CopyGrid4DFieldType' -! + ErrMsg = '' + if (allocated(UniformFieldTypeData%Time)) then + deallocate(UniformFieldTypeData%Time) + end if + if (allocated(UniformFieldTypeData%VelH)) then + deallocate(UniformFieldTypeData%VelH) + end if + if (allocated(UniformFieldTypeData%VelHDot)) then + deallocate(UniformFieldTypeData%VelHDot) + end if + if (allocated(UniformFieldTypeData%VelV)) then + deallocate(UniformFieldTypeData%VelV) + end if + if (allocated(UniformFieldTypeData%VelVDot)) then + deallocate(UniformFieldTypeData%VelVDot) + end if + if (allocated(UniformFieldTypeData%VelGust)) then + deallocate(UniformFieldTypeData%VelGust) + end if + if (allocated(UniformFieldTypeData%VelGustDot)) then + deallocate(UniformFieldTypeData%VelGustDot) + end if + if (allocated(UniformFieldTypeData%AngleH)) then + deallocate(UniformFieldTypeData%AngleH) + end if + if (allocated(UniformFieldTypeData%AngleHDot)) then + deallocate(UniformFieldTypeData%AngleHDot) + end if + if (allocated(UniformFieldTypeData%AngleV)) then + deallocate(UniformFieldTypeData%AngleV) + end if + if (allocated(UniformFieldTypeData%AngleVDot)) then + deallocate(UniformFieldTypeData%AngleVDot) + end if + if (allocated(UniformFieldTypeData%ShrH)) then + deallocate(UniformFieldTypeData%ShrH) + end if + if (allocated(UniformFieldTypeData%ShrHDot)) then + deallocate(UniformFieldTypeData%ShrHDot) + end if + if (allocated(UniformFieldTypeData%ShrV)) then + deallocate(UniformFieldTypeData%ShrV) + end if + if (allocated(UniformFieldTypeData%ShrVDot)) then + deallocate(UniformFieldTypeData%ShrVDot) + end if + if (allocated(UniformFieldTypeData%LinShrV)) then + deallocate(UniformFieldTypeData%LinShrV) + end if + if (allocated(UniformFieldTypeData%LinShrVDot)) then + deallocate(UniformFieldTypeData%LinShrVDot) + end if +end subroutine + +subroutine IfW_FlowField_PackUniformFieldType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UniformFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackUniformFieldType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%RefHeight) + call RegPack(Buf, InData%RefLength) + call RegPack(Buf, InData%DataSize) + call RegPack(Buf, allocated(InData%Time)) + if (allocated(InData%Time)) then + call RegPackBounds(Buf, 1, lbound(InData%Time), ubound(InData%Time)) + call RegPack(Buf, InData%Time) + end if + call RegPack(Buf, allocated(InData%VelH)) + if (allocated(InData%VelH)) then + call RegPackBounds(Buf, 1, lbound(InData%VelH), ubound(InData%VelH)) + call RegPack(Buf, InData%VelH) + end if + call RegPack(Buf, allocated(InData%VelHDot)) + if (allocated(InData%VelHDot)) then + call RegPackBounds(Buf, 1, lbound(InData%VelHDot), ubound(InData%VelHDot)) + call RegPack(Buf, InData%VelHDot) + end if + call RegPack(Buf, allocated(InData%VelV)) + if (allocated(InData%VelV)) then + call RegPackBounds(Buf, 1, lbound(InData%VelV), ubound(InData%VelV)) + call RegPack(Buf, InData%VelV) + end if + call RegPack(Buf, allocated(InData%VelVDot)) + if (allocated(InData%VelVDot)) then + call RegPackBounds(Buf, 1, lbound(InData%VelVDot), ubound(InData%VelVDot)) + call RegPack(Buf, InData%VelVDot) + end if + call RegPack(Buf, allocated(InData%VelGust)) + if (allocated(InData%VelGust)) then + call RegPackBounds(Buf, 1, lbound(InData%VelGust), ubound(InData%VelGust)) + call RegPack(Buf, InData%VelGust) + end if + call RegPack(Buf, allocated(InData%VelGustDot)) + if (allocated(InData%VelGustDot)) then + call RegPackBounds(Buf, 1, lbound(InData%VelGustDot), ubound(InData%VelGustDot)) + call RegPack(Buf, InData%VelGustDot) + end if + call RegPack(Buf, allocated(InData%AngleH)) + if (allocated(InData%AngleH)) then + call RegPackBounds(Buf, 1, lbound(InData%AngleH), ubound(InData%AngleH)) + call RegPack(Buf, InData%AngleH) + end if + call RegPack(Buf, allocated(InData%AngleHDot)) + if (allocated(InData%AngleHDot)) then + call RegPackBounds(Buf, 1, lbound(InData%AngleHDot), ubound(InData%AngleHDot)) + call RegPack(Buf, InData%AngleHDot) + end if + call RegPack(Buf, allocated(InData%AngleV)) + if (allocated(InData%AngleV)) then + call RegPackBounds(Buf, 1, lbound(InData%AngleV), ubound(InData%AngleV)) + call RegPack(Buf, InData%AngleV) + end if + call RegPack(Buf, allocated(InData%AngleVDot)) + if (allocated(InData%AngleVDot)) then + call RegPackBounds(Buf, 1, lbound(InData%AngleVDot), ubound(InData%AngleVDot)) + call RegPack(Buf, InData%AngleVDot) + end if + call RegPack(Buf, allocated(InData%ShrH)) + if (allocated(InData%ShrH)) then + call RegPackBounds(Buf, 1, lbound(InData%ShrH), ubound(InData%ShrH)) + call RegPack(Buf, InData%ShrH) + end if + call RegPack(Buf, allocated(InData%ShrHDot)) + if (allocated(InData%ShrHDot)) then + call RegPackBounds(Buf, 1, lbound(InData%ShrHDot), ubound(InData%ShrHDot)) + call RegPack(Buf, InData%ShrHDot) + end if + call RegPack(Buf, allocated(InData%ShrV)) + if (allocated(InData%ShrV)) then + call RegPackBounds(Buf, 1, lbound(InData%ShrV), ubound(InData%ShrV)) + call RegPack(Buf, InData%ShrV) + end if + call RegPack(Buf, allocated(InData%ShrVDot)) + if (allocated(InData%ShrVDot)) then + call RegPackBounds(Buf, 1, lbound(InData%ShrVDot), ubound(InData%ShrVDot)) + call RegPack(Buf, InData%ShrVDot) + end if + call RegPack(Buf, allocated(InData%LinShrV)) + if (allocated(InData%LinShrV)) then + call RegPackBounds(Buf, 1, lbound(InData%LinShrV), ubound(InData%LinShrV)) + call RegPack(Buf, InData%LinShrV) + end if + call RegPack(Buf, allocated(InData%LinShrVDot)) + if (allocated(InData%LinShrVDot)) then + call RegPackBounds(Buf, 1, lbound(InData%LinShrVDot), ubound(InData%LinShrVDot)) + call RegPack(Buf, InData%LinShrVDot) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UniformFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUniformFieldType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%RefHeight) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DataSize) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Time)) deallocate(OutData%Time) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Time(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Time.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Time) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%VelH)) deallocate(OutData%VelH) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelH(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelH) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%VelHDot)) deallocate(OutData%VelHDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelHDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelHDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelHDot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%VelV)) deallocate(OutData%VelV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelV(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelV) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%VelVDot)) deallocate(OutData%VelVDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelVDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelVDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelVDot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%VelGust)) deallocate(OutData%VelGust) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelGust(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelGust.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelGust) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%VelGustDot)) deallocate(OutData%VelGustDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelGustDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelGustDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelGustDot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AngleH)) deallocate(OutData%AngleH) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngleH(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngleH) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AngleHDot)) deallocate(OutData%AngleHDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngleHDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleHDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngleHDot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AngleV)) deallocate(OutData%AngleV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngleV(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngleV) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AngleVDot)) deallocate(OutData%AngleVDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngleVDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleVDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngleVDot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ShrH)) deallocate(OutData%ShrH) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ShrH(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ShrH) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ShrHDot)) deallocate(OutData%ShrHDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ShrHDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrHDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ShrHDot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ShrV)) deallocate(OutData%ShrV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ShrV(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ShrV) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ShrVDot)) deallocate(OutData%ShrVDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ShrVDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrVDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ShrVDot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinShrV)) deallocate(OutData%LinShrV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinShrV(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinShrV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinShrV) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinShrVDot)) deallocate(OutData%LinShrVDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinShrVDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinShrVDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinShrVDot) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine IfW_FlowField_CopyUniformField_Interp(SrcUniformField_InterpData, DstUniformField_InterpData, CtrlCode, ErrStat, ErrMsg) + type(UniformField_Interp), intent(in) :: SrcUniformField_InterpData + type(UniformField_Interp), intent(inout) :: DstUniformField_InterpData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyUniformField_Interp' ErrStat = ErrID_None - ErrMsg = "" - DstGrid4DFieldTypeData%n = SrcGrid4DFieldTypeData%n - DstGrid4DFieldTypeData%delta = SrcGrid4DFieldTypeData%delta - DstGrid4DFieldTypeData%pZero = SrcGrid4DFieldTypeData%pZero - DstGrid4DFieldTypeData%Vel => SrcGrid4DFieldTypeData%Vel - DstGrid4DFieldTypeData%TimeStart = SrcGrid4DFieldTypeData%TimeStart - DstGrid4DFieldTypeData%RefHeight = SrcGrid4DFieldTypeData%RefHeight - END SUBROUTINE IfW_FlowField_CopyGrid4DFieldType - - SUBROUTINE IfW_FlowField_DestroyGrid4DFieldType( Grid4DFieldTypeData, ErrStat, ErrMsg ) - TYPE(Grid4DFieldType), INTENT(INOUT) :: Grid4DFieldTypeData - 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 = 'IfW_FlowField_DestroyGrid4DFieldType' - - ErrStat = ErrID_None - ErrMsg = "" - -NULLIFY(Grid4DFieldTypeData%Vel) - END SUBROUTINE IfW_FlowField_DestroyGrid4DFieldType - - SUBROUTINE IfW_FlowField_PackGrid4DFieldType( 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(Grid4DFieldType), 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 = 'IfW_FlowField_PackGrid4DFieldType' - ! 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 + SIZE(InData%n) ! n - Re_BufSz = Re_BufSz + SIZE(InData%delta) ! delta - Re_BufSz = Re_BufSz + SIZE(InData%pZero) ! pZero - Re_BufSz = Re_BufSz + 1 ! TimeStart - Re_BufSz = Re_BufSz + 1 ! RefHeight - 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 i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) - ReKiBuf(Re_Xferred) = InData%delta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) - ReKiBuf(Re_Xferred) = InData%pZero(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%TimeStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHeight - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_PackGrid4DFieldType - - SUBROUTINE IfW_FlowField_UnPackGrid4DFieldType( 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(Grid4DFieldType), 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 = 'IfW_FlowField_UnPackGrid4DFieldType' - ! 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 - i1_l = LBOUND(OutData%n,1) - i1_u = UBOUND(OutData%n,1) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%delta,1) - i1_u = UBOUND(OutData%delta,1) - DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) - OutData%delta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%pZero,1) - i1_u = UBOUND(OutData%pZero,1) - DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) - OutData%pZero(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - NULLIFY(OutData%Vel) - OutData%TimeStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_UnPackGrid4DFieldType - - SUBROUTINE IfW_FlowField_CopyPointsFieldType( SrcPointsFieldTypeData, DstPointsFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(PointsFieldType), INTENT(IN) :: SrcPointsFieldTypeData - TYPE(PointsFieldType), INTENT(INOUT) :: DstPointsFieldTypeData - 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 = 'IfW_FlowField_CopyPointsFieldType' -! + ErrMsg = '' + DstUniformField_InterpData%VelH = SrcUniformField_InterpData%VelH + DstUniformField_InterpData%VelHDot = SrcUniformField_InterpData%VelHDot + DstUniformField_InterpData%VelV = SrcUniformField_InterpData%VelV + DstUniformField_InterpData%VelVDot = SrcUniformField_InterpData%VelVDot + DstUniformField_InterpData%VelGust = SrcUniformField_InterpData%VelGust + DstUniformField_InterpData%VelGustDot = SrcUniformField_InterpData%VelGustDot + DstUniformField_InterpData%AngleH = SrcUniformField_InterpData%AngleH + DstUniformField_InterpData%AngleHDot = SrcUniformField_InterpData%AngleHDot + DstUniformField_InterpData%AngleV = SrcUniformField_InterpData%AngleV + DstUniformField_InterpData%AngleVDot = SrcUniformField_InterpData%AngleVDot + DstUniformField_InterpData%ShrH = SrcUniformField_InterpData%ShrH + DstUniformField_InterpData%ShrHDot = SrcUniformField_InterpData%ShrHDot + DstUniformField_InterpData%ShrV = SrcUniformField_InterpData%ShrV + DstUniformField_InterpData%ShrVDot = SrcUniformField_InterpData%ShrVDot + DstUniformField_InterpData%LinShrV = SrcUniformField_InterpData%LinShrV + DstUniformField_InterpData%LinShrVDot = SrcUniformField_InterpData%LinShrVDot + DstUniformField_InterpData%CosAngleH = SrcUniformField_InterpData%CosAngleH + DstUniformField_InterpData%SinAngleH = SrcUniformField_InterpData%SinAngleH + DstUniformField_InterpData%CosAngleV = SrcUniformField_InterpData%CosAngleV + DstUniformField_InterpData%SinAngleV = SrcUniformField_InterpData%SinAngleV +end subroutine + +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 + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyUniformField_Interp' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcPointsFieldTypeData%Vel)) THEN - i1_l = LBOUND(SrcPointsFieldTypeData%Vel,1) - i1_u = UBOUND(SrcPointsFieldTypeData%Vel,1) - i2_l = LBOUND(SrcPointsFieldTypeData%Vel,2) - i2_u = UBOUND(SrcPointsFieldTypeData%Vel,2) - IF (.NOT. ALLOCATED(DstPointsFieldTypeData%Vel)) THEN - ALLOCATE(DstPointsFieldTypeData%Vel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstPointsFieldTypeData%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstPointsFieldTypeData%Vel = SrcPointsFieldTypeData%Vel -ENDIF - END SUBROUTINE IfW_FlowField_CopyPointsFieldType - - SUBROUTINE IfW_FlowField_DestroyPointsFieldType( PointsFieldTypeData, ErrStat, ErrMsg ) - TYPE(PointsFieldType), INTENT(INOUT) :: PointsFieldTypeData - 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 = 'IfW_FlowField_DestroyPointsFieldType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(PointsFieldTypeData%Vel)) THEN - DEALLOCATE(PointsFieldTypeData%Vel) -ENDIF - END SUBROUTINE IfW_FlowField_DestroyPointsFieldType - - SUBROUTINE IfW_FlowField_PackPointsFieldType( 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(PointsFieldType), 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 = 'IfW_FlowField_PackPointsFieldType' - ! 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 ! Vel allocated yes/no - IF ( ALLOCATED(InData%Vel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vel) ! Vel - 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%Vel) ) 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%Vel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vel,2), UBOUND(InData%Vel,2) - DO i1 = LBOUND(InData%Vel,1), UBOUND(InData%Vel,1) - ReKiBuf(Re_Xferred) = InData%Vel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE IfW_FlowField_PackPointsFieldType - - SUBROUTINE IfW_FlowField_UnPackPointsFieldType( 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(PointsFieldType), 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 = 'IfW_FlowField_UnPackPointsFieldType' - ! 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 ! Vel 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%Vel)) DEALLOCATE(OutData%Vel) - ALLOCATE(OutData%Vel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vel,2), UBOUND(OutData%Vel,2) - DO i1 = LBOUND(OutData%Vel,1), UBOUND(OutData%Vel,1) - OutData%Vel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE IfW_FlowField_UnPackPointsFieldType - - SUBROUTINE IfW_FlowField_CopyUserFieldType( SrcUserFieldTypeData, DstUserFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UserFieldType), INTENT(IN) :: SrcUserFieldTypeData - TYPE(UserFieldType), INTENT(INOUT) :: DstUserFieldTypeData - 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 = 'IfW_FlowField_CopyUserFieldType' -! + ErrMsg = '' +end subroutine + +subroutine IfW_FlowField_PackUniformField_Interp(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UniformField_Interp), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackUniformField_Interp' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%VelH) + call RegPack(Buf, InData%VelHDot) + call RegPack(Buf, InData%VelV) + call RegPack(Buf, InData%VelVDot) + call RegPack(Buf, InData%VelGust) + call RegPack(Buf, InData%VelGustDot) + call RegPack(Buf, InData%AngleH) + call RegPack(Buf, InData%AngleHDot) + call RegPack(Buf, InData%AngleV) + call RegPack(Buf, InData%AngleVDot) + call RegPack(Buf, InData%ShrH) + call RegPack(Buf, InData%ShrHDot) + call RegPack(Buf, InData%ShrV) + call RegPack(Buf, InData%ShrVDot) + call RegPack(Buf, InData%LinShrV) + call RegPack(Buf, InData%LinShrVDot) + call RegPack(Buf, InData%CosAngleH) + call RegPack(Buf, InData%SinAngleH) + call RegPack(Buf, InData%CosAngleV) + call RegPack(Buf, InData%SinAngleV) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackUniformField_Interp(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UniformField_Interp), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUniformField_Interp' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%VelH) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VelHDot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VelV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VelVDot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VelGust) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VelGustDot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngleH) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngleHDot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngleV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AngleVDot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ShrH) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ShrHDot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ShrV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ShrVDot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinShrV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinShrVDot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CosAngleH) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SinAngleH) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CosAngleV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SinAngleV) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(Grid3DFieldType), intent(in) :: SrcGrid3DFieldTypeData + type(Grid3DFieldType), intent(inout) :: DstGrid3DFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyGrid3DFieldType' ErrStat = ErrID_None - ErrMsg = "" - DstUserFieldTypeData%RefHeight = SrcUserFieldTypeData%RefHeight - END SUBROUTINE IfW_FlowField_CopyUserFieldType - - SUBROUTINE IfW_FlowField_DestroyUserFieldType( UserFieldTypeData, ErrStat, ErrMsg ) - TYPE(UserFieldType), INTENT(INOUT) :: UserFieldTypeData - 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 = 'IfW_FlowField_DestroyUserFieldType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IfW_FlowField_DestroyUserFieldType - - SUBROUTINE IfW_FlowField_PackUserFieldType( 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(UserFieldType), 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 = 'IfW_FlowField_PackUserFieldType' - ! 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 ! RefHeight - 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%RefHeight - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_PackUserFieldType - - SUBROUTINE IfW_FlowField_UnPackUserFieldType( 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(UserFieldType), 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 = 'IfW_FlowField_UnPackUserFieldType' - ! 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%RefHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_UnPackUserFieldType - - SUBROUTINE IfW_FlowField_CopyFlowFieldType( SrcFlowFieldTypeData, DstFlowFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FlowFieldType), INTENT(IN) :: SrcFlowFieldTypeData - TYPE(FlowFieldType), INTENT(INOUT) :: DstFlowFieldTypeData - 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 = 'IfW_FlowField_CopyFlowFieldType' -! + ErrMsg = '' + DstGrid3DFieldTypeData%WindFileFormat = SrcGrid3DFieldTypeData%WindFileFormat + DstGrid3DFieldTypeData%WindProfileType = SrcGrid3DFieldTypeData%WindProfileType + DstGrid3DFieldTypeData%Periodic = SrcGrid3DFieldTypeData%Periodic + DstGrid3DFieldTypeData%InterpTower = SrcGrid3DFieldTypeData%InterpTower + DstGrid3DFieldTypeData%AddMeanAfterInterp = SrcGrid3DFieldTypeData%AddMeanAfterInterp + DstGrid3DFieldTypeData%RefHeight = SrcGrid3DFieldTypeData%RefHeight + DstGrid3DFieldTypeData%RefLength = SrcGrid3DFieldTypeData%RefLength + if (allocated(SrcGrid3DFieldTypeData%Vel)) then + LB(1:4) = lbound(SrcGrid3DFieldTypeData%Vel) + UB(1:4) = ubound(SrcGrid3DFieldTypeData%Vel) + if (.not. allocated(DstGrid3DFieldTypeData%Vel)) then + allocate(DstGrid3DFieldTypeData%Vel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%Vel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%Vel = SrcGrid3DFieldTypeData%Vel + end if + if (allocated(SrcGrid3DFieldTypeData%Acc)) then + LB(1:4) = lbound(SrcGrid3DFieldTypeData%Acc) + UB(1:4) = ubound(SrcGrid3DFieldTypeData%Acc) + if (.not. allocated(DstGrid3DFieldTypeData%Acc)) then + allocate(DstGrid3DFieldTypeData%Acc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%Acc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%Acc = SrcGrid3DFieldTypeData%Acc + end if + if (allocated(SrcGrid3DFieldTypeData%VelTower)) then + LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelTower) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelTower) + if (.not. allocated(DstGrid3DFieldTypeData%VelTower)) then + allocate(DstGrid3DFieldTypeData%VelTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%VelTower.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%VelTower = SrcGrid3DFieldTypeData%VelTower + end if + if (allocated(SrcGrid3DFieldTypeData%AccTower)) then + LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccTower) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccTower) + if (.not. allocated(DstGrid3DFieldTypeData%AccTower)) then + allocate(DstGrid3DFieldTypeData%AccTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%AccTower.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%AccTower = SrcGrid3DFieldTypeData%AccTower + end if + if (allocated(SrcGrid3DFieldTypeData%VelAvg)) then + LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelAvg) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelAvg) + if (.not. allocated(DstGrid3DFieldTypeData%VelAvg)) then + allocate(DstGrid3DFieldTypeData%VelAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%VelAvg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%VelAvg = SrcGrid3DFieldTypeData%VelAvg + end if + if (allocated(SrcGrid3DFieldTypeData%AccAvg)) then + LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccAvg) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccAvg) + if (.not. allocated(DstGrid3DFieldTypeData%AccAvg)) then + allocate(DstGrid3DFieldTypeData%AccAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%AccAvg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%AccAvg = SrcGrid3DFieldTypeData%AccAvg + end if + DstGrid3DFieldTypeData%DTime = SrcGrid3DFieldTypeData%DTime + DstGrid3DFieldTypeData%Rate = SrcGrid3DFieldTypeData%Rate + DstGrid3DFieldTypeData%YHWid = SrcGrid3DFieldTypeData%YHWid + DstGrid3DFieldTypeData%ZHWid = SrcGrid3DFieldTypeData%ZHWid + DstGrid3DFieldTypeData%GridBase = SrcGrid3DFieldTypeData%GridBase + DstGrid3DFieldTypeData%InitXPosition = SrcGrid3DFieldTypeData%InitXPosition + DstGrid3DFieldTypeData%InvDY = SrcGrid3DFieldTypeData%InvDY + DstGrid3DFieldTypeData%InvDZ = SrcGrid3DFieldTypeData%InvDZ + DstGrid3DFieldTypeData%MeanWS = SrcGrid3DFieldTypeData%MeanWS + DstGrid3DFieldTypeData%InvMWS = SrcGrid3DFieldTypeData%InvMWS + DstGrid3DFieldTypeData%TotalTime = SrcGrid3DFieldTypeData%TotalTime + DstGrid3DFieldTypeData%NComp = SrcGrid3DFieldTypeData%NComp + DstGrid3DFieldTypeData%NYGrids = SrcGrid3DFieldTypeData%NYGrids + DstGrid3DFieldTypeData%NZGrids = SrcGrid3DFieldTypeData%NZGrids + DstGrid3DFieldTypeData%NTGrids = SrcGrid3DFieldTypeData%NTGrids + DstGrid3DFieldTypeData%NSteps = SrcGrid3DFieldTypeData%NSteps + DstGrid3DFieldTypeData%PLExp = SrcGrid3DFieldTypeData%PLExp + DstGrid3DFieldTypeData%Z0 = SrcGrid3DFieldTypeData%Z0 + DstGrid3DFieldTypeData%VLinShr = SrcGrid3DFieldTypeData%VLinShr + DstGrid3DFieldTypeData%HLinShr = SrcGrid3DFieldTypeData%HLinShr + DstGrid3DFieldTypeData%BoxExceedAllowF = SrcGrid3DFieldTypeData%BoxExceedAllowF + DstGrid3DFieldTypeData%BoxExceedAllowIdx = SrcGrid3DFieldTypeData%BoxExceedAllowIdx + DstGrid3DFieldTypeData%BoxExceedWarned = SrcGrid3DFieldTypeData%BoxExceedWarned +end subroutine + +subroutine IfW_FlowField_DestroyGrid3DFieldType(Grid3DFieldTypeData, ErrStat, ErrMsg) + type(Grid3DFieldType), intent(inout) :: Grid3DFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyGrid3DFieldType' ErrStat = ErrID_None - ErrMsg = "" - DstFlowFieldTypeData%FieldType = SrcFlowFieldTypeData%FieldType - DstFlowFieldTypeData%RefPosition = SrcFlowFieldTypeData%RefPosition - DstFlowFieldTypeData%PropagationDir = SrcFlowFieldTypeData%PropagationDir - DstFlowFieldTypeData%VFlowAngle = SrcFlowFieldTypeData%VFlowAngle - DstFlowFieldTypeData%VelInterpCubic = SrcFlowFieldTypeData%VelInterpCubic - DstFlowFieldTypeData%RotateWindBox = SrcFlowFieldTypeData%RotateWindBox - DstFlowFieldTypeData%AccFieldValid = SrcFlowFieldTypeData%AccFieldValid - DstFlowFieldTypeData%RotToWind = SrcFlowFieldTypeData%RotToWind - DstFlowFieldTypeData%RotFromWind = SrcFlowFieldTypeData%RotFromWind - CALL IfW_FlowField_Copyuniformfieldtype( SrcFlowFieldTypeData%Uniform, DstFlowFieldTypeData%Uniform, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IfW_FlowField_Copygrid3dfieldtype( SrcFlowFieldTypeData%Grid3D, DstFlowFieldTypeData%Grid3D, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IfW_FlowField_Copygrid4dfieldtype( SrcFlowFieldTypeData%Grid4D, DstFlowFieldTypeData%Grid4D, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IfW_FlowField_Copypointsfieldtype( SrcFlowFieldTypeData%Points, DstFlowFieldTypeData%Points, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IfW_FlowField_Copyuserfieldtype( SrcFlowFieldTypeData%User, DstFlowFieldTypeData%User, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE IfW_FlowField_CopyFlowFieldType - - SUBROUTINE IfW_FlowField_DestroyFlowFieldType( FlowFieldTypeData, ErrStat, ErrMsg ) - TYPE(FlowFieldType), INTENT(INOUT) :: FlowFieldTypeData - 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 = 'IfW_FlowField_DestroyFlowFieldType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL IfW_FlowField_DestroyUniformFieldType( FlowFieldTypeData%Uniform, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_DestroyGrid3DFieldType( FlowFieldTypeData%Grid3D, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_DestroyGrid4DFieldType( FlowFieldTypeData%Grid4D, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_DestroyPointsFieldType( FlowFieldTypeData%Points, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_DestroyUserFieldType( FlowFieldTypeData%User, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE IfW_FlowField_DestroyFlowFieldType - - SUBROUTINE IfW_FlowField_PackFlowFieldType( 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(FlowFieldType), 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 = 'IfW_FlowField_PackFlowFieldType' - ! 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 ! FieldType - Re_BufSz = Re_BufSz + SIZE(InData%RefPosition) ! RefPosition - Re_BufSz = Re_BufSz + 1 ! PropagationDir - Re_BufSz = Re_BufSz + 1 ! VFlowAngle - Int_BufSz = Int_BufSz + 1 ! VelInterpCubic - Int_BufSz = Int_BufSz + 1 ! RotateWindBox - Int_BufSz = Int_BufSz + 1 ! AccFieldValid - Re_BufSz = Re_BufSz + SIZE(InData%RotToWind) ! RotToWind - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Uniform - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Uniform - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Uniform - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Grid3D - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Grid3D - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Grid3D - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Grid4D - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Grid4D - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Grid4D - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Points - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Points - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Points - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! User - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! User - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! User - 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 - - IntKiBuf(Int_Xferred) = InData%FieldType - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RefPosition,1), UBOUND(InData%RefPosition,1) - ReKiBuf(Re_Xferred) = InData%RefPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%PropagationDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VFlowAngle - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%VelInterpCubic, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotateWindBox, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%AccFieldValid, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%RotToWind,2), UBOUND(InData%RotToWind,2) - DO i1 = LBOUND(InData%RotToWind,1), UBOUND(InData%RotToWind,1) - ReKiBuf(Re_Xferred) = InData%RotToWind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%RotFromWind,2), UBOUND(InData%RotFromWind,2) - DO i1 = LBOUND(InData%RotFromWind,1), UBOUND(InData%RotFromWind,1) - ReKiBuf(Re_Xferred) = InData%RotFromWind(i1,i2) - 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 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 IfW_FlowField_PackFlowFieldType - - SUBROUTINE IfW_FlowField_UnPackFlowFieldType( 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(FlowFieldType), 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 = 'IfW_FlowField_UnPackFlowFieldType' - ! 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%FieldType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RefPosition,1) - i1_u = UBOUND(OutData%RefPosition,1) - DO i1 = LBOUND(OutData%RefPosition,1), UBOUND(OutData%RefPosition,1) - OutData%RefPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%PropagationDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VFlowAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelInterpCubic = TRANSFER(IntKiBuf(Int_Xferred), OutData%VelInterpCubic) - Int_Xferred = Int_Xferred + 1 - OutData%RotateWindBox = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotateWindBox) - Int_Xferred = Int_Xferred + 1 - OutData%AccFieldValid = TRANSFER(IntKiBuf(Int_Xferred), OutData%AccFieldValid) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RotToWind,1) - i1_u = UBOUND(OutData%RotToWind,1) - i2_l = LBOUND(OutData%RotToWind,2) - i2_u = UBOUND(OutData%RotToWind,2) - DO i2 = LBOUND(OutData%RotToWind,2), UBOUND(OutData%RotToWind,2) - DO i1 = LBOUND(OutData%RotToWind,1), UBOUND(OutData%RotToWind,1) - OutData%RotToWind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%RotFromWind,1) - i1_u = UBOUND(OutData%RotFromWind,1) - i2_l = LBOUND(OutData%RotFromWind,2) - i2_u = UBOUND(OutData%RotFromWind,2) - DO i2 = LBOUND(OutData%RotFromWind,2), UBOUND(OutData%RotFromWind,2) - DO i1 = LBOUND(OutData%RotFromWind,1), UBOUND(OutData%RotFromWind,1) - OutData%RotFromWind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE IfW_FlowField_UnPackFlowFieldType - + ErrMsg = '' + if (allocated(Grid3DFieldTypeData%Vel)) then + deallocate(Grid3DFieldTypeData%Vel) + end if + if (allocated(Grid3DFieldTypeData%Acc)) then + deallocate(Grid3DFieldTypeData%Acc) + end if + if (allocated(Grid3DFieldTypeData%VelTower)) then + deallocate(Grid3DFieldTypeData%VelTower) + end if + if (allocated(Grid3DFieldTypeData%AccTower)) then + deallocate(Grid3DFieldTypeData%AccTower) + end if + if (allocated(Grid3DFieldTypeData%VelAvg)) then + deallocate(Grid3DFieldTypeData%VelAvg) + end if + if (allocated(Grid3DFieldTypeData%AccAvg)) then + deallocate(Grid3DFieldTypeData%AccAvg) + end if +end subroutine + +subroutine IfW_FlowField_PackGrid3DFieldType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Grid3DFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackGrid3DFieldType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%WindFileFormat) + call RegPack(Buf, InData%WindProfileType) + call RegPack(Buf, InData%Periodic) + call RegPack(Buf, InData%InterpTower) + call RegPack(Buf, InData%AddMeanAfterInterp) + call RegPack(Buf, InData%RefHeight) + call RegPack(Buf, InData%RefLength) + call RegPack(Buf, allocated(InData%Vel)) + if (allocated(InData%Vel)) then + call RegPackBounds(Buf, 4, lbound(InData%Vel), ubound(InData%Vel)) + call RegPack(Buf, InData%Vel) + end if + call RegPack(Buf, allocated(InData%Acc)) + if (allocated(InData%Acc)) then + call RegPackBounds(Buf, 4, lbound(InData%Acc), ubound(InData%Acc)) + call RegPack(Buf, InData%Acc) + end if + call RegPack(Buf, allocated(InData%VelTower)) + if (allocated(InData%VelTower)) then + call RegPackBounds(Buf, 3, lbound(InData%VelTower), ubound(InData%VelTower)) + call RegPack(Buf, InData%VelTower) + end if + call RegPack(Buf, allocated(InData%AccTower)) + if (allocated(InData%AccTower)) then + call RegPackBounds(Buf, 3, lbound(InData%AccTower), ubound(InData%AccTower)) + call RegPack(Buf, InData%AccTower) + end if + call RegPack(Buf, allocated(InData%VelAvg)) + if (allocated(InData%VelAvg)) then + call RegPackBounds(Buf, 3, lbound(InData%VelAvg), ubound(InData%VelAvg)) + call RegPack(Buf, InData%VelAvg) + end if + call RegPack(Buf, allocated(InData%AccAvg)) + if (allocated(InData%AccAvg)) then + call RegPackBounds(Buf, 3, lbound(InData%AccAvg), ubound(InData%AccAvg)) + call RegPack(Buf, InData%AccAvg) + end if + call RegPack(Buf, InData%DTime) + call RegPack(Buf, InData%Rate) + call RegPack(Buf, InData%YHWid) + call RegPack(Buf, InData%ZHWid) + call RegPack(Buf, InData%GridBase) + call RegPack(Buf, InData%InitXPosition) + call RegPack(Buf, InData%InvDY) + call RegPack(Buf, InData%InvDZ) + call RegPack(Buf, InData%MeanWS) + call RegPack(Buf, InData%InvMWS) + call RegPack(Buf, InData%TotalTime) + call RegPack(Buf, InData%NComp) + call RegPack(Buf, InData%NYGrids) + call RegPack(Buf, InData%NZGrids) + call RegPack(Buf, InData%NTGrids) + call RegPack(Buf, InData%NSteps) + call RegPack(Buf, InData%PLExp) + call RegPack(Buf, InData%Z0) + call RegPack(Buf, InData%VLinShr) + call RegPack(Buf, InData%HLinShr) + call RegPack(Buf, InData%BoxExceedAllowF) + call RegPack(Buf, InData%BoxExceedAllowIdx) + call RegPack(Buf, InData%BoxExceedWarned) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackGrid3DFieldType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Grid3DFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackGrid3DFieldType' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%WindFileFormat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WindProfileType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Periodic) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InterpTower) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AddMeanAfterInterp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefHeight) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Vel)) deallocate(OutData%Vel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vel) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Acc)) deallocate(OutData%Acc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Acc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Acc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Acc) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%VelTower)) deallocate(OutData%VelTower) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelTower.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelTower) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AccTower)) deallocate(OutData%AccTower) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AccTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccTower.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AccTower) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%VelAvg)) deallocate(OutData%VelAvg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelAvg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelAvg) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AccAvg)) deallocate(OutData%AccAvg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AccAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccAvg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AccAvg) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%DTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Rate) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YHWid) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ZHWid) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GridBase) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InitXPosition) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InvDY) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InvDZ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MeanWS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InvMWS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TotalTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NComp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NYGrids) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NZGrids) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NTGrids) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NSteps) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Z0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VLinShr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HLinShr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BoxExceedAllowF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BoxExceedAllowIdx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BoxExceedWarned) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_CopyGrid4DFieldType(SrcGrid4DFieldTypeData, DstGrid4DFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(Grid4DFieldType), intent(in) :: SrcGrid4DFieldTypeData + type(Grid4DFieldType), intent(inout) :: DstGrid4DFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyGrid4DFieldType' + ErrStat = ErrID_None + ErrMsg = '' + DstGrid4DFieldTypeData%n = SrcGrid4DFieldTypeData%n + DstGrid4DFieldTypeData%delta = SrcGrid4DFieldTypeData%delta + DstGrid4DFieldTypeData%pZero = SrcGrid4DFieldTypeData%pZero + DstGrid4DFieldTypeData%Vel => SrcGrid4DFieldTypeData%Vel + DstGrid4DFieldTypeData%TimeStart = SrcGrid4DFieldTypeData%TimeStart + DstGrid4DFieldTypeData%RefHeight = SrcGrid4DFieldTypeData%RefHeight +end subroutine + +subroutine IfW_FlowField_DestroyGrid4DFieldType(Grid4DFieldTypeData, ErrStat, ErrMsg) + type(Grid4DFieldType), intent(inout) :: Grid4DFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyGrid4DFieldType' + ErrStat = ErrID_None + ErrMsg = '' + nullify(Grid4DFieldTypeData%Vel) +end subroutine + +subroutine IfW_FlowField_PackGrid4DFieldType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Grid4DFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackGrid4DFieldType' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%n) + call RegPack(Buf, InData%delta) + call RegPack(Buf, InData%pZero) + call RegPack(Buf, associated(InData%Vel)) + if (associated(InData%Vel)) then + call RegPackBounds(Buf, 5, lbound(InData%Vel), ubound(InData%Vel)) + call RegPackPointer(Buf, c_loc(InData%Vel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Vel) + end if + end if + call RegPack(Buf, InData%TimeStart) + call RegPack(Buf, InData%RefHeight) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackGrid4DFieldType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Grid4DFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackGrid4DFieldType' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%delta) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%pZero) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%Vel)) deallocate(OutData%Vel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vel, UB(1:5)-LB(1:5)) + OutData%Vel(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%Vel + else + allocate(OutData%Vel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vel) + call RegUnpack(Buf, OutData%Vel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Vel => null() + end if + call RegUnpack(Buf, OutData%TimeStart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefHeight) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_CopyPointsFieldType(SrcPointsFieldTypeData, DstPointsFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(PointsFieldType), intent(in) :: SrcPointsFieldTypeData + type(PointsFieldType), intent(inout) :: DstPointsFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyPointsFieldType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcPointsFieldTypeData%Vel)) then + LB(1:2) = lbound(SrcPointsFieldTypeData%Vel) + UB(1:2) = ubound(SrcPointsFieldTypeData%Vel) + if (.not. allocated(DstPointsFieldTypeData%Vel)) then + allocate(DstPointsFieldTypeData%Vel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstPointsFieldTypeData%Vel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstPointsFieldTypeData%Vel = SrcPointsFieldTypeData%Vel + end if +end subroutine + +subroutine IfW_FlowField_DestroyPointsFieldType(PointsFieldTypeData, ErrStat, ErrMsg) + type(PointsFieldType), intent(inout) :: PointsFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyPointsFieldType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(PointsFieldTypeData%Vel)) then + deallocate(PointsFieldTypeData%Vel) + end if +end subroutine + +subroutine IfW_FlowField_PackPointsFieldType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(PointsFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackPointsFieldType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Vel)) + if (allocated(InData%Vel)) then + call RegPackBounds(Buf, 2, lbound(InData%Vel), ubound(InData%Vel)) + call RegPack(Buf, InData%Vel) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackPointsFieldType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(PointsFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackPointsFieldType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Vel)) deallocate(OutData%Vel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vel) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine IfW_FlowField_CopyUserFieldType(SrcUserFieldTypeData, DstUserFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(UserFieldType), intent(in) :: SrcUserFieldTypeData + type(UserFieldType), intent(inout) :: DstUserFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyUserFieldType' + ErrStat = ErrID_None + ErrMsg = '' + DstUserFieldTypeData%RefHeight = SrcUserFieldTypeData%RefHeight +end subroutine + +subroutine IfW_FlowField_DestroyUserFieldType(UserFieldTypeData, ErrStat, ErrMsg) + type(UserFieldType), intent(inout) :: UserFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyUserFieldType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine IfW_FlowField_PackUserFieldType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UserFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackUserFieldType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%RefHeight) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackUserFieldType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UserFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUserFieldType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%RefHeight) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_CopyFlowFieldType(SrcFlowFieldTypeData, DstFlowFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(FlowFieldType), intent(in) :: SrcFlowFieldTypeData + type(FlowFieldType), intent(inout) :: DstFlowFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyFlowFieldType' + ErrStat = ErrID_None + ErrMsg = '' + DstFlowFieldTypeData%FieldType = SrcFlowFieldTypeData%FieldType + DstFlowFieldTypeData%RefPosition = SrcFlowFieldTypeData%RefPosition + DstFlowFieldTypeData%PropagationDir = SrcFlowFieldTypeData%PropagationDir + DstFlowFieldTypeData%VFlowAngle = SrcFlowFieldTypeData%VFlowAngle + DstFlowFieldTypeData%VelInterpCubic = SrcFlowFieldTypeData%VelInterpCubic + DstFlowFieldTypeData%RotateWindBox = SrcFlowFieldTypeData%RotateWindBox + DstFlowFieldTypeData%AccFieldValid = SrcFlowFieldTypeData%AccFieldValid + DstFlowFieldTypeData%RotToWind = SrcFlowFieldTypeData%RotToWind + DstFlowFieldTypeData%RotFromWind = SrcFlowFieldTypeData%RotFromWind + call IfW_FlowField_CopyUniformFieldType(SrcFlowFieldTypeData%Uniform, DstFlowFieldTypeData%Uniform, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IfW_FlowField_CopyGrid3DFieldType(SrcFlowFieldTypeData%Grid3D, DstFlowFieldTypeData%Grid3D, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IfW_FlowField_CopyGrid4DFieldType(SrcFlowFieldTypeData%Grid4D, DstFlowFieldTypeData%Grid4D, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IfW_FlowField_CopyPointsFieldType(SrcFlowFieldTypeData%Points, DstFlowFieldTypeData%Points, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IfW_FlowField_CopyUserFieldType(SrcFlowFieldTypeData%User, DstFlowFieldTypeData%User, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine IfW_FlowField_DestroyFlowFieldType(FlowFieldTypeData, ErrStat, ErrMsg) + type(FlowFieldType), intent(inout) :: FlowFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyFlowFieldType' + ErrStat = ErrID_None + ErrMsg = '' + call IfW_FlowField_DestroyUniformFieldType(FlowFieldTypeData%Uniform, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IfW_FlowField_DestroyGrid3DFieldType(FlowFieldTypeData%Grid3D, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IfW_FlowField_DestroyGrid4DFieldType(FlowFieldTypeData%Grid4D, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IfW_FlowField_DestroyPointsFieldType(FlowFieldTypeData%Points, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IfW_FlowField_DestroyUserFieldType(FlowFieldTypeData%User, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine IfW_FlowField_PackFlowFieldType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FlowFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackFlowFieldType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%FieldType) + call RegPack(Buf, InData%RefPosition) + call RegPack(Buf, InData%PropagationDir) + call RegPack(Buf, InData%VFlowAngle) + call RegPack(Buf, InData%VelInterpCubic) + call RegPack(Buf, InData%RotateWindBox) + call RegPack(Buf, InData%AccFieldValid) + call RegPack(Buf, InData%RotToWind) + call RegPack(Buf, InData%RotFromWind) + call IfW_FlowField_PackUniformFieldType(Buf, InData%Uniform) + call IfW_FlowField_PackGrid3DFieldType(Buf, InData%Grid3D) + call IfW_FlowField_PackGrid4DFieldType(Buf, InData%Grid4D) + call IfW_FlowField_PackPointsFieldType(Buf, InData%Points) + call IfW_FlowField_PackUserFieldType(Buf, InData%User) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackFlowFieldType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FlowFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackFlowFieldType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%FieldType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefPosition) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PropagationDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VFlowAngle) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VelInterpCubic) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotateWindBox) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AccFieldValid) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotToWind) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotFromWind) + if (RegCheckErr(Buf, RoutineName)) return + call IfW_FlowField_UnpackUniformFieldType(Buf, OutData%Uniform) ! Uniform + call IfW_FlowField_UnpackGrid3DFieldType(Buf, OutData%Grid3D) ! Grid3D + call IfW_FlowField_UnpackGrid4DFieldType(Buf, OutData%Grid4D) ! Grid4D + call IfW_FlowField_UnpackPointsFieldType(Buf, OutData%Points) ! Points + call IfW_FlowField_UnpackUserFieldType(Buf, OutData%User) ! User +end subroutine END MODULE IfW_FlowField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind_Driver.f90 b/modules/inflowwind/src/InflowWind_Driver.f90 index 77beb83a58..0a20b2e333 100644 --- a/modules/inflowwind/src/InflowWind_Driver.f90 +++ b/modules/inflowwind/src/InflowWind_Driver.f90 @@ -862,8 +862,6 @@ PROGRAM InflowWind_Driver !FFT calculations occur here. Output to file. - - !-------------------------------------------------------------------------------------------------------------------------------- !-=-=- We are done, so close everything down -=-=- !-------------------------------------------------------------------------------------------------------------------------------- @@ -925,8 +923,6 @@ PROGRAM InflowWind_Driver CALL WrScr(' InflowWind_End call 3 of 3: ok') ENDIF - - CALL DriverCleanup() CONTAINS @@ -945,7 +941,6 @@ SUBROUTINE DriverCleanup() END SUBROUTINE DriverCleanup - END PROGRAM InflowWind_Driver diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index 1d4342bf6b..defa03ae42 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -38,37 +38,37 @@ MODULE InflowWind_IO_Types TYPE, PUBLIC :: WindFileDat character(1024) :: FileName !< Name of the windfile retrieved [-] INTEGER(IntKi) :: WindType = 0 !< Type of the windfile [-] - REAL(ReKi) :: RefHt !< Reference height given in file [meters] - LOGICAL :: RefHt_Set !< Reference height was given in file [-] - REAL(DbKi) :: DT !< TimeStep of the wind file -- zero value for none [seconds] - INTEGER(IntKi) :: NumTSteps !< Number of timesteps in the time range of wind file [-] - LOGICAL :: ConstantDT !< Timesteps are the same throughout file [-] - REAL(ReKi) , DIMENSION(1:2) :: TRange !< Time range of the wind file [seconds] - LOGICAL :: TRange_Limited !< TRange limits strictly enforced [-] - REAL(ReKi) , DIMENSION(1:2) :: YRange !< Range in y direction [meters] - LOGICAL :: YRange_Limited !< YRange limits strictly enforced [-] - REAL(ReKi) , DIMENSION(1:2) :: ZRange !< Range in z direction [meters] - LOGICAL :: ZRange_Limited !< ZRange limits strictly enforced [-] - INTEGER(IntKi) :: BinaryFormat !< Binary format identifier [-] - LOGICAL :: IsBinary !< Windfile is a binary file [-] - REAL(ReKi) , DIMENSION(1:3) :: TI !< Turbulence intensity (U,V,W) [-] - LOGICAL :: TI_listed !< Turbulence intesity given in file [-] - REAL(ReKi) :: MWS !< Approximate mean wind speed [-] + REAL(ReKi) :: RefHt = 0.0_ReKi !< Reference height given in file [meters] + LOGICAL :: RefHt_Set = .false. !< Reference height was given in file [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< TimeStep of the wind file -- zero value for none [seconds] + INTEGER(IntKi) :: NumTSteps = 0_IntKi !< Number of timesteps in the time range of wind file [-] + LOGICAL :: ConstantDT = .false. !< Timesteps are the same throughout file [-] + REAL(ReKi) , DIMENSION(1:2) :: TRange = 0.0_ReKi !< Time range of the wind file [seconds] + LOGICAL :: TRange_Limited = .false. !< TRange limits strictly enforced [-] + REAL(ReKi) , DIMENSION(1:2) :: YRange = 0.0_ReKi !< Range in y direction [meters] + LOGICAL :: YRange_Limited = .false. !< YRange limits strictly enforced [-] + REAL(ReKi) , DIMENSION(1:2) :: ZRange = 0.0_ReKi !< Range in z direction [meters] + LOGICAL :: ZRange_Limited = .false. !< ZRange limits strictly enforced [-] + INTEGER(IntKi) :: BinaryFormat = 0_IntKi !< Binary format identifier [-] + LOGICAL :: IsBinary = .false. !< Windfile is a binary file [-] + REAL(ReKi) , DIMENSION(1:3) :: TI = 0.0_ReKi !< Turbulence intensity (U,V,W) [-] + LOGICAL :: TI_listed = .false. !< Turbulence intesity given in file [-] + REAL(ReKi) :: MWS = 0.0_ReKi !< Approximate mean wind speed [-] END TYPE WindFileDat ! ======================= ! ========= Steady_InitInputType ======= TYPE, PUBLIC :: Steady_InitInputType - REAL(ReKi) :: HWindSpeed !< Horizontal wind speed [m/s] - REAL(ReKi) :: RefHt !< Reference height for horizontal wind speed [meters] - REAL(ReKi) :: PLExp !< Power law exponent [-] + REAL(ReKi) :: HWindSpeed = 0.0_ReKi !< Horizontal wind speed [m/s] + REAL(ReKi) :: RefHt = 0.0_ReKi !< Reference height for horizontal wind speed [meters] + REAL(ReKi) :: PLExp = 0.0_ReKi !< Power law exponent [-] END TYPE Steady_InitInputType ! ======================= ! ========= Uniform_InitInputType ======= TYPE, PUBLIC :: Uniform_InitInputType character(1024) :: WindFileName !< Name of the wind file to use [-] - REAL(ReKi) :: RefHt !< Reference height for horizontal wind speed [meters] - REAL(ReKi) :: RefLength !< Reference length for linear horizontal and vertical sheer [-] - REAL(ReKi) :: PropagationDir !< Direction of wind propagation [radians] + REAL(ReKi) :: RefHt = 0.0_ReKi !< Reference height for horizontal wind speed [meters] + REAL(ReKi) :: RefLength = 0.0_ReKi !< Reference length for linear horizontal and vertical sheer [-] + REAL(ReKi) :: PropagationDir = 0.0_ReKi !< Direction of wind propagation [radians] LOGICAL :: UseInputFile = .true. !< Flag for toggling file based IO in wind type 2. [-] TYPE(FileInfoType) :: PassedFileData !< Optional slot for wind type 2 data if file IO is not used. [-] END TYPE Uniform_InitInputType @@ -76,8 +76,8 @@ MODULE InflowWind_IO_Types ! ========= Grid3D_InitInputType ======= TYPE, PUBLIC :: Grid3D_InitInputType INTEGER(IntKi) :: ScaleMethod = 0 !< Turbulence scaling method [0=none, 1=direct scaling, 2= calculate scaling factor based on a desired standard deviation] [-] - REAL(ReKi) , DIMENSION(1:3) :: SF !< Turbulence scaling factor for each direction [ScaleMethod=1] [-] - REAL(ReKi) , DIMENSION(1:3) :: SigmaF !< Turbulence standard deviation to calculate scaling from in each direction [ScaleMethod=2] [-] + REAL(ReKi) , DIMENSION(1:3) :: SF = 0 !< Turbulence scaling factor for each direction [ScaleMethod=1] [-] + REAL(ReKi) , DIMENSION(1:3) :: SigmaF = 0 !< Turbulence standard deviation to calculate scaling from in each direction [ScaleMethod=2] [-] INTEGER(IntKi) :: WindProfileType = -1 !< Wind profile type (0=constant;1=logarithmic;2=power law) [-] REAL(ReKi) :: RefHt = 0 !< Reference (hub) height of the grid [meters] REAL(ReKi) :: URef = 0 !< Mean u-component wind speed at the reference height [meters] @@ -97,17 +97,17 @@ MODULE InflowWind_IO_Types ! ========= Bladed_InitInputType ======= TYPE, PUBLIC :: Bladed_InitInputType character(1024) :: WindFileName !< Root filename [-] - INTEGER(IntKi) :: WindType !< Whether this is native Bladed (needs wind profile and TI scaling) or not [-] - LOGICAL :: NativeBladedFmt !< Whether this is native Bladed (needs wind profile and TI scaling) or not [-] - LOGICAL :: TowerFileExist !< Tower file exists [-] + INTEGER(IntKi) :: WindType = 0_IntKi !< Whether this is native Bladed (needs wind profile and TI scaling) or not [-] + LOGICAL :: NativeBladedFmt = .false. !< Whether this is native Bladed (needs wind profile and TI scaling) or not [-] + LOGICAL :: TowerFileExist = .false. !< Tower file exists [-] INTEGER(IntKi) :: TurbineID = 0 !< Wind turbine ID number in the fixed (DEFAULT) file name when FixedWindFileRootName = .TRUE. (used by FAST.Farm) [-] LOGICAL :: FixedWindFileRootName = .false. !< Do the wind data files have a fixed (DEFAULT) file name? (used by FAST.Farm) [-] END TYPE Bladed_InitInputType ! ======================= ! ========= Bladed_InitOutputType ======= TYPE, PUBLIC :: Bladed_InitOutputType - REAL(ReKi) :: PropagationDir !< Propogation direction from native Bladed format [degrees] - REAL(ReKi) :: VFlowAngle !< Vertical flow angle from native Bladed format [degrees] + REAL(ReKi) :: PropagationDir = 0.0_ReKi !< Propogation direction from native Bladed format [degrees] + REAL(ReKi) :: VFlowAngle = 0.0_ReKi !< Vertical flow angle from native Bladed format [degrees] END TYPE Bladed_InitOutputType ! ======================= ! ========= HAWC_InitInputType ======= @@ -124,2010 +124,707 @@ MODULE InflowWind_IO_Types ! ======================= ! ========= User_InitInputType ======= TYPE, PUBLIC :: User_InitInputType - REAL(SiKi) :: Dummy !< User field initialization input dummy value [-] + REAL(SiKi) :: Dummy = 0.0_R4Ki !< User field initialization input dummy value [-] END TYPE User_InitInputType ! ======================= ! ========= Grid4D_InitInputType ======= TYPE, PUBLIC :: Grid4D_InitInputType - INTEGER(IntKi) , DIMENSION(1:4) :: n !< number of grid points in the x, y, z, and t directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta !< size between 2 consecutive grid points in each grid direction [m,m,m,s] - REAL(ReKi) , DIMENSION(1:3) :: pZero !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of grid points in the x, y, z, and t directions [-] + REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [m,m,m,s] + REAL(ReKi) , DIMENSION(1:3) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: Vel => NULL() !< pointer to 4D grid velocity data [m/s] END TYPE Grid4D_InitInputType ! ======================= ! ========= Points_InitInputType ======= TYPE, PUBLIC :: Points_InitInputType - INTEGER(IntKi) :: NumWindPoints !< Number of points where wind components will be provided [-] + INTEGER(IntKi) :: NumWindPoints = 0_IntKi !< Number of points where wind components will be provided [-] END TYPE Points_InitInputType ! ======================= CONTAINS - SUBROUTINE InflowWind_IO_CopyWindFileDat( SrcWindFileDatData, DstWindFileDatData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WindFileDat), INTENT(IN) :: SrcWindFileDatData - TYPE(WindFileDat), INTENT(INOUT) :: DstWindFileDatData - 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 = 'InflowWind_IO_CopyWindFileDat' -! - ErrStat = ErrID_None - ErrMsg = "" - DstWindFileDatData%FileName = SrcWindFileDatData%FileName - DstWindFileDatData%WindType = SrcWindFileDatData%WindType - DstWindFileDatData%RefHt = SrcWindFileDatData%RefHt - DstWindFileDatData%RefHt_Set = SrcWindFileDatData%RefHt_Set - DstWindFileDatData%DT = SrcWindFileDatData%DT - DstWindFileDatData%NumTSteps = SrcWindFileDatData%NumTSteps - DstWindFileDatData%ConstantDT = SrcWindFileDatData%ConstantDT - DstWindFileDatData%TRange = SrcWindFileDatData%TRange - DstWindFileDatData%TRange_Limited = SrcWindFileDatData%TRange_Limited - DstWindFileDatData%YRange = SrcWindFileDatData%YRange - DstWindFileDatData%YRange_Limited = SrcWindFileDatData%YRange_Limited - DstWindFileDatData%ZRange = SrcWindFileDatData%ZRange - DstWindFileDatData%ZRange_Limited = SrcWindFileDatData%ZRange_Limited - DstWindFileDatData%BinaryFormat = SrcWindFileDatData%BinaryFormat - DstWindFileDatData%IsBinary = SrcWindFileDatData%IsBinary - DstWindFileDatData%TI = SrcWindFileDatData%TI - DstWindFileDatData%TI_listed = SrcWindFileDatData%TI_listed - DstWindFileDatData%MWS = SrcWindFileDatData%MWS - END SUBROUTINE InflowWind_IO_CopyWindFileDat - - SUBROUTINE InflowWind_IO_DestroyWindFileDat( WindFileDatData, ErrStat, ErrMsg ) - TYPE(WindFileDat), INTENT(INOUT) :: WindFileDatData - 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 = 'InflowWind_IO_DestroyWindFileDat' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_IO_DestroyWindFileDat - - SUBROUTINE InflowWind_IO_PackWindFileDat( 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(WindFileDat), 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 = 'InflowWind_IO_PackWindFileDat' - ! 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%FileName) ! FileName - Int_BufSz = Int_BufSz + 1 ! WindType - Re_BufSz = Re_BufSz + 1 ! RefHt - Int_BufSz = Int_BufSz + 1 ! RefHt_Set - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! NumTSteps - Int_BufSz = Int_BufSz + 1 ! ConstantDT - Re_BufSz = Re_BufSz + SIZE(InData%TRange) ! TRange - Int_BufSz = Int_BufSz + 1 ! TRange_Limited - Re_BufSz = Re_BufSz + SIZE(InData%YRange) ! YRange - Int_BufSz = Int_BufSz + 1 ! YRange_Limited - Re_BufSz = Re_BufSz + SIZE(InData%ZRange) ! ZRange - Int_BufSz = Int_BufSz + 1 ! ZRange_Limited - Int_BufSz = Int_BufSz + 1 ! BinaryFormat - Int_BufSz = Int_BufSz + 1 ! IsBinary - Re_BufSz = Re_BufSz + SIZE(InData%TI) ! TI - Int_BufSz = Int_BufSz + 1 ! TI_listed - Re_BufSz = Re_BufSz + 1 ! MWS - 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%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%WindType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RefHt_Set, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ConstantDT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TRange,1), UBOUND(InData%TRange,1) - ReKiBuf(Re_Xferred) = InData%TRange(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%TRange_Limited, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%YRange,1), UBOUND(InData%YRange,1) - ReKiBuf(Re_Xferred) = InData%YRange(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%YRange_Limited, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%ZRange,1), UBOUND(InData%ZRange,1) - ReKiBuf(Re_Xferred) = InData%ZRange(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%ZRange_Limited, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BinaryFormat - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsBinary, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) - ReKiBuf(Re_Xferred) = InData%TI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%TI_listed, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MWS - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackWindFileDat - SUBROUTINE InflowWind_IO_UnPackWindFileDat( 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(WindFileDat), 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 = 'InflowWind_IO_UnPackWindFileDat' - ! 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%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WindType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt_Set = TRANSFER(IntKiBuf(Int_Xferred), OutData%RefHt_Set) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumTSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ConstantDT = TRANSFER(IntKiBuf(Int_Xferred), OutData%ConstantDT) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TRange,1) - i1_u = UBOUND(OutData%TRange,1) - DO i1 = LBOUND(OutData%TRange,1), UBOUND(OutData%TRange,1) - OutData%TRange(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%TRange_Limited) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%YRange,1) - i1_u = UBOUND(OutData%YRange,1) - DO i1 = LBOUND(OutData%YRange,1), UBOUND(OutData%YRange,1) - OutData%YRange(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%YRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%YRange_Limited) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%ZRange,1) - i1_u = UBOUND(OutData%ZRange,1) - DO i1 = LBOUND(OutData%ZRange,1), UBOUND(OutData%ZRange,1) - OutData%ZRange(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%ZRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%ZRange_Limited) - Int_Xferred = Int_Xferred + 1 - OutData%BinaryFormat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%IsBinary = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsBinary) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TI,1) - i1_u = UBOUND(OutData%TI,1) - DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) - OutData%TI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TI_listed = TRANSFER(IntKiBuf(Int_Xferred), OutData%TI_listed) - Int_Xferred = Int_Xferred + 1 - OutData%MWS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackWindFileDat - - SUBROUTINE InflowWind_IO_CopySteady_InitInputType( SrcSteady_InitInputTypeData, DstSteady_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Steady_InitInputType), INTENT(IN) :: SrcSteady_InitInputTypeData - TYPE(Steady_InitInputType), INTENT(INOUT) :: DstSteady_InitInputTypeData - 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 = 'InflowWind_IO_CopySteady_InitInputType' -! +subroutine InflowWind_IO_CopyWindFileDat(SrcWindFileDatData, DstWindFileDatData, CtrlCode, ErrStat, ErrMsg) + type(WindFileDat), intent(in) :: SrcWindFileDatData + type(WindFileDat), intent(inout) :: DstWindFileDatData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyWindFileDat' ErrStat = ErrID_None - ErrMsg = "" - DstSteady_InitInputTypeData%HWindSpeed = SrcSteady_InitInputTypeData%HWindSpeed - DstSteady_InitInputTypeData%RefHt = SrcSteady_InitInputTypeData%RefHt - DstSteady_InitInputTypeData%PLExp = SrcSteady_InitInputTypeData%PLExp - END SUBROUTINE InflowWind_IO_CopySteady_InitInputType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroySteady_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_IO_DestroySteady_InitInputType - - SUBROUTINE InflowWind_IO_PackSteady_InitInputType( 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(Steady_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 = 'InflowWind_IO_PackSteady_InitInputType' - ! 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 ! HWindSpeed - Re_BufSz = Re_BufSz + 1 ! RefHt - Re_BufSz = Re_BufSz + 1 ! PLExp - 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%HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackSteady_InitInputType - - SUBROUTINE InflowWind_IO_UnPackSteady_InitInputType( 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(Steady_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackSteady_InitInputType' - ! 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%HWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackSteady_InitInputType - - SUBROUTINE InflowWind_IO_CopyUniform_InitInputType( SrcUniform_InitInputTypeData, DstUniform_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Uniform_InitInputType), INTENT(IN) :: SrcUniform_InitInputTypeData - TYPE(Uniform_InitInputType), INTENT(INOUT) :: DstUniform_InitInputTypeData - 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 = 'InflowWind_IO_CopyUniform_InitInputType' -! + ErrMsg = '' + DstWindFileDatData%FileName = SrcWindFileDatData%FileName + DstWindFileDatData%WindType = SrcWindFileDatData%WindType + DstWindFileDatData%RefHt = SrcWindFileDatData%RefHt + DstWindFileDatData%RefHt_Set = SrcWindFileDatData%RefHt_Set + DstWindFileDatData%DT = SrcWindFileDatData%DT + DstWindFileDatData%NumTSteps = SrcWindFileDatData%NumTSteps + DstWindFileDatData%ConstantDT = SrcWindFileDatData%ConstantDT + DstWindFileDatData%TRange = SrcWindFileDatData%TRange + DstWindFileDatData%TRange_Limited = SrcWindFileDatData%TRange_Limited + DstWindFileDatData%YRange = SrcWindFileDatData%YRange + DstWindFileDatData%YRange_Limited = SrcWindFileDatData%YRange_Limited + DstWindFileDatData%ZRange = SrcWindFileDatData%ZRange + DstWindFileDatData%ZRange_Limited = SrcWindFileDatData%ZRange_Limited + DstWindFileDatData%BinaryFormat = SrcWindFileDatData%BinaryFormat + DstWindFileDatData%IsBinary = SrcWindFileDatData%IsBinary + DstWindFileDatData%TI = SrcWindFileDatData%TI + DstWindFileDatData%TI_listed = SrcWindFileDatData%TI_listed + DstWindFileDatData%MWS = SrcWindFileDatData%MWS +end subroutine + +subroutine InflowWind_IO_DestroyWindFileDat(WindFileDatData, ErrStat, ErrMsg) + type(WindFileDat), intent(inout) :: WindFileDatData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyWindFileDat' ErrStat = ErrID_None - ErrMsg = "" - DstUniform_InitInputTypeData%WindFileName = SrcUniform_InitInputTypeData%WindFileName - DstUniform_InitInputTypeData%RefHt = SrcUniform_InitInputTypeData%RefHt - DstUniform_InitInputTypeData%RefLength = SrcUniform_InitInputTypeData%RefLength - DstUniform_InitInputTypeData%PropagationDir = SrcUniform_InitInputTypeData%PropagationDir - DstUniform_InitInputTypeData%UseInputFile = SrcUniform_InitInputTypeData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcUniform_InitInputTypeData%PassedFileData, DstUniform_InitInputTypeData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE InflowWind_IO_CopyUniform_InitInputType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyUniform_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyFileInfoType( Uniform_InitInputTypeData%PassedFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_IO_DestroyUniform_InitInputType - - SUBROUTINE InflowWind_IO_PackUniform_InitInputType( 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(Uniform_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 = 'InflowWind_IO_PackUniform_InitInputType' - ! 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%WindFileName) ! WindFileName - Re_BufSz = Re_BufSz + 1 ! RefHt - Re_BufSz = Re_BufSz + 1 ! RefLength - Re_BufSz = Re_BufSz + 1 ! PropagationDir - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedFileData - 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%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PropagationDir - 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 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 InflowWind_IO_PackUniform_InitInputType - - SUBROUTINE InflowWind_IO_UnPackUniform_InitInputType( 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(Uniform_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackUniform_InitInputType' - ! 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%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PropagationDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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) - END SUBROUTINE InflowWind_IO_UnPackUniform_InitInputType - - SUBROUTINE InflowWind_IO_CopyGrid3D_InitInputType( SrcGrid3D_InitInputTypeData, DstGrid3D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Grid3D_InitInputType), INTENT(IN) :: SrcGrid3D_InitInputTypeData - TYPE(Grid3D_InitInputType), INTENT(INOUT) :: DstGrid3D_InitInputTypeData - 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 = 'InflowWind_IO_CopyGrid3D_InitInputType' -! + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackWindFileDat(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WindFileDat), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackWindFileDat' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%FileName) + call RegPack(Buf, InData%WindType) + call RegPack(Buf, InData%RefHt) + call RegPack(Buf, InData%RefHt_Set) + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%NumTSteps) + call RegPack(Buf, InData%ConstantDT) + call RegPack(Buf, InData%TRange) + call RegPack(Buf, InData%TRange_Limited) + call RegPack(Buf, InData%YRange) + call RegPack(Buf, InData%YRange_Limited) + call RegPack(Buf, InData%ZRange) + call RegPack(Buf, InData%ZRange_Limited) + call RegPack(Buf, InData%BinaryFormat) + call RegPack(Buf, InData%IsBinary) + call RegPack(Buf, InData%TI) + call RegPack(Buf, InData%TI_listed) + call RegPack(Buf, InData%MWS) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackWindFileDat(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WindFileDat), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackWindFileDat' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%FileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WindType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefHt_Set) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumTSteps) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ConstantDT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TRange) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TRange_Limited) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YRange) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YRange_Limited) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ZRange) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ZRange_Limited) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BinaryFormat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IsBinary) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TI) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TI_listed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MWS) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopySteady_InitInputType(SrcSteady_InitInputTypeData, DstSteady_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Steady_InitInputType), intent(in) :: SrcSteady_InitInputTypeData + type(Steady_InitInputType), intent(inout) :: DstSteady_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopySteady_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstGrid3D_InitInputTypeData%ScaleMethod = SrcGrid3D_InitInputTypeData%ScaleMethod - DstGrid3D_InitInputTypeData%SF = SrcGrid3D_InitInputTypeData%SF - DstGrid3D_InitInputTypeData%SigmaF = SrcGrid3D_InitInputTypeData%SigmaF - DstGrid3D_InitInputTypeData%WindProfileType = SrcGrid3D_InitInputTypeData%WindProfileType - DstGrid3D_InitInputTypeData%RefHt = SrcGrid3D_InitInputTypeData%RefHt - DstGrid3D_InitInputTypeData%URef = SrcGrid3D_InitInputTypeData%URef - DstGrid3D_InitInputTypeData%PLExp = SrcGrid3D_InitInputTypeData%PLExp - DstGrid3D_InitInputTypeData%VLinShr = SrcGrid3D_InitInputTypeData%VLinShr - DstGrid3D_InitInputTypeData%HLinShr = SrcGrid3D_InitInputTypeData%HLinShr - DstGrid3D_InitInputTypeData%RefLength = SrcGrid3D_InitInputTypeData%RefLength - DstGrid3D_InitInputTypeData%Z0 = SrcGrid3D_InitInputTypeData%Z0 - DstGrid3D_InitInputTypeData%XOffset = SrcGrid3D_InitInputTypeData%XOffset - END SUBROUTINE InflowWind_IO_CopyGrid3D_InitInputType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyGrid3D_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_IO_DestroyGrid3D_InitInputType - - SUBROUTINE InflowWind_IO_PackGrid3D_InitInputType( 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(Grid3D_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 = 'InflowWind_IO_PackGrid3D_InitInputType' - ! 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 ! ScaleMethod - Re_BufSz = Re_BufSz + SIZE(InData%SF) ! SF - Re_BufSz = Re_BufSz + SIZE(InData%SigmaF) ! SigmaF - Int_BufSz = Int_BufSz + 1 ! WindProfileType - Re_BufSz = Re_BufSz + 1 ! RefHt - Re_BufSz = Re_BufSz + 1 ! URef - Re_BufSz = Re_BufSz + 1 ! PLExp - Re_BufSz = Re_BufSz + 1 ! VLinShr - Re_BufSz = Re_BufSz + 1 ! HLinShr - Re_BufSz = Re_BufSz + 1 ! RefLength - Re_BufSz = Re_BufSz + 1 ! Z0 - Re_BufSz = Re_BufSz + 1 ! XOffset - 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%ScaleMethod - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%SF,1), UBOUND(InData%SF,1) - ReKiBuf(Re_Xferred) = InData%SF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%SigmaF,1), UBOUND(InData%SigmaF,1) - ReKiBuf(Re_Xferred) = InData%SigmaF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%WindProfileType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%URef - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VLinShr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HLinShr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%XOffset - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackGrid3D_InitInputType - - SUBROUTINE InflowWind_IO_UnPackGrid3D_InitInputType( 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(Grid3D_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 = 'InflowWind_IO_UnPackGrid3D_InitInputType' - ! 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%ScaleMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%SF,1) - i1_u = UBOUND(OutData%SF,1) - DO i1 = LBOUND(OutData%SF,1), UBOUND(OutData%SF,1) - OutData%SF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%SigmaF,1) - i1_u = UBOUND(OutData%SigmaF,1) - DO i1 = LBOUND(OutData%SigmaF,1), UBOUND(OutData%SigmaF,1) - OutData%SigmaF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%WindProfileType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%URef = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VLinShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HLinShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%XOffset = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackGrid3D_InitInputType - - SUBROUTINE InflowWind_IO_CopyTurbSim_InitInputType( SrcTurbSim_InitInputTypeData, DstTurbSim_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TurbSim_InitInputType), INTENT(IN) :: SrcTurbSim_InitInputTypeData - TYPE(TurbSim_InitInputType), INTENT(INOUT) :: DstTurbSim_InitInputTypeData - 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 = 'InflowWind_IO_CopyTurbSim_InitInputType' -! + ErrMsg = '' + DstSteady_InitInputTypeData%HWindSpeed = SrcSteady_InitInputTypeData%HWindSpeed + DstSteady_InitInputTypeData%RefHt = SrcSteady_InitInputTypeData%RefHt + DstSteady_InitInputTypeData%PLExp = SrcSteady_InitInputTypeData%PLExp +end subroutine + +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 + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroySteady_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstTurbSim_InitInputTypeData%WindFileName = SrcTurbSim_InitInputTypeData%WindFileName - END SUBROUTINE InflowWind_IO_CopyTurbSim_InitInputType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyTurbSim_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_IO_DestroyTurbSim_InitInputType - - SUBROUTINE InflowWind_IO_PackTurbSim_InitInputType( 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(TurbSim_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 = 'InflowWind_IO_PackTurbSim_InitInputType' - ! 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%WindFileName) ! WindFileName - 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%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE InflowWind_IO_PackTurbSim_InitInputType - - SUBROUTINE InflowWind_IO_UnPackTurbSim_InitInputType( 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(TurbSim_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackTurbSim_InitInputType' - ! 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%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE InflowWind_IO_UnPackTurbSim_InitInputType - - SUBROUTINE InflowWind_IO_CopyBladed_InitInputType( SrcBladed_InitInputTypeData, DstBladed_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Bladed_InitInputType), INTENT(IN) :: SrcBladed_InitInputTypeData - TYPE(Bladed_InitInputType), INTENT(INOUT) :: DstBladed_InitInputTypeData - 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 = 'InflowWind_IO_CopyBladed_InitInputType' -! + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackSteady_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Steady_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackSteady_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%HWindSpeed) + call RegPack(Buf, InData%RefHt) + call RegPack(Buf, InData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackSteady_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Steady_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackSteady_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%HWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopyUniform_InitInputType(SrcUniform_InitInputTypeData, DstUniform_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Uniform_InitInputType), intent(in) :: SrcUniform_InitInputTypeData + type(Uniform_InitInputType), intent(inout) :: DstUniform_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyUniform_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstBladed_InitInputTypeData%WindFileName = SrcBladed_InitInputTypeData%WindFileName - DstBladed_InitInputTypeData%WindType = SrcBladed_InitInputTypeData%WindType - DstBladed_InitInputTypeData%NativeBladedFmt = SrcBladed_InitInputTypeData%NativeBladedFmt - DstBladed_InitInputTypeData%TowerFileExist = SrcBladed_InitInputTypeData%TowerFileExist - DstBladed_InitInputTypeData%TurbineID = SrcBladed_InitInputTypeData%TurbineID - DstBladed_InitInputTypeData%FixedWindFileRootName = SrcBladed_InitInputTypeData%FixedWindFileRootName - END SUBROUTINE InflowWind_IO_CopyBladed_InitInputType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyBladed_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_IO_DestroyBladed_InitInputType - - SUBROUTINE InflowWind_IO_PackBladed_InitInputType( 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(Bladed_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 = 'InflowWind_IO_PackBladed_InitInputType' - ! 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%WindFileName) ! WindFileName - Int_BufSz = Int_BufSz + 1 ! WindType - Int_BufSz = Int_BufSz + 1 ! NativeBladedFmt - Int_BufSz = Int_BufSz + 1 ! TowerFileExist - Int_BufSz = Int_BufSz + 1 ! TurbineID - Int_BufSz = Int_BufSz + 1 ! FixedWindFileRootName - 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%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%WindType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NativeBladedFmt, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TowerFileExist, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TurbineID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FixedWindFileRootName, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackBladed_InitInputType - - SUBROUTINE InflowWind_IO_UnPackBladed_InitInputType( 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(Bladed_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackBladed_InitInputType' - ! 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%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WindType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NativeBladedFmt = TRANSFER(IntKiBuf(Int_Xferred), OutData%NativeBladedFmt) - Int_Xferred = Int_Xferred + 1 - OutData%TowerFileExist = TRANSFER(IntKiBuf(Int_Xferred), OutData%TowerFileExist) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FixedWindFileRootName = TRANSFER(IntKiBuf(Int_Xferred), OutData%FixedWindFileRootName) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackBladed_InitInputType - - SUBROUTINE InflowWind_IO_CopyBladed_InitOutputType( SrcBladed_InitOutputTypeData, DstBladed_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Bladed_InitOutputType), INTENT(IN) :: SrcBladed_InitOutputTypeData - TYPE(Bladed_InitOutputType), INTENT(INOUT) :: DstBladed_InitOutputTypeData - 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 = 'InflowWind_IO_CopyBladed_InitOutputType' -! + ErrMsg = '' + DstUniform_InitInputTypeData%WindFileName = SrcUniform_InitInputTypeData%WindFileName + DstUniform_InitInputTypeData%RefHt = SrcUniform_InitInputTypeData%RefHt + DstUniform_InitInputTypeData%RefLength = SrcUniform_InitInputTypeData%RefLength + DstUniform_InitInputTypeData%PropagationDir = SrcUniform_InitInputTypeData%PropagationDir + DstUniform_InitInputTypeData%UseInputFile = SrcUniform_InitInputTypeData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcUniform_InitInputTypeData%PassedFileData, DstUniform_InitInputTypeData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +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 + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyUniform_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstBladed_InitOutputTypeData%PropagationDir = SrcBladed_InitOutputTypeData%PropagationDir - DstBladed_InitOutputTypeData%VFlowAngle = SrcBladed_InitOutputTypeData%VFlowAngle - END SUBROUTINE InflowWind_IO_CopyBladed_InitOutputType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyBladed_InitOutputType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_IO_DestroyBladed_InitOutputType - - SUBROUTINE InflowWind_IO_PackBladed_InitOutputType( 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(Bladed_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 = 'InflowWind_IO_PackBladed_InitOutputType' - ! 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 ! PropagationDir - Re_BufSz = Re_BufSz + 1 ! VFlowAngle - 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%PropagationDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VFlowAngle - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackBladed_InitOutputType - - SUBROUTINE InflowWind_IO_UnPackBladed_InitOutputType( 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(Bladed_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackBladed_InitOutputType' - ! 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%PropagationDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VFlowAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackBladed_InitOutputType - - SUBROUTINE InflowWind_IO_CopyHAWC_InitInputType( SrcHAWC_InitInputTypeData, DstHAWC_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HAWC_InitInputType), INTENT(IN) :: SrcHAWC_InitInputTypeData - TYPE(HAWC_InitInputType), INTENT(INOUT) :: DstHAWC_InitInputTypeData - 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 = 'InflowWind_IO_CopyHAWC_InitInputType' -! + ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(Uniform_InitInputTypeData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine InflowWind_IO_PackUniform_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Uniform_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackUniform_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%WindFileName) + call RegPack(Buf, InData%RefHt) + call RegPack(Buf, InData%RefLength) + call RegPack(Buf, InData%PropagationDir) + call RegPack(Buf, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackUniform_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Uniform_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackUniform_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%WindFileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PropagationDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData +end subroutine + +subroutine InflowWind_IO_CopyGrid3D_InitInputType(SrcGrid3D_InitInputTypeData, DstGrid3D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Grid3D_InitInputType), intent(in) :: SrcGrid3D_InitInputTypeData + type(Grid3D_InitInputType), intent(inout) :: DstGrid3D_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyGrid3D_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstHAWC_InitInputTypeData%WindFileName = SrcHAWC_InitInputTypeData%WindFileName - DstHAWC_InitInputTypeData%nx = SrcHAWC_InitInputTypeData%nx - DstHAWC_InitInputTypeData%ny = SrcHAWC_InitInputTypeData%ny - DstHAWC_InitInputTypeData%nz = SrcHAWC_InitInputTypeData%nz - DstHAWC_InitInputTypeData%dx = SrcHAWC_InitInputTypeData%dx - DstHAWC_InitInputTypeData%dy = SrcHAWC_InitInputTypeData%dy - DstHAWC_InitInputTypeData%dz = SrcHAWC_InitInputTypeData%dz - CALL InflowWind_IO_Copygrid3d_initinputtype( SrcHAWC_InitInputTypeData%G3D, DstHAWC_InitInputTypeData%G3D, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE InflowWind_IO_CopyHAWC_InitInputType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyHAWC_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL InflowWind_IO_DestroyGrid3D_InitInputType( HAWC_InitInputTypeData%G3D, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_IO_DestroyHAWC_InitInputType - - SUBROUTINE InflowWind_IO_PackHAWC_InitInputType( 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(HAWC_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 = 'InflowWind_IO_PackHAWC_InitInputType' - ! 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 + SIZE(InData%WindFileName)*LEN(InData%WindFileName) ! WindFileName - Int_BufSz = Int_BufSz + 1 ! nx - Int_BufSz = Int_BufSz + 1 ! ny - Int_BufSz = Int_BufSz + 1 ! nz - Re_BufSz = Re_BufSz + 1 ! dx - Re_BufSz = Re_BufSz + 1 ! dy - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! G3D - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! G3D - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! G3D - 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 i1 = LBOUND(InData%WindFileName,1), UBOUND(InData%WindFileName,1) - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - IntKiBuf(Int_Xferred) = InData%nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nz - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dy - 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 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 InflowWind_IO_PackHAWC_InitInputType - - SUBROUTINE InflowWind_IO_UnPackHAWC_InitInputType( 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(HAWC_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 = 'InflowWind_IO_UnPackHAWC_InitInputType' - ! 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 - i1_l = LBOUND(OutData%WindFileName,1) - i1_u = UBOUND(OutData%WindFileName,1) - DO i1 = LBOUND(OutData%WindFileName,1), UBOUND(OutData%WindFileName,1) - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - OutData%nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nz = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dz = ReKiBuf(Re_Xferred) - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE InflowWind_IO_UnPackHAWC_InitInputType - - SUBROUTINE InflowWind_IO_CopyUser_InitInputType( SrcUser_InitInputTypeData, DstUser_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(User_InitInputType), INTENT(IN) :: SrcUser_InitInputTypeData - TYPE(User_InitInputType), INTENT(INOUT) :: DstUser_InitInputTypeData - 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 = 'InflowWind_IO_CopyUser_InitInputType' -! + ErrMsg = '' + DstGrid3D_InitInputTypeData%ScaleMethod = SrcGrid3D_InitInputTypeData%ScaleMethod + DstGrid3D_InitInputTypeData%SF = SrcGrid3D_InitInputTypeData%SF + DstGrid3D_InitInputTypeData%SigmaF = SrcGrid3D_InitInputTypeData%SigmaF + DstGrid3D_InitInputTypeData%WindProfileType = SrcGrid3D_InitInputTypeData%WindProfileType + DstGrid3D_InitInputTypeData%RefHt = SrcGrid3D_InitInputTypeData%RefHt + DstGrid3D_InitInputTypeData%URef = SrcGrid3D_InitInputTypeData%URef + DstGrid3D_InitInputTypeData%PLExp = SrcGrid3D_InitInputTypeData%PLExp + DstGrid3D_InitInputTypeData%VLinShr = SrcGrid3D_InitInputTypeData%VLinShr + DstGrid3D_InitInputTypeData%HLinShr = SrcGrid3D_InitInputTypeData%HLinShr + DstGrid3D_InitInputTypeData%RefLength = SrcGrid3D_InitInputTypeData%RefLength + DstGrid3D_InitInputTypeData%Z0 = SrcGrid3D_InitInputTypeData%Z0 + DstGrid3D_InitInputTypeData%XOffset = SrcGrid3D_InitInputTypeData%XOffset +end subroutine + +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 + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyGrid3D_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstUser_InitInputTypeData%Dummy = SrcUser_InitInputTypeData%Dummy - END SUBROUTINE InflowWind_IO_CopyUser_InitInputType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyUser_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_IO_DestroyUser_InitInputType - - SUBROUTINE InflowWind_IO_PackUser_InitInputType( 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(User_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 = 'InflowWind_IO_PackUser_InitInputType' - ! 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 ! Dummy - 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%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackUser_InitInputType - - SUBROUTINE InflowWind_IO_UnPackUser_InitInputType( 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(User_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackUser_InitInputType' - ! 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%Dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackUser_InitInputType - - SUBROUTINE InflowWind_IO_CopyGrid4D_InitInputType( SrcGrid4D_InitInputTypeData, DstGrid4D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Grid4D_InitInputType), INTENT(IN) :: SrcGrid4D_InitInputTypeData - TYPE(Grid4D_InitInputType), INTENT(INOUT) :: DstGrid4D_InitInputTypeData - 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 = 'InflowWind_IO_CopyGrid4D_InitInputType' -! + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackGrid3D_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Grid3D_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackGrid3D_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%ScaleMethod) + call RegPack(Buf, InData%SF) + call RegPack(Buf, InData%SigmaF) + call RegPack(Buf, InData%WindProfileType) + call RegPack(Buf, InData%RefHt) + call RegPack(Buf, InData%URef) + call RegPack(Buf, InData%PLExp) + call RegPack(Buf, InData%VLinShr) + call RegPack(Buf, InData%HLinShr) + call RegPack(Buf, InData%RefLength) + call RegPack(Buf, InData%Z0) + call RegPack(Buf, InData%XOffset) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackGrid3D_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Grid3D_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackGrid3D_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%ScaleMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SigmaF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WindProfileType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%URef) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VLinShr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HLinShr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Z0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%XOffset) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopyTurbSim_InitInputType(SrcTurbSim_InitInputTypeData, DstTurbSim_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(TurbSim_InitInputType), intent(in) :: SrcTurbSim_InitInputTypeData + type(TurbSim_InitInputType), intent(inout) :: DstTurbSim_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyTurbSim_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstGrid4D_InitInputTypeData%n = SrcGrid4D_InitInputTypeData%n - DstGrid4D_InitInputTypeData%delta = SrcGrid4D_InitInputTypeData%delta - DstGrid4D_InitInputTypeData%pZero = SrcGrid4D_InitInputTypeData%pZero - DstGrid4D_InitInputTypeData%Vel => SrcGrid4D_InitInputTypeData%Vel - END SUBROUTINE InflowWind_IO_CopyGrid4D_InitInputType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyGrid4D_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - -NULLIFY(Grid4D_InitInputTypeData%Vel) - END SUBROUTINE InflowWind_IO_DestroyGrid4D_InitInputType - - SUBROUTINE InflowWind_IO_PackGrid4D_InitInputType( 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(Grid4D_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 = 'InflowWind_IO_PackGrid4D_InitInputType' - ! 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 + SIZE(InData%n) ! n - Re_BufSz = Re_BufSz + SIZE(InData%delta) ! delta - Re_BufSz = Re_BufSz + SIZE(InData%pZero) ! pZero - 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 i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) - ReKiBuf(Re_Xferred) = InData%delta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) - ReKiBuf(Re_Xferred) = InData%pZero(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE InflowWind_IO_PackGrid4D_InitInputType - - SUBROUTINE InflowWind_IO_UnPackGrid4D_InitInputType( 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(Grid4D_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 = 'InflowWind_IO_UnPackGrid4D_InitInputType' - ! 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 - i1_l = LBOUND(OutData%n,1) - i1_u = UBOUND(OutData%n,1) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%delta,1) - i1_u = UBOUND(OutData%delta,1) - DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) - OutData%delta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%pZero,1) - i1_u = UBOUND(OutData%pZero,1) - DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) - OutData%pZero(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - NULLIFY(OutData%Vel) - END SUBROUTINE InflowWind_IO_UnPackGrid4D_InitInputType - - SUBROUTINE InflowWind_IO_CopyPoints_InitInputType( SrcPoints_InitInputTypeData, DstPoints_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Points_InitInputType), INTENT(IN) :: SrcPoints_InitInputTypeData - TYPE(Points_InitInputType), INTENT(INOUT) :: DstPoints_InitInputTypeData - 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 = 'InflowWind_IO_CopyPoints_InitInputType' -! + ErrMsg = '' + DstTurbSim_InitInputTypeData%WindFileName = SrcTurbSim_InitInputTypeData%WindFileName +end subroutine + +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 + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyTurbSim_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstPoints_InitInputTypeData%NumWindPoints = SrcPoints_InitInputTypeData%NumWindPoints - END SUBROUTINE InflowWind_IO_CopyPoints_InitInputType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyPoints_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_IO_DestroyPoints_InitInputType - - SUBROUTINE InflowWind_IO_PackPoints_InitInputType( 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(Points_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 = 'InflowWind_IO_PackPoints_InitInputType' - ! 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 ! NumWindPoints - 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%NumWindPoints - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackPoints_InitInputType - - SUBROUTINE InflowWind_IO_UnPackPoints_InitInputType( 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(Points_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackPoints_InitInputType' - ! 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%NumWindPoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackPoints_InitInputType - + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackTurbSim_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TurbSim_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackTurbSim_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%WindFileName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackTurbSim_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TurbSim_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackTurbSim_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%WindFileName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopyBladed_InitInputType(SrcBladed_InitInputTypeData, DstBladed_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Bladed_InitInputType), intent(in) :: SrcBladed_InitInputTypeData + type(Bladed_InitInputType), intent(inout) :: DstBladed_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyBladed_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstBladed_InitInputTypeData%WindFileName = SrcBladed_InitInputTypeData%WindFileName + DstBladed_InitInputTypeData%WindType = SrcBladed_InitInputTypeData%WindType + DstBladed_InitInputTypeData%NativeBladedFmt = SrcBladed_InitInputTypeData%NativeBladedFmt + DstBladed_InitInputTypeData%TowerFileExist = SrcBladed_InitInputTypeData%TowerFileExist + DstBladed_InitInputTypeData%TurbineID = SrcBladed_InitInputTypeData%TurbineID + DstBladed_InitInputTypeData%FixedWindFileRootName = SrcBladed_InitInputTypeData%FixedWindFileRootName +end subroutine + +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 + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyBladed_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackBladed_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Bladed_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackBladed_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%WindFileName) + call RegPack(Buf, InData%WindType) + call RegPack(Buf, InData%NativeBladedFmt) + call RegPack(Buf, InData%TowerFileExist) + call RegPack(Buf, InData%TurbineID) + call RegPack(Buf, InData%FixedWindFileRootName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackBladed_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Bladed_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackBladed_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%WindFileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WindType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NativeBladedFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TowerFileExist) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TurbineID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FixedWindFileRootName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopyBladed_InitOutputType(SrcBladed_InitOutputTypeData, DstBladed_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Bladed_InitOutputType), intent(in) :: SrcBladed_InitOutputTypeData + type(Bladed_InitOutputType), intent(inout) :: DstBladed_InitOutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyBladed_InitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + DstBladed_InitOutputTypeData%PropagationDir = SrcBladed_InitOutputTypeData%PropagationDir + DstBladed_InitOutputTypeData%VFlowAngle = SrcBladed_InitOutputTypeData%VFlowAngle +end subroutine + +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 + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyBladed_InitOutputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackBladed_InitOutputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Bladed_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackBladed_InitOutputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%PropagationDir) + call RegPack(Buf, InData%VFlowAngle) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackBladed_InitOutputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Bladed_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackBladed_InitOutputType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%PropagationDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VFlowAngle) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopyHAWC_InitInputType(SrcHAWC_InitInputTypeData, DstHAWC_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(HAWC_InitInputType), intent(in) :: SrcHAWC_InitInputTypeData + type(HAWC_InitInputType), intent(inout) :: DstHAWC_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyHAWC_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstHAWC_InitInputTypeData%WindFileName = SrcHAWC_InitInputTypeData%WindFileName + DstHAWC_InitInputTypeData%nx = SrcHAWC_InitInputTypeData%nx + DstHAWC_InitInputTypeData%ny = SrcHAWC_InitInputTypeData%ny + DstHAWC_InitInputTypeData%nz = SrcHAWC_InitInputTypeData%nz + DstHAWC_InitInputTypeData%dx = SrcHAWC_InitInputTypeData%dx + DstHAWC_InitInputTypeData%dy = SrcHAWC_InitInputTypeData%dy + DstHAWC_InitInputTypeData%dz = SrcHAWC_InitInputTypeData%dz + call InflowWind_IO_CopyGrid3D_InitInputType(SrcHAWC_InitInputTypeData%G3D, DstHAWC_InitInputTypeData%G3D, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +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 + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyHAWC_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_IO_DestroyGrid3D_InitInputType(HAWC_InitInputTypeData%G3D, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine InflowWind_IO_PackHAWC_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HAWC_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackHAWC_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%WindFileName) + call RegPack(Buf, InData%nx) + call RegPack(Buf, InData%ny) + call RegPack(Buf, InData%nz) + call RegPack(Buf, InData%dx) + call RegPack(Buf, InData%dy) + call RegPack(Buf, InData%dz) + call InflowWind_IO_PackGrid3D_InitInputType(Buf, InData%G3D) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackHAWC_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HAWC_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackHAWC_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%WindFileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ny) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nz) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dy) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dz) + if (RegCheckErr(Buf, RoutineName)) return + call InflowWind_IO_UnpackGrid3D_InitInputType(Buf, OutData%G3D) ! G3D +end subroutine + +subroutine InflowWind_IO_CopyUser_InitInputType(SrcUser_InitInputTypeData, DstUser_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(User_InitInputType), intent(in) :: SrcUser_InitInputTypeData + type(User_InitInputType), intent(inout) :: DstUser_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyUser_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstUser_InitInputTypeData%Dummy = SrcUser_InitInputTypeData%Dummy +end subroutine + +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 + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyUser_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackUser_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(User_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackUser_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackUser_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(User_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackUser_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopyGrid4D_InitInputType(SrcGrid4D_InitInputTypeData, DstGrid4D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Grid4D_InitInputType), intent(in) :: SrcGrid4D_InitInputTypeData + type(Grid4D_InitInputType), intent(inout) :: DstGrid4D_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyGrid4D_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstGrid4D_InitInputTypeData%n = SrcGrid4D_InitInputTypeData%n + DstGrid4D_InitInputTypeData%delta = SrcGrid4D_InitInputTypeData%delta + DstGrid4D_InitInputTypeData%pZero = SrcGrid4D_InitInputTypeData%pZero + DstGrid4D_InitInputTypeData%Vel => SrcGrid4D_InitInputTypeData%Vel +end subroutine + +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 + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyGrid4D_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + nullify(Grid4D_InitInputTypeData%Vel) +end subroutine + +subroutine InflowWind_IO_PackGrid4D_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Grid4D_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackGrid4D_InitInputType' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%n) + call RegPack(Buf, InData%delta) + call RegPack(Buf, InData%pZero) + call RegPack(Buf, associated(InData%Vel)) + if (associated(InData%Vel)) then + call RegPackBounds(Buf, 5, lbound(InData%Vel), ubound(InData%Vel)) + call RegPackPointer(Buf, c_loc(InData%Vel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Vel) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackGrid4D_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Grid4D_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackGrid4D_InitInputType' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%delta) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%pZero) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%Vel)) deallocate(OutData%Vel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vel, UB(1:5)-LB(1:5)) + OutData%Vel(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%Vel + else + allocate(OutData%Vel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vel) + call RegUnpack(Buf, OutData%Vel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Vel => null() + end if +end subroutine + +subroutine InflowWind_IO_CopyPoints_InitInputType(SrcPoints_InitInputTypeData, DstPoints_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Points_InitInputType), intent(in) :: SrcPoints_InitInputTypeData + type(Points_InitInputType), intent(inout) :: DstPoints_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyPoints_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstPoints_InitInputTypeData%NumWindPoints = SrcPoints_InitInputTypeData%NumWindPoints +end subroutine + +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 + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyPoints_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackPoints_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Points_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackPoints_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%NumWindPoints) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackPoints_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Points_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackPoints_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NumWindPoints) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE InflowWind_IO_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index e69719c38a..7a7347bce5 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -50,51 +50,51 @@ MODULE InflowWind_Types INTEGER(IntKi), PUBLIC, PARAMETER :: IfW_NumPtsAvg = 144 ! Number of points averaged for rotor-average wind speed [-] ! ========= InflowWind_InputFile ======= TYPE, PUBLIC :: InflowWind_InputFile - LOGICAL :: EchoFlag !< Echo the input file [-] + LOGICAL :: EchoFlag = .false. !< Echo the input file [-] INTEGER(IntKi) :: WindType = 0 !< Type of windfile [-] - REAL(ReKi) :: PropagationDir !< Direction of wind propagation (meteorological direction) [(degrees)] - REAL(ReKi) :: VFlowAngle !< Vertical (upflow) angle [degrees] + REAL(ReKi) :: PropagationDir = 0.0_ReKi !< Direction of wind propagation (meteorological direction) [(degrees)] + REAL(ReKi) :: VFlowAngle = 0.0_ReKi !< Vertical (upflow) angle [degrees] LOGICAL :: VelInterpCubic = .FALSE. !< Use cubic interpolation for velocity in time (false=linear, true=cubic) [Used with WindType=2,3,4,5,7] [-] - INTEGER(IntKi) :: NWindVel !< Number of points to output the wind velocity (0 to 9) [-] + INTEGER(IntKi) :: NWindVel = 0_IntKi !< Number of points to output the wind velocity (0 to 9) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVxiList !< List of X coordinates for wind velocity measurements [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVyiList !< List of Y coordinates for wind velocity measurements [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVziList !< List of Z coordinates for wind velocity measurements [meters] - REAL(ReKi) :: Steady_HWindSpeed !< Steady wind -- horizontal windspeed [meters/s] - REAL(ReKi) :: Steady_RefHt !< Steady wind -- reference height [meters] - REAL(ReKi) :: Steady_PLexp !< Steady wind -- power law exponent [-] + REAL(ReKi) :: Steady_HWindSpeed = 0.0_ReKi !< Steady wind -- horizontal windspeed [meters/s] + REAL(ReKi) :: Steady_RefHt = 0.0_ReKi !< Steady wind -- reference height [meters] + REAL(ReKi) :: Steady_PLexp = 0.0_ReKi !< Steady wind -- power law exponent [-] CHARACTER(1024) :: Uniform_FileName !< Uniform wind -- filename [-] - REAL(ReKi) :: Uniform_RefHt !< Uniform wind -- reference height [meters] - REAL(ReKi) :: Uniform_RefLength !< Uniform wind -- reference length [meters] + REAL(ReKi) :: Uniform_RefHt = 0.0_ReKi !< Uniform wind -- reference height [meters] + REAL(ReKi) :: Uniform_RefLength = 0.0_ReKi !< Uniform wind -- reference length [meters] CHARACTER(1024) :: TSFF_FileName !< TurbSim Full-Field -- filename [-] CHARACTER(1024) :: BladedFF_FileName !< Bladed-style Full-Field -- filename [-] - LOGICAL :: BladedFF_TowerFile !< Bladed-style Full-Field -- tower file exists [-] + LOGICAL :: BladedFF_TowerFile = .false. !< Bladed-style Full-Field -- tower file exists [-] LOGICAL :: CTTS_CoherentTurb = .FALSE. !< Coherent turbulence data exists [-] CHARACTER(1024) :: CTTS_FileName !< Name of coherent turbulence file [-] CHARACTER(1024) :: CTTS_Path !< Path to coherent turbulence binary data files [-] CHARACTER(1024) :: HAWC_FileName_u !< HAWC -- u component binary data file name [-] CHARACTER(1024) :: HAWC_FileName_v !< HAWC -- v component binary data file name [-] CHARACTER(1024) :: HAWC_FileName_w !< HAWC -- w component binary data file name [-] - INTEGER(IntKi) :: HAWC_nx !< HAWC -- number of grids in x direction [-] - INTEGER(IntKi) :: HAWC_ny !< HAWC -- number of grids in y direction [-] - INTEGER(IntKi) :: HAWC_nz !< HAWC -- number of grids in z direction [-] - REAL(ReKi) :: HAWC_dx !< HAWC -- distance between points in x direction [meters] - REAL(ReKi) :: HAWC_dy !< HAWC -- distance between points in y direction [meters] - REAL(ReKi) :: HAWC_dz !< HAWC -- distance between points in z direction [meters] - LOGICAL :: SumPrint !< Write summary info to a file .IfW.Sum [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: HAWC_nx = 0_IntKi !< HAWC -- number of grids in x direction [-] + INTEGER(IntKi) :: HAWC_ny = 0_IntKi !< HAWC -- number of grids in y direction [-] + INTEGER(IntKi) :: HAWC_nz = 0_IntKi !< HAWC -- number of grids in z direction [-] + REAL(ReKi) :: HAWC_dx = 0.0_ReKi !< HAWC -- distance between points in x direction [meters] + REAL(ReKi) :: HAWC_dy = 0.0_ReKi !< HAWC -- distance between points in y direction [meters] + REAL(ReKi) :: HAWC_dz = 0.0_ReKi !< HAWC -- distance between points in z direction [meters] + LOGICAL :: SumPrint = .false. !< Write summary info to a file .IfW.Sum [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - INTEGER(IntKi) :: SensorType !< Sensor type (for lidar/sensor module) [-] - INTEGER(IntKi) :: NumBeam !< Number of lidar beams [-] - INTEGER(IntKi) :: NumPulseGate !< The number of range gates to return wind speeds at [-] - REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos !< Position of the lidar unit relative to the rotor apex of rotation [m] + INTEGER(IntKi) :: SensorType = 0_IntKi !< Sensor type (for lidar/sensor module) [-] + INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of lidar beams [-] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< The number of range gates to return wind speeds at [-] + REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos = 0.0_ReKi !< Position of the lidar unit relative to the rotor apex of rotation [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceX !< LIDAR LOS focal distance co-ordinates in the x direction [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceY !< LIDAR LOS focal distance co-ordinates in the y direction [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceZ !< LIDAR LOS focal distance co-ordinates in the z direction [m] - REAL(ReKi) :: PulseSpacing !< Distance between range gates [m] - REAL(ReKi) :: MeasurementInterval !< Time between each measurement [s] - REAL(ReKi) :: URefLid !< Reference average wind speed for the lidar [m/s] - LOGICAL :: LidRadialVel !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] - INTEGER(IntKi) :: ConsiderHubMotion !< Flag whether or not the hub motion's impact on the Lidar measurement will be considered [0 for no, 1 for yes] [-] + REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [m] + REAL(ReKi) :: MeasurementInterval = 0.0_ReKi !< Time between each measurement [s] + REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] + LOGICAL :: LidRadialVel = .false. !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] + INTEGER(IntKi) :: ConsiderHubMotion = 0_IntKi !< Flag whether or not the hub motion's impact on the Lidar measurement will be considered [0 for no, 1 for yes] [-] TYPE(Grid3D_InitInputType) :: FF !< scaling data [-] END TYPE InflowWind_InputFile ! ======================= @@ -103,7 +103,7 @@ MODULE InflowWind_Types CHARACTER(1024) :: InputFileName !< Name of the InflowWind input file to use [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] LOGICAL :: Use4Dext = .FALSE. !< Flag that tells this module if an external module will pass it 4-D velocity grids. [-] - INTEGER(IntKi) :: NumWindPoints !< Number of wind velocity points expected [-] + INTEGER(IntKi) :: NumWindPoints = 0_IntKi !< Number of wind velocity points expected [-] INTEGER(IntKi) :: TurbineID = 0 !< Wind turbine ID number in the fixed (DEFAULT) file name when FixedWindFileRootName = .TRUE. (used by FAST.Farm) [-] LOGICAL :: FixedWindFileRootName = .FALSE. !< Do the wind data files have a fixed (DEFAULT) file name? (used by FAST.Farm) [-] LOGICAL :: UseInputFile = .TRUE. !< Should we read everthing from an input file, or do we get it some other way [-] @@ -114,10 +114,10 @@ MODULE InflowWind_Types LOGICAL :: OutputAccel = .FALSE. !< Flag to output wind acceleration [-] TYPE(Lidar_InitInputType) :: lidar !< InitInput for lidar data [-] TYPE(Grid4D_InitInputType) :: FDext !< InitInput for 4D external wind data [-] - REAL(ReKi) :: RadAvg !< Radius (from hub) used for averaging wind speed [-] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] - REAL(ReKi) :: MSL2SWL !< Mean sea level to still water level [m] + REAL(ReKi) :: RadAvg = 0.0_ReKi !< Radius (from hub) used for averaging wind speed [-] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean sea level to still water level [m] INTEGER(IntKi) :: BoxExceedAllowIdx = -1 !< Extrapolate winds outside box starting at this index (for OLAF wakes and LidarSim) [-] LOGICAL :: BoxExceedAllowF = .FALSE. !< Flag to allow Extrapolation winds outside box starting at this index (for OLAF wakes and LidarSim) [-] END TYPE InflowWind_InitInputType @@ -139,12 +139,12 @@ MODULE InflowWind_Types ! ========= InflowWind_ParameterType ======= TYPE, PUBLIC :: InflowWind_ParameterType CHARACTER(1024) :: RootFileName !< Root of the InflowWind input filename [-] - REAL(DbKi) :: DT !< Time step for cont. state integration & disc. state update [seconds] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for cont. state integration & disc. state update [seconds] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindViXYZprime !< List of XYZ coordinates for velocity measurements, translated to the wind coordinate system (prime coordinates). This equals MATMUL( RotToWind, ParamData%WindViXYZ ) [meters] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindViXYZ !< List of XYZ coordinates for wind velocity measurements, 3xNWindVel [meters] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Flow field data to represent all wind types [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PositionAvg !< (non-rotated) positions of points used for averaging wind speed [meters] - INTEGER(IntKi) :: NWindVel !< Number of points in the wind velocity list [-] + INTEGER(IntKi) :: NWindVel = 0_IntKi !< Number of points in the wind velocity list [-] INTEGER(IntKi) :: NumOuts = 0 !< Number of parameters in the output list (number of outputs requested) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutParamLinIndx !< Index into WriteOutput for WindViXYZ in linearization analysis [-] @@ -156,8 +156,8 @@ MODULE InflowWind_Types TYPE, PUBLIC :: InflowWind_InputType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PositionXYZ !< Array holding the input positions at a given timestep [meters] TYPE(Lidar_InputType) :: lidar !< Lidar data [-] - REAL(ReKi) , DIMENSION(1:3) :: HubPosition !< position of the hub (inertial frame) [m] - REAL(ReKi) , DIMENSION(1:3,1:3) :: HubOrientation !< orientation of the hub (direction cosine matrix) [-] + REAL(ReKi) , DIMENSION(1:3) :: HubPosition = 0.0_ReKi !< position of the hub (inertial frame) [m] + REAL(ReKi) , DIMENSION(1:3,1:3) :: HubOrientation = 0.0_ReKi !< orientation of the hub (direction cosine matrix) [-] END TYPE InflowWind_InputType ! ======================= ! ========= InflowWind_OutputType ======= @@ -165,29 +165,29 @@ MODULE InflowWind_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: VelocityUVW !< Array holding the U,V,W velocity for a given timestep [meters/sec] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AccelUVW !< Array holding the U,V,W acceleration for a given timestep [meters/sec] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Array with values to output to file [-] - REAL(ReKi) , DIMENSION(1:3) :: DiskVel !< Vector holding the U,V,W average velocity of the disk [meters/sec] - REAL(ReKi) , DIMENSION(1:3) :: HubVel !< Vector holding the U,V,W velocity at the hub [meters/sec] + REAL(ReKi) , DIMENSION(1:3) :: DiskVel = 0.0_ReKi !< Vector holding the U,V,W average velocity of the disk [meters/sec] + REAL(ReKi) , DIMENSION(1:3) :: HubVel = 0.0_ReKi !< Vector holding the U,V,W velocity at the hub [meters/sec] TYPE(Lidar_OutputType) :: lidar !< Lidar data [-] END TYPE InflowWind_OutputType ! ======================= ! ========= InflowWind_ContinuousStateType ======= TYPE, PUBLIC :: InflowWind_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: DummyContState = 0.0_ReKi !< Remove this variable if you have continuous states [-] END TYPE InflowWind_ContinuousStateType ! ======================= ! ========= InflowWind_DiscreteStateType ======= TYPE, PUBLIC :: InflowWind_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE InflowWind_DiscreteStateType ! ======================= ! ========= InflowWind_ConstraintStateType ======= TYPE, PUBLIC :: InflowWind_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE InflowWind_ConstraintStateType ! ======================= ! ========= InflowWind_OtherStateType ======= TYPE, PUBLIC :: InflowWind_OtherStateType - REAL(ReKi) :: DummyOtherState !< Remove this variable if you have other states [-] + REAL(ReKi) :: DummyOtherState = 0.0_ReKi !< Remove this variable if you have other states [-] END TYPE InflowWind_OtherStateType ! ======================= ! ========= InflowWind_MiscVarType ======= @@ -202,4908 +202,1848 @@ MODULE InflowWind_Types END TYPE InflowWind_MiscVarType ! ======================= CONTAINS - SUBROUTINE InflowWind_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(InflowWind_InputFile), INTENT(INOUT) :: DstInputFileData - 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 = 'InflowWind_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag - DstInputFileData%WindType = SrcInputFileData%WindType - DstInputFileData%PropagationDir = SrcInputFileData%PropagationDir - DstInputFileData%VFlowAngle = SrcInputFileData%VFlowAngle - DstInputFileData%VelInterpCubic = SrcInputFileData%VelInterpCubic - DstInputFileData%NWindVel = SrcInputFileData%NWindVel -IF (ALLOCATED(SrcInputFileData%WindVxiList)) THEN - i1_l = LBOUND(SrcInputFileData%WindVxiList,1) - i1_u = UBOUND(SrcInputFileData%WindVxiList,1) - IF (.NOT. ALLOCATED(DstInputFileData%WindVxiList)) THEN - ALLOCATE(DstInputFileData%WindVxiList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVxiList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WindVxiList = SrcInputFileData%WindVxiList -ENDIF -IF (ALLOCATED(SrcInputFileData%WindVyiList)) THEN - i1_l = LBOUND(SrcInputFileData%WindVyiList,1) - i1_u = UBOUND(SrcInputFileData%WindVyiList,1) - IF (.NOT. ALLOCATED(DstInputFileData%WindVyiList)) THEN - ALLOCATE(DstInputFileData%WindVyiList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVyiList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WindVyiList = SrcInputFileData%WindVyiList -ENDIF -IF (ALLOCATED(SrcInputFileData%WindVziList)) THEN - i1_l = LBOUND(SrcInputFileData%WindVziList,1) - i1_u = UBOUND(SrcInputFileData%WindVziList,1) - IF (.NOT. ALLOCATED(DstInputFileData%WindVziList)) THEN - ALLOCATE(DstInputFileData%WindVziList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVziList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WindVziList = SrcInputFileData%WindVziList -ENDIF - DstInputFileData%Steady_HWindSpeed = SrcInputFileData%Steady_HWindSpeed - DstInputFileData%Steady_RefHt = SrcInputFileData%Steady_RefHt - DstInputFileData%Steady_PLexp = SrcInputFileData%Steady_PLexp - DstInputFileData%Uniform_FileName = SrcInputFileData%Uniform_FileName - DstInputFileData%Uniform_RefHt = SrcInputFileData%Uniform_RefHt - DstInputFileData%Uniform_RefLength = SrcInputFileData%Uniform_RefLength - DstInputFileData%TSFF_FileName = SrcInputFileData%TSFF_FileName - DstInputFileData%BladedFF_FileName = SrcInputFileData%BladedFF_FileName - DstInputFileData%BladedFF_TowerFile = SrcInputFileData%BladedFF_TowerFile - DstInputFileData%CTTS_CoherentTurb = SrcInputFileData%CTTS_CoherentTurb - DstInputFileData%CTTS_FileName = SrcInputFileData%CTTS_FileName - DstInputFileData%CTTS_Path = SrcInputFileData%CTTS_Path - DstInputFileData%HAWC_FileName_u = SrcInputFileData%HAWC_FileName_u - DstInputFileData%HAWC_FileName_v = SrcInputFileData%HAWC_FileName_v - DstInputFileData%HAWC_FileName_w = SrcInputFileData%HAWC_FileName_w - DstInputFileData%HAWC_nx = SrcInputFileData%HAWC_nx - DstInputFileData%HAWC_ny = SrcInputFileData%HAWC_ny - DstInputFileData%HAWC_nz = SrcInputFileData%HAWC_nz - DstInputFileData%HAWC_dx = SrcInputFileData%HAWC_dx - DstInputFileData%HAWC_dy = SrcInputFileData%HAWC_dy - DstInputFileData%HAWC_dz = SrcInputFileData%HAWC_dz - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%SensorType = SrcInputFileData%SensorType - DstInputFileData%NumBeam = SrcInputFileData%NumBeam - DstInputFileData%NumPulseGate = SrcInputFileData%NumPulseGate - DstInputFileData%RotorApexOffsetPos = SrcInputFileData%RotorApexOffsetPos -IF (ALLOCATED(SrcInputFileData%FocalDistanceX)) THEN - i1_l = LBOUND(SrcInputFileData%FocalDistanceX,1) - i1_u = UBOUND(SrcInputFileData%FocalDistanceX,1) - IF (.NOT. ALLOCATED(DstInputFileData%FocalDistanceX)) THEN - ALLOCATE(DstInputFileData%FocalDistanceX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%FocalDistanceX = SrcInputFileData%FocalDistanceX -ENDIF -IF (ALLOCATED(SrcInputFileData%FocalDistanceY)) THEN - i1_l = LBOUND(SrcInputFileData%FocalDistanceY,1) - i1_u = UBOUND(SrcInputFileData%FocalDistanceY,1) - IF (.NOT. ALLOCATED(DstInputFileData%FocalDistanceY)) THEN - ALLOCATE(DstInputFileData%FocalDistanceY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%FocalDistanceY = SrcInputFileData%FocalDistanceY -ENDIF -IF (ALLOCATED(SrcInputFileData%FocalDistanceZ)) THEN - i1_l = LBOUND(SrcInputFileData%FocalDistanceZ,1) - i1_u = UBOUND(SrcInputFileData%FocalDistanceZ,1) - IF (.NOT. ALLOCATED(DstInputFileData%FocalDistanceZ)) THEN - ALLOCATE(DstInputFileData%FocalDistanceZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%FocalDistanceZ = SrcInputFileData%FocalDistanceZ -ENDIF - DstInputFileData%PulseSpacing = SrcInputFileData%PulseSpacing - DstInputFileData%MeasurementInterval = SrcInputFileData%MeasurementInterval - DstInputFileData%URefLid = SrcInputFileData%URefLid - DstInputFileData%LidRadialVel = SrcInputFileData%LidRadialVel - DstInputFileData%ConsiderHubMotion = SrcInputFileData%ConsiderHubMotion - CALL InflowWind_IO_Copygrid3d_initinputtype( SrcInputFileData%FF, DstInputFileData%FF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE InflowWind_CopyInputFile - - SUBROUTINE InflowWind_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(InflowWind_InputFile), INTENT(INOUT) :: InputFileData - 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 = 'InflowWind_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%WindVxiList)) THEN - DEALLOCATE(InputFileData%WindVxiList) -ENDIF -IF (ALLOCATED(InputFileData%WindVyiList)) THEN - DEALLOCATE(InputFileData%WindVyiList) -ENDIF -IF (ALLOCATED(InputFileData%WindVziList)) THEN - DEALLOCATE(InputFileData%WindVziList) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF -IF (ALLOCATED(InputFileData%FocalDistanceX)) THEN - DEALLOCATE(InputFileData%FocalDistanceX) -ENDIF -IF (ALLOCATED(InputFileData%FocalDistanceY)) THEN - DEALLOCATE(InputFileData%FocalDistanceY) -ENDIF -IF (ALLOCATED(InputFileData%FocalDistanceZ)) THEN - DEALLOCATE(InputFileData%FocalDistanceZ) -ENDIF - CALL InflowWind_IO_DestroyGrid3D_InitInputType( InputFileData%FF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyInputFile - - SUBROUTINE InflowWind_PackInputFile( 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(InflowWind_InputFile), 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 = 'InflowWind_PackInputFile' - ! 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 ! EchoFlag - Int_BufSz = Int_BufSz + 1 ! WindType - Re_BufSz = Re_BufSz + 1 ! PropagationDir - Re_BufSz = Re_BufSz + 1 ! VFlowAngle - Int_BufSz = Int_BufSz + 1 ! VelInterpCubic - Int_BufSz = Int_BufSz + 1 ! NWindVel - Int_BufSz = Int_BufSz + 1 ! WindVxiList allocated yes/no - IF ( ALLOCATED(InData%WindVxiList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVxiList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVxiList) ! WindVxiList - END IF - Int_BufSz = Int_BufSz + 1 ! WindVyiList allocated yes/no - IF ( ALLOCATED(InData%WindVyiList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVyiList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVyiList) ! WindVyiList - END IF - Int_BufSz = Int_BufSz + 1 ! WindVziList allocated yes/no - IF ( ALLOCATED(InData%WindVziList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVziList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVziList) ! WindVziList - END IF - Re_BufSz = Re_BufSz + 1 ! Steady_HWindSpeed - Re_BufSz = Re_BufSz + 1 ! Steady_RefHt - Re_BufSz = Re_BufSz + 1 ! Steady_PLexp - Int_BufSz = Int_BufSz + 1*LEN(InData%Uniform_FileName) ! Uniform_FileName - Re_BufSz = Re_BufSz + 1 ! Uniform_RefHt - Re_BufSz = Re_BufSz + 1 ! Uniform_RefLength - Int_BufSz = Int_BufSz + 1*LEN(InData%TSFF_FileName) ! TSFF_FileName - Int_BufSz = Int_BufSz + 1*LEN(InData%BladedFF_FileName) ! BladedFF_FileName - Int_BufSz = Int_BufSz + 1 ! BladedFF_TowerFile - Int_BufSz = Int_BufSz + 1 ! CTTS_CoherentTurb - Int_BufSz = Int_BufSz + 1*LEN(InData%CTTS_FileName) ! CTTS_FileName - Int_BufSz = Int_BufSz + 1*LEN(InData%CTTS_Path) ! CTTS_Path - Int_BufSz = Int_BufSz + 1*LEN(InData%HAWC_FileName_u) ! HAWC_FileName_u - Int_BufSz = Int_BufSz + 1*LEN(InData%HAWC_FileName_v) ! HAWC_FileName_v - Int_BufSz = Int_BufSz + 1*LEN(InData%HAWC_FileName_w) ! HAWC_FileName_w - Int_BufSz = Int_BufSz + 1 ! HAWC_nx - Int_BufSz = Int_BufSz + 1 ! HAWC_ny - Int_BufSz = Int_BufSz + 1 ! HAWC_nz - Re_BufSz = Re_BufSz + 1 ! HAWC_dx - Re_BufSz = Re_BufSz + 1 ! HAWC_dy - Re_BufSz = Re_BufSz + 1 ! HAWC_dz - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! NumBeam - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Re_BufSz = Re_BufSz + SIZE(InData%RotorApexOffsetPos) ! RotorApexOffsetPos - Int_BufSz = Int_BufSz + 1 ! FocalDistanceX allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceX) ! FocalDistanceX - END IF - Int_BufSz = Int_BufSz + 1 ! FocalDistanceY allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceY) ! FocalDistanceY - END IF - Int_BufSz = Int_BufSz + 1 ! FocalDistanceZ allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceZ) ! FocalDistanceZ - END IF - Re_BufSz = Re_BufSz + 1 ! PulseSpacing - Re_BufSz = Re_BufSz + 1 ! MeasurementInterval - Re_BufSz = Re_BufSz + 1 ! URefLid - Int_BufSz = Int_BufSz + 1 ! LidRadialVel - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FF - 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 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%EchoFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WindType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PropagationDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VFlowAngle - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%VelInterpCubic, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWindVel - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WindVxiList) ) 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%WindVxiList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVxiList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WindVxiList,1), UBOUND(InData%WindVxiList,1) - ReKiBuf(Re_Xferred) = InData%WindVxiList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindVyiList) ) 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%WindVyiList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVyiList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WindVyiList,1), UBOUND(InData%WindVyiList,1) - ReKiBuf(Re_Xferred) = InData%WindVyiList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindVziList) ) 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%WindVziList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVziList,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WindVziList,1), UBOUND(InData%WindVziList,1) - ReKiBuf(Re_Xferred) = InData%WindVziList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Steady_HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Steady_RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Steady_PLexp - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%Uniform_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%Uniform_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%Uniform_RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Uniform_RefLength - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%TSFF_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%TSFF_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%BladedFF_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%BladedFF_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%BladedFF_TowerFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CTTS_CoherentTurb, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%CTTS_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%CTTS_Path) - IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_Path(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_u(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_v) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_v(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_w) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_w(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%HAWC_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%HAWC_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%HAWC_nz - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HAWC_dx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HAWC_dy - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HAWC_dz - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) 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%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - 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 - END IF - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBeam - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) - ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%FocalDistanceX) ) 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%FocalDistanceX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceX,1), UBOUND(InData%FocalDistanceX,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FocalDistanceY) ) 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%FocalDistanceY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceY,1), UBOUND(InData%FocalDistanceY,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FocalDistanceZ) ) 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%FocalDistanceZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceZ,1), UBOUND(InData%FocalDistanceZ,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PulseSpacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MeasurementInterval - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%URefLid - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) - 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 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 InflowWind_PackInputFile - - SUBROUTINE InflowWind_UnPackInputFile( 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(InflowWind_InputFile), 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 = 'InflowWind_UnPackInputFile' - ! 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%EchoFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%EchoFlag) - Int_Xferred = Int_Xferred + 1 - OutData%WindType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PropagationDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VFlowAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelInterpCubic = TRANSFER(IntKiBuf(Int_Xferred), OutData%VelInterpCubic) - Int_Xferred = Int_Xferred + 1 - OutData%NWindVel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVxiList 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%WindVxiList)) DEALLOCATE(OutData%WindVxiList) - ALLOCATE(OutData%WindVxiList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVxiList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVxiList,1), UBOUND(OutData%WindVxiList,1) - OutData%WindVxiList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVyiList 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%WindVyiList)) DEALLOCATE(OutData%WindVyiList) - ALLOCATE(OutData%WindVyiList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVyiList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVyiList,1), UBOUND(OutData%WindVyiList,1) - OutData%WindVyiList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVziList 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%WindVziList)) DEALLOCATE(OutData%WindVziList) - ALLOCATE(OutData%WindVziList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVziList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVziList,1), UBOUND(OutData%WindVziList,1) - OutData%WindVziList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Steady_HWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Steady_RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Steady_PLexp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%Uniform_FileName) - OutData%Uniform_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Uniform_RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Uniform_RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%TSFF_FileName) - OutData%TSFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%BladedFF_FileName) - OutData%BladedFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%BladedFF_TowerFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%BladedFF_TowerFile) - Int_Xferred = Int_Xferred + 1 - OutData%CTTS_CoherentTurb = TRANSFER(IntKiBuf(Int_Xferred), OutData%CTTS_CoherentTurb) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%CTTS_FileName) - OutData%CTTS_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%CTTS_Path) - OutData%CTTS_Path(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_u) - OutData%HAWC_FileName_u(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_v) - OutData%HAWC_FileName_v(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_w) - OutData%HAWC_FileName_w(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%HAWC_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_nz = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_dx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_dy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_dz = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBeam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RotorApexOffsetPos,1) - i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) - OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceX 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%FocalDistanceX)) DEALLOCATE(OutData%FocalDistanceX) - ALLOCATE(OutData%FocalDistanceX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceX,1), UBOUND(OutData%FocalDistanceX,1) - OutData%FocalDistanceX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceY 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%FocalDistanceY)) DEALLOCATE(OutData%FocalDistanceY) - ALLOCATE(OutData%FocalDistanceY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceY,1), UBOUND(OutData%FocalDistanceY,1) - OutData%FocalDistanceY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceZ 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%FocalDistanceZ)) DEALLOCATE(OutData%FocalDistanceZ) - ALLOCATE(OutData%FocalDistanceZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceZ,1), UBOUND(OutData%FocalDistanceZ,1) - OutData%FocalDistanceZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%PulseSpacing = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MeasurementInterval = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%URefLid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) - Int_Xferred = Int_Xferred + 1 - OutData%ConsiderHubMotion = 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE InflowWind_UnPackInputFile - - SUBROUTINE InflowWind_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(InflowWind_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_CopyInitInput' -! +subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_InputFile), intent(in) :: SrcInputFileData + type(InflowWind_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFileName = SrcInitInputData%InputFileName - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%Use4Dext = SrcInitInputData%Use4Dext - DstInitInputData%NumWindPoints = SrcInitInputData%NumWindPoints - DstInitInputData%TurbineID = SrcInitInputData%TurbineID - DstInitInputData%FixedWindFileRootName = SrcInitInputData%FixedWindFileRootName - DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile - DstInitInputData%RootName = SrcInitInputData%RootName - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%WindType2UseInputFile = SrcInitInputData%WindType2UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%WindType2Data, DstInitInputData%WindType2Data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%OutputAccel = SrcInitInputData%OutputAccel - CALL Lidar_CopyInitInput( SrcInitInputData%lidar, DstInitInputData%lidar, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_IO_Copygrid4d_initinputtype( SrcInitInputData%FDext, DstInitInputData%FDext, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%RadAvg = SrcInitInputData%RadAvg - DstInitInputData%MHK = SrcInitInputData%MHK - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%BoxExceedAllowIdx = SrcInitInputData%BoxExceedAllowIdx - DstInitInputData%BoxExceedAllowF = SrcInitInputData%BoxExceedAllowF - END SUBROUTINE InflowWind_CopyInitInput - - SUBROUTINE InflowWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(InflowWind_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 = 'InflowWind_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyFileInfoType( InitInputData%WindType2Data, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Lidar_DestroyInitInput( InitInputData%lidar, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_IO_DestroyGrid4D_InitInputType( InitInputData%FDext, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyInitInput - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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%InputFileName) ! InputFileName - Int_BufSz = Int_BufSz + 1 ! Linearize - Int_BufSz = Int_BufSz + 1 ! Use4Dext - Int_BufSz = Int_BufSz + 1 ! NumWindPoints - Int_BufSz = Int_BufSz + 1 ! TurbineID - Int_BufSz = Int_BufSz + 1 ! FixedWindFileRootName - Int_BufSz = Int_BufSz + 1 ! UseInputFile - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WindType2Data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WindType2Data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WindType2Data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! OutputAccel - Int_BufSz = Int_BufSz + 3 ! lidar: size of buffers for each call to pack subtype - CALL Lidar_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, .TRUE. ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! lidar - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! lidar - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! lidar - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FDext - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FDext - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FDext - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! RadAvg - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! BoxExceedAllowIdx - Int_BufSz = Int_BufSz + 1 ! BoxExceedAllowF - 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%InputFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Use4Dext, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumWindPoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TurbineID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FixedWindFileRootName, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - 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 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) = 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 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) = TRANSFER(InData%OutputAccel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL Lidar_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar - 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 - 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 - - 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%RadAvg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BoxExceedAllowIdx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%BoxExceedAllowF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_PackInitInput - - SUBROUTINE InflowWind_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(InflowWind_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_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%InputFileName) - OutData%InputFileName(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%Use4Dext = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use4Dext) - Int_Xferred = Int_Xferred + 1 - OutData%NumWindPoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FixedWindFileRootName = TRANSFER(IntKiBuf(Int_Xferred), OutData%FixedWindFileRootName) - Int_Xferred = Int_Xferred + 1 - OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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) - OutData%WindType2UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WindType2UseInputFile) - 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%WindType2Data, ErrStat2, ErrMsg2 ) ! WindType2Data - 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%OutputAccel = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutputAccel) - 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 Lidar_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%lidar, ErrStat2, ErrMsg2 ) ! lidar - 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) - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%RadAvg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BoxExceedAllowIdx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BoxExceedAllowF = TRANSFER(IntKiBuf(Int_Xferred), OutData%BoxExceedAllowF) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_UnPackInitInput - - SUBROUTINE InflowWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(InflowWind_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 = 'InflowWind_CopyInitOutput' -! + ErrMsg = '' + DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag + DstInputFileData%WindType = SrcInputFileData%WindType + DstInputFileData%PropagationDir = SrcInputFileData%PropagationDir + DstInputFileData%VFlowAngle = SrcInputFileData%VFlowAngle + DstInputFileData%VelInterpCubic = SrcInputFileData%VelInterpCubic + DstInputFileData%NWindVel = SrcInputFileData%NWindVel + if (allocated(SrcInputFileData%WindVxiList)) then + LB(1:1) = lbound(SrcInputFileData%WindVxiList) + UB(1:1) = ubound(SrcInputFileData%WindVxiList) + if (.not. allocated(DstInputFileData%WindVxiList)) then + allocate(DstInputFileData%WindVxiList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVxiList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WindVxiList = SrcInputFileData%WindVxiList + end if + if (allocated(SrcInputFileData%WindVyiList)) then + LB(1:1) = lbound(SrcInputFileData%WindVyiList) + UB(1:1) = ubound(SrcInputFileData%WindVyiList) + if (.not. allocated(DstInputFileData%WindVyiList)) then + allocate(DstInputFileData%WindVyiList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVyiList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WindVyiList = SrcInputFileData%WindVyiList + end if + if (allocated(SrcInputFileData%WindVziList)) then + LB(1:1) = lbound(SrcInputFileData%WindVziList) + UB(1:1) = ubound(SrcInputFileData%WindVziList) + if (.not. allocated(DstInputFileData%WindVziList)) then + allocate(DstInputFileData%WindVziList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVziList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WindVziList = SrcInputFileData%WindVziList + end if + DstInputFileData%Steady_HWindSpeed = SrcInputFileData%Steady_HWindSpeed + DstInputFileData%Steady_RefHt = SrcInputFileData%Steady_RefHt + DstInputFileData%Steady_PLexp = SrcInputFileData%Steady_PLexp + DstInputFileData%Uniform_FileName = SrcInputFileData%Uniform_FileName + DstInputFileData%Uniform_RefHt = SrcInputFileData%Uniform_RefHt + DstInputFileData%Uniform_RefLength = SrcInputFileData%Uniform_RefLength + DstInputFileData%TSFF_FileName = SrcInputFileData%TSFF_FileName + DstInputFileData%BladedFF_FileName = SrcInputFileData%BladedFF_FileName + DstInputFileData%BladedFF_TowerFile = SrcInputFileData%BladedFF_TowerFile + DstInputFileData%CTTS_CoherentTurb = SrcInputFileData%CTTS_CoherentTurb + DstInputFileData%CTTS_FileName = SrcInputFileData%CTTS_FileName + DstInputFileData%CTTS_Path = SrcInputFileData%CTTS_Path + DstInputFileData%HAWC_FileName_u = SrcInputFileData%HAWC_FileName_u + DstInputFileData%HAWC_FileName_v = SrcInputFileData%HAWC_FileName_v + DstInputFileData%HAWC_FileName_w = SrcInputFileData%HAWC_FileName_w + DstInputFileData%HAWC_nx = SrcInputFileData%HAWC_nx + DstInputFileData%HAWC_ny = SrcInputFileData%HAWC_ny + DstInputFileData%HAWC_nz = SrcInputFileData%HAWC_nz + DstInputFileData%HAWC_dx = SrcInputFileData%HAWC_dx + DstInputFileData%HAWC_dy = SrcInputFileData%HAWC_dy + DstInputFileData%HAWC_dz = SrcInputFileData%HAWC_dz + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + end if + DstInputFileData%SensorType = SrcInputFileData%SensorType + DstInputFileData%NumBeam = SrcInputFileData%NumBeam + DstInputFileData%NumPulseGate = SrcInputFileData%NumPulseGate + DstInputFileData%RotorApexOffsetPos = SrcInputFileData%RotorApexOffsetPos + if (allocated(SrcInputFileData%FocalDistanceX)) then + LB(1:1) = lbound(SrcInputFileData%FocalDistanceX) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceX) + if (.not. allocated(DstInputFileData%FocalDistanceX)) then + allocate(DstInputFileData%FocalDistanceX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%FocalDistanceX = SrcInputFileData%FocalDistanceX + end if + if (allocated(SrcInputFileData%FocalDistanceY)) then + LB(1:1) = lbound(SrcInputFileData%FocalDistanceY) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceY) + if (.not. allocated(DstInputFileData%FocalDistanceY)) then + allocate(DstInputFileData%FocalDistanceY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%FocalDistanceY = SrcInputFileData%FocalDistanceY + end if + if (allocated(SrcInputFileData%FocalDistanceZ)) then + LB(1:1) = lbound(SrcInputFileData%FocalDistanceZ) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceZ) + if (.not. allocated(DstInputFileData%FocalDistanceZ)) then + allocate(DstInputFileData%FocalDistanceZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%FocalDistanceZ = SrcInputFileData%FocalDistanceZ + end if + DstInputFileData%PulseSpacing = SrcInputFileData%PulseSpacing + DstInputFileData%MeasurementInterval = SrcInputFileData%MeasurementInterval + DstInputFileData%URefLid = SrcInputFileData%URefLid + DstInputFileData%LidRadialVel = SrcInputFileData%LidRadialVel + DstInputFileData%ConsiderHubMotion = SrcInputFileData%ConsiderHubMotion + call InflowWind_IO_CopyGrid3D_InitInputType(SrcInputFileData%FF, DstInputFileData%FF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine InflowWind_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(InflowWind_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyInputFile' 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 - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_IO_Copywindfiledat( SrcInitOutputData%WindFileInfo, DstInitOutputData%WindFileInfo, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF - DstInitOutputData%FlowField => SrcInitOutputData%FlowField - END SUBROUTINE InflowWind_CopyInitOutput - - SUBROUTINE InflowWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(InflowWind_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 = 'InflowWind_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF -NULLIFY(InitOutputData%FlowField) - END SUBROUTINE InflowWind_DestroyInitOutput - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WindFileInfo - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WindFileInfo - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WindFileInfo - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - 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 - 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 - - 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) 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%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) 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%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) 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%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) 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%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) 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%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE InflowWind_PackInitOutput - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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) - 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 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 - - 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 ! LinNames_y 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%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(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 ! LinNames_u 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%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(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 ! RotFrame_y 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%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u 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%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u 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%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - NULLIFY(OutData%FlowField) - END SUBROUTINE InflowWind_UnPackInitOutput - - SUBROUTINE InflowWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_ParameterType), INTENT(IN) :: SrcParamData - TYPE(InflowWind_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 = 'InflowWind_CopyParam' -! + ErrMsg = '' + if (allocated(InputFileData%WindVxiList)) then + deallocate(InputFileData%WindVxiList) + end if + if (allocated(InputFileData%WindVyiList)) then + deallocate(InputFileData%WindVyiList) + end if + if (allocated(InputFileData%WindVziList)) then + deallocate(InputFileData%WindVziList) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%FocalDistanceX)) then + deallocate(InputFileData%FocalDistanceX) + end if + if (allocated(InputFileData%FocalDistanceY)) then + deallocate(InputFileData%FocalDistanceY) + end if + if (allocated(InputFileData%FocalDistanceZ)) then + deallocate(InputFileData%FocalDistanceZ) + end if + call InflowWind_IO_DestroyGrid3D_InitInputType(InputFileData%FF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine InflowWind_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%EchoFlag) + call RegPack(Buf, InData%WindType) + call RegPack(Buf, InData%PropagationDir) + call RegPack(Buf, InData%VFlowAngle) + call RegPack(Buf, InData%VelInterpCubic) + call RegPack(Buf, InData%NWindVel) + call RegPack(Buf, allocated(InData%WindVxiList)) + if (allocated(InData%WindVxiList)) then + call RegPackBounds(Buf, 1, lbound(InData%WindVxiList), ubound(InData%WindVxiList)) + call RegPack(Buf, InData%WindVxiList) + end if + call RegPack(Buf, allocated(InData%WindVyiList)) + if (allocated(InData%WindVyiList)) then + call RegPackBounds(Buf, 1, lbound(InData%WindVyiList), ubound(InData%WindVyiList)) + call RegPack(Buf, InData%WindVyiList) + end if + call RegPack(Buf, allocated(InData%WindVziList)) + if (allocated(InData%WindVziList)) then + call RegPackBounds(Buf, 1, lbound(InData%WindVziList), ubound(InData%WindVziList)) + call RegPack(Buf, InData%WindVziList) + end if + call RegPack(Buf, InData%Steady_HWindSpeed) + call RegPack(Buf, InData%Steady_RefHt) + call RegPack(Buf, InData%Steady_PLexp) + call RegPack(Buf, InData%Uniform_FileName) + call RegPack(Buf, InData%Uniform_RefHt) + call RegPack(Buf, InData%Uniform_RefLength) + call RegPack(Buf, InData%TSFF_FileName) + call RegPack(Buf, InData%BladedFF_FileName) + call RegPack(Buf, InData%BladedFF_TowerFile) + call RegPack(Buf, InData%CTTS_CoherentTurb) + call RegPack(Buf, InData%CTTS_FileName) + call RegPack(Buf, InData%CTTS_Path) + call RegPack(Buf, InData%HAWC_FileName_u) + call RegPack(Buf, InData%HAWC_FileName_v) + call RegPack(Buf, InData%HAWC_FileName_w) + call RegPack(Buf, InData%HAWC_nx) + call RegPack(Buf, InData%HAWC_ny) + call RegPack(Buf, InData%HAWC_nz) + call RegPack(Buf, InData%HAWC_dx) + call RegPack(Buf, InData%HAWC_dy) + call RegPack(Buf, InData%HAWC_dz) + call RegPack(Buf, InData%SumPrint) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + call RegPack(Buf, InData%SensorType) + call RegPack(Buf, InData%NumBeam) + call RegPack(Buf, InData%NumPulseGate) + call RegPack(Buf, InData%RotorApexOffsetPos) + call RegPack(Buf, allocated(InData%FocalDistanceX)) + if (allocated(InData%FocalDistanceX)) then + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceX), ubound(InData%FocalDistanceX)) + call RegPack(Buf, InData%FocalDistanceX) + end if + call RegPack(Buf, allocated(InData%FocalDistanceY)) + if (allocated(InData%FocalDistanceY)) then + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceY), ubound(InData%FocalDistanceY)) + call RegPack(Buf, InData%FocalDistanceY) + end if + call RegPack(Buf, allocated(InData%FocalDistanceZ)) + if (allocated(InData%FocalDistanceZ)) then + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceZ), ubound(InData%FocalDistanceZ)) + call RegPack(Buf, InData%FocalDistanceZ) + end if + call RegPack(Buf, InData%PulseSpacing) + call RegPack(Buf, InData%MeasurementInterval) + call RegPack(Buf, InData%URefLid) + call RegPack(Buf, InData%LidRadialVel) + call RegPack(Buf, InData%ConsiderHubMotion) + call InflowWind_IO_PackGrid3D_InitInputType(Buf, InData%FF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackInputFile' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%EchoFlag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WindType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PropagationDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VFlowAngle) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VelInterpCubic) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NWindVel) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WindVxiList)) deallocate(OutData%WindVxiList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindVxiList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVxiList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindVxiList) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WindVyiList)) deallocate(OutData%WindVyiList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindVyiList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVyiList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindVyiList) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WindVziList)) deallocate(OutData%WindVziList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindVziList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVziList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindVziList) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Steady_HWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Steady_RefHt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Steady_PLexp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Uniform_FileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Uniform_RefHt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Uniform_RefLength) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TSFF_FileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BladedFF_FileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BladedFF_TowerFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CTTS_CoherentTurb) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CTTS_FileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CTTS_Path) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HAWC_FileName_u) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HAWC_FileName_v) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HAWC_FileName_w) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HAWC_nx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HAWC_ny) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HAWC_nz) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HAWC_dx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HAWC_dy) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HAWC_dz) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBeam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotorApexOffsetPos) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%FocalDistanceX)) deallocate(OutData%FocalDistanceX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FocalDistanceX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FocalDistanceX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FocalDistanceY)) deallocate(OutData%FocalDistanceY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FocalDistanceY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FocalDistanceY) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FocalDistanceZ)) deallocate(OutData%FocalDistanceZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FocalDistanceZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FocalDistanceZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%PulseSpacing) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MeasurementInterval) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LidRadialVel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ConsiderHubMotion) + if (RegCheckErr(Buf, RoutineName)) return + call InflowWind_IO_UnpackGrid3D_InitInputType(Buf, OutData%FF) ! FF +end subroutine + +subroutine InflowWind_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_InitInputType), intent(in) :: SrcInitInputData + type(InflowWind_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%RootFileName = SrcParamData%RootFileName - DstParamData%DT = SrcParamData%DT -IF (ALLOCATED(SrcParamData%WindViXYZprime)) THEN - i1_l = LBOUND(SrcParamData%WindViXYZprime,1) - i1_u = UBOUND(SrcParamData%WindViXYZprime,1) - i2_l = LBOUND(SrcParamData%WindViXYZprime,2) - i2_u = UBOUND(SrcParamData%WindViXYZprime,2) - IF (.NOT. ALLOCATED(DstParamData%WindViXYZprime)) THEN - ALLOCATE(DstParamData%WindViXYZprime(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindViXYZprime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WindViXYZprime = SrcParamData%WindViXYZprime -ENDIF -IF (ALLOCATED(SrcParamData%WindViXYZ)) THEN - i1_l = LBOUND(SrcParamData%WindViXYZ,1) - i1_u = UBOUND(SrcParamData%WindViXYZ,1) - i2_l = LBOUND(SrcParamData%WindViXYZ,2) - i2_u = UBOUND(SrcParamData%WindViXYZ,2) - IF (.NOT. ALLOCATED(DstParamData%WindViXYZ)) THEN - ALLOCATE(DstParamData%WindViXYZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindViXYZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WindViXYZ = SrcParamData%WindViXYZ -ENDIF -IF (ASSOCIATED(SrcParamData%FlowField)) THEN - IF (.NOT. ASSOCIATED(DstParamData%FlowField)) THEN - ALLOCATE(DstParamData%FlowField,STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FlowField.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - CALL IfW_FlowField_Copyflowfieldtype( SrcParamData%FlowField, DstParamData%FlowField, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -ENDIF -IF (ALLOCATED(SrcParamData%PositionAvg)) THEN - i1_l = LBOUND(SrcParamData%PositionAvg,1) - i1_u = UBOUND(SrcParamData%PositionAvg,1) - i2_l = LBOUND(SrcParamData%PositionAvg,2) - i2_u = UBOUND(SrcParamData%PositionAvg,2) - IF (.NOT. ALLOCATED(DstParamData%PositionAvg)) THEN - ALLOCATE(DstParamData%PositionAvg(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PositionAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PositionAvg = SrcParamData%PositionAvg -ENDIF - DstParamData%NWindVel = SrcParamData%NWindVel - DstParamData%NumOuts = SrcParamData%NumOuts -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 -IF (ALLOCATED(SrcParamData%OutParamLinIndx)) THEN - i1_l = LBOUND(SrcParamData%OutParamLinIndx,1) - i1_u = UBOUND(SrcParamData%OutParamLinIndx,1) - i2_l = LBOUND(SrcParamData%OutParamLinIndx,2) - i2_u = UBOUND(SrcParamData%OutParamLinIndx,2) - IF (.NOT. ALLOCATED(DstParamData%OutParamLinIndx)) THEN - ALLOCATE(DstParamData%OutParamLinIndx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx -ENDIF - CALL Lidar_CopyParam( SrcParamData%lidar, DstParamData%lidar, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%OutputAccel = SrcParamData%OutputAccel - END SUBROUTINE InflowWind_CopyParam - - SUBROUTINE InflowWind_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(InflowWind_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 = 'InflowWind_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%WindViXYZprime)) THEN - DEALLOCATE(ParamData%WindViXYZprime) -ENDIF -IF (ALLOCATED(ParamData%WindViXYZ)) THEN - DEALLOCATE(ParamData%WindViXYZ) -ENDIF -IF (ASSOCIATED(ParamData%FlowField)) THEN - IF (ASSOCIATED(ParamData%FlowField)) THEN - CALL IfW_FlowField_DestroyFlowFieldType( ParamData%FlowField, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ENDIF - DEALLOCATE(ParamData%FlowField) - ParamData%FlowField => NULL() -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%OutParamLinIndx)) THEN - DEALLOCATE(ParamData%OutParamLinIndx) -ENDIF - CALL Lidar_DestroyParam( ParamData%lidar, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyParam - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 - Int_BufSz = Int_BufSz + 1*LEN(InData%RootFileName) ! RootFileName - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! WindViXYZprime allocated yes/no - IF ( ALLOCATED(InData%WindViXYZprime) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindViXYZprime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindViXYZprime) ! WindViXYZprime - END IF - Int_BufSz = Int_BufSz + 1 ! WindViXYZ allocated yes/no - IF ( ALLOCATED(InData%WindViXYZ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindViXYZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindViXYZ) ! WindViXYZ - END IF - Int_BufSz = Int_BufSz + 1 ! FlowField allocated yes/no - IF ( ASSOCIATED(InData%FlowField) ) THEN - Int_BufSz = Int_BufSz + 2*0 ! FlowField upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FlowField - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FlowField - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FlowField - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END IF - Int_BufSz = Int_BufSz + 1 ! PositionAvg allocated yes/no - IF ( ALLOCATED(InData%PositionAvg) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PositionAvg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PositionAvg) ! PositionAvg - END IF - Int_BufSz = Int_BufSz + 1 ! NWindVel - Int_BufSz = Int_BufSz + 1 ! NumOuts - 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 - 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 ! OutParamLinIndx allocated yes/no - IF ( ALLOCATED(InData%OutParamLinIndx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OutParamLinIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutParamLinIndx) ! OutParamLinIndx - END IF - Int_BufSz = Int_BufSz + 3 ! lidar: size of buffers for each call to pack subtype - CALL Lidar_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, .TRUE. ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! lidar - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! lidar - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! lidar - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! OutputAccel - 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%RootFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WindViXYZprime) ) 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%WindViXYZprime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZprime,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindViXYZprime,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZprime,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindViXYZprime,2), UBOUND(InData%WindViXYZprime,2) - DO i1 = LBOUND(InData%WindViXYZprime,1), UBOUND(InData%WindViXYZprime,1) - ReKiBuf(Re_Xferred) = InData%WindViXYZprime(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindViXYZ) ) 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%WindViXYZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindViXYZ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindViXYZ,2), UBOUND(InData%WindViXYZ,2) - DO i1 = LBOUND(InData%WindViXYZ,1), UBOUND(InData%WindViXYZ,1) - ReKiBuf(Re_Xferred) = InData%WindViXYZ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%FlowField) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - - 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 - - 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 IF - IF ( .NOT. ALLOCATED(InData%PositionAvg) ) 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%PositionAvg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositionAvg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PositionAvg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositionAvg,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PositionAvg,2), UBOUND(InData%PositionAvg,2) - DO i1 = LBOUND(InData%PositionAvg,1), UBOUND(InData%PositionAvg,1) - ReKiBuf(Re_Xferred) = InData%PositionAvg(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NWindVel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - 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 - IF ( .NOT. ALLOCATED(InData%OutParamLinIndx) ) 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%OutParamLinIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParamLinIndx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OutParamLinIndx,2), UBOUND(InData%OutParamLinIndx,2) - DO i1 = LBOUND(InData%OutParamLinIndx,1), UBOUND(InData%OutParamLinIndx,1) - IntKiBuf(Int_Xferred) = InData%OutParamLinIndx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - CALL Lidar_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar - 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) = TRANSFER(InData%OutputAccel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_PackParam - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 - DO I = 1, LEN(OutData%RootFileName) - OutData%RootFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViXYZprime 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%WindViXYZprime)) DEALLOCATE(OutData%WindViXYZprime) - ALLOCATE(OutData%WindViXYZprime(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZprime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindViXYZprime,2), UBOUND(OutData%WindViXYZprime,2) - DO i1 = LBOUND(OutData%WindViXYZprime,1), UBOUND(OutData%WindViXYZprime,1) - OutData%WindViXYZprime(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViXYZ 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%WindViXYZ)) DEALLOCATE(OutData%WindViXYZ) - ALLOCATE(OutData%WindViXYZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindViXYZ,2), UBOUND(OutData%WindViXYZ,2) - DO i1 = LBOUND(OutData%WindViXYZ,1), UBOUND(OutData%WindViXYZ,1) - OutData%WindViXYZ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlowField not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - IF (ASSOCIATED(OutData%FlowField)) DEALLOCATE(OutData%FlowField) - ALLOCATE(OutData%FlowField,STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', ErrStat, ErrMsg,RoutineName) - RETURN - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PositionAvg 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%PositionAvg)) DEALLOCATE(OutData%PositionAvg) - ALLOCATE(OutData%PositionAvg(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositionAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PositionAvg,2), UBOUND(OutData%PositionAvg,2) - DO i1 = LBOUND(OutData%PositionAvg,1), UBOUND(OutData%PositionAvg,1) - OutData%PositionAvg(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%NWindVel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParamLinIndx 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%OutParamLinIndx)) DEALLOCATE(OutData%OutParamLinIndx) - ALLOCATE(OutData%OutParamLinIndx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OutParamLinIndx,2), UBOUND(OutData%OutParamLinIndx,2) - DO i1 = LBOUND(OutData%OutParamLinIndx,1), UBOUND(OutData%OutParamLinIndx,1) - OutData%OutParamLinIndx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 Lidar_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%lidar, ErrStat2, ErrMsg2 ) ! lidar - 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%OutputAccel = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutputAccel) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_UnPackParam - - SUBROUTINE InflowWind_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_InputType), INTENT(IN) :: SrcInputData - TYPE(InflowWind_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) :: 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_CopyInput' -! + ErrMsg = '' + DstInitInputData%InputFileName = SrcInitInputData%InputFileName + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%Use4Dext = SrcInitInputData%Use4Dext + DstInitInputData%NumWindPoints = SrcInitInputData%NumWindPoints + DstInitInputData%TurbineID = SrcInitInputData%TurbineID + DstInitInputData%FixedWindFileRootName = SrcInitInputData%FixedWindFileRootName + DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile + DstInitInputData%RootName = SrcInitInputData%RootName + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%WindType2UseInputFile = SrcInitInputData%WindType2UseInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%WindType2Data, DstInitInputData%WindType2Data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%OutputAccel = SrcInitInputData%OutputAccel + call Lidar_CopyInitInput(SrcInitInputData%lidar, DstInitInputData%lidar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_IO_CopyGrid4D_InitInputType(SrcInitInputData%FDext, DstInitInputData%FDext, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%RadAvg = SrcInitInputData%RadAvg + DstInitInputData%MHK = SrcInitInputData%MHK + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%BoxExceedAllowIdx = SrcInitInputData%BoxExceedAllowIdx + DstInitInputData%BoxExceedAllowF = SrcInitInputData%BoxExceedAllowF +end subroutine + +subroutine InflowWind_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(InflowWind_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%PositionXYZ)) THEN - i1_l = LBOUND(SrcInputData%PositionXYZ,1) - i1_u = UBOUND(SrcInputData%PositionXYZ,1) - i2_l = LBOUND(SrcInputData%PositionXYZ,2) - i2_u = UBOUND(SrcInputData%PositionXYZ,2) - IF (.NOT. ALLOCATED(DstInputData%PositionXYZ)) THEN - ALLOCATE(DstInputData%PositionXYZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%PositionXYZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%PositionXYZ = SrcInputData%PositionXYZ -ENDIF - CALL Lidar_CopyInput( SrcInputData%lidar, DstInputData%lidar, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInputData%HubPosition = SrcInputData%HubPosition - DstInputData%HubOrientation = SrcInputData%HubOrientation - END SUBROUTINE InflowWind_CopyInput - - SUBROUTINE InflowWind_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(InflowWind_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 = 'InflowWind_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%PositionXYZ)) THEN - DEALLOCATE(InputData%PositionXYZ) -ENDIF - CALL Lidar_DestroyInput( InputData%lidar, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyInput - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 - Int_BufSz = Int_BufSz + 1 ! PositionXYZ allocated yes/no - IF ( ALLOCATED(InData%PositionXYZ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PositionXYZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PositionXYZ) ! PositionXYZ - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! lidar: size of buffers for each call to pack subtype - CALL Lidar_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, .TRUE. ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! lidar - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! lidar - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! lidar - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition - Re_BufSz = Re_BufSz + SIZE(InData%HubOrientation) ! HubOrientation - 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%PositionXYZ) ) 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%PositionXYZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositionXYZ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PositionXYZ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositionXYZ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PositionXYZ,2), UBOUND(InData%PositionXYZ,2) - DO i1 = LBOUND(InData%PositionXYZ,1), UBOUND(InData%PositionXYZ,1) - ReKiBuf(Re_Xferred) = InData%PositionXYZ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - CALL Lidar_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar - 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 - DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) - ReKiBuf(Re_Xferred) = InData%HubPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%HubOrientation,2), UBOUND(InData%HubOrientation,2) - DO i1 = LBOUND(InData%HubOrientation,1), UBOUND(InData%HubOrientation,1) - ReKiBuf(Re_Xferred) = InData%HubOrientation(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE InflowWind_PackInput - - SUBROUTINE InflowWind_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(InflowWind_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) :: 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_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PositionXYZ 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%PositionXYZ)) DEALLOCATE(OutData%PositionXYZ) - ALLOCATE(OutData%PositionXYZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositionXYZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PositionXYZ,2), UBOUND(OutData%PositionXYZ,2) - DO i1 = LBOUND(OutData%PositionXYZ,1), UBOUND(OutData%PositionXYZ,1) - OutData%PositionXYZ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 Lidar_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%lidar, ErrStat2, ErrMsg2 ) ! lidar - 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) - i1_l = LBOUND(OutData%HubPosition,1) - i1_u = UBOUND(OutData%HubPosition,1) - DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) - OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubOrientation,1) - i1_u = UBOUND(OutData%HubOrientation,1) - i2_l = LBOUND(OutData%HubOrientation,2) - i2_u = UBOUND(OutData%HubOrientation,2) - DO i2 = LBOUND(OutData%HubOrientation,2), UBOUND(OutData%HubOrientation,2) - DO i1 = LBOUND(OutData%HubOrientation,1), UBOUND(OutData%HubOrientation,1) - OutData%HubOrientation(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE InflowWind_UnPackInput - - SUBROUTINE InflowWind_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_OutputType), INTENT(IN) :: SrcOutputData - TYPE(InflowWind_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_CopyOutput' -! + ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyFileInfoType(InitInputData%WindType2Data, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Lidar_DestroyInitInput(InitInputData%lidar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_IO_DestroyGrid4D_InitInputType(InitInputData%FDext, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine InflowWind_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFileName) + call RegPack(Buf, InData%Linearize) + call RegPack(Buf, InData%Use4Dext) + call RegPack(Buf, InData%NumWindPoints) + call RegPack(Buf, InData%TurbineID) + call RegPack(Buf, InData%FixedWindFileRootName) + call RegPack(Buf, InData%UseInputFile) + call RegPack(Buf, InData%RootName) + call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) + call RegPack(Buf, InData%WindType2UseInputFile) + call NWTC_Library_PackFileInfoType(Buf, InData%WindType2Data) + call RegPack(Buf, InData%OutputAccel) + call Lidar_PackInitInput(Buf, InData%lidar) + call InflowWind_IO_PackGrid4D_InitInputType(Buf, InData%FDext) + call RegPack(Buf, InData%RadAvg) + call RegPack(Buf, InData%MHK) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%MSL2SWL) + call RegPack(Buf, InData%BoxExceedAllowIdx) + call RegPack(Buf, InData%BoxExceedAllowF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Use4Dext) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumWindPoints) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TurbineID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FixedWindFileRootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData + call RegUnpack(Buf, OutData%WindType2UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(Buf, OutData%WindType2Data) ! WindType2Data + call RegUnpack(Buf, OutData%OutputAccel) + if (RegCheckErr(Buf, RoutineName)) return + call Lidar_UnpackInitInput(Buf, OutData%lidar) ! lidar + call InflowWind_IO_UnpackGrid4D_InitInputType(Buf, OutData%FDext) ! FDext + call RegUnpack(Buf, OutData%RadAvg) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BoxExceedAllowIdx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BoxExceedAllowF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_InitOutputType), intent(in) :: SrcInitOutputData + type(InflowWind_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%VelocityUVW)) THEN - i1_l = LBOUND(SrcOutputData%VelocityUVW,1) - i1_u = UBOUND(SrcOutputData%VelocityUVW,1) - i2_l = LBOUND(SrcOutputData%VelocityUVW,2) - i2_u = UBOUND(SrcOutputData%VelocityUVW,2) - IF (.NOT. ALLOCATED(DstOutputData%VelocityUVW)) THEN - ALLOCATE(DstOutputData%VelocityUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VelocityUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%VelocityUVW = SrcOutputData%VelocityUVW -ENDIF -IF (ALLOCATED(SrcOutputData%AccelUVW)) THEN - i1_l = LBOUND(SrcOutputData%AccelUVW,1) - i1_u = UBOUND(SrcOutputData%AccelUVW,1) - i2_l = LBOUND(SrcOutputData%AccelUVW,2) - i2_u = UBOUND(SrcOutputData%AccelUVW,2) - IF (.NOT. ALLOCATED(DstOutputData%AccelUVW)) THEN - ALLOCATE(DstOutputData%AccelUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AccelUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%AccelUVW = SrcOutputData%AccelUVW -ENDIF -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 - DstOutputData%DiskVel = SrcOutputData%DiskVel - DstOutputData%HubVel = SrcOutputData%HubVel - CALL Lidar_CopyOutput( SrcOutputData%lidar, DstOutputData%lidar, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE InflowWind_CopyOutput - - SUBROUTINE InflowWind_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(InflowWind_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 = 'InflowWind_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%VelocityUVW)) THEN - DEALLOCATE(OutputData%VelocityUVW) -ENDIF -IF (ALLOCATED(OutputData%AccelUVW)) THEN - DEALLOCATE(OutputData%AccelUVW) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - CALL Lidar_DestroyOutput( OutputData%lidar, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyOutput - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 ! VelocityUVW allocated yes/no - IF ( ALLOCATED(InData%VelocityUVW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VelocityUVW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelocityUVW) ! VelocityUVW - END IF - Int_BufSz = Int_BufSz + 1 ! AccelUVW allocated yes/no - IF ( ALLOCATED(InData%AccelUVW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AccelUVW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AccelUVW) ! AccelUVW - END IF - 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 - Re_BufSz = Re_BufSz + SIZE(InData%DiskVel) ! DiskVel - Re_BufSz = Re_BufSz + SIZE(InData%HubVel) ! HubVel - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! lidar: size of buffers for each call to pack subtype - CALL Lidar_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, .TRUE. ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! lidar - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! lidar - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! lidar - 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 - - IF ( .NOT. ALLOCATED(InData%VelocityUVW) ) 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%VelocityUVW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelocityUVW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelocityUVW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelocityUVW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%VelocityUVW,2), UBOUND(InData%VelocityUVW,2) - DO i1 = LBOUND(InData%VelocityUVW,1), UBOUND(InData%VelocityUVW,1) - ReKiBuf(Re_Xferred) = InData%VelocityUVW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AccelUVW) ) 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%AccelUVW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccelUVW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccelUVW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccelUVW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AccelUVW,2), UBOUND(InData%AccelUVW,2) - DO i1 = LBOUND(InData%AccelUVW,1), UBOUND(InData%AccelUVW,1) - ReKiBuf(Re_Xferred) = InData%AccelUVW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - 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 - DO i1 = LBOUND(InData%DiskVel,1), UBOUND(InData%DiskVel,1) - ReKiBuf(Re_Xferred) = InData%DiskVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%HubVel,1), UBOUND(InData%HubVel,1) - ReKiBuf(Re_Xferred) = InData%HubVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - CALL Lidar_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar - 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 InflowWind_PackOutput - - SUBROUTINE InflowWind_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(InflowWind_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_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 ! VelocityUVW 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%VelocityUVW)) DEALLOCATE(OutData%VelocityUVW) - ALLOCATE(OutData%VelocityUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelocityUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%VelocityUVW,2), UBOUND(OutData%VelocityUVW,2) - DO i1 = LBOUND(OutData%VelocityUVW,1), UBOUND(OutData%VelocityUVW,1) - OutData%VelocityUVW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AccelUVW 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%AccelUVW)) DEALLOCATE(OutData%AccelUVW) - ALLOCATE(OutData%AccelUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccelUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AccelUVW,2), UBOUND(OutData%AccelUVW,2) - DO i1 = LBOUND(OutData%AccelUVW,1), UBOUND(OutData%AccelUVW,1) - OutData%AccelUVW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - 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 - i1_l = LBOUND(OutData%DiskVel,1) - i1_u = UBOUND(OutData%DiskVel,1) - DO i1 = LBOUND(OutData%DiskVel,1), UBOUND(OutData%DiskVel,1) - OutData%DiskVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubVel,1) - i1_u = UBOUND(OutData%HubVel,1) - DO i1 = LBOUND(OutData%HubVel,1), UBOUND(OutData%HubVel,1) - OutData%HubVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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 Lidar_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%lidar, ErrStat2, ErrMsg2 ) ! lidar - 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 InflowWind_UnPackOutput - - SUBROUTINE InflowWind_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(InflowWind_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 = 'InflowWind_CopyContState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_IO_CopyWindFileDat(SrcInitOutputData%WindFileInfo, DstInitOutputData%WindFileInfo, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + end if + DstInitOutputData%FlowField => SrcInitOutputData%FlowField +end subroutine + +subroutine InflowWind_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(InflowWind_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE InflowWind_CopyContState - - SUBROUTINE InflowWind_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(InflowWind_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 = 'InflowWind_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_DestroyContState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 InflowWind_PackContState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_UnPackContState - - SUBROUTINE InflowWind_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(InflowWind_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 = 'InflowWind_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + nullify(InitOutputData%FlowField) +end subroutine + +subroutine InflowWind_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackInitOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call InflowWind_IO_PackWindFileDat(Buf, InData%WindFileInfo) + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + call RegPack(Buf, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(Buf, InData%FlowField) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + call InflowWind_IO_UnpackWindFileDat(Buf, OutData%WindFileInfo) ! WindFileInfo + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(Buf, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if +end subroutine + +subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_ParameterType), intent(in) :: SrcParamData + type(InflowWind_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE InflowWind_CopyDiscState - - SUBROUTINE InflowWind_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(InflowWind_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 = 'InflowWind_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_DestroyDiscState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 InflowWind_PackDiscState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_UnPackDiscState - - SUBROUTINE InflowWind_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(InflowWind_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 = 'InflowWind_CopyConstrState' -! + ErrMsg = '' + DstParamData%RootFileName = SrcParamData%RootFileName + DstParamData%DT = SrcParamData%DT + if (allocated(SrcParamData%WindViXYZprime)) then + LB(1:2) = lbound(SrcParamData%WindViXYZprime) + UB(1:2) = ubound(SrcParamData%WindViXYZprime) + if (.not. allocated(DstParamData%WindViXYZprime)) then + allocate(DstParamData%WindViXYZprime(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindViXYZprime.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WindViXYZprime = SrcParamData%WindViXYZprime + end if + if (allocated(SrcParamData%WindViXYZ)) then + LB(1:2) = lbound(SrcParamData%WindViXYZ) + UB(1:2) = ubound(SrcParamData%WindViXYZ) + if (.not. allocated(DstParamData%WindViXYZ)) then + allocate(DstParamData%WindViXYZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindViXYZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WindViXYZ = SrcParamData%WindViXYZ + end if + if (associated(SrcParamData%FlowField)) then + if (.not. associated(DstParamData%FlowField)) then + allocate(DstParamData%FlowField, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FlowField.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call IfW_FlowField_CopyFlowFieldType(SrcParamData%FlowField, DstParamData%FlowField, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + if (allocated(SrcParamData%PositionAvg)) then + LB(1:2) = lbound(SrcParamData%PositionAvg) + UB(1:2) = ubound(SrcParamData%PositionAvg) + if (.not. allocated(DstParamData%PositionAvg)) then + allocate(DstParamData%PositionAvg(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PositionAvg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PositionAvg = SrcParamData%PositionAvg + end if + DstParamData%NWindVel = SrcParamData%NWindVel + DstParamData%NumOuts = SrcParamData%NumOuts + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + if (allocated(SrcParamData%OutParamLinIndx)) then + LB(1:2) = lbound(SrcParamData%OutParamLinIndx) + UB(1:2) = ubound(SrcParamData%OutParamLinIndx) + if (.not. allocated(DstParamData%OutParamLinIndx)) then + allocate(DstParamData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParamLinIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx + end if + call Lidar_CopyParam(SrcParamData%lidar, DstParamData%lidar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%OutputAccel = SrcParamData%OutputAccel +end subroutine + +subroutine InflowWind_DestroyParam(ParamData, ErrStat, ErrMsg) + type(InflowWind_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyParam' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE InflowWind_CopyConstrState - - SUBROUTINE InflowWind_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(InflowWind_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 = 'InflowWind_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_DestroyConstrState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 InflowWind_PackConstrState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_UnPackConstrState - - SUBROUTINE InflowWind_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(InflowWind_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 = 'InflowWind_CopyOtherState' -! + ErrMsg = '' + if (allocated(ParamData%WindViXYZprime)) then + deallocate(ParamData%WindViXYZprime) + end if + if (allocated(ParamData%WindViXYZ)) then + deallocate(ParamData%WindViXYZ) + end if + if (associated(ParamData%FlowField)) then + call IfW_FlowField_DestroyFlowFieldType(ParamData%FlowField, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%FlowField) + ParamData%FlowField => null() + end if + if (allocated(ParamData%PositionAvg)) then + deallocate(ParamData%PositionAvg) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%OutParamLinIndx)) then + deallocate(ParamData%OutParamLinIndx) + end if + call Lidar_DestroyParam(ParamData%lidar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine InflowWind_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%RootFileName) + call RegPack(Buf, InData%DT) + call RegPack(Buf, allocated(InData%WindViXYZprime)) + if (allocated(InData%WindViXYZprime)) then + call RegPackBounds(Buf, 2, lbound(InData%WindViXYZprime), ubound(InData%WindViXYZprime)) + call RegPack(Buf, InData%WindViXYZprime) + end if + call RegPack(Buf, allocated(InData%WindViXYZ)) + if (allocated(InData%WindViXYZ)) then + call RegPackBounds(Buf, 2, lbound(InData%WindViXYZ), ubound(InData%WindViXYZ)) + call RegPack(Buf, InData%WindViXYZ) + end if + call RegPack(Buf, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(Buf, InData%FlowField) + end if + end if + call RegPack(Buf, allocated(InData%PositionAvg)) + if (allocated(InData%PositionAvg)) then + call RegPackBounds(Buf, 2, lbound(InData%PositionAvg), ubound(InData%PositionAvg)) + call RegPack(Buf, InData%PositionAvg) + end if + call RegPack(Buf, InData%NWindVel) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OutParamLinIndx)) + if (allocated(InData%OutParamLinIndx)) then + call RegPackBounds(Buf, 2, lbound(InData%OutParamLinIndx), ubound(InData%OutParamLinIndx)) + call RegPack(Buf, InData%OutParamLinIndx) + end if + call Lidar_PackParam(Buf, InData%lidar) + call RegPack(Buf, InData%OutputAccel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%RootFileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WindViXYZprime)) deallocate(OutData%WindViXYZprime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindViXYZprime(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZprime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindViXYZprime) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WindViXYZ)) deallocate(OutData%WindViXYZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindViXYZ(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindViXYZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(Buf, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if + if (allocated(OutData%PositionAvg)) deallocate(OutData%PositionAvg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PositionAvg(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositionAvg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PositionAvg) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NWindVel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + if (allocated(OutData%OutParamLinIndx)) deallocate(OutData%OutParamLinIndx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutParamLinIndx) + if (RegCheckErr(Buf, RoutineName)) return + end if + call Lidar_UnpackParam(Buf, OutData%lidar) ! lidar + call RegUnpack(Buf, OutData%OutputAccel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_InputType), intent(in) :: SrcInputData + type(InflowWind_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyInput' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE InflowWind_CopyOtherState - - SUBROUTINE InflowWind_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(InflowWind_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 = 'InflowWind_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_DestroyOtherState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 - Re_BufSz = Re_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 - - ReKiBuf(Re_Xferred) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_PackOtherState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_UnPackOtherState - - SUBROUTINE InflowWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(InflowWind_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) :: 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_CopyMisc' -! + ErrMsg = '' + if (allocated(SrcInputData%PositionXYZ)) then + LB(1:2) = lbound(SrcInputData%PositionXYZ) + UB(1:2) = ubound(SrcInputData%PositionXYZ) + if (.not. allocated(DstInputData%PositionXYZ)) then + allocate(DstInputData%PositionXYZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%PositionXYZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%PositionXYZ = SrcInputData%PositionXYZ + end if + call Lidar_CopyInput(SrcInputData%lidar, DstInputData%lidar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputData%HubPosition = SrcInputData%HubPosition + DstInputData%HubOrientation = SrcInputData%HubOrientation +end subroutine + +subroutine InflowWind_DestroyInput(InputData, ErrStat, ErrMsg) + type(InflowWind_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF -IF (ALLOCATED(SrcMiscData%WindViUVW)) THEN - i1_l = LBOUND(SrcMiscData%WindViUVW,1) - i1_u = UBOUND(SrcMiscData%WindViUVW,1) - i2_l = LBOUND(SrcMiscData%WindViUVW,2) - i2_u = UBOUND(SrcMiscData%WindViUVW,2) - IF (.NOT. ALLOCATED(DstMiscData%WindViUVW)) THEN - ALLOCATE(DstMiscData%WindViUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindViUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WindViUVW = SrcMiscData%WindViUVW -ENDIF -IF (ALLOCATED(SrcMiscData%WindAiUVW)) THEN - i1_l = LBOUND(SrcMiscData%WindAiUVW,1) - i1_u = UBOUND(SrcMiscData%WindAiUVW,1) - i2_l = LBOUND(SrcMiscData%WindAiUVW,2) - i2_u = UBOUND(SrcMiscData%WindAiUVW,2) - IF (.NOT. ALLOCATED(DstMiscData%WindAiUVW)) THEN - ALLOCATE(DstMiscData%WindAiUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAiUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WindAiUVW = SrcMiscData%WindAiUVW -ENDIF - CALL InflowWind_CopyInput( SrcMiscData%u_Avg, DstMiscData%u_Avg, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcMiscData%y_Avg, DstMiscData%y_Avg, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcMiscData%u_Hub, DstMiscData%u_Hub, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcMiscData%y_Hub, DstMiscData%y_Hub, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE InflowWind_CopyMisc - - SUBROUTINE InflowWind_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(InflowWind_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 = 'InflowWind_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%WindViUVW)) THEN - DEALLOCATE(MiscData%WindViUVW) -ENDIF -IF (ALLOCATED(MiscData%WindAiUVW)) THEN - DEALLOCATE(MiscData%WindAiUVW) -ENDIF - CALL InflowWind_DestroyInput( MiscData%u_Avg, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( MiscData%y_Avg, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( MiscData%u_Hub, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( MiscData%y_Hub, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyMisc - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Int_BufSz = Int_BufSz + 1 ! WindViUVW allocated yes/no - IF ( ALLOCATED(InData%WindViUVW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindViUVW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindViUVW) ! WindViUVW - END IF - Int_BufSz = Int_BufSz + 1 ! WindAiUVW allocated yes/no - IF ( ALLOCATED(InData%WindAiUVW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindAiUVW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindAiUVW) ! WindAiUVW - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! u_Avg: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_Avg, ErrStat2, ErrMsg2, .TRUE. ) ! u_Avg - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_Avg - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_Avg - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_Avg - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_Avg: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_Avg, ErrStat2, ErrMsg2, .TRUE. ) ! y_Avg - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_Avg - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_Avg - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_Avg - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_Hub: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_Hub, ErrStat2, ErrMsg2, .TRUE. ) ! u_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_Hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_Hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_Hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_Hub: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_Hub, ErrStat2, ErrMsg2, .TRUE. ) ! y_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_Hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_Hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_Hub - 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 - - IF ( .NOT. ALLOCATED(InData%AllOuts) ) 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%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindViUVW) ) 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%WindViUVW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViUVW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindViUVW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViUVW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindViUVW,2), UBOUND(InData%WindViUVW,2) - DO i1 = LBOUND(InData%WindViUVW,1), UBOUND(InData%WindViUVW,1) - ReKiBuf(Re_Xferred) = InData%WindViUVW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindAiUVW) ) 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%WindAiUVW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindAiUVW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindAiUVW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindAiUVW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindAiUVW,2), UBOUND(InData%WindAiUVW,2) - DO i1 = LBOUND(InData%WindAiUVW,1), UBOUND(InData%WindAiUVW,1) - ReKiBuf(Re_Xferred) = InData%WindAiUVW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_Avg, ErrStat2, ErrMsg2, OnlySize ) ! u_Avg - 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 - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_Avg, ErrStat2, ErrMsg2, OnlySize ) ! y_Avg - 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 - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_Hub, ErrStat2, ErrMsg2, OnlySize ) ! u_Hub - 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 - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_Hub, ErrStat2, ErrMsg2, OnlySize ) ! y_Hub - 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 InflowWind_PackMisc - - SUBROUTINE InflowWind_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(InflowWind_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) :: 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_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts 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%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViUVW 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%WindViUVW)) DEALLOCATE(OutData%WindViUVW) - ALLOCATE(OutData%WindViUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindViUVW,2), UBOUND(OutData%WindViUVW,2) - DO i1 = LBOUND(OutData%WindViUVW,1), UBOUND(OutData%WindViUVW,1) - OutData%WindViUVW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindAiUVW 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%WindAiUVW)) DEALLOCATE(OutData%WindAiUVW) - ALLOCATE(OutData%WindAiUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindAiUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindAiUVW,2), UBOUND(OutData%WindAiUVW,2) - DO i1 = LBOUND(OutData%WindAiUVW,1), UBOUND(OutData%WindAiUVW,1) - OutData%WindAiUVW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_Avg, ErrStat2, ErrMsg2 ) ! u_Avg - 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) - 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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_Avg, ErrStat2, ErrMsg2 ) ! y_Avg - 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) - 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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_Hub, ErrStat2, ErrMsg2 ) ! u_Hub - 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) - 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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_Hub, ErrStat2, ErrMsg2 ) ! y_Hub - 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 InflowWind_UnPackMisc - - - SUBROUTINE InflowWind_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(InflowWind_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(InflowWind_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 + ErrMsg = '' + if (allocated(InputData%PositionXYZ)) then + deallocate(InputData%PositionXYZ) + end if + call Lidar_DestroyInput(InputData%lidar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine InflowWind_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%PositionXYZ)) + if (allocated(InData%PositionXYZ)) then + call RegPackBounds(Buf, 2, lbound(InData%PositionXYZ), ubound(InData%PositionXYZ)) + call RegPack(Buf, InData%PositionXYZ) + end if + call Lidar_PackInput(Buf, InData%lidar) + call RegPack(Buf, InData%HubPosition) + call RegPack(Buf, InData%HubOrientation) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%PositionXYZ)) deallocate(OutData%PositionXYZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PositionXYZ(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositionXYZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PositionXYZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + call Lidar_UnpackInput(Buf, OutData%lidar) ! lidar + call RegUnpack(Buf, OutData%HubPosition) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubOrientation) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_OutputType), intent(in) :: SrcOutputData + type(InflowWind_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%VelocityUVW)) then + LB(1:2) = lbound(SrcOutputData%VelocityUVW) + UB(1:2) = ubound(SrcOutputData%VelocityUVW) + if (.not. allocated(DstOutputData%VelocityUVW)) then + allocate(DstOutputData%VelocityUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VelocityUVW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%VelocityUVW = SrcOutputData%VelocityUVW + end if + if (allocated(SrcOutputData%AccelUVW)) then + LB(1:2) = lbound(SrcOutputData%AccelUVW) + UB(1:2) = ubound(SrcOutputData%AccelUVW) + if (.not. allocated(DstOutputData%AccelUVW)) then + allocate(DstOutputData%AccelUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AccelUVW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%AccelUVW = SrcOutputData%AccelUVW + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if + DstOutputData%DiskVel = SrcOutputData%DiskVel + DstOutputData%HubVel = SrcOutputData%HubVel + call Lidar_CopyOutput(SrcOutputData%lidar, DstOutputData%lidar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine InflowWind_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(InflowWind_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%VelocityUVW)) then + deallocate(OutputData%VelocityUVW) + end if + if (allocated(OutputData%AccelUVW)) then + deallocate(OutputData%AccelUVW) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + call Lidar_DestroyOutput(OutputData%lidar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine InflowWind_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%VelocityUVW)) + if (allocated(InData%VelocityUVW)) then + call RegPackBounds(Buf, 2, lbound(InData%VelocityUVW), ubound(InData%VelocityUVW)) + call RegPack(Buf, InData%VelocityUVW) + end if + call RegPack(Buf, allocated(InData%AccelUVW)) + if (allocated(InData%AccelUVW)) then + call RegPackBounds(Buf, 2, lbound(InData%AccelUVW), ubound(InData%AccelUVW)) + call RegPack(Buf, InData%AccelUVW) + end if + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + call RegPack(Buf, InData%DiskVel) + call RegPack(Buf, InData%HubVel) + call Lidar_PackOutput(Buf, InData%lidar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackOutput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%VelocityUVW)) deallocate(OutData%VelocityUVW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelocityUVW(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelocityUVW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelocityUVW) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AccelUVW)) deallocate(OutData%AccelUVW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AccelUVW(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccelUVW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AccelUVW) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%DiskVel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubVel) + if (RegCheckErr(Buf, RoutineName)) return + call Lidar_UnpackOutput(Buf, OutData%lidar) ! lidar +end subroutine + +subroutine InflowWind_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_ContinuousStateType), intent(in) :: SrcContStateData + type(InflowWind_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine + +subroutine InflowWind_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(InflowWind_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_DiscreteStateType), intent(in) :: SrcDiscStateData + type(InflowWind_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine InflowWind_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(InflowWind_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_ConstraintStateType), intent(in) :: SrcConstrStateData + type(InflowWind_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine InflowWind_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(InflowWind_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_OtherStateType), intent(in) :: SrcOtherStateData + type(InflowWind_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +subroutine InflowWind_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(InflowWind_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_MiscVarType), intent(in) :: SrcMiscData + type(InflowWind_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + end if + if (allocated(SrcMiscData%WindViUVW)) then + LB(1:2) = lbound(SrcMiscData%WindViUVW) + UB(1:2) = ubound(SrcMiscData%WindViUVW) + if (.not. allocated(DstMiscData%WindViUVW)) then + allocate(DstMiscData%WindViUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindViUVW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindViUVW = SrcMiscData%WindViUVW + end if + if (allocated(SrcMiscData%WindAiUVW)) then + LB(1:2) = lbound(SrcMiscData%WindAiUVW) + UB(1:2) = ubound(SrcMiscData%WindAiUVW) + if (.not. allocated(DstMiscData%WindAiUVW)) then + allocate(DstMiscData%WindAiUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAiUVW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindAiUVW = SrcMiscData%WindAiUVW + end if + call InflowWind_CopyInput(SrcMiscData%u_Avg, DstMiscData%u_Avg, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcMiscData%y_Avg, DstMiscData%y_Avg, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcMiscData%u_Hub, DstMiscData%u_Hub, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcMiscData%y_Hub, DstMiscData%y_Hub, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine InflowWind_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(InflowWind_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%WindViUVW)) then + deallocate(MiscData%WindViUVW) + end if + if (allocated(MiscData%WindAiUVW)) then + deallocate(MiscData%WindAiUVW) + end if + call InflowWind_DestroyInput(MiscData%u_Avg, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(MiscData%y_Avg, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInput(MiscData%u_Hub, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(MiscData%y_Hub, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine InflowWind_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + call RegPack(Buf, allocated(InData%WindViUVW)) + if (allocated(InData%WindViUVW)) then + call RegPackBounds(Buf, 2, lbound(InData%WindViUVW), ubound(InData%WindViUVW)) + call RegPack(Buf, InData%WindViUVW) + end if + call RegPack(Buf, allocated(InData%WindAiUVW)) + if (allocated(InData%WindAiUVW)) then + call RegPackBounds(Buf, 2, lbound(InData%WindAiUVW), ubound(InData%WindAiUVW)) + call RegPack(Buf, InData%WindAiUVW) + end if + call InflowWind_PackInput(Buf, InData%u_Avg) + call InflowWind_PackOutput(Buf, InData%y_Avg) + call InflowWind_PackInput(Buf, InData%u_Hub) + call InflowWind_PackOutput(Buf, InData%y_Hub) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackMisc' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WindViUVW)) deallocate(OutData%WindViUVW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindViUVW(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViUVW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindViUVW) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WindAiUVW)) deallocate(OutData%WindAiUVW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindAiUVW(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindAiUVW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindAiUVW) + if (RegCheckErr(Buf, RoutineName)) return + end if + call InflowWind_UnpackInput(Buf, OutData%u_Avg) ! u_Avg + call InflowWind_UnpackOutput(Buf, OutData%y_Avg) ! y_Avg + call InflowWind_UnpackInput(Buf, OutData%u_Hub) ! u_Hub + call InflowWind_UnpackOutput(Buf, OutData%y_Hub) ! y_Hub +end subroutine + +subroutine InflowWind_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(InflowWind_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(InflowWind_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 = 'InflowWind_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 InflowWind_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL InflowWind_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 InflowWind_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 InflowWind_Input_ExtrapInterp - - - SUBROUTINE InflowWind_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call InflowWind_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call InflowWind_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call InflowWind_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE InflowWind_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. @@ -5115,63 +2055,51 @@ SUBROUTINE InflowWind_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(InflowWind_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(InflowWind_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(InflowWind_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 + TYPE(InflowWind_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(InflowWind_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(InflowWind_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 = 'InflowWind_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 - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN - DO i2 = LBOUND(u_out%PositionXYZ,2),UBOUND(u_out%PositionXYZ,2) - DO i1 = LBOUND(u_out%PositionXYZ,1),UBOUND(u_out%PositionXYZ,1) - b = -(u1%PositionXYZ(i1,i2) - u2%PositionXYZ(i1,i2)) - u_out%PositionXYZ(i1,i2) = u1%PositionXYZ(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - CALL Lidar_Input_ExtrapInterp1( u1%lidar, u2%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - DO i1 = LBOUND(u_out%HubPosition,1),UBOUND(u_out%HubPosition,1) - b = -(u1%HubPosition(i1) - u2%HubPosition(i1)) - u_out%HubPosition(i1) = u1%HubPosition(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%HubOrientation,2),UBOUND(u_out%HubOrientation,2) - DO i1 = LBOUND(u_out%HubOrientation,1),UBOUND(u_out%HubOrientation,1) - b = -(u1%HubOrientation(i1,i2) - u2%HubOrientation(i1,i2)) - u_out%HubOrientation(i1,i2) = u1%HubOrientation(i1,i2) + b * ScaleFactor - END DO - END DO - END SUBROUTINE InflowWind_Input_ExtrapInterp1 - - - SUBROUTINE InflowWind_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN + u_out%PositionXYZ = a1*u1%PositionXYZ + a2*u2%PositionXYZ + END IF ! check if allocated + CALL Lidar_Input_ExtrapInterp1( u1%lidar, u2%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%HubPosition = a1*u1%HubPosition + a2*u2%HubPosition + u_out%HubOrientation = a1*u1%HubOrientation + a2*u2%HubOrientation +END SUBROUTINE + +SUBROUTINE InflowWind_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. @@ -5185,126 +2113,111 @@ SUBROUTINE InflowWind_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSt ! !.................................................................................................................................. - TYPE(InflowWind_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(InflowWind_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(InflowWind_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(InflowWind_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 + TYPE(InflowWind_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(InflowWind_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(InflowWind_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(InflowWind_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 = 'InflowWind_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN - DO i2 = LBOUND(u_out%PositionXYZ,2),UBOUND(u_out%PositionXYZ,2) - DO i1 = LBOUND(u_out%PositionXYZ,1),UBOUND(u_out%PositionXYZ,1) - b = (t(3)**2*(u1%PositionXYZ(i1,i2) - u2%PositionXYZ(i1,i2)) + t(2)**2*(-u1%PositionXYZ(i1,i2) + u3%PositionXYZ(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%PositionXYZ(i1,i2) + t(3)*u2%PositionXYZ(i1,i2) - t(2)*u3%PositionXYZ(i1,i2) ) * scaleFactor - u_out%PositionXYZ(i1,i2) = u1%PositionXYZ(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - CALL Lidar_Input_ExtrapInterp2( u1%lidar, u2%lidar, u3%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - DO i1 = LBOUND(u_out%HubPosition,1),UBOUND(u_out%HubPosition,1) - b = (t(3)**2*(u1%HubPosition(i1) - u2%HubPosition(i1)) + t(2)**2*(-u1%HubPosition(i1) + u3%HubPosition(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%HubPosition(i1) + t(3)*u2%HubPosition(i1) - t(2)*u3%HubPosition(i1) ) * scaleFactor - u_out%HubPosition(i1) = u1%HubPosition(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%HubOrientation,2),UBOUND(u_out%HubOrientation,2) - DO i1 = LBOUND(u_out%HubOrientation,1),UBOUND(u_out%HubOrientation,1) - b = (t(3)**2*(u1%HubOrientation(i1,i2) - u2%HubOrientation(i1,i2)) + t(2)**2*(-u1%HubOrientation(i1,i2) + u3%HubOrientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%HubOrientation(i1,i2) + t(3)*u2%HubOrientation(i1,i2) - t(2)*u3%HubOrientation(i1,i2) ) * scaleFactor - u_out%HubOrientation(i1,i2) = u1%HubOrientation(i1,i2) + b + c * t_out - END DO - END DO - END SUBROUTINE InflowWind_Input_ExtrapInterp2 - - - SUBROUTINE InflowWind_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(InflowWind_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(InflowWind_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN + u_out%PositionXYZ = a1*u1%PositionXYZ + a2*u2%PositionXYZ + a3*u3%PositionXYZ + END IF ! check if allocated + CALL Lidar_Input_ExtrapInterp2( u1%lidar, u2%lidar, u3%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%HubPosition = a1*u1%HubPosition + a2*u2%HubPosition + a3*u3%HubPosition + u_out%HubOrientation = a1*u1%HubOrientation + a2*u2%HubOrientation + a3*u3%HubOrientation +END SUBROUTINE + +subroutine InflowWind_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(InflowWind_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(InflowWind_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 = 'InflowWind_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 InflowWind_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL InflowWind_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 InflowWind_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 InflowWind_Output_ExtrapInterp - - - SUBROUTINE InflowWind_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call InflowWind_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call InflowWind_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call InflowWind_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE InflowWind_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. @@ -5316,75 +2229,57 @@ SUBROUTINE InflowWind_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(InflowWind_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(InflowWind_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(InflowWind_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 + TYPE(InflowWind_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(InflowWind_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(InflowWind_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 = 'InflowWind_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN - DO i2 = LBOUND(y_out%VelocityUVW,2),UBOUND(y_out%VelocityUVW,2) - DO i1 = LBOUND(y_out%VelocityUVW,1),UBOUND(y_out%VelocityUVW,1) - b = -(y1%VelocityUVW(i1,i2) - y2%VelocityUVW(i1,i2)) - y_out%VelocityUVW(i1,i2) = y1%VelocityUVW(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%AccelUVW) .AND. ALLOCATED(y1%AccelUVW)) THEN - DO i2 = LBOUND(y_out%AccelUVW,2),UBOUND(y_out%AccelUVW,2) - DO i1 = LBOUND(y_out%AccelUVW,1),UBOUND(y_out%AccelUVW,1) - b = -(y1%AccelUVW(i1,i2) - y2%AccelUVW(i1,i2)) - y_out%AccelUVW(i1,i2) = y1%AccelUVW(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -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 - DO i1 = LBOUND(y_out%DiskVel,1),UBOUND(y_out%DiskVel,1) - b = -(y1%DiskVel(i1) - y2%DiskVel(i1)) - y_out%DiskVel(i1) = y1%DiskVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(y_out%HubVel,1),UBOUND(y_out%HubVel,1) - b = -(y1%HubVel(i1) - y2%HubVel(i1)) - y_out%HubVel(i1) = y1%HubVel(i1) + b * ScaleFactor - END DO - CALL Lidar_Output_ExtrapInterp1( y1%lidar, y2%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE InflowWind_Output_ExtrapInterp1 - - - SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN + y_out%VelocityUVW = a1*y1%VelocityUVW + a2*y2%VelocityUVW + END IF ! check if allocated + IF (ALLOCATED(y_out%AccelUVW) .AND. ALLOCATED(y1%AccelUVW)) THEN + y_out%AccelUVW = a1*y1%AccelUVW + a2*y2%AccelUVW + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated + y_out%DiskVel = a1*y1%DiskVel + a2*y2%DiskVel + y_out%HubVel = a1*y1%HubVel + a2*y2%HubVel + CALL Lidar_Output_ExtrapInterp1( y1%lidar, y2%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE InflowWind_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. @@ -5398,86 +2293,62 @@ SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrS ! !.................................................................................................................................. - TYPE(InflowWind_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(InflowWind_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(InflowWind_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(InflowWind_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 + TYPE(InflowWind_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(InflowWind_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(InflowWind_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(InflowWind_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 = 'InflowWind_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN - DO i2 = LBOUND(y_out%VelocityUVW,2),UBOUND(y_out%VelocityUVW,2) - DO i1 = LBOUND(y_out%VelocityUVW,1),UBOUND(y_out%VelocityUVW,1) - b = (t(3)**2*(y1%VelocityUVW(i1,i2) - y2%VelocityUVW(i1,i2)) + t(2)**2*(-y1%VelocityUVW(i1,i2) + y3%VelocityUVW(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%VelocityUVW(i1,i2) + t(3)*y2%VelocityUVW(i1,i2) - t(2)*y3%VelocityUVW(i1,i2) ) * scaleFactor - y_out%VelocityUVW(i1,i2) = y1%VelocityUVW(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%AccelUVW) .AND. ALLOCATED(y1%AccelUVW)) THEN - DO i2 = LBOUND(y_out%AccelUVW,2),UBOUND(y_out%AccelUVW,2) - DO i1 = LBOUND(y_out%AccelUVW,1),UBOUND(y_out%AccelUVW,1) - b = (t(3)**2*(y1%AccelUVW(i1,i2) - y2%AccelUVW(i1,i2)) + t(2)**2*(-y1%AccelUVW(i1,i2) + y3%AccelUVW(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%AccelUVW(i1,i2) + t(3)*y2%AccelUVW(i1,i2) - t(2)*y3%AccelUVW(i1,i2) ) * scaleFactor - y_out%AccelUVW(i1,i2) = y1%AccelUVW(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -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 - DO i1 = LBOUND(y_out%DiskVel,1),UBOUND(y_out%DiskVel,1) - b = (t(3)**2*(y1%DiskVel(i1) - y2%DiskVel(i1)) + t(2)**2*(-y1%DiskVel(i1) + y3%DiskVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%DiskVel(i1) + t(3)*y2%DiskVel(i1) - t(2)*y3%DiskVel(i1) ) * scaleFactor - y_out%DiskVel(i1) = y1%DiskVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(y_out%HubVel,1),UBOUND(y_out%HubVel,1) - b = (t(3)**2*(y1%HubVel(i1) - y2%HubVel(i1)) + t(2)**2*(-y1%HubVel(i1) + y3%HubVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%HubVel(i1) + t(3)*y2%HubVel(i1) - t(2)*y3%HubVel(i1) ) * scaleFactor - y_out%HubVel(i1) = y1%HubVel(i1) + b + c * t_out - END DO - CALL Lidar_Output_ExtrapInterp2( y1%lidar, y2%lidar, y3%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE InflowWind_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN + y_out%VelocityUVW = a1*y1%VelocityUVW + a2*y2%VelocityUVW + a3*y3%VelocityUVW + END IF ! check if allocated + IF (ALLOCATED(y_out%AccelUVW) .AND. ALLOCATED(y1%AccelUVW)) THEN + y_out%AccelUVW = a1*y1%AccelUVW + a2*y2%AccelUVW + a3*y3%AccelUVW + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated + y_out%DiskVel = a1*y1%DiskVel + a2*y2%DiskVel + a3*y3%DiskVel + y_out%HubVel = a1*y1%HubVel + a2*y2%HubVel + a3*y3%HubVel + CALL Lidar_Output_ExtrapInterp2( y1%lidar, y2%lidar, y3%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE InflowWind_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 7b23f352c0..a8e83bafe1 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -40,78 +40,78 @@ MODULE Lidar_Types ! ========= Lidar_InitInputType ======= TYPE, PUBLIC :: Lidar_InitInputType INTEGER(IntKi) :: SensorType = SensorType_None !< SensorType_* parameter [-] - REAL(DbKi) :: Tmax !< the length of the simulation [s] - REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos !< position of the lidar unit relative to the rotor apex of rotation [m] - REAL(ReKi) , DIMENSION(1:3) :: HubPosition !< initial position of the hub (lidar mounted on hub) [0,0,HubHeight] [m] - INTEGER(IntKi) :: NumPulseGate !< the number of range gates to return wind speeds at [-] - LOGICAL :: LidRadialVel !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] + REAL(DbKi) :: Tmax = 0.0_R8Ki !< the length of the simulation [s] + REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos = 0.0_ReKi !< position of the lidar unit relative to the rotor apex of rotation [m] + REAL(ReKi) , DIMENSION(1:3) :: HubPosition = 0.0_ReKi !< initial position of the hub (lidar mounted on hub) [0,0,HubHeight] [m] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< the number of range gates to return wind speeds at [-] + LOGICAL :: LidRadialVel = .false. !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] END TYPE Lidar_InitInputType ! ======================= ! ========= Lidar_InitOutputType ======= TYPE, PUBLIC :: Lidar_InitOutputType - REAL(ReKi) :: DummyInitOut + REAL(ReKi) :: DummyInitOut = 0.0_ReKi END TYPE Lidar_InitOutputType ! ======================= ! ========= Lidar_ParameterType ======= TYPE, PUBLIC :: Lidar_ParameterType - INTEGER(IntKi) :: NumPulseGate !< the number of range gates to return wind speeds at; pulsed lidar only [-] - REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos !< position of the lidar unit relative to the rotor apex of rotation [m] - REAL(ReKi) :: RayRangeSq !< Rayleigh Range Squared [-] - REAL(ReKi) :: SpatialRes !< spatial sampling distance of weighting function (1/2)*(avg ws)*dt [-] - INTEGER(IntKi) :: SensorType !< SensorType_* parameter [-] - REAL(ReKi) :: WtFnTrunc !< Percentage of the peak value at which to truncate weighting function [-] - REAL(ReKi) :: PulseRangeOne !< the range to the closest range gate [m] - REAL(ReKi) :: DeltaP !< the distance between range gates [m] - REAL(ReKi) :: DeltaR !< the FWHM width of the pulse [-] - REAL(ReKi) :: r_p - LOGICAL :: LidRadialVel !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] - REAL(ReKi) :: DisplacementLidarX !< Displacement of the lidar system from the focal measurement point [m] - REAL(ReKi) :: DisplacementLidarY !< Displacement of the lidar system from the focal measurement point [m] - REAL(ReKi) :: DisplacementLidarZ !< Displacement of the lidar system from the focal measurement point [m] - INTEGER(IntKi) :: NumBeam !< Number of lidar beams [-] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< the number of range gates to return wind speeds at; pulsed lidar only [-] + REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos = 0.0_ReKi !< position of the lidar unit relative to the rotor apex of rotation [m] + REAL(ReKi) :: RayRangeSq = 0.0_ReKi !< Rayleigh Range Squared [-] + REAL(ReKi) :: SpatialRes = 0.0_ReKi !< spatial sampling distance of weighting function (1/2)*(avg ws)*dt [-] + INTEGER(IntKi) :: SensorType = 0_IntKi !< SensorType_* parameter [-] + REAL(ReKi) :: WtFnTrunc = 0.0_ReKi !< Percentage of the peak value at which to truncate weighting function [-] + REAL(ReKi) :: PulseRangeOne = 0.0_ReKi !< the range to the closest range gate [m] + REAL(ReKi) :: DeltaP = 0.0_ReKi !< the distance between range gates [m] + REAL(ReKi) :: DeltaR = 0.0_ReKi !< the FWHM width of the pulse [-] + REAL(ReKi) :: r_p = 0.0_ReKi + LOGICAL :: LidRadialVel = .false. !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] + REAL(ReKi) :: DisplacementLidarX = 0.0_ReKi !< Displacement of the lidar system from the focal measurement point [m] + REAL(ReKi) :: DisplacementLidarY = 0.0_ReKi !< Displacement of the lidar system from the focal measurement point [m] + REAL(ReKi) :: DisplacementLidarZ = 0.0_ReKi !< Displacement of the lidar system from the focal measurement point [m] + INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of lidar beams [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceX !< LIDAR LOS focal distance co-ordinates in the x direction [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceY !< LIDAR LOS focal distance co-ordinates in the y direction [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceZ !< LIDAR LOS focal distance co-ordinates in the z direction [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MsrPosition !< Position of the desired wind measurement (was XMsrPt, YMsrPt, ZMsrPt) [m] - REAL(ReKi) :: PulseSpacing !< Distance between range gates [m] - REAL(ReKi) :: URefLid !< Reference average wind speed for the lidar [m/s] - INTEGER(IntKi) :: ConsiderHubMotion !< Flag whether to consider the hub motion's impact on the Lidar measurement [-] - REAL(ReKi) :: MeasurementInterval !< Time steps between lidar measurements [s] - REAL(ReKi) , DIMENSION(1:3) :: LidPosition !< Position of the Lidar unit (was XLidPt, YLidPt, ZLidPt) [m] + REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [m] + REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] + INTEGER(IntKi) :: ConsiderHubMotion = 0_IntKi !< Flag whether to consider the hub motion's impact on the Lidar measurement [-] + REAL(ReKi) :: MeasurementInterval = 0.0_ReKi !< Time steps between lidar measurements [s] + REAL(ReKi) , DIMENSION(1:3) :: LidPosition = 0.0_ReKi !< Position of the Lidar unit (was XLidPt, YLidPt, ZLidPt) [m] END TYPE Lidar_ParameterType ! ======================= ! ========= Lidar_ContinuousStateType ======= TYPE, PUBLIC :: Lidar_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: DummyContState = 0.0_ReKi !< Remove this variable if you have continuous states [-] END TYPE Lidar_ContinuousStateType ! ======================= ! ========= Lidar_DiscreteStateType ======= TYPE, PUBLIC :: Lidar_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE Lidar_DiscreteStateType ! ======================= ! ========= Lidar_ConstraintStateType ======= TYPE, PUBLIC :: Lidar_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE Lidar_ConstraintStateType ! ======================= ! ========= Lidar_OtherStateType ======= TYPE, PUBLIC :: Lidar_OtherStateType - REAL(ReKi) :: DummyOtherState + REAL(ReKi) :: DummyOtherState = 0.0_ReKi END TYPE Lidar_OtherStateType ! ======================= ! ========= Lidar_MiscVarType ======= TYPE, PUBLIC :: Lidar_MiscVarType - REAL(ReKi) :: DummyMiscVar !< Remove this variable if you have misc variables [-] + REAL(ReKi) :: DummyMiscVar = 0.0_ReKi !< Remove this variable if you have misc variables [-] END TYPE Lidar_MiscVarType ! ======================= ! ========= Lidar_InputType ======= TYPE, PUBLIC :: Lidar_InputType - REAL(ReKi) :: PulseLidEl !< the angle off of the x axis that the lidar is aimed (0 would be staring directly upwind, pi/2 would be staring perpendicular to the x axis) [-] - REAL(ReKi) :: PulseLidAz !< the angle in the YZ plane that the lidar is staring (if PulseLidEl is set to pi/2, then 0 would be aligned with the positive z axis, pi/2 would be aligned with the positive y axis) [-] - REAL(ReKi) :: HubDisplacementX !< X direction hub displacement of the lidar (from ElastoDyn) [m] - REAL(ReKi) :: HubDisplacementY !< Y direction hub displacement of the lidar (from ElastoDyn) [m] - REAL(ReKi) :: HubDisplacementZ !< Z direction hub displacement of the lidar (from ElastoDyn) [m] + REAL(ReKi) :: PulseLidEl = 0.0_ReKi !< the angle off of the x axis that the lidar is aimed (0 would be staring directly upwind, pi/2 would be staring perpendicular to the x axis) [-] + REAL(ReKi) :: PulseLidAz = 0.0_ReKi !< the angle in the YZ plane that the lidar is staring (if PulseLidEl is set to pi/2, then 0 would be aligned with the positive z axis, pi/2 would be aligned with the positive y axis) [-] + REAL(ReKi) :: HubDisplacementX = 0.0_ReKi !< X direction hub displacement of the lidar (from ElastoDyn) [m] + REAL(ReKi) :: HubDisplacementY = 0.0_ReKi !< Y direction hub displacement of the lidar (from ElastoDyn) [m] + REAL(ReKi) :: HubDisplacementZ = 0.0_ReKi !< Z direction hub displacement of the lidar (from ElastoDyn) [m] END TYPE Lidar_InputType ! ======================= ! ========= Lidar_OutputType ======= @@ -124,2032 +124,874 @@ MODULE Lidar_Types END TYPE Lidar_OutputType ! ======================= CONTAINS - SUBROUTINE Lidar_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Lidar_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 = 'Lidar_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%SensorType = SrcInitInputData%SensorType - DstInitInputData%Tmax = SrcInitInputData%Tmax - DstInitInputData%RotorApexOffsetPos = SrcInitInputData%RotorApexOffsetPos - DstInitInputData%HubPosition = SrcInitInputData%HubPosition - DstInitInputData%NumPulseGate = SrcInitInputData%NumPulseGate - DstInitInputData%LidRadialVel = SrcInitInputData%LidRadialVel - END SUBROUTINE Lidar_CopyInitInput - - SUBROUTINE Lidar_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(Lidar_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 = 'Lidar_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyInitInput - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 ! SensorType - Db_BufSz = Db_BufSz + 1 ! Tmax - Re_BufSz = Re_BufSz + SIZE(InData%RotorApexOffsetPos) ! RotorApexOffsetPos - Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Int_BufSz = Int_BufSz + 1 ! LidRadialVel - 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%SensorType - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) - ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) - ReKiBuf(Re_Xferred) = InData%HubPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Lidar_PackInitInput - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Tmax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%RotorApexOffsetPos,1) - i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) - OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubPosition,1) - i1_u = UBOUND(OutData%HubPosition,1) - DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) - OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Lidar_UnPackInitInput - - SUBROUTINE Lidar_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Lidar_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_CopyInitOutput' -! +subroutine Lidar_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_InitInputType), intent(in) :: SrcInitInputData + type(Lidar_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut - END SUBROUTINE Lidar_CopyInitOutput - - SUBROUTINE Lidar_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(Lidar_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 = 'Lidar_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyInitOutput - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 - Re_BufSz = Re_BufSz + 1 ! DummyInitOut - 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%DummyInitOut - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_PackInitOutput - - SUBROUTINE Lidar_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(Lidar_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_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 - OutData%DummyInitOut = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_UnPackInitOutput - - SUBROUTINE Lidar_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Lidar_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 = 'Lidar_CopyParam' -! + ErrMsg = '' + DstInitInputData%SensorType = SrcInitInputData%SensorType + DstInitInputData%Tmax = SrcInitInputData%Tmax + DstInitInputData%RotorApexOffsetPos = SrcInitInputData%RotorApexOffsetPos + DstInitInputData%HubPosition = SrcInitInputData%HubPosition + DstInitInputData%NumPulseGate = SrcInitInputData%NumPulseGate + DstInitInputData%LidRadialVel = SrcInitInputData%LidRadialVel +end subroutine + +subroutine Lidar_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Lidar_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%NumPulseGate = SrcParamData%NumPulseGate - DstParamData%RotorApexOffsetPos = SrcParamData%RotorApexOffsetPos - DstParamData%RayRangeSq = SrcParamData%RayRangeSq - DstParamData%SpatialRes = SrcParamData%SpatialRes - DstParamData%SensorType = SrcParamData%SensorType - DstParamData%WtFnTrunc = SrcParamData%WtFnTrunc - DstParamData%PulseRangeOne = SrcParamData%PulseRangeOne - DstParamData%DeltaP = SrcParamData%DeltaP - DstParamData%DeltaR = SrcParamData%DeltaR - DstParamData%r_p = SrcParamData%r_p - DstParamData%LidRadialVel = SrcParamData%LidRadialVel - DstParamData%DisplacementLidarX = SrcParamData%DisplacementLidarX - DstParamData%DisplacementLidarY = SrcParamData%DisplacementLidarY - DstParamData%DisplacementLidarZ = SrcParamData%DisplacementLidarZ - DstParamData%NumBeam = SrcParamData%NumBeam -IF (ALLOCATED(SrcParamData%FocalDistanceX)) THEN - i1_l = LBOUND(SrcParamData%FocalDistanceX,1) - i1_u = UBOUND(SrcParamData%FocalDistanceX,1) - IF (.NOT. ALLOCATED(DstParamData%FocalDistanceX)) THEN - ALLOCATE(DstParamData%FocalDistanceX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FocalDistanceX = SrcParamData%FocalDistanceX -ENDIF -IF (ALLOCATED(SrcParamData%FocalDistanceY)) THEN - i1_l = LBOUND(SrcParamData%FocalDistanceY,1) - i1_u = UBOUND(SrcParamData%FocalDistanceY,1) - IF (.NOT. ALLOCATED(DstParamData%FocalDistanceY)) THEN - ALLOCATE(DstParamData%FocalDistanceY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FocalDistanceY = SrcParamData%FocalDistanceY -ENDIF -IF (ALLOCATED(SrcParamData%FocalDistanceZ)) THEN - i1_l = LBOUND(SrcParamData%FocalDistanceZ,1) - i1_u = UBOUND(SrcParamData%FocalDistanceZ,1) - IF (.NOT. ALLOCATED(DstParamData%FocalDistanceZ)) THEN - ALLOCATE(DstParamData%FocalDistanceZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FocalDistanceZ = SrcParamData%FocalDistanceZ -ENDIF -IF (ALLOCATED(SrcParamData%MsrPosition)) THEN - i1_l = LBOUND(SrcParamData%MsrPosition,1) - i1_u = UBOUND(SrcParamData%MsrPosition,1) - i2_l = LBOUND(SrcParamData%MsrPosition,2) - i2_u = UBOUND(SrcParamData%MsrPosition,2) - IF (.NOT. ALLOCATED(DstParamData%MsrPosition)) THEN - ALLOCATE(DstParamData%MsrPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MsrPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MsrPosition = SrcParamData%MsrPosition -ENDIF - DstParamData%PulseSpacing = SrcParamData%PulseSpacing - DstParamData%URefLid = SrcParamData%URefLid - DstParamData%ConsiderHubMotion = SrcParamData%ConsiderHubMotion - DstParamData%MeasurementInterval = SrcParamData%MeasurementInterval - DstParamData%LidPosition = SrcParamData%LidPosition - END SUBROUTINE Lidar_CopyParam - - SUBROUTINE Lidar_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(Lidar_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 = 'Lidar_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%FocalDistanceX)) THEN - DEALLOCATE(ParamData%FocalDistanceX) -ENDIF -IF (ALLOCATED(ParamData%FocalDistanceY)) THEN - DEALLOCATE(ParamData%FocalDistanceY) -ENDIF -IF (ALLOCATED(ParamData%FocalDistanceZ)) THEN - DEALLOCATE(ParamData%FocalDistanceZ) -ENDIF -IF (ALLOCATED(ParamData%MsrPosition)) THEN - DEALLOCATE(ParamData%MsrPosition) -ENDIF - END SUBROUTINE Lidar_DestroyParam - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Re_BufSz = Re_BufSz + SIZE(InData%RotorApexOffsetPos) ! RotorApexOffsetPos - Re_BufSz = Re_BufSz + 1 ! RayRangeSq - Re_BufSz = Re_BufSz + 1 ! SpatialRes - Int_BufSz = Int_BufSz + 1 ! SensorType - Re_BufSz = Re_BufSz + 1 ! WtFnTrunc - Re_BufSz = Re_BufSz + 1 ! PulseRangeOne - Re_BufSz = Re_BufSz + 1 ! DeltaP - Re_BufSz = Re_BufSz + 1 ! DeltaR - Re_BufSz = Re_BufSz + 1 ! r_p - Int_BufSz = Int_BufSz + 1 ! LidRadialVel - Re_BufSz = Re_BufSz + 1 ! DisplacementLidarX - Re_BufSz = Re_BufSz + 1 ! DisplacementLidarY - Re_BufSz = Re_BufSz + 1 ! DisplacementLidarZ - Int_BufSz = Int_BufSz + 1 ! NumBeam - Int_BufSz = Int_BufSz + 1 ! FocalDistanceX allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceX) ! FocalDistanceX - END IF - Int_BufSz = Int_BufSz + 1 ! FocalDistanceY allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceY) ! FocalDistanceY - END IF - Int_BufSz = Int_BufSz + 1 ! FocalDistanceZ allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceZ) ! FocalDistanceZ - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPosition allocated yes/no - IF ( ALLOCATED(InData%MsrPosition) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MsrPosition upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPosition) ! MsrPosition - END IF - Re_BufSz = Re_BufSz + 1 ! PulseSpacing - Re_BufSz = Re_BufSz + 1 ! URefLid - Int_BufSz = Int_BufSz + 1 ! ConsiderHubMotion - Re_BufSz = Re_BufSz + 1 ! MeasurementInterval - Re_BufSz = Re_BufSz + SIZE(InData%LidPosition) ! LidPosition - 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%NumPulseGate - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) - ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%RayRangeSq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpatialRes - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtFnTrunc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PulseRangeOne - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DeltaP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DeltaR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%r_p - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DisplacementLidarX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DisplacementLidarY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DisplacementLidarZ - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBeam - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FocalDistanceX) ) 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%FocalDistanceX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceX,1), UBOUND(InData%FocalDistanceX,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FocalDistanceY) ) 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%FocalDistanceY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceY,1), UBOUND(InData%FocalDistanceY,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FocalDistanceZ) ) 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%FocalDistanceZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceZ,1), UBOUND(InData%FocalDistanceZ,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPosition) ) 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%MsrPosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPosition,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MsrPosition,2), UBOUND(InData%MsrPosition,2) - DO i1 = LBOUND(InData%MsrPosition,1), UBOUND(InData%MsrPosition,1) - ReKiBuf(Re_Xferred) = InData%MsrPosition(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PulseSpacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%URefLid - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ConsiderHubMotion - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MeasurementInterval - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%LidPosition,1), UBOUND(InData%LidPosition,1) - ReKiBuf(Re_Xferred) = InData%LidPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE Lidar_PackParam - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RotorApexOffsetPos,1) - i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) - OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%RayRangeSq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpatialRes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtFnTrunc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PulseRangeOne = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DeltaP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DeltaR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%r_p = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) - Int_Xferred = Int_Xferred + 1 - OutData%DisplacementLidarX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DisplacementLidarY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DisplacementLidarZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBeam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceX 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%FocalDistanceX)) DEALLOCATE(OutData%FocalDistanceX) - ALLOCATE(OutData%FocalDistanceX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceX,1), UBOUND(OutData%FocalDistanceX,1) - OutData%FocalDistanceX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceY 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%FocalDistanceY)) DEALLOCATE(OutData%FocalDistanceY) - ALLOCATE(OutData%FocalDistanceY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceY,1), UBOUND(OutData%FocalDistanceY,1) - OutData%FocalDistanceY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceZ 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%FocalDistanceZ)) DEALLOCATE(OutData%FocalDistanceZ) - ALLOCATE(OutData%FocalDistanceZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceZ,1), UBOUND(OutData%FocalDistanceZ,1) - OutData%FocalDistanceZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPosition 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%MsrPosition)) DEALLOCATE(OutData%MsrPosition) - ALLOCATE(OutData%MsrPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MsrPosition,2), UBOUND(OutData%MsrPosition,2) - DO i1 = LBOUND(OutData%MsrPosition,1), UBOUND(OutData%MsrPosition,1) - OutData%MsrPosition(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%PulseSpacing = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%URefLid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ConsiderHubMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MeasurementInterval = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%LidPosition,1) - i1_u = UBOUND(OutData%LidPosition,1) - DO i1 = LBOUND(OutData%LidPosition,1), UBOUND(OutData%LidPosition,1) - OutData%LidPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE Lidar_UnPackParam - - SUBROUTINE Lidar_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Lidar_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 = 'Lidar_CopyContState' -! + ErrMsg = '' +end subroutine + +subroutine Lidar_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%SensorType) + call RegPack(Buf, InData%Tmax) + call RegPack(Buf, InData%RotorApexOffsetPos) + call RegPack(Buf, InData%HubPosition) + call RegPack(Buf, InData%NumPulseGate) + call RegPack(Buf, InData%LidRadialVel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotorApexOffsetPos) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubPosition) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LidRadialVel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_InitOutputType), intent(in) :: SrcInitOutputData + type(Lidar_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE Lidar_CopyContState - - SUBROUTINE Lidar_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(Lidar_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 = 'Lidar_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyContState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 Lidar_PackContState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_UnPackContState - - SUBROUTINE Lidar_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Lidar_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 = 'Lidar_CopyDiscState' -! + ErrMsg = '' + DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut +end subroutine + +subroutine Lidar_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Lidar_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE Lidar_CopyDiscState - - SUBROUTINE Lidar_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(Lidar_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 = 'Lidar_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyDiscState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 Lidar_PackDiscState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_UnPackDiscState - - SUBROUTINE Lidar_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Lidar_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 = 'Lidar_CopyConstrState' -! + ErrMsg = '' +end subroutine + +subroutine Lidar_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyInitOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyInitOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_ParameterType), intent(in) :: SrcParamData + type(Lidar_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Lidar_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Lidar_CopyConstrState - - SUBROUTINE Lidar_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(Lidar_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 = 'Lidar_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyConstrState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 Lidar_PackConstrState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_UnPackConstrState - - SUBROUTINE Lidar_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Lidar_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 = 'Lidar_CopyOtherState' -! + ErrMsg = '' + DstParamData%NumPulseGate = SrcParamData%NumPulseGate + DstParamData%RotorApexOffsetPos = SrcParamData%RotorApexOffsetPos + DstParamData%RayRangeSq = SrcParamData%RayRangeSq + DstParamData%SpatialRes = SrcParamData%SpatialRes + DstParamData%SensorType = SrcParamData%SensorType + DstParamData%WtFnTrunc = SrcParamData%WtFnTrunc + DstParamData%PulseRangeOne = SrcParamData%PulseRangeOne + DstParamData%DeltaP = SrcParamData%DeltaP + DstParamData%DeltaR = SrcParamData%DeltaR + DstParamData%r_p = SrcParamData%r_p + DstParamData%LidRadialVel = SrcParamData%LidRadialVel + DstParamData%DisplacementLidarX = SrcParamData%DisplacementLidarX + DstParamData%DisplacementLidarY = SrcParamData%DisplacementLidarY + DstParamData%DisplacementLidarZ = SrcParamData%DisplacementLidarZ + DstParamData%NumBeam = SrcParamData%NumBeam + if (allocated(SrcParamData%FocalDistanceX)) then + LB(1:1) = lbound(SrcParamData%FocalDistanceX) + UB(1:1) = ubound(SrcParamData%FocalDistanceX) + if (.not. allocated(DstParamData%FocalDistanceX)) then + allocate(DstParamData%FocalDistanceX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FocalDistanceX = SrcParamData%FocalDistanceX + end if + if (allocated(SrcParamData%FocalDistanceY)) then + LB(1:1) = lbound(SrcParamData%FocalDistanceY) + UB(1:1) = ubound(SrcParamData%FocalDistanceY) + if (.not. allocated(DstParamData%FocalDistanceY)) then + allocate(DstParamData%FocalDistanceY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FocalDistanceY = SrcParamData%FocalDistanceY + end if + if (allocated(SrcParamData%FocalDistanceZ)) then + LB(1:1) = lbound(SrcParamData%FocalDistanceZ) + UB(1:1) = ubound(SrcParamData%FocalDistanceZ) + if (.not. allocated(DstParamData%FocalDistanceZ)) then + allocate(DstParamData%FocalDistanceZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FocalDistanceZ = SrcParamData%FocalDistanceZ + end if + if (allocated(SrcParamData%MsrPosition)) then + LB(1:2) = lbound(SrcParamData%MsrPosition) + UB(1:2) = ubound(SrcParamData%MsrPosition) + if (.not. allocated(DstParamData%MsrPosition)) then + allocate(DstParamData%MsrPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MsrPosition.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MsrPosition = SrcParamData%MsrPosition + end if + DstParamData%PulseSpacing = SrcParamData%PulseSpacing + DstParamData%URefLid = SrcParamData%URefLid + DstParamData%ConsiderHubMotion = SrcParamData%ConsiderHubMotion + DstParamData%MeasurementInterval = SrcParamData%MeasurementInterval + DstParamData%LidPosition = SrcParamData%LidPosition +end subroutine + +subroutine Lidar_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Lidar_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyParam' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Lidar_CopyOtherState - - SUBROUTINE Lidar_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(Lidar_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 = 'Lidar_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyOtherState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 - Re_BufSz = Re_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 - - ReKiBuf(Re_Xferred) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_PackOtherState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_UnPackOtherState - - SUBROUTINE Lidar_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Lidar_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 = 'Lidar_CopyMisc' -! + ErrMsg = '' + if (allocated(ParamData%FocalDistanceX)) then + deallocate(ParamData%FocalDistanceX) + end if + if (allocated(ParamData%FocalDistanceY)) then + deallocate(ParamData%FocalDistanceY) + end if + if (allocated(ParamData%FocalDistanceZ)) then + deallocate(ParamData%FocalDistanceZ) + end if + if (allocated(ParamData%MsrPosition)) then + deallocate(ParamData%MsrPosition) + end if +end subroutine + +subroutine Lidar_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%NumPulseGate) + call RegPack(Buf, InData%RotorApexOffsetPos) + call RegPack(Buf, InData%RayRangeSq) + call RegPack(Buf, InData%SpatialRes) + call RegPack(Buf, InData%SensorType) + call RegPack(Buf, InData%WtFnTrunc) + call RegPack(Buf, InData%PulseRangeOne) + call RegPack(Buf, InData%DeltaP) + call RegPack(Buf, InData%DeltaR) + call RegPack(Buf, InData%r_p) + call RegPack(Buf, InData%LidRadialVel) + call RegPack(Buf, InData%DisplacementLidarX) + call RegPack(Buf, InData%DisplacementLidarY) + call RegPack(Buf, InData%DisplacementLidarZ) + call RegPack(Buf, InData%NumBeam) + call RegPack(Buf, allocated(InData%FocalDistanceX)) + if (allocated(InData%FocalDistanceX)) then + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceX), ubound(InData%FocalDistanceX)) + call RegPack(Buf, InData%FocalDistanceX) + end if + call RegPack(Buf, allocated(InData%FocalDistanceY)) + if (allocated(InData%FocalDistanceY)) then + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceY), ubound(InData%FocalDistanceY)) + call RegPack(Buf, InData%FocalDistanceY) + end if + call RegPack(Buf, allocated(InData%FocalDistanceZ)) + if (allocated(InData%FocalDistanceZ)) then + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceZ), ubound(InData%FocalDistanceZ)) + call RegPack(Buf, InData%FocalDistanceZ) + end if + call RegPack(Buf, allocated(InData%MsrPosition)) + if (allocated(InData%MsrPosition)) then + call RegPackBounds(Buf, 2, lbound(InData%MsrPosition), ubound(InData%MsrPosition)) + call RegPack(Buf, InData%MsrPosition) + end if + call RegPack(Buf, InData%PulseSpacing) + call RegPack(Buf, InData%URefLid) + call RegPack(Buf, InData%ConsiderHubMotion) + call RegPack(Buf, InData%MeasurementInterval) + call RegPack(Buf, InData%LidPosition) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotorApexOffsetPos) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RayRangeSq) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SpatialRes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtFnTrunc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PulseRangeOne) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DeltaP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DeltaR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%r_p) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LidRadialVel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DisplacementLidarX) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DisplacementLidarY) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DisplacementLidarZ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBeam) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%FocalDistanceX)) deallocate(OutData%FocalDistanceX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FocalDistanceX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FocalDistanceX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FocalDistanceY)) deallocate(OutData%FocalDistanceY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FocalDistanceY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FocalDistanceY) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FocalDistanceZ)) deallocate(OutData%FocalDistanceZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FocalDistanceZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FocalDistanceZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MsrPosition)) deallocate(OutData%MsrPosition) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPosition(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPosition.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPosition) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%PulseSpacing) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ConsiderHubMotion) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MeasurementInterval) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LidPosition) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_ContinuousStateType), intent(in) :: SrcContStateData + type(Lidar_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE Lidar_CopyMisc - - SUBROUTINE Lidar_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(Lidar_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 = 'Lidar_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyMisc - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 Lidar_PackMisc - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 Lidar_UnPackMisc - - SUBROUTINE Lidar_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_InputType), INTENT(IN) :: SrcInputData - TYPE(Lidar_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 = 'Lidar_CopyInput' -! + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine + +subroutine Lidar_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(Lidar_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstInputData%PulseLidEl = SrcInputData%PulseLidEl - DstInputData%PulseLidAz = SrcInputData%PulseLidAz - DstInputData%HubDisplacementX = SrcInputData%HubDisplacementX - DstInputData%HubDisplacementY = SrcInputData%HubDisplacementY - DstInputData%HubDisplacementZ = SrcInputData%HubDisplacementZ - END SUBROUTINE Lidar_CopyInput - - SUBROUTINE Lidar_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(Lidar_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 = 'Lidar_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyInput - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 ! PulseLidEl - Re_BufSz = Re_BufSz + 1 ! PulseLidAz - Re_BufSz = Re_BufSz + 1 ! HubDisplacementX - Re_BufSz = Re_BufSz + 1 ! HubDisplacementY - Re_BufSz = Re_BufSz + 1 ! HubDisplacementZ - 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%PulseLidEl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PulseLidAz - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubDisplacementX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubDisplacementY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubDisplacementZ - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_PackInput - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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%PulseLidEl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PulseLidAz = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubDisplacementX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubDisplacementY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubDisplacementZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_UnPackInput - - SUBROUTINE Lidar_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_OutputType), INTENT(IN) :: SrcOutputData - TYPE(Lidar_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 = 'Lidar_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine Lidar_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_DiscreteStateType), intent(in) :: SrcDiscStateData + type(Lidar_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%LidSpeed)) THEN - i1_l = LBOUND(SrcOutputData%LidSpeed,1) - i1_u = UBOUND(SrcOutputData%LidSpeed,1) - IF (.NOT. ALLOCATED(DstOutputData%LidSpeed)) THEN - ALLOCATE(DstOutputData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%LidSpeed = SrcOutputData%LidSpeed -ENDIF -IF (ALLOCATED(SrcOutputData%WtTrunc)) THEN - i1_l = LBOUND(SrcOutputData%WtTrunc,1) - i1_u = UBOUND(SrcOutputData%WtTrunc,1) - IF (.NOT. ALLOCATED(DstOutputData%WtTrunc)) THEN - ALLOCATE(DstOutputData%WtTrunc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WtTrunc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WtTrunc = SrcOutputData%WtTrunc -ENDIF -IF (ALLOCATED(SrcOutputData%MsrPositionsX)) THEN - i1_l = LBOUND(SrcOutputData%MsrPositionsX,1) - i1_u = UBOUND(SrcOutputData%MsrPositionsX,1) - IF (.NOT. ALLOCATED(DstOutputData%MsrPositionsX)) THEN - ALLOCATE(DstOutputData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%MsrPositionsX = SrcOutputData%MsrPositionsX -ENDIF -IF (ALLOCATED(SrcOutputData%MsrPositionsY)) THEN - i1_l = LBOUND(SrcOutputData%MsrPositionsY,1) - i1_u = UBOUND(SrcOutputData%MsrPositionsY,1) - IF (.NOT. ALLOCATED(DstOutputData%MsrPositionsY)) THEN - ALLOCATE(DstOutputData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%MsrPositionsY = SrcOutputData%MsrPositionsY -ENDIF -IF (ALLOCATED(SrcOutputData%MsrPositionsZ)) THEN - i1_l = LBOUND(SrcOutputData%MsrPositionsZ,1) - i1_u = UBOUND(SrcOutputData%MsrPositionsZ,1) - IF (.NOT. ALLOCATED(DstOutputData%MsrPositionsZ)) THEN - ALLOCATE(DstOutputData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%MsrPositionsZ = SrcOutputData%MsrPositionsZ -ENDIF - END SUBROUTINE Lidar_CopyOutput - - SUBROUTINE Lidar_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(Lidar_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 = 'Lidar_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%LidSpeed)) THEN - DEALLOCATE(OutputData%LidSpeed) -ENDIF -IF (ALLOCATED(OutputData%WtTrunc)) THEN - DEALLOCATE(OutputData%WtTrunc) -ENDIF -IF (ALLOCATED(OutputData%MsrPositionsX)) THEN - DEALLOCATE(OutputData%MsrPositionsX) -ENDIF -IF (ALLOCATED(OutputData%MsrPositionsY)) THEN - DEALLOCATE(OutputData%MsrPositionsY) -ENDIF -IF (ALLOCATED(OutputData%MsrPositionsZ)) THEN - DEALLOCATE(OutputData%MsrPositionsZ) -ENDIF - END SUBROUTINE Lidar_DestroyOutput - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 ! LidSpeed allocated yes/no - IF ( ALLOCATED(InData%LidSpeed) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LidSpeed upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LidSpeed) ! LidSpeed - END IF - Int_BufSz = Int_BufSz + 1 ! WtTrunc allocated yes/no - IF ( ALLOCATED(InData%WtTrunc) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WtTrunc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WtTrunc) ! WtTrunc - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsX allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsX) ! MsrPositionsX - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsY allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsY) ! MsrPositionsY - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsZ allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsZ) ! MsrPositionsZ - 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%LidSpeed) ) 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%LidSpeed,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LidSpeed,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LidSpeed,1), UBOUND(InData%LidSpeed,1) - ReKiBuf(Re_Xferred) = InData%LidSpeed(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WtTrunc) ) 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%WtTrunc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WtTrunc,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WtTrunc,1), UBOUND(InData%WtTrunc,1) - ReKiBuf(Re_Xferred) = InData%WtTrunc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsX) ) 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%MsrPositionsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsX,1), UBOUND(InData%MsrPositionsX,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsY) ) 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%MsrPositionsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsY,1), UBOUND(InData%MsrPositionsY,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsZ) ) 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%MsrPositionsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsZ,1), UBOUND(InData%MsrPositionsZ,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Lidar_PackOutput - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 ! LidSpeed 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%LidSpeed)) DEALLOCATE(OutData%LidSpeed) - ALLOCATE(OutData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LidSpeed,1), UBOUND(OutData%LidSpeed,1) - OutData%LidSpeed(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WtTrunc 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%WtTrunc)) DEALLOCATE(OutData%WtTrunc) - ALLOCATE(OutData%WtTrunc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WtTrunc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WtTrunc,1), UBOUND(OutData%WtTrunc,1) - OutData%WtTrunc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsX 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%MsrPositionsX)) DEALLOCATE(OutData%MsrPositionsX) - ALLOCATE(OutData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsX,1), UBOUND(OutData%MsrPositionsX,1) - OutData%MsrPositionsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsY 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%MsrPositionsY)) DEALLOCATE(OutData%MsrPositionsY) - ALLOCATE(OutData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsY,1), UBOUND(OutData%MsrPositionsY,1) - OutData%MsrPositionsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsZ 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%MsrPositionsZ)) DEALLOCATE(OutData%MsrPositionsZ) - ALLOCATE(OutData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsZ,1), UBOUND(OutData%MsrPositionsZ,1) - OutData%MsrPositionsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Lidar_UnPackOutput - - - SUBROUTINE Lidar_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(Lidar_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Lidar_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 + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine Lidar_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(Lidar_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Lidar_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_ConstraintStateType), intent(in) :: SrcConstrStateData + type(Lidar_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine Lidar_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(Lidar_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Lidar_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_OtherStateType), intent(in) :: SrcOtherStateData + type(Lidar_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +subroutine Lidar_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(Lidar_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Lidar_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_MiscVarType), intent(in) :: SrcMiscData + type(Lidar_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar +end subroutine + +subroutine Lidar_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Lidar_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Lidar_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_InputType), intent(in) :: SrcInputData + type(Lidar_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%PulseLidEl = SrcInputData%PulseLidEl + DstInputData%PulseLidAz = SrcInputData%PulseLidAz + DstInputData%HubDisplacementX = SrcInputData%HubDisplacementX + DstInputData%HubDisplacementY = SrcInputData%HubDisplacementY + DstInputData%HubDisplacementZ = SrcInputData%HubDisplacementZ +end subroutine + +subroutine Lidar_DestroyInput(InputData, ErrStat, ErrMsg) + type(Lidar_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Lidar_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%PulseLidEl) + call RegPack(Buf, InData%PulseLidAz) + call RegPack(Buf, InData%HubDisplacementX) + call RegPack(Buf, InData%HubDisplacementY) + call RegPack(Buf, InData%HubDisplacementZ) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%PulseLidEl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PulseLidAz) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubDisplacementX) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubDisplacementY) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubDisplacementZ) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_OutputType), intent(in) :: SrcOutputData + type(Lidar_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Lidar_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%LidSpeed)) then + LB(1:1) = lbound(SrcOutputData%LidSpeed) + UB(1:1) = ubound(SrcOutputData%LidSpeed) + if (.not. allocated(DstOutputData%LidSpeed)) then + allocate(DstOutputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%LidSpeed.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%LidSpeed = SrcOutputData%LidSpeed + end if + if (allocated(SrcOutputData%WtTrunc)) then + LB(1:1) = lbound(SrcOutputData%WtTrunc) + UB(1:1) = ubound(SrcOutputData%WtTrunc) + if (.not. allocated(DstOutputData%WtTrunc)) then + allocate(DstOutputData%WtTrunc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WtTrunc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WtTrunc = SrcOutputData%WtTrunc + end if + if (allocated(SrcOutputData%MsrPositionsX)) then + LB(1:1) = lbound(SrcOutputData%MsrPositionsX) + UB(1:1) = ubound(SrcOutputData%MsrPositionsX) + if (.not. allocated(DstOutputData%MsrPositionsX)) then + allocate(DstOutputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%MsrPositionsX = SrcOutputData%MsrPositionsX + end if + if (allocated(SrcOutputData%MsrPositionsY)) then + LB(1:1) = lbound(SrcOutputData%MsrPositionsY) + UB(1:1) = ubound(SrcOutputData%MsrPositionsY) + if (.not. allocated(DstOutputData%MsrPositionsY)) then + allocate(DstOutputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%MsrPositionsY = SrcOutputData%MsrPositionsY + end if + if (allocated(SrcOutputData%MsrPositionsZ)) then + LB(1:1) = lbound(SrcOutputData%MsrPositionsZ) + UB(1:1) = ubound(SrcOutputData%MsrPositionsZ) + if (.not. allocated(DstOutputData%MsrPositionsZ)) then + allocate(DstOutputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%MsrPositionsZ = SrcOutputData%MsrPositionsZ + end if +end subroutine + +subroutine Lidar_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(Lidar_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%LidSpeed)) then + deallocate(OutputData%LidSpeed) + end if + if (allocated(OutputData%WtTrunc)) then + deallocate(OutputData%WtTrunc) + end if + if (allocated(OutputData%MsrPositionsX)) then + deallocate(OutputData%MsrPositionsX) + end if + if (allocated(OutputData%MsrPositionsY)) then + deallocate(OutputData%MsrPositionsY) + end if + if (allocated(OutputData%MsrPositionsZ)) then + deallocate(OutputData%MsrPositionsZ) + end if +end subroutine + +subroutine Lidar_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%LidSpeed)) + if (allocated(InData%LidSpeed)) then + call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) + call RegPack(Buf, InData%LidSpeed) + end if + call RegPack(Buf, allocated(InData%WtTrunc)) + if (allocated(InData%WtTrunc)) then + call RegPackBounds(Buf, 1, lbound(InData%WtTrunc), ubound(InData%WtTrunc)) + call RegPack(Buf, InData%WtTrunc) + end if + call RegPack(Buf, allocated(InData%MsrPositionsX)) + if (allocated(InData%MsrPositionsX)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) + call RegPack(Buf, InData%MsrPositionsX) + end if + call RegPack(Buf, allocated(InData%MsrPositionsY)) + if (allocated(InData%MsrPositionsY)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) + call RegPack(Buf, InData%MsrPositionsY) + end if + call RegPack(Buf, allocated(InData%MsrPositionsZ)) + if (allocated(InData%MsrPositionsZ)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) + call RegPack(Buf, InData%MsrPositionsZ) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LidSpeed(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LidSpeed) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WtTrunc)) deallocate(OutData%WtTrunc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WtTrunc(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WtTrunc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WtTrunc) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsY) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsZ) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine Lidar_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(Lidar_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(Lidar_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 = 'Lidar_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 Lidar_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Lidar_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 Lidar_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 Lidar_Input_ExtrapInterp - - - SUBROUTINE Lidar_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call Lidar_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Lidar_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Lidar_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE Lidar_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. @@ -2161,49 +1003,45 @@ SUBROUTINE Lidar_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(Lidar_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(Lidar_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Lidar_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 + TYPE(Lidar_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(Lidar_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(Lidar_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 = 'Lidar_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%PulseLidEl - u2%PulseLidEl) - u_out%PulseLidEl = u1%PulseLidEl + b * ScaleFactor - b = -(u1%PulseLidAz - u2%PulseLidAz) - u_out%PulseLidAz = u1%PulseLidAz + b * ScaleFactor - b = -(u1%HubDisplacementX - u2%HubDisplacementX) - u_out%HubDisplacementX = u1%HubDisplacementX + b * ScaleFactor - b = -(u1%HubDisplacementY - u2%HubDisplacementY) - u_out%HubDisplacementY = u1%HubDisplacementY + b * ScaleFactor - b = -(u1%HubDisplacementZ - u2%HubDisplacementZ) - u_out%HubDisplacementZ = u1%HubDisplacementZ + b * ScaleFactor - END SUBROUTINE Lidar_Input_ExtrapInterp1 - - - SUBROUTINE Lidar_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + u_out%PulseLidEl = a1*u1%PulseLidEl + a2*u2%PulseLidEl + u_out%PulseLidAz = a1*u1%PulseLidAz + a2*u2%PulseLidAz + u_out%HubDisplacementX = a1*u1%HubDisplacementX + a2*u2%HubDisplacementX + u_out%HubDisplacementY = a1*u1%HubDisplacementY + a2*u2%HubDisplacementY + u_out%HubDisplacementZ = a1*u1%HubDisplacementZ + a2*u2%HubDisplacementZ +END SUBROUTINE + +SUBROUTINE Lidar_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. @@ -2217,114 +1055,105 @@ SUBROUTINE Lidar_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(Lidar_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(Lidar_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(Lidar_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Lidar_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 + TYPE(Lidar_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(Lidar_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(Lidar_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(Lidar_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 = 'Lidar_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_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 + 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 + 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 + 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%PulseLidEl - u2%PulseLidEl) + t(2)**2*(-u1%PulseLidEl + u3%PulseLidEl))* scaleFactor - c = ( (t(2)-t(3))*u1%PulseLidEl + t(3)*u2%PulseLidEl - t(2)*u3%PulseLidEl ) * scaleFactor - u_out%PulseLidEl = u1%PulseLidEl + b + c * t_out - b = (t(3)**2*(u1%PulseLidAz - u2%PulseLidAz) + t(2)**2*(-u1%PulseLidAz + u3%PulseLidAz))* scaleFactor - c = ( (t(2)-t(3))*u1%PulseLidAz + t(3)*u2%PulseLidAz - t(2)*u3%PulseLidAz ) * scaleFactor - u_out%PulseLidAz = u1%PulseLidAz + b + c * t_out - b = (t(3)**2*(u1%HubDisplacementX - u2%HubDisplacementX) + t(2)**2*(-u1%HubDisplacementX + u3%HubDisplacementX))* scaleFactor - c = ( (t(2)-t(3))*u1%HubDisplacementX + t(3)*u2%HubDisplacementX - t(2)*u3%HubDisplacementX ) * scaleFactor - u_out%HubDisplacementX = u1%HubDisplacementX + b + c * t_out - b = (t(3)**2*(u1%HubDisplacementY - u2%HubDisplacementY) + t(2)**2*(-u1%HubDisplacementY + u3%HubDisplacementY))* scaleFactor - c = ( (t(2)-t(3))*u1%HubDisplacementY + t(3)*u2%HubDisplacementY - t(2)*u3%HubDisplacementY ) * scaleFactor - u_out%HubDisplacementY = u1%HubDisplacementY + b + c * t_out - b = (t(3)**2*(u1%HubDisplacementZ - u2%HubDisplacementZ) + t(2)**2*(-u1%HubDisplacementZ + u3%HubDisplacementZ))* scaleFactor - c = ( (t(2)-t(3))*u1%HubDisplacementZ + t(3)*u2%HubDisplacementZ - t(2)*u3%HubDisplacementZ ) * scaleFactor - u_out%HubDisplacementZ = u1%HubDisplacementZ + b + c * t_out - END SUBROUTINE Lidar_Input_ExtrapInterp2 - - - SUBROUTINE Lidar_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(Lidar_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Lidar_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + u_out%PulseLidEl = a1*u1%PulseLidEl + a2*u2%PulseLidEl + a3*u3%PulseLidEl + u_out%PulseLidAz = a1*u1%PulseLidAz + a2*u2%PulseLidAz + a3*u3%PulseLidAz + u_out%HubDisplacementX = a1*u1%HubDisplacementX + a2*u2%HubDisplacementX + a3*u3%HubDisplacementX + u_out%HubDisplacementY = a1*u1%HubDisplacementY + a2*u2%HubDisplacementY + a3*u3%HubDisplacementY + u_out%HubDisplacementZ = a1*u1%HubDisplacementZ + a2*u2%HubDisplacementZ + a3*u3%HubDisplacementZ +END SUBROUTINE + +subroutine Lidar_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(Lidar_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(Lidar_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 = 'Lidar_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 Lidar_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Lidar_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 Lidar_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 Lidar_Output_ExtrapInterp - - - SUBROUTINE Lidar_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call Lidar_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Lidar_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Lidar_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE Lidar_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. @@ -2336,71 +1165,57 @@ SUBROUTINE Lidar_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(Lidar_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(Lidar_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Lidar_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 + TYPE(Lidar_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(Lidar_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(Lidar_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 = 'Lidar_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN - DO i1 = LBOUND(y_out%LidSpeed,1),UBOUND(y_out%LidSpeed,1) - b = -(y1%LidSpeed(i1) - y2%LidSpeed(i1)) - y_out%LidSpeed(i1) = y1%LidSpeed(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN - DO i1 = LBOUND(y_out%WtTrunc,1),UBOUND(y_out%WtTrunc,1) - b = -(y1%WtTrunc(i1) - y2%WtTrunc(i1)) - y_out%WtTrunc(i1) = y1%WtTrunc(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsX) .AND. ALLOCATED(y1%MsrPositionsX)) THEN - DO i1 = LBOUND(y_out%MsrPositionsX,1),UBOUND(y_out%MsrPositionsX,1) - b = -(y1%MsrPositionsX(i1) - y2%MsrPositionsX(i1)) - y_out%MsrPositionsX(i1) = y1%MsrPositionsX(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsY) .AND. ALLOCATED(y1%MsrPositionsY)) THEN - DO i1 = LBOUND(y_out%MsrPositionsY,1),UBOUND(y_out%MsrPositionsY,1) - b = -(y1%MsrPositionsY(i1) - y2%MsrPositionsY(i1)) - y_out%MsrPositionsY(i1) = y1%MsrPositionsY(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsZ) .AND. ALLOCATED(y1%MsrPositionsZ)) THEN - DO i1 = LBOUND(y_out%MsrPositionsZ,1),UBOUND(y_out%MsrPositionsZ,1) - b = -(y1%MsrPositionsZ(i1) - y2%MsrPositionsZ(i1)) - y_out%MsrPositionsZ(i1) = y1%MsrPositionsZ(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE Lidar_Output_ExtrapInterp1 - - - SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN + y_out%LidSpeed = a1*y1%LidSpeed + a2*y2%LidSpeed + END IF ! check if allocated + IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN + y_out%WtTrunc = a1*y1%WtTrunc + a2*y2%WtTrunc + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsX) .AND. ALLOCATED(y1%MsrPositionsX)) THEN + y_out%MsrPositionsX = a1*y1%MsrPositionsX + a2*y2%MsrPositionsX + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsY) .AND. ALLOCATED(y1%MsrPositionsY)) THEN + y_out%MsrPositionsY = a1*y1%MsrPositionsY + a2*y2%MsrPositionsY + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsZ) .AND. ALLOCATED(y1%MsrPositionsZ)) THEN + y_out%MsrPositionsZ = a1*y1%MsrPositionsZ + a2*y2%MsrPositionsZ + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE Lidar_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. @@ -2414,82 +1229,62 @@ SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(Lidar_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(Lidar_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(Lidar_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Lidar_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 + TYPE(Lidar_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(Lidar_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(Lidar_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(Lidar_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 = 'Lidar_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_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 + 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 + 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 + 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%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN - DO i1 = LBOUND(y_out%LidSpeed,1),UBOUND(y_out%LidSpeed,1) - b = (t(3)**2*(y1%LidSpeed(i1) - y2%LidSpeed(i1)) + t(2)**2*(-y1%LidSpeed(i1) + y3%LidSpeed(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%LidSpeed(i1) + t(3)*y2%LidSpeed(i1) - t(2)*y3%LidSpeed(i1) ) * scaleFactor - y_out%LidSpeed(i1) = y1%LidSpeed(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN - DO i1 = LBOUND(y_out%WtTrunc,1),UBOUND(y_out%WtTrunc,1) - b = (t(3)**2*(y1%WtTrunc(i1) - y2%WtTrunc(i1)) + t(2)**2*(-y1%WtTrunc(i1) + y3%WtTrunc(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WtTrunc(i1) + t(3)*y2%WtTrunc(i1) - t(2)*y3%WtTrunc(i1) ) * scaleFactor - y_out%WtTrunc(i1) = y1%WtTrunc(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsX) .AND. ALLOCATED(y1%MsrPositionsX)) THEN - DO i1 = LBOUND(y_out%MsrPositionsX,1),UBOUND(y_out%MsrPositionsX,1) - b = (t(3)**2*(y1%MsrPositionsX(i1) - y2%MsrPositionsX(i1)) + t(2)**2*(-y1%MsrPositionsX(i1) + y3%MsrPositionsX(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%MsrPositionsX(i1) + t(3)*y2%MsrPositionsX(i1) - t(2)*y3%MsrPositionsX(i1) ) * scaleFactor - y_out%MsrPositionsX(i1) = y1%MsrPositionsX(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsY) .AND. ALLOCATED(y1%MsrPositionsY)) THEN - DO i1 = LBOUND(y_out%MsrPositionsY,1),UBOUND(y_out%MsrPositionsY,1) - b = (t(3)**2*(y1%MsrPositionsY(i1) - y2%MsrPositionsY(i1)) + t(2)**2*(-y1%MsrPositionsY(i1) + y3%MsrPositionsY(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%MsrPositionsY(i1) + t(3)*y2%MsrPositionsY(i1) - t(2)*y3%MsrPositionsY(i1) ) * scaleFactor - y_out%MsrPositionsY(i1) = y1%MsrPositionsY(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsZ) .AND. ALLOCATED(y1%MsrPositionsZ)) THEN - DO i1 = LBOUND(y_out%MsrPositionsZ,1),UBOUND(y_out%MsrPositionsZ,1) - b = (t(3)**2*(y1%MsrPositionsZ(i1) - y2%MsrPositionsZ(i1)) + t(2)**2*(-y1%MsrPositionsZ(i1) + y3%MsrPositionsZ(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%MsrPositionsZ(i1) + t(3)*y2%MsrPositionsZ(i1) - t(2)*y3%MsrPositionsZ(i1) ) * scaleFactor - y_out%MsrPositionsZ(i1) = y1%MsrPositionsZ(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE Lidar_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN + y_out%LidSpeed = a1*y1%LidSpeed + a2*y2%LidSpeed + a3*y3%LidSpeed + END IF ! check if allocated + IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN + y_out%WtTrunc = a1*y1%WtTrunc + a2*y2%WtTrunc + a3*y3%WtTrunc + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsX) .AND. ALLOCATED(y1%MsrPositionsX)) THEN + y_out%MsrPositionsX = a1*y1%MsrPositionsX + a2*y2%MsrPositionsX + a3*y3%MsrPositionsX + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsY) .AND. ALLOCATED(y1%MsrPositionsY)) THEN + y_out%MsrPositionsY = a1*y1%MsrPositionsY + a2*y2%MsrPositionsY + a3*y3%MsrPositionsY + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsZ) .AND. ALLOCATED(y1%MsrPositionsZ)) THEN + y_out%MsrPositionsZ = a1*y1%MsrPositionsZ + a2*y2%MsrPositionsZ + a3*y3%MsrPositionsZ + END IF ! check if allocated +END SUBROUTINE END MODULE Lidar_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 index f8acf9447f..ac349c062b 100644 --- a/modules/map/src/MAP_Fortran_Types.f90 +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -48,635 +48,273 @@ MODULE MAP_Fortran_Types ! ========= Lin_ParamType ======= TYPE, PUBLIC :: Lin_ParamType INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian (fortran-only) [-] - REAL(R8Ki) :: du !< determines size of the translational displacement perturbation for u (inputs) (fortran-only) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix (fortran-only) [-] + REAL(R8Ki) :: du = 0.0_R8Ki !< determines size of the translational displacement perturbation for u (inputs) (fortran-only) [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix (fortran-only) [-] END TYPE Lin_ParamType ! ======================= CONTAINS - SUBROUTINE MAP_Fortran_CopyLin_InitInputType( SrcLin_InitInputTypeData, DstLin_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lin_InitInputType), INTENT(IN) :: SrcLin_InitInputTypeData - TYPE(Lin_InitInputType), INTENT(INOUT) :: DstLin_InitInputTypeData - 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 = 'MAP_Fortran_CopyLin_InitInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstLin_InitInputTypeData%linearize = SrcLin_InitInputTypeData%linearize - END SUBROUTINE MAP_Fortran_CopyLin_InitInputType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MAP_Fortran_DestroyLin_InitInputType - - SUBROUTINE MAP_Fortran_PackLin_InitInputType( 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(Lin_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 = 'MAP_Fortran_PackLin_InitInputType' - ! 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 ! linearize - 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) = TRANSFER(InData%linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MAP_Fortran_PackLin_InitInputType - - SUBROUTINE MAP_Fortran_UnPackLin_InitInputType( 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(Lin_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_UnPackLin_InitInputType' - ! 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%linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%linearize) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MAP_Fortran_UnPackLin_InitInputType - - SUBROUTINE MAP_Fortran_CopyLin_InitOutputType( SrcLin_InitOutputTypeData, DstLin_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lin_InitOutputType), INTENT(IN) :: SrcLin_InitOutputTypeData - TYPE(Lin_InitOutputType), INTENT(INOUT) :: DstLin_InitOutputTypeData - 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 = 'MAP_Fortran_CopyLin_InitOutputType' -! +subroutine MAP_Fortran_CopyLin_InitInputType(SrcLin_InitInputTypeData, DstLin_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Lin_InitInputType), intent(in) :: SrcLin_InitInputTypeData + type(Lin_InitInputType), intent(inout) :: DstLin_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_InitInputType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcLin_InitOutputTypeData%LinNames_y)) THEN - i1_l = LBOUND(SrcLin_InitOutputTypeData%LinNames_y,1) - i1_u = UBOUND(SrcLin_InitOutputTypeData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstLin_InitOutputTypeData%LinNames_y)) THEN - ALLOCATE(DstLin_InitOutputTypeData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLin_InitOutputTypeData%LinNames_y = SrcLin_InitOutputTypeData%LinNames_y -ENDIF -IF (ALLOCATED(SrcLin_InitOutputTypeData%LinNames_u)) THEN - i1_l = LBOUND(SrcLin_InitOutputTypeData%LinNames_u,1) - i1_u = UBOUND(SrcLin_InitOutputTypeData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstLin_InitOutputTypeData%LinNames_u)) THEN - ALLOCATE(DstLin_InitOutputTypeData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLin_InitOutputTypeData%LinNames_u = SrcLin_InitOutputTypeData%LinNames_u -ENDIF -IF (ALLOCATED(SrcLin_InitOutputTypeData%IsLoad_u)) THEN - i1_l = LBOUND(SrcLin_InitOutputTypeData%IsLoad_u,1) - i1_u = UBOUND(SrcLin_InitOutputTypeData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstLin_InitOutputTypeData%IsLoad_u)) THEN - ALLOCATE(DstLin_InitOutputTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLin_InitOutputTypeData%IsLoad_u = SrcLin_InitOutputTypeData%IsLoad_u -ENDIF - END SUBROUTINE MAP_Fortran_CopyLin_InitOutputType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_InitOutputType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Lin_InitOutputTypeData%LinNames_y)) THEN - DEALLOCATE(Lin_InitOutputTypeData%LinNames_y) -ENDIF -IF (ALLOCATED(Lin_InitOutputTypeData%LinNames_u)) THEN - DEALLOCATE(Lin_InitOutputTypeData%LinNames_u) -ENDIF -IF (ALLOCATED(Lin_InitOutputTypeData%IsLoad_u)) THEN - DEALLOCATE(Lin_InitOutputTypeData%IsLoad_u) -ENDIF - END SUBROUTINE MAP_Fortran_DestroyLin_InitOutputType + ErrMsg = '' + DstLin_InitInputTypeData%linearize = SrcLin_InitInputTypeData%linearize +end subroutine - SUBROUTINE MAP_Fortran_PackLin_InitOutputType( 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(Lin_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 = 'MAP_Fortran_PackLin_InitOutputType' - ! 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 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - 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%LinNames_y) ) 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%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) 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%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) 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%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MAP_Fortran_PackLin_InitOutputType - - SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType( 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(Lin_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 = 'MAP_Fortran_UnPackLin_InitOutputType' - ! 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 ! LinNames_y 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%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(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 ! LinNames_u 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%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(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 ! IsLoad_u 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%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType - - SUBROUTINE MAP_Fortran_CopyLin_ParamType( SrcLin_ParamTypeData, DstLin_ParamTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lin_ParamType), INTENT(IN) :: SrcLin_ParamTypeData - TYPE(Lin_ParamType), INTENT(INOUT) :: DstLin_ParamTypeData - 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 = 'MAP_Fortran_CopyLin_ParamType' -! +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 + character(*), parameter :: RoutineName = 'MAP_Fortran_DestroyLin_InitInputType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcLin_ParamTypeData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcLin_ParamTypeData%Jac_u_indx,1) - i1_u = UBOUND(SrcLin_ParamTypeData%Jac_u_indx,1) - i2_l = LBOUND(SrcLin_ParamTypeData%Jac_u_indx,2) - i2_u = UBOUND(SrcLin_ParamTypeData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstLin_ParamTypeData%Jac_u_indx)) THEN - ALLOCATE(DstLin_ParamTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_ParamTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLin_ParamTypeData%Jac_u_indx = SrcLin_ParamTypeData%Jac_u_indx -ENDIF - DstLin_ParamTypeData%du = SrcLin_ParamTypeData%du - DstLin_ParamTypeData%Jac_ny = SrcLin_ParamTypeData%Jac_ny - END SUBROUTINE MAP_Fortran_CopyLin_ParamType + ErrMsg = '' +end subroutine - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_ParamType' +subroutine MAP_Fortran_PackLin_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lin_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine - ErrStat = ErrID_None - ErrMsg = "" +subroutine MAP_Fortran_UnPackLin_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lin_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine -IF (ALLOCATED(Lin_ParamTypeData%Jac_u_indx)) THEN - DEALLOCATE(Lin_ParamTypeData%Jac_u_indx) -ENDIF - END SUBROUTINE MAP_Fortran_DestroyLin_ParamType +subroutine MAP_Fortran_CopyLin_InitOutputType(SrcLin_InitOutputTypeData, DstLin_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Lin_InitOutputType), intent(in) :: SrcLin_InitOutputTypeData + type(Lin_InitOutputType), intent(inout) :: DstLin_InitOutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_InitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcLin_InitOutputTypeData%LinNames_y)) then + LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_y) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_y) + if (.not. allocated(DstLin_InitOutputTypeData%LinNames_y)) then + allocate(DstLin_InitOutputTypeData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_InitOutputTypeData%LinNames_y = SrcLin_InitOutputTypeData%LinNames_y + end if + if (allocated(SrcLin_InitOutputTypeData%LinNames_u)) then + LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_u) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_u) + if (.not. allocated(DstLin_InitOutputTypeData%LinNames_u)) then + allocate(DstLin_InitOutputTypeData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_InitOutputTypeData%LinNames_u = SrcLin_InitOutputTypeData%LinNames_u + end if + if (allocated(SrcLin_InitOutputTypeData%IsLoad_u)) then + LB(1:1) = lbound(SrcLin_InitOutputTypeData%IsLoad_u) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%IsLoad_u) + if (.not. allocated(DstLin_InitOutputTypeData%IsLoad_u)) then + allocate(DstLin_InitOutputTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_InitOutputTypeData%IsLoad_u = SrcLin_InitOutputTypeData%IsLoad_u + end if +end subroutine - SUBROUTINE MAP_Fortran_PackLin_ParamType( 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(Lin_ParamType), 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 = 'MAP_Fortran_PackLin_ParamType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) +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 + character(*), parameter :: RoutineName = 'MAP_Fortran_DestroyLin_InitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Lin_InitOutputTypeData%LinNames_y)) then + deallocate(Lin_InitOutputTypeData%LinNames_y) + end if + if (allocated(Lin_InitOutputTypeData%LinNames_u)) then + deallocate(Lin_InitOutputTypeData%LinNames_u) + end if + if (allocated(Lin_InitOutputTypeData%IsLoad_u)) then + deallocate(Lin_InitOutputTypeData%IsLoad_u) + end if +end subroutine - 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 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Db_BufSz = Db_BufSz + 1 ! du - Int_BufSz = Int_BufSz + 1 ! Jac_ny - 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) +subroutine MAP_Fortran_PackLin_InitOutputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lin_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_InitOutputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 +subroutine MAP_Fortran_UnPackLin_InitOutputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lin_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_InitOutputType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) 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%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 +subroutine MAP_Fortran_CopyLin_ParamType(SrcLin_ParamTypeData, DstLin_ParamTypeData, CtrlCode, ErrStat, ErrMsg) + type(Lin_ParamType), intent(in) :: SrcLin_ParamTypeData + type(Lin_ParamType), intent(inout) :: DstLin_ParamTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_ParamType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcLin_ParamTypeData%Jac_u_indx)) then + LB(1:2) = lbound(SrcLin_ParamTypeData%Jac_u_indx) + UB(1:2) = ubound(SrcLin_ParamTypeData%Jac_u_indx) + if (.not. allocated(DstLin_ParamTypeData%Jac_u_indx)) then + allocate(DstLin_ParamTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_ParamTypeData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_ParamTypeData%Jac_u_indx = SrcLin_ParamTypeData%Jac_u_indx + end if + DstLin_ParamTypeData%du = SrcLin_ParamTypeData%du + DstLin_ParamTypeData%Jac_ny = SrcLin_ParamTypeData%Jac_ny +end subroutine - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%du - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MAP_Fortran_PackLin_ParamType +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 + character(*), parameter :: RoutineName = 'MAP_Fortran_DestroyLin_ParamType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Lin_ParamTypeData%Jac_u_indx)) then + deallocate(Lin_ParamTypeData%Jac_u_indx) + end if +end subroutine - SUBROUTINE MAP_Fortran_UnPackLin_ParamType( 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(Lin_ParamType), 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 = 'MAP_Fortran_UnPackLin_ParamType' - ! 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 ! Jac_u_indx 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%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%du = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MAP_Fortran_UnPackLin_ParamType +subroutine MAP_Fortran_PackLin_ParamType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lin_ParamType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_ParamType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + call RegPack(Buf, InData%du) + call RegPack(Buf, InData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine MAP_Fortran_UnPackLin_ParamType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lin_ParamType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_ParamType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE MAP_Fortran_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index af459d0bdf..3df4cf9291 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -90,7 +90,7 @@ MODULE MAP_Types END TYPE MAP_ContinuousStateType_C TYPE, PUBLIC :: MAP_ContinuousStateType TYPE( MAP_ContinuousStateType_C ) :: C_obj - REAL(R8Ki) :: dummy !< Remove this variable if you have continuous states [-] + REAL(R8Ki) :: dummy = 0.0_R8Ki !< Remove this variable if you have continuous states [-] END TYPE MAP_ContinuousStateType ! ======================= ! ========= MAP_DiscreteStateType_C ======= @@ -100,7 +100,7 @@ MODULE MAP_Types END TYPE MAP_DiscreteStateType_C TYPE, PUBLIC :: MAP_DiscreteStateType TYPE( MAP_DiscreteStateType_C ) :: C_obj - REAL(R8Ki) :: dummy !< Remove this variable if you have discrete states [-] + REAL(R8Ki) :: dummy = 0.0_R8Ki !< Remove this variable if you have discrete states [-] END TYPE MAP_DiscreteStateType ! ======================= ! ========= MAP_OtherStateType_C ======= @@ -193,10 +193,10 @@ MODULE MAP_Types END TYPE MAP_ParameterType_C TYPE, PUBLIC :: MAP_ParameterType TYPE( MAP_ParameterType_C ) :: C_obj - REAL(R8Ki) :: g !< gravitational constant [[kg/m^2]] - REAL(R8Ki) :: depth !< distance to seabed [[m]] - REAL(R8Ki) :: rho_sea !< density of seawater [[m]] - REAL(R8Ki) :: dt !< time step coupling interval [[sec]] + REAL(R8Ki) :: g = 0.0_R8Ki !< gravitational constant [[kg/m^2]] + REAL(R8Ki) :: depth = 0.0_R8Ki !< distance to seabed [[m]] + REAL(R8Ki) :: rho_sea = 0.0_R8Ki !< density of seawater [[m]] + REAL(R8Ki) :: dt = 0.0_R8Ki !< time step coupling interval [[sec]] CHARACTER(255) , DIMENSION(1:500) :: InputLines !< input file line for restart [-] CHARACTER(1) , DIMENSION(1:500) :: InputLineType !< input file line type for restart [-] INTEGER(IntKi) :: numOuts = 0 !< Number of write outputs [-] @@ -246,4796 +246,3203 @@ MODULE MAP_Types END TYPE MAP_OutputType ! ======================= CONTAINS - SUBROUTINE MAP_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(MAP_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + +subroutine MAP_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(MAP_InitInputType), intent(in) :: SrcInitInputData + type(MAP_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%gravity = SrcInitInputData%gravity + DstInitInputData%C_obj%gravity = SrcInitInputData%C_obj%gravity + DstInitInputData%sea_density = SrcInitInputData%sea_density + DstInitInputData%C_obj%sea_density = SrcInitInputData%C_obj%sea_density + DstInitInputData%depth = SrcInitInputData%depth + DstInitInputData%C_obj%depth = SrcInitInputData%C_obj%depth + DstInitInputData%file_name = SrcInitInputData%file_name + DstInitInputData%C_obj%file_name = SrcInitInputData%C_obj%file_name + DstInitInputData%summary_file_name = SrcInitInputData%summary_file_name + DstInitInputData%C_obj%summary_file_name = SrcInitInputData%C_obj%summary_file_name + DstInitInputData%library_input_str = SrcInitInputData%library_input_str + DstInitInputData%C_obj%library_input_str = SrcInitInputData%C_obj%library_input_str + DstInitInputData%node_input_str = SrcInitInputData%node_input_str + DstInitInputData%C_obj%node_input_str = SrcInitInputData%C_obj%node_input_str + DstInitInputData%line_input_str = SrcInitInputData%line_input_str + DstInitInputData%C_obj%line_input_str = SrcInitInputData%C_obj%line_input_str + DstInitInputData%option_input_str = SrcInitInputData%option_input_str + DstInitInputData%C_obj%option_input_str = SrcInitInputData%C_obj%option_input_str + call MAP_Fortran_CopyLin_InitInputType(SrcInitInputData%LinInitInp, DstInitInputData%LinInitInp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine MAP_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(MAP_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + call MAP_Fortran_DestroyLin_InitInputType(InitInputData%LinInitInp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine MAP_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, InData%gravity) + call RegPack(Buf, InData%sea_density) + call RegPack(Buf, InData%depth) + call RegPack(Buf, InData%file_name) + call RegPack(Buf, InData%summary_file_name) + call RegPack(Buf, InData%library_input_str) + call RegPack(Buf, InData%node_input_str) + call RegPack(Buf, InData%line_input_str) + call RegPack(Buf, InData%option_input_str) + call MAP_Fortran_PackLin_InitInputType(Buf, InData%LinInitInp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%gravity) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%gravity = OutData%gravity + call RegUnpack(Buf, OutData%sea_density) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%sea_density = OutData%sea_density + call RegUnpack(Buf, OutData%depth) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%depth = OutData%depth + call RegUnpack(Buf, OutData%file_name) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%file_name = transfer(OutData%file_name, OutData%C_obj%file_name ) + call RegUnpack(Buf, OutData%summary_file_name) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%summary_file_name = transfer(OutData%summary_file_name, OutData%C_obj%summary_file_name ) + call RegUnpack(Buf, OutData%library_input_str) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%library_input_str = transfer(OutData%library_input_str, OutData%C_obj%library_input_str ) + call RegUnpack(Buf, OutData%node_input_str) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%node_input_str = transfer(OutData%node_input_str, OutData%C_obj%node_input_str ) + call RegUnpack(Buf, OutData%line_input_str) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%line_input_str = transfer(OutData%line_input_str, OutData%C_obj%line_input_str ) + call RegUnpack(Buf, OutData%option_input_str) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%option_input_str = transfer(OutData%option_input_str, OutData%C_obj%option_input_str ) + call MAP_Fortran_UnpackLin_InitInputType(Buf, OutData%LinInitInp) ! LinInitInp +end subroutine + +SUBROUTINE MAP_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_CopyInitInput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - DstInitInputData%gravity = SrcInitInputData%gravity - DstInitInputData%C_obj%gravity = SrcInitInputData%C_obj%gravity - DstInitInputData%sea_density = SrcInitInputData%sea_density - DstInitInputData%C_obj%sea_density = SrcInitInputData%C_obj%sea_density - DstInitInputData%depth = SrcInitInputData%depth - DstInitInputData%C_obj%depth = SrcInitInputData%C_obj%depth - DstInitInputData%file_name = SrcInitInputData%file_name - DstInitInputData%C_obj%file_name = SrcInitInputData%C_obj%file_name - DstInitInputData%summary_file_name = SrcInitInputData%summary_file_name - DstInitInputData%C_obj%summary_file_name = SrcInitInputData%C_obj%summary_file_name - DstInitInputData%library_input_str = SrcInitInputData%library_input_str - DstInitInputData%C_obj%library_input_str = SrcInitInputData%C_obj%library_input_str - DstInitInputData%node_input_str = SrcInitInputData%node_input_str - DstInitInputData%C_obj%node_input_str = SrcInitInputData%C_obj%node_input_str - DstInitInputData%line_input_str = SrcInitInputData%line_input_str - DstInitInputData%C_obj%line_input_str = SrcInitInputData%C_obj%line_input_str - DstInitInputData%option_input_str = SrcInitInputData%option_input_str - DstInitInputData%C_obj%option_input_str = SrcInitInputData%C_obj%option_input_str - CALL MAP_Fortran_Copylin_initinputtype( SrcInitInputData%LinInitInp, DstInitInputData%LinInitInp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE MAP_CopyInitInput - - SUBROUTINE MAP_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(MAP_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 = 'MAP_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MAP_Fortran_DestroyLin_InitInputType( InitInputData%LinInitInp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE MAP_DestroyInitInput + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%gravity = InitInputData%C_obj%gravity + InitInputData%sea_density = InitInputData%C_obj%sea_density + InitInputData%depth = InitInputData%C_obj%depth + InitInputData%file_name = TRANSFER(InitInputData%C_obj%file_name, InitInputData%file_name ) + InitInputData%summary_file_name = TRANSFER(InitInputData%C_obj%summary_file_name, InitInputData%summary_file_name ) + InitInputData%library_input_str = TRANSFER(InitInputData%C_obj%library_input_str, InitInputData%library_input_str ) + InitInputData%node_input_str = TRANSFER(InitInputData%C_obj%node_input_str, InitInputData%node_input_str ) + InitInputData%line_input_str = TRANSFER(InitInputData%C_obj%line_input_str, InitInputData%line_input_str ) + InitInputData%option_input_str = TRANSFER(InitInputData%C_obj%option_input_str, InitInputData%option_input_str ) +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%C_obj%gravity = InitInputData%gravity + InitInputData%C_obj%sea_density = InitInputData%sea_density + InitInputData%C_obj%depth = InitInputData%depth + InitInputData%C_obj%file_name = TRANSFER(InitInputData%file_name, InitInputData%C_obj%file_name) + InitInputData%C_obj%summary_file_name = TRANSFER(InitInputData%summary_file_name, InitInputData%C_obj%summary_file_name) + InitInputData%C_obj%library_input_str = TRANSFER(InitInputData%library_input_str, InitInputData%C_obj%library_input_str) + InitInputData%C_obj%node_input_str = TRANSFER(InitInputData%node_input_str, InitInputData%C_obj%node_input_str) + InitInputData%C_obj%line_input_str = TRANSFER(InitInputData%line_input_str, InitInputData%C_obj%line_input_str) + InitInputData%C_obj%option_input_str = TRANSFER(InitInputData%option_input_str, InitInputData%C_obj%option_input_str) +END SUBROUTINE + +subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(MAP_InitOutputType), intent(in) :: SrcInitOutputData + type(MAP_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitOutputData%progName = SrcInitOutputData%progName + DstInitOutputData%C_obj%progName = SrcInitOutputData%C_obj%progName + DstInitOutputData%version = SrcInitOutputData%version + DstInitOutputData%C_obj%version = SrcInitOutputData%C_obj%version + DstInitOutputData%compilingData = SrcInitOutputData%compilingData + DstInitOutputData%C_obj%compilingData = SrcInitOutputData%C_obj%compilingData + if (allocated(SrcInitOutputData%writeOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr) + if (.not. allocated(DstInitOutputData%writeOutputHdr)) then + allocate(DstInitOutputData%writeOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%writeOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt) + if (.not. allocated(DstInitOutputData%writeOutputUnt)) then + allocate(DstInitOutputData%writeOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_Fortran_CopyLin_InitOutputType(SrcInitOutputData%LinInitOut, DstInitOutputData%LinInitOut, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine MAP_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(MAP_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%writeOutputHdr)) then + deallocate(InitOutputData%writeOutputHdr) + end if + if (allocated(InitOutputData%writeOutputUnt)) then + deallocate(InitOutputData%writeOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_Fortran_DestroyLin_InitOutputType(InitOutputData%LinInitOut, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine MAP_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, InData%progName) + call RegPack(Buf, InData%version) + call RegPack(Buf, InData%compilingData) + call RegPack(Buf, allocated(InData%writeOutputHdr)) + if (allocated(InData%writeOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%writeOutputHdr), ubound(InData%writeOutputHdr)) + call RegPack(Buf, InData%writeOutputHdr) + end if + call RegPack(Buf, allocated(InData%writeOutputUnt)) + if (allocated(InData%writeOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%writeOutputUnt), ubound(InData%writeOutputUnt)) + call RegPack(Buf, InData%writeOutputUnt) + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call MAP_Fortran_PackLin_InitOutputType(Buf, InData%LinInitOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%progName) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%progName = transfer(OutData%progName, OutData%C_obj%progName ) + call RegUnpack(Buf, OutData%version) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%version = transfer(OutData%version, OutData%C_obj%version ) + call RegUnpack(Buf, OutData%compilingData) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%compilingData = transfer(OutData%compilingData, OutData%C_obj%compilingData ) + if (allocated(OutData%writeOutputHdr)) deallocate(OutData%writeOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%writeOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%writeOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%writeOutputUnt)) deallocate(OutData%writeOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%writeOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%writeOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + call MAP_Fortran_UnpackLin_InitOutputType(Buf, OutData%LinInitOut) ! LinInitOut +end subroutine + +SUBROUTINE MAP_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitOutputData%progName = TRANSFER(InitOutputData%C_obj%progName, InitOutputData%progName ) + InitOutputData%version = TRANSFER(InitOutputData%C_obj%version, InitOutputData%version ) + InitOutputData%compilingData = TRANSFER(InitOutputData%C_obj%compilingData, InitOutputData%compilingData ) +END SUBROUTINE - SUBROUTINE MAP_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(MAP_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 = 'MAP_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) +SUBROUTINE MAP_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitOutputData%C_obj%progName = TRANSFER(InitOutputData%progName, InitOutputData%C_obj%progName) + InitOutputData%C_obj%version = TRANSFER(InitOutputData%version, InitOutputData%C_obj%version) + InitOutputData%C_obj%compilingData = TRANSFER(InitOutputData%compilingData, InitOutputData%C_obj%compilingData) +END SUBROUTINE + +subroutine MAP_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(MAP_ContinuousStateType), intent(in) :: SrcContStateData + type(MAP_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%dummy = SrcContStateData%dummy + DstContStateData%C_obj%dummy = SrcContStateData%C_obj%dummy +end subroutine + +subroutine MAP_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(MAP_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MAP_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%dummy = OutData%dummy +end subroutine + +SUBROUTINE MAP_C2Fary_CopyContState(ContStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ContStateData%dummy = ContStateData%C_obj%dummy +END SUBROUTINE - 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 ! gravity - Db_BufSz = Db_BufSz + 1 ! sea_density - Db_BufSz = Db_BufSz + 1 ! depth - Int_BufSz = Int_BufSz + 1*LEN(InData%file_name) ! file_name - Int_BufSz = Int_BufSz + 1*LEN(InData%summary_file_name) ! summary_file_name - Int_BufSz = Int_BufSz + 1*LEN(InData%library_input_str) ! library_input_str - Int_BufSz = Int_BufSz + 1*LEN(InData%node_input_str) ! node_input_str - Int_BufSz = Int_BufSz + 1*LEN(InData%line_input_str) ! line_input_str - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +SUBROUTINE MAP_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ContStateData%C_obj%dummy = ContStateData%dummy +END SUBROUTINE + +subroutine MAP_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(MAP_DiscreteStateType), intent(in) :: SrcDiscStateData + type(MAP_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%dummy = SrcDiscStateData%dummy + DstDiscStateData%C_obj%dummy = SrcDiscStateData%C_obj%dummy +end subroutine + +subroutine MAP_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(MAP_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MAP_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%dummy = OutData%dummy +end subroutine + +SUBROUTINE MAP_C2Fary_CopyDiscState(DiscStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + DiscStateData%dummy = DiscStateData%C_obj%dummy +END SUBROUTINE - IF(ALLOCATED(Re_Buf)) THEN ! LinInitInp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) +SUBROUTINE MAP_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + DiscStateData%C_obj%dummy = DiscStateData%dummy +END SUBROUTINE + +subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(MAP_OtherStateType), intent(in) :: SrcOtherStateData + type(MAP_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MAP_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcOtherStateData%H)) then + LB(1:1) = lbound(SrcOtherStateData%H) + UB(1:1) = ubound(SrcOtherStateData%H) + if (.not. associated(DstOtherStateData%H)) then + allocate(DstOtherStateData%H(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%H = SrcOtherStateData%H + end if + if (associated(SrcOtherStateData%V)) then + LB(1:1) = lbound(SrcOtherStateData%V) + UB(1:1) = ubound(SrcOtherStateData%V) + if (.not. associated(DstOtherStateData%V)) then + allocate(DstOtherStateData%V(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%V = SrcOtherStateData%V + end if + if (associated(SrcOtherStateData%Ha)) then + LB(1:1) = lbound(SrcOtherStateData%Ha) + UB(1:1) = ubound(SrcOtherStateData%Ha) + if (.not. associated(DstOtherStateData%Ha)) then + allocate(DstOtherStateData%Ha(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%Ha = SrcOtherStateData%Ha + end if + if (associated(SrcOtherStateData%Va)) then + LB(1:1) = lbound(SrcOtherStateData%Va) + UB(1:1) = ubound(SrcOtherStateData%Va) + if (.not. associated(DstOtherStateData%Va)) then + allocate(DstOtherStateData%Va(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%Va = SrcOtherStateData%Va + end if + if (associated(SrcOtherStateData%x)) then + LB(1:1) = lbound(SrcOtherStateData%x) + UB(1:1) = ubound(SrcOtherStateData%x) + if (.not. associated(DstOtherStateData%x)) then + allocate(DstOtherStateData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%x = SrcOtherStateData%x + end if + if (associated(SrcOtherStateData%y)) then + LB(1:1) = lbound(SrcOtherStateData%y) + UB(1:1) = ubound(SrcOtherStateData%y) + if (.not. associated(DstOtherStateData%y)) then + allocate(DstOtherStateData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%y = SrcOtherStateData%y + end if + if (associated(SrcOtherStateData%z)) then + LB(1:1) = lbound(SrcOtherStateData%z) + UB(1:1) = ubound(SrcOtherStateData%z) + if (.not. associated(DstOtherStateData%z)) then + allocate(DstOtherStateData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%z = SrcOtherStateData%z + end if + if (associated(SrcOtherStateData%xa)) then + LB(1:1) = lbound(SrcOtherStateData%xa) + UB(1:1) = ubound(SrcOtherStateData%xa) + if (.not. associated(DstOtherStateData%xa)) then + allocate(DstOtherStateData%xa(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%xa = SrcOtherStateData%xa + end if + if (associated(SrcOtherStateData%ya)) then + LB(1:1) = lbound(SrcOtherStateData%ya) + UB(1:1) = ubound(SrcOtherStateData%ya) + if (.not. associated(DstOtherStateData%ya)) then + allocate(DstOtherStateData%ya(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%ya = SrcOtherStateData%ya + end if + if (associated(SrcOtherStateData%za)) then + LB(1:1) = lbound(SrcOtherStateData%za) + UB(1:1) = ubound(SrcOtherStateData%za) + if (.not. associated(DstOtherStateData%za)) then + allocate(DstOtherStateData%za(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%za = SrcOtherStateData%za + end if + if (associated(SrcOtherStateData%Fx_connect)) then + LB(1:1) = lbound(SrcOtherStateData%Fx_connect) + UB(1:1) = ubound(SrcOtherStateData%Fx_connect) + if (.not. associated(DstOtherStateData%Fx_connect)) then + allocate(DstOtherStateData%Fx_connect(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%Fx_connect = SrcOtherStateData%Fx_connect + end if + if (associated(SrcOtherStateData%Fy_connect)) then + LB(1:1) = lbound(SrcOtherStateData%Fy_connect) + UB(1:1) = ubound(SrcOtherStateData%Fy_connect) + if (.not. associated(DstOtherStateData%Fy_connect)) then + allocate(DstOtherStateData%Fy_connect(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%Fy_connect = SrcOtherStateData%Fy_connect + end if + if (associated(SrcOtherStateData%Fz_connect)) then + LB(1:1) = lbound(SrcOtherStateData%Fz_connect) + UB(1:1) = ubound(SrcOtherStateData%Fz_connect) + if (.not. associated(DstOtherStateData%Fz_connect)) then + allocate(DstOtherStateData%Fz_connect(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%Fz_connect = SrcOtherStateData%Fz_connect + end if + if (associated(SrcOtherStateData%Fx_anchor)) then + LB(1:1) = lbound(SrcOtherStateData%Fx_anchor) + UB(1:1) = ubound(SrcOtherStateData%Fx_anchor) + if (.not. associated(DstOtherStateData%Fx_anchor)) then + allocate(DstOtherStateData%Fx_anchor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%Fx_anchor = SrcOtherStateData%Fx_anchor + end if + if (associated(SrcOtherStateData%Fy_anchor)) then + LB(1:1) = lbound(SrcOtherStateData%Fy_anchor) + UB(1:1) = ubound(SrcOtherStateData%Fy_anchor) + if (.not. associated(DstOtherStateData%Fy_anchor)) then + allocate(DstOtherStateData%Fy_anchor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%Fy_anchor = SrcOtherStateData%Fy_anchor + end if + if (associated(SrcOtherStateData%Fz_anchor)) then + LB(1:1) = lbound(SrcOtherStateData%Fz_anchor) + UB(1:1) = ubound(SrcOtherStateData%Fz_anchor) + if (.not. associated(DstOtherStateData%Fz_anchor)) then + allocate(DstOtherStateData%Fz_anchor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOtherStateData%Fz_anchor = SrcOtherStateData%Fz_anchor + end if +end subroutine + +subroutine MAP_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(MAP_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(OtherStateData%H)) then + deallocate(OtherStateData%H) + OtherStateData%H => null() + OtherStateData%C_obj%H = c_null_ptr + OtherStateData%C_obj%H_Len = 0 + end if + if (associated(OtherStateData%V)) then + deallocate(OtherStateData%V) + OtherStateData%V => null() + OtherStateData%C_obj%V = c_null_ptr + OtherStateData%C_obj%V_Len = 0 + end if + if (associated(OtherStateData%Ha)) then + deallocate(OtherStateData%Ha) + OtherStateData%Ha => null() + OtherStateData%C_obj%Ha = c_null_ptr + OtherStateData%C_obj%Ha_Len = 0 + end if + if (associated(OtherStateData%Va)) then + deallocate(OtherStateData%Va) + OtherStateData%Va => null() + OtherStateData%C_obj%Va = c_null_ptr + OtherStateData%C_obj%Va_Len = 0 + end if + if (associated(OtherStateData%x)) then + deallocate(OtherStateData%x) + OtherStateData%x => null() + OtherStateData%C_obj%x = c_null_ptr + OtherStateData%C_obj%x_Len = 0 + end if + if (associated(OtherStateData%y)) then + deallocate(OtherStateData%y) + OtherStateData%y => null() + OtherStateData%C_obj%y = c_null_ptr + OtherStateData%C_obj%y_Len = 0 + end if + if (associated(OtherStateData%z)) then + deallocate(OtherStateData%z) + OtherStateData%z => null() + OtherStateData%C_obj%z = c_null_ptr + OtherStateData%C_obj%z_Len = 0 + end if + if (associated(OtherStateData%xa)) then + deallocate(OtherStateData%xa) + OtherStateData%xa => null() + OtherStateData%C_obj%xa = c_null_ptr + OtherStateData%C_obj%xa_Len = 0 + end if + if (associated(OtherStateData%ya)) then + deallocate(OtherStateData%ya) + OtherStateData%ya => null() + OtherStateData%C_obj%ya = c_null_ptr + OtherStateData%C_obj%ya_Len = 0 + end if + if (associated(OtherStateData%za)) then + deallocate(OtherStateData%za) + OtherStateData%za => null() + OtherStateData%C_obj%za = c_null_ptr + OtherStateData%C_obj%za_Len = 0 + end if + if (associated(OtherStateData%Fx_connect)) then + deallocate(OtherStateData%Fx_connect) + OtherStateData%Fx_connect => null() + OtherStateData%C_obj%Fx_connect = c_null_ptr + OtherStateData%C_obj%Fx_connect_Len = 0 + end if + if (associated(OtherStateData%Fy_connect)) then + deallocate(OtherStateData%Fy_connect) + OtherStateData%Fy_connect => null() + OtherStateData%C_obj%Fy_connect = c_null_ptr + OtherStateData%C_obj%Fy_connect_Len = 0 + end if + if (associated(OtherStateData%Fz_connect)) then + deallocate(OtherStateData%Fz_connect) + OtherStateData%Fz_connect => null() + OtherStateData%C_obj%Fz_connect = c_null_ptr + OtherStateData%C_obj%Fz_connect_Len = 0 + end if + if (associated(OtherStateData%Fx_anchor)) then + deallocate(OtherStateData%Fx_anchor) + OtherStateData%Fx_anchor => null() + OtherStateData%C_obj%Fx_anchor = c_null_ptr + OtherStateData%C_obj%Fx_anchor_Len = 0 + end if + if (associated(OtherStateData%Fy_anchor)) then + deallocate(OtherStateData%Fy_anchor) + OtherStateData%Fy_anchor => null() + OtherStateData%C_obj%Fy_anchor = c_null_ptr + OtherStateData%C_obj%Fy_anchor_Len = 0 + end if + if (associated(OtherStateData%Fz_anchor)) then + deallocate(OtherStateData%Fz_anchor) + OtherStateData%Fz_anchor => null() + OtherStateData%C_obj%Fz_anchor = c_null_ptr + OtherStateData%C_obj%Fz_anchor_Len = 0 + end if +end subroutine + +subroutine MAP_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackOtherState' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, associated(InData%H)) + if (associated(InData%H)) then + call RegPackBounds(Buf, 1, lbound(InData%H), ubound(InData%H)) + call RegPackPointer(Buf, c_loc(InData%H), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%H) + end if + end if + call RegPack(Buf, associated(InData%V)) + if (associated(InData%V)) then + call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) + call RegPackPointer(Buf, c_loc(InData%V), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%V) + end if + end if + call RegPack(Buf, associated(InData%Ha)) + if (associated(InData%Ha)) then + call RegPackBounds(Buf, 1, lbound(InData%Ha), ubound(InData%Ha)) + call RegPackPointer(Buf, c_loc(InData%Ha), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Ha) + end if + end if + call RegPack(Buf, associated(InData%Va)) + if (associated(InData%Va)) then + call RegPackBounds(Buf, 1, lbound(InData%Va), ubound(InData%Va)) + call RegPackPointer(Buf, c_loc(InData%Va), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Va) + end if + end if + call RegPack(Buf, associated(InData%x)) + if (associated(InData%x)) then + call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPackPointer(Buf, c_loc(InData%x), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%x) + end if + end if + call RegPack(Buf, associated(InData%y)) + if (associated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPackPointer(Buf, c_loc(InData%y), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%y) + end if + end if + call RegPack(Buf, associated(InData%z)) + if (associated(InData%z)) then + call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + call RegPackPointer(Buf, c_loc(InData%z), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%z) + end if + end if + call RegPack(Buf, associated(InData%xa)) + if (associated(InData%xa)) then + call RegPackBounds(Buf, 1, lbound(InData%xa), ubound(InData%xa)) + call RegPackPointer(Buf, c_loc(InData%xa), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%xa) + end if + end if + call RegPack(Buf, associated(InData%ya)) + if (associated(InData%ya)) then + call RegPackBounds(Buf, 1, lbound(InData%ya), ubound(InData%ya)) + call RegPackPointer(Buf, c_loc(InData%ya), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%ya) + end if + end if + call RegPack(Buf, associated(InData%za)) + if (associated(InData%za)) then + call RegPackBounds(Buf, 1, lbound(InData%za), ubound(InData%za)) + call RegPackPointer(Buf, c_loc(InData%za), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%za) + end if + end if + call RegPack(Buf, associated(InData%Fx_connect)) + if (associated(InData%Fx_connect)) then + call RegPackBounds(Buf, 1, lbound(InData%Fx_connect), ubound(InData%Fx_connect)) + call RegPackPointer(Buf, c_loc(InData%Fx_connect), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fx_connect) + end if + end if + call RegPack(Buf, associated(InData%Fy_connect)) + if (associated(InData%Fy_connect)) then + call RegPackBounds(Buf, 1, lbound(InData%Fy_connect), ubound(InData%Fy_connect)) + call RegPackPointer(Buf, c_loc(InData%Fy_connect), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fy_connect) + end if + end if + call RegPack(Buf, associated(InData%Fz_connect)) + if (associated(InData%Fz_connect)) then + call RegPackBounds(Buf, 1, lbound(InData%Fz_connect), ubound(InData%Fz_connect)) + call RegPackPointer(Buf, c_loc(InData%Fz_connect), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fz_connect) + end if + end if + call RegPack(Buf, associated(InData%Fx_anchor)) + if (associated(InData%Fx_anchor)) then + call RegPackBounds(Buf, 1, lbound(InData%Fx_anchor), ubound(InData%Fx_anchor)) + call RegPackPointer(Buf, c_loc(InData%Fx_anchor), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fx_anchor) + end if + end if + call RegPack(Buf, associated(InData%Fy_anchor)) + if (associated(InData%Fy_anchor)) then + call RegPackBounds(Buf, 1, lbound(InData%Fy_anchor), ubound(InData%Fy_anchor)) + call RegPackPointer(Buf, c_loc(InData%Fy_anchor), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fy_anchor) + end if + end if + call RegPack(Buf, associated(InData%Fz_anchor)) + if (associated(InData%Fz_anchor)) then + call RegPackBounds(Buf, 1, lbound(InData%Fz_anchor), ubound(InData%Fz_anchor)) + call RegPackPointer(Buf, c_loc(InData%Fz_anchor), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fz_anchor) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackOtherState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%H)) deallocate(OutData%H) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%H, UB(1:1)-LB(1:1)) + OutData%H(LB(1):) => OutData%H + else + allocate(OutData%H(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%H.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%H) + OutData%C_obj%H_Len = size(OutData%H) + if (OutData%C_obj%H_Len > 0) OutData%C_obj%H = c_loc(OutData%H(LB(1))) + call RegUnpack(Buf, OutData%H) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%H => null() + end if + if (associated(OutData%V)) deallocate(OutData%V) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%V, UB(1:1)-LB(1:1)) + OutData%V(LB(1):) => OutData%V + else + allocate(OutData%V(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%V) + OutData%C_obj%V_Len = size(OutData%V) + if (OutData%C_obj%V_Len > 0) OutData%C_obj%V = c_loc(OutData%V(LB(1))) + call RegUnpack(Buf, OutData%V) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%V => null() + end if + if (associated(OutData%Ha)) deallocate(OutData%Ha) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Ha, UB(1:1)-LB(1:1)) + OutData%Ha(LB(1):) => OutData%Ha + else + allocate(OutData%Ha(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ha.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Ha) + OutData%C_obj%Ha_Len = size(OutData%Ha) + if (OutData%C_obj%Ha_Len > 0) OutData%C_obj%Ha = c_loc(OutData%Ha(LB(1))) + call RegUnpack(Buf, OutData%Ha) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Ha => null() + end if + if (associated(OutData%Va)) deallocate(OutData%Va) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Va, UB(1:1)-LB(1:1)) + OutData%Va(LB(1):) => OutData%Va + else + allocate(OutData%Va(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Va.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Va) + OutData%C_obj%Va_Len = size(OutData%Va) + if (OutData%C_obj%Va_Len > 0) OutData%C_obj%Va = c_loc(OutData%Va(LB(1))) + call RegUnpack(Buf, OutData%Va) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Va => null() + end if + if (associated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%x, UB(1:1)-LB(1:1)) + OutData%x(LB(1):) => OutData%x + else + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%x) + OutData%C_obj%x_Len = size(OutData%x) + if (OutData%C_obj%x_Len > 0) OutData%C_obj%x = c_loc(OutData%x(LB(1))) + call RegUnpack(Buf, OutData%x) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%x => null() + end if + if (associated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%y, UB(1:1)-LB(1:1)) + OutData%y(LB(1):) => OutData%y + else + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%y) + OutData%C_obj%y_Len = size(OutData%y) + if (OutData%C_obj%y_Len > 0) OutData%C_obj%y = c_loc(OutData%y(LB(1))) + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%y => null() + end if + if (associated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%z, UB(1:1)-LB(1:1)) + OutData%z(LB(1):) => OutData%z + else + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%z) + OutData%C_obj%z_Len = size(OutData%z) + if (OutData%C_obj%z_Len > 0) OutData%C_obj%z = c_loc(OutData%z(LB(1))) + call RegUnpack(Buf, OutData%z) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%z => null() + end if + if (associated(OutData%xa)) deallocate(OutData%xa) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%xa, UB(1:1)-LB(1:1)) + OutData%xa(LB(1):) => OutData%xa + else + allocate(OutData%xa(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xa.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%xa) + OutData%C_obj%xa_Len = size(OutData%xa) + if (OutData%C_obj%xa_Len > 0) OutData%C_obj%xa = c_loc(OutData%xa(LB(1))) + call RegUnpack(Buf, OutData%xa) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%xa => null() + end if + if (associated(OutData%ya)) deallocate(OutData%ya) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%ya, UB(1:1)-LB(1:1)) + OutData%ya(LB(1):) => OutData%ya + else + allocate(OutData%ya(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ya.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%ya) + OutData%C_obj%ya_Len = size(OutData%ya) + if (OutData%C_obj%ya_Len > 0) OutData%C_obj%ya = c_loc(OutData%ya(LB(1))) + call RegUnpack(Buf, OutData%ya) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%ya => null() + end if + if (associated(OutData%za)) deallocate(OutData%za) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%za, UB(1:1)-LB(1:1)) + OutData%za(LB(1):) => OutData%za + else + allocate(OutData%za(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%za.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%za) + OutData%C_obj%za_Len = size(OutData%za) + if (OutData%C_obj%za_Len > 0) OutData%C_obj%za = c_loc(OutData%za(LB(1))) + call RegUnpack(Buf, OutData%za) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%za => null() + end if + if (associated(OutData%Fx_connect)) deallocate(OutData%Fx_connect) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fx_connect, UB(1:1)-LB(1:1)) + OutData%Fx_connect(LB(1):) => OutData%Fx_connect + else + allocate(OutData%Fx_connect(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx_connect.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fx_connect) + 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(LB(1))) + call RegUnpack(Buf, OutData%Fx_connect) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fx_connect => null() + end if + if (associated(OutData%Fy_connect)) deallocate(OutData%Fy_connect) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fy_connect, UB(1:1)-LB(1:1)) + OutData%Fy_connect(LB(1):) => OutData%Fy_connect + else + allocate(OutData%Fy_connect(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy_connect.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fy_connect) + 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(LB(1))) + call RegUnpack(Buf, OutData%Fy_connect) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fy_connect => null() + end if + if (associated(OutData%Fz_connect)) deallocate(OutData%Fz_connect) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fz_connect, UB(1:1)-LB(1:1)) + OutData%Fz_connect(LB(1):) => OutData%Fz_connect + else + allocate(OutData%Fz_connect(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz_connect.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fz_connect) + 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(LB(1))) + call RegUnpack(Buf, OutData%Fz_connect) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fz_connect => null() + end if + if (associated(OutData%Fx_anchor)) deallocate(OutData%Fx_anchor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fx_anchor, UB(1:1)-LB(1:1)) + OutData%Fx_anchor(LB(1):) => OutData%Fx_anchor + else + allocate(OutData%Fx_anchor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx_anchor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fx_anchor) + 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(LB(1))) + call RegUnpack(Buf, OutData%Fx_anchor) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fx_anchor => null() + end if + if (associated(OutData%Fy_anchor)) deallocate(OutData%Fy_anchor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fy_anchor, UB(1:1)-LB(1:1)) + OutData%Fy_anchor(LB(1):) => OutData%Fy_anchor + else + allocate(OutData%Fy_anchor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy_anchor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fy_anchor) + 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(LB(1))) + call RegUnpack(Buf, OutData%Fy_anchor) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fy_anchor => null() + end if + if (associated(OutData%Fz_anchor)) deallocate(OutData%Fz_anchor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fz_anchor, UB(1:1)-LB(1:1)) + OutData%Fz_anchor(LB(1):) => OutData%Fz_anchor + else + allocate(OutData%Fz_anchor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz_anchor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fz_anchor) + 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(LB(1))) + call RegUnpack(Buf, OutData%Fz_anchor) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fz_anchor => null() + end if +end subroutine + +SUBROUTINE MAP_C2Fary_CopyOtherState(OtherStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- H OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%H ) ) THEN + NULLIFY( OtherStateData%H ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%H, OtherStateData%H, [OtherStateData%C_obj%H_Len]) END IF - IF(ALLOCATED(Db_Buf)) THEN ! LinInitInp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + END IF + + ! -- V OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%V ) ) THEN + NULLIFY( OtherStateData%V ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%V, OtherStateData%V, [OtherStateData%C_obj%V_Len]) END IF - IF(ALLOCATED(Int_Buf)) THEN ! LinInitInp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + END IF + + ! -- Ha OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Ha ) ) THEN + NULLIFY( OtherStateData%Ha ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Ha, OtherStateData%Ha, [OtherStateData%C_obj%Ha_Len]) 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%gravity - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%sea_density - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%depth - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%file_name) - IntKiBuf(Int_Xferred) = ICHAR(InData%file_name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%summary_file_name) - IntKiBuf(Int_Xferred) = ICHAR(InData%summary_file_name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%library_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%library_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%node_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%node_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%line_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%line_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%option_input_str) - 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 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) + END IF + + ! -- Va OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Va ) ) THEN + NULLIFY( OtherStateData%Va ) 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) + CALL C_F_POINTER(OtherStateData%C_obj%Va, OtherStateData%Va, [OtherStateData%C_obj%Va_Len]) + END IF + END IF + + ! -- x OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%x ) ) THEN + NULLIFY( OtherStateData%x ) 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) + CALL C_F_POINTER(OtherStateData%C_obj%x, OtherStateData%x, [OtherStateData%C_obj%x_Len]) + END IF + END IF + + ! -- y OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%y ) ) THEN + NULLIFY( OtherStateData%y ) ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE MAP_PackInitInput - - SUBROUTINE MAP_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(MAP_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_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 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%gravity = OutData%gravity - OutData%sea_density = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%sea_density = OutData%sea_density - OutData%depth = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%depth = OutData%depth - DO I = 1, LEN(OutData%file_name) - OutData%file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%file_name = TRANSFER(OutData%file_name, OutData%C_obj%file_name ) - DO I = 1, LEN(OutData%summary_file_name) - OutData%summary_file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%summary_file_name = TRANSFER(OutData%summary_file_name, OutData%C_obj%summary_file_name ) - DO I = 1, LEN(OutData%library_input_str) - OutData%library_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%library_input_str = TRANSFER(OutData%library_input_str, OutData%C_obj%library_input_str ) - DO I = 1, LEN(OutData%node_input_str) - OutData%node_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%node_input_str = TRANSFER(OutData%node_input_str, OutData%C_obj%node_input_str ) - DO I = 1, LEN(OutData%line_input_str) - OutData%line_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%line_input_str = TRANSFER(OutData%line_input_str, OutData%C_obj%line_input_str ) - DO I = 1, LEN(OutData%option_input_str) - OutData%option_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%option_input_str = TRANSFER(OutData%option_input_str, OutData%C_obj%option_input_str ) - 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 + CALL C_F_POINTER(OtherStateData%C_obj%y, OtherStateData%y, [OtherStateData%C_obj%y_Len]) 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 + + ! -- z OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%z ) ) THEN + NULLIFY( OtherStateData%z ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%z, OtherStateData%z, [OtherStateData%C_obj%z_Len]) 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 + + ! -- xa OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%xa ) ) THEN + NULLIFY( OtherStateData%xa ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%xa, OtherStateData%xa, [OtherStateData%C_obj%xa_Len]) END IF - 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE MAP_UnPackInitInput - - SUBROUTINE MAP_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%gravity = InitInputData%C_obj%gravity - InitInputData%sea_density = InitInputData%C_obj%sea_density - InitInputData%depth = InitInputData%C_obj%depth - InitInputData%file_name = TRANSFER(InitInputData%C_obj%file_name, InitInputData%file_name ) - InitInputData%summary_file_name = TRANSFER(InitInputData%C_obj%summary_file_name, InitInputData%summary_file_name ) - InitInputData%library_input_str = TRANSFER(InitInputData%C_obj%library_input_str, InitInputData%library_input_str ) - InitInputData%node_input_str = TRANSFER(InitInputData%C_obj%node_input_str, InitInputData%node_input_str ) - InitInputData%line_input_str = TRANSFER(InitInputData%C_obj%line_input_str, InitInputData%line_input_str ) - InitInputData%option_input_str = TRANSFER(InitInputData%C_obj%option_input_str, InitInputData%option_input_str ) - END SUBROUTINE MAP_C2Fary_CopyInitInput - - SUBROUTINE MAP_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%C_obj%gravity = InitInputData%gravity - InitInputData%C_obj%sea_density = InitInputData%sea_density - InitInputData%C_obj%depth = InitInputData%depth - InitInputData%C_obj%file_name = TRANSFER(InitInputData%file_name, InitInputData%C_obj%file_name ) - InitInputData%C_obj%summary_file_name = TRANSFER(InitInputData%summary_file_name, InitInputData%C_obj%summary_file_name ) - InitInputData%C_obj%library_input_str = TRANSFER(InitInputData%library_input_str, InitInputData%C_obj%library_input_str ) - InitInputData%C_obj%node_input_str = TRANSFER(InitInputData%node_input_str, InitInputData%C_obj%node_input_str ) - InitInputData%C_obj%line_input_str = TRANSFER(InitInputData%line_input_str, InitInputData%C_obj%line_input_str ) - InitInputData%C_obj%option_input_str = TRANSFER(InitInputData%option_input_str, InitInputData%C_obj%option_input_str ) - END SUBROUTINE MAP_F2C_CopyInitInput + END IF + + ! -- ya OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%ya ) ) THEN + NULLIFY( OtherStateData%ya ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%ya, OtherStateData%ya, [OtherStateData%C_obj%ya_Len]) + END IF + END IF + + ! -- za OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%za ) ) THEN + NULLIFY( OtherStateData%za ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%za, OtherStateData%za, [OtherStateData%C_obj%za_Len]) + END IF + END IF + + ! -- Fx_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_connect ) ) THEN + NULLIFY( OtherStateData%Fx_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fx_connect, OtherStateData%Fx_connect, [OtherStateData%C_obj%Fx_connect_Len]) + END IF + END IF + + ! -- Fy_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_connect ) ) THEN + NULLIFY( OtherStateData%Fy_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fy_connect, OtherStateData%Fy_connect, [OtherStateData%C_obj%Fy_connect_Len]) + END IF + END IF + + ! -- Fz_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_connect ) ) THEN + NULLIFY( OtherStateData%Fz_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fz_connect, OtherStateData%Fz_connect, [OtherStateData%C_obj%Fz_connect_Len]) + END IF + END IF + + ! -- Fx_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_anchor ) ) THEN + NULLIFY( OtherStateData%Fx_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fx_anchor, OtherStateData%Fx_anchor, [OtherStateData%C_obj%Fx_anchor_Len]) + END IF + END IF + + ! -- Fy_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_anchor ) ) THEN + NULLIFY( OtherStateData%Fy_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fy_anchor, OtherStateData%Fy_anchor, [OtherStateData%C_obj%Fy_anchor_Len]) + END IF + END IF + + ! -- Fz_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_anchor ) ) THEN + NULLIFY( OtherStateData%Fz_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fz_anchor, OtherStateData%Fz_anchor, [OtherStateData%C_obj%Fz_anchor_Len]) + END IF + END IF +END SUBROUTINE - SUBROUTINE MAP_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(MAP_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode +SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData 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 = 'MAP_CopyInitOutput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%progName = SrcInitOutputData%progName - DstInitOutputData%C_obj%progName = SrcInitOutputData%C_obj%progName - DstInitOutputData%version = SrcInitOutputData%version - DstInitOutputData%C_obj%version = SrcInitOutputData%C_obj%version - DstInitOutputData%compilingData = SrcInitOutputData%compilingData - DstInitOutputData%C_obj%compilingData = SrcInitOutputData%C_obj%compilingData -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 - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_Fortran_Copylin_initoutputtype( SrcInitOutputData%LinInitOut, DstInitOutputData%LinInitOut, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE MAP_CopyInitOutput - - SUBROUTINE MAP_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(MAP_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 = 'MAP_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_Fortran_DestroyLin_InitOutputType( InitOutputData%LinInitOut, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE MAP_DestroyInitOutput - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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*LEN(InData%progName) ! progName - Int_BufSz = Int_BufSz + 1*LEN(InData%version) ! version - Int_BufSz = Int_BufSz + 1*LEN(InData%compilingData) ! compilingData - 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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- 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 + 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))) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + 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 + 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))) 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LinInitOut - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + 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 + 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))) END IF - IF(ALLOCATED(Db_Buf)) THEN ! LinInitOut - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + 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 + 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))) END IF - IF(ALLOCATED(Int_Buf)) THEN ! LinInitOut - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + 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 + 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))) 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%progName) - IntKiBuf(Int_Xferred) = ICHAR(InData%progName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%version) - IntKiBuf(Int_Xferred) = ICHAR(InData%version(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%compilingData) - IntKiBuf(Int_Xferred) = ICHAR(InData%compilingData(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - 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 - - 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) + 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 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) + 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 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) + 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 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 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) + 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 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) + 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 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) + 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 ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE MAP_PackInitOutput - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 - DO I = 1, LEN(OutData%progName) - OutData%progName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%progName = TRANSFER(OutData%progName, OutData%C_obj%progName ) - DO I = 1, LEN(OutData%version) - OutData%version(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%version = TRANSFER(OutData%version, OutData%C_obj%version ) - DO I = 1, LEN(OutData%compilingData) - OutData%compilingData(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%compilingData = TRANSFER(OutData%compilingData, OutData%C_obj%compilingData ) - 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 + 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 - 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 + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) 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) - 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 + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) END IF - 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE MAP_UnPackInitOutput - - SUBROUTINE MAP_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitOutputData%progName = TRANSFER(InitOutputData%C_obj%progName, InitOutputData%progName ) - InitOutputData%version = TRANSFER(InitOutputData%C_obj%version, InitOutputData%version ) - InitOutputData%compilingData = TRANSFER(InitOutputData%C_obj%compilingData, InitOutputData%compilingData ) - END SUBROUTINE MAP_C2Fary_CopyInitOutput - - SUBROUTINE MAP_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitOutputData%C_obj%progName = TRANSFER(InitOutputData%progName, InitOutputData%C_obj%progName ) - InitOutputData%C_obj%version = TRANSFER(InitOutputData%version, InitOutputData%C_obj%version ) - InitOutputData%C_obj%compilingData = TRANSFER(InitOutputData%compilingData, InitOutputData%C_obj%compilingData ) - END SUBROUTINE MAP_F2C_CopyInitOutput - - SUBROUTINE MAP_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(MAP_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 = 'MAP_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%dummy = SrcContStateData%dummy - DstContStateData%C_obj%dummy = SrcContStateData%C_obj%dummy - END SUBROUTINE MAP_CopyContState - - SUBROUTINE MAP_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(MAP_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 = 'MAP_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MAP_DestroyContState - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 - Db_BufSz = Db_BufSz + 1 ! dummy - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%dummy - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE MAP_PackContState - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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%dummy = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%dummy = OutData%dummy - END SUBROUTINE MAP_UnPackContState - - SUBROUTINE MAP_C2Fary_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ContStateData%dummy = ContStateData%C_obj%dummy - END SUBROUTINE MAP_C2Fary_CopyContState - - SUBROUTINE MAP_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ContStateData%C_obj%dummy = ContStateData%dummy - END SUBROUTINE MAP_F2C_CopyContState - - SUBROUTINE MAP_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(MAP_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 = 'MAP_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%dummy = SrcDiscStateData%dummy - DstDiscStateData%C_obj%dummy = SrcDiscStateData%C_obj%dummy - END SUBROUTINE MAP_CopyDiscState - - SUBROUTINE MAP_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(MAP_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 = 'MAP_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MAP_DestroyDiscState - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 - Db_BufSz = Db_BufSz + 1 ! dummy - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%dummy - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE MAP_PackDiscState - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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%dummy = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%dummy = OutData%dummy - END SUBROUTINE MAP_UnPackDiscState - - SUBROUTINE MAP_C2Fary_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - DiscStateData%dummy = DiscStateData%C_obj%dummy - END SUBROUTINE MAP_C2Fary_CopyDiscState - - SUBROUTINE MAP_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - DiscStateData%C_obj%dummy = DiscStateData%dummy - END SUBROUTINE MAP_F2C_CopyDiscState - - SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(MAP_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcOtherStateData%H)) THEN - i1_l = LBOUND(SrcOtherStateData%H,1) - i1_u = UBOUND(SrcOtherStateData%H,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%H)) THEN - ALLOCATE(DstOtherStateData%H(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%H = SrcOtherStateData%H -ENDIF -IF (ASSOCIATED(SrcOtherStateData%V)) THEN - i1_l = LBOUND(SrcOtherStateData%V,1) - i1_u = UBOUND(SrcOtherStateData%V,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%V)) THEN - ALLOCATE(DstOtherStateData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%V = SrcOtherStateData%V -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Ha)) THEN - i1_l = LBOUND(SrcOtherStateData%Ha,1) - i1_u = UBOUND(SrcOtherStateData%Ha,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Ha)) THEN - ALLOCATE(DstOtherStateData%Ha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%Ha = SrcOtherStateData%Ha -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Va)) THEN - i1_l = LBOUND(SrcOtherStateData%Va,1) - i1_u = UBOUND(SrcOtherStateData%Va,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Va)) THEN - ALLOCATE(DstOtherStateData%Va(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%Va = SrcOtherStateData%Va -ENDIF -IF (ASSOCIATED(SrcOtherStateData%x)) THEN - i1_l = LBOUND(SrcOtherStateData%x,1) - i1_u = UBOUND(SrcOtherStateData%x,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%x)) THEN - ALLOCATE(DstOtherStateData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%x = SrcOtherStateData%x -ENDIF -IF (ASSOCIATED(SrcOtherStateData%y)) THEN - i1_l = LBOUND(SrcOtherStateData%y,1) - i1_u = UBOUND(SrcOtherStateData%y,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%y)) THEN - ALLOCATE(DstOtherStateData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%y = SrcOtherStateData%y -ENDIF -IF (ASSOCIATED(SrcOtherStateData%z)) THEN - i1_l = LBOUND(SrcOtherStateData%z,1) - i1_u = UBOUND(SrcOtherStateData%z,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%z)) THEN - ALLOCATE(DstOtherStateData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%z = SrcOtherStateData%z -ENDIF -IF (ASSOCIATED(SrcOtherStateData%xa)) THEN - i1_l = LBOUND(SrcOtherStateData%xa,1) - i1_u = UBOUND(SrcOtherStateData%xa,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%xa)) THEN - ALLOCATE(DstOtherStateData%xa(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%xa = SrcOtherStateData%xa -ENDIF -IF (ASSOCIATED(SrcOtherStateData%ya)) THEN - i1_l = LBOUND(SrcOtherStateData%ya,1) - i1_u = UBOUND(SrcOtherStateData%ya,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%ya)) THEN - ALLOCATE(DstOtherStateData%ya(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%ya = SrcOtherStateData%ya -ENDIF -IF (ASSOCIATED(SrcOtherStateData%za)) THEN - i1_l = LBOUND(SrcOtherStateData%za,1) - i1_u = UBOUND(SrcOtherStateData%za,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%za)) THEN - ALLOCATE(DstOtherStateData%za(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%za = SrcOtherStateData%za -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fx_connect)) THEN - i1_l = LBOUND(SrcOtherStateData%Fx_connect,1) - i1_u = UBOUND(SrcOtherStateData%Fx_connect,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fx_connect)) THEN - ALLOCATE(DstOtherStateData%Fx_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%Fx_connect = SrcOtherStateData%Fx_connect -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fy_connect)) THEN - i1_l = LBOUND(SrcOtherStateData%Fy_connect,1) - i1_u = UBOUND(SrcOtherStateData%Fy_connect,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fy_connect)) THEN - ALLOCATE(DstOtherStateData%Fy_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%Fy_connect = SrcOtherStateData%Fy_connect -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fz_connect)) THEN - i1_l = LBOUND(SrcOtherStateData%Fz_connect,1) - i1_u = UBOUND(SrcOtherStateData%Fz_connect,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fz_connect)) THEN - ALLOCATE(DstOtherStateData%Fz_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%Fz_connect = SrcOtherStateData%Fz_connect -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fx_anchor)) THEN - i1_l = LBOUND(SrcOtherStateData%Fx_anchor,1) - i1_u = UBOUND(SrcOtherStateData%Fx_anchor,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fx_anchor)) THEN - ALLOCATE(DstOtherStateData%Fx_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%Fx_anchor = SrcOtherStateData%Fx_anchor -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fy_anchor)) THEN - i1_l = LBOUND(SrcOtherStateData%Fy_anchor,1) - i1_u = UBOUND(SrcOtherStateData%Fy_anchor,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fy_anchor)) THEN - ALLOCATE(DstOtherStateData%Fy_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%Fy_anchor = SrcOtherStateData%Fy_anchor -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fz_anchor)) THEN - i1_l = LBOUND(SrcOtherStateData%Fz_anchor,1) - i1_u = UBOUND(SrcOtherStateData%Fz_anchor,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fz_anchor)) THEN - ALLOCATE(DstOtherStateData%Fz_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOtherStateData%Fz_anchor = SrcOtherStateData%Fz_anchor -ENDIF - END SUBROUTINE MAP_CopyOtherState - - SUBROUTINE MAP_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(MAP_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 = 'MAP_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(OtherStateData%H)) THEN - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - DEALLOCATE(OtherStateData%Fz_anchor) - OtherStateData%Fz_anchor => NULL() - OtherStateData%C_obj%Fz_anchor = C_NULL_PTR - OtherStateData%C_obj%Fz_anchor_Len = 0 -ENDIF - END SUBROUTINE MAP_DestroyOtherState - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 ! H allocated yes/no - IF ( ASSOCIATED(InData%H) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! H upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%H) ! H - END IF - Int_BufSz = Int_BufSz + 1 ! V allocated yes/no - IF ( ASSOCIATED(InData%V) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%V) ! V - END IF - Int_BufSz = Int_BufSz + 1 ! Ha allocated yes/no - IF ( ASSOCIATED(InData%Ha) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Ha upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ha) ! Ha - END IF - Int_BufSz = Int_BufSz + 1 ! Va allocated yes/no - IF ( ASSOCIATED(InData%Va) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Va upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Va) ! Va - END IF - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ASSOCIATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x) ! x - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ASSOCIATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ASSOCIATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%z) ! z - END IF - Int_BufSz = Int_BufSz + 1 ! xa allocated yes/no - IF ( ASSOCIATED(InData%xa) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xa upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%xa) ! xa - END IF - Int_BufSz = Int_BufSz + 1 ! ya allocated yes/no - IF ( ASSOCIATED(InData%ya) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ya upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ya) ! ya - END IF - Int_BufSz = Int_BufSz + 1 ! za allocated yes/no - IF ( ASSOCIATED(InData%za) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! za upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%za) ! za - END IF - Int_BufSz = Int_BufSz + 1 ! Fx_connect allocated yes/no - IF ( ASSOCIATED(InData%Fx_connect) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fx_connect upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fx_connect) ! Fx_connect - END IF - Int_BufSz = Int_BufSz + 1 ! Fy_connect allocated yes/no - IF ( ASSOCIATED(InData%Fy_connect) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fy_connect upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fy_connect) ! Fy_connect - END IF - Int_BufSz = Int_BufSz + 1 ! Fz_connect allocated yes/no - IF ( ASSOCIATED(InData%Fz_connect) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fz_connect upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fz_connect) ! Fz_connect - END IF - Int_BufSz = Int_BufSz + 1 ! Fx_anchor allocated yes/no - IF ( ASSOCIATED(InData%Fx_anchor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fx_anchor upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fx_anchor) ! Fx_anchor - END IF - Int_BufSz = Int_BufSz + 1 ! Fy_anchor allocated yes/no - IF ( ASSOCIATED(InData%Fy_anchor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fy_anchor upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fy_anchor) ! Fy_anchor - END IF - Int_BufSz = Int_BufSz + 1 ! Fz_anchor allocated yes/no - IF ( ASSOCIATED(InData%Fz_anchor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fz_anchor upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fz_anchor) ! Fz_anchor - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%H) ) 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%H,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%H,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%H,1), UBOUND(InData%H,1) - DbKiBuf(Db_Xferred) = InData%H(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%V) ) 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%V,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) - DbKiBuf(Db_Xferred) = InData%V(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Ha) ) 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%Ha,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ha,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Ha,1), UBOUND(InData%Ha,1) - DbKiBuf(Db_Xferred) = InData%Ha(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Va) ) 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%Va,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Va,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Va,1), UBOUND(InData%Va,1) - DbKiBuf(Db_Xferred) = InData%Va(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%x) ) 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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%y) ) 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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - DbKiBuf(Db_Xferred) = InData%y(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%z) ) 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%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - DbKiBuf(Db_Xferred) = InData%z(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%xa) ) 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%xa,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xa,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xa,1), UBOUND(InData%xa,1) - DbKiBuf(Db_Xferred) = InData%xa(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%ya) ) 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%ya,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ya,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ya,1), UBOUND(InData%ya,1) - DbKiBuf(Db_Xferred) = InData%ya(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%za) ) 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%za,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%za,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%za,1), UBOUND(InData%za,1) - DbKiBuf(Db_Xferred) = InData%za(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fx_connect) ) 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%Fx_connect,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx_connect,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fx_connect,1), UBOUND(InData%Fx_connect,1) - DbKiBuf(Db_Xferred) = InData%Fx_connect(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fy_connect) ) 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%Fy_connect,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy_connect,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fy_connect,1), UBOUND(InData%Fy_connect,1) - DbKiBuf(Db_Xferred) = InData%Fy_connect(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fz_connect) ) 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%Fz_connect,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz_connect,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fz_connect,1), UBOUND(InData%Fz_connect,1) - DbKiBuf(Db_Xferred) = InData%Fz_connect(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fx_anchor) ) 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%Fx_anchor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx_anchor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fx_anchor,1), UBOUND(InData%Fx_anchor,1) - DbKiBuf(Db_Xferred) = InData%Fx_anchor(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fy_anchor) ) 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%Fy_anchor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy_anchor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fy_anchor,1), UBOUND(InData%Fy_anchor,1) - DbKiBuf(Db_Xferred) = InData%Fy_anchor(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fz_anchor) ) 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%Fz_anchor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz_anchor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fz_anchor,1), UBOUND(InData%Fz_anchor,1) - DbKiBuf(Db_Xferred) = InData%Fz_anchor(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MAP_PackOtherState - - SUBROUTINE MAP_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(MAP_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! H 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%H)) DEALLOCATE(OutData%H) - ALLOCATE(OutData%H(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%H,1), UBOUND(OutData%H,1) - OutData%H(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V 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%V)) DEALLOCATE(OutData%V) - ALLOCATE(OutData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) - OutData%V(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ha 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%Ha)) DEALLOCATE(OutData%Ha) - ALLOCATE(OutData%Ha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%Ha,1), UBOUND(OutData%Ha,1) - OutData%Ha(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Va 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%Va)) DEALLOCATE(OutData%Va) - ALLOCATE(OutData%Va(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%Va,1), UBOUND(OutData%Va,1) - OutData%Va(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x 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%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z 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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xa 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%xa)) DEALLOCATE(OutData%xa) - ALLOCATE(OutData%xa(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%xa,1), UBOUND(OutData%xa,1) - OutData%xa(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ya 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%ya)) DEALLOCATE(OutData%ya) - ALLOCATE(OutData%ya(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%ya,1), UBOUND(OutData%ya,1) - OutData%ya(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! za 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%za)) DEALLOCATE(OutData%za) - ALLOCATE(OutData%za(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%za,1), UBOUND(OutData%za,1) - OutData%za(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fx_connect 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%Fx_connect)) DEALLOCATE(OutData%Fx_connect) - ALLOCATE(OutData%Fx_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - 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 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy_connect 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%Fy_connect)) DEALLOCATE(OutData%Fy_connect) - ALLOCATE(OutData%Fy_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - 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 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz_connect 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%Fz_connect)) DEALLOCATE(OutData%Fz_connect) - ALLOCATE(OutData%Fz_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - 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 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fx_anchor 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%Fx_anchor)) DEALLOCATE(OutData%Fx_anchor) - ALLOCATE(OutData%Fx_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - 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 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy_anchor 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%Fy_anchor)) DEALLOCATE(OutData%Fy_anchor) - ALLOCATE(OutData%Fy_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - 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 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz_anchor 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%Fz_anchor)) DEALLOCATE(OutData%Fz_anchor) - ALLOCATE(OutData%Fz_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - 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 - END DO - END IF - END SUBROUTINE MAP_UnPackOtherState - - SUBROUTINE MAP_C2Fary_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- H OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%H ) ) THEN - NULLIFY( OtherStateData%H ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%H, OtherStateData%H, (/OtherStateData%C_obj%H_Len/)) - END IF - END IF - - ! -- V OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%V ) ) THEN - NULLIFY( OtherStateData%V ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%V, OtherStateData%V, (/OtherStateData%C_obj%V_Len/)) - END IF - END IF - - ! -- Ha OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Ha ) ) THEN - NULLIFY( OtherStateData%Ha ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Ha, OtherStateData%Ha, (/OtherStateData%C_obj%Ha_Len/)) - END IF - END IF - - ! -- Va OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Va ) ) THEN - NULLIFY( OtherStateData%Va ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Va, OtherStateData%Va, (/OtherStateData%C_obj%Va_Len/)) - END IF - END IF - - ! -- x OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%x ) ) THEN - NULLIFY( OtherStateData%x ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%x, OtherStateData%x, (/OtherStateData%C_obj%x_Len/)) - END IF - END IF - - ! -- y OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%y ) ) THEN - NULLIFY( OtherStateData%y ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%y, OtherStateData%y, (/OtherStateData%C_obj%y_Len/)) - END IF - END IF - - ! -- z OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%z ) ) THEN - NULLIFY( OtherStateData%z ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%z, OtherStateData%z, (/OtherStateData%C_obj%z_Len/)) - END IF - END IF - - ! -- xa OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%xa ) ) THEN - NULLIFY( OtherStateData%xa ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%xa, OtherStateData%xa, (/OtherStateData%C_obj%xa_Len/)) - END IF - END IF - - ! -- ya OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%ya ) ) THEN - NULLIFY( OtherStateData%ya ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%ya, OtherStateData%ya, (/OtherStateData%C_obj%ya_Len/)) - END IF - END IF - - ! -- za OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%za ) ) THEN - NULLIFY( OtherStateData%za ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%za, OtherStateData%za, (/OtherStateData%C_obj%za_Len/)) - END IF - END IF - - ! -- Fx_connect OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_connect ) ) THEN - NULLIFY( OtherStateData%Fx_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fx_connect, OtherStateData%Fx_connect, (/OtherStateData%C_obj%Fx_connect_Len/)) - END IF - END IF - - ! -- Fy_connect OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_connect ) ) THEN - NULLIFY( OtherStateData%Fy_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fy_connect, OtherStateData%Fy_connect, (/OtherStateData%C_obj%Fy_connect_Len/)) - END IF - END IF - - ! -- Fz_connect OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_connect ) ) THEN - NULLIFY( OtherStateData%Fz_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fz_connect, OtherStateData%Fz_connect, (/OtherStateData%C_obj%Fz_connect_Len/)) - END IF - END IF - - ! -- Fx_anchor OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_anchor ) ) THEN - NULLIFY( OtherStateData%Fx_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fx_anchor, OtherStateData%Fx_anchor, (/OtherStateData%C_obj%Fx_anchor_Len/)) - END IF - END IF - - ! -- Fy_anchor OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_anchor ) ) THEN - NULLIFY( OtherStateData%Fy_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fy_anchor, OtherStateData%Fy_anchor, (/OtherStateData%C_obj%Fy_anchor_Len/)) - END IF - END IF - - ! -- Fz_anchor OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_anchor ) ) THEN - NULLIFY( OtherStateData%Fz_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fz_anchor, OtherStateData%Fz_anchor, (/OtherStateData%C_obj%Fz_anchor_Len/)) - END IF - END IF - END SUBROUTINE MAP_C2Fary_CopyOtherState - - SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - END IF - END IF - END SUBROUTINE MAP_F2C_CopyOtherState - - SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(MAP_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_CopyConstrState' -! + END IF +END SUBROUTINE + +subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(MAP_ConstraintStateType), intent(in) :: SrcConstrStateData + type(MAP_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MAP_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcConstrStateData%H)) THEN - i1_l = LBOUND(SrcConstrStateData%H,1) - i1_u = UBOUND(SrcConstrStateData%H,1) - IF (.NOT. ASSOCIATED(DstConstrStateData%H)) THEN - ALLOCATE(DstConstrStateData%H(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstConstrStateData%H = SrcConstrStateData%H -ENDIF -IF (ASSOCIATED(SrcConstrStateData%V)) THEN - i1_l = LBOUND(SrcConstrStateData%V,1) - i1_u = UBOUND(SrcConstrStateData%V,1) - IF (.NOT. ASSOCIATED(DstConstrStateData%V)) THEN - ALLOCATE(DstConstrStateData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstConstrStateData%V = SrcConstrStateData%V -ENDIF -IF (ASSOCIATED(SrcConstrStateData%x)) THEN - i1_l = LBOUND(SrcConstrStateData%x,1) - i1_u = UBOUND(SrcConstrStateData%x,1) - IF (.NOT. ASSOCIATED(DstConstrStateData%x)) THEN - ALLOCATE(DstConstrStateData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstConstrStateData%x = SrcConstrStateData%x -ENDIF -IF (ASSOCIATED(SrcConstrStateData%y)) THEN - i1_l = LBOUND(SrcConstrStateData%y,1) - i1_u = UBOUND(SrcConstrStateData%y,1) - IF (.NOT. ASSOCIATED(DstConstrStateData%y)) THEN - ALLOCATE(DstConstrStateData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstConstrStateData%y = SrcConstrStateData%y -ENDIF -IF (ASSOCIATED(SrcConstrStateData%z)) THEN - i1_l = LBOUND(SrcConstrStateData%z,1) - i1_u = UBOUND(SrcConstrStateData%z,1) - IF (.NOT. ASSOCIATED(DstConstrStateData%z)) THEN - ALLOCATE(DstConstrStateData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstConstrStateData%z = SrcConstrStateData%z -ENDIF - END SUBROUTINE MAP_CopyConstrState - - SUBROUTINE MAP_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(MAP_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 = 'MAP_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(ConstrStateData%H)) THEN - 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 - 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 - 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 - 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 - DEALLOCATE(ConstrStateData%z) - ConstrStateData%z => NULL() - ConstrStateData%C_obj%z = C_NULL_PTR - ConstrStateData%C_obj%z_Len = 0 -ENDIF - END SUBROUTINE MAP_DestroyConstrState - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 - Int_BufSz = Int_BufSz + 1 ! H allocated yes/no - IF ( ASSOCIATED(InData%H) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! H upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%H) ! H - END IF - Int_BufSz = Int_BufSz + 1 ! V allocated yes/no - IF ( ASSOCIATED(InData%V) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%V) ! V - END IF - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ASSOCIATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x) ! x - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ASSOCIATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ASSOCIATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%z) ! z - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%H) ) 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%H,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%H,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%H,1), UBOUND(InData%H,1) - DbKiBuf(Db_Xferred) = InData%H(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%V) ) 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%V,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) - DbKiBuf(Db_Xferred) = InData%V(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%x) ) 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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%y) ) 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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - DbKiBuf(Db_Xferred) = InData%y(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%z) ) 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%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - DbKiBuf(Db_Xferred) = InData%z(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MAP_PackConstrState - - SUBROUTINE MAP_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(MAP_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! H 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%H)) DEALLOCATE(OutData%H) - ALLOCATE(OutData%H(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%H,1), UBOUND(OutData%H,1) - OutData%H(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V 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%V)) DEALLOCATE(OutData%V) - ALLOCATE(OutData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) - OutData%V(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x 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%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z 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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MAP_UnPackConstrState - - SUBROUTINE MAP_C2Fary_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- H ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%H ) ) THEN - NULLIFY( ConstrStateData%H ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%H, ConstrStateData%H, (/ConstrStateData%C_obj%H_Len/)) - END IF - END IF - - ! -- V ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%V ) ) THEN - NULLIFY( ConstrStateData%V ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%V, ConstrStateData%V, (/ConstrStateData%C_obj%V_Len/)) - END IF - END IF - - ! -- x ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%x ) ) THEN - NULLIFY( ConstrStateData%x ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%x, ConstrStateData%x, (/ConstrStateData%C_obj%x_Len/)) - END IF - END IF - - ! -- y ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%y ) ) THEN - NULLIFY( ConstrStateData%y ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%y, ConstrStateData%y, (/ConstrStateData%C_obj%y_Len/)) - END IF - END IF - - ! -- z ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%z ) ) THEN - NULLIFY( ConstrStateData%z ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%z, ConstrStateData%z, (/ConstrStateData%C_obj%z_Len/)) - END IF - END IF - END SUBROUTINE MAP_C2Fary_CopyConstrState - - SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - END IF - END IF - END SUBROUTINE MAP_F2C_CopyConstrState - - SUBROUTINE MAP_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_ParameterType), INTENT(IN) :: SrcParamData - TYPE(MAP_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + ErrMsg = '' + if (associated(SrcConstrStateData%H)) then + LB(1:1) = lbound(SrcConstrStateData%H) + UB(1:1) = ubound(SrcConstrStateData%H) + if (.not. associated(DstConstrStateData%H)) then + allocate(DstConstrStateData%H(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstConstrStateData%H = SrcConstrStateData%H + end if + if (associated(SrcConstrStateData%V)) then + LB(1:1) = lbound(SrcConstrStateData%V) + UB(1:1) = ubound(SrcConstrStateData%V) + if (.not. associated(DstConstrStateData%V)) then + allocate(DstConstrStateData%V(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstConstrStateData%V = SrcConstrStateData%V + end if + if (associated(SrcConstrStateData%x)) then + LB(1:1) = lbound(SrcConstrStateData%x) + UB(1:1) = ubound(SrcConstrStateData%x) + if (.not. associated(DstConstrStateData%x)) then + allocate(DstConstrStateData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstConstrStateData%x = SrcConstrStateData%x + end if + if (associated(SrcConstrStateData%y)) then + LB(1:1) = lbound(SrcConstrStateData%y) + UB(1:1) = ubound(SrcConstrStateData%y) + if (.not. associated(DstConstrStateData%y)) then + allocate(DstConstrStateData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstConstrStateData%y = SrcConstrStateData%y + end if + if (associated(SrcConstrStateData%z)) then + LB(1:1) = lbound(SrcConstrStateData%z) + UB(1:1) = ubound(SrcConstrStateData%z) + if (.not. associated(DstConstrStateData%z)) then + allocate(DstConstrStateData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstConstrStateData%z = SrcConstrStateData%z + end if +end subroutine + +subroutine MAP_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(MAP_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(ConstrStateData%H)) then + deallocate(ConstrStateData%H) + ConstrStateData%H => null() + ConstrStateData%C_obj%H = c_null_ptr + ConstrStateData%C_obj%H_Len = 0 + end if + if (associated(ConstrStateData%V)) then + deallocate(ConstrStateData%V) + ConstrStateData%V => null() + ConstrStateData%C_obj%V = c_null_ptr + ConstrStateData%C_obj%V_Len = 0 + end if + if (associated(ConstrStateData%x)) then + deallocate(ConstrStateData%x) + ConstrStateData%x => null() + ConstrStateData%C_obj%x = c_null_ptr + ConstrStateData%C_obj%x_Len = 0 + end if + if (associated(ConstrStateData%y)) then + deallocate(ConstrStateData%y) + ConstrStateData%y => null() + ConstrStateData%C_obj%y = c_null_ptr + ConstrStateData%C_obj%y_Len = 0 + end if + if (associated(ConstrStateData%z)) then + deallocate(ConstrStateData%z) + ConstrStateData%z => null() + ConstrStateData%C_obj%z = c_null_ptr + ConstrStateData%C_obj%z_Len = 0 + end if +end subroutine + +subroutine MAP_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackConstrState' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, associated(InData%H)) + if (associated(InData%H)) then + call RegPackBounds(Buf, 1, lbound(InData%H), ubound(InData%H)) + call RegPackPointer(Buf, c_loc(InData%H), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%H) + end if + end if + call RegPack(Buf, associated(InData%V)) + if (associated(InData%V)) then + call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) + call RegPackPointer(Buf, c_loc(InData%V), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%V) + end if + end if + call RegPack(Buf, associated(InData%x)) + if (associated(InData%x)) then + call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPackPointer(Buf, c_loc(InData%x), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%x) + end if + end if + call RegPack(Buf, associated(InData%y)) + if (associated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPackPointer(Buf, c_loc(InData%y), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%y) + end if + end if + call RegPack(Buf, associated(InData%z)) + if (associated(InData%z)) then + call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + call RegPackPointer(Buf, c_loc(InData%z), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%z) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackConstrState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%H)) deallocate(OutData%H) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%H, UB(1:1)-LB(1:1)) + OutData%H(LB(1):) => OutData%H + else + allocate(OutData%H(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%H.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%H) + OutData%C_obj%H_Len = size(OutData%H) + if (OutData%C_obj%H_Len > 0) OutData%C_obj%H = c_loc(OutData%H(LB(1))) + call RegUnpack(Buf, OutData%H) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%H => null() + end if + if (associated(OutData%V)) deallocate(OutData%V) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%V, UB(1:1)-LB(1:1)) + OutData%V(LB(1):) => OutData%V + else + allocate(OutData%V(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%V) + OutData%C_obj%V_Len = size(OutData%V) + if (OutData%C_obj%V_Len > 0) OutData%C_obj%V = c_loc(OutData%V(LB(1))) + call RegUnpack(Buf, OutData%V) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%V => null() + end if + if (associated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%x, UB(1:1)-LB(1:1)) + OutData%x(LB(1):) => OutData%x + else + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%x) + OutData%C_obj%x_Len = size(OutData%x) + if (OutData%C_obj%x_Len > 0) OutData%C_obj%x = c_loc(OutData%x(LB(1))) + call RegUnpack(Buf, OutData%x) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%x => null() + end if + if (associated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%y, UB(1:1)-LB(1:1)) + OutData%y(LB(1):) => OutData%y + else + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%y) + OutData%C_obj%y_Len = size(OutData%y) + if (OutData%C_obj%y_Len > 0) OutData%C_obj%y = c_loc(OutData%y(LB(1))) + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%y => null() + end if + if (associated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%z, UB(1:1)-LB(1:1)) + OutData%z(LB(1):) => OutData%z + else + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%z) + OutData%C_obj%z_Len = size(OutData%z) + if (OutData%C_obj%z_Len > 0) OutData%C_obj%z = c_loc(OutData%z(LB(1))) + call RegUnpack(Buf, OutData%z) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%z => null() + end if +end subroutine + +SUBROUTINE MAP_C2Fary_CopyConstrState(ConstrStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData 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 = 'MAP_CopyParam' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - DstParamData%g = SrcParamData%g - DstParamData%C_obj%g = SrcParamData%C_obj%g - DstParamData%depth = SrcParamData%depth - DstParamData%C_obj%depth = SrcParamData%C_obj%depth - DstParamData%rho_sea = SrcParamData%rho_sea - DstParamData%C_obj%rho_sea = SrcParamData%C_obj%rho_sea - DstParamData%dt = SrcParamData%dt - DstParamData%C_obj%dt = SrcParamData%C_obj%dt - DstParamData%InputLines = SrcParamData%InputLines - DstParamData%InputLineType = SrcParamData%InputLineType - DstParamData%numOuts = SrcParamData%numOuts - DstParamData%C_obj%numOuts = SrcParamData%C_obj%numOuts - CALL MAP_Fortran_Copylin_paramtype( SrcParamData%LinParams, DstParamData%LinParams, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE MAP_CopyParam - - SUBROUTINE MAP_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(MAP_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 = 'MAP_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MAP_Fortran_DestroyLin_ParamType( ParamData%LinParams, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE MAP_DestroyParam - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 ! g - Db_BufSz = Db_BufSz + 1 ! depth - Db_BufSz = Db_BufSz + 1 ! rho_sea - Db_BufSz = Db_BufSz + 1 ! dt - Int_BufSz = Int_BufSz + SIZE(InData%InputLines)*LEN(InData%InputLines) ! InputLines - Int_BufSz = Int_BufSz + SIZE(InData%InputLineType)*LEN(InData%InputLineType) ! InputLineType - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LinParams - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- H ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%H ) ) THEN + NULLIFY( ConstrStateData%H ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%H, ConstrStateData%H, [ConstrStateData%C_obj%H_Len]) + END IF + END IF + + ! -- V ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%V ) ) THEN + NULLIFY( ConstrStateData%V ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%V, ConstrStateData%V, [ConstrStateData%C_obj%V_Len]) END IF - IF(ALLOCATED(Db_Buf)) THEN ! LinParams - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + END IF + + ! -- x ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%x ) ) THEN + NULLIFY( ConstrStateData%x ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%x, ConstrStateData%x, [ConstrStateData%C_obj%x_Len]) END IF - IF(ALLOCATED(Int_Buf)) THEN ! LinParams - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + END IF + + ! -- y ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%y ) ) THEN + NULLIFY( ConstrStateData%y ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%y, ConstrStateData%y, [ConstrStateData%C_obj%y_Len]) 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%g - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%depth - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rho_sea - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dt - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%InputLines,1), UBOUND(InData%InputLines,1) - DO I = 1, LEN(InData%InputLines) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputLines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - DO i1 = LBOUND(InData%InputLineType,1), UBOUND(InData%InputLineType,1) - DO I = 1, LEN(InData%InputLineType) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputLineType(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + END IF + + ! -- z ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%z ) ) THEN + NULLIFY( ConstrStateData%z ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%z, ConstrStateData%z, [ConstrStateData%C_obj%z_Len]) + END IF + END IF +END SUBROUTINE - 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) +SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- 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 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) + 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 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) + 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 ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE MAP_PackParam - - SUBROUTINE MAP_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(MAP_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_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%g = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%g = OutData%g - OutData%depth = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%depth = OutData%depth - OutData%rho_sea = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%rho_sea = OutData%rho_sea - OutData%dt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%dt = OutData%dt - i1_l = LBOUND(OutData%InputLines,1) - i1_u = UBOUND(OutData%InputLines,1) - DO i1 = LBOUND(OutData%InputLines,1), UBOUND(OutData%InputLines,1) - DO I = 1, LEN(OutData%InputLines) - OutData%InputLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - i1_l = LBOUND(OutData%InputLineType,1) - i1_u = UBOUND(OutData%InputLineType,1) - DO i1 = LBOUND(OutData%InputLineType,1), UBOUND(OutData%InputLineType,1) - DO I = 1, LEN(OutData%InputLineType) - OutData%InputLineType(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - OutData%numOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%numOuts = OutData%numOuts - 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 + 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 - 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 + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) END IF - 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE MAP_UnPackParam - - SUBROUTINE MAP_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%g = ParamData%C_obj%g - ParamData%depth = ParamData%C_obj%depth - ParamData%rho_sea = ParamData%C_obj%rho_sea - ParamData%dt = ParamData%C_obj%dt - ParamData%numOuts = ParamData%C_obj%numOuts - END SUBROUTINE MAP_C2Fary_CopyParam - - SUBROUTINE MAP_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%C_obj%g = ParamData%g - ParamData%C_obj%depth = ParamData%depth - ParamData%C_obj%rho_sea = ParamData%rho_sea - ParamData%C_obj%dt = ParamData%dt - ParamData%C_obj%numOuts = ParamData%numOuts - END SUBROUTINE MAP_F2C_CopyParam - - SUBROUTINE MAP_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_InputType), INTENT(INOUT) :: SrcInputData - TYPE(MAP_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + END IF +END SUBROUTINE + +subroutine MAP_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(MAP_ParameterType), intent(in) :: SrcParamData + type(MAP_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%g = SrcParamData%g + DstParamData%C_obj%g = SrcParamData%C_obj%g + DstParamData%depth = SrcParamData%depth + DstParamData%C_obj%depth = SrcParamData%C_obj%depth + DstParamData%rho_sea = SrcParamData%rho_sea + DstParamData%C_obj%rho_sea = SrcParamData%C_obj%rho_sea + DstParamData%dt = SrcParamData%dt + DstParamData%C_obj%dt = SrcParamData%C_obj%dt + DstParamData%InputLines = SrcParamData%InputLines + DstParamData%InputLineType = SrcParamData%InputLineType + DstParamData%numOuts = SrcParamData%numOuts + DstParamData%C_obj%numOuts = SrcParamData%C_obj%numOuts + call MAP_Fortran_CopyLin_ParamType(SrcParamData%LinParams, DstParamData%LinParams, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine MAP_DestroyParam(ParamData, ErrStat, ErrMsg) + type(MAP_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + call MAP_Fortran_DestroyLin_ParamType(ParamData%LinParams, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine MAP_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, InData%g) + call RegPack(Buf, InData%depth) + call RegPack(Buf, InData%rho_sea) + call RegPack(Buf, InData%dt) + call RegPack(Buf, InData%InputLines) + call RegPack(Buf, InData%InputLineType) + call RegPack(Buf, InData%numOuts) + call MAP_Fortran_PackLin_ParamType(Buf, InData%LinParams) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackParam' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%g) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%g = OutData%g + call RegUnpack(Buf, OutData%depth) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%depth = OutData%depth + call RegUnpack(Buf, OutData%rho_sea) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%rho_sea = OutData%rho_sea + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%dt = OutData%dt + call RegUnpack(Buf, OutData%InputLines) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InputLineType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%numOuts) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%numOuts = OutData%numOuts + call MAP_Fortran_UnpackLin_ParamType(Buf, OutData%LinParams) ! LinParams +end subroutine + +SUBROUTINE MAP_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData 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 = 'MAP_CopyInput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" -IF (ASSOCIATED(SrcInputData%x)) THEN - i1_l = LBOUND(SrcInputData%x,1) - i1_u = UBOUND(SrcInputData%x,1) - IF (.NOT. ASSOCIATED(DstInputData%x)) THEN - ALLOCATE(DstInputData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%x = SrcInputData%x -ENDIF -IF (ASSOCIATED(SrcInputData%y)) THEN - i1_l = LBOUND(SrcInputData%y,1) - i1_u = UBOUND(SrcInputData%y,1) - IF (.NOT. ASSOCIATED(DstInputData%y)) THEN - ALLOCATE(DstInputData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%y = SrcInputData%y -ENDIF -IF (ASSOCIATED(SrcInputData%z)) THEN - i1_l = LBOUND(SrcInputData%z,1) - i1_u = UBOUND(SrcInputData%z,1) - IF (.NOT. ASSOCIATED(DstInputData%z)) THEN - ALLOCATE(DstInputData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%z = SrcInputData%z -ENDIF - CALL MeshCopy( SrcInputData%PtFairDisplacement, DstInputData%PtFairDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE MAP_CopyInput - - SUBROUTINE MAP_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(MAP_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 = 'MAP_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(InputData%x)) THEN - 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 - 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 - DEALLOCATE(InputData%z) - InputData%z => NULL() - InputData%C_obj%z = C_NULL_PTR - InputData%C_obj%z_Len = 0 -ENDIF - CALL MeshDestroy( InputData%PtFairDisplacement, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE MAP_DestroyInput - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ASSOCIATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x) ! x - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ASSOCIATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ASSOCIATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%z) ! z - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtFairDisplacement: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtFairDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtFairDisplacement - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtFairDisplacement - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%g = ParamData%C_obj%g + ParamData%depth = ParamData%C_obj%depth + ParamData%rho_sea = ParamData%C_obj%rho_sea + ParamData%dt = ParamData%C_obj%dt + ParamData%numOuts = ParamData%C_obj%numOuts +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%C_obj%g = ParamData%g + ParamData%C_obj%depth = ParamData%depth + ParamData%C_obj%rho_sea = ParamData%rho_sea + ParamData%C_obj%dt = ParamData%dt + ParamData%C_obj%numOuts = ParamData%numOuts +END SUBROUTINE + +subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(MAP_InputType), intent(inout) :: SrcInputData + type(MAP_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcInputData%x)) then + LB(1:1) = lbound(SrcInputData%x) + UB(1:1) = ubound(SrcInputData%x) + if (.not. associated(DstInputData%x)) then + allocate(DstInputData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%x = SrcInputData%x + end if + if (associated(SrcInputData%y)) then + LB(1:1) = lbound(SrcInputData%y) + UB(1:1) = ubound(SrcInputData%y) + if (.not. associated(DstInputData%y)) then + allocate(DstInputData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%y = SrcInputData%y + end if + if (associated(SrcInputData%z)) then + LB(1:1) = lbound(SrcInputData%z) + UB(1:1) = ubound(SrcInputData%z) + if (.not. associated(DstInputData%z)) then + allocate(DstInputData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%z = SrcInputData%z + end if + call MeshCopy(SrcInputData%PtFairDisplacement, DstInputData%PtFairDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine MAP_DestroyInput(InputData, ErrStat, ErrMsg) + type(MAP_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(InputData%x)) then + deallocate(InputData%x) + InputData%x => null() + InputData%C_obj%x = c_null_ptr + InputData%C_obj%x_Len = 0 + end if + if (associated(InputData%y)) then + deallocate(InputData%y) + InputData%y => null() + InputData%C_obj%y = c_null_ptr + InputData%C_obj%y_Len = 0 + end if + if (associated(InputData%z)) then + deallocate(InputData%z) + InputData%z => null() + InputData%C_obj%z = c_null_ptr + InputData%C_obj%z_Len = 0 + end if + call MeshDestroy( InputData%PtFairDisplacement, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine MAP_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, associated(InData%x)) + if (associated(InData%x)) then + call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPackPointer(Buf, c_loc(InData%x), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%x) + end if + end if + call RegPack(Buf, associated(InData%y)) + if (associated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPackPointer(Buf, c_loc(InData%y), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%y) + end if + end if + call RegPack(Buf, associated(InData%z)) + if (associated(InData%z)) then + call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + call RegPackPointer(Buf, c_loc(InData%z), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%z) + end if + end if + call MeshPack(Buf, InData%PtFairDisplacement) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%x, UB(1:1)-LB(1:1)) + OutData%x(LB(1):) => OutData%x + else + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%x) + OutData%C_obj%x_Len = size(OutData%x) + if (OutData%C_obj%x_Len > 0) OutData%C_obj%x = c_loc(OutData%x(LB(1))) + call RegUnpack(Buf, OutData%x) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%x => null() + end if + if (associated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%y, UB(1:1)-LB(1:1)) + OutData%y(LB(1):) => OutData%y + else + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%y) + OutData%C_obj%y_Len = size(OutData%y) + if (OutData%C_obj%y_Len > 0) OutData%C_obj%y = c_loc(OutData%y(LB(1))) + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%y => null() + end if + if (associated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%z, UB(1:1)-LB(1:1)) + OutData%z(LB(1):) => OutData%z + else + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%z) + OutData%C_obj%z_Len = size(OutData%z) + if (OutData%C_obj%z_Len > 0) OutData%C_obj%z = c_loc(OutData%z(LB(1))) + call RegUnpack(Buf, OutData%z) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%z => null() + end if + call MeshUnpack(Buf, OutData%PtFairDisplacement) ! PtFairDisplacement +end subroutine + +SUBROUTINE MAP_C2Fary_CopyInput(InputData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- x Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%x ) ) THEN + NULLIFY( InputData%x ) + ELSE + CALL C_F_POINTER(InputData%C_obj%x, InputData%x, [InputData%C_obj%x_Len]) END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtFairDisplacement - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + END IF + + ! -- y Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%y ) ) THEN + NULLIFY( InputData%y ) + ELSE + CALL C_F_POINTER(InputData%C_obj%y, InputData%y, [InputData%C_obj%y_Len]) END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtFairDisplacement - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + END IF + + ! -- z Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%z ) ) THEN + NULLIFY( InputData%z ) + ELSE + CALL C_F_POINTER(InputData%C_obj%z, InputData%z, [InputData%C_obj%z_Len]) 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%x) ) 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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%y) ) 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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - DbKiBuf(Db_Xferred) = InData%y(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%z) ) 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%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - DbKiBuf(Db_Xferred) = InData%z(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - CALL MeshPack( InData%PtFairDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairDisplacement - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + END IF +END SUBROUTINE - 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) +SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- 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 ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE MAP_PackInput - - SUBROUTINE MAP_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(MAP_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x 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%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z 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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - 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 + 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 - 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 + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) END IF - CALL MeshUnpack( OutData%PtFairDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtFairDisplacement - 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 MAP_UnPackInput - - SUBROUTINE MAP_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- x Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%x ) ) THEN - NULLIFY( InputData%x ) - ELSE - CALL C_F_POINTER(InputData%C_obj%x, InputData%x, (/InputData%C_obj%x_Len/)) - END IF - END IF - - ! -- y Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%y ) ) THEN - NULLIFY( InputData%y ) - ELSE - CALL C_F_POINTER(InputData%C_obj%y, InputData%y, (/InputData%C_obj%y_Len/)) - END IF - END IF - - ! -- z Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%z ) ) THEN - NULLIFY( InputData%z ) - ELSE - CALL C_F_POINTER(InputData%C_obj%z, InputData%z, (/InputData%C_obj%z_Len/)) - END IF - END IF - END SUBROUTINE MAP_C2Fary_CopyInput - - SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - END IF - END IF - END SUBROUTINE MAP_F2C_CopyInput - - SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(MAP_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + END IF +END SUBROUTINE + +subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(MAP_OutputType), intent(inout) :: SrcOutputData + type(MAP_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcOutputData%Fx)) then + LB(1:1) = lbound(SrcOutputData%Fx) + UB(1:1) = ubound(SrcOutputData%Fx) + if (.not. associated(DstOutputData%Fx)) then + allocate(DstOutputData%Fx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOutputData%Fx = SrcOutputData%Fx + end if + if (associated(SrcOutputData%Fy)) then + LB(1:1) = lbound(SrcOutputData%Fy) + UB(1:1) = ubound(SrcOutputData%Fy) + if (.not. associated(DstOutputData%Fy)) then + allocate(DstOutputData%Fy(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOutputData%Fy = SrcOutputData%Fy + end if + if (associated(SrcOutputData%Fz)) then + LB(1:1) = lbound(SrcOutputData%Fz) + UB(1:1) = ubound(SrcOutputData%Fz) + if (.not. associated(DstOutputData%Fz)) then + allocate(DstOutputData%Fz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOutputData%Fz = SrcOutputData%Fz + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if + if (associated(SrcOutputData%wrtOutput)) then + LB(1:1) = lbound(SrcOutputData%wrtOutput) + UB(1:1) = ubound(SrcOutputData%wrtOutput) + if (.not. associated(DstOutputData%wrtOutput)) then + allocate(DstOutputData%wrtOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOutputData%wrtOutput = SrcOutputData%wrtOutput + end if + call MeshCopy(SrcOutputData%ptFairleadLoad, DstOutputData%ptFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine MAP_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(MAP_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(OutputData%Fx)) then + deallocate(OutputData%Fx) + OutputData%Fx => null() + OutputData%C_obj%Fx = c_null_ptr + OutputData%C_obj%Fx_Len = 0 + end if + if (associated(OutputData%Fy)) then + deallocate(OutputData%Fy) + OutputData%Fy => null() + OutputData%C_obj%Fy = c_null_ptr + OutputData%C_obj%Fy_Len = 0 + end if + if (associated(OutputData%Fz)) then + deallocate(OutputData%Fz) + OutputData%Fz => null() + OutputData%C_obj%Fz = c_null_ptr + OutputData%C_obj%Fz_Len = 0 + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + if (associated(OutputData%wrtOutput)) then + deallocate(OutputData%wrtOutput) + OutputData%wrtOutput => null() + OutputData%C_obj%wrtOutput = c_null_ptr + OutputData%C_obj%wrtOutput_Len = 0 + end if + call MeshDestroy( OutputData%ptFairleadLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine MAP_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, associated(InData%Fx)) + if (associated(InData%Fx)) then + call RegPackBounds(Buf, 1, lbound(InData%Fx), ubound(InData%Fx)) + call RegPackPointer(Buf, c_loc(InData%Fx), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fx) + end if + end if + call RegPack(Buf, associated(InData%Fy)) + if (associated(InData%Fy)) then + call RegPackBounds(Buf, 1, lbound(InData%Fy), ubound(InData%Fy)) + call RegPackPointer(Buf, c_loc(InData%Fy), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fy) + end if + end if + call RegPack(Buf, associated(InData%Fz)) + if (associated(InData%Fz)) then + call RegPackBounds(Buf, 1, lbound(InData%Fz), ubound(InData%Fz)) + call RegPackPointer(Buf, c_loc(InData%Fz), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fz) + end if + end if + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + call RegPack(Buf, associated(InData%wrtOutput)) + if (associated(InData%wrtOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%wrtOutput), ubound(InData%wrtOutput)) + call RegPackPointer(Buf, c_loc(InData%wrtOutput), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%wrtOutput) + end if + end if + call MeshPack(Buf, InData%ptFairleadLoad) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%Fx)) deallocate(OutData%Fx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fx, UB(1:1)-LB(1:1)) + OutData%Fx(LB(1):) => OutData%Fx + else + allocate(OutData%Fx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fx) + OutData%C_obj%Fx_Len = size(OutData%Fx) + if (OutData%C_obj%Fx_Len > 0) OutData%C_obj%Fx = c_loc(OutData%Fx(LB(1))) + call RegUnpack(Buf, OutData%Fx) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fx => null() + end if + if (associated(OutData%Fy)) deallocate(OutData%Fy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fy, UB(1:1)-LB(1:1)) + OutData%Fy(LB(1):) => OutData%Fy + else + allocate(OutData%Fy(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fy) + OutData%C_obj%Fy_Len = size(OutData%Fy) + if (OutData%C_obj%Fy_Len > 0) OutData%C_obj%Fy = c_loc(OutData%Fy(LB(1))) + call RegUnpack(Buf, OutData%Fy) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fy => null() + end if + if (associated(OutData%Fz)) deallocate(OutData%Fz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fz, UB(1:1)-LB(1:1)) + OutData%Fz(LB(1):) => OutData%Fz + else + allocate(OutData%Fz(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fz) + OutData%C_obj%Fz_Len = size(OutData%Fz) + if (OutData%C_obj%Fz_Len > 0) OutData%C_obj%Fz = c_loc(OutData%Fz(LB(1))) + call RegUnpack(Buf, OutData%Fz) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fz => null() + end if + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (associated(OutData%wrtOutput)) deallocate(OutData%wrtOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%wrtOutput, UB(1:1)-LB(1:1)) + OutData%wrtOutput(LB(1):) => OutData%wrtOutput + else + allocate(OutData%wrtOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wrtOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%wrtOutput) + OutData%C_obj%wrtOutput_Len = size(OutData%wrtOutput) + if (OutData%C_obj%wrtOutput_Len > 0) OutData%C_obj%wrtOutput = c_loc(OutData%wrtOutput(LB(1))) + call RegUnpack(Buf, OutData%wrtOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%wrtOutput => null() + end if + call MeshUnpack(Buf, OutData%ptFairleadLoad) ! ptFairleadLoad +end subroutine + +SUBROUTINE MAP_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData 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 = 'MAP_CopyOutput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" -IF (ASSOCIATED(SrcOutputData%Fx)) THEN - i1_l = LBOUND(SrcOutputData%Fx,1) - i1_u = UBOUND(SrcOutputData%Fx,1) - IF (.NOT. ASSOCIATED(DstOutputData%Fx)) THEN - ALLOCATE(DstOutputData%Fx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOutputData%Fx = SrcOutputData%Fx -ENDIF -IF (ASSOCIATED(SrcOutputData%Fy)) THEN - i1_l = LBOUND(SrcOutputData%Fy,1) - i1_u = UBOUND(SrcOutputData%Fy,1) - IF (.NOT. ASSOCIATED(DstOutputData%Fy)) THEN - ALLOCATE(DstOutputData%Fy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOutputData%Fy = SrcOutputData%Fy -ENDIF -IF (ASSOCIATED(SrcOutputData%Fz)) THEN - i1_l = LBOUND(SrcOutputData%Fz,1) - i1_u = UBOUND(SrcOutputData%Fz,1) - IF (.NOT. ASSOCIATED(DstOutputData%Fz)) THEN - ALLOCATE(DstOutputData%Fz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOutputData%Fz = SrcOutputData%Fz -ENDIF -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 -IF (ASSOCIATED(SrcOutputData%wrtOutput)) THEN - i1_l = LBOUND(SrcOutputData%wrtOutput,1) - i1_u = UBOUND(SrcOutputData%wrtOutput,1) - IF (.NOT. ASSOCIATED(DstOutputData%wrtOutput)) THEN - ALLOCATE(DstOutputData%wrtOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOutputData%wrtOutput = SrcOutputData%wrtOutput -ENDIF - CALL MeshCopy( SrcOutputData%ptFairleadLoad, DstOutputData%ptFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE MAP_CopyOutput - - SUBROUTINE MAP_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(MAP_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 = 'MAP_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(OutputData%Fx)) THEN - 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 - 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 - DEALLOCATE(OutputData%Fz) - OutputData%Fz => NULL() - OutputData%C_obj%Fz = C_NULL_PTR - OutputData%C_obj%Fz_Len = 0 -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF -IF (ASSOCIATED(OutputData%wrtOutput)) THEN - DEALLOCATE(OutputData%wrtOutput) - OutputData%wrtOutput => NULL() - OutputData%C_obj%wrtOutput = C_NULL_PTR - OutputData%C_obj%wrtOutput_Len = 0 -ENDIF - CALL MeshDestroy( OutputData%ptFairleadLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE MAP_DestroyOutput - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 ! Fx allocated yes/no - IF ( ASSOCIATED(InData%Fx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fx upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fx) ! Fx - END IF - Int_BufSz = Int_BufSz + 1 ! Fy allocated yes/no - IF ( ASSOCIATED(InData%Fy) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fy upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fy) ! Fy - END IF - Int_BufSz = Int_BufSz + 1 ! Fz allocated yes/no - IF ( ASSOCIATED(InData%Fz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fz upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fz) ! Fz - END IF - 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 - Int_BufSz = Int_BufSz + 1 ! wrtOutput allocated yes/no - IF ( ASSOCIATED(InData%wrtOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! wrtOutput upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%wrtOutput) ! wrtOutput - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! ptFairleadLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%ptFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ptFairleadLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ptFairleadLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- Fx Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fx ) ) THEN + NULLIFY( OutputData%Fx ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fx, OutputData%Fx, [OutputData%C_obj%Fx_Len]) END IF - IF(ALLOCATED(Db_Buf)) THEN ! ptFairleadLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + END IF + + ! -- Fy Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fy ) ) THEN + NULLIFY( OutputData%Fy ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fy, OutputData%Fy, [OutputData%C_obj%Fy_Len]) END IF - IF(ALLOCATED(Int_Buf)) THEN ! ptFairleadLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + END IF + + ! -- Fz Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fz ) ) THEN + NULLIFY( OutputData%Fz ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fz, OutputData%Fz, [OutputData%C_obj%Fz_Len]) 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%Fx) ) 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%Fx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fx,1), UBOUND(InData%Fx,1) - DbKiBuf(Db_Xferred) = InData%Fx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fy) ) 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%Fy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fy,1), UBOUND(InData%Fy,1) - DbKiBuf(Db_Xferred) = InData%Fy(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fz) ) 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%Fz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fz,1), UBOUND(InData%Fz,1) - DbKiBuf(Db_Xferred) = InData%Fz(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - 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 - IF ( .NOT. ASSOCIATED(InData%wrtOutput) ) 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%wrtOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wrtOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%wrtOutput,1), UBOUND(InData%wrtOutput,1) - DbKiBuf(Db_Xferred) = InData%wrtOutput(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - CALL MeshPack( InData%ptFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ptFairleadLoad - 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) + END IF + + ! -- wrtOutput Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%wrtOutput ) ) THEN + NULLIFY( OutputData%wrtOutput ) 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) + CALL C_F_POINTER(OutputData%C_obj%wrtOutput, OutputData%wrtOutput, [OutputData%C_obj%wrtOutput_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- 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 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) + 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 ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE MAP_PackOutput - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 ! Fx 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%Fx)) DEALLOCATE(OutData%Fx) - ALLOCATE(OutData%Fx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%Fx,1), UBOUND(OutData%Fx,1) - OutData%Fx(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy 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%Fy)) DEALLOCATE(OutData%Fy) - ALLOCATE(OutData%Fy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%Fy,1), UBOUND(OutData%Fy,1) - OutData%Fy(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz 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%Fz)) DEALLOCATE(OutData%Fz) - ALLOCATE(OutData%Fz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%Fz,1), UBOUND(OutData%Fz,1) - OutData%Fz(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wrtOutput 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%wrtOutput)) DEALLOCATE(OutData%wrtOutput) - ALLOCATE(OutData%wrtOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%wrtOutput,1), UBOUND(OutData%wrtOutput,1) - OutData%wrtOutput(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - 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 + 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 - 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 + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) END IF - CALL MeshUnpack( OutData%ptFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ptFairleadLoad - 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 MAP_UnPackOutput - - SUBROUTINE MAP_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- Fx Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fx ) ) THEN - NULLIFY( OutputData%Fx ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%Fx, OutputData%Fx, (/OutputData%C_obj%Fx_Len/)) - END IF - END IF - - ! -- Fy Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fy ) ) THEN - NULLIFY( OutputData%Fy ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%Fy, OutputData%Fy, (/OutputData%C_obj%Fy_Len/)) - END IF - END IF - - ! -- Fz Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fz ) ) THEN - NULLIFY( OutputData%Fz ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%Fz, OutputData%Fz, (/OutputData%C_obj%Fz_Len/)) - END IF - END IF - - ! -- wrtOutput Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%wrtOutput ) ) THEN - NULLIFY( OutputData%wrtOutput ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%wrtOutput, OutputData%wrtOutput, (/OutputData%C_obj%wrtOutput_Len/)) - END IF - END IF - END SUBROUTINE MAP_C2Fary_CopyOutput - - SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - END IF - END IF - END SUBROUTINE MAP_F2C_CopyOutput - - - SUBROUTINE MAP_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(MAP_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(MAP_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 + END IF +END SUBROUTINE + +subroutine MAP_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(MAP_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(MAP_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 = 'MAP_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 MAP_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL MAP_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 MAP_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 MAP_Input_ExtrapInterp - - - SUBROUTINE MAP_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call MAP_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call MAP_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call MAP_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE MAP_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. @@ -5047,61 +3454,53 @@ SUBROUTINE MAP_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(MAP_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(MAP_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(MAP_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 + TYPE(MAP_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(MAP_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(MAP_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 = 'MAP_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 - 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN - DO i1 = LBOUND(u_out%x,1),UBOUND(u_out%x,1) - b = -(u1%x(i1) - u2%x(i1)) - u_out%x(i1) = u1%x(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN - DO i1 = LBOUND(u_out%y,1),UBOUND(u_out%y,1) - b = -(u1%y(i1) - u2%y(i1)) - u_out%y(i1) = u1%y(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN - DO i1 = LBOUND(u_out%z,1),UBOUND(u_out%z,1) - b = -(u1%z(i1) - u2%z(i1)) - u_out%z(i1) = u1%z(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - CALL MeshExtrapInterp1(u1%PtFairDisplacement, u2%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE MAP_Input_ExtrapInterp1 - - - SUBROUTINE MAP_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN + u_out%x = a1*u1%x + a2*u2%x + END IF ! check if allocated + IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN + u_out%y = a1*u1%y + a2*u2%y + END IF ! check if allocated + IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN + u_out%z = a1*u1%z + a2*u2%z + END IF ! check if allocated + CALL MeshExtrapInterp1(u1%PtFairDisplacement, u2%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE MAP_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. @@ -5115,124 +3514,113 @@ SUBROUTINE MAP_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(MAP_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(MAP_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(MAP_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(MAP_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 + TYPE(MAP_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(MAP_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(MAP_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(MAP_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 = 'MAP_Input_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Input_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 + 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 + 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 + 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 (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN - DO i1 = LBOUND(u_out%x,1),UBOUND(u_out%x,1) - b = (t(3)**2*(u1%x(i1) - u2%x(i1)) + t(2)**2*(-u1%x(i1) + u3%x(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%x(i1) + t(3)*u2%x(i1) - t(2)*u3%x(i1) ) * scaleFactor - u_out%x(i1) = u1%x(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN - DO i1 = LBOUND(u_out%y,1),UBOUND(u_out%y,1) - b = (t(3)**2*(u1%y(i1) - u2%y(i1)) + t(2)**2*(-u1%y(i1) + u3%y(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%y(i1) + t(3)*u2%y(i1) - t(2)*u3%y(i1) ) * scaleFactor - u_out%y(i1) = u1%y(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN - DO i1 = LBOUND(u_out%z,1),UBOUND(u_out%z,1) - b = (t(3)**2*(u1%z(i1) - u2%z(i1)) + t(2)**2*(-u1%z(i1) + u3%z(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%z(i1) + t(3)*u2%z(i1) - t(2)*u3%z(i1) ) * scaleFactor - u_out%z(i1) = u1%z(i1) + b + c * t_out - END DO -END IF ! check if allocated - CALL MeshExtrapInterp2(u1%PtFairDisplacement, u2%PtFairDisplacement, u3%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE MAP_Input_ExtrapInterp2 - - - SUBROUTINE MAP_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(MAP_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(MAP_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN + u_out%x = a1*u1%x + a2*u2%x + a3*u3%x + END IF ! check if allocated + IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN + u_out%y = a1*u1%y + a2*u2%y + a3*u3%y + END IF ! check if allocated + IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN + u_out%z = a1*u1%z + a2*u2%z + a3*u3%z + END IF ! check if allocated + CALL MeshExtrapInterp2(u1%PtFairDisplacement, u2%PtFairDisplacement, u3%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine MAP_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(MAP_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(MAP_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 = 'MAP_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 MAP_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL MAP_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 MAP_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 MAP_Output_ExtrapInterp - - - SUBROUTINE MAP_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call MAP_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call MAP_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call MAP_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE MAP_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. @@ -5244,73 +3632,59 @@ SUBROUTINE MAP_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(MAP_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(MAP_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(MAP_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 + TYPE(MAP_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(MAP_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(MAP_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 = 'MAP_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN - DO i1 = LBOUND(y_out%Fx,1),UBOUND(y_out%Fx,1) - b = -(y1%Fx(i1) - y2%Fx(i1)) - y_out%Fx(i1) = y1%Fx(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN - DO i1 = LBOUND(y_out%Fy,1),UBOUND(y_out%Fy,1) - b = -(y1%Fy(i1) - y2%Fy(i1)) - y_out%Fy(i1) = y1%Fy(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN - DO i1 = LBOUND(y_out%Fz,1),UBOUND(y_out%Fz,1) - b = -(y1%Fz(i1) - y2%Fz(i1)) - y_out%Fz(i1) = y1%Fz(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -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 -IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN - DO i1 = LBOUND(y_out%wrtOutput,1),UBOUND(y_out%wrtOutput,1) - b = -(y1%wrtOutput(i1) - y2%wrtOutput(i1)) - y_out%wrtOutput(i1) = y1%wrtOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - CALL MeshExtrapInterp1(y1%ptFairleadLoad, y2%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE MAP_Output_ExtrapInterp1 - - - SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN + y_out%Fx = a1*y1%Fx + a2*y2%Fx + END IF ! check if allocated + IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN + y_out%Fy = a1*y1%Fy + a2*y2%Fy + END IF ! check if allocated + IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN + y_out%Fz = a1*y1%Fz + a2*y2%Fz + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated + IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN + y_out%wrtOutput = a1*y1%wrtOutput + a2*y2%wrtOutput + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%ptFairleadLoad, y2%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE MAP_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. @@ -5324,84 +3698,64 @@ SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(MAP_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(MAP_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(MAP_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(MAP_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 + TYPE(MAP_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(MAP_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(MAP_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(MAP_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 = 'MAP_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_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 + 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 + 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 + 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 (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN - DO i1 = LBOUND(y_out%Fx,1),UBOUND(y_out%Fx,1) - b = (t(3)**2*(y1%Fx(i1) - y2%Fx(i1)) + t(2)**2*(-y1%Fx(i1) + y3%Fx(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%Fx(i1) + t(3)*y2%Fx(i1) - t(2)*y3%Fx(i1) ) * scaleFactor - y_out%Fx(i1) = y1%Fx(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN - DO i1 = LBOUND(y_out%Fy,1),UBOUND(y_out%Fy,1) - b = (t(3)**2*(y1%Fy(i1) - y2%Fy(i1)) + t(2)**2*(-y1%Fy(i1) + y3%Fy(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%Fy(i1) + t(3)*y2%Fy(i1) - t(2)*y3%Fy(i1) ) * scaleFactor - y_out%Fy(i1) = y1%Fy(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN - DO i1 = LBOUND(y_out%Fz,1),UBOUND(y_out%Fz,1) - b = (t(3)**2*(y1%Fz(i1) - y2%Fz(i1)) + t(2)**2*(-y1%Fz(i1) + y3%Fz(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%Fz(i1) + t(3)*y2%Fz(i1) - t(2)*y3%Fz(i1) ) * scaleFactor - y_out%Fz(i1) = y1%Fz(i1) + b + c * t_out - END DO -END IF ! check if allocated -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 -IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN - DO i1 = LBOUND(y_out%wrtOutput,1),UBOUND(y_out%wrtOutput,1) - b = (t(3)**2*(y1%wrtOutput(i1) - y2%wrtOutput(i1)) + t(2)**2*(-y1%wrtOutput(i1) + y3%wrtOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%wrtOutput(i1) + t(3)*y2%wrtOutput(i1) - t(2)*y3%wrtOutput(i1) ) * scaleFactor - y_out%wrtOutput(i1) = y1%wrtOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - CALL MeshExtrapInterp2(y1%ptFairleadLoad, y2%ptFairleadLoad, y3%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE MAP_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN + y_out%Fx = a1*y1%Fx + a2*y2%Fx + a3*y3%Fx + END IF ! check if allocated + IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN + y_out%Fy = a1*y1%Fy + a2*y2%Fy + a3*y3%Fy + END IF ! check if allocated + IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN + y_out%Fz = a1*y1%Fz + a2*y2%Fz + a3*y3%Fz + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated + IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN + y_out%wrtOutput = a1*y1%wrtOutput + a2*y2%wrtOutput + a3*y3%wrtOutput + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%ptFairleadLoad, y2%ptFairleadLoad, y3%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE MAP_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 127da93d94..aabdec7d8b 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -49,147 +49,147 @@ MODULE MoorDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PtfmInit !< initial position of platform(s) shape: 6, nTurbines [-] INTEGER(IntKi) :: FarmSize = 0 !< Indicates normal FAST module mode if 0, FAST.Farm coupled mode and =nTurbines if >0 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TurbineRefPos !< reference position of turbines in farm, shape: 3, nTurbines [-] - REAL(ReKi) :: Tmax !< simulation duration [[s]] + REAL(ReKi) :: Tmax = 0.0_ReKi !< simulation duration [[s]] CHARACTER(1024) :: FileName !< MoorDyn input file [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] LOGICAL :: UsePrimaryInputFile = .TRUE. !< Read input file instead of passed data [-] TYPE(FileInfoType) :: PassedPrimaryInputData !< Primary input file as FileInfoType (set by driver/glue code) -- String array with metadata [-] - LOGICAL :: Echo !< echo parameter - do we want to echo the header line describing the input file? [-] + LOGICAL :: Echo = .false. !< echo parameter - do we want to echo the header line describing the input file? [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< string containing list of output channels requested in input file [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] END TYPE MD_InitInputType ! ======================= ! ========= MD_LineProp ======= TYPE, PUBLIC :: MD_LineProp - INTEGER(IntKi) :: IdNum !< integer identifier of this set of line properties [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this set of line properties [-] CHARACTER(20) :: name !< name/identifier of this set of line properties [-] - REAL(DbKi) :: d !< volume-equivalent diameter [[m]] - REAL(DbKi) :: w !< per-length weight in air [[kg/m]] - REAL(DbKi) :: EA !< axial stiffness [[N]] - REAL(DbKi) :: EA_D !< axial stiffness [[N]] - REAL(DbKi) :: BA !< internal damping coefficient times area [[N-s]] - REAL(DbKi) :: BA_D !< internal damping coefficient times area [[N-s]] - REAL(DbKi) :: EI !< bending stiffness [[N-m]] - REAL(DbKi) :: Can !< transverse added mass coefficient [-] - REAL(DbKi) :: Cat !< tangential added mass coefficient [-] - REAL(DbKi) :: Cdn !< transverse drag coefficient [-] - REAL(DbKi) :: Cdt !< tangential drag coefficient [-] - INTEGER(IntKi) :: ElasticMod !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] + REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] + REAL(DbKi) :: w = 0.0_R8Ki !< per-length weight in air [[kg/m]] + REAL(DbKi) :: EA = 0.0_R8Ki !< axial stiffness [[N]] + REAL(DbKi) :: EA_D = 0.0_R8Ki !< axial stiffness [[N]] + REAL(DbKi) :: BA = 0.0_R8Ki !< internal damping coefficient times area [[N-s]] + REAL(DbKi) :: BA_D = 0.0_R8Ki !< internal damping coefficient times area [[N-s]] + REAL(DbKi) :: EI = 0.0_R8Ki !< bending stiffness [[N-m]] + REAL(DbKi) :: Can = 0.0_R8Ki !< transverse added mass coefficient [-] + REAL(DbKi) :: Cat = 0.0_R8Ki !< tangential added mass coefficient [-] + REAL(DbKi) :: Cdn = 0.0_R8Ki !< transverse drag coefficient [-] + REAL(DbKi) :: Cdt = 0.0_R8Ki !< tangential drag coefficient [-] + INTEGER(IntKi) :: ElasticMod = 0_IntKi !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] INTEGER(IntKi) :: nEApoints = 0 !< number of values in stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffXs !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffYs !< y array for stress-strain lookup table [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] INTEGER(IntKi) :: nBApoints = 0 !< number of values in stress-strainrate lookup table (0 means using constant c) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampXs !< x array for stress-strainrate lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampYs !< y array for stress-strainrate lookup table [-] + REAL(DbKi) , DIMENSION(1:30) :: dampXs = 0.0_R8Ki !< x array for stress-strainrate lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: dampYs = 0.0_R8Ki !< y array for stress-strainrate lookup table [-] INTEGER(IntKi) :: nEIpoints = 0 !< number of values in bending stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffXs !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffYs !< y array for stress-strain lookup table [-] + REAL(DbKi) , DIMENSION(1:30) :: bstiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: bstiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] END TYPE MD_LineProp ! ======================= ! ========= MD_RodProp ======= TYPE, PUBLIC :: MD_RodProp - INTEGER(IntKi) :: IdNum !< integer identifier of this set of rod properties [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this set of rod properties [-] CHARACTER(10) :: name !< name/identifier of this set of rod properties [-] - REAL(DbKi) :: d !< volume-equivalent diameter [[m]] - REAL(DbKi) :: w !< per-length weight in air [[kg/m]] - REAL(DbKi) :: Can !< transverse added mass coefficient [-] - REAL(DbKi) :: Cat !< tangential added mass coefficient [-] - REAL(DbKi) :: Cdn !< transverse drag coefficient [-] - REAL(DbKi) :: Cdt !< tangential drag coefficient [-] - REAL(DbKi) :: CdEnd !< drag coefficient for rod end [[-]] - REAL(DbKi) :: CaEnd !< added mass coefficient for rod end [[-]] + REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] + REAL(DbKi) :: w = 0.0_R8Ki !< per-length weight in air [[kg/m]] + REAL(DbKi) :: Can = 0.0_R8Ki !< transverse added mass coefficient [-] + REAL(DbKi) :: Cat = 0.0_R8Ki !< tangential added mass coefficient [-] + REAL(DbKi) :: Cdn = 0.0_R8Ki !< transverse drag coefficient [-] + REAL(DbKi) :: Cdt = 0.0_R8Ki !< tangential drag coefficient [-] + REAL(DbKi) :: CdEnd = 0.0_R8Ki !< drag coefficient for rod end [[-]] + REAL(DbKi) :: CaEnd = 0.0_R8Ki !< added mass coefficient for rod end [[-]] END TYPE MD_RodProp ! ======================= ! ========= MD_Body ======= TYPE, PUBLIC :: MD_Body - INTEGER(IntKi) :: IdNum !< integer identifier of this Connection [-] - INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] - INTEGER(IntKi) , DIMENSION(1:30) :: AttachedC !< list of IdNums of connections attached to this body [-] - INTEGER(IntKi) , DIMENSION(1:30) :: AttachedR !< list of IdNums of rods attached to this body [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this Connection [-] + INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] + INTEGER(IntKi) , DIMENSION(1:30) :: AttachedC = 0_IntKi !< list of IdNums of connections attached to this body [-] + INTEGER(IntKi) , DIMENSION(1:30) :: AttachedR = 0_IntKi !< list of IdNums of rods attached to this body [-] INTEGER(IntKi) :: nAttachedC = 0 !< number of attached connections [-] INTEGER(IntKi) :: nAttachedR = 0 !< number of attached rods [-] - REAL(DbKi) , DIMENSION(1:3,1:30) :: rConnectRel !< relative position of connection on body [-] - REAL(DbKi) , DIMENSION(1:6,1:30) :: r6RodRel !< relative position and orientation of rod on body [-] - REAL(DbKi) :: bodyM !< [-] - REAL(DbKi) :: bodyV !< [-] - REAL(DbKi) , DIMENSION(1:3) :: bodyI !< [-] - REAL(DbKi) , DIMENSION(1:6) :: bodyCdA !< product of drag force and frontal area of connection point [[m^2]] - REAL(DbKi) , DIMENSION(1:6) :: bodyCa !< added mass coefficient of connection point [-] - REAL(DbKi) :: time !< current time [[s]] - REAL(DbKi) , DIMENSION(1:6) :: r6 !< position [-] - REAL(DbKi) , DIMENSION(1:6) :: v6 !< velocity [-] - REAL(DbKi) , DIMENSION(1:6) :: a6 !< acceleration (only used for coupled bodies) [-] - REAL(DbKi) , DIMENSION(1:3) :: U !< water velocity at ref point [[m/s]] - REAL(DbKi) , DIMENSION(1:3) :: Ud !< water acceleration at ref point [[m/s^2]] - REAL(DbKi) :: zeta !< water surface elevation above ref point [[m]] - REAL(DbKi) , DIMENSION(1:6) :: F6net !< total force and moment on body (excluding inertial loads) [-] - REAL(DbKi) , DIMENSION(1:6,1:6) :: M6net !< total mass matrix of Body and any attached objects [-] - REAL(DbKi) , DIMENSION(1:6,1:6) :: M !< rotated body 6-dof mass and inertia matrix in global orientation [-] - REAL(DbKi) , DIMENSION(1:6,1:6) :: M0 !< body 6-dof mass and inertia matrix in its own frame [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: OrMat !< DCM for body orientation [-] - REAL(DbKi) , DIMENSION(1:3) :: rCG !< vector in body frame from ref point to CG (before rods etc..) [-] + REAL(DbKi) , DIMENSION(1:3,1:30) :: rConnectRel = 0.0_R8Ki !< relative position of connection on body [-] + REAL(DbKi) , DIMENSION(1:6,1:30) :: r6RodRel = 0.0_R8Ki !< relative position and orientation of rod on body [-] + REAL(DbKi) :: bodyM = 0.0_R8Ki !< [-] + REAL(DbKi) :: bodyV = 0.0_R8Ki !< [-] + REAL(DbKi) , DIMENSION(1:3) :: bodyI = 0.0_R8Ki !< [-] + REAL(DbKi) , DIMENSION(1:6) :: bodyCdA = 0.0_R8Ki !< product of drag force and frontal area of connection point [[m^2]] + REAL(DbKi) , DIMENSION(1:6) :: bodyCa = 0.0_R8Ki !< added mass coefficient of connection point [-] + REAL(DbKi) :: time = 0.0_R8Ki !< current time [[s]] + REAL(DbKi) , DIMENSION(1:6) :: r6 = 0.0_R8Ki !< position [-] + REAL(DbKi) , DIMENSION(1:6) :: v6 = 0.0_R8Ki !< velocity [-] + REAL(DbKi) , DIMENSION(1:6) :: a6 = 0.0_R8Ki !< acceleration (only used for coupled bodies) [-] + REAL(DbKi) , DIMENSION(1:3) :: U = 0.0_R8Ki !< water velocity at ref point [[m/s]] + REAL(DbKi) , DIMENSION(1:3) :: Ud = 0.0_R8Ki !< water acceleration at ref point [[m/s^2]] + REAL(DbKi) :: zeta = 0.0_R8Ki !< water surface elevation above ref point [[m]] + REAL(DbKi) , DIMENSION(1:6) :: F6net = 0.0_R8Ki !< total force and moment on body (excluding inertial loads) [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M6net = 0.0_R8Ki !< total mass matrix of Body and any attached objects [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M = 0.0_R8Ki !< rotated body 6-dof mass and inertia matrix in global orientation [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M0 = 0.0_R8Ki !< body 6-dof mass and inertia matrix in its own frame [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: OrMat = 0.0_R8Ki !< DCM for body orientation [-] + REAL(DbKi) , DIMENSION(1:3) :: rCG = 0.0_R8Ki !< vector in body frame from ref point to CG (before rods etc..) [-] END TYPE MD_Body ! ======================= ! ========= MD_Connect ======= TYPE, PUBLIC :: MD_Connect - INTEGER(IntKi) :: IdNum !< integer identifier of this Connection [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this Connection [-] CHARACTER(10) :: type !< type of Connect: fix, vessel, connect [-] - INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] - INTEGER(IntKi) , DIMENSION(1:10) :: Attached !< list of IdNums of lines attached to this connection node [-] - INTEGER(IntKi) , DIMENSION(1:10) :: Top !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] + INTEGER(IntKi) , DIMENSION(1:10) :: Attached = 0_IntKi !< list of IdNums of lines attached to this connection node [-] + INTEGER(IntKi) , DIMENSION(1:10) :: Top = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] INTEGER(IntKi) :: nAttached = 0 !< number of attached lines [-] - REAL(DbKi) :: conM !< [-] - REAL(DbKi) :: conV !< [-] - REAL(DbKi) :: conFX !< [-] - REAL(DbKi) :: conFY !< [-] - REAL(DbKi) :: conFZ !< [-] - REAL(DbKi) :: conCa !< added mass coefficient of connection point [-] - REAL(DbKi) :: conCdA !< product of drag force and frontal area of connection point [[m^2]] - REAL(DbKi) :: time !< current time [[s]] - REAL(DbKi) , DIMENSION(1:3) :: r !< position [-] - REAL(DbKi) , DIMENSION(1:3) :: rd !< velocity [-] - REAL(DbKi) , DIMENSION(1:3) :: a !< acceleration (only used for coupled points) [-] - REAL(DbKi) , DIMENSION(1:3) :: U !< water velocity at node [[m/s]] - REAL(DbKi) , DIMENSION(1:3) :: Ud !< water acceleration at node [[m/s^2]] - REAL(DbKi) :: zeta !< water surface elevation above node [[m]] + REAL(DbKi) :: conM = 0.0_R8Ki !< [-] + REAL(DbKi) :: conV = 0.0_R8Ki !< [-] + REAL(DbKi) :: conFX = 0.0_R8Ki !< [-] + REAL(DbKi) :: conFY = 0.0_R8Ki !< [-] + REAL(DbKi) :: conFZ = 0.0_R8Ki !< [-] + REAL(DbKi) :: conCa = 0.0_R8Ki !< added mass coefficient of connection point [-] + REAL(DbKi) :: conCdA = 0.0_R8Ki !< product of drag force and frontal area of connection point [[m^2]] + REAL(DbKi) :: time = 0.0_R8Ki !< current time [[s]] + REAL(DbKi) , DIMENSION(1:3) :: r = 0.0_R8Ki !< position [-] + REAL(DbKi) , DIMENSION(1:3) :: rd = 0.0_R8Ki !< velocity [-] + REAL(DbKi) , DIMENSION(1:3) :: a = 0.0_R8Ki !< acceleration (only used for coupled points) [-] + REAL(DbKi) , DIMENSION(1:3) :: U = 0.0_R8Ki !< water velocity at node [[m/s]] + REAL(DbKi) , DIMENSION(1:3) :: Ud = 0.0_R8Ki !< water acceleration at node [[m/s^2]] + REAL(DbKi) :: zeta = 0.0_R8Ki !< water surface elevation above node [[m]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: PDyn !< water dynamic pressure at node [[Pa]] - REAL(DbKi) , DIMENSION(1:3) :: Fnet !< total force on node (excluding inertial loads) [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: M !< node mass matrix, from attached lines [-] + REAL(DbKi) , DIMENSION(1:3) :: Fnet = 0.0_R8Ki !< total force on node (excluding inertial loads) [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: M = 0.0_R8Ki !< node mass matrix, from attached lines [-] END TYPE MD_Connect ! ======================= ! ========= MD_Rod ======= TYPE, PUBLIC :: MD_Rod - INTEGER(IntKi) :: IdNum !< integer identifier of this Line [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this Line [-] CHARACTER(10) :: type !< type of Rod. should match one of RodProp names [-] - INTEGER(IntKi) :: PropsIdNum !< the IdNum of the associated rod properties [-] - INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] - INTEGER(IntKi) , DIMENSION(1:10) :: AttachedA !< list of IdNums of lines attached to end A [-] - INTEGER(IntKi) , DIMENSION(1:10) :: AttachedB !< list of IdNums of lines attached to end B [-] - INTEGER(IntKi) , DIMENSION(1:10) :: TopA !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] - INTEGER(IntKi) , DIMENSION(1:10) :: TopB !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) :: PropsIdNum = 0_IntKi !< the IdNum of the associated rod properties [-] + INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] + INTEGER(IntKi) , DIMENSION(1:10) :: AttachedA = 0_IntKi !< list of IdNums of lines attached to end A [-] + INTEGER(IntKi) , DIMENSION(1:10) :: AttachedB = 0_IntKi !< list of IdNums of lines attached to end B [-] + INTEGER(IntKi) , DIMENSION(1:10) :: TopA = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: TopB = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] INTEGER(IntKi) :: nAttachedA = 0 !< number of attached lines to Rod end A [-] INTEGER(IntKi) :: nAttachedB = 0 !< number of attached lines to Rod end B [-] - INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList !< array specifying what line quantities should be output (1 vs 0) [-] - INTEGER(IntKi) :: N !< The number of elements in the line [-] - INTEGER(IntKi) :: endTypeA !< type of connection at end A: 0=pinned to Connection, 1=cantilevered to Rod. [-] - INTEGER(IntKi) :: endTypeB !< type of connection at end B: 0=pinned to Connection, 1=cantilevered to Rod. [-] - REAL(DbKi) :: UnstrLen !< length of the rod [[m]] - REAL(DbKi) :: mass !< mass of the rod [[kg]] - REAL(DbKi) :: rho !< density [[kg/m3]] - REAL(DbKi) :: d !< volume-equivalent diameter [[m]] - REAL(DbKi) :: Can !< [[-]] - REAL(DbKi) :: Cat !< [[-]] - REAL(DbKi) :: Cdn !< [[-]] - REAL(DbKi) :: Cdt !< [[-]] - REAL(DbKi) :: CdEnd !< drag coefficient for rod end [[-]] - REAL(DbKi) :: CaEnd !< added mass coefficient for rod end [[-]] - REAL(DbKi) :: time !< current time [[s]] - REAL(DbKi) :: roll !< roll relative to vertical [deg] - REAL(DbKi) :: pitch !< pitch relative to vertical [deg] - REAL(DbKi) :: h0 !< submerged length of rod axis, distance along rod centerline from end A to the waterplane (0 <= h0 <= L) [m] + INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList = 0_IntKi !< array specifying what line quantities should be output (1 vs 0) [-] + INTEGER(IntKi) :: N = 0_IntKi !< The number of elements in the line [-] + INTEGER(IntKi) :: endTypeA = 0_IntKi !< type of connection at end A: 0=pinned to Connection, 1=cantilevered to Rod. [-] + INTEGER(IntKi) :: endTypeB = 0_IntKi !< type of connection at end B: 0=pinned to Connection, 1=cantilevered to Rod. [-] + REAL(DbKi) :: UnstrLen = 0.0_R8Ki !< length of the rod [[m]] + REAL(DbKi) :: mass = 0.0_R8Ki !< mass of the rod [[kg]] + REAL(DbKi) :: rho = 0.0_R8Ki !< density [[kg/m3]] + REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] + REAL(DbKi) :: Can = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cat = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cdn = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cdt = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: CdEnd = 0.0_R8Ki !< drag coefficient for rod end [[-]] + REAL(DbKi) :: CaEnd = 0.0_R8Ki !< added mass coefficient for rod end [[-]] + REAL(DbKi) :: time = 0.0_R8Ki !< current time [[s]] + REAL(DbKi) :: roll = 0.0_R8Ki !< roll relative to vertical [deg] + REAL(DbKi) :: pitch = 0.0_R8Ki !< pitch relative to vertical [deg] + REAL(DbKi) :: h0 = 0.0_R8Ki !< submerged length of rod axis, distance along rod centerline from end A to the waterplane (0 <= h0 <= L) [m] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: r !< node positions [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: rd !< node velocities [-] - REAL(DbKi) , DIMENSION(1:3) :: q !< tangent vector for rod as a whole [-] + REAL(DbKi) , DIMENSION(1:3) :: q = 0.0_R8Ki !< tangent vector for rod as a whole [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: l !< segment unstretched length [[m]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: V !< segment volume [[m^3]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: U !< water velocity at node [[m/s]] @@ -206,53 +206,53 @@ MODULE MoorDyn_Types REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: B !< node bottom contact force [[N]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Fnet !< total force on node [[N]] REAL(DbKi) , DIMENSION(:,:,:), ALLOCATABLE :: M !< node mass matrix [[kg]] - REAL(DbKi) , DIMENSION(1:3) :: FextA !< external forces from attached lines on/about end A [-] - REAL(DbKi) , DIMENSION(1:3) :: FextB !< external forces from attached lines on/about end A [-] - REAL(DbKi) , DIMENSION(1:3) :: Mext !< external moment vector holding sum of any externally applied moments i.e. bending lines [-] - REAL(DbKi) , DIMENSION(1:6) :: r6 !< 6 DOF position vector [-] - REAL(DbKi) , DIMENSION(1:6) :: v6 !< 6 DOF velocity vector [-] - REAL(DbKi) , DIMENSION(1:6) :: a6 !< 6 DOF acceleration vector (only used for coupled Rods) [-] - REAL(DbKi) , DIMENSION(1:6) :: F6net !< total force and moment about end A (excluding inertial loads) that Rod may exert on whatever it's attached to [-] - REAL(DbKi) , DIMENSION(1:6,1:6) :: M6net !< total mass matrix about end A of Rod and any attached Points [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: OrMat !< DCM for body orientation [-] - INTEGER(IntKi) :: RodUnOut !< unit number of rod output file [-] + REAL(DbKi) , DIMENSION(1:3) :: FextA = 0.0_R8Ki !< external forces from attached lines on/about end A [-] + REAL(DbKi) , DIMENSION(1:3) :: FextB = 0.0_R8Ki !< external forces from attached lines on/about end A [-] + REAL(DbKi) , DIMENSION(1:3) :: Mext = 0.0_R8Ki !< external moment vector holding sum of any externally applied moments i.e. bending lines [-] + REAL(DbKi) , DIMENSION(1:6) :: r6 = 0.0_R8Ki !< 6 DOF position vector [-] + REAL(DbKi) , DIMENSION(1:6) :: v6 = 0.0_R8Ki !< 6 DOF velocity vector [-] + REAL(DbKi) , DIMENSION(1:6) :: a6 = 0.0_R8Ki !< 6 DOF acceleration vector (only used for coupled Rods) [-] + REAL(DbKi) , DIMENSION(1:6) :: F6net = 0.0_R8Ki !< total force and moment about end A (excluding inertial loads) that Rod may exert on whatever it's attached to [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M6net = 0.0_R8Ki !< total mass matrix about end A of Rod and any attached Points [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: OrMat = 0.0_R8Ki !< DCM for body orientation [-] + INTEGER(IntKi) :: RodUnOut = 0_IntKi !< unit number of rod output file [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: RodWrOutput !< one row of output data for this rod [-] END TYPE MD_Rod ! ======================= ! ========= MD_Line ======= TYPE, PUBLIC :: MD_Line - INTEGER(IntKi) :: IdNum !< integer identifier of this Line [-] - INTEGER(IntKi) :: PropsIdNum !< the IdNum of the associated line properties [-] - INTEGER(IntKi) :: ElasticMod !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] - INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList !< array specifying what line quantities should be output (1 vs 0) [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this Line [-] + INTEGER(IntKi) :: PropsIdNum = 0_IntKi !< the IdNum of the associated line properties [-] + INTEGER(IntKi) :: ElasticMod = 0_IntKi !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] + INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList = 0_IntKi !< array specifying what line quantities should be output (1 vs 0) [-] INTEGER(IntKi) :: CtrlChan = 0 !< index of control channel that will drive line active tensioning (0 for none) [-] - INTEGER(IntKi) :: FairConnect !< IdNum of Connection at fairlead [-] - INTEGER(IntKi) :: AnchConnect !< IdNum of Connection at anchor [-] - INTEGER(IntKi) :: N !< The number of elements in the line [-] - INTEGER(IntKi) :: endTypeA !< type of connection at end A: 0=pinned to Connection, 1=cantilevered to Rod. [-] - INTEGER(IntKi) :: endTypeB !< type of connection at end B: 0=pinned to Connection, 1=cantilevered to Rod. [-] - REAL(DbKi) :: UnstrLen !< unstretched length of the line [-] - REAL(DbKi) :: rho !< density [[kg/m3]] - REAL(DbKi) :: d !< volume-equivalent diameter [[m]] + INTEGER(IntKi) :: FairConnect = 0_IntKi !< IdNum of Connection at fairlead [-] + INTEGER(IntKi) :: AnchConnect = 0_IntKi !< IdNum of Connection at anchor [-] + INTEGER(IntKi) :: N = 0_IntKi !< The number of elements in the line [-] + INTEGER(IntKi) :: endTypeA = 0_IntKi !< type of connection at end A: 0=pinned to Connection, 1=cantilevered to Rod. [-] + INTEGER(IntKi) :: endTypeB = 0_IntKi !< type of connection at end B: 0=pinned to Connection, 1=cantilevered to Rod. [-] + REAL(DbKi) :: UnstrLen = 0.0_R8Ki !< unstretched length of the line [-] + REAL(DbKi) :: rho = 0.0_R8Ki !< density [[kg/m3]] + REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] REAL(DbKi) :: EA = 0 !< stiffness [[N]] REAL(DbKi) :: EA_D = 0 !< dynamic stiffness when using viscoelastic model [[N]] REAL(DbKi) :: BA = 0 !< internal damping coefficient times area for this line only [[N-s]] REAL(DbKi) :: BA_D = 0 !< dynamic internal damping coefficient times area when using viscoelastic model [[N-s]] REAL(DbKi) :: EI = 0 !< bending stiffness [[N-m]] - REAL(DbKi) :: Can !< [[-]] - REAL(DbKi) :: Cat !< [[-]] - REAL(DbKi) :: Cdn !< [[-]] - REAL(DbKi) :: Cdt !< [[-]] + REAL(DbKi) :: Can = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cat = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cdn = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cdt = 0.0_R8Ki !< [[-]] INTEGER(IntKi) :: nEApoints = 0 !< number of values in stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffXs !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffYs !< y array for stress-strain lookup table [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] INTEGER(IntKi) :: nBApoints = 0 !< number of values in stress-strainrate lookup table (0 means using constant c) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampXs !< x array for stress-strainrate lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampYs !< y array for stress-strainrate lookup table [-] + REAL(DbKi) , DIMENSION(1:30) :: dampXs = 0.0_R8Ki !< x array for stress-strainrate lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: dampYs = 0.0_R8Ki !< y array for stress-strainrate lookup table [-] INTEGER(IntKi) :: nEIpoints = 0 !< number of values in bending stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffXs !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffYs !< y array for stress-strain lookup table [-] - REAL(DbKi) :: time !< current time [[s]] + REAL(DbKi) , DIMENSION(1:30) :: bstiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: bstiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] + REAL(DbKi) :: time = 0.0_R8Ki !< current time [[s]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: r !< node positions [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: rd !< node velocities [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: q !< node tangent vectors [-] @@ -280,25 +280,25 @@ MODULE MoorDyn_Types REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Fnet !< total force on node [[N]] REAL(DbKi) , DIMENSION(:,:,:), ALLOCATABLE :: S !< node inverse mass matrix [[kg]] REAL(DbKi) , DIMENSION(:,:,:), ALLOCATABLE :: M !< node mass matrix [[kg]] - REAL(DbKi) , DIMENSION(1:3) :: EndMomentA !< vector of end moments due to bending at line end A [[N-m]] - REAL(DbKi) , DIMENSION(1:3) :: EndMomentB !< vector of end moments due to bending at line end B [[N-m]] - INTEGER(IntKi) :: LineUnOut !< unit number of line output file [-] + REAL(DbKi) , DIMENSION(1:3) :: EndMomentA = 0.0_R8Ki !< vector of end moments due to bending at line end A [[N-m]] + REAL(DbKi) , DIMENSION(1:3) :: EndMomentB = 0.0_R8Ki !< vector of end moments due to bending at line end B [[N-m]] + INTEGER(IntKi) :: LineUnOut = 0_IntKi !< unit number of line output file [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: LineWrOutput !< one row of output data for this line [-] END TYPE MD_Line ! ======================= ! ========= MD_Fail ======= TYPE, PUBLIC :: MD_Fail - INTEGER(IntKi) :: IdNum !< integer identifier of this failure [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this failure [-] END TYPE MD_Fail ! ======================= ! ========= MD_OutParmType ======= TYPE, PUBLIC :: MD_OutParmType CHARACTER(10) :: Name !< name of output channel [-] CHARACTER(10) :: Units !< units string [-] - INTEGER(IntKi) :: QType !< type of quantity - 0=tension, 1=x, 2=y, 3=z... [-] - INTEGER(IntKi) :: OType !< type of object - 0=line, 1=connect [-] - INTEGER(IntKi) :: NodeID !< node number if OType=0. 0=anchor, -1=N=Fairlead [-] - INTEGER(IntKi) :: ObjID !< number of Connect or Line object [-] + INTEGER(IntKi) :: QType = 0_IntKi !< type of quantity - 0=tension, 1=x, 2=y, 3=z... [-] + INTEGER(IntKi) :: OType = 0_IntKi !< type of object - 0=line, 1=connect [-] + INTEGER(IntKi) :: NodeID = 0_IntKi !< node number if OType=0. 0=anchor, -1=N=Fairlead [-] + INTEGER(IntKi) :: ObjID = 0_IntKi !< number of Connect or Line object [-] END TYPE MD_OutParmType ! ======================= ! ========= MD_InitOutputType ======= @@ -324,17 +324,17 @@ MODULE MoorDyn_Types ! ======================= ! ========= MD_DiscreteStateType ======= TYPE, PUBLIC :: MD_DiscreteStateType - REAL(SiKi) :: dummy !< Remove this variable if you have discrete states [-] + REAL(SiKi) :: dummy = 0.0_R4Ki !< Remove this variable if you have discrete states [-] END TYPE MD_DiscreteStateType ! ======================= ! ========= MD_ConstraintStateType ======= TYPE, PUBLIC :: MD_ConstraintStateType - REAL(SiKi) :: dummy !< Remove this variable if you have constraint states [-] + REAL(SiKi) :: dummy = 0.0_R4Ki !< Remove this variable if you have constraint states [-] END TYPE MD_ConstraintStateType ! ======================= ! ========= MD_OtherStateType ======= TYPE, PUBLIC :: MD_OtherStateType - REAL(SiKi) :: dummy !< Remove this variable if you have other states [-] + REAL(SiKi) :: dummy = 0.0_R4Ki !< Remove this variable if you have other states [-] END TYPE MD_OtherStateType ! ======================= ! ========= MD_MiscVarType ======= @@ -361,14 +361,14 @@ MODULE MoorDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RodStateIsN !< ending index of each rod's states in state vector [] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIs1 !< starting index of each body's states in state vector [] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIsN !< ending index of each body's states in state vector [] - INTEGER(IntKi) :: Nx !< number of states and size of state vector [] - INTEGER(IntKi) :: WaveTi !< current interpolation index for wave time series data [] + INTEGER(IntKi) :: Nx = 0_IntKi !< number of states and size of state vector [] + INTEGER(IntKi) :: WaveTi = 0_IntKi !< current interpolation index for wave time series data [] TYPE(MD_ContinuousStateType) :: xTemp !< contains temporary state vector used in integration (put here so it's only allocated once) [-] TYPE(MD_ContinuousStateType) :: xdTemp !< contains temporary state derivative vector used in integration (put here so it's only allocated once) [-] - REAL(DbKi) , DIMENSION(1:6) :: zeros6 !< array of zeros for convenience [-] + REAL(DbKi) , DIMENSION(1:6) :: zeros6 = 0.0_R8Ki !< array of zeros for convenience [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: MDWrOutput !< Data from time step to be written to a MoorDyn output file [-] - REAL(DbKi) :: LastOutTime !< Time of last writing to MD output files [-] - REAL(ReKi) , DIMENSION(1:6) :: PtfmInit !< initial position of platform for an individual (non-farm) MD instance [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Time of last writing to MD output files [-] + REAL(ReKi) , DIMENSION(1:6) :: PtfmInit = 0.0_ReKi !< initial position of platform for an individual (non-farm) MD instance [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: BathymetryGrid !< matrix describing the bathymetry in a grid of x's and y's [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Xs !< array of x-coordinates in the bathymetry grid [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Ys !< array of y-coordinates in the bathymetry grid [-] @@ -394,39 +394,39 @@ MODULE MoorDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: nCpldCons !< number of coupled points (for FAST.Farm, size>1 with an entry for each turbine) [] INTEGER(IntKi) :: NConns = 0 !< number of Connect type Connections - not to be confused with NConnects [] INTEGER(IntKi) :: NAnchs = 0 !< number of Anchor type Connections [] - REAL(DbKi) :: Tmax !< simulation duration [[s]] + REAL(DbKi) :: Tmax = 0.0_R8Ki !< simulation duration [[s]] REAL(DbKi) :: g = 9.81 !< gravitational constant (positive) [[m/s^2]] REAL(DbKi) :: rhoW = 1025 !< density of seawater [[kg/m^3]] - REAL(DbKi) :: WtrDpth !< water depth [[m]] - REAL(DbKi) :: kBot !< bottom stiffness [[Pa/m]] - REAL(DbKi) :: cBot !< bottom damping [[Pa-s/m]] - REAL(DbKi) :: dtM0 !< desired mooring model time step [[s]] - REAL(DbKi) :: dtCoupling !< coupling time step that MoorDyn should expect [[s]] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] - REAL(DbKi) :: dtOut !< interval for writing output file lines [[s]] + REAL(DbKi) :: WtrDpth = 0.0_R8Ki !< water depth [[m]] + REAL(DbKi) :: kBot = 0.0_R8Ki !< bottom stiffness [[Pa/m]] + REAL(DbKi) :: cBot = 0.0_R8Ki !< bottom damping [[Pa-s/m]] + REAL(DbKi) :: dtM0 = 0.0_R8Ki !< desired mooring model time step [[s]] + REAL(DbKi) :: dtCoupling = 0.0_R8Ki !< coupling time step that MoorDyn should expect [[s]] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + REAL(DbKi) :: dtOut = 0.0_R8Ki !< interval for writing output file lines [[s]] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(MD_OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] CHARACTER(1) :: Delim !< Column delimiter for output text files [-] - INTEGER(IntKi) :: MDUnOut !< Unit number of main output file [-] + INTEGER(IntKi) :: MDUnOut = 0_IntKi !< Unit number of main output file [-] CHARACTER(1024) :: PriPath !< The path to the primary MoorDyn input file, used if looking for additional input files [-] INTEGER(IntKi) :: writeLog = -1 !< Switch for level of log file output [-] INTEGER(IntKi) :: UnLog = -1 !< Unit number of log file [-] - INTEGER(IntKi) :: WaveKin !< Flag for whether or how to consider water kinematics [-] - INTEGER(IntKi) :: Current !< Flag for whether or how to consider water kinematics [-] - INTEGER(IntKi) :: nTurbines !< Number of turbines if MoorDyn is performing an array-level simulation with FAST.Farm, otherwise 0 [-] + INTEGER(IntKi) :: WaveKin = 0_IntKi !< Flag for whether or how to consider water kinematics [-] + INTEGER(IntKi) :: Current = 0_IntKi !< Flag for whether or how to consider water kinematics [-] + INTEGER(IntKi) :: nTurbines = 0_IntKi !< Number of turbines if MoorDyn is performing an array-level simulation with FAST.Farm, otherwise 0 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TurbineRefPos !< reference position of turbines in farm, shape: 3, nTurbines [-] - REAL(DbKi) :: mu_kT !< transverse kinetic friction coefficient [(-)] - REAL(DbKi) :: mu_kA !< axial kinetic friction coefficient [(-)] - REAL(DbKi) :: mc !< ratio of the static friction coefficient to the kinetic friction coefficient [(-)] - REAL(DbKi) :: cv !< saturated damping coefficient [(-)] - INTEGER(IntKi) :: nxWave !< number of x wave grid points [-] - INTEGER(IntKi) :: nyWave !< number of y wave grid points [-] - INTEGER(IntKi) :: nzWave !< number of z wave grid points [-] - INTEGER(IntKi) :: ntWave !< number of wave time steps [-] + REAL(DbKi) :: mu_kT = 0.0_R8Ki !< transverse kinetic friction coefficient [(-)] + REAL(DbKi) :: mu_kA = 0.0_R8Ki !< axial kinetic friction coefficient [(-)] + REAL(DbKi) :: mc = 0.0_R8Ki !< ratio of the static friction coefficient to the kinetic friction coefficient [(-)] + REAL(DbKi) :: cv = 0.0_R8Ki !< saturated damping coefficient [(-)] + INTEGER(IntKi) :: nxWave = 0_IntKi !< number of x wave grid points [-] + INTEGER(IntKi) :: nyWave = 0_IntKi !< number of y wave grid points [-] + INTEGER(IntKi) :: nzWave = 0_IntKi !< number of z wave grid points [-] + INTEGER(IntKi) :: ntWave = 0_IntKi !< number of wave time steps [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pxWave !< x location of wave grid points [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pyWave !< y location of wave grid points [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pzWave !< z location of wave grid points [-] - REAL(SiKi) :: dtWave !< wave data time step [-] + REAL(SiKi) :: dtWave = 0.0_R4Ki !< wave data time step [-] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uxWave !< wave velocities time series at each grid point [-] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uyWave !< wave velocities time series at each grid point [-] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uzWave !< wave velocities time series at each grid point [-] @@ -435,16 +435,16 @@ MODULE MoorDyn_Types REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: azWave !< wave accelerations time series at each grid point [-] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PDyn !< wave dynamic pressure time series at each grid point [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: zeta !< wave surface elevations time series at each surface grid point [-] - INTEGER(IntKi) :: nzCurrent !< number of z current grid points [-] + INTEGER(IntKi) :: nzCurrent = 0_IntKi !< number of z current grid points [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pzCurrent !< z location of current grid points [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: uxCurrent !< current velocities time series at each grid point [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: uyCurrent !< current velocities time series at each grid point [-] - INTEGER(IntKi) :: Nx0 !< copy of initial size of system state vector, for linearization routines [-] + INTEGER(IntKi) :: Nx0 = 0_IntKi !< copy of initial size of system state vector, for linearization routines [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_nx !< number of continuous states in jacobian matrix [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nx = 0_IntKi !< number of continuous states in jacobian matrix [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: dxIdx_map2_xStateIdx !< Mapping array from index of dX array to corresponding state index [-] END TYPE MD_ParameterType ! ======================= @@ -462,12647 +462,5900 @@ MODULE MoorDyn_Types END TYPE MD_OutputType ! ======================= CONTAINS - SUBROUTINE MD_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_InputFileType), INTENT(IN) :: SrcInputFileTypeData - TYPE(MD_InputFileType), INTENT(INOUT) :: DstInputFileTypeData - 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 = 'MD_CopyInputFileType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileTypeData%DTIC = SrcInputFileTypeData%DTIC - DstInputFileTypeData%TMaxIC = SrcInputFileTypeData%TMaxIC - DstInputFileTypeData%CdScaleIC = SrcInputFileTypeData%CdScaleIC - DstInputFileTypeData%threshIC = SrcInputFileTypeData%threshIC - END SUBROUTINE MD_CopyInputFileType - - SUBROUTINE MD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) - TYPE(MD_InputFileType), INTENT(INOUT) :: InputFileTypeData - 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 = 'MD_DestroyInputFileType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MD_DestroyInputFileType - - SUBROUTINE MD_PackInputFileType( 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(MD_InputFileType), 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 = 'MD_PackInputFileType' - ! 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 ! DTIC - Db_BufSz = Db_BufSz + 1 ! TMaxIC - Re_BufSz = Re_BufSz + 1 ! CdScaleIC - Re_BufSz = Re_BufSz + 1 ! threshIC - 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%DTIC - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMaxIC - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CdScaleIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%threshIC - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_PackInputFileType - - SUBROUTINE MD_UnPackInputFileType( 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(MD_InputFileType), 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 = 'MD_UnPackInputFileType' - ! 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%DTIC = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TMaxIC = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CdScaleIC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%threshIC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_UnPackInputFileType - - SUBROUTINE MD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(MD_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 = 'MD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%g = SrcInitInputData%g - DstInitInputData%rhoW = SrcInitInputData%rhoW - DstInitInputData%WtrDepth = SrcInitInputData%WtrDepth -IF (ALLOCATED(SrcInitInputData%PtfmInit)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmInit,1) - i1_u = UBOUND(SrcInitInputData%PtfmInit,1) - i2_l = LBOUND(SrcInitInputData%PtfmInit,2) - i2_u = UBOUND(SrcInitInputData%PtfmInit,2) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmInit)) THEN - ALLOCATE(DstInitInputData%PtfmInit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit -ENDIF - DstInitInputData%FarmSize = SrcInitInputData%FarmSize -IF (ALLOCATED(SrcInitInputData%TurbineRefPos)) THEN - i1_l = LBOUND(SrcInitInputData%TurbineRefPos,1) - i1_u = UBOUND(SrcInitInputData%TurbineRefPos,1) - i2_l = LBOUND(SrcInitInputData%TurbineRefPos,2) - i2_u = UBOUND(SrcInitInputData%TurbineRefPos,2) - IF (.NOT. ALLOCATED(DstInitInputData%TurbineRefPos)) THEN - ALLOCATE(DstInitInputData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%TurbineRefPos = SrcInitInputData%TurbineRefPos -ENDIF - DstInitInputData%Tmax = SrcInitInputData%Tmax - DstInitInputData%FileName = SrcInitInputData%FileName - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%UsePrimaryInputFile = SrcInitInputData%UsePrimaryInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%Echo = SrcInitInputData%Echo -IF (ALLOCATED(SrcInitInputData%OutList)) THEN - i1_l = LBOUND(SrcInitInputData%OutList,1) - i1_u = UBOUND(SrcInitInputData%OutList,1) - IF (.NOT. ALLOCATED(DstInitInputData%OutList)) THEN - ALLOCATE(DstInitInputData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%OutList = SrcInitInputData%OutList -ENDIF - DstInitInputData%Linearize = SrcInitInputData%Linearize - END SUBROUTINE MD_CopyInitInput - - SUBROUTINE MD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(MD_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 = 'MD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitInputData%OutList)) THEN - DEALLOCATE(InitInputData%OutList) -ENDIF - END SUBROUTINE MD_DestroyInitInput - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! g - Re_BufSz = Re_BufSz + 1 ! rhoW - Re_BufSz = Re_BufSz + 1 ! WtrDepth - Int_BufSz = Int_BufSz + 1 ! PtfmInit allocated yes/no - IF ( ALLOCATED(InData%PtfmInit) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PtfmInit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmInit) ! PtfmInit - END IF - Int_BufSz = Int_BufSz + 1 ! FarmSize - Int_BufSz = Int_BufSz + 1 ! TurbineRefPos allocated yes/no - IF ( ALLOCATED(InData%TurbineRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TurbineRefPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TurbineRefPos) ! TurbineRefPos - END IF - Re_BufSz = Re_BufSz + 1 ! Tmax - Int_BufSz = Int_BufSz + 1*LEN(InData%FileName) ! FileName - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedPrimaryInputData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedPrimaryInputData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedPrimaryInputData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1 ! Linearize - 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%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhoW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDepth - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmInit) ) 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%PtfmInit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmInit,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmInit,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmInit,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PtfmInit,2), UBOUND(InData%PtfmInit,2) - DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) - ReKiBuf(Re_Xferred) = InData%PtfmInit(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%FarmSize - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TurbineRefPos) ) 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%TurbineRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineRefPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TurbineRefPos,2), UBOUND(InData%TurbineRefPos,2) - DO i1 = LBOUND(InData%TurbineRefPos,1), UBOUND(InData%TurbineRefPos,1) - ReKiBuf(Re_Xferred) = InData%TurbineRefPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Tmax - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - 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 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) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) 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%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - 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 - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_PackInitInput - - SUBROUTINE MD_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(MD_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 = 'MD_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%g = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rhoW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDepth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmInit 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%PtfmInit)) DEALLOCATE(OutData%PtfmInit) - ALLOCATE(OutData%PtfmInit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PtfmInit,2), UBOUND(OutData%PtfmInit,2) - DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) - OutData%PtfmInit(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%FarmSize = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TurbineRefPos 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%TurbineRefPos)) DEALLOCATE(OutData%TurbineRefPos) - ALLOCATE(OutData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TurbineRefPos,2), UBOUND(OutData%TurbineRefPos,2) - DO i1 = LBOUND(OutData%TurbineRefPos,1), UBOUND(OutData%TurbineRefPos,1) - OutData%TurbineRefPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%Tmax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePrimaryInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePrimaryInputFile) - 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%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData - 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%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - 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%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_UnPackInitInput - - SUBROUTINE MD_CopyLineProp( SrcLinePropData, DstLinePropData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_LineProp), INTENT(IN) :: SrcLinePropData - TYPE(MD_LineProp), INTENT(INOUT) :: DstLinePropData - 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 = 'MD_CopyLineProp' -! - ErrStat = ErrID_None - ErrMsg = "" - DstLinePropData%IdNum = SrcLinePropData%IdNum - DstLinePropData%name = SrcLinePropData%name - DstLinePropData%d = SrcLinePropData%d - DstLinePropData%w = SrcLinePropData%w - DstLinePropData%EA = SrcLinePropData%EA - DstLinePropData%EA_D = SrcLinePropData%EA_D - DstLinePropData%BA = SrcLinePropData%BA - DstLinePropData%BA_D = SrcLinePropData%BA_D - DstLinePropData%EI = SrcLinePropData%EI - DstLinePropData%Can = SrcLinePropData%Can - DstLinePropData%Cat = SrcLinePropData%Cat - DstLinePropData%Cdn = SrcLinePropData%Cdn - DstLinePropData%Cdt = SrcLinePropData%Cdt - DstLinePropData%ElasticMod = SrcLinePropData%ElasticMod - DstLinePropData%nEApoints = SrcLinePropData%nEApoints - DstLinePropData%stiffXs = SrcLinePropData%stiffXs - DstLinePropData%stiffYs = SrcLinePropData%stiffYs - DstLinePropData%nBApoints = SrcLinePropData%nBApoints - DstLinePropData%dampXs = SrcLinePropData%dampXs - DstLinePropData%dampYs = SrcLinePropData%dampYs - DstLinePropData%nEIpoints = SrcLinePropData%nEIpoints - DstLinePropData%bstiffXs = SrcLinePropData%bstiffXs - DstLinePropData%bstiffYs = SrcLinePropData%bstiffYs - END SUBROUTINE MD_CopyLineProp - - SUBROUTINE MD_DestroyLineProp( LinePropData, ErrStat, ErrMsg ) - TYPE(MD_LineProp), INTENT(INOUT) :: LinePropData - 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 = 'MD_DestroyLineProp' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MD_DestroyLineProp - - SUBROUTINE MD_PackLineProp( 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(MD_LineProp), 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 = 'MD_PackLineProp' - ! 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 ! IdNum - Int_BufSz = Int_BufSz + 1*LEN(InData%name) ! name - Db_BufSz = Db_BufSz + 1 ! d - Db_BufSz = Db_BufSz + 1 ! w - Db_BufSz = Db_BufSz + 1 ! EA - Db_BufSz = Db_BufSz + 1 ! EA_D - Db_BufSz = Db_BufSz + 1 ! BA - Db_BufSz = Db_BufSz + 1 ! BA_D - Db_BufSz = Db_BufSz + 1 ! EI - Db_BufSz = Db_BufSz + 1 ! Can - Db_BufSz = Db_BufSz + 1 ! Cat - Db_BufSz = Db_BufSz + 1 ! Cdn - Db_BufSz = Db_BufSz + 1 ! Cdt - Int_BufSz = Int_BufSz + 1 ! ElasticMod - Int_BufSz = Int_BufSz + 1 ! nEApoints - Db_BufSz = Db_BufSz + SIZE(InData%stiffXs) ! stiffXs - Db_BufSz = Db_BufSz + SIZE(InData%stiffYs) ! stiffYs - Int_BufSz = Int_BufSz + 1 ! nBApoints - Db_BufSz = Db_BufSz + SIZE(InData%dampXs) ! dampXs - Db_BufSz = Db_BufSz + SIZE(InData%dampYs) ! dampYs - Int_BufSz = Int_BufSz + 1 ! nEIpoints - Db_BufSz = Db_BufSz + SIZE(InData%bstiffXs) ! bstiffXs - Db_BufSz = Db_BufSz + SIZE(InData%bstiffYs) ! bstiffYs - 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%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%name) - IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%d - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%w - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EA_D - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA_D - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EI - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Can - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cat - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdt - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ElasticMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nEApoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%stiffXs,1), UBOUND(InData%stiffXs,1) - DbKiBuf(Db_Xferred) = InData%stiffXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%stiffYs,1), UBOUND(InData%stiffYs,1) - DbKiBuf(Db_Xferred) = InData%stiffYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nBApoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%dampXs,1), UBOUND(InData%dampXs,1) - DbKiBuf(Db_Xferred) = InData%dampXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%dampYs,1), UBOUND(InData%dampYs,1) - DbKiBuf(Db_Xferred) = InData%dampYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nEIpoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%bstiffXs,1), UBOUND(InData%bstiffXs,1) - DbKiBuf(Db_Xferred) = InData%bstiffXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%bstiffYs,1), UBOUND(InData%bstiffYs,1) - DbKiBuf(Db_Xferred) = InData%bstiffYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE MD_PackLineProp - - SUBROUTINE MD_UnPackLineProp( 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(MD_LineProp), 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 = 'MD_UnPackLineProp' - ! 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%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%name) - OutData%name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%d = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%w = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EA_D = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BA_D = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EI = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Can = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cat = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%ElasticMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nEApoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%stiffXs,1) - i1_u = UBOUND(OutData%stiffXs,1) - DO i1 = LBOUND(OutData%stiffXs,1), UBOUND(OutData%stiffXs,1) - OutData%stiffXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%stiffYs,1) - i1_u = UBOUND(OutData%stiffYs,1) - DO i1 = LBOUND(OutData%stiffYs,1), UBOUND(OutData%stiffYs,1) - OutData%stiffYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%nBApoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%dampXs,1) - i1_u = UBOUND(OutData%dampXs,1) - DO i1 = LBOUND(OutData%dampXs,1), UBOUND(OutData%dampXs,1) - OutData%dampXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%dampYs,1) - i1_u = UBOUND(OutData%dampYs,1) - DO i1 = LBOUND(OutData%dampYs,1), UBOUND(OutData%dampYs,1) - OutData%dampYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%nEIpoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%bstiffXs,1) - i1_u = UBOUND(OutData%bstiffXs,1) - DO i1 = LBOUND(OutData%bstiffXs,1), UBOUND(OutData%bstiffXs,1) - OutData%bstiffXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%bstiffYs,1) - i1_u = UBOUND(OutData%bstiffYs,1) - DO i1 = LBOUND(OutData%bstiffYs,1), UBOUND(OutData%bstiffYs,1) - OutData%bstiffYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE MD_UnPackLineProp - - SUBROUTINE MD_CopyRodProp( SrcRodPropData, DstRodPropData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_RodProp), INTENT(IN) :: SrcRodPropData - TYPE(MD_RodProp), INTENT(INOUT) :: DstRodPropData - 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 = 'MD_CopyRodProp' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRodPropData%IdNum = SrcRodPropData%IdNum - DstRodPropData%name = SrcRodPropData%name - DstRodPropData%d = SrcRodPropData%d - DstRodPropData%w = SrcRodPropData%w - DstRodPropData%Can = SrcRodPropData%Can - DstRodPropData%Cat = SrcRodPropData%Cat - DstRodPropData%Cdn = SrcRodPropData%Cdn - DstRodPropData%Cdt = SrcRodPropData%Cdt - DstRodPropData%CdEnd = SrcRodPropData%CdEnd - DstRodPropData%CaEnd = SrcRodPropData%CaEnd - END SUBROUTINE MD_CopyRodProp - - SUBROUTINE MD_DestroyRodProp( RodPropData, ErrStat, ErrMsg ) - TYPE(MD_RodProp), INTENT(INOUT) :: RodPropData - 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 = 'MD_DestroyRodProp' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MD_DestroyRodProp - - SUBROUTINE MD_PackRodProp( 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(MD_RodProp), 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 = 'MD_PackRodProp' - ! 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 ! IdNum - Int_BufSz = Int_BufSz + 1*LEN(InData%name) ! name - Db_BufSz = Db_BufSz + 1 ! d - Db_BufSz = Db_BufSz + 1 ! w - Db_BufSz = Db_BufSz + 1 ! Can - Db_BufSz = Db_BufSz + 1 ! Cat - Db_BufSz = Db_BufSz + 1 ! Cdn - Db_BufSz = Db_BufSz + 1 ! Cdt - Db_BufSz = Db_BufSz + 1 ! CdEnd - Db_BufSz = Db_BufSz + 1 ! CaEnd - 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%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%name) - IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%d - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%w - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Can - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cat - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CdEnd - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CaEnd - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE MD_PackRodProp - - SUBROUTINE MD_UnPackRodProp( 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(MD_RodProp), 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 = 'MD_UnPackRodProp' - ! 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%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%name) - OutData%name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%d = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%w = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Can = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cat = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CdEnd = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CaEnd = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE MD_UnPackRodProp - - SUBROUTINE MD_CopyBody( SrcBodyData, DstBodyData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Body), INTENT(IN) :: SrcBodyData - TYPE(MD_Body), INTENT(INOUT) :: DstBodyData - 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 = 'MD_CopyBody' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBodyData%IdNum = SrcBodyData%IdNum - DstBodyData%typeNum = SrcBodyData%typeNum - DstBodyData%AttachedC = SrcBodyData%AttachedC - DstBodyData%AttachedR = SrcBodyData%AttachedR - DstBodyData%nAttachedC = SrcBodyData%nAttachedC - DstBodyData%nAttachedR = SrcBodyData%nAttachedR - DstBodyData%rConnectRel = SrcBodyData%rConnectRel - DstBodyData%r6RodRel = SrcBodyData%r6RodRel - DstBodyData%bodyM = SrcBodyData%bodyM - DstBodyData%bodyV = SrcBodyData%bodyV - DstBodyData%bodyI = SrcBodyData%bodyI - DstBodyData%bodyCdA = SrcBodyData%bodyCdA - DstBodyData%bodyCa = SrcBodyData%bodyCa - DstBodyData%time = SrcBodyData%time - DstBodyData%r6 = SrcBodyData%r6 - DstBodyData%v6 = SrcBodyData%v6 - DstBodyData%a6 = SrcBodyData%a6 - DstBodyData%U = SrcBodyData%U - DstBodyData%Ud = SrcBodyData%Ud - DstBodyData%zeta = SrcBodyData%zeta - DstBodyData%F6net = SrcBodyData%F6net - DstBodyData%M6net = SrcBodyData%M6net - DstBodyData%M = SrcBodyData%M - DstBodyData%M0 = SrcBodyData%M0 - DstBodyData%OrMat = SrcBodyData%OrMat - DstBodyData%rCG = SrcBodyData%rCG - END SUBROUTINE MD_CopyBody - - SUBROUTINE MD_DestroyBody( BodyData, ErrStat, ErrMsg ) - TYPE(MD_Body), INTENT(INOUT) :: BodyData - 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 = 'MD_DestroyBody' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MD_DestroyBody - - SUBROUTINE MD_PackBody( 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(MD_Body), 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 = 'MD_PackBody' - ! 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 ! IdNum - Int_BufSz = Int_BufSz + 1 ! typeNum - Int_BufSz = Int_BufSz + SIZE(InData%AttachedC) ! AttachedC - Int_BufSz = Int_BufSz + SIZE(InData%AttachedR) ! AttachedR - Int_BufSz = Int_BufSz + 1 ! nAttachedC - Int_BufSz = Int_BufSz + 1 ! nAttachedR - Db_BufSz = Db_BufSz + SIZE(InData%rConnectRel) ! rConnectRel - Db_BufSz = Db_BufSz + SIZE(InData%r6RodRel) ! r6RodRel - Db_BufSz = Db_BufSz + 1 ! bodyM - Db_BufSz = Db_BufSz + 1 ! bodyV - Db_BufSz = Db_BufSz + SIZE(InData%bodyI) ! bodyI - Db_BufSz = Db_BufSz + SIZE(InData%bodyCdA) ! bodyCdA - Db_BufSz = Db_BufSz + SIZE(InData%bodyCa) ! bodyCa - Db_BufSz = Db_BufSz + 1 ! time - Db_BufSz = Db_BufSz + SIZE(InData%r6) ! r6 - Db_BufSz = Db_BufSz + SIZE(InData%v6) ! v6 - Db_BufSz = Db_BufSz + SIZE(InData%a6) ! a6 - Db_BufSz = Db_BufSz + SIZE(InData%U) ! U - Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud - Db_BufSz = Db_BufSz + 1 ! zeta - Db_BufSz = Db_BufSz + SIZE(InData%F6net) ! F6net - Db_BufSz = Db_BufSz + SIZE(InData%M6net) ! M6net - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - Db_BufSz = Db_BufSz + SIZE(InData%M0) ! M0 - Db_BufSz = Db_BufSz + SIZE(InData%OrMat) ! OrMat - Db_BufSz = Db_BufSz + SIZE(InData%rCG) ! rCG - 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%IdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%typeNum - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%AttachedC,1), UBOUND(InData%AttachedC,1) - IntKiBuf(Int_Xferred) = InData%AttachedC(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AttachedR,1), UBOUND(InData%AttachedR,1) - IntKiBuf(Int_Xferred) = InData%AttachedR(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nAttachedC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nAttachedR - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%rConnectRel,2), UBOUND(InData%rConnectRel,2) - DO i1 = LBOUND(InData%rConnectRel,1), UBOUND(InData%rConnectRel,1) - DbKiBuf(Db_Xferred) = InData%rConnectRel(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%r6RodRel,2), UBOUND(InData%r6RodRel,2) - DO i1 = LBOUND(InData%r6RodRel,1), UBOUND(InData%r6RodRel,1) - DbKiBuf(Db_Xferred) = InData%r6RodRel(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DbKiBuf(Db_Xferred) = InData%bodyM - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%bodyV - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%bodyI,1), UBOUND(InData%bodyI,1) - DbKiBuf(Db_Xferred) = InData%bodyI(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%bodyCdA,1), UBOUND(InData%bodyCdA,1) - DbKiBuf(Db_Xferred) = InData%bodyCdA(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%bodyCa,1), UBOUND(InData%bodyCa,1) - DbKiBuf(Db_Xferred) = InData%bodyCa(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%time - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%r6,1), UBOUND(InData%r6,1) - DbKiBuf(Db_Xferred) = InData%r6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%v6,1), UBOUND(InData%v6,1) - DbKiBuf(Db_Xferred) = InData%v6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%a6,1), UBOUND(InData%a6,1) - DbKiBuf(Db_Xferred) = InData%a6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - DbKiBuf(Db_Xferred) = InData%U(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) - DbKiBuf(Db_Xferred) = InData%Ud(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%zeta - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%F6net,1), UBOUND(InData%F6net,1) - DbKiBuf(Db_Xferred) = InData%F6net(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%M6net,2), UBOUND(InData%M6net,2) - DO i1 = LBOUND(InData%M6net,1), UBOUND(InData%M6net,1) - DbKiBuf(Db_Xferred) = InData%M6net(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) - DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) - DbKiBuf(Db_Xferred) = InData%M(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%M0,2), UBOUND(InData%M0,2) - DO i1 = LBOUND(InData%M0,1), UBOUND(InData%M0,1) - DbKiBuf(Db_Xferred) = InData%M0(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%OrMat,2), UBOUND(InData%OrMat,2) - DO i1 = LBOUND(InData%OrMat,1), UBOUND(InData%OrMat,1) - DbKiBuf(Db_Xferred) = InData%OrMat(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%rCG,1), UBOUND(InData%rCG,1) - DbKiBuf(Db_Xferred) = InData%rCG(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE MD_PackBody - - SUBROUTINE MD_UnPackBody( 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(MD_Body), 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 = 'MD_UnPackBody' - ! 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%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%typeNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%AttachedC,1) - i1_u = UBOUND(OutData%AttachedC,1) - DO i1 = LBOUND(OutData%AttachedC,1), UBOUND(OutData%AttachedC,1) - OutData%AttachedC(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AttachedR,1) - i1_u = UBOUND(OutData%AttachedR,1) - DO i1 = LBOUND(OutData%AttachedR,1), UBOUND(OutData%AttachedR,1) - OutData%AttachedR(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%nAttachedC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nAttachedR = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%rConnectRel,1) - i1_u = UBOUND(OutData%rConnectRel,1) - i2_l = LBOUND(OutData%rConnectRel,2) - i2_u = UBOUND(OutData%rConnectRel,2) - DO i2 = LBOUND(OutData%rConnectRel,2), UBOUND(OutData%rConnectRel,2) - DO i1 = LBOUND(OutData%rConnectRel,1), UBOUND(OutData%rConnectRel,1) - OutData%rConnectRel(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%r6RodRel,1) - i1_u = UBOUND(OutData%r6RodRel,1) - i2_l = LBOUND(OutData%r6RodRel,2) - i2_u = UBOUND(OutData%r6RodRel,2) - DO i2 = LBOUND(OutData%r6RodRel,2), UBOUND(OutData%r6RodRel,2) - DO i1 = LBOUND(OutData%r6RodRel,1), UBOUND(OutData%r6RodRel,1) - OutData%r6RodRel(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%bodyM = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%bodyV = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%bodyI,1) - i1_u = UBOUND(OutData%bodyI,1) - DO i1 = LBOUND(OutData%bodyI,1), UBOUND(OutData%bodyI,1) - OutData%bodyI(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%bodyCdA,1) - i1_u = UBOUND(OutData%bodyCdA,1) - DO i1 = LBOUND(OutData%bodyCdA,1), UBOUND(OutData%bodyCdA,1) - OutData%bodyCdA(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%bodyCa,1) - i1_u = UBOUND(OutData%bodyCa,1) - DO i1 = LBOUND(OutData%bodyCa,1), UBOUND(OutData%bodyCa,1) - OutData%bodyCa(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%time = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%r6,1) - i1_u = UBOUND(OutData%r6,1) - DO i1 = LBOUND(OutData%r6,1), UBOUND(OutData%r6,1) - OutData%r6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%v6,1) - i1_u = UBOUND(OutData%v6,1) - DO i1 = LBOUND(OutData%v6,1), UBOUND(OutData%v6,1) - OutData%v6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%a6,1) - i1_u = UBOUND(OutData%a6,1) - DO i1 = LBOUND(OutData%a6,1), UBOUND(OutData%a6,1) - OutData%a6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%U,1) - i1_u = UBOUND(OutData%U,1) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Ud,1) - i1_u = UBOUND(OutData%Ud,1) - DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) - OutData%Ud(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%zeta = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%F6net,1) - i1_u = UBOUND(OutData%F6net,1) - DO i1 = LBOUND(OutData%F6net,1), UBOUND(OutData%F6net,1) - OutData%F6net(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%M6net,1) - i1_u = UBOUND(OutData%M6net,1) - i2_l = LBOUND(OutData%M6net,2) - i2_u = UBOUND(OutData%M6net,2) - DO i2 = LBOUND(OutData%M6net,2), UBOUND(OutData%M6net,2) - DO i1 = LBOUND(OutData%M6net,1), UBOUND(OutData%M6net,1) - OutData%M6net(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%M,1) - i1_u = UBOUND(OutData%M,1) - i2_l = LBOUND(OutData%M,2) - i2_u = UBOUND(OutData%M,2) - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%M0,1) - i1_u = UBOUND(OutData%M0,1) - i2_l = LBOUND(OutData%M0,2) - i2_u = UBOUND(OutData%M0,2) - DO i2 = LBOUND(OutData%M0,2), UBOUND(OutData%M0,2) - DO i1 = LBOUND(OutData%M0,1), UBOUND(OutData%M0,1) - OutData%M0(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%OrMat,1) - i1_u = UBOUND(OutData%OrMat,1) - i2_l = LBOUND(OutData%OrMat,2) - i2_u = UBOUND(OutData%OrMat,2) - DO i2 = LBOUND(OutData%OrMat,2), UBOUND(OutData%OrMat,2) - DO i1 = LBOUND(OutData%OrMat,1), UBOUND(OutData%OrMat,1) - OutData%OrMat(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%rCG,1) - i1_u = UBOUND(OutData%rCG,1) - DO i1 = LBOUND(OutData%rCG,1), UBOUND(OutData%rCG,1) - OutData%rCG(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE MD_UnPackBody - - SUBROUTINE MD_CopyConnect( SrcConnectData, DstConnectData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Connect), INTENT(IN) :: SrcConnectData - TYPE(MD_Connect), INTENT(INOUT) :: DstConnectData - 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 = 'MD_CopyConnect' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConnectData%IdNum = SrcConnectData%IdNum - DstConnectData%type = SrcConnectData%type - DstConnectData%typeNum = SrcConnectData%typeNum - DstConnectData%Attached = SrcConnectData%Attached - DstConnectData%Top = SrcConnectData%Top - DstConnectData%nAttached = SrcConnectData%nAttached - DstConnectData%conM = SrcConnectData%conM - DstConnectData%conV = SrcConnectData%conV - DstConnectData%conFX = SrcConnectData%conFX - DstConnectData%conFY = SrcConnectData%conFY - DstConnectData%conFZ = SrcConnectData%conFZ - DstConnectData%conCa = SrcConnectData%conCa - DstConnectData%conCdA = SrcConnectData%conCdA - DstConnectData%time = SrcConnectData%time - DstConnectData%r = SrcConnectData%r - DstConnectData%rd = SrcConnectData%rd - DstConnectData%a = SrcConnectData%a - DstConnectData%U = SrcConnectData%U - DstConnectData%Ud = SrcConnectData%Ud - DstConnectData%zeta = SrcConnectData%zeta -IF (ALLOCATED(SrcConnectData%PDyn)) THEN - i1_l = LBOUND(SrcConnectData%PDyn,1) - i1_u = UBOUND(SrcConnectData%PDyn,1) - IF (.NOT. ALLOCATED(DstConnectData%PDyn)) THEN - ALLOCATE(DstConnectData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConnectData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstConnectData%PDyn = SrcConnectData%PDyn -ENDIF - DstConnectData%Fnet = SrcConnectData%Fnet - DstConnectData%M = SrcConnectData%M - END SUBROUTINE MD_CopyConnect - - SUBROUTINE MD_DestroyConnect( ConnectData, ErrStat, ErrMsg ) - TYPE(MD_Connect), INTENT(INOUT) :: ConnectData - 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 = 'MD_DestroyConnect' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ConnectData%PDyn)) THEN - DEALLOCATE(ConnectData%PDyn) -ENDIF - END SUBROUTINE MD_DestroyConnect - - SUBROUTINE MD_PackConnect( 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(MD_Connect), 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 = 'MD_PackConnect' - ! 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 ! IdNum - Int_BufSz = Int_BufSz + 1*LEN(InData%type) ! type - Int_BufSz = Int_BufSz + 1 ! typeNum - Int_BufSz = Int_BufSz + SIZE(InData%Attached) ! Attached - Int_BufSz = Int_BufSz + SIZE(InData%Top) ! Top - Int_BufSz = Int_BufSz + 1 ! nAttached - Db_BufSz = Db_BufSz + 1 ! conM - Db_BufSz = Db_BufSz + 1 ! conV - Db_BufSz = Db_BufSz + 1 ! conFX - Db_BufSz = Db_BufSz + 1 ! conFY - Db_BufSz = Db_BufSz + 1 ! conFZ - Db_BufSz = Db_BufSz + 1 ! conCa - Db_BufSz = Db_BufSz + 1 ! conCdA - Db_BufSz = Db_BufSz + 1 ! time - Db_BufSz = Db_BufSz + SIZE(InData%r) ! r - Db_BufSz = Db_BufSz + SIZE(InData%rd) ! rd - Db_BufSz = Db_BufSz + SIZE(InData%a) ! a - Db_BufSz = Db_BufSz + SIZE(InData%U) ! U - Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud - Db_BufSz = Db_BufSz + 1 ! zeta - Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no - IF ( ALLOCATED(InData%PDyn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PDyn upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PDyn) ! PDyn - END IF - Db_BufSz = Db_BufSz + SIZE(InData%Fnet) ! Fnet - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - 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%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%type) - IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%typeNum - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%Attached,1), UBOUND(InData%Attached,1) - IntKiBuf(Int_Xferred) = InData%Attached(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Top,1), UBOUND(InData%Top,1) - IntKiBuf(Int_Xferred) = InData%Top(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nAttached - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conM - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conV - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conFX - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conFY - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conFZ - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conCa - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conCdA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%time - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - DbKiBuf(Db_Xferred) = InData%r(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) - DbKiBuf(Db_Xferred) = InData%rd(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%a,1), UBOUND(InData%a,1) - DbKiBuf(Db_Xferred) = InData%a(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - DbKiBuf(Db_Xferred) = InData%U(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) - DbKiBuf(Db_Xferred) = InData%Ud(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%zeta - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PDyn) ) 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%PDyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) - DbKiBuf(Db_Xferred) = InData%PDyn(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%Fnet,1), UBOUND(InData%Fnet,1) - DbKiBuf(Db_Xferred) = InData%Fnet(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) - DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) - DbKiBuf(Db_Xferred) = InData%M(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END SUBROUTINE MD_PackConnect - - SUBROUTINE MD_UnPackConnect( 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(MD_Connect), 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 = 'MD_UnPackConnect' - ! 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%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%type) - OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%typeNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%Attached,1) - i1_u = UBOUND(OutData%Attached,1) - DO i1 = LBOUND(OutData%Attached,1), UBOUND(OutData%Attached,1) - OutData%Attached(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Top,1) - i1_u = UBOUND(OutData%Top,1) - DO i1 = LBOUND(OutData%Top,1), UBOUND(OutData%Top,1) - OutData%Top(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%nAttached = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%conM = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conV = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conFX = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conFY = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conFZ = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conCa = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conCdA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%time = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%r,1) - i1_u = UBOUND(OutData%r,1) - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rd,1) - i1_u = UBOUND(OutData%rd,1) - DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) - OutData%rd(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%a,1) - i1_u = UBOUND(OutData%a,1) - DO i1 = LBOUND(OutData%a,1), UBOUND(OutData%a,1) - OutData%a(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%U,1) - i1_u = UBOUND(OutData%U,1) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Ud,1) - i1_u = UBOUND(OutData%Ud,1) - DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) - OutData%Ud(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%zeta = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn 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%PDyn)) DEALLOCATE(OutData%PDyn) - ALLOCATE(OutData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) - OutData%PDyn(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%Fnet,1) - i1_u = UBOUND(OutData%Fnet,1) - DO i1 = LBOUND(OutData%Fnet,1), UBOUND(OutData%Fnet,1) - OutData%Fnet(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%M,1) - i1_u = UBOUND(OutData%M,1) - i2_l = LBOUND(OutData%M,2) - i2_u = UBOUND(OutData%M,2) - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END SUBROUTINE MD_UnPackConnect - - SUBROUTINE MD_CopyRod( SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Rod), INTENT(IN) :: SrcRodData - TYPE(MD_Rod), INTENT(INOUT) :: DstRodData - 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 = 'MD_CopyRod' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRodData%IdNum = SrcRodData%IdNum - DstRodData%type = SrcRodData%type - DstRodData%PropsIdNum = SrcRodData%PropsIdNum - DstRodData%typeNum = SrcRodData%typeNum - DstRodData%AttachedA = SrcRodData%AttachedA - DstRodData%AttachedB = SrcRodData%AttachedB - DstRodData%TopA = SrcRodData%TopA - DstRodData%TopB = SrcRodData%TopB - DstRodData%nAttachedA = SrcRodData%nAttachedA - DstRodData%nAttachedB = SrcRodData%nAttachedB - DstRodData%OutFlagList = SrcRodData%OutFlagList - DstRodData%N = SrcRodData%N - DstRodData%endTypeA = SrcRodData%endTypeA - DstRodData%endTypeB = SrcRodData%endTypeB - DstRodData%UnstrLen = SrcRodData%UnstrLen - DstRodData%mass = SrcRodData%mass - DstRodData%rho = SrcRodData%rho - DstRodData%d = SrcRodData%d - DstRodData%Can = SrcRodData%Can - DstRodData%Cat = SrcRodData%Cat - DstRodData%Cdn = SrcRodData%Cdn - DstRodData%Cdt = SrcRodData%Cdt - DstRodData%CdEnd = SrcRodData%CdEnd - DstRodData%CaEnd = SrcRodData%CaEnd - DstRodData%time = SrcRodData%time - DstRodData%roll = SrcRodData%roll - DstRodData%pitch = SrcRodData%pitch - DstRodData%h0 = SrcRodData%h0 -IF (ALLOCATED(SrcRodData%r)) THEN - i1_l = LBOUND(SrcRodData%r,1) - i1_u = UBOUND(SrcRodData%r,1) - i2_l = LBOUND(SrcRodData%r,2) - i2_u = UBOUND(SrcRodData%r,2) - IF (.NOT. ALLOCATED(DstRodData%r)) THEN - ALLOCATE(DstRodData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%r = SrcRodData%r -ENDIF -IF (ALLOCATED(SrcRodData%rd)) THEN - i1_l = LBOUND(SrcRodData%rd,1) - i1_u = UBOUND(SrcRodData%rd,1) - i2_l = LBOUND(SrcRodData%rd,2) - i2_u = UBOUND(SrcRodData%rd,2) - IF (.NOT. ALLOCATED(DstRodData%rd)) THEN - ALLOCATE(DstRodData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%rd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%rd = SrcRodData%rd -ENDIF - DstRodData%q = SrcRodData%q -IF (ALLOCATED(SrcRodData%l)) THEN - i1_l = LBOUND(SrcRodData%l,1) - i1_u = UBOUND(SrcRodData%l,1) - IF (.NOT. ALLOCATED(DstRodData%l)) THEN - ALLOCATE(DstRodData%l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%l = SrcRodData%l -ENDIF -IF (ALLOCATED(SrcRodData%V)) THEN - i1_l = LBOUND(SrcRodData%V,1) - i1_u = UBOUND(SrcRodData%V,1) - IF (.NOT. ALLOCATED(DstRodData%V)) THEN - ALLOCATE(DstRodData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%V = SrcRodData%V -ENDIF -IF (ALLOCATED(SrcRodData%U)) THEN - i1_l = LBOUND(SrcRodData%U,1) - i1_u = UBOUND(SrcRodData%U,1) - i2_l = LBOUND(SrcRodData%U,2) - i2_u = UBOUND(SrcRodData%U,2) - IF (.NOT. ALLOCATED(DstRodData%U)) THEN - ALLOCATE(DstRodData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%U = SrcRodData%U -ENDIF -IF (ALLOCATED(SrcRodData%Ud)) THEN - i1_l = LBOUND(SrcRodData%Ud,1) - i1_u = UBOUND(SrcRodData%Ud,1) - i2_l = LBOUND(SrcRodData%Ud,2) - i2_u = UBOUND(SrcRodData%Ud,2) - IF (.NOT. ALLOCATED(DstRodData%Ud)) THEN - ALLOCATE(DstRodData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ud.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Ud = SrcRodData%Ud -ENDIF -IF (ALLOCATED(SrcRodData%zeta)) THEN - i1_l = LBOUND(SrcRodData%zeta,1) - i1_u = UBOUND(SrcRodData%zeta,1) - IF (.NOT. ALLOCATED(DstRodData%zeta)) THEN - ALLOCATE(DstRodData%zeta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%zeta = SrcRodData%zeta -ENDIF -IF (ALLOCATED(SrcRodData%PDyn)) THEN - i1_l = LBOUND(SrcRodData%PDyn,1) - i1_u = UBOUND(SrcRodData%PDyn,1) - IF (.NOT. ALLOCATED(DstRodData%PDyn)) THEN - ALLOCATE(DstRodData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%PDyn = SrcRodData%PDyn -ENDIF -IF (ALLOCATED(SrcRodData%W)) THEN - i1_l = LBOUND(SrcRodData%W,1) - i1_u = UBOUND(SrcRodData%W,1) - i2_l = LBOUND(SrcRodData%W,2) - i2_u = UBOUND(SrcRodData%W,2) - IF (.NOT. ALLOCATED(DstRodData%W)) THEN - ALLOCATE(DstRodData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%W = SrcRodData%W -ENDIF -IF (ALLOCATED(SrcRodData%Bo)) THEN - i1_l = LBOUND(SrcRodData%Bo,1) - i1_u = UBOUND(SrcRodData%Bo,1) - i2_l = LBOUND(SrcRodData%Bo,2) - i2_u = UBOUND(SrcRodData%Bo,2) - IF (.NOT. ALLOCATED(DstRodData%Bo)) THEN - ALLOCATE(DstRodData%Bo(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Bo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Bo = SrcRodData%Bo -ENDIF -IF (ALLOCATED(SrcRodData%Pd)) THEN - i1_l = LBOUND(SrcRodData%Pd,1) - i1_u = UBOUND(SrcRodData%Pd,1) - i2_l = LBOUND(SrcRodData%Pd,2) - i2_u = UBOUND(SrcRodData%Pd,2) - IF (.NOT. ALLOCATED(DstRodData%Pd)) THEN - ALLOCATE(DstRodData%Pd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Pd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Pd = SrcRodData%Pd -ENDIF -IF (ALLOCATED(SrcRodData%Dp)) THEN - i1_l = LBOUND(SrcRodData%Dp,1) - i1_u = UBOUND(SrcRodData%Dp,1) - i2_l = LBOUND(SrcRodData%Dp,2) - i2_u = UBOUND(SrcRodData%Dp,2) - IF (.NOT. ALLOCATED(DstRodData%Dp)) THEN - ALLOCATE(DstRodData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Dp = SrcRodData%Dp -ENDIF -IF (ALLOCATED(SrcRodData%Dq)) THEN - i1_l = LBOUND(SrcRodData%Dq,1) - i1_u = UBOUND(SrcRodData%Dq,1) - i2_l = LBOUND(SrcRodData%Dq,2) - i2_u = UBOUND(SrcRodData%Dq,2) - IF (.NOT. ALLOCATED(DstRodData%Dq)) THEN - ALLOCATE(DstRodData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Dq = SrcRodData%Dq -ENDIF -IF (ALLOCATED(SrcRodData%Ap)) THEN - i1_l = LBOUND(SrcRodData%Ap,1) - i1_u = UBOUND(SrcRodData%Ap,1) - i2_l = LBOUND(SrcRodData%Ap,2) - i2_u = UBOUND(SrcRodData%Ap,2) - IF (.NOT. ALLOCATED(DstRodData%Ap)) THEN - ALLOCATE(DstRodData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Ap = SrcRodData%Ap -ENDIF -IF (ALLOCATED(SrcRodData%Aq)) THEN - i1_l = LBOUND(SrcRodData%Aq,1) - i1_u = UBOUND(SrcRodData%Aq,1) - i2_l = LBOUND(SrcRodData%Aq,2) - i2_u = UBOUND(SrcRodData%Aq,2) - IF (.NOT. ALLOCATED(DstRodData%Aq)) THEN - ALLOCATE(DstRodData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Aq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Aq = SrcRodData%Aq -ENDIF -IF (ALLOCATED(SrcRodData%B)) THEN - i1_l = LBOUND(SrcRodData%B,1) - i1_u = UBOUND(SrcRodData%B,1) - i2_l = LBOUND(SrcRodData%B,2) - i2_u = UBOUND(SrcRodData%B,2) - IF (.NOT. ALLOCATED(DstRodData%B)) THEN - ALLOCATE(DstRodData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%B = SrcRodData%B -ENDIF -IF (ALLOCATED(SrcRodData%Fnet)) THEN - i1_l = LBOUND(SrcRodData%Fnet,1) - i1_u = UBOUND(SrcRodData%Fnet,1) - i2_l = LBOUND(SrcRodData%Fnet,2) - i2_u = UBOUND(SrcRodData%Fnet,2) - IF (.NOT. ALLOCATED(DstRodData%Fnet)) THEN - ALLOCATE(DstRodData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Fnet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Fnet = SrcRodData%Fnet -ENDIF -IF (ALLOCATED(SrcRodData%M)) THEN - i1_l = LBOUND(SrcRodData%M,1) - i1_u = UBOUND(SrcRodData%M,1) - i2_l = LBOUND(SrcRodData%M,2) - i2_u = UBOUND(SrcRodData%M,2) - i3_l = LBOUND(SrcRodData%M,3) - i3_u = UBOUND(SrcRodData%M,3) - IF (.NOT. ALLOCATED(DstRodData%M)) THEN - ALLOCATE(DstRodData%M(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%M = SrcRodData%M -ENDIF - DstRodData%FextA = SrcRodData%FextA - DstRodData%FextB = SrcRodData%FextB - DstRodData%Mext = SrcRodData%Mext - DstRodData%r6 = SrcRodData%r6 - DstRodData%v6 = SrcRodData%v6 - DstRodData%a6 = SrcRodData%a6 - DstRodData%F6net = SrcRodData%F6net - DstRodData%M6net = SrcRodData%M6net - DstRodData%OrMat = SrcRodData%OrMat - DstRodData%RodUnOut = SrcRodData%RodUnOut -IF (ALLOCATED(SrcRodData%RodWrOutput)) THEN - i1_l = LBOUND(SrcRodData%RodWrOutput,1) - i1_u = UBOUND(SrcRodData%RodWrOutput,1) - IF (.NOT. ALLOCATED(DstRodData%RodWrOutput)) THEN - ALLOCATE(DstRodData%RodWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%RodWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%RodWrOutput = SrcRodData%RodWrOutput -ENDIF - END SUBROUTINE MD_CopyRod - - SUBROUTINE MD_DestroyRod( RodData, ErrStat, ErrMsg ) - TYPE(MD_Rod), INTENT(INOUT) :: RodData - 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 = 'MD_DestroyRod' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(RodData%r)) THEN - DEALLOCATE(RodData%r) -ENDIF -IF (ALLOCATED(RodData%rd)) THEN - DEALLOCATE(RodData%rd) -ENDIF -IF (ALLOCATED(RodData%l)) THEN - DEALLOCATE(RodData%l) -ENDIF -IF (ALLOCATED(RodData%V)) THEN - DEALLOCATE(RodData%V) -ENDIF -IF (ALLOCATED(RodData%U)) THEN - DEALLOCATE(RodData%U) -ENDIF -IF (ALLOCATED(RodData%Ud)) THEN - DEALLOCATE(RodData%Ud) -ENDIF -IF (ALLOCATED(RodData%zeta)) THEN - DEALLOCATE(RodData%zeta) -ENDIF -IF (ALLOCATED(RodData%PDyn)) THEN - DEALLOCATE(RodData%PDyn) -ENDIF -IF (ALLOCATED(RodData%W)) THEN - DEALLOCATE(RodData%W) -ENDIF -IF (ALLOCATED(RodData%Bo)) THEN - DEALLOCATE(RodData%Bo) -ENDIF -IF (ALLOCATED(RodData%Pd)) THEN - DEALLOCATE(RodData%Pd) -ENDIF -IF (ALLOCATED(RodData%Dp)) THEN - DEALLOCATE(RodData%Dp) -ENDIF -IF (ALLOCATED(RodData%Dq)) THEN - DEALLOCATE(RodData%Dq) -ENDIF -IF (ALLOCATED(RodData%Ap)) THEN - DEALLOCATE(RodData%Ap) -ENDIF -IF (ALLOCATED(RodData%Aq)) THEN - DEALLOCATE(RodData%Aq) -ENDIF -IF (ALLOCATED(RodData%B)) THEN - DEALLOCATE(RodData%B) -ENDIF -IF (ALLOCATED(RodData%Fnet)) THEN - DEALLOCATE(RodData%Fnet) -ENDIF -IF (ALLOCATED(RodData%M)) THEN - DEALLOCATE(RodData%M) -ENDIF -IF (ALLOCATED(RodData%RodWrOutput)) THEN - DEALLOCATE(RodData%RodWrOutput) -ENDIF - END SUBROUTINE MD_DestroyRod - - SUBROUTINE MD_PackRod( 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(MD_Rod), 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 = 'MD_PackRod' - ! 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 ! IdNum - Int_BufSz = Int_BufSz + 1*LEN(InData%type) ! type - Int_BufSz = Int_BufSz + 1 ! PropsIdNum - Int_BufSz = Int_BufSz + 1 ! typeNum - Int_BufSz = Int_BufSz + SIZE(InData%AttachedA) ! AttachedA - Int_BufSz = Int_BufSz + SIZE(InData%AttachedB) ! AttachedB - Int_BufSz = Int_BufSz + SIZE(InData%TopA) ! TopA - Int_BufSz = Int_BufSz + SIZE(InData%TopB) ! TopB - Int_BufSz = Int_BufSz + 1 ! nAttachedA - Int_BufSz = Int_BufSz + 1 ! nAttachedB - Int_BufSz = Int_BufSz + SIZE(InData%OutFlagList) ! OutFlagList - Int_BufSz = Int_BufSz + 1 ! N - Int_BufSz = Int_BufSz + 1 ! endTypeA - Int_BufSz = Int_BufSz + 1 ! endTypeB - Db_BufSz = Db_BufSz + 1 ! UnstrLen - Db_BufSz = Db_BufSz + 1 ! mass - Db_BufSz = Db_BufSz + 1 ! rho - Db_BufSz = Db_BufSz + 1 ! d - Db_BufSz = Db_BufSz + 1 ! Can - Db_BufSz = Db_BufSz + 1 ! Cat - Db_BufSz = Db_BufSz + 1 ! Cdn - Db_BufSz = Db_BufSz + 1 ! Cdt - Db_BufSz = Db_BufSz + 1 ! CdEnd - Db_BufSz = Db_BufSz + 1 ! CaEnd - Db_BufSz = Db_BufSz + 1 ! time - Db_BufSz = Db_BufSz + 1 ! roll - Db_BufSz = Db_BufSz + 1 ! pitch - Db_BufSz = Db_BufSz + 1 ! h0 - Int_BufSz = Int_BufSz + 1 ! r allocated yes/no - IF ( ALLOCATED(InData%r) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%r) ! r - END IF - Int_BufSz = Int_BufSz + 1 ! rd allocated yes/no - IF ( ALLOCATED(InData%rd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rd) ! rd - END IF - Db_BufSz = Db_BufSz + SIZE(InData%q) ! q - Int_BufSz = Int_BufSz + 1 ! l allocated yes/no - IF ( ALLOCATED(InData%l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! l upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%l) ! l - END IF - Int_BufSz = Int_BufSz + 1 ! V allocated yes/no - IF ( ALLOCATED(InData%V) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%V) ! V - END IF - Int_BufSz = Int_BufSz + 1 ! U allocated yes/no - IF ( ALLOCATED(InData%U) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! U upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%U) ! U - END IF - Int_BufSz = Int_BufSz + 1 ! Ud allocated yes/no - IF ( ALLOCATED(InData%Ud) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Ud upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud - END IF - Int_BufSz = Int_BufSz + 1 ! zeta allocated yes/no - IF ( ALLOCATED(InData%zeta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zeta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%zeta) ! zeta - END IF - Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no - IF ( ALLOCATED(InData%PDyn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PDyn upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PDyn) ! PDyn - END IF - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! W upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%W) ! W - END IF - Int_BufSz = Int_BufSz + 1 ! Bo allocated yes/no - IF ( ALLOCATED(InData%Bo) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Bo upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Bo) ! Bo - END IF - Int_BufSz = Int_BufSz + 1 ! Pd allocated yes/no - IF ( ALLOCATED(InData%Pd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Pd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Pd) ! Pd - END IF - Int_BufSz = Int_BufSz + 1 ! Dp allocated yes/no - IF ( ALLOCATED(InData%Dp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Dp) ! Dp - END IF - Int_BufSz = Int_BufSz + 1 ! Dq allocated yes/no - IF ( ALLOCATED(InData%Dq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dq upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Dq) ! Dq - END IF - Int_BufSz = Int_BufSz + 1 ! Ap allocated yes/no - IF ( ALLOCATED(InData%Ap) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Ap upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ap) ! Ap - END IF - Int_BufSz = Int_BufSz + 1 ! Aq allocated yes/no - IF ( ALLOCATED(InData%Aq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Aq upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Aq) ! Aq - END IF - Int_BufSz = Int_BufSz + 1 ! B allocated yes/no - IF ( ALLOCATED(InData%B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%B) ! B - END IF - Int_BufSz = Int_BufSz + 1 ! Fnet allocated yes/no - IF ( ALLOCATED(InData%Fnet) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Fnet upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fnet) ! Fnet - END IF - Int_BufSz = Int_BufSz + 1 ! M allocated yes/no - IF ( ALLOCATED(InData%M) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! M upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - END IF - Db_BufSz = Db_BufSz + SIZE(InData%FextA) ! FextA - Db_BufSz = Db_BufSz + SIZE(InData%FextB) ! FextB - Db_BufSz = Db_BufSz + SIZE(InData%Mext) ! Mext - Db_BufSz = Db_BufSz + SIZE(InData%r6) ! r6 - Db_BufSz = Db_BufSz + SIZE(InData%v6) ! v6 - Db_BufSz = Db_BufSz + SIZE(InData%a6) ! a6 - Db_BufSz = Db_BufSz + SIZE(InData%F6net) ! F6net - Db_BufSz = Db_BufSz + SIZE(InData%M6net) ! M6net - Db_BufSz = Db_BufSz + SIZE(InData%OrMat) ! OrMat - Int_BufSz = Int_BufSz + 1 ! RodUnOut - Int_BufSz = Int_BufSz + 1 ! RodWrOutput allocated yes/no - IF ( ALLOCATED(InData%RodWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodWrOutput upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RodWrOutput) ! RodWrOutput - 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 - - IntKiBuf(Int_Xferred) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%type) - IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%PropsIdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%typeNum - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%AttachedA,1), UBOUND(InData%AttachedA,1) - IntKiBuf(Int_Xferred) = InData%AttachedA(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AttachedB,1), UBOUND(InData%AttachedB,1) - IntKiBuf(Int_Xferred) = InData%AttachedB(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TopA,1), UBOUND(InData%TopA,1) - IntKiBuf(Int_Xferred) = InData%TopA(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TopB,1), UBOUND(InData%TopB,1) - IntKiBuf(Int_Xferred) = InData%TopB(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nAttachedA - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nAttachedB - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%OutFlagList,1), UBOUND(InData%OutFlagList,1) - IntKiBuf(Int_Xferred) = InData%OutFlagList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%N - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%endTypeA - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%endTypeB - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%UnstrLen - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%mass - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rho - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%d - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Can - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cat - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CdEnd - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CaEnd - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%time - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%roll - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pitch - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%h0 - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%r) ) 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%r,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r,2), UBOUND(InData%r,2) - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - DbKiBuf(Db_Xferred) = InData%r(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rd) ) 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%rd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rd,2), UBOUND(InData%rd,2) - DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) - DbKiBuf(Db_Xferred) = InData%rd(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) - DbKiBuf(Db_Xferred) = InData%q(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%l) ) 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%l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%l,1), UBOUND(InData%l,1) - DbKiBuf(Db_Xferred) = InData%l(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%V) ) 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%V,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) - DbKiBuf(Db_Xferred) = InData%V(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U) ) 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%U,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%U,2), UBOUND(InData%U,2) - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - DbKiBuf(Db_Xferred) = InData%U(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ud) ) 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%Ud,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Ud,2), UBOUND(InData%Ud,2) - DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) - DbKiBuf(Db_Xferred) = InData%Ud(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zeta) ) 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%zeta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zeta,1), UBOUND(InData%zeta,1) - DbKiBuf(Db_Xferred) = InData%zeta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PDyn) ) 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%PDyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) - DbKiBuf(Db_Xferred) = InData%PDyn(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%W) ) 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%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%W,2), UBOUND(InData%W,2) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - DbKiBuf(Db_Xferred) = InData%W(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Bo) ) 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%Bo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bo,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bo,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bo,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Bo,2), UBOUND(InData%Bo,2) - DO i1 = LBOUND(InData%Bo,1), UBOUND(InData%Bo,1) - DbKiBuf(Db_Xferred) = InData%Bo(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pd) ) 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%Pd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Pd,2), UBOUND(InData%Pd,2) - DO i1 = LBOUND(InData%Pd,1), UBOUND(InData%Pd,1) - DbKiBuf(Db_Xferred) = InData%Pd(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dp) ) 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%Dp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dp,2), UBOUND(InData%Dp,2) - DO i1 = LBOUND(InData%Dp,1), UBOUND(InData%Dp,1) - DbKiBuf(Db_Xferred) = InData%Dp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dq) ) 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%Dq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dq,2), UBOUND(InData%Dq,2) - DO i1 = LBOUND(InData%Dq,1), UBOUND(InData%Dq,1) - DbKiBuf(Db_Xferred) = InData%Dq(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ap) ) 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%Ap,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ap,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Ap,2), UBOUND(InData%Ap,2) - DO i1 = LBOUND(InData%Ap,1), UBOUND(InData%Ap,1) - DbKiBuf(Db_Xferred) = InData%Ap(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Aq) ) 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%Aq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Aq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Aq,2), UBOUND(InData%Aq,2) - DO i1 = LBOUND(InData%Aq,1), UBOUND(InData%Aq,1) - DbKiBuf(Db_Xferred) = InData%Aq(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%B) ) 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%B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) - DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) - DbKiBuf(Db_Xferred) = InData%B(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fnet) ) 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%Fnet,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Fnet,2), UBOUND(InData%Fnet,2) - DO i1 = LBOUND(InData%Fnet,1), UBOUND(InData%Fnet,1) - DbKiBuf(Db_Xferred) = InData%Fnet(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M) ) 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%M,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%M,3), UBOUND(InData%M,3) - DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) - DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) - DbKiBuf(Db_Xferred) = InData%M(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%FextA,1), UBOUND(InData%FextA,1) - DbKiBuf(Db_Xferred) = InData%FextA(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FextB,1), UBOUND(InData%FextB,1) - DbKiBuf(Db_Xferred) = InData%FextB(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Mext,1), UBOUND(InData%Mext,1) - DbKiBuf(Db_Xferred) = InData%Mext(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%r6,1), UBOUND(InData%r6,1) - DbKiBuf(Db_Xferred) = InData%r6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%v6,1), UBOUND(InData%v6,1) - DbKiBuf(Db_Xferred) = InData%v6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%a6,1), UBOUND(InData%a6,1) - DbKiBuf(Db_Xferred) = InData%a6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%F6net,1), UBOUND(InData%F6net,1) - DbKiBuf(Db_Xferred) = InData%F6net(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%M6net,2), UBOUND(InData%M6net,2) - DO i1 = LBOUND(InData%M6net,1), UBOUND(InData%M6net,1) - DbKiBuf(Db_Xferred) = InData%M6net(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%OrMat,2), UBOUND(InData%OrMat,2) - DO i1 = LBOUND(InData%OrMat,1), UBOUND(InData%OrMat,1) - DbKiBuf(Db_Xferred) = InData%OrMat(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - IntKiBuf(Int_Xferred) = InData%RodUnOut - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%RodWrOutput) ) 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%RodWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodWrOutput,1), UBOUND(InData%RodWrOutput,1) - DbKiBuf(Db_Xferred) = InData%RodWrOutput(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackRod - - SUBROUTINE MD_UnPackRod( 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(MD_Rod), 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 = 'MD_UnPackRod' - ! 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%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%type) - OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PropsIdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%typeNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%AttachedA,1) - i1_u = UBOUND(OutData%AttachedA,1) - DO i1 = LBOUND(OutData%AttachedA,1), UBOUND(OutData%AttachedA,1) - OutData%AttachedA(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AttachedB,1) - i1_u = UBOUND(OutData%AttachedB,1) - DO i1 = LBOUND(OutData%AttachedB,1), UBOUND(OutData%AttachedB,1) - OutData%AttachedB(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TopA,1) - i1_u = UBOUND(OutData%TopA,1) - DO i1 = LBOUND(OutData%TopA,1), UBOUND(OutData%TopA,1) - OutData%TopA(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TopB,1) - i1_u = UBOUND(OutData%TopB,1) - DO i1 = LBOUND(OutData%TopB,1), UBOUND(OutData%TopB,1) - OutData%TopB(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%nAttachedA = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nAttachedB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%OutFlagList,1) - i1_u = UBOUND(OutData%OutFlagList,1) - DO i1 = LBOUND(OutData%OutFlagList,1), UBOUND(OutData%OutFlagList,1) - OutData%OutFlagList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%N = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%endTypeA = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%endTypeB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnstrLen = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%mass = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%rho = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%d = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Can = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cat = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CdEnd = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CaEnd = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%time = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%roll = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%pitch = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%h0 = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r 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%r)) DEALLOCATE(OutData%r) - ALLOCATE(OutData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r,2), UBOUND(OutData%r,2) - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rd 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%rd)) DEALLOCATE(OutData%rd) - ALLOCATE(OutData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rd,2), UBOUND(OutData%rd,2) - DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) - OutData%rd(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%q,1) - i1_u = UBOUND(OutData%q,1) - DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) - OutData%q(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! l 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%l)) DEALLOCATE(OutData%l) - ALLOCATE(OutData%l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%l,1), UBOUND(OutData%l,1) - OutData%l(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V 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%V)) DEALLOCATE(OutData%V) - ALLOCATE(OutData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) - OutData%V(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U 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%U)) DEALLOCATE(OutData%U) - ALLOCATE(OutData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%U,2), UBOUND(OutData%U,2) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ud 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%Ud)) DEALLOCATE(OutData%Ud) - ALLOCATE(OutData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Ud,2), UBOUND(OutData%Ud,2) - DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) - OutData%Ud(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zeta 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%zeta)) DEALLOCATE(OutData%zeta) - ALLOCATE(OutData%zeta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zeta,1), UBOUND(OutData%zeta,1) - OutData%zeta(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn 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%PDyn)) DEALLOCATE(OutData%PDyn) - ALLOCATE(OutData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) - OutData%PDyn(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W 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%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%W,2), UBOUND(OutData%W,2) - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) - OutData%W(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bo 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%Bo)) DEALLOCATE(OutData%Bo) - ALLOCATE(OutData%Bo(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Bo,2), UBOUND(OutData%Bo,2) - DO i1 = LBOUND(OutData%Bo,1), UBOUND(OutData%Bo,1) - OutData%Bo(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pd 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%Pd)) DEALLOCATE(OutData%Pd) - ALLOCATE(OutData%Pd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Pd,2), UBOUND(OutData%Pd,2) - DO i1 = LBOUND(OutData%Pd,1), UBOUND(OutData%Pd,1) - OutData%Pd(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp 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%Dp)) DEALLOCATE(OutData%Dp) - ALLOCATE(OutData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dp,2), UBOUND(OutData%Dp,2) - DO i1 = LBOUND(OutData%Dp,1), UBOUND(OutData%Dp,1) - OutData%Dp(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dq 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%Dq)) DEALLOCATE(OutData%Dq) - ALLOCATE(OutData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dq,2), UBOUND(OutData%Dq,2) - DO i1 = LBOUND(OutData%Dq,1), UBOUND(OutData%Dq,1) - OutData%Dq(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ap 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%Ap)) DEALLOCATE(OutData%Ap) - ALLOCATE(OutData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Ap,2), UBOUND(OutData%Ap,2) - DO i1 = LBOUND(OutData%Ap,1), UBOUND(OutData%Ap,1) - OutData%Ap(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Aq 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%Aq)) DEALLOCATE(OutData%Aq) - ALLOCATE(OutData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Aq,2), UBOUND(OutData%Aq,2) - DO i1 = LBOUND(OutData%Aq,1), UBOUND(OutData%Aq,1) - OutData%Aq(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B 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%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) - DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) - OutData%B(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fnet 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%Fnet)) DEALLOCATE(OutData%Fnet) - ALLOCATE(OutData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Fnet,2), UBOUND(OutData%Fnet,2) - DO i1 = LBOUND(OutData%Fnet,1), UBOUND(OutData%Fnet,1) - OutData%Fnet(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M 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%M)) DEALLOCATE(OutData%M) - ALLOCATE(OutData%M(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%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%M,3), UBOUND(OutData%M,3) - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2,i3) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%FextA,1) - i1_u = UBOUND(OutData%FextA,1) - DO i1 = LBOUND(OutData%FextA,1), UBOUND(OutData%FextA,1) - OutData%FextA(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FextB,1) - i1_u = UBOUND(OutData%FextB,1) - DO i1 = LBOUND(OutData%FextB,1), UBOUND(OutData%FextB,1) - OutData%FextB(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Mext,1) - i1_u = UBOUND(OutData%Mext,1) - DO i1 = LBOUND(OutData%Mext,1), UBOUND(OutData%Mext,1) - OutData%Mext(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%r6,1) - i1_u = UBOUND(OutData%r6,1) - DO i1 = LBOUND(OutData%r6,1), UBOUND(OutData%r6,1) - OutData%r6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%v6,1) - i1_u = UBOUND(OutData%v6,1) - DO i1 = LBOUND(OutData%v6,1), UBOUND(OutData%v6,1) - OutData%v6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%a6,1) - i1_u = UBOUND(OutData%a6,1) - DO i1 = LBOUND(OutData%a6,1), UBOUND(OutData%a6,1) - OutData%a6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%F6net,1) - i1_u = UBOUND(OutData%F6net,1) - DO i1 = LBOUND(OutData%F6net,1), UBOUND(OutData%F6net,1) - OutData%F6net(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%M6net,1) - i1_u = UBOUND(OutData%M6net,1) - i2_l = LBOUND(OutData%M6net,2) - i2_u = UBOUND(OutData%M6net,2) - DO i2 = LBOUND(OutData%M6net,2), UBOUND(OutData%M6net,2) - DO i1 = LBOUND(OutData%M6net,1), UBOUND(OutData%M6net,1) - OutData%M6net(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%OrMat,1) - i1_u = UBOUND(OutData%OrMat,1) - i2_l = LBOUND(OutData%OrMat,2) - i2_u = UBOUND(OutData%OrMat,2) - DO i2 = LBOUND(OutData%OrMat,2), UBOUND(OutData%OrMat,2) - DO i1 = LBOUND(OutData%OrMat,1), UBOUND(OutData%OrMat,1) - OutData%OrMat(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%RodUnOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodWrOutput 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%RodWrOutput)) DEALLOCATE(OutData%RodWrOutput) - ALLOCATE(OutData%RodWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodWrOutput,1), UBOUND(OutData%RodWrOutput,1) - OutData%RodWrOutput(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackRod - - SUBROUTINE MD_CopyLine( SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Line), INTENT(IN) :: SrcLineData - TYPE(MD_Line), INTENT(INOUT) :: DstLineData - 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 = 'MD_CopyLine' -! - ErrStat = ErrID_None - ErrMsg = "" - DstLineData%IdNum = SrcLineData%IdNum - DstLineData%PropsIdNum = SrcLineData%PropsIdNum - DstLineData%ElasticMod = SrcLineData%ElasticMod - DstLineData%OutFlagList = SrcLineData%OutFlagList - DstLineData%CtrlChan = SrcLineData%CtrlChan - DstLineData%FairConnect = SrcLineData%FairConnect - DstLineData%AnchConnect = SrcLineData%AnchConnect - DstLineData%N = SrcLineData%N - DstLineData%endTypeA = SrcLineData%endTypeA - DstLineData%endTypeB = SrcLineData%endTypeB - DstLineData%UnstrLen = SrcLineData%UnstrLen - DstLineData%rho = SrcLineData%rho - DstLineData%d = SrcLineData%d - DstLineData%EA = SrcLineData%EA - DstLineData%EA_D = SrcLineData%EA_D - DstLineData%BA = SrcLineData%BA - DstLineData%BA_D = SrcLineData%BA_D - DstLineData%EI = SrcLineData%EI - DstLineData%Can = SrcLineData%Can - DstLineData%Cat = SrcLineData%Cat - DstLineData%Cdn = SrcLineData%Cdn - DstLineData%Cdt = SrcLineData%Cdt - DstLineData%nEApoints = SrcLineData%nEApoints - DstLineData%stiffXs = SrcLineData%stiffXs - DstLineData%stiffYs = SrcLineData%stiffYs - DstLineData%nBApoints = SrcLineData%nBApoints - DstLineData%dampXs = SrcLineData%dampXs - DstLineData%dampYs = SrcLineData%dampYs - DstLineData%nEIpoints = SrcLineData%nEIpoints - DstLineData%bstiffXs = SrcLineData%bstiffXs - DstLineData%bstiffYs = SrcLineData%bstiffYs - DstLineData%time = SrcLineData%time -IF (ALLOCATED(SrcLineData%r)) THEN - i1_l = LBOUND(SrcLineData%r,1) - i1_u = UBOUND(SrcLineData%r,1) - i2_l = LBOUND(SrcLineData%r,2) - i2_u = UBOUND(SrcLineData%r,2) - IF (.NOT. ALLOCATED(DstLineData%r)) THEN - ALLOCATE(DstLineData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%r = SrcLineData%r -ENDIF -IF (ALLOCATED(SrcLineData%rd)) THEN - i1_l = LBOUND(SrcLineData%rd,1) - i1_u = UBOUND(SrcLineData%rd,1) - i2_l = LBOUND(SrcLineData%rd,2) - i2_u = UBOUND(SrcLineData%rd,2) - IF (.NOT. ALLOCATED(DstLineData%rd)) THEN - ALLOCATE(DstLineData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%rd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%rd = SrcLineData%rd -ENDIF -IF (ALLOCATED(SrcLineData%q)) THEN - i1_l = LBOUND(SrcLineData%q,1) - i1_u = UBOUND(SrcLineData%q,1) - i2_l = LBOUND(SrcLineData%q,2) - i2_u = UBOUND(SrcLineData%q,2) - IF (.NOT. ALLOCATED(DstLineData%q)) THEN - ALLOCATE(DstLineData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%q.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%q = SrcLineData%q -ENDIF -IF (ALLOCATED(SrcLineData%qs)) THEN - i1_l = LBOUND(SrcLineData%qs,1) - i1_u = UBOUND(SrcLineData%qs,1) - i2_l = LBOUND(SrcLineData%qs,2) - i2_u = UBOUND(SrcLineData%qs,2) - IF (.NOT. ALLOCATED(DstLineData%qs)) THEN - ALLOCATE(DstLineData%qs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%qs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%qs = SrcLineData%qs -ENDIF -IF (ALLOCATED(SrcLineData%l)) THEN - i1_l = LBOUND(SrcLineData%l,1) - i1_u = UBOUND(SrcLineData%l,1) - IF (.NOT. ALLOCATED(DstLineData%l)) THEN - ALLOCATE(DstLineData%l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%l = SrcLineData%l -ENDIF -IF (ALLOCATED(SrcLineData%ld)) THEN - i1_l = LBOUND(SrcLineData%ld,1) - i1_u = UBOUND(SrcLineData%ld,1) - IF (.NOT. ALLOCATED(DstLineData%ld)) THEN - ALLOCATE(DstLineData%ld(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%ld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%ld = SrcLineData%ld -ENDIF -IF (ALLOCATED(SrcLineData%lstr)) THEN - i1_l = LBOUND(SrcLineData%lstr,1) - i1_u = UBOUND(SrcLineData%lstr,1) - IF (.NOT. ALLOCATED(DstLineData%lstr)) THEN - ALLOCATE(DstLineData%lstr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%lstr = SrcLineData%lstr -ENDIF -IF (ALLOCATED(SrcLineData%lstrd)) THEN - i1_l = LBOUND(SrcLineData%lstrd,1) - i1_u = UBOUND(SrcLineData%lstrd,1) - IF (.NOT. ALLOCATED(DstLineData%lstrd)) THEN - ALLOCATE(DstLineData%lstrd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstrd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%lstrd = SrcLineData%lstrd -ENDIF -IF (ALLOCATED(SrcLineData%Kurv)) THEN - i1_l = LBOUND(SrcLineData%Kurv,1) - i1_u = UBOUND(SrcLineData%Kurv,1) - IF (.NOT. ALLOCATED(DstLineData%Kurv)) THEN - ALLOCATE(DstLineData%Kurv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Kurv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Kurv = SrcLineData%Kurv -ENDIF -IF (ALLOCATED(SrcLineData%dl_1)) THEN - i1_l = LBOUND(SrcLineData%dl_1,1) - i1_u = UBOUND(SrcLineData%dl_1,1) - IF (.NOT. ALLOCATED(DstLineData%dl_1)) THEN - ALLOCATE(DstLineData%dl_1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%dl_1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%dl_1 = SrcLineData%dl_1 -ENDIF -IF (ALLOCATED(SrcLineData%V)) THEN - i1_l = LBOUND(SrcLineData%V,1) - i1_u = UBOUND(SrcLineData%V,1) - IF (.NOT. ALLOCATED(DstLineData%V)) THEN - ALLOCATE(DstLineData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%V = SrcLineData%V -ENDIF -IF (ALLOCATED(SrcLineData%U)) THEN - i1_l = LBOUND(SrcLineData%U,1) - i1_u = UBOUND(SrcLineData%U,1) - i2_l = LBOUND(SrcLineData%U,2) - i2_u = UBOUND(SrcLineData%U,2) - IF (.NOT. ALLOCATED(DstLineData%U)) THEN - ALLOCATE(DstLineData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%U = SrcLineData%U -ENDIF -IF (ALLOCATED(SrcLineData%Ud)) THEN - i1_l = LBOUND(SrcLineData%Ud,1) - i1_u = UBOUND(SrcLineData%Ud,1) - i2_l = LBOUND(SrcLineData%Ud,2) - i2_u = UBOUND(SrcLineData%Ud,2) - IF (.NOT. ALLOCATED(DstLineData%Ud)) THEN - ALLOCATE(DstLineData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Ud.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Ud = SrcLineData%Ud -ENDIF -IF (ALLOCATED(SrcLineData%zeta)) THEN - i1_l = LBOUND(SrcLineData%zeta,1) - i1_u = UBOUND(SrcLineData%zeta,1) - IF (.NOT. ALLOCATED(DstLineData%zeta)) THEN - ALLOCATE(DstLineData%zeta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%zeta = SrcLineData%zeta -ENDIF -IF (ALLOCATED(SrcLineData%PDyn)) THEN - i1_l = LBOUND(SrcLineData%PDyn,1) - i1_u = UBOUND(SrcLineData%PDyn,1) - IF (.NOT. ALLOCATED(DstLineData%PDyn)) THEN - ALLOCATE(DstLineData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%PDyn = SrcLineData%PDyn -ENDIF -IF (ALLOCATED(SrcLineData%T)) THEN - i1_l = LBOUND(SrcLineData%T,1) - i1_u = UBOUND(SrcLineData%T,1) - i2_l = LBOUND(SrcLineData%T,2) - i2_u = UBOUND(SrcLineData%T,2) - IF (.NOT. ALLOCATED(DstLineData%T)) THEN - ALLOCATE(DstLineData%T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%T = SrcLineData%T -ENDIF -IF (ALLOCATED(SrcLineData%Td)) THEN - i1_l = LBOUND(SrcLineData%Td,1) - i1_u = UBOUND(SrcLineData%Td,1) - i2_l = LBOUND(SrcLineData%Td,2) - i2_u = UBOUND(SrcLineData%Td,2) - IF (.NOT. ALLOCATED(DstLineData%Td)) THEN - ALLOCATE(DstLineData%Td(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Td.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Td = SrcLineData%Td -ENDIF -IF (ALLOCATED(SrcLineData%W)) THEN - i1_l = LBOUND(SrcLineData%W,1) - i1_u = UBOUND(SrcLineData%W,1) - i2_l = LBOUND(SrcLineData%W,2) - i2_u = UBOUND(SrcLineData%W,2) - IF (.NOT. ALLOCATED(DstLineData%W)) THEN - ALLOCATE(DstLineData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%W = SrcLineData%W -ENDIF -IF (ALLOCATED(SrcLineData%Dp)) THEN - i1_l = LBOUND(SrcLineData%Dp,1) - i1_u = UBOUND(SrcLineData%Dp,1) - i2_l = LBOUND(SrcLineData%Dp,2) - i2_u = UBOUND(SrcLineData%Dp,2) - IF (.NOT. ALLOCATED(DstLineData%Dp)) THEN - ALLOCATE(DstLineData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Dp = SrcLineData%Dp -ENDIF -IF (ALLOCATED(SrcLineData%Dq)) THEN - i1_l = LBOUND(SrcLineData%Dq,1) - i1_u = UBOUND(SrcLineData%Dq,1) - i2_l = LBOUND(SrcLineData%Dq,2) - i2_u = UBOUND(SrcLineData%Dq,2) - IF (.NOT. ALLOCATED(DstLineData%Dq)) THEN - ALLOCATE(DstLineData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Dq = SrcLineData%Dq -ENDIF -IF (ALLOCATED(SrcLineData%Ap)) THEN - i1_l = LBOUND(SrcLineData%Ap,1) - i1_u = UBOUND(SrcLineData%Ap,1) - i2_l = LBOUND(SrcLineData%Ap,2) - i2_u = UBOUND(SrcLineData%Ap,2) - IF (.NOT. ALLOCATED(DstLineData%Ap)) THEN - ALLOCATE(DstLineData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Ap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Ap = SrcLineData%Ap -ENDIF -IF (ALLOCATED(SrcLineData%Aq)) THEN - i1_l = LBOUND(SrcLineData%Aq,1) - i1_u = UBOUND(SrcLineData%Aq,1) - i2_l = LBOUND(SrcLineData%Aq,2) - i2_u = UBOUND(SrcLineData%Aq,2) - IF (.NOT. ALLOCATED(DstLineData%Aq)) THEN - ALLOCATE(DstLineData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Aq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Aq = SrcLineData%Aq -ENDIF -IF (ALLOCATED(SrcLineData%B)) THEN - i1_l = LBOUND(SrcLineData%B,1) - i1_u = UBOUND(SrcLineData%B,1) - i2_l = LBOUND(SrcLineData%B,2) - i2_u = UBOUND(SrcLineData%B,2) - IF (.NOT. ALLOCATED(DstLineData%B)) THEN - ALLOCATE(DstLineData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%B = SrcLineData%B -ENDIF -IF (ALLOCATED(SrcLineData%Bs)) THEN - i1_l = LBOUND(SrcLineData%Bs,1) - i1_u = UBOUND(SrcLineData%Bs,1) - i2_l = LBOUND(SrcLineData%Bs,2) - i2_u = UBOUND(SrcLineData%Bs,2) - IF (.NOT. ALLOCATED(DstLineData%Bs)) THEN - ALLOCATE(DstLineData%Bs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Bs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Bs = SrcLineData%Bs -ENDIF -IF (ALLOCATED(SrcLineData%Fnet)) THEN - i1_l = LBOUND(SrcLineData%Fnet,1) - i1_u = UBOUND(SrcLineData%Fnet,1) - i2_l = LBOUND(SrcLineData%Fnet,2) - i2_u = UBOUND(SrcLineData%Fnet,2) - IF (.NOT. ALLOCATED(DstLineData%Fnet)) THEN - ALLOCATE(DstLineData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Fnet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Fnet = SrcLineData%Fnet -ENDIF -IF (ALLOCATED(SrcLineData%S)) THEN - i1_l = LBOUND(SrcLineData%S,1) - i1_u = UBOUND(SrcLineData%S,1) - i2_l = LBOUND(SrcLineData%S,2) - i2_u = UBOUND(SrcLineData%S,2) - i3_l = LBOUND(SrcLineData%S,3) - i3_u = UBOUND(SrcLineData%S,3) - IF (.NOT. ALLOCATED(DstLineData%S)) THEN - ALLOCATE(DstLineData%S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%S = SrcLineData%S -ENDIF -IF (ALLOCATED(SrcLineData%M)) THEN - i1_l = LBOUND(SrcLineData%M,1) - i1_u = UBOUND(SrcLineData%M,1) - i2_l = LBOUND(SrcLineData%M,2) - i2_u = UBOUND(SrcLineData%M,2) - i3_l = LBOUND(SrcLineData%M,3) - i3_u = UBOUND(SrcLineData%M,3) - IF (.NOT. ALLOCATED(DstLineData%M)) THEN - ALLOCATE(DstLineData%M(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%M = SrcLineData%M -ENDIF - DstLineData%EndMomentA = SrcLineData%EndMomentA - DstLineData%EndMomentB = SrcLineData%EndMomentB - DstLineData%LineUnOut = SrcLineData%LineUnOut -IF (ALLOCATED(SrcLineData%LineWrOutput)) THEN - i1_l = LBOUND(SrcLineData%LineWrOutput,1) - i1_u = UBOUND(SrcLineData%LineWrOutput,1) - IF (.NOT. ALLOCATED(DstLineData%LineWrOutput)) THEN - ALLOCATE(DstLineData%LineWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%LineWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%LineWrOutput = SrcLineData%LineWrOutput -ENDIF - END SUBROUTINE MD_CopyLine - - SUBROUTINE MD_DestroyLine( LineData, ErrStat, ErrMsg ) - TYPE(MD_Line), INTENT(INOUT) :: LineData - 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 = 'MD_DestroyLine' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(LineData%r)) THEN - DEALLOCATE(LineData%r) -ENDIF -IF (ALLOCATED(LineData%rd)) THEN - DEALLOCATE(LineData%rd) -ENDIF -IF (ALLOCATED(LineData%q)) THEN - DEALLOCATE(LineData%q) -ENDIF -IF (ALLOCATED(LineData%qs)) THEN - DEALLOCATE(LineData%qs) -ENDIF -IF (ALLOCATED(LineData%l)) THEN - DEALLOCATE(LineData%l) -ENDIF -IF (ALLOCATED(LineData%ld)) THEN - DEALLOCATE(LineData%ld) -ENDIF -IF (ALLOCATED(LineData%lstr)) THEN - DEALLOCATE(LineData%lstr) -ENDIF -IF (ALLOCATED(LineData%lstrd)) THEN - DEALLOCATE(LineData%lstrd) -ENDIF -IF (ALLOCATED(LineData%Kurv)) THEN - DEALLOCATE(LineData%Kurv) -ENDIF -IF (ALLOCATED(LineData%dl_1)) THEN - DEALLOCATE(LineData%dl_1) -ENDIF -IF (ALLOCATED(LineData%V)) THEN - DEALLOCATE(LineData%V) -ENDIF -IF (ALLOCATED(LineData%U)) THEN - DEALLOCATE(LineData%U) -ENDIF -IF (ALLOCATED(LineData%Ud)) THEN - DEALLOCATE(LineData%Ud) -ENDIF -IF (ALLOCATED(LineData%zeta)) THEN - DEALLOCATE(LineData%zeta) -ENDIF -IF (ALLOCATED(LineData%PDyn)) THEN - DEALLOCATE(LineData%PDyn) -ENDIF -IF (ALLOCATED(LineData%T)) THEN - DEALLOCATE(LineData%T) -ENDIF -IF (ALLOCATED(LineData%Td)) THEN - DEALLOCATE(LineData%Td) -ENDIF -IF (ALLOCATED(LineData%W)) THEN - DEALLOCATE(LineData%W) -ENDIF -IF (ALLOCATED(LineData%Dp)) THEN - DEALLOCATE(LineData%Dp) -ENDIF -IF (ALLOCATED(LineData%Dq)) THEN - DEALLOCATE(LineData%Dq) -ENDIF -IF (ALLOCATED(LineData%Ap)) THEN - DEALLOCATE(LineData%Ap) -ENDIF -IF (ALLOCATED(LineData%Aq)) THEN - DEALLOCATE(LineData%Aq) -ENDIF -IF (ALLOCATED(LineData%B)) THEN - DEALLOCATE(LineData%B) -ENDIF -IF (ALLOCATED(LineData%Bs)) THEN - DEALLOCATE(LineData%Bs) -ENDIF -IF (ALLOCATED(LineData%Fnet)) THEN - DEALLOCATE(LineData%Fnet) -ENDIF -IF (ALLOCATED(LineData%S)) THEN - DEALLOCATE(LineData%S) -ENDIF -IF (ALLOCATED(LineData%M)) THEN - DEALLOCATE(LineData%M) -ENDIF -IF (ALLOCATED(LineData%LineWrOutput)) THEN - DEALLOCATE(LineData%LineWrOutput) -ENDIF - END SUBROUTINE MD_DestroyLine - - SUBROUTINE MD_PackLine( 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(MD_Line), 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 = 'MD_PackLine' - ! 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 ! IdNum - Int_BufSz = Int_BufSz + 1 ! PropsIdNum - Int_BufSz = Int_BufSz + 1 ! ElasticMod - Int_BufSz = Int_BufSz + SIZE(InData%OutFlagList) ! OutFlagList - Int_BufSz = Int_BufSz + 1 ! CtrlChan - Int_BufSz = Int_BufSz + 1 ! FairConnect - Int_BufSz = Int_BufSz + 1 ! AnchConnect - Int_BufSz = Int_BufSz + 1 ! N - Int_BufSz = Int_BufSz + 1 ! endTypeA - Int_BufSz = Int_BufSz + 1 ! endTypeB - Db_BufSz = Db_BufSz + 1 ! UnstrLen - Db_BufSz = Db_BufSz + 1 ! rho - Db_BufSz = Db_BufSz + 1 ! d - Db_BufSz = Db_BufSz + 1 ! EA - Db_BufSz = Db_BufSz + 1 ! EA_D - Db_BufSz = Db_BufSz + 1 ! BA - Db_BufSz = Db_BufSz + 1 ! BA_D - Db_BufSz = Db_BufSz + 1 ! EI - Db_BufSz = Db_BufSz + 1 ! Can - Db_BufSz = Db_BufSz + 1 ! Cat - Db_BufSz = Db_BufSz + 1 ! Cdn - Db_BufSz = Db_BufSz + 1 ! Cdt - Int_BufSz = Int_BufSz + 1 ! nEApoints - Db_BufSz = Db_BufSz + SIZE(InData%stiffXs) ! stiffXs - Db_BufSz = Db_BufSz + SIZE(InData%stiffYs) ! stiffYs - Int_BufSz = Int_BufSz + 1 ! nBApoints - Db_BufSz = Db_BufSz + SIZE(InData%dampXs) ! dampXs - Db_BufSz = Db_BufSz + SIZE(InData%dampYs) ! dampYs - Int_BufSz = Int_BufSz + 1 ! nEIpoints - Db_BufSz = Db_BufSz + SIZE(InData%bstiffXs) ! bstiffXs - Db_BufSz = Db_BufSz + SIZE(InData%bstiffYs) ! bstiffYs - Db_BufSz = Db_BufSz + 1 ! time - Int_BufSz = Int_BufSz + 1 ! r allocated yes/no - IF ( ALLOCATED(InData%r) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%r) ! r - END IF - Int_BufSz = Int_BufSz + 1 ! rd allocated yes/no - IF ( ALLOCATED(InData%rd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rd) ! rd - END IF - Int_BufSz = Int_BufSz + 1 ! q allocated yes/no - IF ( ALLOCATED(InData%q) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! q upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%q) ! q - END IF - Int_BufSz = Int_BufSz + 1 ! qs allocated yes/no - IF ( ALLOCATED(InData%qs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! qs upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%qs) ! qs - END IF - Int_BufSz = Int_BufSz + 1 ! l allocated yes/no - IF ( ALLOCATED(InData%l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! l upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%l) ! l - END IF - Int_BufSz = Int_BufSz + 1 ! ld allocated yes/no - IF ( ALLOCATED(InData%ld) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ld upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ld) ! ld - END IF - Int_BufSz = Int_BufSz + 1 ! lstr allocated yes/no - IF ( ALLOCATED(InData%lstr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! lstr upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lstr) ! lstr - END IF - Int_BufSz = Int_BufSz + 1 ! lstrd allocated yes/no - IF ( ALLOCATED(InData%lstrd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! lstrd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lstrd) ! lstrd - END IF - Int_BufSz = Int_BufSz + 1 ! Kurv allocated yes/no - IF ( ALLOCATED(InData%Kurv) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Kurv upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Kurv) ! Kurv - END IF - Int_BufSz = Int_BufSz + 1 ! dl_1 allocated yes/no - IF ( ALLOCATED(InData%dl_1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dl_1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dl_1) ! dl_1 - END IF - Int_BufSz = Int_BufSz + 1 ! V allocated yes/no - IF ( ALLOCATED(InData%V) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%V) ! V - END IF - Int_BufSz = Int_BufSz + 1 ! U allocated yes/no - IF ( ALLOCATED(InData%U) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! U upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%U) ! U - END IF - Int_BufSz = Int_BufSz + 1 ! Ud allocated yes/no - IF ( ALLOCATED(InData%Ud) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Ud upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud - END IF - Int_BufSz = Int_BufSz + 1 ! zeta allocated yes/no - IF ( ALLOCATED(InData%zeta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zeta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%zeta) ! zeta - END IF - Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no - IF ( ALLOCATED(InData%PDyn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PDyn upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PDyn) ! PDyn - END IF - Int_BufSz = Int_BufSz + 1 ! T allocated yes/no - IF ( ALLOCATED(InData%T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%T) ! T - END IF - Int_BufSz = Int_BufSz + 1 ! Td allocated yes/no - IF ( ALLOCATED(InData%Td) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Td upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Td) ! Td - END IF - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! W upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%W) ! W - END IF - Int_BufSz = Int_BufSz + 1 ! Dp allocated yes/no - IF ( ALLOCATED(InData%Dp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Dp) ! Dp - END IF - Int_BufSz = Int_BufSz + 1 ! Dq allocated yes/no - IF ( ALLOCATED(InData%Dq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dq upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Dq) ! Dq - END IF - Int_BufSz = Int_BufSz + 1 ! Ap allocated yes/no - IF ( ALLOCATED(InData%Ap) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Ap upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ap) ! Ap - END IF - Int_BufSz = Int_BufSz + 1 ! Aq allocated yes/no - IF ( ALLOCATED(InData%Aq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Aq upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Aq) ! Aq - END IF - Int_BufSz = Int_BufSz + 1 ! B allocated yes/no - IF ( ALLOCATED(InData%B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%B) ! B - END IF - Int_BufSz = Int_BufSz + 1 ! Bs allocated yes/no - IF ( ALLOCATED(InData%Bs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Bs upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Bs) ! Bs - END IF - Int_BufSz = Int_BufSz + 1 ! Fnet allocated yes/no - IF ( ALLOCATED(InData%Fnet) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Fnet upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fnet) ! Fnet - END IF - Int_BufSz = Int_BufSz + 1 ! S allocated yes/no - IF ( ALLOCATED(InData%S) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! S upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%S) ! S - END IF - Int_BufSz = Int_BufSz + 1 ! M allocated yes/no - IF ( ALLOCATED(InData%M) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! M upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - END IF - Db_BufSz = Db_BufSz + SIZE(InData%EndMomentA) ! EndMomentA - Db_BufSz = Db_BufSz + SIZE(InData%EndMomentB) ! EndMomentB - Int_BufSz = Int_BufSz + 1 ! LineUnOut - Int_BufSz = Int_BufSz + 1 ! LineWrOutput allocated yes/no - IF ( ALLOCATED(InData%LineWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineWrOutput upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LineWrOutput) ! LineWrOutput - 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 - - IntKiBuf(Int_Xferred) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PropsIdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ElasticMod - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%OutFlagList,1), UBOUND(InData%OutFlagList,1) - IntKiBuf(Int_Xferred) = InData%OutFlagList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%CtrlChan - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FairConnect - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AnchConnect - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%N - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%endTypeA - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%endTypeB - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%UnstrLen - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rho - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%d - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EA_D - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA_D - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EI - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Can - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cat - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdt - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nEApoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%stiffXs,1), UBOUND(InData%stiffXs,1) - DbKiBuf(Db_Xferred) = InData%stiffXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%stiffYs,1), UBOUND(InData%stiffYs,1) - DbKiBuf(Db_Xferred) = InData%stiffYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nBApoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%dampXs,1), UBOUND(InData%dampXs,1) - DbKiBuf(Db_Xferred) = InData%dampXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%dampYs,1), UBOUND(InData%dampYs,1) - DbKiBuf(Db_Xferred) = InData%dampYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nEIpoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%bstiffXs,1), UBOUND(InData%bstiffXs,1) - DbKiBuf(Db_Xferred) = InData%bstiffXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%bstiffYs,1), UBOUND(InData%bstiffYs,1) - DbKiBuf(Db_Xferred) = InData%bstiffYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%time - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%r) ) 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%r,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r,2), UBOUND(InData%r,2) - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - DbKiBuf(Db_Xferred) = InData%r(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rd) ) 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%rd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rd,2), UBOUND(InData%rd,2) - DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) - DbKiBuf(Db_Xferred) = InData%rd(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%q) ) 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%q,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%q,2), UBOUND(InData%q,2) - DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) - DbKiBuf(Db_Xferred) = InData%q(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%qs) ) 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%qs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%qs,2), UBOUND(InData%qs,2) - DO i1 = LBOUND(InData%qs,1), UBOUND(InData%qs,1) - DbKiBuf(Db_Xferred) = InData%qs(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%l) ) 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%l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%l,1), UBOUND(InData%l,1) - DbKiBuf(Db_Xferred) = InData%l(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ld) ) 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%ld,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ld,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ld,1), UBOUND(InData%ld,1) - DbKiBuf(Db_Xferred) = InData%ld(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%lstr) ) 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%lstr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%lstr,1), UBOUND(InData%lstr,1) - DbKiBuf(Db_Xferred) = InData%lstr(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%lstrd) ) 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%lstrd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstrd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%lstrd,1), UBOUND(InData%lstrd,1) - DbKiBuf(Db_Xferred) = InData%lstrd(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kurv) ) 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%Kurv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kurv,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Kurv,1), UBOUND(InData%Kurv,1) - DbKiBuf(Db_Xferred) = InData%Kurv(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dl_1) ) 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%dl_1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl_1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dl_1,1), UBOUND(InData%dl_1,1) - DbKiBuf(Db_Xferred) = InData%dl_1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%V) ) 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%V,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) - DbKiBuf(Db_Xferred) = InData%V(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U) ) 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%U,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%U,2), UBOUND(InData%U,2) - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - DbKiBuf(Db_Xferred) = InData%U(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ud) ) 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%Ud,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Ud,2), UBOUND(InData%Ud,2) - DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) - DbKiBuf(Db_Xferred) = InData%Ud(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zeta) ) 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%zeta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zeta,1), UBOUND(InData%zeta,1) - DbKiBuf(Db_Xferred) = InData%zeta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PDyn) ) 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%PDyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) - DbKiBuf(Db_Xferred) = InData%PDyn(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%T) ) 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%T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%T,2), UBOUND(InData%T,2) - DO i1 = LBOUND(InData%T,1), UBOUND(InData%T,1) - DbKiBuf(Db_Xferred) = InData%T(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Td) ) 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%Td,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Td,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Td,2), UBOUND(InData%Td,2) - DO i1 = LBOUND(InData%Td,1), UBOUND(InData%Td,1) - DbKiBuf(Db_Xferred) = InData%Td(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%W) ) 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%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%W,2), UBOUND(InData%W,2) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - DbKiBuf(Db_Xferred) = InData%W(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dp) ) 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%Dp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dp,2), UBOUND(InData%Dp,2) - DO i1 = LBOUND(InData%Dp,1), UBOUND(InData%Dp,1) - DbKiBuf(Db_Xferred) = InData%Dp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dq) ) 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%Dq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dq,2), UBOUND(InData%Dq,2) - DO i1 = LBOUND(InData%Dq,1), UBOUND(InData%Dq,1) - DbKiBuf(Db_Xferred) = InData%Dq(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ap) ) 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%Ap,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ap,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Ap,2), UBOUND(InData%Ap,2) - DO i1 = LBOUND(InData%Ap,1), UBOUND(InData%Ap,1) - DbKiBuf(Db_Xferred) = InData%Ap(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Aq) ) 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%Aq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Aq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Aq,2), UBOUND(InData%Aq,2) - DO i1 = LBOUND(InData%Aq,1), UBOUND(InData%Aq,1) - DbKiBuf(Db_Xferred) = InData%Aq(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%B) ) 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%B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) - DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) - DbKiBuf(Db_Xferred) = InData%B(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Bs) ) 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%Bs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Bs,2), UBOUND(InData%Bs,2) - DO i1 = LBOUND(InData%Bs,1), UBOUND(InData%Bs,1) - DbKiBuf(Db_Xferred) = InData%Bs(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fnet) ) 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%Fnet,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Fnet,2), UBOUND(InData%Fnet,2) - DO i1 = LBOUND(InData%Fnet,1), UBOUND(InData%Fnet,1) - DbKiBuf(Db_Xferred) = InData%Fnet(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%S) ) 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%S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%S,3), UBOUND(InData%S,3) - DO i2 = LBOUND(InData%S,2), UBOUND(InData%S,2) - DO i1 = LBOUND(InData%S,1), UBOUND(InData%S,1) - DbKiBuf(Db_Xferred) = InData%S(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M) ) 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%M,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%M,3), UBOUND(InData%M,3) - DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) - DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) - DbKiBuf(Db_Xferred) = InData%M(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%EndMomentA,1), UBOUND(InData%EndMomentA,1) - DbKiBuf(Db_Xferred) = InData%EndMomentA(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%EndMomentB,1), UBOUND(InData%EndMomentB,1) - DbKiBuf(Db_Xferred) = InData%EndMomentB(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%LineUnOut - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LineWrOutput) ) 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%LineWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineWrOutput,1), UBOUND(InData%LineWrOutput,1) - DbKiBuf(Db_Xferred) = InData%LineWrOutput(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackLine - - SUBROUTINE MD_UnPackLine( 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(MD_Line), 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 = 'MD_UnPackLine' - ! 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%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PropsIdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ElasticMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%OutFlagList,1) - i1_u = UBOUND(OutData%OutFlagList,1) - DO i1 = LBOUND(OutData%OutFlagList,1), UBOUND(OutData%OutFlagList,1) - OutData%OutFlagList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%CtrlChan = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FairConnect = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AnchConnect = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%N = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%endTypeA = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%endTypeB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnstrLen = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%rho = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%d = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EA_D = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BA_D = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EI = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Can = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cat = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%nEApoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%stiffXs,1) - i1_u = UBOUND(OutData%stiffXs,1) - DO i1 = LBOUND(OutData%stiffXs,1), UBOUND(OutData%stiffXs,1) - OutData%stiffXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%stiffYs,1) - i1_u = UBOUND(OutData%stiffYs,1) - DO i1 = LBOUND(OutData%stiffYs,1), UBOUND(OutData%stiffYs,1) - OutData%stiffYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%nBApoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%dampXs,1) - i1_u = UBOUND(OutData%dampXs,1) - DO i1 = LBOUND(OutData%dampXs,1), UBOUND(OutData%dampXs,1) - OutData%dampXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%dampYs,1) - i1_u = UBOUND(OutData%dampYs,1) - DO i1 = LBOUND(OutData%dampYs,1), UBOUND(OutData%dampYs,1) - OutData%dampYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%nEIpoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%bstiffXs,1) - i1_u = UBOUND(OutData%bstiffXs,1) - DO i1 = LBOUND(OutData%bstiffXs,1), UBOUND(OutData%bstiffXs,1) - OutData%bstiffXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%bstiffYs,1) - i1_u = UBOUND(OutData%bstiffYs,1) - DO i1 = LBOUND(OutData%bstiffYs,1), UBOUND(OutData%bstiffYs,1) - OutData%bstiffYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%time = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r 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%r)) DEALLOCATE(OutData%r) - ALLOCATE(OutData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r,2), UBOUND(OutData%r,2) - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rd 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%rd)) DEALLOCATE(OutData%rd) - ALLOCATE(OutData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rd,2), UBOUND(OutData%rd,2) - DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) - OutData%rd(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q 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%q)) DEALLOCATE(OutData%q) - ALLOCATE(OutData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%q,2), UBOUND(OutData%q,2) - DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) - OutData%q(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qs 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%qs)) DEALLOCATE(OutData%qs) - ALLOCATE(OutData%qs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%qs,2), UBOUND(OutData%qs,2) - DO i1 = LBOUND(OutData%qs,1), UBOUND(OutData%qs,1) - OutData%qs(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! l 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%l)) DEALLOCATE(OutData%l) - ALLOCATE(OutData%l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%l,1), UBOUND(OutData%l,1) - OutData%l(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ld 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%ld)) DEALLOCATE(OutData%ld) - ALLOCATE(OutData%ld(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ld,1), UBOUND(OutData%ld,1) - OutData%ld(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstr 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%lstr)) DEALLOCATE(OutData%lstr) - ALLOCATE(OutData%lstr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%lstr,1), UBOUND(OutData%lstr,1) - OutData%lstr(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstrd 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%lstrd)) DEALLOCATE(OutData%lstrd) - ALLOCATE(OutData%lstrd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstrd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%lstrd,1), UBOUND(OutData%lstrd,1) - OutData%lstrd(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kurv 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%Kurv)) DEALLOCATE(OutData%Kurv) - ALLOCATE(OutData%Kurv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kurv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Kurv,1), UBOUND(OutData%Kurv,1) - OutData%Kurv(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dl_1 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%dl_1)) DEALLOCATE(OutData%dl_1) - ALLOCATE(OutData%dl_1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl_1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dl_1,1), UBOUND(OutData%dl_1,1) - OutData%dl_1(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V 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%V)) DEALLOCATE(OutData%V) - ALLOCATE(OutData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) - OutData%V(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U 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%U)) DEALLOCATE(OutData%U) - ALLOCATE(OutData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%U,2), UBOUND(OutData%U,2) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ud 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%Ud)) DEALLOCATE(OutData%Ud) - ALLOCATE(OutData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Ud,2), UBOUND(OutData%Ud,2) - DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) - OutData%Ud(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zeta 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%zeta)) DEALLOCATE(OutData%zeta) - ALLOCATE(OutData%zeta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zeta,1), UBOUND(OutData%zeta,1) - OutData%zeta(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn 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%PDyn)) DEALLOCATE(OutData%PDyn) - ALLOCATE(OutData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) - OutData%PDyn(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T 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%T)) DEALLOCATE(OutData%T) - ALLOCATE(OutData%T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%T,2), UBOUND(OutData%T,2) - DO i1 = LBOUND(OutData%T,1), UBOUND(OutData%T,1) - OutData%T(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Td 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%Td)) DEALLOCATE(OutData%Td) - ALLOCATE(OutData%Td(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Td.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Td,2), UBOUND(OutData%Td,2) - DO i1 = LBOUND(OutData%Td,1), UBOUND(OutData%Td,1) - OutData%Td(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W 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%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%W,2), UBOUND(OutData%W,2) - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) - OutData%W(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp 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%Dp)) DEALLOCATE(OutData%Dp) - ALLOCATE(OutData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dp,2), UBOUND(OutData%Dp,2) - DO i1 = LBOUND(OutData%Dp,1), UBOUND(OutData%Dp,1) - OutData%Dp(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dq 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%Dq)) DEALLOCATE(OutData%Dq) - ALLOCATE(OutData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dq,2), UBOUND(OutData%Dq,2) - DO i1 = LBOUND(OutData%Dq,1), UBOUND(OutData%Dq,1) - OutData%Dq(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ap 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%Ap)) DEALLOCATE(OutData%Ap) - ALLOCATE(OutData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Ap,2), UBOUND(OutData%Ap,2) - DO i1 = LBOUND(OutData%Ap,1), UBOUND(OutData%Ap,1) - OutData%Ap(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Aq 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%Aq)) DEALLOCATE(OutData%Aq) - ALLOCATE(OutData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Aq,2), UBOUND(OutData%Aq,2) - DO i1 = LBOUND(OutData%Aq,1), UBOUND(OutData%Aq,1) - OutData%Aq(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B 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%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) - DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) - OutData%B(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bs 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%Bs)) DEALLOCATE(OutData%Bs) - ALLOCATE(OutData%Bs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Bs,2), UBOUND(OutData%Bs,2) - DO i1 = LBOUND(OutData%Bs,1), UBOUND(OutData%Bs,1) - OutData%Bs(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fnet 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%Fnet)) DEALLOCATE(OutData%Fnet) - ALLOCATE(OutData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Fnet,2), UBOUND(OutData%Fnet,2) - DO i1 = LBOUND(OutData%Fnet,1), UBOUND(OutData%Fnet,1) - OutData%Fnet(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! S 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%S)) DEALLOCATE(OutData%S) - ALLOCATE(OutData%S(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%S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%S,3), UBOUND(OutData%S,3) - DO i2 = LBOUND(OutData%S,2), UBOUND(OutData%S,2) - DO i1 = LBOUND(OutData%S,1), UBOUND(OutData%S,1) - OutData%S(i1,i2,i3) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M 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%M)) DEALLOCATE(OutData%M) - ALLOCATE(OutData%M(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%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%M,3), UBOUND(OutData%M,3) - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2,i3) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%EndMomentA,1) - i1_u = UBOUND(OutData%EndMomentA,1) - DO i1 = LBOUND(OutData%EndMomentA,1), UBOUND(OutData%EndMomentA,1) - OutData%EndMomentA(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%EndMomentB,1) - i1_u = UBOUND(OutData%EndMomentB,1) - DO i1 = LBOUND(OutData%EndMomentB,1), UBOUND(OutData%EndMomentB,1) - OutData%EndMomentB(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%LineUnOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineWrOutput 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%LineWrOutput)) DEALLOCATE(OutData%LineWrOutput) - ALLOCATE(OutData%LineWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineWrOutput,1), UBOUND(OutData%LineWrOutput,1) - OutData%LineWrOutput(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackLine - - SUBROUTINE MD_CopyFail( SrcFailData, DstFailData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Fail), INTENT(IN) :: SrcFailData - TYPE(MD_Fail), INTENT(INOUT) :: DstFailData - 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 = 'MD_CopyFail' -! - ErrStat = ErrID_None - ErrMsg = "" - DstFailData%IdNum = SrcFailData%IdNum - END SUBROUTINE MD_CopyFail - - SUBROUTINE MD_DestroyFail( FailData, ErrStat, ErrMsg ) - TYPE(MD_Fail), INTENT(INOUT) :: FailData - 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 = 'MD_DestroyFail' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MD_DestroyFail - - SUBROUTINE MD_PackFail( 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(MD_Fail), 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 = 'MD_PackFail' - ! 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 ! IdNum - 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%IdNum - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_PackFail - - SUBROUTINE MD_UnPackFail( 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(MD_Fail), 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 = 'MD_UnPackFail' - ! 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%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_UnPackFail - - SUBROUTINE MD_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_OutParmType), INTENT(IN) :: SrcOutParmTypeData - TYPE(MD_OutParmType), INTENT(INOUT) :: DstOutParmTypeData - 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 = 'MD_CopyOutParmType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOutParmTypeData%Name = SrcOutParmTypeData%Name - DstOutParmTypeData%Units = SrcOutParmTypeData%Units - DstOutParmTypeData%QType = SrcOutParmTypeData%QType - DstOutParmTypeData%OType = SrcOutParmTypeData%OType - DstOutParmTypeData%NodeID = SrcOutParmTypeData%NodeID - DstOutParmTypeData%ObjID = SrcOutParmTypeData%ObjID - END SUBROUTINE MD_CopyOutParmType - - SUBROUTINE MD_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg ) - TYPE(MD_OutParmType), INTENT(INOUT) :: OutParmTypeData - 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 = 'MD_DestroyOutParmType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MD_DestroyOutParmType - - SUBROUTINE MD_PackOutParmType( 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(MD_OutParmType), 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 = 'MD_PackOutParmType' - ! 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%Name) ! Name - Int_BufSz = Int_BufSz + 1*LEN(InData%Units) ! Units - Int_BufSz = Int_BufSz + 1 ! QType - Int_BufSz = Int_BufSz + 1 ! OType - Int_BufSz = Int_BufSz + 1 ! NodeID - Int_BufSz = Int_BufSz + 1 ! ObjID - 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%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Units) - IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%QType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NodeID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ObjID - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_PackOutParmType - - SUBROUTINE MD_UnPackOutParmType( 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(MD_OutParmType), 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 = 'MD_UnPackOutParmType' - ! 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%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Units) - OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%QType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NodeID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ObjID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_UnPackOutParmType - - SUBROUTINE MD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(MD_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 = 'MD_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 - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%CableCChanRqst)) THEN - i1_l = LBOUND(SrcInitOutputData%CableCChanRqst,1) - i1_u = UBOUND(SrcInitOutputData%CableCChanRqst,1) - IF (.NOT. ALLOCATED(DstInitOutputData%CableCChanRqst)) THEN - ALLOCATE(DstInitOutputData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN - ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF - END SUBROUTINE MD_CopyInitOutput - - SUBROUTINE MD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(MD_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 = 'MD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%CableCChanRqst)) THEN - DEALLOCATE(InitOutputData%CableCChanRqst) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN - DEALLOCATE(InitOutputData%RotFrame_x) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF - END SUBROUTINE MD_DestroyInitOutput - - SUBROUTINE MD_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(MD_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 = 'MD_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CableCChanRqst allocated yes/no - IF ( ALLOCATED(InData%CableCChanRqst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableCChanRqst upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CableCChanRqst) ! CableCChanRqst - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%CableCChanRqst) ) 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%CableCChanRqst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableCChanRqst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableCChanRqst,1), UBOUND(InData%CableCChanRqst,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%CableCChanRqst(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) 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%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) 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%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) 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%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) 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%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) 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%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) 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%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) 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%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) 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%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackInitOutput - - SUBROUTINE MD_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(MD_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 = 'MD_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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableCChanRqst 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%CableCChanRqst)) DEALLOCATE(OutData%CableCChanRqst) - ALLOCATE(OutData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableCChanRqst,1), UBOUND(OutData%CableCChanRqst,1) - OutData%CableCChanRqst(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CableCChanRqst(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y 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%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(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 ! LinNames_x 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%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(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 ! LinNames_u 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%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(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 ! RotFrame_y 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%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x 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%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u 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%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u 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%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x 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%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackInitOutput - - SUBROUTINE MD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(MD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%states)) THEN - i1_l = LBOUND(SrcContStateData%states,1) - i1_u = UBOUND(SrcContStateData%states,1) - IF (.NOT. ALLOCATED(DstContStateData%states)) THEN - ALLOCATE(DstContStateData%states(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%states.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%states = SrcContStateData%states -ENDIF - END SUBROUTINE MD_CopyContState - - SUBROUTINE MD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(MD_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 = 'MD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%states)) THEN - DEALLOCATE(ContStateData%states) -ENDIF - END SUBROUTINE MD_DestroyContState - - SUBROUTINE MD_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(MD_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 = 'MD_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 - Int_BufSz = Int_BufSz + 1 ! states allocated yes/no - IF ( ALLOCATED(InData%states) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! states upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%states) ! states - 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%states) ) 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%states,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%states,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%states,1), UBOUND(InData%states,1) - DbKiBuf(Db_Xferred) = InData%states(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackContState - - SUBROUTINE MD_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(MD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! states 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%states)) DEALLOCATE(OutData%states) - ALLOCATE(OutData%states(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%states.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%states,1), UBOUND(OutData%states,1) - OutData%states(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackContState - - SUBROUTINE MD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(MD_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 = 'MD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%dummy = SrcDiscStateData%dummy - END SUBROUTINE MD_CopyDiscState - - SUBROUTINE MD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(MD_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 = 'MD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MD_DestroyDiscState - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! dummy - 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%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_PackDiscState - - SUBROUTINE MD_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(MD_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 = 'MD_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%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_UnPackDiscState - - SUBROUTINE MD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(MD_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 = 'MD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%dummy = SrcConstrStateData%dummy - END SUBROUTINE MD_CopyConstrState - - SUBROUTINE MD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(MD_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 = 'MD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MD_DestroyConstrState - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! dummy - 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%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_PackConstrState - - SUBROUTINE MD_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(MD_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 = 'MD_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%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_UnPackConstrState - - SUBROUTINE MD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(MD_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 = 'MD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%dummy = SrcOtherStateData%dummy - END SUBROUTINE MD_CopyOtherState - - SUBROUTINE MD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(MD_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 = 'MD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MD_DestroyOtherState - - SUBROUTINE MD_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(MD_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 = 'MD_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 - Re_BufSz = Re_BufSz + 1 ! dummy - 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%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_PackOtherState - - SUBROUTINE MD_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(MD_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 = 'MD_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%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_UnPackOtherState - - SUBROUTINE MD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(MD_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) :: 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 = 'MD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%LineTypeList)) THEN - i1_l = LBOUND(SrcMiscData%LineTypeList,1) - i1_u = UBOUND(SrcMiscData%LineTypeList,1) - IF (.NOT. ALLOCATED(DstMiscData%LineTypeList)) THEN - ALLOCATE(DstMiscData%LineTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%LineTypeList,1), UBOUND(SrcMiscData%LineTypeList,1) - CALL MD_Copylineprop( SrcMiscData%LineTypeList(i1), DstMiscData%LineTypeList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%RodTypeList)) THEN - i1_l = LBOUND(SrcMiscData%RodTypeList,1) - i1_u = UBOUND(SrcMiscData%RodTypeList,1) - IF (.NOT. ALLOCATED(DstMiscData%RodTypeList)) THEN - ALLOCATE(DstMiscData%RodTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%RodTypeList,1), UBOUND(SrcMiscData%RodTypeList,1) - CALL MD_Copyrodprop( SrcMiscData%RodTypeList(i1), DstMiscData%RodTypeList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MD_Copybody( SrcMiscData%GroundBody, DstMiscData%GroundBody, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%BodyList)) THEN - i1_l = LBOUND(SrcMiscData%BodyList,1) - i1_u = UBOUND(SrcMiscData%BodyList,1) - IF (.NOT. ALLOCATED(DstMiscData%BodyList)) THEN - ALLOCATE(DstMiscData%BodyList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%BodyList,1), UBOUND(SrcMiscData%BodyList,1) - CALL MD_Copybody( SrcMiscData%BodyList(i1), DstMiscData%BodyList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%RodList)) THEN - i1_l = LBOUND(SrcMiscData%RodList,1) - i1_u = UBOUND(SrcMiscData%RodList,1) - IF (.NOT. ALLOCATED(DstMiscData%RodList)) THEN - ALLOCATE(DstMiscData%RodList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%RodList,1), UBOUND(SrcMiscData%RodList,1) - CALL MD_Copyrod( SrcMiscData%RodList(i1), DstMiscData%RodList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%ConnectList)) THEN - i1_l = LBOUND(SrcMiscData%ConnectList,1) - i1_u = UBOUND(SrcMiscData%ConnectList,1) - IF (.NOT. ALLOCATED(DstMiscData%ConnectList)) THEN - ALLOCATE(DstMiscData%ConnectList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConnectList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%ConnectList,1), UBOUND(SrcMiscData%ConnectList,1) - CALL MD_Copyconnect( SrcMiscData%ConnectList(i1), DstMiscData%ConnectList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%LineList)) THEN - i1_l = LBOUND(SrcMiscData%LineList,1) - i1_u = UBOUND(SrcMiscData%LineList,1) - IF (.NOT. ALLOCATED(DstMiscData%LineList)) THEN - ALLOCATE(DstMiscData%LineList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%LineList,1), UBOUND(SrcMiscData%LineList,1) - CALL MD_Copyline( SrcMiscData%LineList(i1), DstMiscData%LineList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%FailList)) THEN - i1_l = LBOUND(SrcMiscData%FailList,1) - i1_u = UBOUND(SrcMiscData%FailList,1) - IF (.NOT. ALLOCATED(DstMiscData%FailList)) THEN - ALLOCATE(DstMiscData%FailList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FailList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%FailList,1), UBOUND(SrcMiscData%FailList,1) - CALL MD_Copyfail( SrcMiscData%FailList(i1), DstMiscData%FailList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%FreeConIs)) THEN - i1_l = LBOUND(SrcMiscData%FreeConIs,1) - i1_u = UBOUND(SrcMiscData%FreeConIs,1) - IF (.NOT. ALLOCATED(DstMiscData%FreeConIs)) THEN - ALLOCATE(DstMiscData%FreeConIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeConIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FreeConIs = SrcMiscData%FreeConIs -ENDIF -IF (ALLOCATED(SrcMiscData%CpldConIs)) THEN - i1_l = LBOUND(SrcMiscData%CpldConIs,1) - i1_u = UBOUND(SrcMiscData%CpldConIs,1) - i2_l = LBOUND(SrcMiscData%CpldConIs,2) - i2_u = UBOUND(SrcMiscData%CpldConIs,2) - IF (.NOT. ALLOCATED(DstMiscData%CpldConIs)) THEN - ALLOCATE(DstMiscData%CpldConIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldConIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CpldConIs = SrcMiscData%CpldConIs -ENDIF -IF (ALLOCATED(SrcMiscData%FreeRodIs)) THEN - i1_l = LBOUND(SrcMiscData%FreeRodIs,1) - i1_u = UBOUND(SrcMiscData%FreeRodIs,1) - IF (.NOT. ALLOCATED(DstMiscData%FreeRodIs)) THEN - ALLOCATE(DstMiscData%FreeRodIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs -ENDIF -IF (ALLOCATED(SrcMiscData%CpldRodIs)) THEN - i1_l = LBOUND(SrcMiscData%CpldRodIs,1) - i1_u = UBOUND(SrcMiscData%CpldRodIs,1) - i2_l = LBOUND(SrcMiscData%CpldRodIs,2) - i2_u = UBOUND(SrcMiscData%CpldRodIs,2) - IF (.NOT. ALLOCATED(DstMiscData%CpldRodIs)) THEN - ALLOCATE(DstMiscData%CpldRodIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs -ENDIF -IF (ALLOCATED(SrcMiscData%FreeBodyIs)) THEN - i1_l = LBOUND(SrcMiscData%FreeBodyIs,1) - i1_u = UBOUND(SrcMiscData%FreeBodyIs,1) - IF (.NOT. ALLOCATED(DstMiscData%FreeBodyIs)) THEN - ALLOCATE(DstMiscData%FreeBodyIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs -ENDIF -IF (ALLOCATED(SrcMiscData%CpldBodyIs)) THEN - i1_l = LBOUND(SrcMiscData%CpldBodyIs,1) - i1_u = UBOUND(SrcMiscData%CpldBodyIs,1) - i2_l = LBOUND(SrcMiscData%CpldBodyIs,2) - i2_u = UBOUND(SrcMiscData%CpldBodyIs,2) - IF (.NOT. ALLOCATED(DstMiscData%CpldBodyIs)) THEN - ALLOCATE(DstMiscData%CpldBodyIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs -ENDIF -IF (ALLOCATED(SrcMiscData%LineStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%LineStateIs1,1) - i1_u = UBOUND(SrcMiscData%LineStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%LineStateIs1)) THEN - ALLOCATE(DstMiscData%LineStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%LineStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%LineStateIsN,1) - i1_u = UBOUND(SrcMiscData%LineStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%LineStateIsN)) THEN - ALLOCATE(DstMiscData%LineStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN -ENDIF -IF (ALLOCATED(SrcMiscData%ConStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%ConStateIs1,1) - i1_u = UBOUND(SrcMiscData%ConStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%ConStateIs1)) THEN - ALLOCATE(DstMiscData%ConStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ConStateIs1 = SrcMiscData%ConStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%ConStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%ConStateIsN,1) - i1_u = UBOUND(SrcMiscData%ConStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%ConStateIsN)) THEN - ALLOCATE(DstMiscData%ConStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ConStateIsN = SrcMiscData%ConStateIsN -ENDIF -IF (ALLOCATED(SrcMiscData%RodStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%RodStateIs1,1) - i1_u = UBOUND(SrcMiscData%RodStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%RodStateIs1)) THEN - ALLOCATE(DstMiscData%RodStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%RodStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%RodStateIsN,1) - i1_u = UBOUND(SrcMiscData%RodStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%RodStateIsN)) THEN - ALLOCATE(DstMiscData%RodStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN -ENDIF -IF (ALLOCATED(SrcMiscData%BodyStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%BodyStateIs1,1) - i1_u = UBOUND(SrcMiscData%BodyStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%BodyStateIs1)) THEN - ALLOCATE(DstMiscData%BodyStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%BodyStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%BodyStateIsN,1) - i1_u = UBOUND(SrcMiscData%BodyStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%BodyStateIsN)) THEN - ALLOCATE(DstMiscData%BodyStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN -ENDIF - DstMiscData%Nx = SrcMiscData%Nx - DstMiscData%WaveTi = SrcMiscData%WaveTi - CALL MD_CopyContState( SrcMiscData%xTemp, DstMiscData%xTemp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyContState( SrcMiscData%xdTemp, DstMiscData%xdTemp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%zeros6 = SrcMiscData%zeros6 -IF (ALLOCATED(SrcMiscData%MDWrOutput)) THEN - i1_l = LBOUND(SrcMiscData%MDWrOutput,1) - i1_u = UBOUND(SrcMiscData%MDWrOutput,1) - IF (.NOT. ALLOCATED(DstMiscData%MDWrOutput)) THEN - ALLOCATE(DstMiscData%MDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput -ENDIF - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%PtfmInit = SrcMiscData%PtfmInit -IF (ALLOCATED(SrcMiscData%BathymetryGrid)) THEN - i1_l = LBOUND(SrcMiscData%BathymetryGrid,1) - i1_u = UBOUND(SrcMiscData%BathymetryGrid,1) - i2_l = LBOUND(SrcMiscData%BathymetryGrid,2) - i2_u = UBOUND(SrcMiscData%BathymetryGrid,2) - IF (.NOT. ALLOCATED(DstMiscData%BathymetryGrid)) THEN - ALLOCATE(DstMiscData%BathymetryGrid(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathymetryGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid -ENDIF -IF (ALLOCATED(SrcMiscData%BathGrid_Xs)) THEN - i1_l = LBOUND(SrcMiscData%BathGrid_Xs,1) - i1_u = UBOUND(SrcMiscData%BathGrid_Xs,1) - IF (.NOT. ALLOCATED(DstMiscData%BathGrid_Xs)) THEN - ALLOCATE(DstMiscData%BathGrid_Xs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Xs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs -ENDIF -IF (ALLOCATED(SrcMiscData%BathGrid_Ys)) THEN - i1_l = LBOUND(SrcMiscData%BathGrid_Ys,1) - i1_u = UBOUND(SrcMiscData%BathGrid_Ys,1) - IF (.NOT. ALLOCATED(DstMiscData%BathGrid_Ys)) THEN - ALLOCATE(DstMiscData%BathGrid_Ys(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Ys.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys -ENDIF -IF (ALLOCATED(SrcMiscData%BathGrid_npoints)) THEN - i1_l = LBOUND(SrcMiscData%BathGrid_npoints,1) - i1_u = UBOUND(SrcMiscData%BathGrid_npoints,1) - IF (.NOT. ALLOCATED(DstMiscData%BathGrid_npoints)) THEN - ALLOCATE(DstMiscData%BathGrid_npoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_npoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathGrid_npoints = SrcMiscData%BathGrid_npoints -ENDIF - END SUBROUTINE MD_CopyMisc - - SUBROUTINE MD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(MD_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 = 'MD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%LineTypeList)) THEN -DO i1 = LBOUND(MiscData%LineTypeList,1), UBOUND(MiscData%LineTypeList,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%RodTypeList) -ENDIF - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%FailList) -ENDIF -IF (ALLOCATED(MiscData%FreeConIs)) THEN - DEALLOCATE(MiscData%FreeConIs) -ENDIF -IF (ALLOCATED(MiscData%CpldConIs)) THEN - DEALLOCATE(MiscData%CpldConIs) -ENDIF -IF (ALLOCATED(MiscData%FreeRodIs)) THEN - DEALLOCATE(MiscData%FreeRodIs) -ENDIF -IF (ALLOCATED(MiscData%CpldRodIs)) THEN - DEALLOCATE(MiscData%CpldRodIs) -ENDIF -IF (ALLOCATED(MiscData%FreeBodyIs)) THEN - DEALLOCATE(MiscData%FreeBodyIs) -ENDIF -IF (ALLOCATED(MiscData%CpldBodyIs)) THEN - DEALLOCATE(MiscData%CpldBodyIs) -ENDIF -IF (ALLOCATED(MiscData%LineStateIs1)) THEN - DEALLOCATE(MiscData%LineStateIs1) -ENDIF -IF (ALLOCATED(MiscData%LineStateIsN)) THEN - DEALLOCATE(MiscData%LineStateIsN) -ENDIF -IF (ALLOCATED(MiscData%ConStateIs1)) THEN - DEALLOCATE(MiscData%ConStateIs1) -ENDIF -IF (ALLOCATED(MiscData%ConStateIsN)) THEN - DEALLOCATE(MiscData%ConStateIsN) -ENDIF -IF (ALLOCATED(MiscData%RodStateIs1)) THEN - DEALLOCATE(MiscData%RodStateIs1) -ENDIF -IF (ALLOCATED(MiscData%RodStateIsN)) THEN - DEALLOCATE(MiscData%RodStateIsN) -ENDIF -IF (ALLOCATED(MiscData%BodyStateIs1)) THEN - DEALLOCATE(MiscData%BodyStateIs1) -ENDIF -IF (ALLOCATED(MiscData%BodyStateIsN)) THEN - DEALLOCATE(MiscData%BodyStateIsN) -ENDIF - CALL MD_DestroyContState( MiscData%xTemp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyContState( MiscData%xdTemp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%MDWrOutput)) THEN - DEALLOCATE(MiscData%MDWrOutput) -ENDIF -IF (ALLOCATED(MiscData%BathymetryGrid)) THEN - DEALLOCATE(MiscData%BathymetryGrid) -ENDIF -IF (ALLOCATED(MiscData%BathGrid_Xs)) THEN - DEALLOCATE(MiscData%BathGrid_Xs) -ENDIF -IF (ALLOCATED(MiscData%BathGrid_Ys)) THEN - DEALLOCATE(MiscData%BathGrid_Ys) -ENDIF -IF (ALLOCATED(MiscData%BathGrid_npoints)) THEN - DEALLOCATE(MiscData%BathGrid_npoints) -ENDIF - END SUBROUTINE MD_DestroyMisc - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! LineTypeList allocated yes/no - IF ( ALLOCATED(InData%LineTypeList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineTypeList upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LineTypeList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LineTypeList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LineTypeList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! RodTypeList allocated yes/no - IF ( ALLOCATED(InData%RodTypeList) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RodTypeList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RodTypeList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RodTypeList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! GroundBody - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! GroundBody - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! GroundBody - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BodyList allocated yes/no - IF ( ALLOCATED(InData%BodyList) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BodyList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BodyList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BodyList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! RodList allocated yes/no - IF ( ALLOCATED(InData%RodList) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RodList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RodList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RodList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ConnectList allocated yes/no - IF ( ALLOCATED(InData%ConnectList) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ConnectList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ConnectList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ConnectList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! LineList allocated yes/no - IF ( ALLOCATED(InData%LineList) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LineList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LineList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LineList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FailList allocated yes/no - IF ( ALLOCATED(InData%FailList) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FailList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FailList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FailList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FreeConIs allocated yes/no - IF ( ALLOCATED(InData%FreeConIs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreeConIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FreeConIs) ! FreeConIs - END IF - Int_BufSz = Int_BufSz + 1 ! CpldConIs allocated yes/no - IF ( ALLOCATED(InData%CpldConIs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CpldConIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CpldConIs) ! CpldConIs - END IF - Int_BufSz = Int_BufSz + 1 ! FreeRodIs allocated yes/no - IF ( ALLOCATED(InData%FreeRodIs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreeRodIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FreeRodIs) ! FreeRodIs - END IF - Int_BufSz = Int_BufSz + 1 ! CpldRodIs allocated yes/no - IF ( ALLOCATED(InData%CpldRodIs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CpldRodIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CpldRodIs) ! CpldRodIs - END IF - Int_BufSz = Int_BufSz + 1 ! FreeBodyIs allocated yes/no - IF ( ALLOCATED(InData%FreeBodyIs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreeBodyIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FreeBodyIs) ! FreeBodyIs - END IF - Int_BufSz = Int_BufSz + 1 ! CpldBodyIs allocated yes/no - IF ( ALLOCATED(InData%CpldBodyIs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CpldBodyIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CpldBodyIs) ! CpldBodyIs - END IF - Int_BufSz = Int_BufSz + 1 ! LineStateIs1 allocated yes/no - IF ( ALLOCATED(InData%LineStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LineStateIs1) ! LineStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! LineStateIsN allocated yes/no - IF ( ALLOCATED(InData%LineStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LineStateIsN) ! LineStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! ConStateIs1 allocated yes/no - IF ( ALLOCATED(InData%ConStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ConStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ConStateIs1) ! ConStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! ConStateIsN allocated yes/no - IF ( ALLOCATED(InData%ConStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ConStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ConStateIsN) ! ConStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! RodStateIs1 allocated yes/no - IF ( ALLOCATED(InData%RodStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RodStateIs1) ! RodStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! RodStateIsN allocated yes/no - IF ( ALLOCATED(InData%RodStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RodStateIsN) ! RodStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! BodyStateIs1 allocated yes/no - IF ( ALLOCATED(InData%BodyStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BodyStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BodyStateIs1) ! BodyStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! BodyStateIsN allocated yes/no - IF ( ALLOCATED(InData%BodyStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BodyStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BodyStateIsN) ! BodyStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! Nx - Int_BufSz = Int_BufSz + 1 ! WaveTi - Int_BufSz = Int_BufSz + 3 ! xTemp: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xTemp, ErrStat2, ErrMsg2, .TRUE. ) ! xTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xTemp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xTemp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xTemp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xdTemp: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdTemp, ErrStat2, ErrMsg2, .TRUE. ) ! xdTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdTemp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdTemp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdTemp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + SIZE(InData%zeros6) ! zeros6 - Int_BufSz = Int_BufSz + 1 ! MDWrOutput allocated yes/no - IF ( ALLOCATED(InData%MDWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MDWrOutput upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MDWrOutput) ! MDWrOutput - END IF - Db_BufSz = Db_BufSz + 1 ! LastOutTime - Re_BufSz = Re_BufSz + SIZE(InData%PtfmInit) ! PtfmInit - Int_BufSz = Int_BufSz + 1 ! BathymetryGrid allocated yes/no - IF ( ALLOCATED(InData%BathymetryGrid) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BathymetryGrid upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BathymetryGrid) ! BathymetryGrid - END IF - Int_BufSz = Int_BufSz + 1 ! BathGrid_Xs allocated yes/no - IF ( ALLOCATED(InData%BathGrid_Xs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BathGrid_Xs upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BathGrid_Xs) ! BathGrid_Xs - END IF - Int_BufSz = Int_BufSz + 1 ! BathGrid_Ys allocated yes/no - IF ( ALLOCATED(InData%BathGrid_Ys) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BathGrid_Ys upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BathGrid_Ys) ! BathGrid_Ys - END IF - Int_BufSz = Int_BufSz + 1 ! BathGrid_npoints allocated yes/no - IF ( ALLOCATED(InData%BathGrid_npoints) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BathGrid_npoints upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BathGrid_npoints) ! BathGrid_npoints - 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%LineTypeList) ) 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%LineTypeList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineTypeList,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%RodTypeList) ) 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%RodTypeList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodTypeList,1) - 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 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%BodyList) ) 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%BodyList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BodyList,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%RodList) ) 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%RodList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodList,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%ConnectList) ) 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%ConnectList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConnectList,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%LineList) ) 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%LineList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineList,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%FailList) ) 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%FailList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FailList,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%FreeConIs) ) 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%FreeConIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreeConIs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FreeConIs,1), UBOUND(InData%FreeConIs,1) - IntKiBuf(Int_Xferred) = InData%FreeConIs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CpldConIs) ) 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%CpldConIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldConIs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldConIs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldConIs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CpldConIs,2), UBOUND(InData%CpldConIs,2) - DO i1 = LBOUND(InData%CpldConIs,1), UBOUND(InData%CpldConIs,1) - IntKiBuf(Int_Xferred) = InData%CpldConIs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreeRodIs) ) 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%FreeRodIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreeRodIs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FreeRodIs,1), UBOUND(InData%FreeRodIs,1) - IntKiBuf(Int_Xferred) = InData%FreeRodIs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CpldRodIs) ) 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%CpldRodIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldRodIs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldRodIs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldRodIs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CpldRodIs,2), UBOUND(InData%CpldRodIs,2) - DO i1 = LBOUND(InData%CpldRodIs,1), UBOUND(InData%CpldRodIs,1) - IntKiBuf(Int_Xferred) = InData%CpldRodIs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreeBodyIs) ) 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%FreeBodyIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreeBodyIs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FreeBodyIs,1), UBOUND(InData%FreeBodyIs,1) - IntKiBuf(Int_Xferred) = InData%FreeBodyIs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CpldBodyIs) ) 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%CpldBodyIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldBodyIs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldBodyIs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldBodyIs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CpldBodyIs,2), UBOUND(InData%CpldBodyIs,2) - DO i1 = LBOUND(InData%CpldBodyIs,1), UBOUND(InData%CpldBodyIs,1) - IntKiBuf(Int_Xferred) = InData%CpldBodyIs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineStateIs1) ) 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%LineStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineStateIs1,1), UBOUND(InData%LineStateIs1,1) - IntKiBuf(Int_Xferred) = InData%LineStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineStateIsN) ) 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%LineStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineStateIsN,1), UBOUND(InData%LineStateIsN,1) - IntKiBuf(Int_Xferred) = InData%LineStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ConStateIs1) ) 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%ConStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ConStateIs1,1), UBOUND(InData%ConStateIs1,1) - IntKiBuf(Int_Xferred) = InData%ConStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ConStateIsN) ) 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%ConStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ConStateIsN,1), UBOUND(InData%ConStateIsN,1) - IntKiBuf(Int_Xferred) = InData%ConStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RodStateIs1) ) 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%RodStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodStateIs1,1), UBOUND(InData%RodStateIs1,1) - IntKiBuf(Int_Xferred) = InData%RodStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RodStateIsN) ) 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%RodStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodStateIsN,1), UBOUND(InData%RodStateIsN,1) - IntKiBuf(Int_Xferred) = InData%RodStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BodyStateIs1) ) 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%BodyStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BodyStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BodyStateIs1,1), UBOUND(InData%BodyStateIs1,1) - IntKiBuf(Int_Xferred) = InData%BodyStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BodyStateIsN) ) 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%BodyStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BodyStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BodyStateIsN,1), UBOUND(InData%BodyStateIsN,1) - IntKiBuf(Int_Xferred) = InData%BodyStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveTi - Int_Xferred = Int_Xferred + 1 - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xTemp, ErrStat2, ErrMsg2, OnlySize ) ! xTemp - 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 - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdTemp, ErrStat2, ErrMsg2, OnlySize ) ! xdTemp - 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 - DO i1 = LBOUND(InData%zeros6,1), UBOUND(InData%zeros6,1) - DbKiBuf(Db_Xferred) = InData%zeros6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%MDWrOutput) ) 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%MDWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MDWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MDWrOutput,1), UBOUND(InData%MDWrOutput,1) - DbKiBuf(Db_Xferred) = InData%MDWrOutput(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) - ReKiBuf(Re_Xferred) = InData%PtfmInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%BathymetryGrid) ) 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%BathymetryGrid,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathymetryGrid,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathymetryGrid,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathymetryGrid,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BathymetryGrid,2), UBOUND(InData%BathymetryGrid,2) - DO i1 = LBOUND(InData%BathymetryGrid,1), UBOUND(InData%BathymetryGrid,1) - DbKiBuf(Db_Xferred) = InData%BathymetryGrid(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BathGrid_Xs) ) 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%BathGrid_Xs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathGrid_Xs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BathGrid_Xs,1), UBOUND(InData%BathGrid_Xs,1) - DbKiBuf(Db_Xferred) = InData%BathGrid_Xs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BathGrid_Ys) ) 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%BathGrid_Ys,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathGrid_Ys,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BathGrid_Ys,1), UBOUND(InData%BathGrid_Ys,1) - DbKiBuf(Db_Xferred) = InData%BathGrid_Ys(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BathGrid_npoints) ) 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%BathGrid_npoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathGrid_npoints,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BathGrid_npoints,1), UBOUND(InData%BathGrid_npoints,1) - IntKiBuf(Int_Xferred) = InData%BathGrid_npoints(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackMisc - - SUBROUTINE MD_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(MD_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) :: 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 = 'MD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineTypeList 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%LineTypeList)) DEALLOCATE(OutData%LineTypeList) - ALLOCATE(OutData%LineTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineTypeList,1), UBOUND(OutData%LineTypeList,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 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 - - 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 ! RodTypeList 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%RodTypeList)) DEALLOCATE(OutData%RodTypeList) - ALLOCATE(OutData%RodTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodTypeList,1), UBOUND(OutData%RodTypeList,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 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 - - 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 - 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 MD_UnpackBody( Re_Buf, Db_Buf, Int_Buf, OutData%GroundBody, ErrStat2, ErrMsg2 ) ! GroundBody - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BodyList 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%BodyList)) DEALLOCATE(OutData%BodyList) - ALLOCATE(OutData%BodyList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BodyList,1), UBOUND(OutData%BodyList,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 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 - - 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 ! RodList 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%RodList)) DEALLOCATE(OutData%RodList) - ALLOCATE(OutData%RodList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodList,1), UBOUND(OutData%RodList,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 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 - - 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 ! ConnectList 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%ConnectList)) DEALLOCATE(OutData%ConnectList) - ALLOCATE(OutData%ConnectList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConnectList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ConnectList,1), UBOUND(OutData%ConnectList,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 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 - - 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 ! LineList 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%LineList)) DEALLOCATE(OutData%LineList) - ALLOCATE(OutData%LineList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineList,1), UBOUND(OutData%LineList,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 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 - - 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 ! FailList 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%FailList)) DEALLOCATE(OutData%FailList) - ALLOCATE(OutData%FailList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FailList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FailList,1), UBOUND(OutData%FailList,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 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 - - 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 ! FreeConIs 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%FreeConIs)) DEALLOCATE(OutData%FreeConIs) - ALLOCATE(OutData%FreeConIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeConIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FreeConIs,1), UBOUND(OutData%FreeConIs,1) - OutData%FreeConIs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldConIs 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%CpldConIs)) DEALLOCATE(OutData%CpldConIs) - ALLOCATE(OutData%CpldConIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldConIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CpldConIs,2), UBOUND(OutData%CpldConIs,2) - DO i1 = LBOUND(OutData%CpldConIs,1), UBOUND(OutData%CpldConIs,1) - OutData%CpldConIs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreeRodIs 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%FreeRodIs)) DEALLOCATE(OutData%FreeRodIs) - ALLOCATE(OutData%FreeRodIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FreeRodIs,1), UBOUND(OutData%FreeRodIs,1) - OutData%FreeRodIs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldRodIs 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%CpldRodIs)) DEALLOCATE(OutData%CpldRodIs) - ALLOCATE(OutData%CpldRodIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CpldRodIs,2), UBOUND(OutData%CpldRodIs,2) - DO i1 = LBOUND(OutData%CpldRodIs,1), UBOUND(OutData%CpldRodIs,1) - OutData%CpldRodIs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreeBodyIs 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%FreeBodyIs)) DEALLOCATE(OutData%FreeBodyIs) - ALLOCATE(OutData%FreeBodyIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FreeBodyIs,1), UBOUND(OutData%FreeBodyIs,1) - OutData%FreeBodyIs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldBodyIs 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%CpldBodyIs)) DEALLOCATE(OutData%CpldBodyIs) - ALLOCATE(OutData%CpldBodyIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CpldBodyIs,2), UBOUND(OutData%CpldBodyIs,2) - DO i1 = LBOUND(OutData%CpldBodyIs,1), UBOUND(OutData%CpldBodyIs,1) - OutData%CpldBodyIs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineStateIs1 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%LineStateIs1)) DEALLOCATE(OutData%LineStateIs1) - ALLOCATE(OutData%LineStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineStateIs1,1), UBOUND(OutData%LineStateIs1,1) - OutData%LineStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineStateIsN 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%LineStateIsN)) DEALLOCATE(OutData%LineStateIsN) - ALLOCATE(OutData%LineStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineStateIsN,1), UBOUND(OutData%LineStateIsN,1) - OutData%LineStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ConStateIs1 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%ConStateIs1)) DEALLOCATE(OutData%ConStateIs1) - ALLOCATE(OutData%ConStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ConStateIs1,1), UBOUND(OutData%ConStateIs1,1) - OutData%ConStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ConStateIsN 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%ConStateIsN)) DEALLOCATE(OutData%ConStateIsN) - ALLOCATE(OutData%ConStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ConStateIsN,1), UBOUND(OutData%ConStateIsN,1) - OutData%ConStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodStateIs1 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%RodStateIs1)) DEALLOCATE(OutData%RodStateIs1) - ALLOCATE(OutData%RodStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodStateIs1,1), UBOUND(OutData%RodStateIs1,1) - OutData%RodStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodStateIsN 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%RodStateIsN)) DEALLOCATE(OutData%RodStateIsN) - ALLOCATE(OutData%RodStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodStateIsN,1), UBOUND(OutData%RodStateIsN,1) - OutData%RodStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BodyStateIs1 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%BodyStateIs1)) DEALLOCATE(OutData%BodyStateIs1) - ALLOCATE(OutData%BodyStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BodyStateIs1,1), UBOUND(OutData%BodyStateIs1,1) - OutData%BodyStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BodyStateIsN 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%BodyStateIsN)) DEALLOCATE(OutData%BodyStateIsN) - ALLOCATE(OutData%BodyStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BodyStateIsN,1), UBOUND(OutData%BodyStateIsN,1) - OutData%BodyStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%Nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveTi = 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 MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xTemp, ErrStat2, ErrMsg2 ) ! xTemp - 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) - 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 MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdTemp, ErrStat2, ErrMsg2 ) ! xdTemp - 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) - i1_l = LBOUND(OutData%zeros6,1) - i1_u = UBOUND(OutData%zeros6,1) - DO i1 = LBOUND(OutData%zeros6,1), UBOUND(OutData%zeros6,1) - OutData%zeros6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MDWrOutput 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%MDWrOutput)) DEALLOCATE(OutData%MDWrOutput) - ALLOCATE(OutData%MDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MDWrOutput,1), UBOUND(OutData%MDWrOutput,1) - OutData%MDWrOutput(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%LastOutTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%PtfmInit,1) - i1_u = UBOUND(OutData%PtfmInit,1) - DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) - OutData%PtfmInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathymetryGrid 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%BathymetryGrid)) DEALLOCATE(OutData%BathymetryGrid) - ALLOCATE(OutData%BathymetryGrid(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathymetryGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BathymetryGrid,2), UBOUND(OutData%BathymetryGrid,2) - DO i1 = LBOUND(OutData%BathymetryGrid,1), UBOUND(OutData%BathymetryGrid,1) - OutData%BathymetryGrid(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathGrid_Xs 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%BathGrid_Xs)) DEALLOCATE(OutData%BathGrid_Xs) - ALLOCATE(OutData%BathGrid_Xs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Xs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BathGrid_Xs,1), UBOUND(OutData%BathGrid_Xs,1) - OutData%BathGrid_Xs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathGrid_Ys 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%BathGrid_Ys)) DEALLOCATE(OutData%BathGrid_Ys) - ALLOCATE(OutData%BathGrid_Ys(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Ys.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BathGrid_Ys,1), UBOUND(OutData%BathGrid_Ys,1) - OutData%BathGrid_Ys(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathGrid_npoints 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%BathGrid_npoints)) DEALLOCATE(OutData%BathGrid_npoints) - ALLOCATE(OutData%BathGrid_npoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_npoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BathGrid_npoints,1), UBOUND(OutData%BathGrid_npoints,1) - OutData%BathGrid_npoints(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackMisc - SUBROUTINE MD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(MD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyParam' -! +subroutine MD_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(MD_InputFileType), intent(in) :: SrcInputFileTypeData + type(MD_InputFileType), intent(inout) :: DstInputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyInputFileType' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%nLineTypes = SrcParamData%nLineTypes - DstParamData%nRodTypes = SrcParamData%nRodTypes - DstParamData%nConnects = SrcParamData%nConnects - DstParamData%nConnectsExtra = SrcParamData%nConnectsExtra - DstParamData%nBodies = SrcParamData%nBodies - DstParamData%nRods = SrcParamData%nRods - DstParamData%nLines = SrcParamData%nLines - DstParamData%nCtrlChans = SrcParamData%nCtrlChans - DstParamData%nFails = SrcParamData%nFails - DstParamData%nFreeBodies = SrcParamData%nFreeBodies - DstParamData%nFreeRods = SrcParamData%nFreeRods - DstParamData%nFreeCons = SrcParamData%nFreeCons -IF (ALLOCATED(SrcParamData%nCpldBodies)) THEN - i1_l = LBOUND(SrcParamData%nCpldBodies,1) - i1_u = UBOUND(SrcParamData%nCpldBodies,1) - IF (.NOT. ALLOCATED(DstParamData%nCpldBodies)) THEN - ALLOCATE(DstParamData%nCpldBodies(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldBodies.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%nCpldBodies = SrcParamData%nCpldBodies -ENDIF -IF (ALLOCATED(SrcParamData%nCpldRods)) THEN - i1_l = LBOUND(SrcParamData%nCpldRods,1) - i1_u = UBOUND(SrcParamData%nCpldRods,1) - IF (.NOT. ALLOCATED(DstParamData%nCpldRods)) THEN - ALLOCATE(DstParamData%nCpldRods(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldRods.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%nCpldRods = SrcParamData%nCpldRods -ENDIF -IF (ALLOCATED(SrcParamData%nCpldCons)) THEN - i1_l = LBOUND(SrcParamData%nCpldCons,1) - i1_u = UBOUND(SrcParamData%nCpldCons,1) - IF (.NOT. ALLOCATED(DstParamData%nCpldCons)) THEN - ALLOCATE(DstParamData%nCpldCons(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldCons.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%nCpldCons = SrcParamData%nCpldCons -ENDIF - DstParamData%NConns = SrcParamData%NConns - DstParamData%NAnchs = SrcParamData%NAnchs - DstParamData%Tmax = SrcParamData%Tmax - DstParamData%g = SrcParamData%g - DstParamData%rhoW = SrcParamData%rhoW - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%kBot = SrcParamData%kBot - DstParamData%cBot = SrcParamData%cBot - DstParamData%dtM0 = SrcParamData%dtM0 - DstParamData%dtCoupling = SrcParamData%dtCoupling - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%dtOut = SrcParamData%dtOut - DstParamData%RootName = SrcParamData%RootName -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 MD_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%Delim = SrcParamData%Delim - DstParamData%MDUnOut = SrcParamData%MDUnOut - DstParamData%PriPath = SrcParamData%PriPath - DstParamData%writeLog = SrcParamData%writeLog - DstParamData%UnLog = SrcParamData%UnLog - DstParamData%WaveKin = SrcParamData%WaveKin - DstParamData%Current = SrcParamData%Current - DstParamData%nTurbines = SrcParamData%nTurbines -IF (ALLOCATED(SrcParamData%TurbineRefPos)) THEN - i1_l = LBOUND(SrcParamData%TurbineRefPos,1) - i1_u = UBOUND(SrcParamData%TurbineRefPos,1) - i2_l = LBOUND(SrcParamData%TurbineRefPos,2) - i2_u = UBOUND(SrcParamData%TurbineRefPos,2) - IF (.NOT. ALLOCATED(DstParamData%TurbineRefPos)) THEN - ALLOCATE(DstParamData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TurbineRefPos = SrcParamData%TurbineRefPos -ENDIF - DstParamData%mu_kT = SrcParamData%mu_kT - DstParamData%mu_kA = SrcParamData%mu_kA - DstParamData%mc = SrcParamData%mc - DstParamData%cv = SrcParamData%cv - DstParamData%nxWave = SrcParamData%nxWave - DstParamData%nyWave = SrcParamData%nyWave - DstParamData%nzWave = SrcParamData%nzWave - DstParamData%ntWave = SrcParamData%ntWave -IF (ALLOCATED(SrcParamData%pxWave)) THEN - i1_l = LBOUND(SrcParamData%pxWave,1) - i1_u = UBOUND(SrcParamData%pxWave,1) - IF (.NOT. ALLOCATED(DstParamData%pxWave)) THEN - ALLOCATE(DstParamData%pxWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pxWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%pxWave = SrcParamData%pxWave -ENDIF -IF (ALLOCATED(SrcParamData%pyWave)) THEN - i1_l = LBOUND(SrcParamData%pyWave,1) - i1_u = UBOUND(SrcParamData%pyWave,1) - IF (.NOT. ALLOCATED(DstParamData%pyWave)) THEN - ALLOCATE(DstParamData%pyWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pyWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%pyWave = SrcParamData%pyWave -ENDIF -IF (ALLOCATED(SrcParamData%pzWave)) THEN - i1_l = LBOUND(SrcParamData%pzWave,1) - i1_u = UBOUND(SrcParamData%pzWave,1) - IF (.NOT. ALLOCATED(DstParamData%pzWave)) THEN - ALLOCATE(DstParamData%pzWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%pzWave = SrcParamData%pzWave -ENDIF - DstParamData%dtWave = SrcParamData%dtWave -IF (ALLOCATED(SrcParamData%uxWave)) THEN - i1_l = LBOUND(SrcParamData%uxWave,1) - i1_u = UBOUND(SrcParamData%uxWave,1) - i2_l = LBOUND(SrcParamData%uxWave,2) - i2_u = UBOUND(SrcParamData%uxWave,2) - i3_l = LBOUND(SrcParamData%uxWave,3) - i3_u = UBOUND(SrcParamData%uxWave,3) - i4_l = LBOUND(SrcParamData%uxWave,4) - i4_u = UBOUND(SrcParamData%uxWave,4) - IF (.NOT. ALLOCATED(DstParamData%uxWave)) THEN - ALLOCATE(DstParamData%uxWave(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%uxWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uxWave = SrcParamData%uxWave -ENDIF -IF (ALLOCATED(SrcParamData%uyWave)) THEN - i1_l = LBOUND(SrcParamData%uyWave,1) - i1_u = UBOUND(SrcParamData%uyWave,1) - i2_l = LBOUND(SrcParamData%uyWave,2) - i2_u = UBOUND(SrcParamData%uyWave,2) - i3_l = LBOUND(SrcParamData%uyWave,3) - i3_u = UBOUND(SrcParamData%uyWave,3) - i4_l = LBOUND(SrcParamData%uyWave,4) - i4_u = UBOUND(SrcParamData%uyWave,4) - IF (.NOT. ALLOCATED(DstParamData%uyWave)) THEN - ALLOCATE(DstParamData%uyWave(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%uyWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uyWave = SrcParamData%uyWave -ENDIF -IF (ALLOCATED(SrcParamData%uzWave)) THEN - i1_l = LBOUND(SrcParamData%uzWave,1) - i1_u = UBOUND(SrcParamData%uzWave,1) - i2_l = LBOUND(SrcParamData%uzWave,2) - i2_u = UBOUND(SrcParamData%uzWave,2) - i3_l = LBOUND(SrcParamData%uzWave,3) - i3_u = UBOUND(SrcParamData%uzWave,3) - i4_l = LBOUND(SrcParamData%uzWave,4) - i4_u = UBOUND(SrcParamData%uzWave,4) - IF (.NOT. ALLOCATED(DstParamData%uzWave)) THEN - ALLOCATE(DstParamData%uzWave(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%uzWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uzWave = SrcParamData%uzWave -ENDIF -IF (ALLOCATED(SrcParamData%axWave)) THEN - i1_l = LBOUND(SrcParamData%axWave,1) - i1_u = UBOUND(SrcParamData%axWave,1) - i2_l = LBOUND(SrcParamData%axWave,2) - i2_u = UBOUND(SrcParamData%axWave,2) - i3_l = LBOUND(SrcParamData%axWave,3) - i3_u = UBOUND(SrcParamData%axWave,3) - i4_l = LBOUND(SrcParamData%axWave,4) - i4_u = UBOUND(SrcParamData%axWave,4) - IF (.NOT. ALLOCATED(DstParamData%axWave)) THEN - ALLOCATE(DstParamData%axWave(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%axWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%axWave = SrcParamData%axWave -ENDIF -IF (ALLOCATED(SrcParamData%ayWave)) THEN - i1_l = LBOUND(SrcParamData%ayWave,1) - i1_u = UBOUND(SrcParamData%ayWave,1) - i2_l = LBOUND(SrcParamData%ayWave,2) - i2_u = UBOUND(SrcParamData%ayWave,2) - i3_l = LBOUND(SrcParamData%ayWave,3) - i3_u = UBOUND(SrcParamData%ayWave,3) - i4_l = LBOUND(SrcParamData%ayWave,4) - i4_u = UBOUND(SrcParamData%ayWave,4) - IF (.NOT. ALLOCATED(DstParamData%ayWave)) THEN - ALLOCATE(DstParamData%ayWave(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%ayWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ayWave = SrcParamData%ayWave -ENDIF -IF (ALLOCATED(SrcParamData%azWave)) THEN - i1_l = LBOUND(SrcParamData%azWave,1) - i1_u = UBOUND(SrcParamData%azWave,1) - i2_l = LBOUND(SrcParamData%azWave,2) - i2_u = UBOUND(SrcParamData%azWave,2) - i3_l = LBOUND(SrcParamData%azWave,3) - i3_u = UBOUND(SrcParamData%azWave,3) - i4_l = LBOUND(SrcParamData%azWave,4) - i4_u = UBOUND(SrcParamData%azWave,4) - IF (.NOT. ALLOCATED(DstParamData%azWave)) THEN - ALLOCATE(DstParamData%azWave(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%azWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%azWave = SrcParamData%azWave -ENDIF -IF (ALLOCATED(SrcParamData%PDyn)) THEN - i1_l = LBOUND(SrcParamData%PDyn,1) - i1_u = UBOUND(SrcParamData%PDyn,1) - i2_l = LBOUND(SrcParamData%PDyn,2) - i2_u = UBOUND(SrcParamData%PDyn,2) - i3_l = LBOUND(SrcParamData%PDyn,3) - i3_u = UBOUND(SrcParamData%PDyn,3) - i4_l = LBOUND(SrcParamData%PDyn,4) - i4_u = UBOUND(SrcParamData%PDyn,4) - IF (.NOT. ALLOCATED(DstParamData%PDyn)) THEN - ALLOCATE(DstParamData%PDyn(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%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PDyn = SrcParamData%PDyn -ENDIF -IF (ALLOCATED(SrcParamData%zeta)) THEN - i1_l = LBOUND(SrcParamData%zeta,1) - i1_u = UBOUND(SrcParamData%zeta,1) - i2_l = LBOUND(SrcParamData%zeta,2) - i2_u = UBOUND(SrcParamData%zeta,2) - i3_l = LBOUND(SrcParamData%zeta,3) - i3_u = UBOUND(SrcParamData%zeta,3) - IF (.NOT. ALLOCATED(DstParamData%zeta)) THEN - ALLOCATE(DstParamData%zeta(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%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%zeta = SrcParamData%zeta -ENDIF - DstParamData%nzCurrent = SrcParamData%nzCurrent -IF (ALLOCATED(SrcParamData%pzCurrent)) THEN - i1_l = LBOUND(SrcParamData%pzCurrent,1) - i1_u = UBOUND(SrcParamData%pzCurrent,1) - IF (.NOT. ALLOCATED(DstParamData%pzCurrent)) THEN - ALLOCATE(DstParamData%pzCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%pzCurrent = SrcParamData%pzCurrent -ENDIF -IF (ALLOCATED(SrcParamData%uxCurrent)) THEN - i1_l = LBOUND(SrcParamData%uxCurrent,1) - i1_u = UBOUND(SrcParamData%uxCurrent,1) - IF (.NOT. ALLOCATED(DstParamData%uxCurrent)) THEN - ALLOCATE(DstParamData%uxCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uxCurrent = SrcParamData%uxCurrent -ENDIF -IF (ALLOCATED(SrcParamData%uyCurrent)) THEN - i1_l = LBOUND(SrcParamData%uyCurrent,1) - i1_u = UBOUND(SrcParamData%uyCurrent,1) - IF (.NOT. ALLOCATED(DstParamData%uyCurrent)) THEN - ALLOCATE(DstParamData%uyCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uyCurrent = SrcParamData%uyCurrent -ENDIF - DstParamData%Nx0 = SrcParamData%Nx0 -IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_u_indx,1) - i1_u = UBOUND(SrcParamData%Jac_u_indx,1) - i2_l = LBOUND(SrcParamData%Jac_u_indx,2) - i2_u = UBOUND(SrcParamData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN - ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcParamData%du)) THEN - i1_l = LBOUND(SrcParamData%du,1) - i1_u = UBOUND(SrcParamData%du,1) - IF (.NOT. ALLOCATED(DstParamData%du)) THEN - ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%du = SrcParamData%du -ENDIF -IF (ALLOCATED(SrcParamData%dx)) THEN - i1_l = LBOUND(SrcParamData%dx,1) - i1_u = UBOUND(SrcParamData%dx,1) - IF (.NOT. ALLOCATED(DstParamData%dx)) THEN - ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dx = SrcParamData%dx -ENDIF - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx -IF (ALLOCATED(SrcParamData%dxIdx_map2_xStateIdx)) THEN - i1_l = LBOUND(SrcParamData%dxIdx_map2_xStateIdx,1) - i1_u = UBOUND(SrcParamData%dxIdx_map2_xStateIdx,1) - IF (.NOT. ALLOCATED(DstParamData%dxIdx_map2_xStateIdx)) THEN - ALLOCATE(DstParamData%dxIdx_map2_xStateIdx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dxIdx_map2_xStateIdx = SrcParamData%dxIdx_map2_xStateIdx -ENDIF - END SUBROUTINE MD_CopyParam - - SUBROUTINE MD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(MD_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 = 'MD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%nCpldBodies)) THEN - DEALLOCATE(ParamData%nCpldBodies) -ENDIF -IF (ALLOCATED(ParamData%nCpldRods)) THEN - DEALLOCATE(ParamData%nCpldRods) -ENDIF -IF (ALLOCATED(ParamData%nCpldCons)) THEN - DEALLOCATE(ParamData%nCpldCons) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL MD_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%TurbineRefPos)) THEN - DEALLOCATE(ParamData%TurbineRefPos) -ENDIF -IF (ALLOCATED(ParamData%pxWave)) THEN - DEALLOCATE(ParamData%pxWave) -ENDIF -IF (ALLOCATED(ParamData%pyWave)) THEN - DEALLOCATE(ParamData%pyWave) -ENDIF -IF (ALLOCATED(ParamData%pzWave)) THEN - DEALLOCATE(ParamData%pzWave) -ENDIF -IF (ALLOCATED(ParamData%uxWave)) THEN - DEALLOCATE(ParamData%uxWave) -ENDIF -IF (ALLOCATED(ParamData%uyWave)) THEN - DEALLOCATE(ParamData%uyWave) -ENDIF -IF (ALLOCATED(ParamData%uzWave)) THEN - DEALLOCATE(ParamData%uzWave) -ENDIF -IF (ALLOCATED(ParamData%axWave)) THEN - DEALLOCATE(ParamData%axWave) -ENDIF -IF (ALLOCATED(ParamData%ayWave)) THEN - DEALLOCATE(ParamData%ayWave) -ENDIF -IF (ALLOCATED(ParamData%azWave)) THEN - DEALLOCATE(ParamData%azWave) -ENDIF -IF (ALLOCATED(ParamData%PDyn)) THEN - DEALLOCATE(ParamData%PDyn) -ENDIF -IF (ALLOCATED(ParamData%zeta)) THEN - DEALLOCATE(ParamData%zeta) -ENDIF -IF (ALLOCATED(ParamData%pzCurrent)) THEN - DEALLOCATE(ParamData%pzCurrent) -ENDIF -IF (ALLOCATED(ParamData%uxCurrent)) THEN - DEALLOCATE(ParamData%uxCurrent) -ENDIF -IF (ALLOCATED(ParamData%uyCurrent)) THEN - DEALLOCATE(ParamData%uyCurrent) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF -IF (ALLOCATED(ParamData%dx)) THEN - DEALLOCATE(ParamData%dx) -ENDIF -IF (ALLOCATED(ParamData%dxIdx_map2_xStateIdx)) THEN - DEALLOCATE(ParamData%dxIdx_map2_xStateIdx) -ENDIF - END SUBROUTINE MD_DestroyParam - - SUBROUTINE MD_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(MD_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 = 'MD_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 - Int_BufSz = Int_BufSz + 1 ! nLineTypes - Int_BufSz = Int_BufSz + 1 ! nRodTypes - Int_BufSz = Int_BufSz + 1 ! nConnects - Int_BufSz = Int_BufSz + 1 ! nConnectsExtra - Int_BufSz = Int_BufSz + 1 ! nBodies - Int_BufSz = Int_BufSz + 1 ! nRods - Int_BufSz = Int_BufSz + 1 ! nLines - Int_BufSz = Int_BufSz + 1 ! nCtrlChans - Int_BufSz = Int_BufSz + 1 ! nFails - Int_BufSz = Int_BufSz + 1 ! nFreeBodies - Int_BufSz = Int_BufSz + 1 ! nFreeRods - Int_BufSz = Int_BufSz + 1 ! nFreeCons - Int_BufSz = Int_BufSz + 1 ! nCpldBodies allocated yes/no - IF ( ALLOCATED(InData%nCpldBodies) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nCpldBodies upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nCpldBodies) ! nCpldBodies - END IF - Int_BufSz = Int_BufSz + 1 ! nCpldRods allocated yes/no - IF ( ALLOCATED(InData%nCpldRods) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nCpldRods upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nCpldRods) ! nCpldRods - END IF - Int_BufSz = Int_BufSz + 1 ! nCpldCons allocated yes/no - IF ( ALLOCATED(InData%nCpldCons) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nCpldCons upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nCpldCons) ! nCpldCons - END IF - Int_BufSz = Int_BufSz + 1 ! NConns - Int_BufSz = Int_BufSz + 1 ! NAnchs - Db_BufSz = Db_BufSz + 1 ! Tmax - Db_BufSz = Db_BufSz + 1 ! g - Db_BufSz = Db_BufSz + 1 ! rhoW - Db_BufSz = Db_BufSz + 1 ! WtrDpth - Db_BufSz = Db_BufSz + 1 ! kBot - Db_BufSz = Db_BufSz + 1 ! cBot - Db_BufSz = Db_BufSz + 1 ! dtM0 - Db_BufSz = Db_BufSz + 1 ! dtCoupling - Int_BufSz = Int_BufSz + 1 ! NumOuts - Db_BufSz = Db_BufSz + 1 ! dtOut - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - 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 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 - - 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*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! MDUnOut - Int_BufSz = Int_BufSz + 1*LEN(InData%PriPath) ! PriPath - Int_BufSz = Int_BufSz + 1 ! writeLog - Int_BufSz = Int_BufSz + 1 ! UnLog - Int_BufSz = Int_BufSz + 1 ! WaveKin - Int_BufSz = Int_BufSz + 1 ! Current - Int_BufSz = Int_BufSz + 1 ! nTurbines - Int_BufSz = Int_BufSz + 1 ! TurbineRefPos allocated yes/no - IF ( ALLOCATED(InData%TurbineRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TurbineRefPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TurbineRefPos) ! TurbineRefPos - END IF - Db_BufSz = Db_BufSz + 1 ! mu_kT - Db_BufSz = Db_BufSz + 1 ! mu_kA - Db_BufSz = Db_BufSz + 1 ! mc - Db_BufSz = Db_BufSz + 1 ! cv - Int_BufSz = Int_BufSz + 1 ! nxWave - Int_BufSz = Int_BufSz + 1 ! nyWave - Int_BufSz = Int_BufSz + 1 ! nzWave - Int_BufSz = Int_BufSz + 1 ! ntWave - Int_BufSz = Int_BufSz + 1 ! pxWave allocated yes/no - IF ( ALLOCATED(InData%pxWave) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pxWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pxWave) ! pxWave - END IF - Int_BufSz = Int_BufSz + 1 ! pyWave allocated yes/no - IF ( ALLOCATED(InData%pyWave) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pyWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pyWave) ! pyWave - END IF - Int_BufSz = Int_BufSz + 1 ! pzWave allocated yes/no - IF ( ALLOCATED(InData%pzWave) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pzWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pzWave) ! pzWave - END IF - Re_BufSz = Re_BufSz + 1 ! dtWave - Int_BufSz = Int_BufSz + 1 ! uxWave allocated yes/no - IF ( ALLOCATED(InData%uxWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! uxWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uxWave) ! uxWave - END IF - Int_BufSz = Int_BufSz + 1 ! uyWave allocated yes/no - IF ( ALLOCATED(InData%uyWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! uyWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uyWave) ! uyWave - END IF - Int_BufSz = Int_BufSz + 1 ! uzWave allocated yes/no - IF ( ALLOCATED(InData%uzWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! uzWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uzWave) ! uzWave - END IF - Int_BufSz = Int_BufSz + 1 ! axWave allocated yes/no - IF ( ALLOCATED(InData%axWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! axWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%axWave) ! axWave - END IF - Int_BufSz = Int_BufSz + 1 ! ayWave allocated yes/no - IF ( ALLOCATED(InData%ayWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! ayWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ayWave) ! ayWave - END IF - Int_BufSz = Int_BufSz + 1 ! azWave allocated yes/no - IF ( ALLOCATED(InData%azWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! azWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%azWave) ! azWave - END IF - Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no - IF ( ALLOCATED(InData%PDyn) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PDyn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PDyn) ! PDyn - END IF - Int_BufSz = Int_BufSz + 1 ! zeta allocated yes/no - IF ( ALLOCATED(InData%zeta) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! zeta upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zeta) ! zeta - END IF - Int_BufSz = Int_BufSz + 1 ! nzCurrent - Int_BufSz = Int_BufSz + 1 ! pzCurrent allocated yes/no - IF ( ALLOCATED(InData%pzCurrent) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pzCurrent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pzCurrent) ! pzCurrent - END IF - Int_BufSz = Int_BufSz + 1 ! uxCurrent allocated yes/no - IF ( ALLOCATED(InData%uxCurrent) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! uxCurrent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uxCurrent) ! uxCurrent - END IF - Int_BufSz = Int_BufSz + 1 ! uyCurrent allocated yes/no - IF ( ALLOCATED(InData%uyCurrent) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! uyCurrent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uyCurrent) ! uyCurrent - END IF - Int_BufSz = Int_BufSz + 1 ! Nx0 - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%du) ! du - END IF - Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no - IF ( ALLOCATED(InData%dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! Jac_nx - Int_BufSz = Int_BufSz + 1 ! dxIdx_map2_xStateIdx allocated yes/no - IF ( ALLOCATED(InData%dxIdx_map2_xStateIdx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dxIdx_map2_xStateIdx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%dxIdx_map2_xStateIdx) ! dxIdx_map2_xStateIdx - 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 - - IntKiBuf(Int_Xferred) = InData%nLineTypes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nRodTypes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nConnects - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nConnectsExtra - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nBodies - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nRods - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nCtrlChans - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFails - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFreeBodies - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFreeRods - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFreeCons - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%nCpldBodies) ) 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%nCpldBodies,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nCpldBodies,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nCpldBodies,1), UBOUND(InData%nCpldBodies,1) - IntKiBuf(Int_Xferred) = InData%nCpldBodies(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nCpldRods) ) 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%nCpldRods,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nCpldRods,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nCpldRods,1), UBOUND(InData%nCpldRods,1) - IntKiBuf(Int_Xferred) = InData%nCpldRods(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nCpldCons) ) 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%nCpldCons,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nCpldCons,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nCpldCons,1), UBOUND(InData%nCpldCons,1) - IntKiBuf(Int_Xferred) = InData%nCpldCons(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NConns - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NAnchs - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%g - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rhoW - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%WtrDpth - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%kBot - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%cBot - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dtM0 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dtCoupling - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dtOut - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 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 - - 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 - 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%MDUnOut - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PriPath) - IntKiBuf(Int_Xferred) = ICHAR(InData%PriPath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%writeLog - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnLog - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveKin - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Current - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nTurbines - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TurbineRefPos) ) 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%TurbineRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineRefPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TurbineRefPos,2), UBOUND(InData%TurbineRefPos,2) - DO i1 = LBOUND(InData%TurbineRefPos,1), UBOUND(InData%TurbineRefPos,1) - ReKiBuf(Re_Xferred) = InData%TurbineRefPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%mu_kT - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%mu_kA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%mc - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%cv - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nxWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nyWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nzWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ntWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%pxWave) ) 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%pxWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxWave,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pxWave,1), UBOUND(InData%pxWave,1) - ReKiBuf(Re_Xferred) = InData%pxWave(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%pyWave) ) 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%pyWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyWave,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pyWave,1), UBOUND(InData%pyWave,1) - ReKiBuf(Re_Xferred) = InData%pyWave(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%pzWave) ) 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%pzWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzWave,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pzWave,1), UBOUND(InData%pzWave,1) - ReKiBuf(Re_Xferred) = InData%pzWave(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%dtWave - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%uxWave) ) 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%uxWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uxWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uxWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uxWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%uxWave,4), UBOUND(InData%uxWave,4) - DO i3 = LBOUND(InData%uxWave,3), UBOUND(InData%uxWave,3) - DO i2 = LBOUND(InData%uxWave,2), UBOUND(InData%uxWave,2) - DO i1 = LBOUND(InData%uxWave,1), UBOUND(InData%uxWave,1) - ReKiBuf(Re_Xferred) = InData%uxWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uyWave) ) 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%uyWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uyWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uyWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uyWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%uyWave,4), UBOUND(InData%uyWave,4) - DO i3 = LBOUND(InData%uyWave,3), UBOUND(InData%uyWave,3) - DO i2 = LBOUND(InData%uyWave,2), UBOUND(InData%uyWave,2) - DO i1 = LBOUND(InData%uyWave,1), UBOUND(InData%uyWave,1) - ReKiBuf(Re_Xferred) = InData%uyWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uzWave) ) 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%uzWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uzWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uzWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uzWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%uzWave,4), UBOUND(InData%uzWave,4) - DO i3 = LBOUND(InData%uzWave,3), UBOUND(InData%uzWave,3) - DO i2 = LBOUND(InData%uzWave,2), UBOUND(InData%uzWave,2) - DO i1 = LBOUND(InData%uzWave,1), UBOUND(InData%uzWave,1) - ReKiBuf(Re_Xferred) = InData%uzWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%axWave) ) 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%axWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%axWave,4), UBOUND(InData%axWave,4) - DO i3 = LBOUND(InData%axWave,3), UBOUND(InData%axWave,3) - DO i2 = LBOUND(InData%axWave,2), UBOUND(InData%axWave,2) - DO i1 = LBOUND(InData%axWave,1), UBOUND(InData%axWave,1) - ReKiBuf(Re_Xferred) = InData%axWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ayWave) ) 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%ayWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ayWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ayWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ayWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%ayWave,4), UBOUND(InData%ayWave,4) - DO i3 = LBOUND(InData%ayWave,3), UBOUND(InData%ayWave,3) - DO i2 = LBOUND(InData%ayWave,2), UBOUND(InData%ayWave,2) - DO i1 = LBOUND(InData%ayWave,1), UBOUND(InData%ayWave,1) - ReKiBuf(Re_Xferred) = InData%ayWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%azWave) ) 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%azWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%azWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%azWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%azWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%azWave,4), UBOUND(InData%azWave,4) - DO i3 = LBOUND(InData%azWave,3), UBOUND(InData%azWave,3) - DO i2 = LBOUND(InData%azWave,2), UBOUND(InData%azWave,2) - DO i1 = LBOUND(InData%azWave,1), UBOUND(InData%azWave,1) - ReKiBuf(Re_Xferred) = InData%azWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PDyn) ) 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%PDyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PDyn,4), UBOUND(InData%PDyn,4) - DO i3 = LBOUND(InData%PDyn,3), UBOUND(InData%PDyn,3) - DO i2 = LBOUND(InData%PDyn,2), UBOUND(InData%PDyn,2) - DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) - ReKiBuf(Re_Xferred) = InData%PDyn(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zeta) ) 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%zeta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%zeta,3), UBOUND(InData%zeta,3) - DO i2 = LBOUND(InData%zeta,2), UBOUND(InData%zeta,2) - DO i1 = LBOUND(InData%zeta,1), UBOUND(InData%zeta,1) - ReKiBuf(Re_Xferred) = InData%zeta(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nzCurrent - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%pzCurrent) ) 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%pzCurrent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzCurrent,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pzCurrent,1), UBOUND(InData%pzCurrent,1) - ReKiBuf(Re_Xferred) = InData%pzCurrent(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uxCurrent) ) 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%uxCurrent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxCurrent,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%uxCurrent,1), UBOUND(InData%uxCurrent,1) - ReKiBuf(Re_Xferred) = InData%uxCurrent(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uyCurrent) ) 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%uyCurrent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyCurrent,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%uyCurrent,1), UBOUND(InData%uyCurrent,1) - ReKiBuf(Re_Xferred) = InData%uyCurrent(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Nx0 - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) 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%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%du) ) 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%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - DbKiBuf(Db_Xferred) = InData%du(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dx) ) 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%dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - DbKiBuf(Db_Xferred) = InData%dx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_nx - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%dxIdx_map2_xStateIdx) ) 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%dxIdx_map2_xStateIdx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxIdx_map2_xStateIdx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dxIdx_map2_xStateIdx,1), UBOUND(InData%dxIdx_map2_xStateIdx,1) - IntKiBuf(Int_Xferred) = InData%dxIdx_map2_xStateIdx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackParam - - SUBROUTINE MD_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(MD_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) :: 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_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%nLineTypes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nRodTypes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nConnects = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nConnectsExtra = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nBodies = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nRods = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nLines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nCtrlChans = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFails = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFreeBodies = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFreeRods = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFreeCons = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nCpldBodies 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%nCpldBodies)) DEALLOCATE(OutData%nCpldBodies) - ALLOCATE(OutData%nCpldBodies(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldBodies.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%nCpldBodies,1), UBOUND(OutData%nCpldBodies,1) - OutData%nCpldBodies(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nCpldRods 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%nCpldRods)) DEALLOCATE(OutData%nCpldRods) - ALLOCATE(OutData%nCpldRods(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldRods.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%nCpldRods,1), UBOUND(OutData%nCpldRods,1) - OutData%nCpldRods(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nCpldCons 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%nCpldCons)) DEALLOCATE(OutData%nCpldCons) - ALLOCATE(OutData%nCpldCons(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldCons.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%nCpldCons,1), UBOUND(OutData%nCpldCons,1) - OutData%nCpldCons(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NConns = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NAnchs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Tmax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%g = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%rhoW = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WtrDpth = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%kBot = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%cBot = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%dtM0 = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%dtCoupling = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dtOut = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 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 - - 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 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%MDUnOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PriPath) - OutData%PriPath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%writeLog = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnLog = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveKin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Current = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TurbineRefPos 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%TurbineRefPos)) DEALLOCATE(OutData%TurbineRefPos) - ALLOCATE(OutData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TurbineRefPos,2), UBOUND(OutData%TurbineRefPos,2) - DO i1 = LBOUND(OutData%TurbineRefPos,1), UBOUND(OutData%TurbineRefPos,1) - OutData%TurbineRefPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%mu_kT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%mu_kA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%mc = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%cv = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%nxWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nyWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nzWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ntWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pxWave 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%pxWave)) DEALLOCATE(OutData%pxWave) - ALLOCATE(OutData%pxWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%pxWave,1), UBOUND(OutData%pxWave,1) - OutData%pxWave(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyWave 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%pyWave)) DEALLOCATE(OutData%pyWave) - ALLOCATE(OutData%pyWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%pyWave,1), UBOUND(OutData%pyWave,1) - OutData%pyWave(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzWave 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%pzWave)) DEALLOCATE(OutData%pzWave) - ALLOCATE(OutData%pzWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%pzWave,1), UBOUND(OutData%pzWave,1) - OutData%pzWave(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%dtWave = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uxWave 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%uxWave)) DEALLOCATE(OutData%uxWave) - ALLOCATE(OutData%uxWave(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%uxWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%uxWave,4), UBOUND(OutData%uxWave,4) - DO i3 = LBOUND(OutData%uxWave,3), UBOUND(OutData%uxWave,3) - DO i2 = LBOUND(OutData%uxWave,2), UBOUND(OutData%uxWave,2) - DO i1 = LBOUND(OutData%uxWave,1), UBOUND(OutData%uxWave,1) - OutData%uxWave(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 ! uyWave 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%uyWave)) DEALLOCATE(OutData%uyWave) - ALLOCATE(OutData%uyWave(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%uyWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%uyWave,4), UBOUND(OutData%uyWave,4) - DO i3 = LBOUND(OutData%uyWave,3), UBOUND(OutData%uyWave,3) - DO i2 = LBOUND(OutData%uyWave,2), UBOUND(OutData%uyWave,2) - DO i1 = LBOUND(OutData%uyWave,1), UBOUND(OutData%uyWave,1) - OutData%uyWave(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 ! uzWave 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%uzWave)) DEALLOCATE(OutData%uzWave) - ALLOCATE(OutData%uzWave(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%uzWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%uzWave,4), UBOUND(OutData%uzWave,4) - DO i3 = LBOUND(OutData%uzWave,3), UBOUND(OutData%uzWave,3) - DO i2 = LBOUND(OutData%uzWave,2), UBOUND(OutData%uzWave,2) - DO i1 = LBOUND(OutData%uzWave,1), UBOUND(OutData%uzWave,1) - OutData%uzWave(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 ! axWave 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%axWave)) DEALLOCATE(OutData%axWave) - ALLOCATE(OutData%axWave(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%axWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%axWave,4), UBOUND(OutData%axWave,4) - DO i3 = LBOUND(OutData%axWave,3), UBOUND(OutData%axWave,3) - DO i2 = LBOUND(OutData%axWave,2), UBOUND(OutData%axWave,2) - DO i1 = LBOUND(OutData%axWave,1), UBOUND(OutData%axWave,1) - OutData%axWave(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 ! ayWave 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%ayWave)) DEALLOCATE(OutData%ayWave) - ALLOCATE(OutData%ayWave(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%ayWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%ayWave,4), UBOUND(OutData%ayWave,4) - DO i3 = LBOUND(OutData%ayWave,3), UBOUND(OutData%ayWave,3) - DO i2 = LBOUND(OutData%ayWave,2), UBOUND(OutData%ayWave,2) - DO i1 = LBOUND(OutData%ayWave,1), UBOUND(OutData%ayWave,1) - OutData%ayWave(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 ! azWave 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%azWave)) DEALLOCATE(OutData%azWave) - ALLOCATE(OutData%azWave(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%azWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%azWave,4), UBOUND(OutData%azWave,4) - DO i3 = LBOUND(OutData%azWave,3), UBOUND(OutData%azWave,3) - DO i2 = LBOUND(OutData%azWave,2), UBOUND(OutData%azWave,2) - DO i1 = LBOUND(OutData%azWave,1), UBOUND(OutData%azWave,1) - OutData%azWave(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 ! PDyn 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%PDyn)) DEALLOCATE(OutData%PDyn) - ALLOCATE(OutData%PDyn(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%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PDyn,4), UBOUND(OutData%PDyn,4) - DO i3 = LBOUND(OutData%PDyn,3), UBOUND(OutData%PDyn,3) - DO i2 = LBOUND(OutData%PDyn,2), UBOUND(OutData%PDyn,2) - DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) - OutData%PDyn(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 ! zeta 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%zeta)) DEALLOCATE(OutData%zeta) - ALLOCATE(OutData%zeta(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%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%zeta,3), UBOUND(OutData%zeta,3) - DO i2 = LBOUND(OutData%zeta,2), UBOUND(OutData%zeta,2) - DO i1 = LBOUND(OutData%zeta,1), UBOUND(OutData%zeta,1) - OutData%zeta(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%nzCurrent = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzCurrent 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%pzCurrent)) DEALLOCATE(OutData%pzCurrent) - ALLOCATE(OutData%pzCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%pzCurrent,1), UBOUND(OutData%pzCurrent,1) - OutData%pzCurrent(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uxCurrent 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%uxCurrent)) DEALLOCATE(OutData%uxCurrent) - ALLOCATE(OutData%uxCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uxCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%uxCurrent,1), UBOUND(OutData%uxCurrent,1) - OutData%uxCurrent(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uyCurrent 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%uyCurrent)) DEALLOCATE(OutData%uyCurrent) - ALLOCATE(OutData%uyCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uyCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%uyCurrent,1), UBOUND(OutData%uyCurrent,1) - OutData%uyCurrent(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Nx0 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx 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%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du 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%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx 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%dx)) DEALLOCATE(OutData%dx) - ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dxIdx_map2_xStateIdx 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%dxIdx_map2_xStateIdx)) DEALLOCATE(OutData%dxIdx_map2_xStateIdx) - ALLOCATE(OutData%dxIdx_map2_xStateIdx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dxIdx_map2_xStateIdx,1), UBOUND(OutData%dxIdx_map2_xStateIdx,1) - OutData%dxIdx_map2_xStateIdx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackParam - - SUBROUTINE MD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(MD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyInput' -! + ErrMsg = '' + DstInputFileTypeData%DTIC = SrcInputFileTypeData%DTIC + DstInputFileTypeData%TMaxIC = SrcInputFileTypeData%TMaxIC + DstInputFileTypeData%CdScaleIC = SrcInputFileTypeData%CdScaleIC + DstInputFileTypeData%threshIC = SrcInputFileTypeData%threshIC +end subroutine + +subroutine MD_DestroyInputFileType(InputFileTypeData, ErrStat, ErrMsg) + type(MD_InputFileType), intent(inout) :: InputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyInputFileType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%CoupledKinematics)) THEN - i1_l = LBOUND(SrcInputData%CoupledKinematics,1) - i1_u = UBOUND(SrcInputData%CoupledKinematics,1) - IF (.NOT. ALLOCATED(DstInputData%CoupledKinematics)) THEN - ALLOCATE(DstInputData%CoupledKinematics(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CoupledKinematics.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%CoupledKinematics,1), UBOUND(SrcInputData%CoupledKinematics,1) - CALL MeshCopy( SrcInputData%CoupledKinematics(i1), DstInputData%CoupledKinematics(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%DeltaL)) THEN - i1_l = LBOUND(SrcInputData%DeltaL,1) - i1_u = UBOUND(SrcInputData%DeltaL,1) - IF (.NOT. ALLOCATED(DstInputData%DeltaL)) THEN - ALLOCATE(DstInputData%DeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%DeltaL = SrcInputData%DeltaL -ENDIF -IF (ALLOCATED(SrcInputData%DeltaLdot)) THEN - i1_l = LBOUND(SrcInputData%DeltaLdot,1) - i1_u = UBOUND(SrcInputData%DeltaLdot,1) - IF (.NOT. ALLOCATED(DstInputData%DeltaLdot)) THEN - ALLOCATE(DstInputData%DeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%DeltaLdot = SrcInputData%DeltaLdot -ENDIF - END SUBROUTINE MD_CopyInput - - SUBROUTINE MD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(MD_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 = 'MD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%CoupledKinematics)) THEN -DO i1 = LBOUND(InputData%CoupledKinematics,1), UBOUND(InputData%CoupledKinematics,1) - CALL MeshDestroy( InputData%CoupledKinematics(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%CoupledKinematics) -ENDIF -IF (ALLOCATED(InputData%DeltaL)) THEN - DEALLOCATE(InputData%DeltaL) -ENDIF -IF (ALLOCATED(InputData%DeltaLdot)) THEN - DEALLOCATE(InputData%DeltaLdot) -ENDIF - END SUBROUTINE MD_DestroyInput - - SUBROUTINE MD_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(MD_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 = 'MD_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 - Int_BufSz = Int_BufSz + 1 ! CoupledKinematics allocated yes/no - IF ( ALLOCATED(InData%CoupledKinematics) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CoupledKinematics upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%CoupledKinematics,1), UBOUND(InData%CoupledKinematics,1) - Int_BufSz = Int_BufSz + 3 ! CoupledKinematics: size of buffers for each call to pack subtype - CALL MeshPack( InData%CoupledKinematics(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! CoupledKinematics - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CoupledKinematics - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CoupledKinematics - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CoupledKinematics - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! DeltaL allocated yes/no - IF ( ALLOCATED(InData%DeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DeltaL) ! DeltaL - END IF - Int_BufSz = Int_BufSz + 1 ! DeltaLdot allocated yes/no - IF ( ALLOCATED(InData%DeltaLdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DeltaLdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DeltaLdot) ! DeltaLdot - 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%CoupledKinematics) ) 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%CoupledKinematics,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CoupledKinematics,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CoupledKinematics,1), UBOUND(InData%CoupledKinematics,1) - CALL MeshPack( InData%CoupledKinematics(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! CoupledKinematics - 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 - IF ( .NOT. ALLOCATED(InData%DeltaL) ) 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%DeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DeltaL,1), UBOUND(InData%DeltaL,1) - ReKiBuf(Re_Xferred) = InData%DeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DeltaLdot) ) 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%DeltaLdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DeltaLdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DeltaLdot,1), UBOUND(InData%DeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%DeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackInput - - SUBROUTINE MD_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(MD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoupledKinematics 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%CoupledKinematics)) DEALLOCATE(OutData%CoupledKinematics) - ALLOCATE(OutData%CoupledKinematics(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledKinematics.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CoupledKinematics,1), UBOUND(OutData%CoupledKinematics,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 MeshUnpack( OutData%CoupledKinematics(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! CoupledKinematics - 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 ! DeltaL 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%DeltaL)) DEALLOCATE(OutData%DeltaL) - ALLOCATE(OutData%DeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DeltaL,1), UBOUND(OutData%DeltaL,1) - OutData%DeltaL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DeltaLdot 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%DeltaLdot)) DEALLOCATE(OutData%DeltaLdot) - ALLOCATE(OutData%DeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DeltaLdot,1), UBOUND(OutData%DeltaLdot,1) - OutData%DeltaLdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackInput - - SUBROUTINE MD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(MD_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 = 'MD_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine MD_PackInputFileType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_InputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackInputFileType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DTIC) + call RegPack(Buf, InData%TMaxIC) + call RegPack(Buf, InData%CdScaleIC) + call RegPack(Buf, InData%threshIC) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackInputFileType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_InputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackInputFileType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DTIC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TMaxIC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CdScaleIC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%threshIC) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(MD_InitInputType), intent(in) :: SrcInitInputData + type(MD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%CoupledLoads)) THEN - i1_l = LBOUND(SrcOutputData%CoupledLoads,1) - i1_u = UBOUND(SrcOutputData%CoupledLoads,1) - IF (.NOT. ALLOCATED(DstOutputData%CoupledLoads)) THEN - ALLOCATE(DstOutputData%CoupledLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CoupledLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%CoupledLoads,1), UBOUND(SrcOutputData%CoupledLoads,1) - CALL MeshCopy( SrcOutputData%CoupledLoads(i1), DstOutputData%CoupledLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -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 MD_CopyOutput - - SUBROUTINE MD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(MD_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 = 'MD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%CoupledLoads)) THEN -DO i1 = LBOUND(OutputData%CoupledLoads,1), UBOUND(OutputData%CoupledLoads,1) - CALL MeshDestroy( OutputData%CoupledLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%CoupledLoads) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE MD_DestroyOutput - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! CoupledLoads allocated yes/no - IF ( ALLOCATED(InData%CoupledLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CoupledLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%CoupledLoads,1), UBOUND(InData%CoupledLoads,1) - Int_BufSz = Int_BufSz + 3 ! CoupledLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%CoupledLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! CoupledLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CoupledLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CoupledLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CoupledLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - 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%CoupledLoads) ) 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%CoupledLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CoupledLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CoupledLoads,1), UBOUND(InData%CoupledLoads,1) - CALL MeshPack( InData%CoupledLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! CoupledLoads - 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 - 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 MD_PackOutput - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! CoupledLoads 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%CoupledLoads)) DEALLOCATE(OutData%CoupledLoads) - ALLOCATE(OutData%CoupledLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CoupledLoads,1), UBOUND(OutData%CoupledLoads,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 MeshUnpack( OutData%CoupledLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! CoupledLoads - 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 ! 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 MD_UnPackOutput - - - SUBROUTINE MD_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(MD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(MD_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 + ErrMsg = '' + DstInitInputData%g = SrcInitInputData%g + DstInitInputData%rhoW = SrcInitInputData%rhoW + DstInitInputData%WtrDepth = SrcInitInputData%WtrDepth + if (allocated(SrcInitInputData%PtfmInit)) then + LB(1:2) = lbound(SrcInitInputData%PtfmInit) + UB(1:2) = ubound(SrcInitInputData%PtfmInit) + if (.not. allocated(DstInitInputData%PtfmInit)) then + allocate(DstInitInputData%PtfmInit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmInit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit + end if + DstInitInputData%FarmSize = SrcInitInputData%FarmSize + if (allocated(SrcInitInputData%TurbineRefPos)) then + LB(1:2) = lbound(SrcInitInputData%TurbineRefPos) + UB(1:2) = ubound(SrcInitInputData%TurbineRefPos) + if (.not. allocated(DstInitInputData%TurbineRefPos)) then + allocate(DstInitInputData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TurbineRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%TurbineRefPos = SrcInitInputData%TurbineRefPos + end if + DstInitInputData%Tmax = SrcInitInputData%Tmax + DstInitInputData%FileName = SrcInitInputData%FileName + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%UsePrimaryInputFile = SrcInitInputData%UsePrimaryInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%Echo = SrcInitInputData%Echo + if (allocated(SrcInitInputData%OutList)) then + LB(1:1) = lbound(SrcInitInputData%OutList) + UB(1:1) = ubound(SrcInitInputData%OutList) + if (.not. allocated(DstInitInputData%OutList)) then + allocate(DstInitInputData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%OutList = SrcInitInputData%OutList + end if + DstInitInputData%Linearize = SrcInitInputData%Linearize +end subroutine + +subroutine MD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(MD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%PtfmInit)) then + deallocate(InitInputData%PtfmInit) + end if + if (allocated(InitInputData%TurbineRefPos)) then + deallocate(InitInputData%TurbineRefPos) + end if + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitInputData%OutList)) then + deallocate(InitInputData%OutList) + end if +end subroutine + +subroutine MD_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%g) + call RegPack(Buf, InData%rhoW) + call RegPack(Buf, InData%WtrDepth) + call RegPack(Buf, allocated(InData%PtfmInit)) + if (allocated(InData%PtfmInit)) then + call RegPackBounds(Buf, 2, lbound(InData%PtfmInit), ubound(InData%PtfmInit)) + call RegPack(Buf, InData%PtfmInit) + end if + call RegPack(Buf, InData%FarmSize) + call RegPack(Buf, allocated(InData%TurbineRefPos)) + if (allocated(InData%TurbineRefPos)) then + call RegPackBounds(Buf, 2, lbound(InData%TurbineRefPos), ubound(InData%TurbineRefPos)) + call RegPack(Buf, InData%TurbineRefPos) + end if + call RegPack(Buf, InData%Tmax) + call RegPack(Buf, InData%FileName) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%UsePrimaryInputFile) + call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) + call RegPack(Buf, InData%Echo) + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%g) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rhoW) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDepth) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PtfmInit)) deallocate(OutData%PtfmInit) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmInit(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmInit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmInit) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%FarmSize) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TurbineRefPos)) deallocate(OutData%TurbineRefPos) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineRefPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TurbineRefPos) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UsePrimaryInputFile) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_CopyLineProp(SrcLinePropData, DstLinePropData, CtrlCode, ErrStat, ErrMsg) + type(MD_LineProp), intent(in) :: SrcLinePropData + type(MD_LineProp), intent(inout) :: DstLinePropData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyLineProp' + ErrStat = ErrID_None + ErrMsg = '' + DstLinePropData%IdNum = SrcLinePropData%IdNum + DstLinePropData%name = SrcLinePropData%name + DstLinePropData%d = SrcLinePropData%d + DstLinePropData%w = SrcLinePropData%w + DstLinePropData%EA = SrcLinePropData%EA + DstLinePropData%EA_D = SrcLinePropData%EA_D + DstLinePropData%BA = SrcLinePropData%BA + DstLinePropData%BA_D = SrcLinePropData%BA_D + DstLinePropData%EI = SrcLinePropData%EI + DstLinePropData%Can = SrcLinePropData%Can + DstLinePropData%Cat = SrcLinePropData%Cat + DstLinePropData%Cdn = SrcLinePropData%Cdn + DstLinePropData%Cdt = SrcLinePropData%Cdt + DstLinePropData%ElasticMod = SrcLinePropData%ElasticMod + DstLinePropData%nEApoints = SrcLinePropData%nEApoints + DstLinePropData%stiffXs = SrcLinePropData%stiffXs + DstLinePropData%stiffYs = SrcLinePropData%stiffYs + DstLinePropData%nBApoints = SrcLinePropData%nBApoints + DstLinePropData%dampXs = SrcLinePropData%dampXs + DstLinePropData%dampYs = SrcLinePropData%dampYs + DstLinePropData%nEIpoints = SrcLinePropData%nEIpoints + DstLinePropData%bstiffXs = SrcLinePropData%bstiffXs + DstLinePropData%bstiffYs = SrcLinePropData%bstiffYs +end subroutine + +subroutine MD_DestroyLineProp(LinePropData, ErrStat, ErrMsg) + type(MD_LineProp), intent(inout) :: LinePropData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyLineProp' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackLineProp(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_LineProp), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackLineProp' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%IdNum) + call RegPack(Buf, InData%name) + call RegPack(Buf, InData%d) + call RegPack(Buf, InData%w) + call RegPack(Buf, InData%EA) + call RegPack(Buf, InData%EA_D) + call RegPack(Buf, InData%BA) + call RegPack(Buf, InData%BA_D) + call RegPack(Buf, InData%EI) + call RegPack(Buf, InData%Can) + call RegPack(Buf, InData%Cat) + call RegPack(Buf, InData%Cdn) + call RegPack(Buf, InData%Cdt) + call RegPack(Buf, InData%ElasticMod) + call RegPack(Buf, InData%nEApoints) + call RegPack(Buf, InData%stiffXs) + call RegPack(Buf, InData%stiffYs) + call RegPack(Buf, InData%nBApoints) + call RegPack(Buf, InData%dampXs) + call RegPack(Buf, InData%dampYs) + call RegPack(Buf, InData%nEIpoints) + call RegPack(Buf, InData%bstiffXs) + call RegPack(Buf, InData%bstiffYs) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackLineProp(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_LineProp), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackLineProp' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%name) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%d) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%w) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EA_D) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BA_D) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EI) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Can) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cdn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cdt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ElasticMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nEApoints) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%stiffXs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%stiffYs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nBApoints) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dampXs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dampYs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nEIpoints) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%bstiffXs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%bstiffYs) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_CopyRodProp(SrcRodPropData, DstRodPropData, CtrlCode, ErrStat, ErrMsg) + type(MD_RodProp), intent(in) :: SrcRodPropData + type(MD_RodProp), intent(inout) :: DstRodPropData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyRodProp' + ErrStat = ErrID_None + ErrMsg = '' + DstRodPropData%IdNum = SrcRodPropData%IdNum + DstRodPropData%name = SrcRodPropData%name + DstRodPropData%d = SrcRodPropData%d + DstRodPropData%w = SrcRodPropData%w + DstRodPropData%Can = SrcRodPropData%Can + DstRodPropData%Cat = SrcRodPropData%Cat + DstRodPropData%Cdn = SrcRodPropData%Cdn + DstRodPropData%Cdt = SrcRodPropData%Cdt + DstRodPropData%CdEnd = SrcRodPropData%CdEnd + DstRodPropData%CaEnd = SrcRodPropData%CaEnd +end subroutine + +subroutine MD_DestroyRodProp(RodPropData, ErrStat, ErrMsg) + type(MD_RodProp), intent(inout) :: RodPropData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyRodProp' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackRodProp(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_RodProp), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackRodProp' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%IdNum) + call RegPack(Buf, InData%name) + call RegPack(Buf, InData%d) + call RegPack(Buf, InData%w) + call RegPack(Buf, InData%Can) + call RegPack(Buf, InData%Cat) + call RegPack(Buf, InData%Cdn) + call RegPack(Buf, InData%Cdt) + call RegPack(Buf, InData%CdEnd) + call RegPack(Buf, InData%CaEnd) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackRodProp(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_RodProp), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackRodProp' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%name) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%d) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%w) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Can) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cdn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cdt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CdEnd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CaEnd) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_CopyBody(SrcBodyData, DstBodyData, CtrlCode, ErrStat, ErrMsg) + type(MD_Body), intent(in) :: SrcBodyData + type(MD_Body), intent(inout) :: DstBodyData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyBody' + ErrStat = ErrID_None + ErrMsg = '' + DstBodyData%IdNum = SrcBodyData%IdNum + DstBodyData%typeNum = SrcBodyData%typeNum + DstBodyData%AttachedC = SrcBodyData%AttachedC + DstBodyData%AttachedR = SrcBodyData%AttachedR + DstBodyData%nAttachedC = SrcBodyData%nAttachedC + DstBodyData%nAttachedR = SrcBodyData%nAttachedR + DstBodyData%rConnectRel = SrcBodyData%rConnectRel + DstBodyData%r6RodRel = SrcBodyData%r6RodRel + DstBodyData%bodyM = SrcBodyData%bodyM + DstBodyData%bodyV = SrcBodyData%bodyV + DstBodyData%bodyI = SrcBodyData%bodyI + DstBodyData%bodyCdA = SrcBodyData%bodyCdA + DstBodyData%bodyCa = SrcBodyData%bodyCa + DstBodyData%time = SrcBodyData%time + DstBodyData%r6 = SrcBodyData%r6 + DstBodyData%v6 = SrcBodyData%v6 + DstBodyData%a6 = SrcBodyData%a6 + DstBodyData%U = SrcBodyData%U + DstBodyData%Ud = SrcBodyData%Ud + DstBodyData%zeta = SrcBodyData%zeta + DstBodyData%F6net = SrcBodyData%F6net + DstBodyData%M6net = SrcBodyData%M6net + DstBodyData%M = SrcBodyData%M + DstBodyData%M0 = SrcBodyData%M0 + DstBodyData%OrMat = SrcBodyData%OrMat + DstBodyData%rCG = SrcBodyData%rCG +end subroutine + +subroutine MD_DestroyBody(BodyData, ErrStat, ErrMsg) + type(MD_Body), intent(inout) :: BodyData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyBody' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackBody(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_Body), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackBody' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%IdNum) + call RegPack(Buf, InData%typeNum) + call RegPack(Buf, InData%AttachedC) + call RegPack(Buf, InData%AttachedR) + call RegPack(Buf, InData%nAttachedC) + call RegPack(Buf, InData%nAttachedR) + call RegPack(Buf, InData%rConnectRel) + call RegPack(Buf, InData%r6RodRel) + call RegPack(Buf, InData%bodyM) + call RegPack(Buf, InData%bodyV) + call RegPack(Buf, InData%bodyI) + call RegPack(Buf, InData%bodyCdA) + call RegPack(Buf, InData%bodyCa) + call RegPack(Buf, InData%time) + call RegPack(Buf, InData%r6) + call RegPack(Buf, InData%v6) + call RegPack(Buf, InData%a6) + call RegPack(Buf, InData%U) + call RegPack(Buf, InData%Ud) + call RegPack(Buf, InData%zeta) + call RegPack(Buf, InData%F6net) + call RegPack(Buf, InData%M6net) + call RegPack(Buf, InData%M) + call RegPack(Buf, InData%M0) + call RegPack(Buf, InData%OrMat) + call RegPack(Buf, InData%rCG) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackBody(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_Body), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackBody' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%typeNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AttachedC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AttachedR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nAttachedC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nAttachedR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rConnectRel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%r6RodRel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%bodyM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%bodyV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%bodyI) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%bodyCdA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%bodyCa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%time) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%r6) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%v6) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%a6) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%U) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ud) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%zeta) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%F6net) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%M6net) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%M) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%M0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OrMat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rCG) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_CopyConnect(SrcConnectData, DstConnectData, CtrlCode, ErrStat, ErrMsg) + type(MD_Connect), intent(in) :: SrcConnectData + type(MD_Connect), intent(inout) :: DstConnectData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MD_CopyConnect' + ErrStat = ErrID_None + ErrMsg = '' + DstConnectData%IdNum = SrcConnectData%IdNum + DstConnectData%type = SrcConnectData%type + DstConnectData%typeNum = SrcConnectData%typeNum + DstConnectData%Attached = SrcConnectData%Attached + DstConnectData%Top = SrcConnectData%Top + DstConnectData%nAttached = SrcConnectData%nAttached + DstConnectData%conM = SrcConnectData%conM + DstConnectData%conV = SrcConnectData%conV + DstConnectData%conFX = SrcConnectData%conFX + DstConnectData%conFY = SrcConnectData%conFY + DstConnectData%conFZ = SrcConnectData%conFZ + DstConnectData%conCa = SrcConnectData%conCa + DstConnectData%conCdA = SrcConnectData%conCdA + DstConnectData%time = SrcConnectData%time + DstConnectData%r = SrcConnectData%r + DstConnectData%rd = SrcConnectData%rd + DstConnectData%a = SrcConnectData%a + DstConnectData%U = SrcConnectData%U + DstConnectData%Ud = SrcConnectData%Ud + DstConnectData%zeta = SrcConnectData%zeta + if (allocated(SrcConnectData%PDyn)) then + LB(1:1) = lbound(SrcConnectData%PDyn) + UB(1:1) = ubound(SrcConnectData%PDyn) + if (.not. allocated(DstConnectData%PDyn)) then + allocate(DstConnectData%PDyn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConnectData%PDyn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstConnectData%PDyn = SrcConnectData%PDyn + end if + DstConnectData%Fnet = SrcConnectData%Fnet + DstConnectData%M = SrcConnectData%M +end subroutine + +subroutine MD_DestroyConnect(ConnectData, ErrStat, ErrMsg) + type(MD_Connect), intent(inout) :: ConnectData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyConnect' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConnectData%PDyn)) then + deallocate(ConnectData%PDyn) + end if +end subroutine + +subroutine MD_PackConnect(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_Connect), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackConnect' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%IdNum) + call RegPack(Buf, InData%type) + call RegPack(Buf, InData%typeNum) + call RegPack(Buf, InData%Attached) + call RegPack(Buf, InData%Top) + call RegPack(Buf, InData%nAttached) + call RegPack(Buf, InData%conM) + call RegPack(Buf, InData%conV) + call RegPack(Buf, InData%conFX) + call RegPack(Buf, InData%conFY) + call RegPack(Buf, InData%conFZ) + call RegPack(Buf, InData%conCa) + call RegPack(Buf, InData%conCdA) + call RegPack(Buf, InData%time) + call RegPack(Buf, InData%r) + call RegPack(Buf, InData%rd) + call RegPack(Buf, InData%a) + call RegPack(Buf, InData%U) + call RegPack(Buf, InData%Ud) + call RegPack(Buf, InData%zeta) + call RegPack(Buf, allocated(InData%PDyn)) + if (allocated(InData%PDyn)) then + call RegPackBounds(Buf, 1, lbound(InData%PDyn), ubound(InData%PDyn)) + call RegPack(Buf, InData%PDyn) + end if + call RegPack(Buf, InData%Fnet) + call RegPack(Buf, InData%M) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackConnect(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_Connect), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackConnect' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%type) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%typeNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Attached) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Top) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nAttached) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%conM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%conV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%conFX) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%conFY) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%conFZ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%conCa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%conCdA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%time) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%r) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%a) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%U) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ud) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%zeta) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PDyn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PDyn) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Fnet) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%M) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) + type(MD_Rod), intent(in) :: SrcRodData + type(MD_Rod), intent(inout) :: DstRodData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MD_CopyRod' + ErrStat = ErrID_None + ErrMsg = '' + DstRodData%IdNum = SrcRodData%IdNum + DstRodData%type = SrcRodData%type + DstRodData%PropsIdNum = SrcRodData%PropsIdNum + DstRodData%typeNum = SrcRodData%typeNum + DstRodData%AttachedA = SrcRodData%AttachedA + DstRodData%AttachedB = SrcRodData%AttachedB + DstRodData%TopA = SrcRodData%TopA + DstRodData%TopB = SrcRodData%TopB + DstRodData%nAttachedA = SrcRodData%nAttachedA + DstRodData%nAttachedB = SrcRodData%nAttachedB + DstRodData%OutFlagList = SrcRodData%OutFlagList + DstRodData%N = SrcRodData%N + DstRodData%endTypeA = SrcRodData%endTypeA + DstRodData%endTypeB = SrcRodData%endTypeB + DstRodData%UnstrLen = SrcRodData%UnstrLen + DstRodData%mass = SrcRodData%mass + DstRodData%rho = SrcRodData%rho + DstRodData%d = SrcRodData%d + DstRodData%Can = SrcRodData%Can + DstRodData%Cat = SrcRodData%Cat + DstRodData%Cdn = SrcRodData%Cdn + DstRodData%Cdt = SrcRodData%Cdt + DstRodData%CdEnd = SrcRodData%CdEnd + DstRodData%CaEnd = SrcRodData%CaEnd + DstRodData%time = SrcRodData%time + DstRodData%roll = SrcRodData%roll + DstRodData%pitch = SrcRodData%pitch + DstRodData%h0 = SrcRodData%h0 + if (allocated(SrcRodData%r)) then + LB(1:2) = lbound(SrcRodData%r) + UB(1:2) = ubound(SrcRodData%r) + if (.not. allocated(DstRodData%r)) then + allocate(DstRodData%r(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%r.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%r = SrcRodData%r + end if + if (allocated(SrcRodData%rd)) then + LB(1:2) = lbound(SrcRodData%rd) + UB(1:2) = ubound(SrcRodData%rd) + if (.not. allocated(DstRodData%rd)) then + allocate(DstRodData%rd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%rd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%rd = SrcRodData%rd + end if + DstRodData%q = SrcRodData%q + if (allocated(SrcRodData%l)) then + LB(1:1) = lbound(SrcRodData%l) + UB(1:1) = ubound(SrcRodData%l) + if (.not. allocated(DstRodData%l)) then + allocate(DstRodData%l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%l = SrcRodData%l + end if + if (allocated(SrcRodData%V)) then + LB(1:1) = lbound(SrcRodData%V) + UB(1:1) = ubound(SrcRodData%V) + if (.not. allocated(DstRodData%V)) then + allocate(DstRodData%V(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%V.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%V = SrcRodData%V + end if + if (allocated(SrcRodData%U)) then + LB(1:2) = lbound(SrcRodData%U) + UB(1:2) = ubound(SrcRodData%U) + if (.not. allocated(DstRodData%U)) then + allocate(DstRodData%U(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%U.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%U = SrcRodData%U + end if + if (allocated(SrcRodData%Ud)) then + LB(1:2) = lbound(SrcRodData%Ud) + UB(1:2) = ubound(SrcRodData%Ud) + if (.not. allocated(DstRodData%Ud)) then + allocate(DstRodData%Ud(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ud.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Ud = SrcRodData%Ud + end if + if (allocated(SrcRodData%zeta)) then + LB(1:1) = lbound(SrcRodData%zeta) + UB(1:1) = ubound(SrcRodData%zeta) + if (.not. allocated(DstRodData%zeta)) then + allocate(DstRodData%zeta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%zeta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%zeta = SrcRodData%zeta + end if + if (allocated(SrcRodData%PDyn)) then + LB(1:1) = lbound(SrcRodData%PDyn) + UB(1:1) = ubound(SrcRodData%PDyn) + if (.not. allocated(DstRodData%PDyn)) then + allocate(DstRodData%PDyn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%PDyn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%PDyn = SrcRodData%PDyn + end if + if (allocated(SrcRodData%W)) then + LB(1:2) = lbound(SrcRodData%W) + UB(1:2) = ubound(SrcRodData%W) + if (.not. allocated(DstRodData%W)) then + allocate(DstRodData%W(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%W = SrcRodData%W + end if + if (allocated(SrcRodData%Bo)) then + LB(1:2) = lbound(SrcRodData%Bo) + UB(1:2) = ubound(SrcRodData%Bo) + if (.not. allocated(DstRodData%Bo)) then + allocate(DstRodData%Bo(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Bo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Bo = SrcRodData%Bo + end if + if (allocated(SrcRodData%Pd)) then + LB(1:2) = lbound(SrcRodData%Pd) + UB(1:2) = ubound(SrcRodData%Pd) + if (.not. allocated(DstRodData%Pd)) then + allocate(DstRodData%Pd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Pd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Pd = SrcRodData%Pd + end if + if (allocated(SrcRodData%Dp)) then + LB(1:2) = lbound(SrcRodData%Dp) + UB(1:2) = ubound(SrcRodData%Dp) + if (.not. allocated(DstRodData%Dp)) then + allocate(DstRodData%Dp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Dp = SrcRodData%Dp + end if + if (allocated(SrcRodData%Dq)) then + LB(1:2) = lbound(SrcRodData%Dq) + UB(1:2) = ubound(SrcRodData%Dq) + if (.not. allocated(DstRodData%Dq)) then + allocate(DstRodData%Dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Dq = SrcRodData%Dq + end if + if (allocated(SrcRodData%Ap)) then + LB(1:2) = lbound(SrcRodData%Ap) + UB(1:2) = ubound(SrcRodData%Ap) + if (.not. allocated(DstRodData%Ap)) then + allocate(DstRodData%Ap(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ap.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Ap = SrcRodData%Ap + end if + if (allocated(SrcRodData%Aq)) then + LB(1:2) = lbound(SrcRodData%Aq) + UB(1:2) = ubound(SrcRodData%Aq) + if (.not. allocated(DstRodData%Aq)) then + allocate(DstRodData%Aq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Aq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Aq = SrcRodData%Aq + end if + if (allocated(SrcRodData%B)) then + LB(1:2) = lbound(SrcRodData%B) + UB(1:2) = ubound(SrcRodData%B) + if (.not. allocated(DstRodData%B)) then + allocate(DstRodData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%B = SrcRodData%B + end if + if (allocated(SrcRodData%Fnet)) then + LB(1:2) = lbound(SrcRodData%Fnet) + UB(1:2) = ubound(SrcRodData%Fnet) + if (.not. allocated(DstRodData%Fnet)) then + allocate(DstRodData%Fnet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Fnet.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Fnet = SrcRodData%Fnet + end if + if (allocated(SrcRodData%M)) then + LB(1:3) = lbound(SrcRodData%M) + UB(1:3) = ubound(SrcRodData%M) + if (.not. allocated(DstRodData%M)) then + allocate(DstRodData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%M.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%M = SrcRodData%M + end if + DstRodData%FextA = SrcRodData%FextA + DstRodData%FextB = SrcRodData%FextB + DstRodData%Mext = SrcRodData%Mext + DstRodData%r6 = SrcRodData%r6 + DstRodData%v6 = SrcRodData%v6 + DstRodData%a6 = SrcRodData%a6 + DstRodData%F6net = SrcRodData%F6net + DstRodData%M6net = SrcRodData%M6net + DstRodData%OrMat = SrcRodData%OrMat + DstRodData%RodUnOut = SrcRodData%RodUnOut + if (allocated(SrcRodData%RodWrOutput)) then + LB(1:1) = lbound(SrcRodData%RodWrOutput) + UB(1:1) = ubound(SrcRodData%RodWrOutput) + if (.not. allocated(DstRodData%RodWrOutput)) then + allocate(DstRodData%RodWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%RodWrOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%RodWrOutput = SrcRodData%RodWrOutput + end if +end subroutine + +subroutine MD_DestroyRod(RodData, ErrStat, ErrMsg) + type(MD_Rod), intent(inout) :: RodData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyRod' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RodData%r)) then + deallocate(RodData%r) + end if + if (allocated(RodData%rd)) then + deallocate(RodData%rd) + end if + if (allocated(RodData%l)) then + deallocate(RodData%l) + end if + if (allocated(RodData%V)) then + deallocate(RodData%V) + end if + if (allocated(RodData%U)) then + deallocate(RodData%U) + end if + if (allocated(RodData%Ud)) then + deallocate(RodData%Ud) + end if + if (allocated(RodData%zeta)) then + deallocate(RodData%zeta) + end if + if (allocated(RodData%PDyn)) then + deallocate(RodData%PDyn) + end if + if (allocated(RodData%W)) then + deallocate(RodData%W) + end if + if (allocated(RodData%Bo)) then + deallocate(RodData%Bo) + end if + if (allocated(RodData%Pd)) then + deallocate(RodData%Pd) + end if + if (allocated(RodData%Dp)) then + deallocate(RodData%Dp) + end if + if (allocated(RodData%Dq)) then + deallocate(RodData%Dq) + end if + if (allocated(RodData%Ap)) then + deallocate(RodData%Ap) + end if + if (allocated(RodData%Aq)) then + deallocate(RodData%Aq) + end if + if (allocated(RodData%B)) then + deallocate(RodData%B) + end if + if (allocated(RodData%Fnet)) then + deallocate(RodData%Fnet) + end if + if (allocated(RodData%M)) then + deallocate(RodData%M) + end if + if (allocated(RodData%RodWrOutput)) then + deallocate(RodData%RodWrOutput) + end if +end subroutine + +subroutine MD_PackRod(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_Rod), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackRod' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%IdNum) + call RegPack(Buf, InData%type) + call RegPack(Buf, InData%PropsIdNum) + call RegPack(Buf, InData%typeNum) + call RegPack(Buf, InData%AttachedA) + call RegPack(Buf, InData%AttachedB) + call RegPack(Buf, InData%TopA) + call RegPack(Buf, InData%TopB) + call RegPack(Buf, InData%nAttachedA) + call RegPack(Buf, InData%nAttachedB) + call RegPack(Buf, InData%OutFlagList) + call RegPack(Buf, InData%N) + call RegPack(Buf, InData%endTypeA) + call RegPack(Buf, InData%endTypeB) + call RegPack(Buf, InData%UnstrLen) + call RegPack(Buf, InData%mass) + call RegPack(Buf, InData%rho) + call RegPack(Buf, InData%d) + call RegPack(Buf, InData%Can) + call RegPack(Buf, InData%Cat) + call RegPack(Buf, InData%Cdn) + call RegPack(Buf, InData%Cdt) + call RegPack(Buf, InData%CdEnd) + call RegPack(Buf, InData%CaEnd) + call RegPack(Buf, InData%time) + call RegPack(Buf, InData%roll) + call RegPack(Buf, InData%pitch) + call RegPack(Buf, InData%h0) + call RegPack(Buf, allocated(InData%r)) + if (allocated(InData%r)) then + call RegPackBounds(Buf, 2, lbound(InData%r), ubound(InData%r)) + call RegPack(Buf, InData%r) + end if + call RegPack(Buf, allocated(InData%rd)) + if (allocated(InData%rd)) then + call RegPackBounds(Buf, 2, lbound(InData%rd), ubound(InData%rd)) + call RegPack(Buf, InData%rd) + end if + call RegPack(Buf, InData%q) + call RegPack(Buf, allocated(InData%l)) + if (allocated(InData%l)) then + call RegPackBounds(Buf, 1, lbound(InData%l), ubound(InData%l)) + call RegPack(Buf, InData%l) + end if + call RegPack(Buf, allocated(InData%V)) + if (allocated(InData%V)) then + call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) + call RegPack(Buf, InData%V) + end if + call RegPack(Buf, allocated(InData%U)) + if (allocated(InData%U)) then + call RegPackBounds(Buf, 2, lbound(InData%U), ubound(InData%U)) + call RegPack(Buf, InData%U) + end if + call RegPack(Buf, allocated(InData%Ud)) + if (allocated(InData%Ud)) then + call RegPackBounds(Buf, 2, lbound(InData%Ud), ubound(InData%Ud)) + call RegPack(Buf, InData%Ud) + end if + call RegPack(Buf, allocated(InData%zeta)) + if (allocated(InData%zeta)) then + call RegPackBounds(Buf, 1, lbound(InData%zeta), ubound(InData%zeta)) + call RegPack(Buf, InData%zeta) + end if + call RegPack(Buf, allocated(InData%PDyn)) + if (allocated(InData%PDyn)) then + call RegPackBounds(Buf, 1, lbound(InData%PDyn), ubound(InData%PDyn)) + call RegPack(Buf, InData%PDyn) + end if + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 2, lbound(InData%W), ubound(InData%W)) + call RegPack(Buf, InData%W) + end if + call RegPack(Buf, allocated(InData%Bo)) + if (allocated(InData%Bo)) then + call RegPackBounds(Buf, 2, lbound(InData%Bo), ubound(InData%Bo)) + call RegPack(Buf, InData%Bo) + end if + call RegPack(Buf, allocated(InData%Pd)) + if (allocated(InData%Pd)) then + call RegPackBounds(Buf, 2, lbound(InData%Pd), ubound(InData%Pd)) + call RegPack(Buf, InData%Pd) + end if + call RegPack(Buf, allocated(InData%Dp)) + if (allocated(InData%Dp)) then + call RegPackBounds(Buf, 2, lbound(InData%Dp), ubound(InData%Dp)) + call RegPack(Buf, InData%Dp) + end if + call RegPack(Buf, allocated(InData%Dq)) + if (allocated(InData%Dq)) then + call RegPackBounds(Buf, 2, lbound(InData%Dq), ubound(InData%Dq)) + call RegPack(Buf, InData%Dq) + end if + call RegPack(Buf, allocated(InData%Ap)) + if (allocated(InData%Ap)) then + call RegPackBounds(Buf, 2, lbound(InData%Ap), ubound(InData%Ap)) + call RegPack(Buf, InData%Ap) + end if + call RegPack(Buf, allocated(InData%Aq)) + if (allocated(InData%Aq)) then + call RegPackBounds(Buf, 2, lbound(InData%Aq), ubound(InData%Aq)) + call RegPack(Buf, InData%Aq) + end if + call RegPack(Buf, allocated(InData%B)) + if (allocated(InData%B)) then + call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) + call RegPack(Buf, InData%B) + end if + call RegPack(Buf, allocated(InData%Fnet)) + if (allocated(InData%Fnet)) then + call RegPackBounds(Buf, 2, lbound(InData%Fnet), ubound(InData%Fnet)) + call RegPack(Buf, InData%Fnet) + end if + call RegPack(Buf, allocated(InData%M)) + if (allocated(InData%M)) then + call RegPackBounds(Buf, 3, lbound(InData%M), ubound(InData%M)) + call RegPack(Buf, InData%M) + end if + call RegPack(Buf, InData%FextA) + call RegPack(Buf, InData%FextB) + call RegPack(Buf, InData%Mext) + call RegPack(Buf, InData%r6) + call RegPack(Buf, InData%v6) + call RegPack(Buf, InData%a6) + call RegPack(Buf, InData%F6net) + call RegPack(Buf, InData%M6net) + call RegPack(Buf, InData%OrMat) + call RegPack(Buf, InData%RodUnOut) + call RegPack(Buf, allocated(InData%RodWrOutput)) + if (allocated(InData%RodWrOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%RodWrOutput), ubound(InData%RodWrOutput)) + call RegPack(Buf, InData%RodWrOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackRod(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_Rod), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackRod' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%type) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PropsIdNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%typeNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AttachedA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AttachedB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TopA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TopB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nAttachedA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nAttachedB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFlagList) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%N) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%endTypeA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%endTypeB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnstrLen) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%mass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rho) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%d) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Can) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cdn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cdt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CdEnd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CaEnd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%time) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%roll) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%pitch) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%h0) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%r)) deallocate(OutData%r) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rd)) deallocate(OutData%rd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rd) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%q) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%l)) deallocate(OutData%l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%l) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%V)) deallocate(OutData%V) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%U)) deallocate(OutData%U) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Ud)) deallocate(OutData%Ud) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ud(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ud) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%zeta)) deallocate(OutData%zeta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%zeta(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%zeta) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PDyn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PDyn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%W) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Bo)) deallocate(OutData%Bo) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Bo(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Bo) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Pd)) deallocate(OutData%Pd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Pd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Pd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Dp)) deallocate(OutData%Dp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Dp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Dp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Dq)) deallocate(OutData%Dq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Dq(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Dq) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Ap)) deallocate(OutData%Ap) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ap(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ap) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Aq)) deallocate(OutData%Aq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Aq(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Aq) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%B)) deallocate(OutData%B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%B) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Fnet)) deallocate(OutData%Fnet) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fnet(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fnet) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%M)) deallocate(OutData%M) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%FextA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FextB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Mext) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%r6) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%v6) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%a6) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%F6net) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%M6net) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OrMat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RodUnOut) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%RodWrOutput)) deallocate(OutData%RodWrOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RodWrOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodWrOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RodWrOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) + type(MD_Line), intent(in) :: SrcLineData + type(MD_Line), intent(inout) :: DstLineData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MD_CopyLine' + ErrStat = ErrID_None + ErrMsg = '' + DstLineData%IdNum = SrcLineData%IdNum + DstLineData%PropsIdNum = SrcLineData%PropsIdNum + DstLineData%ElasticMod = SrcLineData%ElasticMod + DstLineData%OutFlagList = SrcLineData%OutFlagList + DstLineData%CtrlChan = SrcLineData%CtrlChan + DstLineData%FairConnect = SrcLineData%FairConnect + DstLineData%AnchConnect = SrcLineData%AnchConnect + DstLineData%N = SrcLineData%N + DstLineData%endTypeA = SrcLineData%endTypeA + DstLineData%endTypeB = SrcLineData%endTypeB + DstLineData%UnstrLen = SrcLineData%UnstrLen + DstLineData%rho = SrcLineData%rho + DstLineData%d = SrcLineData%d + DstLineData%EA = SrcLineData%EA + DstLineData%EA_D = SrcLineData%EA_D + DstLineData%BA = SrcLineData%BA + DstLineData%BA_D = SrcLineData%BA_D + DstLineData%EI = SrcLineData%EI + DstLineData%Can = SrcLineData%Can + DstLineData%Cat = SrcLineData%Cat + DstLineData%Cdn = SrcLineData%Cdn + DstLineData%Cdt = SrcLineData%Cdt + DstLineData%nEApoints = SrcLineData%nEApoints + DstLineData%stiffXs = SrcLineData%stiffXs + DstLineData%stiffYs = SrcLineData%stiffYs + DstLineData%nBApoints = SrcLineData%nBApoints + DstLineData%dampXs = SrcLineData%dampXs + DstLineData%dampYs = SrcLineData%dampYs + DstLineData%nEIpoints = SrcLineData%nEIpoints + DstLineData%bstiffXs = SrcLineData%bstiffXs + DstLineData%bstiffYs = SrcLineData%bstiffYs + DstLineData%time = SrcLineData%time + if (allocated(SrcLineData%r)) then + LB(1:2) = lbound(SrcLineData%r) + UB(1:2) = ubound(SrcLineData%r) + if (.not. allocated(DstLineData%r)) then + allocate(DstLineData%r(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%r.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%r = SrcLineData%r + end if + if (allocated(SrcLineData%rd)) then + LB(1:2) = lbound(SrcLineData%rd) + UB(1:2) = ubound(SrcLineData%rd) + if (.not. allocated(DstLineData%rd)) then + allocate(DstLineData%rd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%rd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%rd = SrcLineData%rd + end if + if (allocated(SrcLineData%q)) then + LB(1:2) = lbound(SrcLineData%q) + UB(1:2) = ubound(SrcLineData%q) + if (.not. allocated(DstLineData%q)) then + allocate(DstLineData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%q.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%q = SrcLineData%q + end if + if (allocated(SrcLineData%qs)) then + LB(1:2) = lbound(SrcLineData%qs) + UB(1:2) = ubound(SrcLineData%qs) + if (.not. allocated(DstLineData%qs)) then + allocate(DstLineData%qs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%qs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%qs = SrcLineData%qs + end if + if (allocated(SrcLineData%l)) then + LB(1:1) = lbound(SrcLineData%l) + UB(1:1) = ubound(SrcLineData%l) + if (.not. allocated(DstLineData%l)) then + allocate(DstLineData%l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%l = SrcLineData%l + end if + if (allocated(SrcLineData%ld)) then + LB(1:1) = lbound(SrcLineData%ld) + UB(1:1) = ubound(SrcLineData%ld) + if (.not. allocated(DstLineData%ld)) then + allocate(DstLineData%ld(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%ld.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%ld = SrcLineData%ld + end if + if (allocated(SrcLineData%lstr)) then + LB(1:1) = lbound(SrcLineData%lstr) + UB(1:1) = ubound(SrcLineData%lstr) + if (.not. allocated(DstLineData%lstr)) then + allocate(DstLineData%lstr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%lstr = SrcLineData%lstr + end if + if (allocated(SrcLineData%lstrd)) then + LB(1:1) = lbound(SrcLineData%lstrd) + UB(1:1) = ubound(SrcLineData%lstrd) + if (.not. allocated(DstLineData%lstrd)) then + allocate(DstLineData%lstrd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstrd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%lstrd = SrcLineData%lstrd + end if + if (allocated(SrcLineData%Kurv)) then + LB(1:1) = lbound(SrcLineData%Kurv) + UB(1:1) = ubound(SrcLineData%Kurv) + if (.not. allocated(DstLineData%Kurv)) then + allocate(DstLineData%Kurv(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Kurv.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Kurv = SrcLineData%Kurv + end if + if (allocated(SrcLineData%dl_1)) then + LB(1:1) = lbound(SrcLineData%dl_1) + UB(1:1) = ubound(SrcLineData%dl_1) + if (.not. allocated(DstLineData%dl_1)) then + allocate(DstLineData%dl_1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%dl_1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%dl_1 = SrcLineData%dl_1 + end if + if (allocated(SrcLineData%V)) then + LB(1:1) = lbound(SrcLineData%V) + UB(1:1) = ubound(SrcLineData%V) + if (.not. allocated(DstLineData%V)) then + allocate(DstLineData%V(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%V.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%V = SrcLineData%V + end if + if (allocated(SrcLineData%U)) then + LB(1:2) = lbound(SrcLineData%U) + UB(1:2) = ubound(SrcLineData%U) + if (.not. allocated(DstLineData%U)) then + allocate(DstLineData%U(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%U.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%U = SrcLineData%U + end if + if (allocated(SrcLineData%Ud)) then + LB(1:2) = lbound(SrcLineData%Ud) + UB(1:2) = ubound(SrcLineData%Ud) + if (.not. allocated(DstLineData%Ud)) then + allocate(DstLineData%Ud(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Ud.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Ud = SrcLineData%Ud + end if + if (allocated(SrcLineData%zeta)) then + LB(1:1) = lbound(SrcLineData%zeta) + UB(1:1) = ubound(SrcLineData%zeta) + if (.not. allocated(DstLineData%zeta)) then + allocate(DstLineData%zeta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%zeta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%zeta = SrcLineData%zeta + end if + if (allocated(SrcLineData%PDyn)) then + LB(1:1) = lbound(SrcLineData%PDyn) + UB(1:1) = ubound(SrcLineData%PDyn) + if (.not. allocated(DstLineData%PDyn)) then + allocate(DstLineData%PDyn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%PDyn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%PDyn = SrcLineData%PDyn + end if + if (allocated(SrcLineData%T)) then + LB(1:2) = lbound(SrcLineData%T) + UB(1:2) = ubound(SrcLineData%T) + if (.not. allocated(DstLineData%T)) then + allocate(DstLineData%T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%T = SrcLineData%T + end if + if (allocated(SrcLineData%Td)) then + LB(1:2) = lbound(SrcLineData%Td) + UB(1:2) = ubound(SrcLineData%Td) + if (.not. allocated(DstLineData%Td)) then + allocate(DstLineData%Td(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Td.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Td = SrcLineData%Td + end if + if (allocated(SrcLineData%W)) then + LB(1:2) = lbound(SrcLineData%W) + UB(1:2) = ubound(SrcLineData%W) + if (.not. allocated(DstLineData%W)) then + allocate(DstLineData%W(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%W = SrcLineData%W + end if + if (allocated(SrcLineData%Dp)) then + LB(1:2) = lbound(SrcLineData%Dp) + UB(1:2) = ubound(SrcLineData%Dp) + if (.not. allocated(DstLineData%Dp)) then + allocate(DstLineData%Dp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Dp = SrcLineData%Dp + end if + if (allocated(SrcLineData%Dq)) then + LB(1:2) = lbound(SrcLineData%Dq) + UB(1:2) = ubound(SrcLineData%Dq) + if (.not. allocated(DstLineData%Dq)) then + allocate(DstLineData%Dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Dq = SrcLineData%Dq + end if + if (allocated(SrcLineData%Ap)) then + LB(1:2) = lbound(SrcLineData%Ap) + UB(1:2) = ubound(SrcLineData%Ap) + if (.not. allocated(DstLineData%Ap)) then + allocate(DstLineData%Ap(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Ap.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Ap = SrcLineData%Ap + end if + if (allocated(SrcLineData%Aq)) then + LB(1:2) = lbound(SrcLineData%Aq) + UB(1:2) = ubound(SrcLineData%Aq) + if (.not. allocated(DstLineData%Aq)) then + allocate(DstLineData%Aq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Aq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Aq = SrcLineData%Aq + end if + if (allocated(SrcLineData%B)) then + LB(1:2) = lbound(SrcLineData%B) + UB(1:2) = ubound(SrcLineData%B) + if (.not. allocated(DstLineData%B)) then + allocate(DstLineData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%B = SrcLineData%B + end if + if (allocated(SrcLineData%Bs)) then + LB(1:2) = lbound(SrcLineData%Bs) + UB(1:2) = ubound(SrcLineData%Bs) + if (.not. allocated(DstLineData%Bs)) then + allocate(DstLineData%Bs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Bs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Bs = SrcLineData%Bs + end if + if (allocated(SrcLineData%Fnet)) then + LB(1:2) = lbound(SrcLineData%Fnet) + UB(1:2) = ubound(SrcLineData%Fnet) + if (.not. allocated(DstLineData%Fnet)) then + allocate(DstLineData%Fnet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Fnet.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Fnet = SrcLineData%Fnet + end if + if (allocated(SrcLineData%S)) then + LB(1:3) = lbound(SrcLineData%S) + UB(1:3) = ubound(SrcLineData%S) + if (.not. allocated(DstLineData%S)) then + allocate(DstLineData%S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%S.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%S = SrcLineData%S + end if + if (allocated(SrcLineData%M)) then + LB(1:3) = lbound(SrcLineData%M) + UB(1:3) = ubound(SrcLineData%M) + if (.not. allocated(DstLineData%M)) then + allocate(DstLineData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%M.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%M = SrcLineData%M + end if + DstLineData%EndMomentA = SrcLineData%EndMomentA + DstLineData%EndMomentB = SrcLineData%EndMomentB + DstLineData%LineUnOut = SrcLineData%LineUnOut + if (allocated(SrcLineData%LineWrOutput)) then + LB(1:1) = lbound(SrcLineData%LineWrOutput) + UB(1:1) = ubound(SrcLineData%LineWrOutput) + if (.not. allocated(DstLineData%LineWrOutput)) then + allocate(DstLineData%LineWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%LineWrOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%LineWrOutput = SrcLineData%LineWrOutput + end if +end subroutine + +subroutine MD_DestroyLine(LineData, ErrStat, ErrMsg) + type(MD_Line), intent(inout) :: LineData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyLine' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(LineData%r)) then + deallocate(LineData%r) + end if + if (allocated(LineData%rd)) then + deallocate(LineData%rd) + end if + if (allocated(LineData%q)) then + deallocate(LineData%q) + end if + if (allocated(LineData%qs)) then + deallocate(LineData%qs) + end if + if (allocated(LineData%l)) then + deallocate(LineData%l) + end if + if (allocated(LineData%ld)) then + deallocate(LineData%ld) + end if + if (allocated(LineData%lstr)) then + deallocate(LineData%lstr) + end if + if (allocated(LineData%lstrd)) then + deallocate(LineData%lstrd) + end if + if (allocated(LineData%Kurv)) then + deallocate(LineData%Kurv) + end if + if (allocated(LineData%dl_1)) then + deallocate(LineData%dl_1) + end if + if (allocated(LineData%V)) then + deallocate(LineData%V) + end if + if (allocated(LineData%U)) then + deallocate(LineData%U) + end if + if (allocated(LineData%Ud)) then + deallocate(LineData%Ud) + end if + if (allocated(LineData%zeta)) then + deallocate(LineData%zeta) + end if + if (allocated(LineData%PDyn)) then + deallocate(LineData%PDyn) + end if + if (allocated(LineData%T)) then + deallocate(LineData%T) + end if + if (allocated(LineData%Td)) then + deallocate(LineData%Td) + end if + if (allocated(LineData%W)) then + deallocate(LineData%W) + end if + if (allocated(LineData%Dp)) then + deallocate(LineData%Dp) + end if + if (allocated(LineData%Dq)) then + deallocate(LineData%Dq) + end if + if (allocated(LineData%Ap)) then + deallocate(LineData%Ap) + end if + if (allocated(LineData%Aq)) then + deallocate(LineData%Aq) + end if + if (allocated(LineData%B)) then + deallocate(LineData%B) + end if + if (allocated(LineData%Bs)) then + deallocate(LineData%Bs) + end if + if (allocated(LineData%Fnet)) then + deallocate(LineData%Fnet) + end if + if (allocated(LineData%S)) then + deallocate(LineData%S) + end if + if (allocated(LineData%M)) then + deallocate(LineData%M) + end if + if (allocated(LineData%LineWrOutput)) then + deallocate(LineData%LineWrOutput) + end if +end subroutine + +subroutine MD_PackLine(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_Line), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackLine' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%IdNum) + call RegPack(Buf, InData%PropsIdNum) + call RegPack(Buf, InData%ElasticMod) + call RegPack(Buf, InData%OutFlagList) + call RegPack(Buf, InData%CtrlChan) + call RegPack(Buf, InData%FairConnect) + call RegPack(Buf, InData%AnchConnect) + call RegPack(Buf, InData%N) + call RegPack(Buf, InData%endTypeA) + call RegPack(Buf, InData%endTypeB) + call RegPack(Buf, InData%UnstrLen) + call RegPack(Buf, InData%rho) + call RegPack(Buf, InData%d) + call RegPack(Buf, InData%EA) + call RegPack(Buf, InData%EA_D) + call RegPack(Buf, InData%BA) + call RegPack(Buf, InData%BA_D) + call RegPack(Buf, InData%EI) + call RegPack(Buf, InData%Can) + call RegPack(Buf, InData%Cat) + call RegPack(Buf, InData%Cdn) + call RegPack(Buf, InData%Cdt) + call RegPack(Buf, InData%nEApoints) + call RegPack(Buf, InData%stiffXs) + call RegPack(Buf, InData%stiffYs) + call RegPack(Buf, InData%nBApoints) + call RegPack(Buf, InData%dampXs) + call RegPack(Buf, InData%dampYs) + call RegPack(Buf, InData%nEIpoints) + call RegPack(Buf, InData%bstiffXs) + call RegPack(Buf, InData%bstiffYs) + call RegPack(Buf, InData%time) + call RegPack(Buf, allocated(InData%r)) + if (allocated(InData%r)) then + call RegPackBounds(Buf, 2, lbound(InData%r), ubound(InData%r)) + call RegPack(Buf, InData%r) + end if + call RegPack(Buf, allocated(InData%rd)) + if (allocated(InData%rd)) then + call RegPackBounds(Buf, 2, lbound(InData%rd), ubound(InData%rd)) + call RegPack(Buf, InData%rd) + end if + call RegPack(Buf, allocated(InData%q)) + if (allocated(InData%q)) then + call RegPackBounds(Buf, 2, lbound(InData%q), ubound(InData%q)) + call RegPack(Buf, InData%q) + end if + call RegPack(Buf, allocated(InData%qs)) + if (allocated(InData%qs)) then + call RegPackBounds(Buf, 2, lbound(InData%qs), ubound(InData%qs)) + call RegPack(Buf, InData%qs) + end if + call RegPack(Buf, allocated(InData%l)) + if (allocated(InData%l)) then + call RegPackBounds(Buf, 1, lbound(InData%l), ubound(InData%l)) + call RegPack(Buf, InData%l) + end if + call RegPack(Buf, allocated(InData%ld)) + if (allocated(InData%ld)) then + call RegPackBounds(Buf, 1, lbound(InData%ld), ubound(InData%ld)) + call RegPack(Buf, InData%ld) + end if + call RegPack(Buf, allocated(InData%lstr)) + if (allocated(InData%lstr)) then + call RegPackBounds(Buf, 1, lbound(InData%lstr), ubound(InData%lstr)) + call RegPack(Buf, InData%lstr) + end if + call RegPack(Buf, allocated(InData%lstrd)) + if (allocated(InData%lstrd)) then + call RegPackBounds(Buf, 1, lbound(InData%lstrd), ubound(InData%lstrd)) + call RegPack(Buf, InData%lstrd) + end if + call RegPack(Buf, allocated(InData%Kurv)) + if (allocated(InData%Kurv)) then + call RegPackBounds(Buf, 1, lbound(InData%Kurv), ubound(InData%Kurv)) + call RegPack(Buf, InData%Kurv) + end if + call RegPack(Buf, allocated(InData%dl_1)) + if (allocated(InData%dl_1)) then + call RegPackBounds(Buf, 1, lbound(InData%dl_1), ubound(InData%dl_1)) + call RegPack(Buf, InData%dl_1) + end if + call RegPack(Buf, allocated(InData%V)) + if (allocated(InData%V)) then + call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) + call RegPack(Buf, InData%V) + end if + call RegPack(Buf, allocated(InData%U)) + if (allocated(InData%U)) then + call RegPackBounds(Buf, 2, lbound(InData%U), ubound(InData%U)) + call RegPack(Buf, InData%U) + end if + call RegPack(Buf, allocated(InData%Ud)) + if (allocated(InData%Ud)) then + call RegPackBounds(Buf, 2, lbound(InData%Ud), ubound(InData%Ud)) + call RegPack(Buf, InData%Ud) + end if + call RegPack(Buf, allocated(InData%zeta)) + if (allocated(InData%zeta)) then + call RegPackBounds(Buf, 1, lbound(InData%zeta), ubound(InData%zeta)) + call RegPack(Buf, InData%zeta) + end if + call RegPack(Buf, allocated(InData%PDyn)) + if (allocated(InData%PDyn)) then + call RegPackBounds(Buf, 1, lbound(InData%PDyn), ubound(InData%PDyn)) + call RegPack(Buf, InData%PDyn) + end if + call RegPack(Buf, allocated(InData%T)) + if (allocated(InData%T)) then + call RegPackBounds(Buf, 2, lbound(InData%T), ubound(InData%T)) + call RegPack(Buf, InData%T) + end if + call RegPack(Buf, allocated(InData%Td)) + if (allocated(InData%Td)) then + call RegPackBounds(Buf, 2, lbound(InData%Td), ubound(InData%Td)) + call RegPack(Buf, InData%Td) + end if + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 2, lbound(InData%W), ubound(InData%W)) + call RegPack(Buf, InData%W) + end if + call RegPack(Buf, allocated(InData%Dp)) + if (allocated(InData%Dp)) then + call RegPackBounds(Buf, 2, lbound(InData%Dp), ubound(InData%Dp)) + call RegPack(Buf, InData%Dp) + end if + call RegPack(Buf, allocated(InData%Dq)) + if (allocated(InData%Dq)) then + call RegPackBounds(Buf, 2, lbound(InData%Dq), ubound(InData%Dq)) + call RegPack(Buf, InData%Dq) + end if + call RegPack(Buf, allocated(InData%Ap)) + if (allocated(InData%Ap)) then + call RegPackBounds(Buf, 2, lbound(InData%Ap), ubound(InData%Ap)) + call RegPack(Buf, InData%Ap) + end if + call RegPack(Buf, allocated(InData%Aq)) + if (allocated(InData%Aq)) then + call RegPackBounds(Buf, 2, lbound(InData%Aq), ubound(InData%Aq)) + call RegPack(Buf, InData%Aq) + end if + call RegPack(Buf, allocated(InData%B)) + if (allocated(InData%B)) then + call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) + call RegPack(Buf, InData%B) + end if + call RegPack(Buf, allocated(InData%Bs)) + if (allocated(InData%Bs)) then + call RegPackBounds(Buf, 2, lbound(InData%Bs), ubound(InData%Bs)) + call RegPack(Buf, InData%Bs) + end if + call RegPack(Buf, allocated(InData%Fnet)) + if (allocated(InData%Fnet)) then + call RegPackBounds(Buf, 2, lbound(InData%Fnet), ubound(InData%Fnet)) + call RegPack(Buf, InData%Fnet) + end if + call RegPack(Buf, allocated(InData%S)) + if (allocated(InData%S)) then + call RegPackBounds(Buf, 3, lbound(InData%S), ubound(InData%S)) + call RegPack(Buf, InData%S) + end if + call RegPack(Buf, allocated(InData%M)) + if (allocated(InData%M)) then + call RegPackBounds(Buf, 3, lbound(InData%M), ubound(InData%M)) + call RegPack(Buf, InData%M) + end if + call RegPack(Buf, InData%EndMomentA) + call RegPack(Buf, InData%EndMomentB) + call RegPack(Buf, InData%LineUnOut) + call RegPack(Buf, allocated(InData%LineWrOutput)) + if (allocated(InData%LineWrOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%LineWrOutput), ubound(InData%LineWrOutput)) + call RegPack(Buf, InData%LineWrOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackLine(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_Line), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackLine' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PropsIdNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ElasticMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFlagList) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CtrlChan) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FairConnect) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AnchConnect) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%N) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%endTypeA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%endTypeB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnstrLen) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rho) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%d) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EA_D) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BA_D) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EI) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Can) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cdn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Cdt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nEApoints) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%stiffXs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%stiffYs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nBApoints) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dampXs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dampYs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nEIpoints) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%bstiffXs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%bstiffYs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%time) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%r)) deallocate(OutData%r) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rd)) deallocate(OutData%rd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%q)) deallocate(OutData%q) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%q(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%q) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%qs)) deallocate(OutData%qs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%qs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%qs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%l)) deallocate(OutData%l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%l) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ld)) deallocate(OutData%ld) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ld(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ld.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ld) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%lstr)) deallocate(OutData%lstr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%lstr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%lstr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%lstrd)) deallocate(OutData%lstrd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%lstrd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstrd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%lstrd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Kurv)) deallocate(OutData%Kurv) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Kurv(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kurv.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Kurv) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dl_1)) deallocate(OutData%dl_1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dl_1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl_1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dl_1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%V)) deallocate(OutData%V) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%U)) deallocate(OutData%U) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Ud)) deallocate(OutData%Ud) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ud(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ud) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%zeta)) deallocate(OutData%zeta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%zeta(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%zeta) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PDyn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PDyn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%T)) deallocate(OutData%T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%T(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%T) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Td)) deallocate(OutData%Td) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Td(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Td.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Td) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%W) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Dp)) deallocate(OutData%Dp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Dp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Dp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Dq)) deallocate(OutData%Dq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Dq(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Dq) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Ap)) deallocate(OutData%Ap) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ap(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ap) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Aq)) deallocate(OutData%Aq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Aq(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Aq) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%B)) deallocate(OutData%B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%B) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Bs)) deallocate(OutData%Bs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Bs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Bs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Fnet)) deallocate(OutData%Fnet) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fnet(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fnet) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%S)) deallocate(OutData%S) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%S.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%S) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%M)) deallocate(OutData%M) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%EndMomentA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EndMomentB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LineUnOut) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%LineWrOutput)) deallocate(OutData%LineWrOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineWrOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineWrOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LineWrOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine MD_CopyFail(SrcFailData, DstFailData, CtrlCode, ErrStat, ErrMsg) + type(MD_Fail), intent(in) :: SrcFailData + type(MD_Fail), intent(inout) :: DstFailData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyFail' + ErrStat = ErrID_None + ErrMsg = '' + DstFailData%IdNum = SrcFailData%IdNum +end subroutine + +subroutine MD_DestroyFail(FailData, ErrStat, ErrMsg) + type(MD_Fail), intent(inout) :: FailData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyFail' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackFail(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_Fail), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackFail' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackFail(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_Fail), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackFail' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_CopyOutParmType(SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg) + type(MD_OutParmType), intent(in) :: SrcOutParmTypeData + type(MD_OutParmType), intent(inout) :: DstOutParmTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyOutParmType' + ErrStat = ErrID_None + ErrMsg = '' + DstOutParmTypeData%Name = SrcOutParmTypeData%Name + DstOutParmTypeData%Units = SrcOutParmTypeData%Units + DstOutParmTypeData%QType = SrcOutParmTypeData%QType + DstOutParmTypeData%OType = SrcOutParmTypeData%OType + DstOutParmTypeData%NodeID = SrcOutParmTypeData%NodeID + DstOutParmTypeData%ObjID = SrcOutParmTypeData%ObjID +end subroutine + +subroutine MD_DestroyOutParmType(OutParmTypeData, ErrStat, ErrMsg) + type(MD_OutParmType), intent(inout) :: OutParmTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyOutParmType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackOutParmType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_OutParmType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackOutParmType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Name) + call RegPack(Buf, InData%Units) + call RegPack(Buf, InData%QType) + call RegPack(Buf, InData%OType) + call RegPack(Buf, InData%NodeID) + call RegPack(Buf, InData%ObjID) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackOutParmType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_OutParmType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackOutParmType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Name) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Units) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%QType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NodeID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ObjID) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(MD_InitOutputType), intent(in) :: SrcInitOutputData + type(MD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%writeOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr) + if (.not. allocated(DstInitOutputData%writeOutputHdr)) then + allocate(DstInitOutputData%writeOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%writeOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt) + if (.not. allocated(DstInitOutputData%writeOutputUnt)) then + allocate(DstInitOutputData%writeOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%CableCChanRqst)) then + LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst) + UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst) + if (.not. allocated(DstInitOutputData%CableCChanRqst)) then + allocate(DstInitOutputData%CableCChanRqst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst + end if + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x + end if +end subroutine + +subroutine MD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(MD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%writeOutputHdr)) then + deallocate(InitOutputData%writeOutputHdr) + end if + if (allocated(InitOutputData%writeOutputUnt)) then + deallocate(InitOutputData%writeOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%CableCChanRqst)) then + deallocate(InitOutputData%CableCChanRqst) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if +end subroutine + +subroutine MD_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%writeOutputHdr)) + if (allocated(InData%writeOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%writeOutputHdr), ubound(InData%writeOutputHdr)) + call RegPack(Buf, InData%writeOutputHdr) + end if + call RegPack(Buf, allocated(InData%writeOutputUnt)) + if (allocated(InData%writeOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%writeOutputUnt), ubound(InData%writeOutputUnt)) + call RegPack(Buf, InData%writeOutputUnt) + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, allocated(InData%CableCChanRqst)) + if (allocated(InData%CableCChanRqst)) then + call RegPackBounds(Buf, 1, lbound(InData%CableCChanRqst), ubound(InData%CableCChanRqst)) + call RegPack(Buf, InData%CableCChanRqst) + end if + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%writeOutputHdr)) deallocate(OutData%writeOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%writeOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%writeOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%writeOutputUnt)) deallocate(OutData%writeOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%writeOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%writeOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (allocated(OutData%CableCChanRqst)) deallocate(OutData%CableCChanRqst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableCChanRqst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableCChanRqst) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine MD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(MD_ContinuousStateType), intent(in) :: SrcContStateData + type(MD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%states)) then + LB(1:1) = lbound(SrcContStateData%states) + UB(1:1) = ubound(SrcContStateData%states) + if (.not. allocated(DstContStateData%states)) then + allocate(DstContStateData%states(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%states.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%states = SrcContStateData%states + end if +end subroutine + +subroutine MD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(MD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%states)) then + deallocate(ContStateData%states) + end if +end subroutine + +subroutine MD_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%states)) + if (allocated(InData%states)) then + call RegPackBounds(Buf, 1, lbound(InData%states), ubound(InData%states)) + call RegPack(Buf, InData%states) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackContState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%states)) deallocate(OutData%states) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%states(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%states.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%states) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine MD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(MD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(MD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%dummy = SrcDiscStateData%dummy +end subroutine + +subroutine MD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(MD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(MD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(MD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%dummy = SrcConstrStateData%dummy +end subroutine + +subroutine MD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(MD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(MD_OtherStateType), intent(in) :: SrcOtherStateData + type(MD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%dummy = SrcOtherStateData%dummy +end subroutine + +subroutine MD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(MD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(MD_MiscVarType), intent(in) :: SrcMiscData + type(MD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%LineTypeList)) then + LB(1:1) = lbound(SrcMiscData%LineTypeList) + UB(1:1) = ubound(SrcMiscData%LineTypeList) + if (.not. allocated(DstMiscData%LineTypeList)) then + allocate(DstMiscData%LineTypeList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineTypeList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyLineProp(SrcMiscData%LineTypeList(i1), DstMiscData%LineTypeList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%RodTypeList)) then + LB(1:1) = lbound(SrcMiscData%RodTypeList) + UB(1:1) = ubound(SrcMiscData%RodTypeList) + if (.not. allocated(DstMiscData%RodTypeList)) then + allocate(DstMiscData%RodTypeList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodTypeList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyRodProp(SrcMiscData%RodTypeList(i1), DstMiscData%RodTypeList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MD_CopyBody(SrcMiscData%GroundBody, DstMiscData%GroundBody, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%BodyList)) then + LB(1:1) = lbound(SrcMiscData%BodyList) + UB(1:1) = ubound(SrcMiscData%BodyList) + if (.not. allocated(DstMiscData%BodyList)) then + allocate(DstMiscData%BodyList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyBody(SrcMiscData%BodyList(i1), DstMiscData%BodyList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%RodList)) then + LB(1:1) = lbound(SrcMiscData%RodList) + UB(1:1) = ubound(SrcMiscData%RodList) + if (.not. allocated(DstMiscData%RodList)) then + allocate(DstMiscData%RodList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyRod(SrcMiscData%RodList(i1), DstMiscData%RodList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%ConnectList)) then + LB(1:1) = lbound(SrcMiscData%ConnectList) + UB(1:1) = ubound(SrcMiscData%ConnectList) + if (.not. allocated(DstMiscData%ConnectList)) then + allocate(DstMiscData%ConnectList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConnectList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyConnect(SrcMiscData%ConnectList(i1), DstMiscData%ConnectList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%LineList)) then + LB(1:1) = lbound(SrcMiscData%LineList) + UB(1:1) = ubound(SrcMiscData%LineList) + if (.not. allocated(DstMiscData%LineList)) then + allocate(DstMiscData%LineList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyLine(SrcMiscData%LineList(i1), DstMiscData%LineList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%FailList)) then + LB(1:1) = lbound(SrcMiscData%FailList) + UB(1:1) = ubound(SrcMiscData%FailList) + if (.not. allocated(DstMiscData%FailList)) then + allocate(DstMiscData%FailList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FailList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyFail(SrcMiscData%FailList(i1), DstMiscData%FailList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%FreeConIs)) then + LB(1:1) = lbound(SrcMiscData%FreeConIs) + UB(1:1) = ubound(SrcMiscData%FreeConIs) + if (.not. allocated(DstMiscData%FreeConIs)) then + allocate(DstMiscData%FreeConIs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeConIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FreeConIs = SrcMiscData%FreeConIs + end if + if (allocated(SrcMiscData%CpldConIs)) then + LB(1:2) = lbound(SrcMiscData%CpldConIs) + UB(1:2) = ubound(SrcMiscData%CpldConIs) + if (.not. allocated(DstMiscData%CpldConIs)) then + allocate(DstMiscData%CpldConIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldConIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CpldConIs = SrcMiscData%CpldConIs + end if + if (allocated(SrcMiscData%FreeRodIs)) then + LB(1:1) = lbound(SrcMiscData%FreeRodIs) + UB(1:1) = ubound(SrcMiscData%FreeRodIs) + if (.not. allocated(DstMiscData%FreeRodIs)) then + allocate(DstMiscData%FreeRodIs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeRodIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs + end if + if (allocated(SrcMiscData%CpldRodIs)) then + LB(1:2) = lbound(SrcMiscData%CpldRodIs) + UB(1:2) = ubound(SrcMiscData%CpldRodIs) + if (.not. allocated(DstMiscData%CpldRodIs)) then + allocate(DstMiscData%CpldRodIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldRodIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs + end if + if (allocated(SrcMiscData%FreeBodyIs)) then + LB(1:1) = lbound(SrcMiscData%FreeBodyIs) + UB(1:1) = ubound(SrcMiscData%FreeBodyIs) + if (.not. allocated(DstMiscData%FreeBodyIs)) then + allocate(DstMiscData%FreeBodyIs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeBodyIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs + end if + if (allocated(SrcMiscData%CpldBodyIs)) then + LB(1:2) = lbound(SrcMiscData%CpldBodyIs) + UB(1:2) = ubound(SrcMiscData%CpldBodyIs) + if (.not. allocated(DstMiscData%CpldBodyIs)) then + allocate(DstMiscData%CpldBodyIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldBodyIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs + end if + if (allocated(SrcMiscData%LineStateIs1)) then + LB(1:1) = lbound(SrcMiscData%LineStateIs1) + UB(1:1) = ubound(SrcMiscData%LineStateIs1) + if (.not. allocated(DstMiscData%LineStateIs1)) then + allocate(DstMiscData%LineStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 + end if + if (allocated(SrcMiscData%LineStateIsN)) then + LB(1:1) = lbound(SrcMiscData%LineStateIsN) + UB(1:1) = ubound(SrcMiscData%LineStateIsN) + if (.not. allocated(DstMiscData%LineStateIsN)) then + allocate(DstMiscData%LineStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN + end if + if (allocated(SrcMiscData%ConStateIs1)) then + LB(1:1) = lbound(SrcMiscData%ConStateIs1) + UB(1:1) = ubound(SrcMiscData%ConStateIs1) + if (.not. allocated(DstMiscData%ConStateIs1)) then + allocate(DstMiscData%ConStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ConStateIs1 = SrcMiscData%ConStateIs1 + end if + if (allocated(SrcMiscData%ConStateIsN)) then + LB(1:1) = lbound(SrcMiscData%ConStateIsN) + UB(1:1) = ubound(SrcMiscData%ConStateIsN) + if (.not. allocated(DstMiscData%ConStateIsN)) then + allocate(DstMiscData%ConStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ConStateIsN = SrcMiscData%ConStateIsN + end if + if (allocated(SrcMiscData%RodStateIs1)) then + LB(1:1) = lbound(SrcMiscData%RodStateIs1) + UB(1:1) = ubound(SrcMiscData%RodStateIs1) + if (.not. allocated(DstMiscData%RodStateIs1)) then + allocate(DstMiscData%RodStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 + end if + if (allocated(SrcMiscData%RodStateIsN)) then + LB(1:1) = lbound(SrcMiscData%RodStateIsN) + UB(1:1) = ubound(SrcMiscData%RodStateIsN) + if (.not. allocated(DstMiscData%RodStateIsN)) then + allocate(DstMiscData%RodStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN + end if + if (allocated(SrcMiscData%BodyStateIs1)) then + LB(1:1) = lbound(SrcMiscData%BodyStateIs1) + UB(1:1) = ubound(SrcMiscData%BodyStateIs1) + if (.not. allocated(DstMiscData%BodyStateIs1)) then + allocate(DstMiscData%BodyStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 + end if + if (allocated(SrcMiscData%BodyStateIsN)) then + LB(1:1) = lbound(SrcMiscData%BodyStateIsN) + UB(1:1) = ubound(SrcMiscData%BodyStateIsN) + if (.not. allocated(DstMiscData%BodyStateIsN)) then + allocate(DstMiscData%BodyStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN + end if + DstMiscData%Nx = SrcMiscData%Nx + DstMiscData%WaveTi = SrcMiscData%WaveTi + call MD_CopyContState(SrcMiscData%xTemp, DstMiscData%xTemp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyContState(SrcMiscData%xdTemp, DstMiscData%xdTemp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%zeros6 = SrcMiscData%zeros6 + if (allocated(SrcMiscData%MDWrOutput)) then + LB(1:1) = lbound(SrcMiscData%MDWrOutput) + UB(1:1) = ubound(SrcMiscData%MDWrOutput) + if (.not. allocated(DstMiscData%MDWrOutput)) then + allocate(DstMiscData%MDWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MDWrOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput + end if + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%PtfmInit = SrcMiscData%PtfmInit + if (allocated(SrcMiscData%BathymetryGrid)) then + LB(1:2) = lbound(SrcMiscData%BathymetryGrid) + UB(1:2) = ubound(SrcMiscData%BathymetryGrid) + if (.not. allocated(DstMiscData%BathymetryGrid)) then + allocate(DstMiscData%BathymetryGrid(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathymetryGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid + end if + if (allocated(SrcMiscData%BathGrid_Xs)) then + LB(1:1) = lbound(SrcMiscData%BathGrid_Xs) + UB(1:1) = ubound(SrcMiscData%BathGrid_Xs) + if (.not. allocated(DstMiscData%BathGrid_Xs)) then + allocate(DstMiscData%BathGrid_Xs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Xs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs + end if + if (allocated(SrcMiscData%BathGrid_Ys)) then + LB(1:1) = lbound(SrcMiscData%BathGrid_Ys) + UB(1:1) = ubound(SrcMiscData%BathGrid_Ys) + if (.not. allocated(DstMiscData%BathGrid_Ys)) then + allocate(DstMiscData%BathGrid_Ys(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Ys.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys + end if + if (allocated(SrcMiscData%BathGrid_npoints)) then + LB(1:1) = lbound(SrcMiscData%BathGrid_npoints) + UB(1:1) = ubound(SrcMiscData%BathGrid_npoints) + if (.not. allocated(DstMiscData%BathGrid_npoints)) then + allocate(DstMiscData%BathGrid_npoints(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_npoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BathGrid_npoints = SrcMiscData%BathGrid_npoints + end if +end subroutine + +subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(MD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%LineTypeList)) then + LB(1:1) = lbound(MiscData%LineTypeList) + UB(1:1) = ubound(MiscData%LineTypeList) + do i1 = LB(1), UB(1) + call MD_DestroyLineProp(MiscData%LineTypeList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%LineTypeList) + end if + if (allocated(MiscData%RodTypeList)) then + LB(1:1) = lbound(MiscData%RodTypeList) + UB(1:1) = ubound(MiscData%RodTypeList) + do i1 = LB(1), UB(1) + call MD_DestroyRodProp(MiscData%RodTypeList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%RodTypeList) + end if + call MD_DestroyBody(MiscData%GroundBody, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%BodyList)) then + LB(1:1) = lbound(MiscData%BodyList) + UB(1:1) = ubound(MiscData%BodyList) + do i1 = LB(1), UB(1) + call MD_DestroyBody(MiscData%BodyList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%BodyList) + end if + if (allocated(MiscData%RodList)) then + LB(1:1) = lbound(MiscData%RodList) + UB(1:1) = ubound(MiscData%RodList) + do i1 = LB(1), UB(1) + call MD_DestroyRod(MiscData%RodList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%RodList) + end if + if (allocated(MiscData%ConnectList)) then + LB(1:1) = lbound(MiscData%ConnectList) + UB(1:1) = ubound(MiscData%ConnectList) + do i1 = LB(1), UB(1) + call MD_DestroyConnect(MiscData%ConnectList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%ConnectList) + end if + if (allocated(MiscData%LineList)) then + LB(1:1) = lbound(MiscData%LineList) + UB(1:1) = ubound(MiscData%LineList) + do i1 = LB(1), UB(1) + call MD_DestroyLine(MiscData%LineList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%LineList) + end if + if (allocated(MiscData%FailList)) then + LB(1:1) = lbound(MiscData%FailList) + UB(1:1) = ubound(MiscData%FailList) + do i1 = LB(1), UB(1) + call MD_DestroyFail(MiscData%FailList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%FailList) + end if + if (allocated(MiscData%FreeConIs)) then + deallocate(MiscData%FreeConIs) + end if + if (allocated(MiscData%CpldConIs)) then + deallocate(MiscData%CpldConIs) + end if + if (allocated(MiscData%FreeRodIs)) then + deallocate(MiscData%FreeRodIs) + end if + if (allocated(MiscData%CpldRodIs)) then + deallocate(MiscData%CpldRodIs) + end if + if (allocated(MiscData%FreeBodyIs)) then + deallocate(MiscData%FreeBodyIs) + end if + if (allocated(MiscData%CpldBodyIs)) then + deallocate(MiscData%CpldBodyIs) + end if + if (allocated(MiscData%LineStateIs1)) then + deallocate(MiscData%LineStateIs1) + end if + if (allocated(MiscData%LineStateIsN)) then + deallocate(MiscData%LineStateIsN) + end if + if (allocated(MiscData%ConStateIs1)) then + deallocate(MiscData%ConStateIs1) + end if + if (allocated(MiscData%ConStateIsN)) then + deallocate(MiscData%ConStateIsN) + end if + if (allocated(MiscData%RodStateIs1)) then + deallocate(MiscData%RodStateIs1) + end if + if (allocated(MiscData%RodStateIsN)) then + deallocate(MiscData%RodStateIsN) + end if + if (allocated(MiscData%BodyStateIs1)) then + deallocate(MiscData%BodyStateIs1) + end if + if (allocated(MiscData%BodyStateIsN)) then + deallocate(MiscData%BodyStateIsN) + end if + call MD_DestroyContState(MiscData%xTemp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyContState(MiscData%xdTemp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%MDWrOutput)) then + deallocate(MiscData%MDWrOutput) + end if + if (allocated(MiscData%BathymetryGrid)) then + deallocate(MiscData%BathymetryGrid) + end if + if (allocated(MiscData%BathGrid_Xs)) then + deallocate(MiscData%BathGrid_Xs) + end if + if (allocated(MiscData%BathGrid_Ys)) then + deallocate(MiscData%BathGrid_Ys) + end if + if (allocated(MiscData%BathGrid_npoints)) then + deallocate(MiscData%BathGrid_npoints) + end if +end subroutine + +subroutine MD_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%LineTypeList)) + if (allocated(InData%LineTypeList)) then + call RegPackBounds(Buf, 1, lbound(InData%LineTypeList), ubound(InData%LineTypeList)) + LB(1:1) = lbound(InData%LineTypeList) + UB(1:1) = ubound(InData%LineTypeList) + do i1 = LB(1), UB(1) + call MD_PackLineProp(Buf, InData%LineTypeList(i1)) + end do + end if + call RegPack(Buf, allocated(InData%RodTypeList)) + if (allocated(InData%RodTypeList)) then + call RegPackBounds(Buf, 1, lbound(InData%RodTypeList), ubound(InData%RodTypeList)) + LB(1:1) = lbound(InData%RodTypeList) + UB(1:1) = ubound(InData%RodTypeList) + do i1 = LB(1), UB(1) + call MD_PackRodProp(Buf, InData%RodTypeList(i1)) + end do + end if + call MD_PackBody(Buf, InData%GroundBody) + call RegPack(Buf, allocated(InData%BodyList)) + if (allocated(InData%BodyList)) then + call RegPackBounds(Buf, 1, lbound(InData%BodyList), ubound(InData%BodyList)) + LB(1:1) = lbound(InData%BodyList) + UB(1:1) = ubound(InData%BodyList) + do i1 = LB(1), UB(1) + call MD_PackBody(Buf, InData%BodyList(i1)) + end do + end if + call RegPack(Buf, allocated(InData%RodList)) + if (allocated(InData%RodList)) then + call RegPackBounds(Buf, 1, lbound(InData%RodList), ubound(InData%RodList)) + LB(1:1) = lbound(InData%RodList) + UB(1:1) = ubound(InData%RodList) + do i1 = LB(1), UB(1) + call MD_PackRod(Buf, InData%RodList(i1)) + end do + end if + call RegPack(Buf, allocated(InData%ConnectList)) + if (allocated(InData%ConnectList)) then + call RegPackBounds(Buf, 1, lbound(InData%ConnectList), ubound(InData%ConnectList)) + LB(1:1) = lbound(InData%ConnectList) + UB(1:1) = ubound(InData%ConnectList) + do i1 = LB(1), UB(1) + call MD_PackConnect(Buf, InData%ConnectList(i1)) + end do + end if + call RegPack(Buf, allocated(InData%LineList)) + if (allocated(InData%LineList)) then + call RegPackBounds(Buf, 1, lbound(InData%LineList), ubound(InData%LineList)) + LB(1:1) = lbound(InData%LineList) + UB(1:1) = ubound(InData%LineList) + do i1 = LB(1), UB(1) + call MD_PackLine(Buf, InData%LineList(i1)) + end do + end if + call RegPack(Buf, allocated(InData%FailList)) + if (allocated(InData%FailList)) then + call RegPackBounds(Buf, 1, lbound(InData%FailList), ubound(InData%FailList)) + LB(1:1) = lbound(InData%FailList) + UB(1:1) = ubound(InData%FailList) + do i1 = LB(1), UB(1) + call MD_PackFail(Buf, InData%FailList(i1)) + end do + end if + call RegPack(Buf, allocated(InData%FreeConIs)) + if (allocated(InData%FreeConIs)) then + call RegPackBounds(Buf, 1, lbound(InData%FreeConIs), ubound(InData%FreeConIs)) + call RegPack(Buf, InData%FreeConIs) + end if + call RegPack(Buf, allocated(InData%CpldConIs)) + if (allocated(InData%CpldConIs)) then + call RegPackBounds(Buf, 2, lbound(InData%CpldConIs), ubound(InData%CpldConIs)) + call RegPack(Buf, InData%CpldConIs) + end if + call RegPack(Buf, allocated(InData%FreeRodIs)) + if (allocated(InData%FreeRodIs)) then + call RegPackBounds(Buf, 1, lbound(InData%FreeRodIs), ubound(InData%FreeRodIs)) + call RegPack(Buf, InData%FreeRodIs) + end if + call RegPack(Buf, allocated(InData%CpldRodIs)) + if (allocated(InData%CpldRodIs)) then + call RegPackBounds(Buf, 2, lbound(InData%CpldRodIs), ubound(InData%CpldRodIs)) + call RegPack(Buf, InData%CpldRodIs) + end if + call RegPack(Buf, allocated(InData%FreeBodyIs)) + if (allocated(InData%FreeBodyIs)) then + call RegPackBounds(Buf, 1, lbound(InData%FreeBodyIs), ubound(InData%FreeBodyIs)) + call RegPack(Buf, InData%FreeBodyIs) + end if + call RegPack(Buf, allocated(InData%CpldBodyIs)) + if (allocated(InData%CpldBodyIs)) then + call RegPackBounds(Buf, 2, lbound(InData%CpldBodyIs), ubound(InData%CpldBodyIs)) + call RegPack(Buf, InData%CpldBodyIs) + end if + call RegPack(Buf, allocated(InData%LineStateIs1)) + if (allocated(InData%LineStateIs1)) then + call RegPackBounds(Buf, 1, lbound(InData%LineStateIs1), ubound(InData%LineStateIs1)) + call RegPack(Buf, InData%LineStateIs1) + end if + call RegPack(Buf, allocated(InData%LineStateIsN)) + if (allocated(InData%LineStateIsN)) then + call RegPackBounds(Buf, 1, lbound(InData%LineStateIsN), ubound(InData%LineStateIsN)) + call RegPack(Buf, InData%LineStateIsN) + end if + call RegPack(Buf, allocated(InData%ConStateIs1)) + if (allocated(InData%ConStateIs1)) then + call RegPackBounds(Buf, 1, lbound(InData%ConStateIs1), ubound(InData%ConStateIs1)) + call RegPack(Buf, InData%ConStateIs1) + end if + call RegPack(Buf, allocated(InData%ConStateIsN)) + if (allocated(InData%ConStateIsN)) then + call RegPackBounds(Buf, 1, lbound(InData%ConStateIsN), ubound(InData%ConStateIsN)) + call RegPack(Buf, InData%ConStateIsN) + end if + call RegPack(Buf, allocated(InData%RodStateIs1)) + if (allocated(InData%RodStateIs1)) then + call RegPackBounds(Buf, 1, lbound(InData%RodStateIs1), ubound(InData%RodStateIs1)) + call RegPack(Buf, InData%RodStateIs1) + end if + call RegPack(Buf, allocated(InData%RodStateIsN)) + if (allocated(InData%RodStateIsN)) then + call RegPackBounds(Buf, 1, lbound(InData%RodStateIsN), ubound(InData%RodStateIsN)) + call RegPack(Buf, InData%RodStateIsN) + end if + call RegPack(Buf, allocated(InData%BodyStateIs1)) + if (allocated(InData%BodyStateIs1)) then + call RegPackBounds(Buf, 1, lbound(InData%BodyStateIs1), ubound(InData%BodyStateIs1)) + call RegPack(Buf, InData%BodyStateIs1) + end if + call RegPack(Buf, allocated(InData%BodyStateIsN)) + if (allocated(InData%BodyStateIsN)) then + call RegPackBounds(Buf, 1, lbound(InData%BodyStateIsN), ubound(InData%BodyStateIsN)) + call RegPack(Buf, InData%BodyStateIsN) + end if + call RegPack(Buf, InData%Nx) + call RegPack(Buf, InData%WaveTi) + call MD_PackContState(Buf, InData%xTemp) + call MD_PackContState(Buf, InData%xdTemp) + call RegPack(Buf, InData%zeros6) + call RegPack(Buf, allocated(InData%MDWrOutput)) + if (allocated(InData%MDWrOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%MDWrOutput), ubound(InData%MDWrOutput)) + call RegPack(Buf, InData%MDWrOutput) + end if + call RegPack(Buf, InData%LastOutTime) + call RegPack(Buf, InData%PtfmInit) + call RegPack(Buf, allocated(InData%BathymetryGrid)) + if (allocated(InData%BathymetryGrid)) then + call RegPackBounds(Buf, 2, lbound(InData%BathymetryGrid), ubound(InData%BathymetryGrid)) + call RegPack(Buf, InData%BathymetryGrid) + end if + call RegPack(Buf, allocated(InData%BathGrid_Xs)) + if (allocated(InData%BathGrid_Xs)) then + call RegPackBounds(Buf, 1, lbound(InData%BathGrid_Xs), ubound(InData%BathGrid_Xs)) + call RegPack(Buf, InData%BathGrid_Xs) + end if + call RegPack(Buf, allocated(InData%BathGrid_Ys)) + if (allocated(InData%BathGrid_Ys)) then + call RegPackBounds(Buf, 1, lbound(InData%BathGrid_Ys), ubound(InData%BathGrid_Ys)) + call RegPack(Buf, InData%BathGrid_Ys) + end if + call RegPack(Buf, allocated(InData%BathGrid_npoints)) + if (allocated(InData%BathGrid_npoints)) then + call RegPackBounds(Buf, 1, lbound(InData%BathGrid_npoints), ubound(InData%BathGrid_npoints)) + call RegPack(Buf, InData%BathGrid_npoints) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%LineTypeList)) deallocate(OutData%LineTypeList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineTypeList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackLineProp(Buf, OutData%LineTypeList(i1)) ! LineTypeList + end do + end if + if (allocated(OutData%RodTypeList)) deallocate(OutData%RodTypeList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RodTypeList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodTypeList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackRodProp(Buf, OutData%RodTypeList(i1)) ! RodTypeList + end do + end if + call MD_UnpackBody(Buf, OutData%GroundBody) ! GroundBody + if (allocated(OutData%BodyList)) deallocate(OutData%BodyList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BodyList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackBody(Buf, OutData%BodyList(i1)) ! BodyList + end do + end if + if (allocated(OutData%RodList)) deallocate(OutData%RodList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RodList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackRod(Buf, OutData%RodList(i1)) ! RodList + end do + end if + if (allocated(OutData%ConnectList)) deallocate(OutData%ConnectList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ConnectList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConnectList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackConnect(Buf, OutData%ConnectList(i1)) ! ConnectList + end do + end if + if (allocated(OutData%LineList)) deallocate(OutData%LineList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackLine(Buf, OutData%LineList(i1)) ! LineList + end do + end if + if (allocated(OutData%FailList)) deallocate(OutData%FailList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FailList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FailList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackFail(Buf, OutData%FailList(i1)) ! FailList + end do + end if + if (allocated(OutData%FreeConIs)) deallocate(OutData%FreeConIs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FreeConIs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeConIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FreeConIs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CpldConIs)) deallocate(OutData%CpldConIs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CpldConIs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldConIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CpldConIs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FreeRodIs)) deallocate(OutData%FreeRodIs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FreeRodIs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeRodIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FreeRodIs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CpldRodIs)) deallocate(OutData%CpldRodIs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CpldRodIs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldRodIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CpldRodIs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FreeBodyIs)) deallocate(OutData%FreeBodyIs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FreeBodyIs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeBodyIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FreeBodyIs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CpldBodyIs)) deallocate(OutData%CpldBodyIs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CpldBodyIs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldBodyIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CpldBodyIs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LineStateIs1)) deallocate(OutData%LineStateIs1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineStateIs1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIs1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LineStateIs1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LineStateIsN)) deallocate(OutData%LineStateIsN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineStateIsN(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIsN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LineStateIsN) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ConStateIs1)) deallocate(OutData%ConStateIs1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ConStateIs1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConStateIs1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ConStateIs1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ConStateIsN)) deallocate(OutData%ConStateIsN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ConStateIsN(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConStateIsN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ConStateIsN) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RodStateIs1)) deallocate(OutData%RodStateIs1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RodStateIs1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIs1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RodStateIs1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RodStateIsN)) deallocate(OutData%RodStateIsN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RodStateIsN(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIsN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RodStateIsN) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BodyStateIs1)) deallocate(OutData%BodyStateIs1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BodyStateIs1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIs1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BodyStateIs1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BodyStateIsN)) deallocate(OutData%BodyStateIsN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BodyStateIsN(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIsN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BodyStateIsN) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Nx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveTi) + if (RegCheckErr(Buf, RoutineName)) return + call MD_UnpackContState(Buf, OutData%xTemp) ! xTemp + call MD_UnpackContState(Buf, OutData%xdTemp) ! xdTemp + call RegUnpack(Buf, OutData%zeros6) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%MDWrOutput)) deallocate(OutData%MDWrOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MDWrOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MDWrOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MDWrOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%LastOutTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmInit) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BathymetryGrid)) deallocate(OutData%BathymetryGrid) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BathymetryGrid(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathymetryGrid.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BathymetryGrid) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BathGrid_Xs)) deallocate(OutData%BathGrid_Xs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BathGrid_Xs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Xs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BathGrid_Xs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BathGrid_Ys)) deallocate(OutData%BathGrid_Ys) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BathGrid_Ys(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Ys.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BathGrid_Ys) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BathGrid_npoints)) deallocate(OutData%BathGrid_npoints) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BathGrid_npoints(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_npoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BathGrid_npoints) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(MD_ParameterType), intent(in) :: SrcParamData + type(MD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%nLineTypes = SrcParamData%nLineTypes + DstParamData%nRodTypes = SrcParamData%nRodTypes + DstParamData%nConnects = SrcParamData%nConnects + DstParamData%nConnectsExtra = SrcParamData%nConnectsExtra + DstParamData%nBodies = SrcParamData%nBodies + DstParamData%nRods = SrcParamData%nRods + DstParamData%nLines = SrcParamData%nLines + DstParamData%nCtrlChans = SrcParamData%nCtrlChans + DstParamData%nFails = SrcParamData%nFails + DstParamData%nFreeBodies = SrcParamData%nFreeBodies + DstParamData%nFreeRods = SrcParamData%nFreeRods + DstParamData%nFreeCons = SrcParamData%nFreeCons + if (allocated(SrcParamData%nCpldBodies)) then + LB(1:1) = lbound(SrcParamData%nCpldBodies) + UB(1:1) = ubound(SrcParamData%nCpldBodies) + if (.not. allocated(DstParamData%nCpldBodies)) then + allocate(DstParamData%nCpldBodies(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldBodies.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%nCpldBodies = SrcParamData%nCpldBodies + end if + if (allocated(SrcParamData%nCpldRods)) then + LB(1:1) = lbound(SrcParamData%nCpldRods) + UB(1:1) = ubound(SrcParamData%nCpldRods) + if (.not. allocated(DstParamData%nCpldRods)) then + allocate(DstParamData%nCpldRods(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldRods.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%nCpldRods = SrcParamData%nCpldRods + end if + if (allocated(SrcParamData%nCpldCons)) then + LB(1:1) = lbound(SrcParamData%nCpldCons) + UB(1:1) = ubound(SrcParamData%nCpldCons) + if (.not. allocated(DstParamData%nCpldCons)) then + allocate(DstParamData%nCpldCons(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldCons.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%nCpldCons = SrcParamData%nCpldCons + end if + DstParamData%NConns = SrcParamData%NConns + DstParamData%NAnchs = SrcParamData%NAnchs + DstParamData%Tmax = SrcParamData%Tmax + DstParamData%g = SrcParamData%g + DstParamData%rhoW = SrcParamData%rhoW + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%kBot = SrcParamData%kBot + DstParamData%cBot = SrcParamData%cBot + DstParamData%dtM0 = SrcParamData%dtM0 + DstParamData%dtCoupling = SrcParamData%dtCoupling + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%dtOut = SrcParamData%dtOut + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%Delim = SrcParamData%Delim + DstParamData%MDUnOut = SrcParamData%MDUnOut + DstParamData%PriPath = SrcParamData%PriPath + DstParamData%writeLog = SrcParamData%writeLog + DstParamData%UnLog = SrcParamData%UnLog + DstParamData%WaveKin = SrcParamData%WaveKin + DstParamData%Current = SrcParamData%Current + DstParamData%nTurbines = SrcParamData%nTurbines + if (allocated(SrcParamData%TurbineRefPos)) then + LB(1:2) = lbound(SrcParamData%TurbineRefPos) + UB(1:2) = ubound(SrcParamData%TurbineRefPos) + if (.not. allocated(DstParamData%TurbineRefPos)) then + allocate(DstParamData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TurbineRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TurbineRefPos = SrcParamData%TurbineRefPos + end if + DstParamData%mu_kT = SrcParamData%mu_kT + DstParamData%mu_kA = SrcParamData%mu_kA + DstParamData%mc = SrcParamData%mc + DstParamData%cv = SrcParamData%cv + DstParamData%nxWave = SrcParamData%nxWave + DstParamData%nyWave = SrcParamData%nyWave + DstParamData%nzWave = SrcParamData%nzWave + DstParamData%ntWave = SrcParamData%ntWave + if (allocated(SrcParamData%pxWave)) then + LB(1:1) = lbound(SrcParamData%pxWave) + UB(1:1) = ubound(SrcParamData%pxWave) + if (.not. allocated(DstParamData%pxWave)) then + allocate(DstParamData%pxWave(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pxWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%pxWave = SrcParamData%pxWave + end if + if (allocated(SrcParamData%pyWave)) then + LB(1:1) = lbound(SrcParamData%pyWave) + UB(1:1) = ubound(SrcParamData%pyWave) + if (.not. allocated(DstParamData%pyWave)) then + allocate(DstParamData%pyWave(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pyWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%pyWave = SrcParamData%pyWave + end if + if (allocated(SrcParamData%pzWave)) then + LB(1:1) = lbound(SrcParamData%pzWave) + UB(1:1) = ubound(SrcParamData%pzWave) + if (.not. allocated(DstParamData%pzWave)) then + allocate(DstParamData%pzWave(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%pzWave = SrcParamData%pzWave + end if + DstParamData%dtWave = SrcParamData%dtWave + if (allocated(SrcParamData%uxWave)) then + LB(1:4) = lbound(SrcParamData%uxWave) + UB(1:4) = ubound(SrcParamData%uxWave) + if (.not. allocated(DstParamData%uxWave)) then + allocate(DstParamData%uxWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uxWave = SrcParamData%uxWave + end if + if (allocated(SrcParamData%uyWave)) then + LB(1:4) = lbound(SrcParamData%uyWave) + UB(1:4) = ubound(SrcParamData%uyWave) + if (.not. allocated(DstParamData%uyWave)) then + allocate(DstParamData%uyWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uyWave = SrcParamData%uyWave + end if + if (allocated(SrcParamData%uzWave)) then + LB(1:4) = lbound(SrcParamData%uzWave) + UB(1:4) = ubound(SrcParamData%uzWave) + if (.not. allocated(DstParamData%uzWave)) then + allocate(DstParamData%uzWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uzWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uzWave = SrcParamData%uzWave + end if + if (allocated(SrcParamData%axWave)) then + LB(1:4) = lbound(SrcParamData%axWave) + UB(1:4) = ubound(SrcParamData%axWave) + if (.not. allocated(DstParamData%axWave)) then + allocate(DstParamData%axWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%axWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%axWave = SrcParamData%axWave + end if + if (allocated(SrcParamData%ayWave)) then + LB(1:4) = lbound(SrcParamData%ayWave) + UB(1:4) = ubound(SrcParamData%ayWave) + if (.not. allocated(DstParamData%ayWave)) then + allocate(DstParamData%ayWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ayWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ayWave = SrcParamData%ayWave + end if + if (allocated(SrcParamData%azWave)) then + LB(1:4) = lbound(SrcParamData%azWave) + UB(1:4) = ubound(SrcParamData%azWave) + if (.not. allocated(DstParamData%azWave)) then + allocate(DstParamData%azWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%azWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%azWave = SrcParamData%azWave + end if + if (allocated(SrcParamData%PDyn)) then + LB(1:4) = lbound(SrcParamData%PDyn) + UB(1:4) = ubound(SrcParamData%PDyn) + if (.not. allocated(DstParamData%PDyn)) then + allocate(DstParamData%PDyn(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PDyn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PDyn = SrcParamData%PDyn + end if + if (allocated(SrcParamData%zeta)) then + LB(1:3) = lbound(SrcParamData%zeta) + UB(1:3) = ubound(SrcParamData%zeta) + if (.not. allocated(DstParamData%zeta)) then + allocate(DstParamData%zeta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zeta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%zeta = SrcParamData%zeta + end if + DstParamData%nzCurrent = SrcParamData%nzCurrent + if (allocated(SrcParamData%pzCurrent)) then + LB(1:1) = lbound(SrcParamData%pzCurrent) + UB(1:1) = ubound(SrcParamData%pzCurrent) + if (.not. allocated(DstParamData%pzCurrent)) then + allocate(DstParamData%pzCurrent(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzCurrent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%pzCurrent = SrcParamData%pzCurrent + end if + if (allocated(SrcParamData%uxCurrent)) then + LB(1:1) = lbound(SrcParamData%uxCurrent) + UB(1:1) = ubound(SrcParamData%uxCurrent) + if (.not. allocated(DstParamData%uxCurrent)) then + allocate(DstParamData%uxCurrent(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxCurrent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uxCurrent = SrcParamData%uxCurrent + end if + if (allocated(SrcParamData%uyCurrent)) then + LB(1:1) = lbound(SrcParamData%uyCurrent) + UB(1:1) = ubound(SrcParamData%uyCurrent) + if (.not. allocated(DstParamData%uyCurrent)) then + allocate(DstParamData%uyCurrent(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyCurrent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uyCurrent = SrcParamData%uyCurrent + end if + DstParamData%Nx0 = SrcParamData%Nx0 + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du + end if + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx + end if + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + if (allocated(SrcParamData%dxIdx_map2_xStateIdx)) then + LB(1:1) = lbound(SrcParamData%dxIdx_map2_xStateIdx) + UB(1:1) = ubound(SrcParamData%dxIdx_map2_xStateIdx) + if (.not. allocated(DstParamData%dxIdx_map2_xStateIdx)) then + allocate(DstParamData%dxIdx_map2_xStateIdx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dxIdx_map2_xStateIdx = SrcParamData%dxIdx_map2_xStateIdx + end if +end subroutine + +subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(MD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%nCpldBodies)) then + deallocate(ParamData%nCpldBodies) + end if + if (allocated(ParamData%nCpldRods)) then + deallocate(ParamData%nCpldRods) + end if + if (allocated(ParamData%nCpldCons)) then + deallocate(ParamData%nCpldCons) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call MD_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%TurbineRefPos)) then + deallocate(ParamData%TurbineRefPos) + end if + if (allocated(ParamData%pxWave)) then + deallocate(ParamData%pxWave) + end if + if (allocated(ParamData%pyWave)) then + deallocate(ParamData%pyWave) + end if + if (allocated(ParamData%pzWave)) then + deallocate(ParamData%pzWave) + end if + if (allocated(ParamData%uxWave)) then + deallocate(ParamData%uxWave) + end if + if (allocated(ParamData%uyWave)) then + deallocate(ParamData%uyWave) + end if + if (allocated(ParamData%uzWave)) then + deallocate(ParamData%uzWave) + end if + if (allocated(ParamData%axWave)) then + deallocate(ParamData%axWave) + end if + if (allocated(ParamData%ayWave)) then + deallocate(ParamData%ayWave) + end if + if (allocated(ParamData%azWave)) then + deallocate(ParamData%azWave) + end if + if (allocated(ParamData%PDyn)) then + deallocate(ParamData%PDyn) + end if + if (allocated(ParamData%zeta)) then + deallocate(ParamData%zeta) + end if + if (allocated(ParamData%pzCurrent)) then + deallocate(ParamData%pzCurrent) + end if + if (allocated(ParamData%uxCurrent)) then + deallocate(ParamData%uxCurrent) + end if + if (allocated(ParamData%uyCurrent)) then + deallocate(ParamData%uyCurrent) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) + end if + if (allocated(ParamData%dxIdx_map2_xStateIdx)) then + deallocate(ParamData%dxIdx_map2_xStateIdx) + end if +end subroutine + +subroutine MD_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackParam' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%nLineTypes) + call RegPack(Buf, InData%nRodTypes) + call RegPack(Buf, InData%nConnects) + call RegPack(Buf, InData%nConnectsExtra) + call RegPack(Buf, InData%nBodies) + call RegPack(Buf, InData%nRods) + call RegPack(Buf, InData%nLines) + call RegPack(Buf, InData%nCtrlChans) + call RegPack(Buf, InData%nFails) + call RegPack(Buf, InData%nFreeBodies) + call RegPack(Buf, InData%nFreeRods) + call RegPack(Buf, InData%nFreeCons) + call RegPack(Buf, allocated(InData%nCpldBodies)) + if (allocated(InData%nCpldBodies)) then + call RegPackBounds(Buf, 1, lbound(InData%nCpldBodies), ubound(InData%nCpldBodies)) + call RegPack(Buf, InData%nCpldBodies) + end if + call RegPack(Buf, allocated(InData%nCpldRods)) + if (allocated(InData%nCpldRods)) then + call RegPackBounds(Buf, 1, lbound(InData%nCpldRods), ubound(InData%nCpldRods)) + call RegPack(Buf, InData%nCpldRods) + end if + call RegPack(Buf, allocated(InData%nCpldCons)) + if (allocated(InData%nCpldCons)) then + call RegPackBounds(Buf, 1, lbound(InData%nCpldCons), ubound(InData%nCpldCons)) + call RegPack(Buf, InData%nCpldCons) + end if + call RegPack(Buf, InData%NConns) + call RegPack(Buf, InData%NAnchs) + call RegPack(Buf, InData%Tmax) + call RegPack(Buf, InData%g) + call RegPack(Buf, InData%rhoW) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%kBot) + call RegPack(Buf, InData%cBot) + call RegPack(Buf, InData%dtM0) + call RegPack(Buf, InData%dtCoupling) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%dtOut) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call MD_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + call RegPack(Buf, InData%Delim) + call RegPack(Buf, InData%MDUnOut) + call RegPack(Buf, InData%PriPath) + call RegPack(Buf, InData%writeLog) + call RegPack(Buf, InData%UnLog) + call RegPack(Buf, InData%WaveKin) + call RegPack(Buf, InData%Current) + call RegPack(Buf, InData%nTurbines) + call RegPack(Buf, allocated(InData%TurbineRefPos)) + if (allocated(InData%TurbineRefPos)) then + call RegPackBounds(Buf, 2, lbound(InData%TurbineRefPos), ubound(InData%TurbineRefPos)) + call RegPack(Buf, InData%TurbineRefPos) + end if + call RegPack(Buf, InData%mu_kT) + call RegPack(Buf, InData%mu_kA) + call RegPack(Buf, InData%mc) + call RegPack(Buf, InData%cv) + call RegPack(Buf, InData%nxWave) + call RegPack(Buf, InData%nyWave) + call RegPack(Buf, InData%nzWave) + call RegPack(Buf, InData%ntWave) + call RegPack(Buf, allocated(InData%pxWave)) + if (allocated(InData%pxWave)) then + call RegPackBounds(Buf, 1, lbound(InData%pxWave), ubound(InData%pxWave)) + call RegPack(Buf, InData%pxWave) + end if + call RegPack(Buf, allocated(InData%pyWave)) + if (allocated(InData%pyWave)) then + call RegPackBounds(Buf, 1, lbound(InData%pyWave), ubound(InData%pyWave)) + call RegPack(Buf, InData%pyWave) + end if + call RegPack(Buf, allocated(InData%pzWave)) + if (allocated(InData%pzWave)) then + call RegPackBounds(Buf, 1, lbound(InData%pzWave), ubound(InData%pzWave)) + call RegPack(Buf, InData%pzWave) + end if + call RegPack(Buf, InData%dtWave) + call RegPack(Buf, allocated(InData%uxWave)) + if (allocated(InData%uxWave)) then + call RegPackBounds(Buf, 4, lbound(InData%uxWave), ubound(InData%uxWave)) + call RegPack(Buf, InData%uxWave) + end if + call RegPack(Buf, allocated(InData%uyWave)) + if (allocated(InData%uyWave)) then + call RegPackBounds(Buf, 4, lbound(InData%uyWave), ubound(InData%uyWave)) + call RegPack(Buf, InData%uyWave) + end if + call RegPack(Buf, allocated(InData%uzWave)) + if (allocated(InData%uzWave)) then + call RegPackBounds(Buf, 4, lbound(InData%uzWave), ubound(InData%uzWave)) + call RegPack(Buf, InData%uzWave) + end if + call RegPack(Buf, allocated(InData%axWave)) + if (allocated(InData%axWave)) then + call RegPackBounds(Buf, 4, lbound(InData%axWave), ubound(InData%axWave)) + call RegPack(Buf, InData%axWave) + end if + call RegPack(Buf, allocated(InData%ayWave)) + if (allocated(InData%ayWave)) then + call RegPackBounds(Buf, 4, lbound(InData%ayWave), ubound(InData%ayWave)) + call RegPack(Buf, InData%ayWave) + end if + call RegPack(Buf, allocated(InData%azWave)) + if (allocated(InData%azWave)) then + call RegPackBounds(Buf, 4, lbound(InData%azWave), ubound(InData%azWave)) + call RegPack(Buf, InData%azWave) + end if + call RegPack(Buf, allocated(InData%PDyn)) + if (allocated(InData%PDyn)) then + call RegPackBounds(Buf, 4, lbound(InData%PDyn), ubound(InData%PDyn)) + call RegPack(Buf, InData%PDyn) + end if + call RegPack(Buf, allocated(InData%zeta)) + if (allocated(InData%zeta)) then + call RegPackBounds(Buf, 3, lbound(InData%zeta), ubound(InData%zeta)) + call RegPack(Buf, InData%zeta) + end if + call RegPack(Buf, InData%nzCurrent) + call RegPack(Buf, allocated(InData%pzCurrent)) + if (allocated(InData%pzCurrent)) then + call RegPackBounds(Buf, 1, lbound(InData%pzCurrent), ubound(InData%pzCurrent)) + call RegPack(Buf, InData%pzCurrent) + end if + call RegPack(Buf, allocated(InData%uxCurrent)) + if (allocated(InData%uxCurrent)) then + call RegPackBounds(Buf, 1, lbound(InData%uxCurrent), ubound(InData%uxCurrent)) + call RegPack(Buf, InData%uxCurrent) + end if + call RegPack(Buf, allocated(InData%uyCurrent)) + if (allocated(InData%uyCurrent)) then + call RegPackBounds(Buf, 1, lbound(InData%uyCurrent), ubound(InData%uyCurrent)) + call RegPack(Buf, InData%uyCurrent) + end if + call RegPack(Buf, InData%Nx0) + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + call RegPack(Buf, allocated(InData%du)) + if (allocated(InData%du)) then + call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPack(Buf, InData%du) + end if + call RegPack(Buf, allocated(InData%dx)) + if (allocated(InData%dx)) then + call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) + call RegPack(Buf, InData%dx) + end if + call RegPack(Buf, InData%Jac_ny) + call RegPack(Buf, InData%Jac_nx) + call RegPack(Buf, allocated(InData%dxIdx_map2_xStateIdx)) + if (allocated(InData%dxIdx_map2_xStateIdx)) then + call RegPackBounds(Buf, 1, lbound(InData%dxIdx_map2_xStateIdx), ubound(InData%dxIdx_map2_xStateIdx)) + call RegPack(Buf, InData%dxIdx_map2_xStateIdx) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackParam' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%nLineTypes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nRodTypes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nConnects) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nConnectsExtra) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nBodies) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nRods) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nLines) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nCtrlChans) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nFails) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nFreeBodies) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nFreeRods) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nFreeCons) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%nCpldBodies)) deallocate(OutData%nCpldBodies) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%nCpldBodies(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldBodies.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%nCpldBodies) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%nCpldRods)) deallocate(OutData%nCpldRods) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%nCpldRods(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldRods.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%nCpldRods) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%nCpldCons)) deallocate(OutData%nCpldCons) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%nCpldCons(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldCons.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%nCpldCons) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NConns) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NAnchs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%g) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rhoW) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%kBot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%cBot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dtM0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dtCoupling) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dtOut) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MDUnOut) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PriPath) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%writeLog) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnLog) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveKin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Current) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nTurbines) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TurbineRefPos)) deallocate(OutData%TurbineRefPos) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineRefPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TurbineRefPos) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%mu_kT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%mu_kA) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%mc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%cv) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nxWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nyWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nzWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ntWave) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%pxWave)) deallocate(OutData%pxWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%pxWave(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%pxWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%pyWave)) deallocate(OutData%pyWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%pyWave(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%pyWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%pzWave)) deallocate(OutData%pzWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%pzWave(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%pzWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%dtWave) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%uxWave)) deallocate(OutData%uxWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uxWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uxWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uxWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%uyWave)) deallocate(OutData%uyWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uyWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uyWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uyWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%uzWave)) deallocate(OutData%uzWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uzWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uzWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uzWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%axWave)) deallocate(OutData%axWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%axWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%axWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%axWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ayWave)) deallocate(OutData%ayWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ayWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ayWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ayWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%azWave)) deallocate(OutData%azWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%azWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%azWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%azWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PDyn(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PDyn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%zeta)) deallocate(OutData%zeta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%zeta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%zeta) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%nzCurrent) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%pzCurrent)) deallocate(OutData%pzCurrent) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%pzCurrent(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzCurrent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%pzCurrent) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%uxCurrent)) deallocate(OutData%uxCurrent) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uxCurrent(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uxCurrent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uxCurrent) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%uyCurrent)) deallocate(OutData%uyCurrent) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uyCurrent(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uyCurrent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uyCurrent) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Nx0) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%du)) deallocate(OutData%du) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%du(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dx)) deallocate(OutData%dx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Jac_nx) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%dxIdx_map2_xStateIdx)) deallocate(OutData%dxIdx_map2_xStateIdx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dxIdx_map2_xStateIdx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxIdx_map2_xStateIdx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dxIdx_map2_xStateIdx) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(MD_InputType), intent(inout) :: SrcInputData + type(MD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%CoupledKinematics)) then + LB(1:1) = lbound(SrcInputData%CoupledKinematics) + UB(1:1) = ubound(SrcInputData%CoupledKinematics) + if (.not. allocated(DstInputData%CoupledKinematics)) then + allocate(DstInputData%CoupledKinematics(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CoupledKinematics.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%CoupledKinematics(i1), DstInputData%CoupledKinematics(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%DeltaL)) then + LB(1:1) = lbound(SrcInputData%DeltaL) + UB(1:1) = ubound(SrcInputData%DeltaL) + if (.not. allocated(DstInputData%DeltaL)) then + allocate(DstInputData%DeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%DeltaL = SrcInputData%DeltaL + end if + if (allocated(SrcInputData%DeltaLdot)) then + LB(1:1) = lbound(SrcInputData%DeltaLdot) + UB(1:1) = ubound(SrcInputData%DeltaLdot) + if (.not. allocated(DstInputData%DeltaLdot)) then + allocate(DstInputData%DeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%DeltaLdot = SrcInputData%DeltaLdot + end if +end subroutine + +subroutine MD_DestroyInput(InputData, ErrStat, ErrMsg) + type(MD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%CoupledKinematics)) then + LB(1:1) = lbound(InputData%CoupledKinematics) + UB(1:1) = ubound(InputData%CoupledKinematics) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%CoupledKinematics(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%CoupledKinematics) + end if + if (allocated(InputData%DeltaL)) then + deallocate(InputData%DeltaL) + end if + if (allocated(InputData%DeltaLdot)) then + deallocate(InputData%DeltaLdot) + end if +end subroutine + +subroutine MD_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%CoupledKinematics)) + if (allocated(InData%CoupledKinematics)) then + call RegPackBounds(Buf, 1, lbound(InData%CoupledKinematics), ubound(InData%CoupledKinematics)) + LB(1:1) = lbound(InData%CoupledKinematics) + UB(1:1) = ubound(InData%CoupledKinematics) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%CoupledKinematics(i1)) + end do + end if + call RegPack(Buf, allocated(InData%DeltaL)) + if (allocated(InData%DeltaL)) then + call RegPackBounds(Buf, 1, lbound(InData%DeltaL), ubound(InData%DeltaL)) + call RegPack(Buf, InData%DeltaL) + end if + call RegPack(Buf, allocated(InData%DeltaLdot)) + if (allocated(InData%DeltaLdot)) then + call RegPackBounds(Buf, 1, lbound(InData%DeltaLdot), ubound(InData%DeltaLdot)) + call RegPack(Buf, InData%DeltaLdot) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%CoupledKinematics)) deallocate(OutData%CoupledKinematics) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CoupledKinematics(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledKinematics.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%CoupledKinematics(i1)) ! CoupledKinematics + end do + end if + if (allocated(OutData%DeltaL)) deallocate(OutData%DeltaL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DeltaL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DeltaL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DeltaLdot)) deallocate(OutData%DeltaLdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DeltaLdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DeltaLdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DeltaLdot) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(MD_OutputType), intent(inout) :: SrcOutputData + type(MD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%CoupledLoads)) then + LB(1:1) = lbound(SrcOutputData%CoupledLoads) + UB(1:1) = ubound(SrcOutputData%CoupledLoads) + if (.not. allocated(DstOutputData%CoupledLoads)) then + allocate(DstOutputData%CoupledLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CoupledLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%CoupledLoads(i1), DstOutputData%CoupledLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(MD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%CoupledLoads)) then + LB(1:1) = lbound(OutputData%CoupledLoads) + UB(1:1) = ubound(OutputData%CoupledLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%CoupledLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%CoupledLoads) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine MD_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%CoupledLoads)) + if (allocated(InData%CoupledLoads)) then + call RegPackBounds(Buf, 1, lbound(InData%CoupledLoads), ubound(InData%CoupledLoads)) + LB(1:1) = lbound(InData%CoupledLoads) + UB(1:1) = ubound(InData%CoupledLoads) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%CoupledLoads(i1)) + end do + end if + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%CoupledLoads)) deallocate(OutData%CoupledLoads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CoupledLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%CoupledLoads(i1)) ! CoupledLoads + end do + end if + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine MD_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(MD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(MD_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 = 'MD_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 MD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL MD_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 MD_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 MD_Input_ExtrapInterp - - - SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call MD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call MD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call MD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE MD_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. @@ -13114,59 +6367,54 @@ SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(MD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(MD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(MD_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 + TYPE(MD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(MD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(MD_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 = 'MD_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 - 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN - DO i1 = LBOUND(u_out%CoupledKinematics,1),UBOUND(u_out%CoupledKinematics,1) - CALL MeshExtrapInterp1(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%DeltaL) .AND. ALLOCATED(u1%DeltaL)) THEN - DO i1 = LBOUND(u_out%DeltaL,1),UBOUND(u_out%DeltaL,1) - b = -(u1%DeltaL(i1) - u2%DeltaL(i1)) - u_out%DeltaL(i1) = u1%DeltaL(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%DeltaLdot) .AND. ALLOCATED(u1%DeltaLdot)) THEN - DO i1 = LBOUND(u_out%DeltaLdot,1),UBOUND(u_out%DeltaLdot,1) - b = -(u1%DeltaLdot(i1) - u2%DeltaLdot(i1)) - u_out%DeltaLdot(i1) = u1%DeltaLdot(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE MD_Input_ExtrapInterp1 - - - SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN + DO i1 = LBOUND(u_out%CoupledKinematics,1),UBOUND(u_out%CoupledKinematics,1) + CALL MeshExtrapInterp1(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%DeltaL) .AND. ALLOCATED(u1%DeltaL)) THEN + u_out%DeltaL = a1*u1%DeltaL + a2*u2%DeltaL + END IF ! check if allocated + IF (ALLOCATED(u_out%DeltaLdot) .AND. ALLOCATED(u1%DeltaLdot)) THEN + u_out%DeltaLdot = a1*u1%DeltaLdot + a2*u2%DeltaLdot + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE MD_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. @@ -13180,121 +6428,114 @@ SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(MD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(MD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(MD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(MD_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 + TYPE(MD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(MD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(MD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(MD_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 = 'MD_Input_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'MD_Input_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 + 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 + 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 + 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(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN - DO i1 = LBOUND(u_out%CoupledKinematics,1),UBOUND(u_out%CoupledKinematics,1) - CALL MeshExtrapInterp2(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), u3%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%DeltaL) .AND. ALLOCATED(u1%DeltaL)) THEN - DO i1 = LBOUND(u_out%DeltaL,1),UBOUND(u_out%DeltaL,1) - b = (t(3)**2*(u1%DeltaL(i1) - u2%DeltaL(i1)) + t(2)**2*(-u1%DeltaL(i1) + u3%DeltaL(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%DeltaL(i1) + t(3)*u2%DeltaL(i1) - t(2)*u3%DeltaL(i1) ) * scaleFactor - u_out%DeltaL(i1) = u1%DeltaL(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%DeltaLdot) .AND. ALLOCATED(u1%DeltaLdot)) THEN - DO i1 = LBOUND(u_out%DeltaLdot,1),UBOUND(u_out%DeltaLdot,1) - b = (t(3)**2*(u1%DeltaLdot(i1) - u2%DeltaLdot(i1)) + t(2)**2*(-u1%DeltaLdot(i1) + u3%DeltaLdot(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%DeltaLdot(i1) + t(3)*u2%DeltaLdot(i1) - t(2)*u3%DeltaLdot(i1) ) * scaleFactor - u_out%DeltaLdot(i1) = u1%DeltaLdot(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE MD_Input_ExtrapInterp2 - - - SUBROUTINE MD_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(MD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(MD_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN + DO i1 = LBOUND(u_out%CoupledKinematics,1),UBOUND(u_out%CoupledKinematics,1) + CALL MeshExtrapInterp2(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), u3%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%DeltaL) .AND. ALLOCATED(u1%DeltaL)) THEN + u_out%DeltaL = a1*u1%DeltaL + a2*u2%DeltaL + a3*u3%DeltaL + END IF ! check if allocated + IF (ALLOCATED(u_out%DeltaLdot) .AND. ALLOCATED(u1%DeltaLdot)) THEN + u_out%DeltaLdot = a1*u1%DeltaLdot + a2*u2%DeltaLdot + a3*u3%DeltaLdot + END IF ! check if allocated +END SUBROUTINE + +subroutine MD_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(MD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(MD_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 = 'MD_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 MD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL MD_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 MD_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 MD_Output_ExtrapInterp - - - SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call MD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call MD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call MD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE MD_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. @@ -13306,53 +6547,51 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(MD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(MD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(MD_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 + TYPE(MD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(MD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(MD_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 = 'MD_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN - DO i1 = LBOUND(y_out%CoupledLoads,1),UBOUND(y_out%CoupledLoads,1) - CALL MeshExtrapInterp1(y1%CoupledLoads(i1), y2%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -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 MD_Output_ExtrapInterp1 - - - SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN + DO i1 = LBOUND(y_out%CoupledLoads,1),UBOUND(y_out%CoupledLoads,1) + CALL MeshExtrapInterp1(y1%CoupledLoads(i1), y2%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE MD_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. @@ -13366,60 +6605,56 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(MD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(MD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(MD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(MD_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 + TYPE(MD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(MD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(MD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(MD_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 = 'MD_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'MD_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 + 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 + 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 + 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%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN - DO i1 = LBOUND(y_out%CoupledLoads,1),UBOUND(y_out%CoupledLoads,1) - CALL MeshExtrapInterp2(y1%CoupledLoads(i1), y2%CoupledLoads(i1), y3%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -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 MD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN + DO i1 = LBOUND(y_out%CoupledLoads,1),UBOUND(y_out%CoupledLoads,1) + CALL MeshExtrapInterp2(y1%CoupledLoads(i1), y2%CoupledLoads(i1), y3%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE MoorDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index 8074c3d7dc..81a39fc2a0 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -14,6 +14,10 @@ # limitations under the License. # +if (GENERATE_TYPES) + generate_f90_types(src/Registry_NWTC_Library_typedef_nomesh.txt ${CMAKE_CURRENT_LIST_DIR}/src/NWTC_Library_Types.f90 -noextrap) +endif() + #------------------------------------------------------------------------------- # NWTC System File #------------------------------------------------------------------------------- @@ -55,6 +59,7 @@ set(NWTCLIBS_SOURCES src/NWTC_Base.f90 src/SingPrec.f90 + src/ModReg.f90 src/ModMesh.f90 src/ModMesh_Mapping.f90 diff --git a/modules/nwtc-library/ModRegGen.py b/modules/nwtc-library/ModRegGen.py new file mode 100644 index 0000000000..82ee7d3feb --- /dev/null +++ b/modules/nwtc-library/ModRegGen.py @@ -0,0 +1,603 @@ + +import textwrap +import itertools +from itertools import product + +type_map = { + 'C1': 'character(*)', + 'L1': 'logical', + 'I4': 'integer(B4Ki)', + 'R4': 'real(R4Ki)', + 'R8': 'real(R8Ki)', +} + +num_ranks = 5 + +module_header = ''' +module ModReg + use NWTC_Base + implicit none + + private + public :: PackBuffer + public :: WritePackBuffer, ReadPackBuffer, InitPackBuffer, RegCheckErr + public :: RegPack, RegPackBounds, RegPackPointer + public :: RegUnpack, RegUnpackBounds, RegUnpackPointer + + type :: PackBuffer + integer(B1Ki), allocatable :: Bytes(:) + integer(IntKi) :: NB + type(c_ptr), allocatable :: Pointers(:) + integer(IntKi) :: NP + integer(IntKi) :: ErrStat = ErrID_Fatal + character(ErrMsgLen) :: ErrMsg = 'PackBuffer not initialized' + end type + {ifc_lines} + +contains + + subroutine InitPackBuffer(Buf, ErrStat, ErrMsg) + type(PackBuffer), intent(inout) :: Buf + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "InitPackBuffer" + integer(IntKi), parameter :: NumPointersInit = 128 + integer(IntKi), parameter :: NumBytesInit = 1024 + integer(IntKi) :: stat + + ErrStat = ErrID_None + ErrMsg = "" + + Buf%ErrStat = ErrID_None + Buf%ErrMsg = "" + Buf%NP = 0 + Buf%NB = 0 + + ! If pointers have not been allocated, allocate with initial size + if (.not. allocated(Buf%Pointers)) then + allocate (Buf%Pointers(NumPointersInit), stat=stat) + if (stat /= 0) then + ErrStat = ErrID_Fatal + write(ErrMsg,*) 'InitPackBuffer: Unable to init pointer index to with size of', NumPointersInit + return + end if + end if + + ! Reset all pointers to null + Buf%Pointers = c_null_ptr + + ! If byte array has not been allocated, allocate with initial size + if (.not. allocated(Buf%Bytes)) then + allocate (Buf%Bytes(NumBytesInit), stat=stat) + if (stat /= 0) then + ErrStat = ErrID_Fatal + write(ErrMsg,*) 'Grow: Unable to init buffer to', NumBytesInit, 'bytes' + return + end if + end if + + end subroutine + + subroutine WritePackBuffer(Buf, Unit, ErrStat, ErrMsg) + type(PackBuffer), intent(inout) :: Buf + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "WritePackBuffer" + integer(IntKi) :: iostat + + ErrStat = ErrID_None + ErrMsg = '' + + if (Buf%ErrStat /= ErrID_None) then + call SetErrStat(Buf%ErrStat, Buf%ErrMsg, ErrStat, ErrMsg, 'Buf%WriteFile') + return + end if + + write(Unit, iostat=iostat) Buf%NP + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error writing number of pointers", ErrStat, ErrMsg, RoutineName) + return + end if + + write(Unit, iostat=iostat) Buf%NB + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error writing number of bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + write(Unit, iostat=iostat) Buf%Bytes(1:Buf%NB) + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error writing bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + end subroutine + + subroutine ReadPackBuffer(Buf, Unit, ErrStat, ErrMsg) + type(PackBuffer), intent(inout) :: Buf + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "ReadPackBuffer" + integer(IntKi) :: iostat + + ErrStat = ErrID_None + ErrMsg = '' + + ! Read number of pointers + read(Unit, iostat=iostat) Buf%NP + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error reading number of pointers", ErrStat, ErrMsg, RoutineName) + return + end if + + ! If pointers are allocated, deallocate + if (allocated(Buf%Pointers)) deallocate(Buf%Pointers) + + ! Allocate pointer index and initialize pointers to null + allocate(Buf%Pointers(1:Buf%NP), stat=ErrStat) + Buf%Pointers = c_null_ptr + + ! Read number of bytes in buffer + read(Unit, iostat=iostat) Buf%NB + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error reading number of bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + ! If bytes are allocated, deallocate + if (allocated(Buf%Bytes)) deallocate(Buf%Bytes) + + ! Allocate bytes + allocate(Buf%Bytes(1:Buf%NB), stat=ErrStat) + + ! Read bytes + read(Unit, iostat=iostat) Buf%Bytes + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error reading bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Clear buffer error + Buf%ErrStat = ErrID_None + Buf%ErrMsg = '' + + ! Reset Number of bytes to be used by unpack routines + Buf%NB = 0 + + end subroutine + + function RegCheckErr(Buf, RoutineName) result(Err) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: RoutineName + logical :: Err + Err = Buf%ErrStat /= ErrID_None + if (Err) Buf%ErrMsg = trim(RoutineName)//": "//trim(Buf%ErrMsg) + end function + + elemental function LogicalToByte(b) result(i) + logical, intent(in) :: b + integer(B1Ki) :: i + if (b) then + i = 1_B1Ki + else + i = 0_B1Ki + end if + end function + + elemental function ByteToLogical(i) result(b) + integer(B1Ki), intent(in) :: i + logical :: b + if (i == 0) then + b = .false. + else + b = .true. + end if + end function + + subroutine RegPackPointer(Buf, Ptr, Found) + type(PackBuffer), intent(inout) :: Buf + type(c_ptr), intent(in) :: Ptr + logical, intent(out) :: Found + + type(c_ptr), allocatable :: PointersTmp(:) + integer(IntKi) :: NewSize + integer(B4Ki) :: i + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Look for pointer in index, if found, pack pointer index and return + do i = 1, Buf%NP + if (c_associated(Ptr, Buf%Pointers(i))) then + call RegPack(Buf, i) + Found = .true. + return + end if + end do + + ! Pointer was not found in index + Found = .false. + + ! If pointer index is full, grow pointer index + if (Buf%NP == size(Buf%Pointers)) then + NewSize = int(1.5_R4Ki * real(Buf%NP, R4Ki), IntKi) + call move_alloc(Buf%Pointers, PointersTmp) + allocate (Buf%Pointers(NewSize), stat=Buf%ErrStat) + if (Buf%ErrStat /= ErrID_None) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) 'RegPackPointer: Unable to allocate pointer index to', NewSize, 'bytes' + return + end if + Buf%Pointers(1:size(PointersTmp)) = PointersTmp + Buf%Pointers(size(PointersTmp)+1:) = c_null_ptr + end if + + ! Increment number of pointers, add new pointer to index + Buf%NP = Buf%NP + 1 + Buf%Pointers(Buf%NP) = Ptr + + ! Pack pointer index + call RegPack(Buf, Buf%NP) + + end subroutine + + subroutine RegUnpackPointer(Buf, Ptr, Idx) + type(PackBuffer), intent(inout) :: Buf + type(c_ptr), intent(out) :: Ptr + integer(B4Ki), intent(out) :: Idx + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Unpack pointer index + call RegUnpack(Buf, Idx) + + ! Get pointer from index + Ptr = Buf%Pointers(Idx) + + end subroutine + + subroutine RegPackBounds(Buf, R, LB, UB) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: R, LB(:), UB(:) + + ! If buffer has an error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Pack lower and upper bounds + call RegPack(Buf, LB(1:R)) + call RegPack(Buf, UB(1:R)) + if (RegCheckErr(Buf, "RegPackBounds")) return + end subroutine + + subroutine RegUnpackBounds(Buf, R, LB, UB) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: R + integer(B4Ki), intent(out) :: LB(:), UB(:) + + ! If buffer has an error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Unpack lower and upper bounds + call RegUnpack(Buf, LB(1:R)) + call RegUnpack(Buf, UB(1:R)) + if (RegCheckErr(Buf, "RegUnpackBounds")) return + end subroutine + + subroutine GrowBuffer(Buf, N) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: N + + integer(B1Ki), allocatable :: BytesTmp(:) + integer(B4Ki) :: NewSize + integer(IntKi) :: stat + + ! Return if there is a buffer error + if (Buf%ErrStat /= ErrID_None) return + + ! If buffer can hold requested bytes, return + if (size(Buf%Bytes) > Buf%NB + N) return + + ! Calculate new size + NewSize = int(real(Buf%NB + N, R4Ki) * 1.8_R4Ki, IntKi) + + ! Move allocation to temporary array and allocate buffer with new size + call move_alloc(Buf%Bytes, BytesTmp) + allocate (Buf%Bytes(NewSize), stat=stat) + if (stat /= 0) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) 'Grow: Unable to grow buffer to', NewSize, 'bytes' + return + end if + + ! Copy contents of temporary bytes to buffer + Buf%Bytes(1:size(BytesTmp)) = BytesTmp + + end subroutine +''' + + +def gen_pack(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + dt_size = int(dt[-1]) + name = f'Pack_{dt}' if rank == 0 else f'Pack_{dt}_Rank{rank}' + w.write(f'\n\n subroutine {name}(Buf, Data)') + w.write(f'\n type(PackBuffer), intent(inout) :: Buf') + w.write(f'\n {decl+", intent(in)":<38s} :: Data{dims}') + w.write(f'\n integer(IntKi) :: DataSize') + w.write(f'\n') + w.write(f'\n ! If buffer error, return') + w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! Get size of data in bytes') + if dt == 'C1' and rank == 0: + w.write(f'\n DataSize = len(Data)') + elif dt == 'C1' and rank > 0: + w.write(f'\n DataSize = len(Data({",".join(["1"]*rank)}))*size(Data)') + elif rank == 0: + w.write(f'\n DataSize = {dt_size}') + elif dt_size == 1: + w.write(f'\n DataSize = size(Data)') + else: + w.write(f'\n DataSize = {dt_size}*size(Data)') + w.write(f'\n') + w.write(f'\n ! Grow buffer to accommodate Data') + w.write(f'\n call GrowBuffer(Buf, DataSize)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n') + w.write(f'\n ! Transfer data to buffer') + if dt == 'L1': + w.write(f'\n Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes)') + else: + w.write(f'\n Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes)') + w.write(f'\n Buf%NB = Buf%NB + DataSize') + w.write(f'\n') + w.write(f'\n end subroutine') + + +def gen_unpack(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + dt_size = int(dt[-1]) + name = f'Unpack_{dt}' if rank == 0 else f'Unpack_{dt}_Rank{rank}' + w.write(f'\n') + w.write(f'\n subroutine {name}(Buf, Data)') + w.write(f'\n type(PackBuffer), intent(inout) :: Buf') + w.write(f'\n {decl+", intent(out)":<38s} :: Data{dims}') + w.write(f'\n integer(IntKi) :: DataSize') + w.write(f'\n') + w.write(f'\n ! If buffer error, return') + w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! Get size of data in bytes') + if dt == 'C1' and rank == 0: + w.write(f'\n DataSize = len(Data)') + elif dt == 'C1' and rank > 0: + w.write(f'\n DataSize = len(Data({",".join(["1"]*rank)}))*size(Data)') + elif rank == 0: + w.write(f'\n DataSize = {dt_size}') + elif dt_size == 1: + w.write(f'\n DataSize = size(Data)') + else: + w.write(f'\n DataSize = {dt_size}*size(Data)') + w.write(f'\n') + w.write(f'\n ! Check that buffer has sufficient bytes remaining') + w.write(f'\n if (size(Buf%Bytes) < Buf%NB + DataSize) then') + w.write(f'\n Buf%ErrStat = ErrID_Fatal') + w.write(f'\n write(Buf%ErrMsg,*) "{name}: buffer too small, requested", DataSize, "bytes"') + w.write(f'\n return') + w.write(f'\n end if') + w.write(f'\n') + w.write(f'\n ! Transfer data from buffer') + if dt == 'L1' and rank == 0: + w.write(f'\n Data = ByteToLogical(Buf%Bytes(Buf%NB+1))') + elif dt == 'L1' and rank > 0: + w.write(f'\n Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data))') + elif rank == 0: + w.write(f'\n Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data)') + else: + w.write(f'\n Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data))') + w.write(f'\n Buf%NB = Buf%NB + DataSize') + w.write(f'\n') + w.write(f'\n end subroutine') + +def gen_pack_alloc(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + name = f'PackAlloc_{dt}' + if rank > 0: name += f'_Rank{rank}' + w.write(f'\n') + w.write(f'\n subroutine {name}(Buf, Data)') + w.write(f'\n type(PackBuffer), intent(inout) :: Buf') + w.write(f'\n {decl+", allocatable, intent(in)":<38s} :: Data{dims}') + w.write(f'\n') + w.write(f'\n ! If buffer error, return') + w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! Write if allocated') + w.write(f'\n call RegPack(Buf, allocated(Data))') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n if (.not. allocated(Data)) return') + w.write(f'\n') + if rank > 0: + w.write(f'\n ! Write array bounds') + w.write(f'\n call RegPackBounds(Buf, {rank}, lbound(Data), ubound(Data))') + w.write(f'\n') + w.write(f'\n ! Write data to buffer') + w.write(f'\n call RegPack(Buf, Data)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n') + w.write(f'\n end subroutine') + + +def gen_unpack_alloc(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + dt_size = int(dt[-1]) + name = f'UnpackAlloc_{dt}' if rank == 0 else f'UnpackAlloc_{dt}_Rank{rank}' + w.write(f'\n') + w.write(f'\n subroutine {name}(Buf, Data)') + w.write(f'\n type(PackBuffer), intent(inout) :: Buf') + w.write(f'\n {decl+", allocatable, intent(out)":<38s} :: Data{dims}') + w.write(f'\n integer(IntKi) :: stat') + w.write(f'\n logical :: IsAllocated') + if rank > 0: + w.write(f'\n integer(IntKi) :: LB({rank}), UB({rank})') + w.write(f'\n') + w.write(f'\n ! If buffer error, return') + w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! Deallocate if allocated') + w.write(f'\n if (allocated(Data)) deallocate(Data)') + w.write(f'\n') + w.write(f'\n ! Read value to see if it was allocated, return if not') + w.write(f'\n call RegUnpack(Buf, IsAllocated)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n if (.not. IsAllocated) return') + w.write(f'\n') + alloc_dims = '' + if rank > 0: + w.write(f'\n ! Read array bounds') + w.write(f'\n call RegUnpackBounds(Buf, {rank}, LB, UB)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + alloc_dims = '(' + ','.join([f'LB({d+1}):UB({d+1})' for d in range(rank)]) + ')' + w.write(f'\n') + w.write(f'\n ! Allocate data') + w.write(f'\n allocate(Data{alloc_dims}, stat=stat)') + w.write(f'\n if (stat /= 0) then') + w.write(f'\n Buf%ErrStat = ErrID_Fatal') + w.write(f'\n Buf%ErrMsg = "{name}: error allocating data"') + w.write(f'\n return') + w.write(f'\n end if') + w.write(f'\n') + w.write(f'\n ! Read data') + w.write(f'\n call RegUnpack(Buf, Data)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n') + w.write(f'\n end subroutine') + + +def gen_pack_ptr(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + name = f'PackPtr_{dt}' + if rank > 0: name += f'_Rank{rank}' + w.write(f'\n') + w.write(f'\n subroutine {name}(Buf, Data)') + w.write(f'\n type(PackBuffer), intent(inout) :: Buf') + w.write(f'\n {decl+", pointer, intent(in)":<38s} :: Data{dims}') + w.write(f'\n logical :: PtrInIndex') + w.write(f'\n') + w.write(f'\n ! If buffer error, return') + w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! Write if associated') + w.write(f'\n call RegPack(Buf, associated(Data))') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n if (.not. associated(Data)) return') + if rank > 0: + w.write(f'\n') + w.write(f'\n ! Write array bounds') + w.write(f'\n call RegPackBounds(Buf, {rank}, lbound(Data), ubound(Data))') + w.write(f'\n') + w.write(f'\n ! Write pointer info') + w.write(f'\n call RegPackPointer(Buf, c_loc(Data), PtrInIndex)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n if (PtrInIndex) return') + w.write(f'\n') + w.write(f'\n ! Write data to buffer') + w.write(f'\n call RegPack(Buf, Data)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n') + w.write(f'\n end subroutine') + +def gen_unpack_ptr(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + dt_size = int(dt[-1]) + name = f'UnpackPtr_{dt}' if rank == 0 else f'UnpackPtr_{dt}_Rank{rank}' + w.write(f'\n') + w.write(f'\n subroutine {name}(Buf, Data)') + w.write(f'\n type(PackBuffer), intent(inout) :: Buf') + w.write(f'\n {decl+", pointer, intent(out)":<38s} :: Data{dims}') + w.write(f'\n integer(IntKi) :: PtrIdx, stat') + w.write(f'\n logical :: IsAssociated') + w.write(f'\n type(c_ptr) :: Ptr') + if rank > 0: + w.write(f'\n integer(IntKi) :: LB({rank}), UB({rank})') + w.write(f'\n') + w.write(f'\n ! If buffer error, return') + w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! If associated, deallocate and nullify') + w.write(f'\n if (associated(Data)) then') + w.write(f'\n deallocate(Data)') + w.write(f'\n nullify(Data)') + w.write(f'\n end if') + w.write(f'\n') + w.write(f'\n ! Read value to see if it was associated, return if not') + w.write(f'\n call RegUnpack(Buf, IsAssociated)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n if (.not. IsAssociated) return') + if rank > 0: + w.write(f'\n') + w.write(f'\n ! Read array bounds') + w.write(f'\n call RegUnpackBounds(Buf, {rank}, LB, UB)') + w.write(f'\n') + w.write(f'\n ! Unpack pointer inf') + w.write(f'\n call RegUnpackPointer(Buf, Ptr, PtrIdx)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n') + w.write(f'\n ! If pointer was in index, associate data with pointer, return') + w.write(f'\n if (c_associated(Ptr)) then') + if rank == 0: + alloc_dims = '' + w.write(f'\n call c_f_pointer(Ptr, Data)') + else: + alloc_dims = '(' + ','.join([f'LB({d+1}):UB({d+1})' for d in range(rank)]) + ')' + remap_dims = ",".join([f'LB({d+1}):' for d in range(rank)]) + w.write(f'\n call c_f_pointer(Ptr, Data, UB - LB)') # Specify shape + w.write(f'\n Data({remap_dims}) => Data') # Remap bounds + w.write(f'\n return') + w.write(f'\n end if') + w.write(f'\n') + w.write(f'\n ! Allocate data') + w.write(f'\n allocate(Data{alloc_dims}, stat=stat)') + w.write(f'\n if (stat /= 0) then') + w.write(f'\n Buf%ErrStat = ErrID_Fatal') + w.write(f'\n Buf%ErrMsg = "{name}: error allocating data"') + w.write(f'\n return') + w.write(f'\n end if') + w.write(f'\n') + w.write(f'\n ! Read data') + w.write(f'\n call RegUnpack(Buf, Data)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n') + w.write(f'\n end subroutine') + +# Registry interface +ifc_lines = '' +ranks = [''] + [f'_Rank{r}' for r in range(1,num_ranks+1)] +for attr, punp in product([''], ['Pack', 'Unpack']): + ifc_lines += f'\n\n interface Reg{punp}{attr}' + funcs = [f'{punp}{attr}_{dt}{rank}'for dt, rank in product(type_map.keys(), ranks)] + lines = textwrap.wrap('module procedure ' + ', '.join(funcs), 80, + initial_indent=" "*6, subsequent_indent=' '*9,break_long_words=False) + ifc_lines += '\n' + ' &\n'.join(lines) + ifc_lines += '\n end interface' + +with open('src/ModReg.f90', 'w') as w: + w.write(module_header.format(ifc_lines=ifc_lines, maxrank=num_ranks)) + + # Loop through data types and ranks + for (dt,decl), rank in product(type_map.items(), range(num_ranks+1)): + gen_pack(w, dt, decl, rank) + gen_unpack(w, dt, decl, rank) + + # gen_pack_alloc(w, dt, decl, rank) + # gen_unpack_alloc(w, dt, decl, rank) + + # gen_pack_ptr(w, dt, decl, rank) + # gen_unpack_ptr(w, dt, decl, rank) + + w.write('\nend module') diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index e946a05d46..4146c1c083 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -35,7 +35,7 @@ !! See https://nwtc.nrel.gov/FAST-Developers and https://nwtc.nrel.gov/system/files/ProgrammingHandbook_Mod20130717.pdf MODULE ModMesh use VTK, only: WrVTK_header, WrVTK_footer - + USE ModReg USE ModMesh_Types IMPLICIT NONE ! INTEGER :: DEBUG_UNIT = 74 @@ -1507,230 +1507,76 @@ END SUBROUTINE MeshDestroy !! buffers when they are no longer needed. For sibling meshes, MeshPack should be called !! separately for each sibling, because the fields allocated with the siblings are separate !! and unique to each sibling. - SUBROUTINE MeshPack ( Mesh, ReKiBuf, DbKiBuf, IntKiBuf , ErrStat, ErrMess, SizeOnly ) - - TYPE(MeshType), INTENT(IN ) :: Mesh ! Mesh being packed - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) ! Real buffer - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) ! Double buffer - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) ! Int buffer - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMess - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - - ! Local - INTEGER(IntKi) :: Re_BufSz ! number of reals in the buffer - INTEGER(IntKi) :: Re_Xferred ! number of reals transferred - INTEGER(IntKi) :: Db_BufSz ! number of doubles in the buffer - INTEGER(IntKi) :: Db_Xferred ! number of doubles transferred - INTEGER(IntKi) :: Int_BufSz ! number of integers in the buffer - INTEGER(IntKi) :: Int_Xferred ! number of integers transferred - - - INTEGER i,j, nelemnodes - LOGICAL OnlySize - INTEGER(IntKi) :: ErrStat2 - !CHARACTER(1024) :: ErrMess2 - CHARACTER(*), PARAMETER :: RoutineName = "MeshPack" + subroutine MeshPack (Buf, Mesh) + type(PackBuffer), intent(inout) :: Buf + type(MeshType), intent(in) :: Mesh ! Mesh being packed + + integer :: i,j, nelemnodes + character(*), parameter :: RoutineName = "MeshPack" + ! bjj: figure out what to do about sibling meshes... (for now, I'm going to ignore them) + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return - ErrStat = ErrID_None - ErrMess = "" - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) OnlySize = SizeOnly + ! Pack if mesh is initialized + call RegPack(Buf, Mesh%Initialized) + ! If mesh is not initialized, return + if (.not. Mesh%Initialized) return - ! bjj: figure out what to do about sibling meshes... (for now, I'm going to ignore them) - - !......................................... - ! get number of integer values - !......................................... - IF (.NOT. Mesh%Initialized) THEN ! we don't need to store any data; it's a blank mesh - Int_BufSz = 1 - ELSE ! initialized, may or may not be committed - Int_BufSz = 3 & ! number of logicals in MeshType (initialized, committed, RemapFlag) - + FIELDMASK_SIZE & ! number of logicals in MeshType (fieldmask) - + 5 ! number of non-pointer integers (ios, nnodes, nextelem, nscalars, refNode) - - !...... - ! we'll store the element structure (and call MeshCommit on Unpack if necessary to get the remaining fields like det_jac) - !...... - DO i = 1, NELEMKINDS + ! Mesh is initialized, but may or may not be committed - Int_BufSz = Int_BufSz+1 ! Mesh%ElemTable(i)%nelem - if (Mesh%ElemTable(i)%nelem > 0) Int_BufSz = Int_BufSz+1 ! number of nodes in this kind of element - - DO j = 1, Mesh%ElemTable(i)%nelem - !Int_BufSz = Int_BufSz+1 ! which kind of element - !Int_BufSz = Int_BufSz+1 ! skip Nneighbors until that's implemented (as well as neighbor list) - Int_BufSz = Int_BufSz + SIZE( Mesh%ElemTable(i)%Elements(j)%ElemNodes ) ! nodes in this element - END DO - - END DO - - END IF - - !......................................... - ! get number of real values - !......................................... - Re_BufSz = 0 - IF (Mesh%Initialized) THEN - Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 ! Position - !Re_BufSz = Re_BufSz + Mesh%Nnodes * 9 ! RefOrientation - IF ( Mesh%FieldMask(MASKID_FORCE) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%FieldMask(MASKID_MOMENT) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - !IF ( Mesh%FieldMask(MASKID_ORIENTATION) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 9 - !IF ( Mesh%FieldMask(MASKID_TRANSLATIONDISP) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%FieldMask(MASKID_ROTATIONVEL) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%FieldMask(MASKID_TRANSLATIONVEL) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%FieldMask(MASKID_ROTATIONACC) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%FieldMask(MASKID_TRANSLATIONACC) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%nScalars .GT. 0 ) Re_BufSz = Re_BufSz + Mesh%Nnodes * Mesh%nScalars - END IF - - !......................................... - ! get number of double values (none now) - !......................................... - Db_BufSz = 0 - IF (Mesh%Initialized) THEN - Db_BufSz = Db_BufSz + Mesh%Nnodes * 9 ! RefOrientation - IF ( Mesh%FieldMask(MASKID_ORIENTATION) ) Db_BufSz = Db_BufSz + Mesh%Nnodes * 9 - IF ( Mesh%FieldMask(MASKID_TRANSLATIONDISP) ) Db_BufSz = Db_BufSz + Mesh%Nnodes * 3 - END IF - - !......................................... - ! allocate buffer arrays - !......................................... - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMess,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, ErrMess,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, ErrMess,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + ! Logicals + call RegPack(Buf, Mesh%committed) + call RegPack(Buf, Mesh%fieldmask) + call RegPack(Buf, Mesh%RemapFlag) - - !......................................... - ! store data in buffer arrays - !......................................... - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ! ..... fill IntKiBuf ..... - - IF (.NOT. Mesh%Initialized) THEN ! we don't need to store any data; it's a blank mesh - IntKiBuf(Int_Xferred) = 0; ; Int_Xferred = Int_Xferred + 1 - ELSE ! initialized, may or may not be committed - ! transfer the logicals - IntKiBuf(Int_Xferred) = 1; Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER( Mesh%committed, IntKiBuf(1) ); Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred:Int_Xferred+FIELDMASK_SIZE-1) = TRANSFER( Mesh%fieldmask, IntKiBuf(Int_Xferred:Int_Xferred+FIELDMASK_SIZE-1) ); Int_Xferred = Int_Xferred + FIELDMASK_SIZE - IntKiBuf(Int_Xferred) = TRANSFER( Mesh%RemapFlag, IntKiBuf(1) ); Int_Xferred = Int_Xferred + 1 - ! integers - IntKiBuf(Int_Xferred) = Mesh%ios; Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = Mesh%nnodes; Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = Mesh%refnode; Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = Mesh%nextelem; Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = Mesh%nscalars; Int_Xferred = Int_Xferred + 1 + ! Integers + call RegPack(Buf, Mesh%ios) + call RegPack(Buf, Mesh%nnodes) + call RegPack(Buf, Mesh%refnode) + call RegPack(Buf, Mesh%nextelem) + call RegPack(Buf, Mesh%nscalars) + + ! Loop through element kinds + do i = 1, NELEMKINDS - ! element structure - DO i = 1, NELEMKINDS - - IntKiBuf(Int_Xferred) = Mesh%ElemTable(i)%nelem; Int_Xferred = Int_Xferred + 1 ! number of elements + ! Number of elements of this kind + call RegPack(Buf, Mesh%ElemTable(i)%nelem) + + ! If there are elements of this kind + if (Mesh%ElemTable(i)%nelem > 0) then - if (Mesh%ElemTable(i)%nelem > 0) then - nelemnodes = SIZE( Mesh%ElemTable(i)%Elements(1)%ElemNodes ); - IntKiBuf(Int_Xferred) = nelemnodes; Int_Xferred = Int_Xferred + 1 ! nodes per element - - ! nodes in this element - DO j = 1, Mesh%ElemTable(i)%nelem - IntKiBuf(Int_Xferred:Int_Xferred+nelemnodes-1) = Mesh%ElemTable(i)%Elements(j)%ElemNodes; Int_Xferred = Int_Xferred + nelemnodes - END DO - end if - - END DO - - END IF - - ! ..... fill ReKiBuf and DbKiBuf ..... - IF (Mesh%Initialized) THEN - DO i = 1, Mesh%Nnodes ! Position - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%Position(:,i); Re_Xferred = Re_Xferred + 3 - END DO - DO i = 1, Mesh%Nnodes ! RefOrientation - DO j = 1,3 - DbKiBuf(Db_Xferred:Db_Xferred+2) = Mesh%RefOrientation(:,j,i); Db_Xferred = Db_Xferred + 3 - ENDDO - END DO - - IF ( Mesh%FieldMask(MASKID_FORCE) ) THEN ! Force - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%Force(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_MOMENT) ) THEN ! Moment - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%Moment(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_ORIENTATION) ) THEN ! Orientation - DO i = 1, Mesh%Nnodes - DO j = 1,3 - DbKiBuf(Db_Xferred:Db_Xferred+2) = Mesh%Orientation(:,j,i); Db_Xferred = Db_Xferred + 3 - ENDDO - END DO - ENDIF - IF ( Mesh%FieldMask(MASKID_TRANSLATIONDISP) ) THEN ! TranslationDisp - DO i = 1, Mesh%Nnodes - DbKiBuf(Db_Xferred:Db_Xferred+2) = Mesh%TranslationDisp(:,i); Db_Xferred = Db_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_ROTATIONVEL) ) THEN ! RotationVel - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%RotationVel(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_TRANSLATIONVEL) ) THEN ! TranslationVel - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%TranslationVel(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_ROTATIONACC) ) THEN ! RotationAcc - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%RotationAcc(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_TRANSLATIONACC) ) THEN ! TranslationAcc - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%TranslationAcc(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - - IF ( Mesh%nScalars .GT. 0 ) THEN ! n_re = n_re + Mesh%Nnodes * Mesh%nScalar - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+Mesh%nScalars-1) = Mesh%Scalars(:,i); Re_Xferred = Re_Xferred + Mesh%nScalars - ENDDO - ENDIF - - END IF - - !bjj: where are we keeping track of which ones are siblings so that we can unpack them (set pointers) properly for restart? + ! Store number of nodes per element + nelemnodes = size(Mesh%ElemTable(i)%Elements(1)%ElemNodes); + call RegPack(Buf, nelemnodes) + + ! Loop through nodes of this element type + do j = 1, Mesh%ElemTable(i)%nelem + call RegPack(Buf, Mesh%ElemTable(i)%Elements(j)%ElemNodes) + end do + end if + end do + + call RegPack(Buf, Mesh%Position) + call RegPack(Buf, Mesh%RefOrientation) + + if (Mesh%fieldmask(MASKID_FORCE)) call RegPack(Buf, Mesh%Force) + if (Mesh%fieldmask(MASKID_MOMENT)) call RegPack(Buf, Mesh%Moment) + if (Mesh%fieldmask(MASKID_ORIENTATION)) call RegPack(Buf, Mesh%Orientation) + if (Mesh%fieldmask(MASKID_TRANSLATIONDISP)) call RegPack(Buf, Mesh%TranslationDisp) + if (Mesh%fieldmask(MASKID_ROTATIONVEL)) call RegPack(Buf, Mesh%RotationVel) + if (Mesh%fieldmask(MASKID_TRANSLATIONVEL)) call RegPack(Buf, Mesh%TranslationVel) + if (Mesh%fieldmask(MASKID_TRANSLATIONACC)) call RegPack(Buf, Mesh%TranslationAcc) + if (Mesh%fieldmask(MASKID_ROTATIONACC)) call RegPack(Buf, Mesh%RotationAcc) + if (Mesh%nScalars > 0) call RegPack(Buf, Mesh%Scalars) + + !bjj: where are we keeping track of which ones are siblings so that we can unpack them (set pointers) properly for restart? + + ! If buffer error, return + if (RegCheckErr(Buf, RoutineName)) return + END SUBROUTINE MeshPack !---------------------------------------------------------------------------------------------------------------------------------- @@ -1739,221 +1585,143 @@ END SUBROUTINE MeshPack !! recreate a mesh after reading in the buffers on a restart of the program. The sense !! of the name is "unpack the mesh from buffers." The resulting mesh will be returned !! in the exact state as when the data in the buffers was packed using MeshPack. - SUBROUTINE MeshUnpack( Mesh, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMess ) + SUBROUTINE MeshUnpack(Buf, Mesh) + type(PackBuffer), intent(inout) :: Buf + type(MeshType), intent(inout) :: Mesh ! Mesh being packed + ! bjj: not implemented yet: ! If the mesh has an already recreated sibling mesh from a previous call to MeshUnpack, specify ! the existing sibling as an optional argument so that the sibling relationship is also recreated. - TYPE(MeshType), INTENT(INOUT) :: Mesh - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMess - - ! Local LOGICAL committed, RemapFlag, fieldmask(FIELDMASK_SIZE) INTEGER nScalars, ios, nnodes, nextelem, nelemnodes, nelem, refnode INTEGER i,j - - INTEGER(IntKi) :: Re_Xferred ! number of reals transferred - INTEGER(IntKi) :: Db_Xferred ! number of doubles transferred - INTEGER(IntKi) :: Int_Xferred ! number of integers transferred - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMess2 - CHARACTER(*), PARAMETER :: RoutineName = "MeshUnpack" - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 + integer(IntKi) :: EN(20) ! Element nodes - ErrStat = ErrID_None - ErrMess = "" + CHARACTER(*), PARAMETER :: RoutineName = "MeshUnpack" + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Read if mesh was initialized + call RegUnpack(Buf, Mesh%initialized) - IF (IntKiBuf(Int_Xferred) == 0 ) THEN ! this is a blank mesh - CALL MeshDestroy( Mesh, ErrStat2, ErrMess2, .TRUE. ) - CALL SetErrStat(ErrStat2,ErrMess2,ErrStat,ErrMess,RoutineName) - RETURN - END IF - - - ! initialized, may or may not be committed - - Mesh%initialized = .true.; Int_Xferred = Int_Xferred + 1 - committed = TRANSFER( IntKiBuf(Int_Xferred), Mesh%committed ); Int_Xferred = Int_Xferred + 1 - fieldmask = TRANSFER( IntKiBuf(Int_Xferred:Int_Xferred+FIELDMASK_SIZE-1), fieldmask ); Int_Xferred = Int_Xferred + FIELDMASK_SIZE - RemapFlag = TRANSFER( IntKiBuf(Int_Xferred), Mesh%RemapFlag ); Int_Xferred = Int_Xferred + 1 - ! integers - ios = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 - nnodes = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 - refnode = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 - nextelem = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 - nscalars = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 - - - CALL MeshCreate( Mesh, ios, nnodes & - ,ErrStat=ErrStat2, ErrMess=ErrMess2 & - ,Force =fieldmask(MASKID_FORCE) & - ,Moment =fieldmask(MASKID_MOMENT) & - ,Orientation =fieldmask(MASKID_ORIENTATION) & - ,TranslationDisp=fieldmask(MASKID_TRANSLATIONDISP) & - ,TranslationVel =fieldmask(MASKID_TRANSLATIONVEL ) & - ,RotationVel =fieldmask(MASKID_ROTATIONVEL ) & - ,TranslationAcc =fieldmask(MASKID_TRANSLATIONACC ) & - ,RotationAcc =fieldmask(MASKID_ROTATIONACC ) & - ,nScalars = nScalars & + ! If mesh was not initialized, this is a blank mesh, destroy and return + if (.not. Mesh%initialized) THEN + call MeshDestroy( Mesh, Buf%ErrStat, Buf%ErrMsg, .TRUE. ) + return + end if + + ! Logicals + call RegUnpack(Buf, committed) + call RegUnpack(Buf, fieldmask) + call RegUnpack(Buf, RemapFlag) + + ! Integers + call RegUnpack(Buf, ios) + call RegUnpack(Buf, nnodes) + call RegUnpack(Buf, refnode) + call RegUnpack(Buf, nextelem) + call RegUnpack(Buf, nscalars) + + ! If buffer error, return + if (RegCheckErr(Buf, RoutineName)) return + + ! Create mesh + call MeshCreate(Mesh, ios, nnodes & + ,ErrStat=Buf%ErrStat, ErrMess=Buf%ErrMsg & + ,Force = fieldmask(MASKID_FORCE) & + ,Moment = fieldmask(MASKID_MOMENT) & + ,Orientation = fieldmask(MASKID_ORIENTATION) & + ,TranslationDisp = fieldmask(MASKID_TRANSLATIONDISP) & + ,TranslationVel = fieldmask(MASKID_TRANSLATIONVEL) & + ,RotationVel = fieldmask(MASKID_ROTATIONVEL) & + ,TranslationAcc = fieldmask(MASKID_TRANSLATIONACC) & + ,RotationAcc = fieldmask(MASKID_ROTATIONACC) & + ,nScalars = nScalars & ) - CALL SetErrStat(ErrStat2, ErrMess2, ErrStat, ErrMess, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + if (Buf%ErrStat >= AbortErrLev) return Mesh%RefNode = refnode Mesh%RemapFlag = RemapFlag Mesh%nextelem = nextelem - ! element structure - DO i = 1, NELEMKINDS - nelem = IntKiBuf(Int_Xferred); Int_Xferred = Int_Xferred + 1 ! number of elements - + ! element structure + DO i = 1, NELEMKINDS + + ! number of elements + call RegUnpack(Buf, nelem) + if (RegCheckErr(Buf, RoutineName)) return + + ! If there are elements of this kind if (nelem > 0) then - nelemnodes = IntKiBuf(Int_Xferred); Int_Xferred = Int_Xferred + 1 ! nodes per element + + ! Get number of nodes per element + call RegUnpack(Buf, nelemnodes) + if (RegCheckErr(Buf, RoutineName)) return - ! nodes in this element - DO j = 1,nelem - - SELECT CASE (nelemnodes) - CASE (1) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ) & - ) - CASE (2) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1) & - ) - CASE (3) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - ) - CASE (4) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3) & - ) - CASE (6) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3),P5 =IntKiBuf(Int_Xferred+ 4),P6 =IntKiBuf(Int_Xferred+ 5) & - ) - CASE (8) - CALL MeshConstructElement( Mesh, i, ErrStat2, ErrMess2 & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3),P5 =IntKiBuf(Int_Xferred+ 4),P6 =IntKiBuf(Int_Xferred+ 5) & - , P7 =IntKiBuf(Int_Xferred+ 6),P8 =IntKiBuf(Int_Xferred+ 7) & - ) - CASE (10) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3),P5 =IntKiBuf(Int_Xferred+ 4),P6 =IntKiBuf(Int_Xferred+ 5) & - , P7 =IntKiBuf(Int_Xferred+ 6),P8 =IntKiBuf(Int_Xferred+ 7),P9 =IntKiBuf(Int_Xferred+ 8) & - , P10=IntKiBuf(Int_Xferred+ 9) & - ) - CASE (15) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3),P5 =IntKiBuf(Int_Xferred+ 4),P6 =IntKiBuf(Int_Xferred+ 5) & - , P7 =IntKiBuf(Int_Xferred+ 6),P8 =IntKiBuf(Int_Xferred+ 7),P9 =IntKiBuf(Int_Xferred+ 8) & - , P10=IntKiBuf(Int_Xferred+ 9),P11=IntKiBuf(Int_Xferred+10),P12=IntKiBuf(Int_Xferred+11) & - , P13=IntKiBuf(Int_Xferred+12),P14=IntKiBuf(Int_Xferred+13),P15=IntKiBuf(Int_Xferred+14) & - ) - CASE (20) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3),P5 =IntKiBuf(Int_Xferred+ 4),P6 =IntKiBuf(Int_Xferred+ 5) & - , P7 =IntKiBuf(Int_Xferred+ 6),P8 =IntKiBuf(Int_Xferred+ 7),P9 =IntKiBuf(Int_Xferred+ 8) & - , P10=IntKiBuf(Int_Xferred+ 9),P11=IntKiBuf(Int_Xferred+10),P12=IntKiBuf(Int_Xferred+11) & - , P13=IntKiBuf(Int_Xferred+12),P14=IntKiBuf(Int_Xferred+13),P15=IntKiBuf(Int_Xferred+14) & - , P16=IntKiBuf(Int_Xferred+15),P17=IntKiBuf(Int_Xferred+16),P18=IntKiBuf(Int_Xferred+17) & - , P19=IntKiBuf(Int_Xferred+18),P20=IntKiBuf(Int_Xferred+19) & - ) - CASE DEFAULT - CALL SetErrStat(ErrID_Fatal,"No such element. Probably manged buffer.",ErrStat,ErrMess,RoutineName) - RETURN - END SELECT - Int_Xferred = Int_Xferred + nelemnodes - END DO ! Elements of this kind - end if ! if there are any elements of this kind - - END DO ! kinds of elements - - ! ..... fill ReKiBuf ..... - DO i = 1, Mesh%Nnodes ! Position - Mesh%Position(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - END DO - DO i = 1, Mesh%Nnodes ! RefOrientation - DO j = 1,3 - Mesh%RefOrientation(:,j,i) = DbKiBuf(Db_Xferred:Db_Xferred+2); Db_Xferred = Db_Xferred + 3 - ENDDO - END DO - - IF ( FieldMask(MASKID_FORCE) ) THEN ! Force - DO i = 1, Mesh%Nnodes - Mesh%Force(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_MOMENT) ) THEN ! Moment - DO i = 1, Mesh%Nnodes - Mesh%Moment(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_ORIENTATION) ) THEN ! Orientation - DO i = 1, Mesh%Nnodes - DO j = 1,3 - Mesh%Orientation(:,j,i) = DbKiBuf(Db_Xferred:Db_Xferred+2); Db_Xferred = Db_Xferred + 3 - ENDDO - END DO - ENDIF - IF ( FieldMask(MASKID_TRANSLATIONDISP) ) THEN ! TranslationDisp - DO i = 1, Mesh%Nnodes - Mesh%TranslationDisp(:,i) = DbKiBuf(Db_Xferred:Db_Xferred+2); Db_Xferred = Db_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_ROTATIONVEL) ) THEN ! RotationVel - DO i = 1, Mesh%Nnodes - Mesh%RotationVel(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_TRANSLATIONVEL) ) THEN ! TranslationVel - DO i = 1, Mesh%Nnodes - Mesh%TranslationVel(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_ROTATIONACC) ) THEN ! RotationAcc - DO i = 1, Mesh%Nnodes - Mesh%RotationAcc(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_TRANSLATIONACC) ) THEN ! TranslationAcc - DO i = 1, Mesh%Nnodes - Mesh%TranslationAcc(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - - IF ( Mesh%nScalars .GT. 0 ) THEN ! n_re = n_re + Mesh%Nnodes * Mesh%nScalar - DO i = 1, Mesh%Nnodes - Mesh%Scalars(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+Mesh%nScalars-1); Re_Xferred = Re_Xferred + Mesh%nScalars - ENDDO - ENDIF + ! Nodes in this element + do j = 1, nelem + + ! Read nodes for this element + call RegUnpack(Buf, EN(1:nelemnodes)) + + select case (nelemnodes) + case (1) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1)) + case (2) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2)) + case (3) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3)) + case (4) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), P4=EN(4)) + case (6) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), & + P4=EN(4), P5=EN(5), P6=EN(6)) + case (8) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), & + P4=EN(4), P5=EN(5), P6=EN(6), P7=EN(7), P8=EN(8)) + case (10) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), & + P4=EN(4), P5=EN(5), P6=EN(6), P7=EN(7), P8=EN(8), P9=EN(9), P10=EN(10)) + case (15) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), & + P4=EN(4), P5=EN(5), P6=EN(6), P7=EN(7), P8=EN(8), P9=EN(9), & + P10=EN(10), P11=EN(11), P12=EN(12), P13=EN(13), P14=EN(14), P15=EN(15)) + case (20) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), & + P4=EN(4), P5=EN(5), P6=EN(6), P7=EN(7), P8=EN(8), P9=EN(9), & + P10=EN(10), P11=EN(11), P12=EN(12), P13=EN(13), P14=EN(14), & + P15=EN(15), P16=EN(16), P17=EN(17), P18=EN(18), P19=EN(19), P20=EN(20)) + case default + call SetErrStat(ErrID_Fatal,"No such element. Probably mangled buffer.", Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end select + end do + end if + end do + + call RegUnpack(Buf, Mesh%Position) + call RegUnpack(Buf, Mesh%RefOrientation) + + if (FieldMask(MASKID_FORCE)) call RegUnpack(Buf, Mesh%Force) + if (FieldMask(MASKID_MOMENT)) call RegUnpack(Buf, Mesh%Moment) + if (FieldMask(MASKID_ORIENTATION)) call RegUnpack(Buf, Mesh%Orientation) + if (FieldMask(MASKID_TRANSLATIONDISP)) call RegUnpack(Buf, Mesh%TranslationDisp) + if (FieldMask(MASKID_ROTATIONVEL)) call RegUnpack(Buf, Mesh%RotationVel) + if (FieldMask(MASKID_TRANSLATIONVEL)) call RegUnpack(Buf, Mesh%TranslationVel) + if (FieldMask(MASKID_TRANSLATIONACC)) call RegUnpack(Buf, Mesh%TranslationAcc) + if (FieldMask(MASKID_ROTATIONACC)) call RegUnpack(Buf, Mesh%RotationAcc) + if (nScalars > 0) call RegUnpack(Buf, Mesh%Scalars) + + ! If buffer error, return + if (RegCheckErr(Buf, RoutineName)) return - ! commit the mesh - IF (committed) THEN - CALL MeshCommit(Mesh, ErrStat2, ErrMess2) - CALL SetErrStat(ErrStat2, ErrMess2, ErrStat, ErrMess, RoutineName) - END IF - - RETURN + ! Commit the mesh + if (committed) call MeshCommit(Mesh, Buf%ErrStat, Buf%ErrMsg) - END SUBROUTINE MeshUnpack + end subroutine !---------------------------------------------------------------------------------------------------------------------------------- !> Given an existing mesh and a destination mesh, create a completely new copy, a sibling, or @@ -3321,7 +3089,7 @@ SUBROUTINE MeshExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation REAL(DbKi) :: tensor(3, order+1) ! for extrapolation of orientations REAL(DbKi) :: tensor_interp(3) ! for extrapolation of orientations REAL(DbKi) :: Orient(3,3) ! for extrapolation of orientations @@ -3351,39 +3119,43 @@ SUBROUTINE MeshExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) RETURN END IF + ! Calculate interpolation coefficients, t(1) = 0 + + a1 = (t_out - t(2))/(t(1) - t(2)) + a2 = (t_out - t(1))/(t(2) - t(1)) + ! now let's interpolate/extrapolate the fields: - scaleFactor = t_out / t(2) IF ( ALLOCATED(u1%Force) ) THEN - u_out%Force = u1%Force + (u2%Force - u1%Force) * scaleFactor + u_out%Force = a1*u1%Force + a2*u2%Force END IF IF ( ALLOCATED(u1%Moment) ) THEN - u_out%Moment = u1%Moment + (u2%Moment - u1%Moment) * scaleFactor + u_out%Moment = a1*u1%Moment + a2*u2%Moment END IF IF ( ALLOCATED(u1%TranslationDisp) ) THEN - u_out%TranslationDisp = u1%TranslationDisp + (u2%TranslationDisp - u1%TranslationDisp) * scaleFactor + u_out%TranslationDisp = a1*u1%TranslationDisp + a2*u2%TranslationDisp END IF IF ( ALLOCATED(u1%RotationVel) ) THEN - u_out%RotationVel = u1%RotationVel + (u2%RotationVel - u1%RotationVel) * scaleFactor + u_out%RotationVel = a1*u1%RotationVel + a2*u2%RotationVel END IF IF ( ALLOCATED(u1%TranslationVel) ) THEN - u_out%TranslationVel = u1%TranslationVel + (u2%TranslationVel - u1%TranslationVel) * scaleFactor + u_out%TranslationVel = a1*u1%TranslationVel + a2*u2%TranslationVel END IF IF ( ALLOCATED(u1%RotationAcc) ) THEN - u_out%RotationAcc = u1%RotationAcc + (u2%RotationAcc - u1%RotationAcc) * scaleFactor + u_out%RotationAcc = a1*u1%RotationAcc + a2*u2%RotationAcc END IF IF ( ALLOCATED(u1%TranslationAcc) ) THEN - u_out%TranslationAcc = u1%TranslationAcc + (u2%TranslationAcc - u1%TranslationAcc) * scaleFactor + u_out%TranslationAcc = a1*u1%TranslationAcc + a2*u2%TranslationAcc END IF IF ( ALLOCATED(u1%Scalars) ) THEN - u_out%Scalars = u1%Scalars + (u2%Scalars - u1%Scalars) * scaleFactor + u_out%Scalars = a1*u1%Scalars + a2*u2%Scalars END IF IF ( ALLOCATED(u1%Orientation) ) THEN @@ -3412,7 +3184,7 @@ SUBROUTINE MeshExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL DCM_SetLogMapForInterp( tensor ) - tensor_interp = tensor(:,1) + (tensor(:,2) - tensor(:,1)) * scaleFactor + tensor_interp = a1*tensor(:,1) + a2*tensor(:,2) u_out%Orientation(:,:,node) = DCM_exp( tensor_interp ) @@ -3443,7 +3215,7 @@ SUBROUTINE MeshExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(DbKi) :: a1, a2, a3 ! temporary for extrapolation/interpolation REAL(DbKi) :: tensor(3, order+1) ! for extrapolation of orientations REAL(DbKi) :: tensor_interp(3) ! for extrapolation of orientations REAL(DbKi) :: Orient(3,3) ! for extrapolation of orientations @@ -3487,63 +3259,44 @@ SUBROUTINE MeshExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) RETURN END IF - ! Now let's interpolate/extrapolate: - - scaleFactor = t_out / ( t(2) * t(3) * (t(2) - t(3)) ) + ! Calculate interpolation coefficients, t(1) = 0 - IF ( ALLOCATED(u1%Force) ) THEN + a1 = (t_out - t(2))*(t_out - t(3))/(t(2)*t(3)) + a2 = t_out*(t_out - t(3))/(t(2)*(t(2) - t(3))) + a3 = t_out*(t_out - t(2))/(t(3)*(t(3) - t(2))) - u_out%Force = u1%Force & - + ( t(3)**2 * (u1%Force - u2%Force) + t(2)**2*(-u1%Force + u3%Force) ) * scaleFactor & - + ( (t(2)-t(3))*u1%Force + t(3)*u2%Force - t(2)*u3%Force ) *scaleFactor * t_out + ! Now let's interpolate/extrapolate: + IF ( ALLOCATED(u1%Force) ) THEN + u_out%Force = a1*u1%Force + a2*u2%Force + a3*u3%Force END IF + IF ( ALLOCATED(u1%Moment) ) THEN - u_out%Moment = u1%Moment & - + ( t(3)**2 * (u1%Moment - u2%Moment) + t(2)**2*(-u1%Moment + u3%Moment) ) * scaleFactor & - + ( (t(2)-t(3))*u1%Moment + t(3)*u2%Moment - t(2)*u3%Moment ) *scaleFactor * t_out + u_out%Moment = a1*u1%Moment + a2*u2%Moment + a3*u3%Moment END IF IF ( ALLOCATED(u1%TranslationDisp) ) THEN - u_out%TranslationDisp = u1%TranslationDisp & - + ( t(3)**2 * ( u1%TranslationDisp - u2%TranslationDisp) & - + t(2)**2 * (-u1%TranslationDisp + u3%TranslationDisp) ) * scaleFactor & - + ( (t(2)-t(3))*u1%TranslationDisp + t(3)*u2%TranslationDisp & - - t(2)*u3%TranslationDisp )*scaleFactor*t_out + u_out%TranslationDisp = a1*u1%TranslationDisp + a2*u2%TranslationDisp + a3*u3%TranslationDisp END IF IF ( ALLOCATED(u1%RotationVel) ) THEN - u_out%RotationVel = u1%RotationVel & - + ( t(3)**2 * ( u1%RotationVel - u2%RotationVel) & - + t(2)**2 * (-u1%RotationVel + u3%RotationVel) ) * scaleFactor & - + ( (t(2)-t(3))*u1%RotationVel + t(3)*u2%RotationVel - t(2)*u3%RotationVel )*scaleFactor*t_out + u_out%RotationVel = a1*u1%RotationVel + a2*u2%RotationVel + a3*u3%RotationVel END IF IF ( ALLOCATED(u1%TranslationVel) ) THEN - u_out%TranslationVel = u1%TranslationVel & - +( t(3)**2 * ( u1%TranslationVel - u2%TranslationVel) & - + t(2)**2 * (-u1%TranslationVel + u3%TranslationVel) ) * scaleFactor & - +( (t(2)-t(3))*u1%TranslationVel + t(3)*u2%TranslationVel - t(2)*u3%TranslationVel)*scaleFactor*t_out + u_out%TranslationVel = a1*u1%TranslationVel + a2*u2%TranslationVel + a3*u3%TranslationVel END IF IF ( ALLOCATED(u1%RotationAcc) ) THEN - u_out%RotationAcc = u1%RotationAcc & - + ( t(3)**2 * ( u1%RotationAcc - u2%RotationAcc) & - + t(2)**2 * (-u1%RotationAcc + u3%RotationAcc) ) * scaleFactor & - + ( (t(2)-t(3))*u1%RotationAcc + t(3)*u2%RotationAcc - t(2)*u3%RotationAcc )*scaleFactor*t_out + u_out%RotationAcc = a1*u1%RotationAcc + a2*u2%RotationAcc + a3*u3%RotationAcc END IF IF ( ALLOCATED(u1%TranslationAcc) ) THEN - u_out%TranslationAcc = u1%TranslationAcc & - +( t(3)**2 * ( u1%TranslationAcc - u2%TranslationAcc) & - + t(2)**2 * (-u1%TranslationAcc + u3%TranslationAcc) ) * scaleFactor & - +( (t(2)-t(3))*u1%TranslationAcc + t(3)*u2%TranslationAcc - t(2)*u3%TranslationAcc)*scaleFactor*t_out + u_out%TranslationAcc = a1*u1%TranslationAcc + a2*u2%TranslationAcc + a3*u3%TranslationAcc END IF IF ( ALLOCATED(u1%Scalars) ) THEN - u_out%Scalars = u1%Scalars & - + ( t(3)**2 * (u1%Scalars - u2%Scalars) + t(2)**2*(-u1%Scalars + u3%Scalars) )*scaleFactor & - + ( (t(2)-t(3))*u1%Scalars + t(3)*u2%Scalars - t(2)*u3%Scalars )*scaleFactor * t_out + u_out%Scalars = a1*u1%Scalars + a2*u2%Scalars + a3*u3%Scalars END IF IF ( ALLOCATED(u1%Orientation) ) THEN @@ -3580,9 +3333,7 @@ SUBROUTINE MeshExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL DCM_SetLogMapForInterp( tensor ) - tensor_interp = tensor(:,1) & - + ( t(3)**2 * (tensor(:,1) - tensor(:,2)) + t(2)**2*(-tensor(:,1) + tensor(:,3)) )*scaleFactor & - + ( (t(2)-t(3))*tensor(:,1) + t(3)*tensor(:,2) - t(2)*tensor(:,3) )*scaleFactor * t_out + tensor_interp = a1*tensor(:,1) + a2*tensor(:,2) + a3*tensor(:,3) u_out%Orientation(:,:,node) = DCM_exp( tensor_interp ) END DO diff --git a/modules/nwtc-library/src/ModMesh_Mapping.f90 b/modules/nwtc-library/src/ModMesh_Mapping.f90 index df2723a60b..d2e08297bd 100644 --- a/modules/nwtc-library/src/ModMesh_Mapping.f90 +++ b/modules/nwtc-library/src/ModMesh_Mapping.f90 @@ -27,6 +27,7 @@ !********************************************************************************************************************************** MODULE ModMesh_Mapping + USE ModReg USE ModMesh USE NWTC_LAPACK @@ -5768,7 +5769,7 @@ END SUBROUTINE WriteMappingTransferToFile ! ! FAST Registry !********************************************************************************************************************************* - SUBROUTINE NWTC_Library_CopyMapType( SrcMapTypeData, DstMapTypeData, CtrlCode, ErrStat, ErrMsg ) +SUBROUTINE NWTC_Library_CopyMapType( SrcMapTypeData, DstMapTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(MapType), INTENT(IN) :: SrcMapTypeData TYPE(MapType), INTENT(INOUT) :: DstMapTypeData INTEGER(IntKi), INTENT(IN ) :: CtrlCode @@ -5777,8 +5778,6 @@ SUBROUTINE NWTC_Library_CopyMapType( SrcMapTypeData, DstMapTypeData, 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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyMapType' @@ -5791,14 +5790,12 @@ SUBROUTINE NWTC_Library_CopyMapType( SrcMapTypeData, DstMapTypeData, CtrlCode, E DstMapTypeData%shape_fn = SrcMapTypeData%shape_fn END SUBROUTINE NWTC_Library_CopyMapType - SUBROUTINE NWTC_Library_DestroyMapType( MapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE NWTC_Library_DestroyMapType( MapTypeData, ErrStat, ErrMsg ) TYPE(MapType), INTENT(INOUT) :: MapTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyMapType' @@ -5806,141 +5803,46 @@ SUBROUTINE NWTC_Library_DestroyMapType( MapTypeData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE NWTC_Library_DestroyMapType - SUBROUTINE NWTC_Library_PackMapType( 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(MapType), 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 = 'NWTC_Library_PackMapType' - ! 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 ! OtherMesh_Element - Db_BufSz = Db_BufSz + 1 ! distance - Db_BufSz = Db_BufSz + SIZE(InData%couple_arm) ! couple_arm - Db_BufSz = Db_BufSz + SIZE(InData%shape_fn) ! shape_fn - 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%OtherMesh_Element - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%distance - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%couple_arm,1), UBOUND(InData%couple_arm,1) - DbKiBuf(Db_Xferred) = InData%couple_arm(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%shape_fn,1), UBOUND(InData%shape_fn,1) - DbKiBuf(Db_Xferred) = InData%shape_fn(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE NWTC_Library_PackMapType - - SUBROUTINE NWTC_Library_UnPackMapType( 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(MapType), 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 = 'NWTC_Library_UnPackMapType' - ! 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%OtherMesh_Element = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%distance = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%couple_arm,1) - i1_u = UBOUND(OutData%couple_arm,1) - DO i1 = LBOUND(OutData%couple_arm,1), UBOUND(OutData%couple_arm,1) - OutData%couple_arm(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%shape_fn,1) - i1_u = UBOUND(OutData%shape_fn,1) - DO i1 = LBOUND(OutData%shape_fn,1), UBOUND(OutData%shape_fn,1) - OutData%shape_fn(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE NWTC_Library_UnPackMapType +subroutine NWTC_Library_PackMapType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackMapType' + if (Buf%ErrStat >= AbortErrLev) return + ! OtherMesh_Element + call RegPack(Buf, InData%OtherMesh_Element) + if (RegCheckErr(Buf, RoutineName)) return + ! distance + call RegPack(Buf, InData%distance) + if (RegCheckErr(Buf, RoutineName)) return + ! couple_arm + call RegPack(Buf, InData%couple_arm) + if (RegCheckErr(Buf, RoutineName)) return + ! shape_fn + call RegPack(Buf, InData%shape_fn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackMapType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMapType' + if (Buf%ErrStat /= ErrID_None) return + ! OtherMesh_Element + call RegUnpack(Buf, OutData%OtherMesh_Element) + if (RegCheckErr(Buf, RoutineName)) return + ! distance + call RegUnpack(Buf, OutData%distance) + if (RegCheckErr(Buf, RoutineName)) return + ! couple_arm + call RegUnpack(Buf, OutData%couple_arm) + if (RegCheckErr(Buf, RoutineName)) return + ! shape_fn + call RegUnpack(Buf, OutData%shape_fn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE NWTC_Library_CopyMeshMapLinearizationType( SrcMeshMapLinearizationTypeData, DstMeshMapLinearizationTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(MeshMapLinearizationType), INTENT(IN) :: SrcMeshMapLinearizationTypeData TYPE(MeshMapLinearizationType), INTENT(INOUT) :: DstMeshMapLinearizationTypeData @@ -6113,14 +6015,12 @@ SUBROUTINE NWTC_Library_CopyMeshMapLinearizationType( SrcMeshMapLinearizationTyp ENDIF END SUBROUTINE NWTC_Library_CopyMeshMapLinearizationType - SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType( MeshMapLinearizationTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType( MeshMapLinearizationTypeData, ErrStat, ErrMsg ) TYPE(MeshMapLinearizationType), INTENT(INOUT) :: MeshMapLinearizationTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyMeshMapLinearizationType' @@ -6128,12 +6028,6 @@ SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType( MeshMapLinearizationTyp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MeshMapLinearizationTypeData%mi)) THEN DEALLOCATE(MeshMapLinearizationTypeData%mi) ENDIF @@ -6169,628 +6063,265 @@ SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType( MeshMapLinearizationTyp ENDIF END SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType - SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( 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(MeshMapLinearizationType), 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 = 'NWTC_Library_PackMeshMapLinearizationType' - ! 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 ! mi allocated yes/no - IF ( ALLOCATED(InData%mi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! mi upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%mi) ! mi - END IF - Int_BufSz = Int_BufSz + 1 ! fx_p allocated yes/no - IF ( ALLOCATED(InData%fx_p) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fx_p upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%fx_p) ! fx_p - END IF - Int_BufSz = Int_BufSz + 1 ! tv_uD allocated yes/no - IF ( ALLOCATED(InData%tv_uD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tv_uD upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%tv_uD) ! tv_uD - END IF - Int_BufSz = Int_BufSz + 1 ! tv_uS allocated yes/no - IF ( ALLOCATED(InData%tv_uS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tv_uS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%tv_uS) ! tv_uS - END IF - Int_BufSz = Int_BufSz + 1 ! ta_uD allocated yes/no - IF ( ALLOCATED(InData%ta_uD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ta_uD upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ta_uD) ! ta_uD - END IF - Int_BufSz = Int_BufSz + 1 ! ta_uS allocated yes/no - IF ( ALLOCATED(InData%ta_uS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ta_uS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ta_uS) ! ta_uS - END IF - Int_BufSz = Int_BufSz + 1 ! ta_rv allocated yes/no - IF ( ALLOCATED(InData%ta_rv) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ta_rv upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ta_rv) ! ta_rv - END IF - Int_BufSz = Int_BufSz + 1 ! li allocated yes/no - IF ( ALLOCATED(InData%li) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! li upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%li) ! li - END IF - Int_BufSz = Int_BufSz + 1 ! M_uS allocated yes/no - IF ( ALLOCATED(InData%M_uS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M_uS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M_uS) ! M_uS - END IF - Int_BufSz = Int_BufSz + 1 ! M_uD allocated yes/no - IF ( ALLOCATED(InData%M_uD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M_uD upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M_uD) ! M_uD - END IF - Int_BufSz = Int_BufSz + 1 ! M_f allocated yes/no - IF ( ALLOCATED(InData%M_f) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M_f upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M_f) ! M_f - 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%mi) ) 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%mi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%mi,2), UBOUND(InData%mi,2) - DO i1 = LBOUND(InData%mi,1), UBOUND(InData%mi,1) - DbKiBuf(Db_Xferred) = InData%mi(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fx_p) ) 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%fx_p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fx_p,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fx_p,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fx_p,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fx_p,2), UBOUND(InData%fx_p,2) - DO i1 = LBOUND(InData%fx_p,1), UBOUND(InData%fx_p,1) - DbKiBuf(Db_Xferred) = InData%fx_p(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tv_uD) ) 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%tv_uD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tv_uD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tv_uD,2), UBOUND(InData%tv_uD,2) - DO i1 = LBOUND(InData%tv_uD,1), UBOUND(InData%tv_uD,1) - DbKiBuf(Db_Xferred) = InData%tv_uD(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tv_uS) ) 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%tv_uS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tv_uS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tv_uS,2), UBOUND(InData%tv_uS,2) - DO i1 = LBOUND(InData%tv_uS,1), UBOUND(InData%tv_uS,1) - DbKiBuf(Db_Xferred) = InData%tv_uS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ta_uD) ) 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%ta_uD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ta_uD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ta_uD,2), UBOUND(InData%ta_uD,2) - DO i1 = LBOUND(InData%ta_uD,1), UBOUND(InData%ta_uD,1) - DbKiBuf(Db_Xferred) = InData%ta_uD(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ta_uS) ) 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%ta_uS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ta_uS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ta_uS,2), UBOUND(InData%ta_uS,2) - DO i1 = LBOUND(InData%ta_uS,1), UBOUND(InData%ta_uS,1) - DbKiBuf(Db_Xferred) = InData%ta_uS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ta_rv) ) 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%ta_rv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_rv,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ta_rv,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_rv,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ta_rv,2), UBOUND(InData%ta_rv,2) - DO i1 = LBOUND(InData%ta_rv,1), UBOUND(InData%ta_rv,1) - DbKiBuf(Db_Xferred) = InData%ta_rv(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%li) ) 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%li,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%li,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%li,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%li,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%li,2), UBOUND(InData%li,2) - DO i1 = LBOUND(InData%li,1), UBOUND(InData%li,1) - DbKiBuf(Db_Xferred) = InData%li(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M_uS) ) 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%M_uS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_uS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M_uS,2), UBOUND(InData%M_uS,2) - DO i1 = LBOUND(InData%M_uS,1), UBOUND(InData%M_uS,1) - DbKiBuf(Db_Xferred) = InData%M_uS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M_uD) ) 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%M_uD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_uD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M_uD,2), UBOUND(InData%M_uD,2) - DO i1 = LBOUND(InData%M_uD,1), UBOUND(InData%M_uD,1) - DbKiBuf(Db_Xferred) = InData%M_uD(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M_f) ) 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%M_f,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_f,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_f,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_f,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M_f,2), UBOUND(InData%M_f,2) - DO i1 = LBOUND(InData%M_f,1), UBOUND(InData%M_f,1) - DbKiBuf(Db_Xferred) = InData%M_f(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE NWTC_Library_PackMeshMapLinearizationType - - SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( 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(MeshMapLinearizationType), 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 = 'NWTC_Library_UnPackMeshMapLinearizationType' - ! 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 ! mi 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%mi)) DEALLOCATE(OutData%mi) - ALLOCATE(OutData%mi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%mi,2), UBOUND(OutData%mi,2) - DO i1 = LBOUND(OutData%mi,1), UBOUND(OutData%mi,1) - OutData%mi(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fx_p 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%fx_p)) DEALLOCATE(OutData%fx_p) - ALLOCATE(OutData%fx_p(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fx_p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fx_p,2), UBOUND(OutData%fx_p,2) - DO i1 = LBOUND(OutData%fx_p,1), UBOUND(OutData%fx_p,1) - OutData%fx_p(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tv_uD 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%tv_uD)) DEALLOCATE(OutData%tv_uD) - ALLOCATE(OutData%tv_uD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tv_uD,2), UBOUND(OutData%tv_uD,2) - DO i1 = LBOUND(OutData%tv_uD,1), UBOUND(OutData%tv_uD,1) - OutData%tv_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tv_uS 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%tv_uS)) DEALLOCATE(OutData%tv_uS) - ALLOCATE(OutData%tv_uS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tv_uS,2), UBOUND(OutData%tv_uS,2) - DO i1 = LBOUND(OutData%tv_uS,1), UBOUND(OutData%tv_uS,1) - OutData%tv_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_uD 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%ta_uD)) DEALLOCATE(OutData%ta_uD) - ALLOCATE(OutData%ta_uD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ta_uD,2), UBOUND(OutData%ta_uD,2) - DO i1 = LBOUND(OutData%ta_uD,1), UBOUND(OutData%ta_uD,1) - OutData%ta_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_uS 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%ta_uS)) DEALLOCATE(OutData%ta_uS) - ALLOCATE(OutData%ta_uS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ta_uS,2), UBOUND(OutData%ta_uS,2) - DO i1 = LBOUND(OutData%ta_uS,1), UBOUND(OutData%ta_uS,1) - OutData%ta_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_rv 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%ta_rv)) DEALLOCATE(OutData%ta_rv) - ALLOCATE(OutData%ta_rv(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_rv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ta_rv,2), UBOUND(OutData%ta_rv,2) - DO i1 = LBOUND(OutData%ta_rv,1), UBOUND(OutData%ta_rv,1) - OutData%ta_rv(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! li 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%li)) DEALLOCATE(OutData%li) - ALLOCATE(OutData%li(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%li.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%li,2), UBOUND(OutData%li,2) - DO i1 = LBOUND(OutData%li,1), UBOUND(OutData%li,1) - OutData%li(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_uS 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%M_uS)) DEALLOCATE(OutData%M_uS) - ALLOCATE(OutData%M_uS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M_uS,2), UBOUND(OutData%M_uS,2) - DO i1 = LBOUND(OutData%M_uS,1), UBOUND(OutData%M_uS,1) - OutData%M_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_uD 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%M_uD)) DEALLOCATE(OutData%M_uD) - ALLOCATE(OutData%M_uD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M_uD,2), UBOUND(OutData%M_uD,2) - DO i1 = LBOUND(OutData%M_uD,1), UBOUND(OutData%M_uD,1) - OutData%M_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_f 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%M_f)) DEALLOCATE(OutData%M_f) - ALLOCATE(OutData%M_f(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_f.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M_f,2), UBOUND(OutData%M_f,2) - DO i1 = LBOUND(OutData%M_f,1), UBOUND(OutData%M_f,1) - OutData%M_f(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType +subroutine NWTC_Library_PackMeshMapLinearizationType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MeshMapLinearizationType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshMapLinearizationType' + if (Buf%ErrStat >= AbortErrLev) return + ! mi + call RegPack(Buf, allocated(InData%mi)) + if (allocated(InData%mi)) then + call RegPackBounds(Buf, 2, lbound(InData%mi), ubound(InData%mi)) + call RegPack(Buf, InData%mi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fx_p + call RegPack(Buf, allocated(InData%fx_p)) + if (allocated(InData%fx_p)) then + call RegPackBounds(Buf, 2, lbound(InData%fx_p), ubound(InData%fx_p)) + call RegPack(Buf, InData%fx_p) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! tv_uD + call RegPack(Buf, allocated(InData%tv_uD)) + if (allocated(InData%tv_uD)) then + call RegPackBounds(Buf, 2, lbound(InData%tv_uD), ubound(InData%tv_uD)) + call RegPack(Buf, InData%tv_uD) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! tv_uS + call RegPack(Buf, allocated(InData%tv_uS)) + if (allocated(InData%tv_uS)) then + call RegPackBounds(Buf, 2, lbound(InData%tv_uS), ubound(InData%tv_uS)) + call RegPack(Buf, InData%tv_uS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ta_uD + call RegPack(Buf, allocated(InData%ta_uD)) + if (allocated(InData%ta_uD)) then + call RegPackBounds(Buf, 2, lbound(InData%ta_uD), ubound(InData%ta_uD)) + call RegPack(Buf, InData%ta_uD) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ta_uS + call RegPack(Buf, allocated(InData%ta_uS)) + if (allocated(InData%ta_uS)) then + call RegPackBounds(Buf, 2, lbound(InData%ta_uS), ubound(InData%ta_uS)) + call RegPack(Buf, InData%ta_uS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ta_rv + call RegPack(Buf, allocated(InData%ta_rv)) + if (allocated(InData%ta_rv)) then + call RegPackBounds(Buf, 2, lbound(InData%ta_rv), ubound(InData%ta_rv)) + call RegPack(Buf, InData%ta_rv) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! li + call RegPack(Buf, allocated(InData%li)) + if (allocated(InData%li)) then + call RegPackBounds(Buf, 2, lbound(InData%li), ubound(InData%li)) + call RegPack(Buf, InData%li) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! M_uS + call RegPack(Buf, allocated(InData%M_uS)) + if (allocated(InData%M_uS)) then + call RegPackBounds(Buf, 2, lbound(InData%M_uS), ubound(InData%M_uS)) + call RegPack(Buf, InData%M_uS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! M_uD + call RegPack(Buf, allocated(InData%M_uD)) + if (allocated(InData%M_uD)) then + call RegPackBounds(Buf, 2, lbound(InData%M_uD), ubound(InData%M_uD)) + call RegPack(Buf, InData%M_uD) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! M_f + call RegPack(Buf, allocated(InData%M_f)) + if (allocated(InData%M_f)) then + call RegPackBounds(Buf, 2, lbound(InData%M_f), ubound(InData%M_f)) + call RegPack(Buf, InData%M_f) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackMeshMapLinearizationType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MeshMapLinearizationType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapLinearizationType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! mi + if (allocated(OutData%mi)) deallocate(OutData%mi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%mi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%mi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%mi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! fx_p + if (allocated(OutData%fx_p)) deallocate(OutData%fx_p) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fx_p(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fx_p.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fx_p) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! tv_uD + if (allocated(OutData%tv_uD)) deallocate(OutData%tv_uD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%tv_uD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%tv_uD) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! tv_uS + if (allocated(OutData%tv_uS)) deallocate(OutData%tv_uS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%tv_uS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%tv_uS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ta_uD + if (allocated(OutData%ta_uD)) deallocate(OutData%ta_uD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ta_uD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ta_uD) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ta_uS + if (allocated(OutData%ta_uS)) deallocate(OutData%ta_uS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ta_uS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ta_uS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ta_rv + if (allocated(OutData%ta_rv)) deallocate(OutData%ta_rv) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ta_rv(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_rv.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ta_rv) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! li + if (allocated(OutData%li)) deallocate(OutData%li) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%li(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%li.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%li) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! M_uS + if (allocated(OutData%M_uS)) deallocate(OutData%M_uS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M_uS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M_uS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! M_uD + if (allocated(OutData%M_uD)) deallocate(OutData%M_uD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M_uD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M_uD) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! M_f + if (allocated(OutData%M_f)) deallocate(OutData%M_f) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M_f(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_f.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M_f) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE NWTC_Library_CopyMeshMapType( SrcMeshMapTypeData, DstMeshMapTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(MeshMapType), INTENT(INOUT) :: SrcMeshMapTypeData TYPE(MeshMapType), INTENT(INOUT) :: DstMeshMapTypeData @@ -6937,14 +6468,12 @@ SUBROUTINE NWTC_Library_CopyMeshMapType( SrcMeshMapTypeData, DstMeshMapTypeData, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE NWTC_Library_CopyMeshMapType - SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg ) TYPE(MeshMapType), INTENT(INOUT) :: MeshMapTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyMeshMapType' @@ -6952,29 +6481,23 @@ SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg, DE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MeshMapTypeData%MapLoads)) THEN DO i1 = LBOUND(MeshMapTypeData%MapLoads,1), UBOUND(MeshMapTypeData%MapLoads,1) - CALL NWTC_Library_Destroymaptype( MeshMapTypeData%MapLoads(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMapType( MeshMapTypeData%MapLoads(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MeshMapTypeData%MapLoads) ENDIF IF (ALLOCATED(MeshMapTypeData%MapMotions)) THEN DO i1 = LBOUND(MeshMapTypeData%MapMotions,1), UBOUND(MeshMapTypeData%MapMotions,1) - CALL NWTC_Library_Destroymaptype( MeshMapTypeData%MapMotions(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMapType( MeshMapTypeData%MapMotions(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MeshMapTypeData%MapMotions) ENDIF IF (ALLOCATED(MeshMapTypeData%MapSrcToAugmt)) THEN DO i1 = LBOUND(MeshMapTypeData%MapSrcToAugmt,1), UBOUND(MeshMapTypeData%MapSrcToAugmt,1) - CALL NWTC_Library_Destroymaptype( MeshMapTypeData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMapType( MeshMapTypeData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MeshMapTypeData%MapSrcToAugmt) @@ -6998,960 +6521,236 @@ SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg, DE IF (ALLOCATED(MeshMapTypeData%LoadLn2_M)) THEN DEALLOCATE(MeshMapTypeData%LoadLn2_M) ENDIF - CALL NWTC_Library_Destroymeshmaplinearizationtype( MeshMapTypeData%dM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapLinearizationType( MeshMapTypeData%dM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE NWTC_Library_DestroyMeshMapType - SUBROUTINE NWTC_Library_PackMeshMapType( 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(MeshMapType), 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 = 'NWTC_Library_PackMeshMapType' - ! 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 ! MapLoads allocated yes/no - IF ( ALLOCATED(InData%MapLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MapLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%MapLoads,1), UBOUND(InData%MapLoads,1) - Int_BufSz = Int_BufSz + 3 ! MapLoads: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapLoads(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MapLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MapLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MapLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MapLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MapMotions allocated yes/no - IF ( ALLOCATED(InData%MapMotions) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MapMotions upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MapMotions,1), UBOUND(InData%MapMotions,1) - Int_BufSz = Int_BufSz + 3 ! MapMotions: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapMotions(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MapMotions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MapMotions - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MapMotions - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MapMotions - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MapSrcToAugmt allocated yes/no - IF ( ALLOCATED(InData%MapSrcToAugmt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MapSrcToAugmt upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MapSrcToAugmt,1), UBOUND(InData%MapSrcToAugmt,1) - Int_BufSz = Int_BufSz + 3 ! MapSrcToAugmt: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MapSrcToAugmt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MapSrcToAugmt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MapSrcToAugmt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MapSrcToAugmt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Augmented_Ln2_Src: size of buffers for each call to pack subtype - CALL MeshPack( InData%Augmented_Ln2_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Augmented_Ln2_Src - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Augmented_Ln2_Src - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Augmented_Ln2_Src - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Augmented_Ln2_Src - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Lumped_Points_Src: size of buffers for each call to pack subtype - CALL MeshPack( InData%Lumped_Points_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Lumped_Points_Src - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Lumped_Points_Src - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Lumped_Points_Src - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Lumped_Points_Src - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! LoadLn2_A_Mat_Piv allocated yes/no - IF ( ALLOCATED(InData%LoadLn2_A_Mat_Piv) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LoadLn2_A_Mat_Piv upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LoadLn2_A_Mat_Piv) ! LoadLn2_A_Mat_Piv - END IF - Int_BufSz = Int_BufSz + 1 ! DisplacedPosition allocated yes/no - IF ( ALLOCATED(InData%DisplacedPosition) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! DisplacedPosition upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DisplacedPosition) ! DisplacedPosition - END IF - Int_BufSz = Int_BufSz + 1 ! LoadLn2_A_Mat allocated yes/no - IF ( ALLOCATED(InData%LoadLn2_A_Mat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_A_Mat upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_A_Mat) ! LoadLn2_A_Mat - END IF - Int_BufSz = Int_BufSz + 1 ! LoadLn2_F allocated yes/no - IF ( ALLOCATED(InData%LoadLn2_F) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_F upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_F) ! LoadLn2_F - END IF - Int_BufSz = Int_BufSz + 1 ! LoadLn2_M allocated yes/no - IF ( ALLOCATED(InData%LoadLn2_M) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_M upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_M) ! LoadLn2_M - END IF - Int_BufSz = Int_BufSz + 3 ! dM: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaplinearizationtype( Re_Buf, Db_Buf, Int_Buf, InData%dM, ErrStat2, ErrMsg2, .TRUE. ) ! dM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! dM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! dM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! dM - 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 - - IF ( .NOT. ALLOCATED(InData%MapLoads) ) 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%MapLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MapLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MapLoads,1), UBOUND(InData%MapLoads,1) - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapLoads(i1), ErrStat2, ErrMsg2, OnlySize ) ! MapLoads - 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 - IF ( .NOT. ALLOCATED(InData%MapMotions) ) 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%MapMotions,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MapMotions,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MapMotions,1), UBOUND(InData%MapMotions,1) - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapMotions(i1), ErrStat2, ErrMsg2, OnlySize ) ! MapMotions - 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 - IF ( .NOT. ALLOCATED(InData%MapSrcToAugmt) ) 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%MapSrcToAugmt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MapSrcToAugmt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MapSrcToAugmt,1), UBOUND(InData%MapSrcToAugmt,1) - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2, OnlySize ) ! MapSrcToAugmt - 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 - CALL MeshPack( InData%Augmented_Ln2_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Augmented_Ln2_Src - 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 - CALL MeshPack( InData%Lumped_Points_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Lumped_Points_Src - 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 - IF ( .NOT. ALLOCATED(InData%LoadLn2_A_Mat_Piv) ) 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%LoadLn2_A_Mat_Piv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat_Piv,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LoadLn2_A_Mat_Piv,1), UBOUND(InData%LoadLn2_A_Mat_Piv,1) - IntKiBuf(Int_Xferred) = InData%LoadLn2_A_Mat_Piv(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DisplacedPosition) ) 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%DisplacedPosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisplacedPosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisplacedPosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisplacedPosition,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisplacedPosition,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisplacedPosition,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%DisplacedPosition,3), UBOUND(InData%DisplacedPosition,3) - DO i2 = LBOUND(InData%DisplacedPosition,2), UBOUND(InData%DisplacedPosition,2) - DO i1 = LBOUND(InData%DisplacedPosition,1), UBOUND(InData%DisplacedPosition,1) - DbKiBuf(Db_Xferred) = InData%DisplacedPosition(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LoadLn2_A_Mat) ) 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%LoadLn2_A_Mat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LoadLn2_A_Mat,2), UBOUND(InData%LoadLn2_A_Mat,2) - DO i1 = LBOUND(InData%LoadLn2_A_Mat,1), UBOUND(InData%LoadLn2_A_Mat,1) - DbKiBuf(Db_Xferred) = InData%LoadLn2_A_Mat(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LoadLn2_F) ) 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%LoadLn2_F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_F,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LoadLn2_F,2), UBOUND(InData%LoadLn2_F,2) - DO i1 = LBOUND(InData%LoadLn2_F,1), UBOUND(InData%LoadLn2_F,1) - DbKiBuf(Db_Xferred) = InData%LoadLn2_F(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LoadLn2_M) ) 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%LoadLn2_M,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_M,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_M,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_M,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LoadLn2_M,2), UBOUND(InData%LoadLn2_M,2) - DO i1 = LBOUND(InData%LoadLn2_M,1), UBOUND(InData%LoadLn2_M,1) - DbKiBuf(Db_Xferred) = InData%LoadLn2_M(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - CALL NWTC_Library_Packmeshmaplinearizationtype( Re_Buf, Db_Buf, Int_Buf, InData%dM, ErrStat2, ErrMsg2, OnlySize ) ! dM - 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 NWTC_Library_PackMeshMapType - SUBROUTINE NWTC_Library_UnPackMeshMapType( 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(MeshMapType), 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 = 'NWTC_Library_UnPackMeshMapType' - ! 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 ! MapLoads 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%MapLoads)) DEALLOCATE(OutData%MapLoads) - ALLOCATE(OutData%MapLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MapLoads,1), UBOUND(OutData%MapLoads,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_Unpackmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%MapLoads(i1), ErrStat2, ErrMsg2 ) ! MapLoads - 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 ! MapMotions 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%MapMotions)) DEALLOCATE(OutData%MapMotions) - ALLOCATE(OutData%MapMotions(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapMotions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MapMotions,1), UBOUND(OutData%MapMotions,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_Unpackmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%MapMotions(i1), ErrStat2, ErrMsg2 ) ! MapMotions - 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 ! MapSrcToAugmt 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%MapSrcToAugmt)) DEALLOCATE(OutData%MapSrcToAugmt) - ALLOCATE(OutData%MapSrcToAugmt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapSrcToAugmt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MapSrcToAugmt,1), UBOUND(OutData%MapSrcToAugmt,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_Unpackmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2 ) ! MapSrcToAugmt - 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 - 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 MeshUnpack( OutData%Augmented_Ln2_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Augmented_Ln2_Src - 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) - 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 MeshUnpack( OutData%Lumped_Points_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Lumped_Points_Src - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_A_Mat_Piv 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%LoadLn2_A_Mat_Piv)) DEALLOCATE(OutData%LoadLn2_A_Mat_Piv) - ALLOCATE(OutData%LoadLn2_A_Mat_Piv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat_Piv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LoadLn2_A_Mat_Piv,1), UBOUND(OutData%LoadLn2_A_Mat_Piv,1) - OutData%LoadLn2_A_Mat_Piv(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DisplacedPosition 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%DisplacedPosition)) DEALLOCATE(OutData%DisplacedPosition) - ALLOCATE(OutData%DisplacedPosition(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%DisplacedPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%DisplacedPosition,3), UBOUND(OutData%DisplacedPosition,3) - DO i2 = LBOUND(OutData%DisplacedPosition,2), UBOUND(OutData%DisplacedPosition,2) - DO i1 = LBOUND(OutData%DisplacedPosition,1), UBOUND(OutData%DisplacedPosition,1) - OutData%DisplacedPosition(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_A_Mat 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%LoadLn2_A_Mat)) DEALLOCATE(OutData%LoadLn2_A_Mat) - ALLOCATE(OutData%LoadLn2_A_Mat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LoadLn2_A_Mat,2), UBOUND(OutData%LoadLn2_A_Mat,2) - DO i1 = LBOUND(OutData%LoadLn2_A_Mat,1), UBOUND(OutData%LoadLn2_A_Mat,1) - OutData%LoadLn2_A_Mat(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_F 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%LoadLn2_F)) DEALLOCATE(OutData%LoadLn2_F) - ALLOCATE(OutData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LoadLn2_F,2), UBOUND(OutData%LoadLn2_F,2) - DO i1 = LBOUND(OutData%LoadLn2_F,1), UBOUND(OutData%LoadLn2_F,1) - OutData%LoadLn2_F(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_M 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%LoadLn2_M)) DEALLOCATE(OutData%LoadLn2_M) - ALLOCATE(OutData%LoadLn2_M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LoadLn2_M,2), UBOUND(OutData%LoadLn2_M,2) - DO i1 = LBOUND(OutData%LoadLn2_M,1), UBOUND(OutData%LoadLn2_M,1) - OutData%LoadLn2_M(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - 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 NWTC_Library_Unpackmeshmaplinearizationtype( Re_Buf, Db_Buf, Int_Buf, OutData%dM, ErrStat2, ErrMsg2 ) ! dM - 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 NWTC_Library_UnPackMeshMapType +subroutine NWTC_Library_PackMeshMapType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MeshMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshMapType' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + ! MapLoads + call RegPack(Buf, allocated(InData%MapLoads)) + if (allocated(InData%MapLoads)) then + call RegPackBounds(Buf, 1, lbound(InData%MapLoads), ubound(InData%MapLoads)) + LB(1:1) = lbound(InData%MapLoads) + UB(1:1) = ubound(InData%MapLoads) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMapType(Buf, InData%MapLoads(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MapMotions + call RegPack(Buf, allocated(InData%MapMotions)) + if (allocated(InData%MapMotions)) then + call RegPackBounds(Buf, 1, lbound(InData%MapMotions), ubound(InData%MapMotions)) + LB(1:1) = lbound(InData%MapMotions) + UB(1:1) = ubound(InData%MapMotions) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMapType(Buf, InData%MapMotions(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MapSrcToAugmt + call RegPack(Buf, allocated(InData%MapSrcToAugmt)) + if (allocated(InData%MapSrcToAugmt)) then + call RegPackBounds(Buf, 1, lbound(InData%MapSrcToAugmt), ubound(InData%MapSrcToAugmt)) + LB(1:1) = lbound(InData%MapSrcToAugmt) + UB(1:1) = ubound(InData%MapSrcToAugmt) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMapType(Buf, InData%MapSrcToAugmt(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Augmented_Ln2_Src + call MeshPack(Buf, InData%Augmented_Ln2_Src) + if (RegCheckErr(Buf, RoutineName)) return + ! Lumped_Points_Src + call MeshPack(Buf, InData%Lumped_Points_Src) + if (RegCheckErr(Buf, RoutineName)) return + ! LoadLn2_A_Mat_Piv + call RegPack(Buf, allocated(InData%LoadLn2_A_Mat_Piv)) + if (allocated(InData%LoadLn2_A_Mat_Piv)) then + call RegPackBounds(Buf, 1, lbound(InData%LoadLn2_A_Mat_Piv), ubound(InData%LoadLn2_A_Mat_Piv)) + call RegPack(Buf, InData%LoadLn2_A_Mat_Piv) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DisplacedPosition + call RegPack(Buf, allocated(InData%DisplacedPosition)) + if (allocated(InData%DisplacedPosition)) then + call RegPackBounds(Buf, 3, lbound(InData%DisplacedPosition), ubound(InData%DisplacedPosition)) + call RegPack(Buf, InData%DisplacedPosition) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LoadLn2_A_Mat + call RegPack(Buf, allocated(InData%LoadLn2_A_Mat)) + if (allocated(InData%LoadLn2_A_Mat)) then + call RegPackBounds(Buf, 2, lbound(InData%LoadLn2_A_Mat), ubound(InData%LoadLn2_A_Mat)) + call RegPack(Buf, InData%LoadLn2_A_Mat) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LoadLn2_F + call RegPack(Buf, allocated(InData%LoadLn2_F)) + if (allocated(InData%LoadLn2_F)) then + call RegPackBounds(Buf, 2, lbound(InData%LoadLn2_F), ubound(InData%LoadLn2_F)) + call RegPack(Buf, InData%LoadLn2_F) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LoadLn2_M + call RegPack(Buf, allocated(InData%LoadLn2_M)) + if (allocated(InData%LoadLn2_M)) then + call RegPackBounds(Buf, 2, lbound(InData%LoadLn2_M), ubound(InData%LoadLn2_M)) + call RegPack(Buf, InData%LoadLn2_M) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dM + call NWTC_Library_PackMeshMapLinearizationType(Buf, InData%dM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackMeshMapType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MeshMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapType' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! MapLoads + if (allocated(OutData%MapLoads)) deallocate(OutData%MapLoads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MapLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMapType(Buf, OutData%MapLoads(i1)) ! MapLoads + end do + end if + ! MapMotions + if (allocated(OutData%MapMotions)) deallocate(OutData%MapMotions) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MapMotions(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapMotions.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMapType(Buf, OutData%MapMotions(i1)) ! MapMotions + end do + end if + ! MapSrcToAugmt + if (allocated(OutData%MapSrcToAugmt)) deallocate(OutData%MapSrcToAugmt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MapSrcToAugmt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapSrcToAugmt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMapType(Buf, OutData%MapSrcToAugmt(i1)) ! MapSrcToAugmt + end do + end if + ! Augmented_Ln2_Src + call MeshUnpack(Buf, OutData%Augmented_Ln2_Src) ! Augmented_Ln2_Src + ! Lumped_Points_Src + call MeshUnpack(Buf, OutData%Lumped_Points_Src) ! Lumped_Points_Src + ! LoadLn2_A_Mat_Piv + if (allocated(OutData%LoadLn2_A_Mat_Piv)) deallocate(OutData%LoadLn2_A_Mat_Piv) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LoadLn2_A_Mat_Piv(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat_Piv.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LoadLn2_A_Mat_Piv) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DisplacedPosition + if (allocated(OutData%DisplacedPosition)) deallocate(OutData%DisplacedPosition) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DisplacedPosition(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DisplacedPosition.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DisplacedPosition) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LoadLn2_A_Mat + if (allocated(OutData%LoadLn2_A_Mat)) deallocate(OutData%LoadLn2_A_Mat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LoadLn2_A_Mat(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LoadLn2_A_Mat) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LoadLn2_F + if (allocated(OutData%LoadLn2_F)) deallocate(OutData%LoadLn2_F) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LoadLn2_F(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_F.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LoadLn2_F) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LoadLn2_M + if (allocated(OutData%LoadLn2_M)) deallocate(OutData%LoadLn2_M) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LoadLn2_M(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_M.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LoadLn2_M) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dM + call NWTC_Library_UnpackMeshMapLinearizationType(Buf, OutData%dM) ! dM +end subroutine !********************************************************************************************************************************* !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/ModReg.f90 b/modules/nwtc-library/src/ModReg.f90 new file mode 100644 index 0000000000..2dd0fd829d --- /dev/null +++ b/modules/nwtc-library/src/ModReg.f90 @@ -0,0 +1,1679 @@ + +module ModReg + use NWTC_Base + implicit none + + private + public :: PackBuffer + public :: WritePackBuffer, ReadPackBuffer, InitPackBuffer, RegCheckErr + public :: RegPack, RegPackBounds, RegPackPointer + public :: RegUnpack, RegUnpackBounds, RegUnpackPointer + + type :: PackBuffer + integer(B1Ki), allocatable :: Bytes(:) + integer(IntKi) :: NB + type(c_ptr), allocatable :: Pointers(:) + integer(IntKi) :: NP + integer(IntKi) :: ErrStat = ErrID_Fatal + character(ErrMsgLen) :: ErrMsg = 'PackBuffer not initialized' + end type + + + interface RegPack + module procedure Pack_C1, Pack_C1_Rank1, Pack_C1_Rank2, Pack_C1_Rank3, & + Pack_C1_Rank4, Pack_C1_Rank5, Pack_L1, Pack_L1_Rank1, Pack_L1_Rank2, & + Pack_L1_Rank3, Pack_L1_Rank4, Pack_L1_Rank5, Pack_I4, Pack_I4_Rank1, & + Pack_I4_Rank2, Pack_I4_Rank3, Pack_I4_Rank4, Pack_I4_Rank5, Pack_R4, & + Pack_R4_Rank1, Pack_R4_Rank2, Pack_R4_Rank3, Pack_R4_Rank4, & + Pack_R4_Rank5, Pack_R8, Pack_R8_Rank1, Pack_R8_Rank2, Pack_R8_Rank3, & + Pack_R8_Rank4, Pack_R8_Rank5 + end interface + + interface RegUnpack + module procedure Unpack_C1, Unpack_C1_Rank1, Unpack_C1_Rank2, & + Unpack_C1_Rank3, Unpack_C1_Rank4, Unpack_C1_Rank5, Unpack_L1, & + Unpack_L1_Rank1, Unpack_L1_Rank2, Unpack_L1_Rank3, Unpack_L1_Rank4, & + Unpack_L1_Rank5, Unpack_I4, Unpack_I4_Rank1, Unpack_I4_Rank2, & + Unpack_I4_Rank3, Unpack_I4_Rank4, Unpack_I4_Rank5, Unpack_R4, & + Unpack_R4_Rank1, Unpack_R4_Rank2, Unpack_R4_Rank3, Unpack_R4_Rank4, & + Unpack_R4_Rank5, Unpack_R8, Unpack_R8_Rank1, Unpack_R8_Rank2, & + Unpack_R8_Rank3, Unpack_R8_Rank4, Unpack_R8_Rank5 + end interface + +contains + + subroutine InitPackBuffer(Buf, ErrStat, ErrMsg) + type(PackBuffer), intent(inout) :: Buf + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "InitPackBuffer" + integer(IntKi), parameter :: NumPointersInit = 128 + integer(IntKi), parameter :: NumBytesInit = 1024 + integer(IntKi) :: stat + + ErrStat = ErrID_None + ErrMsg = "" + + Buf%ErrStat = ErrID_None + Buf%ErrMsg = "" + Buf%NP = 0 + Buf%NB = 0 + + ! If pointers have not been allocated, allocate with initial size + if (.not. allocated(Buf%Pointers)) then + allocate (Buf%Pointers(NumPointersInit), stat=stat) + if (stat /= 0) then + ErrStat = ErrID_Fatal + write(ErrMsg,*) 'InitPackBuffer: Unable to init pointer index to with size of', NumPointersInit + return + end if + end if + + ! Reset all pointers to null + Buf%Pointers = c_null_ptr + + ! If byte array has not been allocated, allocate with initial size + if (.not. allocated(Buf%Bytes)) then + allocate (Buf%Bytes(NumBytesInit), stat=stat) + if (stat /= 0) then + ErrStat = ErrID_Fatal + write(ErrMsg,*) 'Grow: Unable to init buffer to', NumBytesInit, 'bytes' + return + end if + end if + + end subroutine + + subroutine WritePackBuffer(Buf, Unit, ErrStat, ErrMsg) + type(PackBuffer), intent(inout) :: Buf + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "WritePackBuffer" + integer(IntKi) :: iostat + + ErrStat = ErrID_None + ErrMsg = '' + + if (Buf%ErrStat /= ErrID_None) then + call SetErrStat(Buf%ErrStat, Buf%ErrMsg, ErrStat, ErrMsg, 'Buf%WriteFile') + return + end if + + write(Unit, iostat=iostat) Buf%NP + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error writing number of pointers", ErrStat, ErrMsg, RoutineName) + return + end if + + write(Unit, iostat=iostat) Buf%NB + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error writing number of bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + write(Unit, iostat=iostat) Buf%Bytes(1:Buf%NB) + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error writing bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + end subroutine + + subroutine ReadPackBuffer(Buf, Unit, ErrStat, ErrMsg) + type(PackBuffer), intent(inout) :: Buf + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "ReadPackBuffer" + integer(IntKi) :: iostat + + ErrStat = ErrID_None + ErrMsg = '' + + ! Read number of pointers + read(Unit, iostat=iostat) Buf%NP + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error reading number of pointers", ErrStat, ErrMsg, RoutineName) + return + end if + + ! If pointers are allocated, deallocate + if (allocated(Buf%Pointers)) deallocate(Buf%Pointers) + + ! Allocate pointer index and initialize pointers to null + allocate(Buf%Pointers(1:Buf%NP), stat=ErrStat) + Buf%Pointers = c_null_ptr + + ! Read number of bytes in buffer + read(Unit, iostat=iostat) Buf%NB + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error reading number of bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + ! If bytes are allocated, deallocate + if (allocated(Buf%Bytes)) deallocate(Buf%Bytes) + + ! Allocate bytes + allocate(Buf%Bytes(1:Buf%NB), stat=ErrStat) + + ! Read bytes + read(Unit, iostat=iostat) Buf%Bytes + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error reading bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Clear buffer error + Buf%ErrStat = ErrID_None + Buf%ErrMsg = '' + + ! Reset Number of bytes to be used by unpack routines + Buf%NB = 0 + + end subroutine + + function RegCheckErr(Buf, RoutineName) result(Err) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: RoutineName + logical :: Err + Err = Buf%ErrStat /= ErrID_None + if (Err) Buf%ErrMsg = trim(RoutineName)//": "//trim(Buf%ErrMsg) + end function + + elemental function LogicalToByte(b) result(i) + logical, intent(in) :: b + integer(B1Ki) :: i + if (b) then + i = 1_B1Ki + else + i = 0_B1Ki + end if + end function + + elemental function ByteToLogical(i) result(b) + integer(B1Ki), intent(in) :: i + logical :: b + if (i == 0) then + b = .false. + else + b = .true. + end if + end function + + subroutine RegPackPointer(Buf, Ptr, Found) + type(PackBuffer), intent(inout) :: Buf + type(c_ptr), intent(in) :: Ptr + logical, intent(out) :: Found + + type(c_ptr), allocatable :: PointersTmp(:) + integer(IntKi) :: NewSize + integer(B4Ki) :: i + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Look for pointer in index, if found, pack pointer index and return + do i = 1, Buf%NP + if (c_associated(Ptr, Buf%Pointers(i))) then + call RegPack(Buf, i) + Found = .true. + return + end if + end do + + ! Pointer was not found in index + Found = .false. + + ! If pointer index is full, grow pointer index + if (Buf%NP == size(Buf%Pointers)) then + NewSize = int(1.5_R4Ki * real(Buf%NP, R4Ki), IntKi) + call move_alloc(Buf%Pointers, PointersTmp) + allocate (Buf%Pointers(NewSize), stat=Buf%ErrStat) + if (Buf%ErrStat /= ErrID_None) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) 'RegPackPointer: Unable to allocate pointer index to', NewSize, 'bytes' + return + end if + Buf%Pointers(1:size(PointersTmp)) = PointersTmp + Buf%Pointers(size(PointersTmp)+1:) = c_null_ptr + end if + + ! Increment number of pointers, add new pointer to index + Buf%NP = Buf%NP + 1 + Buf%Pointers(Buf%NP) = Ptr + + ! Pack pointer index + call RegPack(Buf, Buf%NP) + + end subroutine + + subroutine RegUnpackPointer(Buf, Ptr, Idx) + type(PackBuffer), intent(inout) :: Buf + type(c_ptr), intent(out) :: Ptr + integer(B4Ki), intent(out) :: Idx + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Unpack pointer index + call RegUnpack(Buf, Idx) + + ! Get pointer from index + Ptr = Buf%Pointers(Idx) + + end subroutine + + subroutine RegPackBounds(Buf, R, LB, UB) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: R, LB(:), UB(:) + + ! If buffer has an error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Pack lower and upper bounds + call RegPack(Buf, LB(1:R)) + call RegPack(Buf, UB(1:R)) + if (RegCheckErr(Buf, "RegPackBounds")) return + end subroutine + + subroutine RegUnpackBounds(Buf, R, LB, UB) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: R + integer(B4Ki), intent(out) :: LB(:), UB(:) + + ! If buffer has an error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Unpack lower and upper bounds + call RegUnpack(Buf, LB(1:R)) + call RegUnpack(Buf, UB(1:R)) + if (RegCheckErr(Buf, "RegUnpackBounds")) return + end subroutine + + subroutine GrowBuffer(Buf, N) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: N + + integer(B1Ki), allocatable :: BytesTmp(:) + integer(B4Ki) :: NewSize + integer(IntKi) :: stat + + ! Return if there is a buffer error + if (Buf%ErrStat /= ErrID_None) return + + ! If buffer can hold requested bytes, return + if (size(Buf%Bytes) > Buf%NB + N) return + + ! Calculate new size + NewSize = int(real(Buf%NB + N, R4Ki) * 1.8_R4Ki, IntKi) + + ! Move allocation to temporary array and allocate buffer with new size + call move_alloc(Buf%Bytes, BytesTmp) + allocate (Buf%Bytes(NewSize), stat=stat) + if (stat /= 0) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) 'Grow: Unable to grow buffer to', NewSize, 'bytes' + return + end if + + ! Copy contents of temporary bytes to buffer + Buf%Bytes(1:size(BytesTmp)) = BytesTmp + + end subroutine + + + subroutine Pack_C1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_C1")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_C1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(out) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_C1: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_C1_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1))*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_C1_Rank1")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_C1_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(out) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1))*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_C1_Rank1: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_C1_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1))*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_C1_Rank2")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_C1_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(out) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1))*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_C1_Rank2: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_C1_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1,1))*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_C1_Rank3")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_C1_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(out) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1,1))*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_C1_Rank3: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_C1_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1,1,1))*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_C1_Rank4")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_C1_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(out) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1,1,1))*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_C1_Rank4: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_C1_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1,1,1,1))*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_C1_Rank5")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_C1_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1,1,1,1))*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_C1_Rank5: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_L1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(in) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 1 + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_L1")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_L1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(out) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 1 + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_L1: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = ByteToLogical(Buf%Bytes(Buf%NB+1)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_L1_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(in) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_L1_Rank1")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_L1_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(out) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_L1_Rank1: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_L1_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(in) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_L1_Rank2")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_L1_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(out) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_L1_Rank2: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_L1_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(in) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_L1_Rank3")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_L1_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(out) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_L1_Rank3: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_L1_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(in) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_L1_Rank4")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_L1_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_L1_Rank4: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_L1_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(in) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_L1_Rank5")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_L1_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_L1_Rank5: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4 + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I4")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(out) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4 + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I4: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I4_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I4_Rank1")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I4_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(out) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I4_Rank1: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I4_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I4_Rank2")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I4_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(out) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I4_Rank2: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I4_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I4_Rank3")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I4_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(out) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I4_Rank3: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I4_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I4_Rank4")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I4_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(out) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I4_Rank4: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I4_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I4_Rank5")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I4_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I4_Rank5: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(in) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4 + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R4")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(out) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4 + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R4: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R4_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(in) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R4_Rank1")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R4_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(out) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R4_Rank1: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R4_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(in) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R4_Rank2")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R4_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(out) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R4_Rank2: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R4_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(in) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R4_Rank3")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R4_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(out) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R4_Rank3: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R4_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(in) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R4_Rank4")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R4_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(out) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R4_Rank4: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R4_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(in) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R4_Rank5")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R4_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R4_Rank5: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R8(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(in) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8 + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R8")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R8(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(out) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8 + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R8: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R8_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(in) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R8_Rank1")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R8_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(out) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R8_Rank1: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R8_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(in) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R8_Rank2")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R8_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(out) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R8_Rank2: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R8_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(in) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R8_Rank3")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R8_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(out) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R8_Rank3: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R8_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(in) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R8_Rank4")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R8_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(out) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R8_Rank4: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R8_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(in) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R8_Rank5")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R8_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R8_Rank5: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine +end module \ No newline at end of file diff --git a/modules/nwtc-library/src/NWTC_Base.f90 b/modules/nwtc-library/src/NWTC_Base.f90 index 2ccec45fb1..4228fe4ee2 100644 --- a/modules/nwtc-library/src/NWTC_Base.f90 +++ b/modules/nwtc-library/src/NWTC_Base.f90 @@ -81,5 +81,30 @@ MODULE NWTC_Base END TYPE DLL_Type +contains + + !======================================================================= + !> This routine sets the error status and error message for a routine + !! that may set non-AbortErrLev errors. It concatenates error messages + !! and has the ability to provide a sort of traceback message of called + !! routines (if this is called consistently). + !! Modules in the FAST framework are recommended to use it. + subroutine SetErrStat (ErrStatLcl, ErrMessLcl, ErrStat, ErrMess, RoutineName) + + INTEGER(IntKi), INTENT(IN ) :: ErrStatLcl ! Error status of the operation + CHARACTER(*), INTENT(IN ) :: ErrMessLcl ! Error message if ErrStat /= ErrID_None + + INTEGER(IntKi), INTENT(INOUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT(INOUT) :: ErrMess ! Error message if ErrStat /= ErrID_None + + CHARACTER(*), INTENT(IN ) :: RoutineName ! Name of the routine error occurred in + + IF ( ErrStatLcl /= ErrID_None ) THEN + IF (ErrStat /= ErrID_None) ErrMess = TRIM(ErrMess)//new_line('a') + ErrMess = TRIM(ErrMess)//TRIM(RoutineName)//':'//TRIM(ErrMessLcl) + ErrStat = MAX(ErrStat,ErrStatLcl) + END IF + + end subroutine END MODULE NWTC_Base diff --git a/modules/nwtc-library/src/NWTC_IO.f90 b/modules/nwtc-library/src/NWTC_IO.f90 index a1d2570ca3..b7e5707fea 100644 --- a/modules/nwtc-library/src/NWTC_IO.f90 +++ b/modules/nwtc-library/src/NWTC_IO.f90 @@ -1725,105 +1725,65 @@ END SUBROUTINE DispCopyrightLicense !======================================================================= !> This routine packs the DLL_Type (nwtc_base::dll_type) data into an integer buffer. !! It is required for the FAST Registry. It is the inverse of DLLTypeUnPack (nwtc_io::dlltypeunpack). - SUBROUTINE DLLTypePack( InData, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMsg, SizeOnly ) - - - TYPE(DLL_Type), INTENT(IN ) :: InData !< DLL data to pack (store in arrays of type ReKi, DbKi, and/or IntKi) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) !< buffer with real (ReKi) data from InData structure - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) !< buffer with double (DbKi) data from InData structure - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) !< buffer with integer (IntKi) data from InData structure - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< error message - LOGICAL, OPTIONAL, INTENT(IN ) :: SizeOnly !< flag to determine if we're just looking for the size of the buffers instead of the packed data + SUBROUTINE DLLTypePack(Buf, InData) + type(PackBuffer), intent(inout) :: Buf + TYPE(DLL_Type), intent(in) :: InData !< DLL data to pack - ! Local variable - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: i,buf_start - - ErrStat = ErrID_None - ErrMsg = "" + INTEGER(IntKi) :: i - ! get size of buffer: - Int_BufSz = LEN(InData%FileName) + LEN(InData%ProcName(1))*NWTC_MAX_DLL_PROC + 1 - - ALLOCATE( IntKiBuf(Int_BufSz), STAT=ErrStat ) - IF (ErrStat /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' DLLTypePack: Error allocating IntKiBuf.' - RETURN - END IF - - IF ( PRESENT(SizeOnly) ) THEN - IF ( SizeOnly ) RETURN - ENDIF - - !.............. - ! Fill buffer - !.............. - - ! has the DLL procedure been loaded? - IF ( C_ASSOCIATED(InData%ProcAddr(1))) THEN - IntKiBuf(1) = 1 - ELSE - IntKiBuf(1) = 0 - END IF + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return - ! Put an ascii representation of the strings in the integer array - CALL Str2IntAry( InData%FileName, IntKiBuf(2:), ErrStat, ErrMsg ) - buf_start=LEN(InData%FileName)+2 - DO i=1,NWTC_MAX_DLL_PROC - CALL Str2IntAry( InData%ProcName(i), IntKiBuf(buf_start:), ErrStat, ErrMsg ) - buf_start = buf_start + LEN(InData%ProcName(i)) - END DO + ! has the DLL procedure been loaded? + call RegPack(Buf, c_associated(InData%ProcAddr(1))) + ! Pack strings + call RegPack(Buf, InData%FileName) + do i = 1, NWTC_MAX_DLL_PROC + call RegPack(Buf, InData%ProcName(i)) + end do + + ! If buffer error, return + if (RegCheckErr(Buf, 'DLLTypeUnPack')) return END SUBROUTINE DLLTypePack !======================================================================= !> This routine unpacks the DLL_Type data from an integer buffer. !! It is required for the FAST Registry. It is the inverse of DLLTypePack (nwtc_io::dlltypepack). - SUBROUTINE DLLTypeUnPack( OutData, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMsg ) - - - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) !< buffer with real (ReKi) data to place in the OutData structure - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) !< buffer with real (DbKi) data to place in the OutData structure - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) !< buffer with integer (IntKi) data to place in the OutData structure - TYPE(DLL_Type), INTENT( OUT) :: OutData !< the reconstituted OutData structure, created from 3 buffers - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< error status/level - CHARACTER(*), INTENT( OUT) :: ErrMsg !< message corresponding to ErrStat - - ! Local variable - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: i, Int_BufEnd + subroutine DLLTypeUnPack(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DLL_Type), intent(out) :: OutData !< Reconstituted OutData structure + + logical :: WasAssociated + integer(IntKi) :: i + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return - ErrStat = ErrID_None - ErrMsg = "" + ! Get flag indicating if dll was associated + call RegUnpack(Buf, WasAssociated) - IF (.NOT. ALLOCATED(IntKiBuf) ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' DLLTypeUnPack: invalid buffer.' - END IF - - ! Get an ascii representation of the strings from the integer array - Int_BufSz = LEN(OutData%FileName) + 1 - CALL IntAry2Str( IntKiBuf(2:(Int_BufSz)), OutData%FileName, ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - Int_BufSz = Int_BufSz + 1 - do i=1,NWTC_MAX_DLL_PROC - Int_BufEnd=Int_BufSz+LEN(OutData%ProcName(i))-1 - CALL IntAry2Str( IntKiBuf(Int_BufSz:Int_BufEnd), OutData%ProcName(i), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - Int_BufSz = Int_BufSz+LEN(OutData%ProcName(i)) + ! Unpack strings + call RegUnpack(Buf, OutData%FileName) + do i = 1, NWTC_MAX_DLL_PROC + call RegUnpack(Buf, OutData%ProcName(i)) end do + + ! If buffer error, return + if (RegCheckErr(Buf, 'DLLTypeUnPack')) return - - IF ( IntKiBuf(1) == 1 .AND. LEN_TRIM(OutData%FileName) > 0 .AND. LEN_TRIM(OutData%ProcName(1)) > 0 ) THEN - CALL LoadDynamicLib( OutData, ErrStat, ErrMsg ) + ! If dll was loaded, and data in filename and procname, load dll + IF (WasAssociated .AND. LEN_TRIM(OutData%FileName) > 0 .AND. LEN_TRIM(OutData%ProcName(1)) > 0) THEN + CALL LoadDynamicLib(OutData, Buf%ErrStat, Buf%ErrMsg) else ! Nullifying OutData%FileAddr = INT(0,C_INTPTR_T) OutData%FileAddrX = C_NULL_PTR OutData%ProcAddr = C_NULL_FUNPTR END IF + + ! If buffer error, return + if (RegCheckErr(Buf, 'DLLTypeUnPack')) return END SUBROUTINE DLLTypeUnPack !======================================================================= diff --git a/modules/nwtc-library/src/NWTC_Library.f90 b/modules/nwtc-library/src/NWTC_Library.f90 index 77d1388f8c..9772468d1b 100644 --- a/modules/nwtc-library/src/NWTC_Library.f90 +++ b/modules/nwtc-library/src/NWTC_Library.f90 @@ -74,6 +74,7 @@ MODULE NWTC_Library USE NWTC_Library_Types USE NWTC_Num ! technically we don't need to specify this if we have ModMesh (because ModMesh USEs NWTC_Num) USE ModMesh + USE ModReg #ifndef NO_MESHMAPPING ! Note that ModMesh_Mapping also includes LAPACK routines diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index ebe2e74a6c..13195434b7 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -24,13 +24,15 @@ ! limitations under the License. ! ! -! bjj: modifications made +! 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 NWTC_Library. 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 NWTC_Library_Types !--------------------------------------------------------------------------------------------------------------------------------- USE SysSubs +USE ModReg IMPLICIT NONE ! ========= ProgDesc ======= TYPE, PUBLIC :: ProgDesc @@ -43,9 +45,9 @@ MODULE NWTC_Library_Types TYPE, PUBLIC :: FASTdataType CHARACTER(1024) :: File !< Name of the FAST-style binary file [-] CHARACTER(1024) :: Descr !< String describing file [-] - INTEGER(IntKi) :: NumChans !< Number of output channels in this binary file (not including the time channel) [-] - INTEGER(IntKi) :: NumRecs !< Number of records (rows) of data in the file [-] - REAL(DbKi) :: TimeStep !< Time step for evenly-spaced data in the output file (when NumRecs is not allo [-] + INTEGER(IntKi) :: NumChans = 0_IntKi !< Number of output channels in this binary file (not including the time channel) [-] + INTEGER(IntKi) :: NumRecs = 0_IntKi !< Number of records (rows) of data in the file [-] + REAL(DbKi) :: TimeStep = 0.0_R8Ki !< Time step for evenly-spaced data in the output file (when NumRecs is not allo [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChanNames !< Strings describing the names of the channels from the binary file (including the time channel) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChanUnits !< Strings describing the units of the channels from the binary file (including the time channel) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Data !< numeric data (rows and columns) from the binary file, including the time channel [-] @@ -53,16 +55,16 @@ MODULE NWTC_Library_Types ! ======================= ! ========= OutParmType ======= TYPE, PUBLIC :: OutParmType - INTEGER(IntKi) :: Indx !< An index into AllOuts array where this channel is computed/stored [-] + INTEGER(IntKi) :: Indx = 0_IntKi !< An index into AllOuts array where this channel is computed/stored [-] CHARACTER(ChanLen) :: Name !< Name of the output channel [-] CHARACTER(ChanLen) :: Units !< Units this channel is specified in [-] - INTEGER(IntKi) :: SignM !< Multiplier for output channel; usually -1 (minus) or 0 (invalid channel) [-] + INTEGER(IntKi) :: SignM = 0_IntKi !< Multiplier for output channel; usually -1 (minus) or 0 (invalid channel) [-] END TYPE OutParmType ! ======================= ! ========= FileInfoType ======= TYPE, PUBLIC :: FileInfoType - INTEGER(IntKi) :: NumLines - INTEGER(IntKi) :: NumFiles + INTEGER(IntKi) :: NumLines = 0_IntKi + INTEGER(IntKi) :: NumFiles = 0_IntKi INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FileLine INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FileIndx CHARACTER(MaxFileInfoLineLen) , DIMENSION(:), ALLOCATABLE :: FileList @@ -71,1460 +73,591 @@ MODULE NWTC_Library_Types ! ======================= ! ========= Quaternion ======= TYPE, PUBLIC :: Quaternion - REAL(ReKi) :: q0 - REAL(ReKi) , DIMENSION(1:3) :: v + REAL(ReKi) :: q0 = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:3) :: v = 0.0_ReKi END TYPE Quaternion ! ======================= ! ========= NWTC_RandomNumber_ParameterType ======= TYPE, PUBLIC :: NWTC_RandomNumber_ParameterType - INTEGER(IntKi) :: pRNG - INTEGER(IntKi) , DIMENSION(1:3) :: RandSeed + INTEGER(IntKi) :: pRNG = 0_IntKi + INTEGER(IntKi) , DIMENSION(1:3) :: RandSeed = 0_IntKi INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RandSeedAry CHARACTER(6) :: RNG_type END TYPE NWTC_RandomNumber_ParameterType ! ======================= CONTAINS -!======================================================================= -!> This routine sets the error status and error message for a routine -!! that may set non-AbortErrLev errors. It concatenates error messages -!! and has the ability to provide a sort of traceback message of called -!! routines (if this is called consistently). -!! Modules in the FAST framework are recommend to use it. - SUBROUTINE SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat, ErrMess, RoutineName ) - - ! This routine is placed in this file because it is called in code generated by the FAST Registry (and I don't feel like putting it in the Sys files) ... be careful not to delete this routine! - - - INTEGER(IntKi), INTENT(IN ) :: ErrStatLcl ! Error status of the operation - CHARACTER(*), INTENT(IN ) :: ErrMessLcl ! Error message if ErrStat /= ErrID_None - - INTEGER(IntKi), INTENT(INOUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT(INOUT) :: ErrMess ! Error message if ErrStat /= ErrID_None - - CHARACTER(*), INTENT(IN ) :: RoutineName ! Name of the routine error occurred in - - - IF ( ErrStatLcl /= ErrID_None ) THEN - - IF (ErrStat /= ErrID_None) ErrMess = TRIM(ErrMess)//NewLine - ErrMess = TRIM(ErrMess)//TRIM(RoutineName)//':'//TRIM(ErrMessLcl) - ErrStat = MAX(ErrStat,ErrStatLcl) - - END IF - - END SUBROUTINE SetErrStat -!======================================================================= - - SUBROUTINE NWTC_Library_CopyProgDesc( SrcProgDescData, DstProgDescData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ProgDesc), INTENT(IN) :: SrcProgDescData - TYPE(ProgDesc), INTENT(INOUT) :: DstProgDescData - 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 = 'NWTC_Library_CopyProgDesc' -! +subroutine NWTC_Library_CopyProgDesc(SrcProgDescData, DstProgDescData, CtrlCode, ErrStat, ErrMsg) + type(ProgDesc), intent(in) :: SrcProgDescData + type(ProgDesc), intent(inout) :: DstProgDescData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_CopyProgDesc' ErrStat = ErrID_None - ErrMsg = "" - DstProgDescData%Name = SrcProgDescData%Name - DstProgDescData%Ver = SrcProgDescData%Ver - DstProgDescData%Date = SrcProgDescData%Date - END SUBROUTINE NWTC_Library_CopyProgDesc - - SUBROUTINE NWTC_Library_DestroyProgDesc( ProgDescData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ProgDesc), INTENT(INOUT) :: ProgDescData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyProgDesc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE NWTC_Library_DestroyProgDesc - - SUBROUTINE NWTC_Library_PackProgDesc( 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(ProgDesc), 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 = 'NWTC_Library_PackProgDesc' - ! 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%Name) ! Name - Int_BufSz = Int_BufSz + 1*LEN(InData%Ver) ! Ver - Int_BufSz = Int_BufSz + 1*LEN(InData%Date) ! Date - 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%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Ver) - IntKiBuf(Int_Xferred) = ICHAR(InData%Ver(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Date) - IntKiBuf(Int_Xferred) = ICHAR(InData%Date(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE NWTC_Library_PackProgDesc - - SUBROUTINE NWTC_Library_UnPackProgDesc( 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(ProgDesc), 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 = 'NWTC_Library_UnPackProgDesc' - ! 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%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Ver) - OutData%Ver(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Date) - OutData%Date(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE NWTC_Library_UnPackProgDesc - - SUBROUTINE NWTC_Library_CopyFASTdataType( SrcFASTdataTypeData, DstFASTdataTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FASTdataType), INTENT(IN) :: SrcFASTdataTypeData - TYPE(FASTdataType), INTENT(INOUT) :: DstFASTdataTypeData - 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 = 'NWTC_Library_CopyFASTdataType' -! + ErrMsg = '' + DstProgDescData%Name = SrcProgDescData%Name + DstProgDescData%Ver = SrcProgDescData%Ver + DstProgDescData%Date = SrcProgDescData%Date +end subroutine + +subroutine NWTC_Library_DestroyProgDesc(ProgDescData, ErrStat, ErrMsg) + type(ProgDesc), intent(inout) :: ProgDescData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyProgDesc' ErrStat = ErrID_None - ErrMsg = "" - DstFASTdataTypeData%File = SrcFASTdataTypeData%File - DstFASTdataTypeData%Descr = SrcFASTdataTypeData%Descr - DstFASTdataTypeData%NumChans = SrcFASTdataTypeData%NumChans - DstFASTdataTypeData%NumRecs = SrcFASTdataTypeData%NumRecs - DstFASTdataTypeData%TimeStep = SrcFASTdataTypeData%TimeStep -IF (ALLOCATED(SrcFASTdataTypeData%ChanNames)) THEN - i1_l = LBOUND(SrcFASTdataTypeData%ChanNames,1) - i1_u = UBOUND(SrcFASTdataTypeData%ChanNames,1) - IF (.NOT. ALLOCATED(DstFASTdataTypeData%ChanNames)) THEN - ALLOCATE(DstFASTdataTypeData%ChanNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%ChanNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFASTdataTypeData%ChanNames = SrcFASTdataTypeData%ChanNames -ENDIF -IF (ALLOCATED(SrcFASTdataTypeData%ChanUnits)) THEN - i1_l = LBOUND(SrcFASTdataTypeData%ChanUnits,1) - i1_u = UBOUND(SrcFASTdataTypeData%ChanUnits,1) - IF (.NOT. ALLOCATED(DstFASTdataTypeData%ChanUnits)) THEN - ALLOCATE(DstFASTdataTypeData%ChanUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%ChanUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFASTdataTypeData%ChanUnits = SrcFASTdataTypeData%ChanUnits -ENDIF -IF (ALLOCATED(SrcFASTdataTypeData%Data)) THEN - i1_l = LBOUND(SrcFASTdataTypeData%Data,1) - i1_u = UBOUND(SrcFASTdataTypeData%Data,1) - i2_l = LBOUND(SrcFASTdataTypeData%Data,2) - i2_u = UBOUND(SrcFASTdataTypeData%Data,2) - IF (.NOT. ALLOCATED(DstFASTdataTypeData%Data)) THEN - ALLOCATE(DstFASTdataTypeData%Data(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%Data.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFASTdataTypeData%Data = SrcFASTdataTypeData%Data -ENDIF - END SUBROUTINE NWTC_Library_CopyFASTdataType - - SUBROUTINE NWTC_Library_DestroyFASTdataType( FASTdataTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FASTdataType), INTENT(INOUT) :: FASTdataTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyFASTdataType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(FASTdataTypeData%ChanNames)) THEN - DEALLOCATE(FASTdataTypeData%ChanNames) -ENDIF -IF (ALLOCATED(FASTdataTypeData%ChanUnits)) THEN - DEALLOCATE(FASTdataTypeData%ChanUnits) -ENDIF -IF (ALLOCATED(FASTdataTypeData%Data)) THEN - DEALLOCATE(FASTdataTypeData%Data) -ENDIF - END SUBROUTINE NWTC_Library_DestroyFASTdataType - - SUBROUTINE NWTC_Library_PackFASTdataType( 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(FASTdataType), 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 = 'NWTC_Library_PackFASTdataType' - ! 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%File) ! File - Int_BufSz = Int_BufSz + 1*LEN(InData%Descr) ! Descr - Int_BufSz = Int_BufSz + 1 ! NumChans - Int_BufSz = Int_BufSz + 1 ! NumRecs - Db_BufSz = Db_BufSz + 1 ! TimeStep - Int_BufSz = Int_BufSz + 1 ! ChanNames allocated yes/no - IF ( ALLOCATED(InData%ChanNames) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChanNames upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChanNames)*LEN(InData%ChanNames) ! ChanNames - END IF - Int_BufSz = Int_BufSz + 1 ! ChanUnits allocated yes/no - IF ( ALLOCATED(InData%ChanUnits) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChanUnits upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChanUnits)*LEN(InData%ChanUnits) ! ChanUnits - END IF - Int_BufSz = Int_BufSz + 1 ! Data allocated yes/no - IF ( ALLOCATED(InData%Data) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Data upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Data) ! Data - 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%File) - IntKiBuf(Int_Xferred) = ICHAR(InData%File(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Descr) - IntKiBuf(Int_Xferred) = ICHAR(InData%Descr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NumChans - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumRecs - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimeStep - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ChanNames) ) 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%ChanNames,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChanNames,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ChanNames,1), UBOUND(InData%ChanNames,1) - DO I = 1, LEN(InData%ChanNames) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChanNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ChanUnits) ) 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%ChanUnits,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChanUnits,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ChanUnits,1), UBOUND(InData%ChanUnits,1) - DO I = 1, LEN(InData%ChanUnits) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChanUnits(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Data) ) 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%Data,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Data,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Data,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Data,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Data,2), UBOUND(InData%Data,2) - DO i1 = LBOUND(InData%Data,1), UBOUND(InData%Data,1) - ReKiBuf(Re_Xferred) = InData%Data(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE NWTC_Library_PackFASTdataType - - SUBROUTINE NWTC_Library_UnPackFASTdataType( 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(FASTdataType), 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 = 'NWTC_Library_UnPackFASTdataType' - ! 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%File) - OutData%File(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Descr) - OutData%Descr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumChans = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumRecs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TimeStep = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChanNames 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%ChanNames)) DEALLOCATE(OutData%ChanNames) - ALLOCATE(OutData%ChanNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ChanNames,1), UBOUND(OutData%ChanNames,1) - DO I = 1, LEN(OutData%ChanNames) - OutData%ChanNames(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 ! ChanUnits 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%ChanUnits)) DEALLOCATE(OutData%ChanUnits) - ALLOCATE(OutData%ChanUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ChanUnits,1), UBOUND(OutData%ChanUnits,1) - DO I = 1, LEN(OutData%ChanUnits) - OutData%ChanUnits(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 ! Data 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%Data)) DEALLOCATE(OutData%Data) - ALLOCATE(OutData%Data(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Data.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Data,2), UBOUND(OutData%Data,2) - DO i1 = LBOUND(OutData%Data,1), UBOUND(OutData%Data,1) - OutData%Data(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE NWTC_Library_UnPackFASTdataType - - SUBROUTINE NWTC_Library_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OutParmType), INTENT(IN) :: SrcOutParmTypeData - TYPE(OutParmType), INTENT(INOUT) :: DstOutParmTypeData - 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 = 'NWTC_Library_CopyOutParmType' -! + ErrMsg = '' +end subroutine + +subroutine NWTC_Library_PackProgDesc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ProgDesc), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackProgDesc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Name) + call RegPack(Buf, InData%Ver) + call RegPack(Buf, InData%Date) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackProgDesc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ProgDesc), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackProgDesc' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Name) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Date) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeData, CtrlCode, ErrStat, ErrMsg) + type(FASTdataType), intent(in) :: SrcFASTdataTypeData + type(FASTdataType), intent(inout) :: DstFASTdataTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyFASTdataType' ErrStat = ErrID_None - ErrMsg = "" - DstOutParmTypeData%Indx = SrcOutParmTypeData%Indx - DstOutParmTypeData%Name = SrcOutParmTypeData%Name - DstOutParmTypeData%Units = SrcOutParmTypeData%Units - DstOutParmTypeData%SignM = SrcOutParmTypeData%SignM - END SUBROUTINE NWTC_Library_CopyOutParmType - - SUBROUTINE NWTC_Library_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(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 = 'NWTC_Library_DestroyOutParmType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE NWTC_Library_DestroyOutParmType - - SUBROUTINE NWTC_Library_PackOutParmType( 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(OutParmType), 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 = 'NWTC_Library_PackOutParmType' - ! 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 ! Indx - Int_BufSz = Int_BufSz + 1*LEN(InData%Name) ! Name - Int_BufSz = Int_BufSz + 1*LEN(InData%Units) ! Units - Int_BufSz = Int_BufSz + 1 ! SignM - 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%Indx - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Units) - IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%SignM - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE NWTC_Library_PackOutParmType - - SUBROUTINE NWTC_Library_UnPackOutParmType( 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(OutParmType), 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 = 'NWTC_Library_UnPackOutParmType' - ! 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%Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Units) - OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SignM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE NWTC_Library_UnPackOutParmType - - SUBROUTINE NWTC_Library_CopyFileInfoType( SrcFileInfoTypeData, DstFileInfoTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FileInfoType), INTENT(IN) :: SrcFileInfoTypeData - TYPE(FileInfoType), INTENT(INOUT) :: DstFileInfoTypeData - 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 = 'NWTC_Library_CopyFileInfoType' -! + ErrMsg = '' + DstFASTdataTypeData%File = SrcFASTdataTypeData%File + DstFASTdataTypeData%Descr = SrcFASTdataTypeData%Descr + DstFASTdataTypeData%NumChans = SrcFASTdataTypeData%NumChans + DstFASTdataTypeData%NumRecs = SrcFASTdataTypeData%NumRecs + DstFASTdataTypeData%TimeStep = SrcFASTdataTypeData%TimeStep + if (allocated(SrcFASTdataTypeData%ChanNames)) then + LB(1:1) = lbound(SrcFASTdataTypeData%ChanNames) + UB(1:1) = ubound(SrcFASTdataTypeData%ChanNames) + if (.not. allocated(DstFASTdataTypeData%ChanNames)) then + allocate(DstFASTdataTypeData%ChanNames(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%ChanNames.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFASTdataTypeData%ChanNames = SrcFASTdataTypeData%ChanNames + end if + if (allocated(SrcFASTdataTypeData%ChanUnits)) then + LB(1:1) = lbound(SrcFASTdataTypeData%ChanUnits) + UB(1:1) = ubound(SrcFASTdataTypeData%ChanUnits) + if (.not. allocated(DstFASTdataTypeData%ChanUnits)) then + allocate(DstFASTdataTypeData%ChanUnits(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%ChanUnits.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFASTdataTypeData%ChanUnits = SrcFASTdataTypeData%ChanUnits + end if + if (allocated(SrcFASTdataTypeData%Data)) then + LB(1:2) = lbound(SrcFASTdataTypeData%Data) + UB(1:2) = ubound(SrcFASTdataTypeData%Data) + if (.not. allocated(DstFASTdataTypeData%Data)) then + allocate(DstFASTdataTypeData%Data(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%Data.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFASTdataTypeData%Data = SrcFASTdataTypeData%Data + end if +end subroutine + +subroutine NWTC_Library_DestroyFASTdataType(FASTdataTypeData, ErrStat, ErrMsg) + type(FASTdataType), intent(inout) :: FASTdataTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyFASTdataType' ErrStat = ErrID_None - ErrMsg = "" - DstFileInfoTypeData%NumLines = SrcFileInfoTypeData%NumLines - DstFileInfoTypeData%NumFiles = SrcFileInfoTypeData%NumFiles -IF (ALLOCATED(SrcFileInfoTypeData%FileLine)) THEN - i1_l = LBOUND(SrcFileInfoTypeData%FileLine,1) - i1_u = UBOUND(SrcFileInfoTypeData%FileLine,1) - IF (.NOT. ALLOCATED(DstFileInfoTypeData%FileLine)) THEN - ALLOCATE(DstFileInfoTypeData%FileLine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileLine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFileInfoTypeData%FileLine = SrcFileInfoTypeData%FileLine -ENDIF -IF (ALLOCATED(SrcFileInfoTypeData%FileIndx)) THEN - i1_l = LBOUND(SrcFileInfoTypeData%FileIndx,1) - i1_u = UBOUND(SrcFileInfoTypeData%FileIndx,1) - IF (.NOT. ALLOCATED(DstFileInfoTypeData%FileIndx)) THEN - ALLOCATE(DstFileInfoTypeData%FileIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFileInfoTypeData%FileIndx = SrcFileInfoTypeData%FileIndx -ENDIF -IF (ALLOCATED(SrcFileInfoTypeData%FileList)) THEN - i1_l = LBOUND(SrcFileInfoTypeData%FileList,1) - i1_u = UBOUND(SrcFileInfoTypeData%FileList,1) - IF (.NOT. ALLOCATED(DstFileInfoTypeData%FileList)) THEN - ALLOCATE(DstFileInfoTypeData%FileList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFileInfoTypeData%FileList = SrcFileInfoTypeData%FileList -ENDIF -IF (ALLOCATED(SrcFileInfoTypeData%Lines)) THEN - i1_l = LBOUND(SrcFileInfoTypeData%Lines,1) - i1_u = UBOUND(SrcFileInfoTypeData%Lines,1) - IF (.NOT. ALLOCATED(DstFileInfoTypeData%Lines)) THEN - ALLOCATE(DstFileInfoTypeData%Lines(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%Lines.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFileInfoTypeData%Lines = SrcFileInfoTypeData%Lines -ENDIF - END SUBROUTINE NWTC_Library_CopyFileInfoType - - SUBROUTINE NWTC_Library_DestroyFileInfoType( FileInfoTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FileInfoType), INTENT(INOUT) :: FileInfoTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyFileInfoType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(FileInfoTypeData%FileLine)) THEN - DEALLOCATE(FileInfoTypeData%FileLine) -ENDIF -IF (ALLOCATED(FileInfoTypeData%FileIndx)) THEN - DEALLOCATE(FileInfoTypeData%FileIndx) -ENDIF -IF (ALLOCATED(FileInfoTypeData%FileList)) THEN - DEALLOCATE(FileInfoTypeData%FileList) -ENDIF -IF (ALLOCATED(FileInfoTypeData%Lines)) THEN - DEALLOCATE(FileInfoTypeData%Lines) -ENDIF - END SUBROUTINE NWTC_Library_DestroyFileInfoType - - SUBROUTINE NWTC_Library_PackFileInfoType( 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(FileInfoType), 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 = 'NWTC_Library_PackFileInfoType' - ! 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 ! NumLines - Int_BufSz = Int_BufSz + 1 ! NumFiles - Int_BufSz = Int_BufSz + 1 ! FileLine allocated yes/no - IF ( ALLOCATED(InData%FileLine) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FileLine upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FileLine) ! FileLine - END IF - Int_BufSz = Int_BufSz + 1 ! FileIndx allocated yes/no - IF ( ALLOCATED(InData%FileIndx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FileIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FileIndx) ! FileIndx - END IF - Int_BufSz = Int_BufSz + 1 ! FileList allocated yes/no - IF ( ALLOCATED(InData%FileList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FileList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FileList)*LEN(InData%FileList) ! FileList - END IF - Int_BufSz = Int_BufSz + 1 ! Lines allocated yes/no - IF ( ALLOCATED(InData%Lines) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Lines upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Lines)*LEN(InData%Lines) ! Lines - 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 - - IntKiBuf(Int_Xferred) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumFiles - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FileLine) ) 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%FileLine,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileLine,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FileLine,1), UBOUND(InData%FileLine,1) - IntKiBuf(Int_Xferred) = InData%FileLine(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FileIndx) ) 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%FileIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileIndx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FileIndx,1), UBOUND(InData%FileIndx,1) - IntKiBuf(Int_Xferred) = InData%FileIndx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FileList) ) 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%FileList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FileList,1), UBOUND(InData%FileList,1) - DO I = 1, LEN(InData%FileList) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Lines) ) 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%Lines,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Lines,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Lines,1), UBOUND(InData%Lines,1) - DO I = 1, LEN(InData%Lines) - IntKiBuf(Int_Xferred) = ICHAR(InData%Lines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE NWTC_Library_PackFileInfoType - - SUBROUTINE NWTC_Library_UnPackFileInfoType( 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(FileInfoType), 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 = 'NWTC_Library_UnPackFileInfoType' - ! 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%NumLines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumFiles = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileLine 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%FileLine)) DEALLOCATE(OutData%FileLine) - ALLOCATE(OutData%FileLine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileLine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FileLine,1), UBOUND(OutData%FileLine,1) - OutData%FileLine(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileIndx 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%FileIndx)) DEALLOCATE(OutData%FileIndx) - ALLOCATE(OutData%FileIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FileIndx,1), UBOUND(OutData%FileIndx,1) - OutData%FileIndx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileList 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%FileList)) DEALLOCATE(OutData%FileList) - ALLOCATE(OutData%FileList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FileList,1), UBOUND(OutData%FileList,1) - DO I = 1, LEN(OutData%FileList) - OutData%FileList(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 ! Lines 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%Lines)) DEALLOCATE(OutData%Lines) - ALLOCATE(OutData%Lines(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lines.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Lines,1), UBOUND(OutData%Lines,1) - DO I = 1, LEN(OutData%Lines) - OutData%Lines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE NWTC_Library_UnPackFileInfoType - - SUBROUTINE NWTC_Library_CopyQuaternion( SrcQuaternionData, DstQuaternionData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Quaternion), INTENT(IN) :: SrcQuaternionData - TYPE(Quaternion), INTENT(INOUT) :: DstQuaternionData - 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 = 'NWTC_Library_CopyQuaternion' -! + ErrMsg = '' + if (allocated(FASTdataTypeData%ChanNames)) then + deallocate(FASTdataTypeData%ChanNames) + end if + if (allocated(FASTdataTypeData%ChanUnits)) then + deallocate(FASTdataTypeData%ChanUnits) + end if + if (allocated(FASTdataTypeData%Data)) then + deallocate(FASTdataTypeData%Data) + end if +end subroutine + +subroutine NWTC_Library_PackFASTdataType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FASTdataType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackFASTdataType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%File) + call RegPack(Buf, InData%Descr) + call RegPack(Buf, InData%NumChans) + call RegPack(Buf, InData%NumRecs) + call RegPack(Buf, InData%TimeStep) + call RegPack(Buf, allocated(InData%ChanNames)) + if (allocated(InData%ChanNames)) then + call RegPackBounds(Buf, 1, lbound(InData%ChanNames), ubound(InData%ChanNames)) + call RegPack(Buf, InData%ChanNames) + end if + call RegPack(Buf, allocated(InData%ChanUnits)) + if (allocated(InData%ChanUnits)) then + call RegPackBounds(Buf, 1, lbound(InData%ChanUnits), ubound(InData%ChanUnits)) + call RegPack(Buf, InData%ChanUnits) + end if + call RegPack(Buf, allocated(InData%Data)) + if (allocated(InData%Data)) then + call RegPackBounds(Buf, 2, lbound(InData%Data), ubound(InData%Data)) + call RegPack(Buf, InData%Data) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackFASTdataType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FASTdataType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackFASTdataType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%File) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Descr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumChans) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumRecs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TimeStep) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ChanNames)) deallocate(OutData%ChanNames) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ChanNames(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanNames.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ChanNames) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ChanUnits)) deallocate(OutData%ChanUnits) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ChanUnits(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanUnits.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ChanUnits) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Data)) deallocate(OutData%Data) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Data(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Data.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Data) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine NWTC_Library_CopyOutParmType(SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg) + type(OutParmType), intent(in) :: SrcOutParmTypeData + type(OutParmType), intent(inout) :: DstOutParmTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_CopyOutParmType' ErrStat = ErrID_None - ErrMsg = "" - DstQuaternionData%q0 = SrcQuaternionData%q0 - DstQuaternionData%v = SrcQuaternionData%v - END SUBROUTINE NWTC_Library_CopyQuaternion - - SUBROUTINE NWTC_Library_DestroyQuaternion( QuaternionData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Quaternion), INTENT(INOUT) :: QuaternionData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyQuaternion' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE NWTC_Library_DestroyQuaternion - - SUBROUTINE NWTC_Library_PackQuaternion( 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(Quaternion), 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 = 'NWTC_Library_PackQuaternion' - ! 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 ! q0 - Re_BufSz = Re_BufSz + SIZE(InData%v) ! v - 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%q0 - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%v,1), UBOUND(InData%v,1) - ReKiBuf(Re_Xferred) = InData%v(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE NWTC_Library_PackQuaternion - - SUBROUTINE NWTC_Library_UnPackQuaternion( 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(Quaternion), 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 = 'NWTC_Library_UnPackQuaternion' - ! 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%q0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%v,1) - i1_u = UBOUND(OutData%v,1) - DO i1 = LBOUND(OutData%v,1), UBOUND(OutData%v,1) - OutData%v(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE NWTC_Library_UnPackQuaternion - - SUBROUTINE NWTC_Library_CopyNWTC_RandomNumber_ParameterType( SrcNWTC_RandomNumber_ParameterTypeData, DstNWTC_RandomNumber_ParameterTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(NWTC_RandomNumber_ParameterType), INTENT(IN) :: SrcNWTC_RandomNumber_ParameterTypeData - TYPE(NWTC_RandomNumber_ParameterType), INTENT(INOUT) :: DstNWTC_RandomNumber_ParameterTypeData - 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 = 'NWTC_Library_CopyNWTC_RandomNumber_ParameterType' -! + ErrMsg = '' + DstOutParmTypeData%Indx = SrcOutParmTypeData%Indx + DstOutParmTypeData%Name = SrcOutParmTypeData%Name + DstOutParmTypeData%Units = SrcOutParmTypeData%Units + DstOutParmTypeData%SignM = SrcOutParmTypeData%SignM +end subroutine + +subroutine NWTC_Library_DestroyOutParmType(OutParmTypeData, ErrStat, ErrMsg) + type(OutParmType), intent(inout) :: OutParmTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyOutParmType' ErrStat = ErrID_None - ErrMsg = "" - DstNWTC_RandomNumber_ParameterTypeData%pRNG = SrcNWTC_RandomNumber_ParameterTypeData%pRNG - DstNWTC_RandomNumber_ParameterTypeData%RandSeed = SrcNWTC_RandomNumber_ParameterTypeData%RandSeed -IF (ALLOCATED(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) THEN - i1_l = LBOUND(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry,1) - i1_u = UBOUND(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry,1) - IF (.NOT. ALLOCATED(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) THEN - ALLOCATE(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry = SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry -ENDIF - DstNWTC_RandomNumber_ParameterTypeData%RNG_type = SrcNWTC_RandomNumber_ParameterTypeData%RNG_type - END SUBROUTINE NWTC_Library_CopyNWTC_RandomNumber_ParameterType - - SUBROUTINE NWTC_Library_DestroyNWTC_RandomNumber_ParameterType( NWTC_RandomNumber_ParameterTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(NWTC_RandomNumber_ParameterType), INTENT(INOUT) :: NWTC_RandomNumber_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 = 'NWTC_Library_DestroyNWTC_RandomNumber_ParameterType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(NWTC_RandomNumber_ParameterTypeData%RandSeedAry)) THEN - DEALLOCATE(NWTC_RandomNumber_ParameterTypeData%RandSeedAry) -ENDIF - END SUBROUTINE NWTC_Library_DestroyNWTC_RandomNumber_ParameterType - - SUBROUTINE NWTC_Library_PackNWTC_RandomNumber_ParameterType( 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(NWTC_RandomNumber_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 = 'NWTC_Library_PackNWTC_RandomNumber_ParameterType' - ! 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 ! pRNG - Int_BufSz = Int_BufSz + SIZE(InData%RandSeed) ! RandSeed - Int_BufSz = Int_BufSz + 1 ! RandSeedAry allocated yes/no - IF ( ALLOCATED(InData%RandSeedAry) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RandSeedAry upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RandSeedAry) ! RandSeedAry - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%RNG_type) ! RNG_type - 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%pRNG - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RandSeed,1), UBOUND(InData%RandSeed,1) - IntKiBuf(Int_Xferred) = InData%RandSeed(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%RandSeedAry) ) 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%RandSeedAry,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RandSeedAry,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RandSeedAry,1), UBOUND(InData%RandSeedAry,1) - IntKiBuf(Int_Xferred) = InData%RandSeedAry(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(InData%RNG_type) - IntKiBuf(Int_Xferred) = ICHAR(InData%RNG_type(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE NWTC_Library_PackNWTC_RandomNumber_ParameterType - - SUBROUTINE NWTC_Library_UnPackNWTC_RandomNumber_ParameterType( 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(NWTC_RandomNumber_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackNWTC_RandomNumber_ParameterType' - ! 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%pRNG = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RandSeed,1) - i1_u = UBOUND(OutData%RandSeed,1) - DO i1 = LBOUND(OutData%RandSeed,1), UBOUND(OutData%RandSeed,1) - OutData%RandSeed(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RandSeedAry 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%RandSeedAry)) DEALLOCATE(OutData%RandSeedAry) - ALLOCATE(OutData%RandSeedAry(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RandSeedAry.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RandSeedAry,1), UBOUND(OutData%RandSeedAry,1) - OutData%RandSeedAry(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(OutData%RNG_type) - OutData%RNG_type(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE NWTC_Library_UnPackNWTC_RandomNumber_ParameterType - + ErrMsg = '' +end subroutine + +subroutine NWTC_Library_PackOutParmType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OutParmType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackOutParmType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Indx) + call RegPack(Buf, InData%Name) + call RegPack(Buf, InData%Units) + call RegPack(Buf, InData%SignM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackOutParmType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OutParmType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackOutParmType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Indx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Name) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Units) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SignM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeData, CtrlCode, ErrStat, ErrMsg) + type(FileInfoType), intent(in) :: SrcFileInfoTypeData + type(FileInfoType), intent(inout) :: DstFileInfoTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyFileInfoType' + ErrStat = ErrID_None + ErrMsg = '' + DstFileInfoTypeData%NumLines = SrcFileInfoTypeData%NumLines + DstFileInfoTypeData%NumFiles = SrcFileInfoTypeData%NumFiles + if (allocated(SrcFileInfoTypeData%FileLine)) then + LB(1:1) = lbound(SrcFileInfoTypeData%FileLine) + UB(1:1) = ubound(SrcFileInfoTypeData%FileLine) + if (.not. allocated(DstFileInfoTypeData%FileLine)) then + allocate(DstFileInfoTypeData%FileLine(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileLine.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFileInfoTypeData%FileLine = SrcFileInfoTypeData%FileLine + end if + if (allocated(SrcFileInfoTypeData%FileIndx)) then + LB(1:1) = lbound(SrcFileInfoTypeData%FileIndx) + UB(1:1) = ubound(SrcFileInfoTypeData%FileIndx) + if (.not. allocated(DstFileInfoTypeData%FileIndx)) then + allocate(DstFileInfoTypeData%FileIndx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFileInfoTypeData%FileIndx = SrcFileInfoTypeData%FileIndx + end if + if (allocated(SrcFileInfoTypeData%FileList)) then + LB(1:1) = lbound(SrcFileInfoTypeData%FileList) + UB(1:1) = ubound(SrcFileInfoTypeData%FileList) + if (.not. allocated(DstFileInfoTypeData%FileList)) then + allocate(DstFileInfoTypeData%FileList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFileInfoTypeData%FileList = SrcFileInfoTypeData%FileList + end if + if (allocated(SrcFileInfoTypeData%Lines)) then + LB(1:1) = lbound(SrcFileInfoTypeData%Lines) + UB(1:1) = ubound(SrcFileInfoTypeData%Lines) + if (.not. allocated(DstFileInfoTypeData%Lines)) then + allocate(DstFileInfoTypeData%Lines(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%Lines.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFileInfoTypeData%Lines = SrcFileInfoTypeData%Lines + end if +end subroutine + +subroutine NWTC_Library_DestroyFileInfoType(FileInfoTypeData, ErrStat, ErrMsg) + type(FileInfoType), intent(inout) :: FileInfoTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyFileInfoType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(FileInfoTypeData%FileLine)) then + deallocate(FileInfoTypeData%FileLine) + end if + if (allocated(FileInfoTypeData%FileIndx)) then + deallocate(FileInfoTypeData%FileIndx) + end if + if (allocated(FileInfoTypeData%FileList)) then + deallocate(FileInfoTypeData%FileList) + end if + if (allocated(FileInfoTypeData%Lines)) then + deallocate(FileInfoTypeData%Lines) + end if +end subroutine + +subroutine NWTC_Library_PackFileInfoType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FileInfoType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackFileInfoType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%NumLines) + call RegPack(Buf, InData%NumFiles) + call RegPack(Buf, allocated(InData%FileLine)) + if (allocated(InData%FileLine)) then + call RegPackBounds(Buf, 1, lbound(InData%FileLine), ubound(InData%FileLine)) + call RegPack(Buf, InData%FileLine) + end if + call RegPack(Buf, allocated(InData%FileIndx)) + if (allocated(InData%FileIndx)) then + call RegPackBounds(Buf, 1, lbound(InData%FileIndx), ubound(InData%FileIndx)) + call RegPack(Buf, InData%FileIndx) + end if + call RegPack(Buf, allocated(InData%FileList)) + if (allocated(InData%FileList)) then + call RegPackBounds(Buf, 1, lbound(InData%FileList), ubound(InData%FileList)) + call RegPack(Buf, InData%FileList) + end if + call RegPack(Buf, allocated(InData%Lines)) + if (allocated(InData%Lines)) then + call RegPackBounds(Buf, 1, lbound(InData%Lines), ubound(InData%Lines)) + call RegPack(Buf, InData%Lines) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackFileInfoType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FileInfoType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackFileInfoType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NumLines) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumFiles) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%FileLine)) deallocate(OutData%FileLine) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FileLine(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileLine.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FileLine) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FileIndx)) deallocate(OutData%FileIndx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FileIndx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FileIndx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FileList)) deallocate(OutData%FileList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FileList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FileList) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Lines)) deallocate(OutData%Lines) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Lines(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lines.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Lines) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine NWTC_Library_CopyQuaternion(SrcQuaternionData, DstQuaternionData, CtrlCode, ErrStat, ErrMsg) + type(Quaternion), intent(in) :: SrcQuaternionData + type(Quaternion), intent(inout) :: DstQuaternionData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_CopyQuaternion' + ErrStat = ErrID_None + ErrMsg = '' + DstQuaternionData%q0 = SrcQuaternionData%q0 + DstQuaternionData%v = SrcQuaternionData%v +end subroutine + +subroutine NWTC_Library_DestroyQuaternion(QuaternionData, ErrStat, ErrMsg) + type(Quaternion), intent(inout) :: QuaternionData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyQuaternion' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine NWTC_Library_PackQuaternion(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Quaternion), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackQuaternion' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%q0) + call RegPack(Buf, InData%v) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackQuaternion(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Quaternion), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackQuaternion' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%q0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%v) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyNWTC_RandomNumber_ParameterType(SrcNWTC_RandomNumber_ParameterTypeData, DstNWTC_RandomNumber_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(NWTC_RandomNumber_ParameterType), intent(in) :: SrcNWTC_RandomNumber_ParameterTypeData + type(NWTC_RandomNumber_ParameterType), intent(inout) :: DstNWTC_RandomNumber_ParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyNWTC_RandomNumber_ParameterType' + ErrStat = ErrID_None + ErrMsg = '' + DstNWTC_RandomNumber_ParameterTypeData%pRNG = SrcNWTC_RandomNumber_ParameterTypeData%pRNG + DstNWTC_RandomNumber_ParameterTypeData%RandSeed = SrcNWTC_RandomNumber_ParameterTypeData%RandSeed + if (allocated(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then + LB(1:1) = lbound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry) + UB(1:1) = ubound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry) + if (.not. allocated(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then + allocate(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry = SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry + end if + DstNWTC_RandomNumber_ParameterTypeData%RNG_type = SrcNWTC_RandomNumber_ParameterTypeData%RNG_type +end subroutine + +subroutine NWTC_Library_DestroyNWTC_RandomNumber_ParameterType(NWTC_RandomNumber_ParameterTypeData, ErrStat, ErrMsg) + type(NWTC_RandomNumber_ParameterType), intent(inout) :: NWTC_RandomNumber_ParameterTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyNWTC_RandomNumber_ParameterType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(NWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then + deallocate(NWTC_RandomNumber_ParameterTypeData%RandSeedAry) + end if +end subroutine + +subroutine NWTC_Library_PackNWTC_RandomNumber_ParameterType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(NWTC_RandomNumber_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackNWTC_RandomNumber_ParameterType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%pRNG) + call RegPack(Buf, InData%RandSeed) + call RegPack(Buf, allocated(InData%RandSeedAry)) + if (allocated(InData%RandSeedAry)) then + call RegPackBounds(Buf, 1, lbound(InData%RandSeedAry), ubound(InData%RandSeedAry)) + call RegPack(Buf, InData%RandSeedAry) + end if + call RegPack(Buf, InData%RNG_type) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackNWTC_RandomNumber_ParameterType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(NWTC_RandomNumber_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackNWTC_RandomNumber_ParameterType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%pRNG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RandSeed) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%RandSeedAry)) deallocate(OutData%RandSeedAry) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RandSeedAry(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RandSeedAry.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RandSeedAry) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%RNG_type) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE NWTC_Library_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/SingPrec.f90 b/modules/nwtc-library/src/SingPrec.f90 index edcfcf1740..ca549f768c 100644 --- a/modules/nwtc-library/src/SingPrec.f90 +++ b/modules/nwtc-library/src/SingPrec.f90 @@ -29,22 +29,31 @@ MODULE Precision !.................................................................................................................................. #ifdef HAS_FORTRAN2008_FEATURES -USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: real32, real64, real128 +USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: real32, real64, real128, int8, int16, int32, int64 #endif -IMPLICIT NONE +IMPLICIT NONE + +#ifdef HAS_FORTRAN2008_FEATURES + +INTEGER, PARAMETER :: B1Ki = int8 !< Kind for one-byte whole numbers +INTEGER, PARAMETER :: B2Ki = int16 !< Kind for two-byte whole numbers +INTEGER, PARAMETER :: B4Ki = int32 !< Kind for four-byte whole numbers +INTEGER, PARAMETER :: B8Ki = int64 !< Kind for eight-byte whole numbers + +INTEGER, PARAMETER :: R4Ki = real32 !< Kind for four-byte, floating-point numbers +INTEGER, PARAMETER :: R8Ki = real64 !< Kind for eight-byte floating-point numbers + +#else INTEGER, PARAMETER :: B1Ki = SELECTED_INT_KIND( 2 ) !< Kind for one-byte whole numbers INTEGER, PARAMETER :: B2Ki = SELECTED_INT_KIND( 4 ) !< Kind for two-byte whole numbers INTEGER, PARAMETER :: B4Ki = SELECTED_INT_KIND( 9 ) !< Kind for four-byte whole numbers INTEGER, PARAMETER :: B8Ki = SELECTED_INT_KIND( 18 ) !< Kind for eight-byte whole numbers -#ifdef HAS_FORTRAN2008_FEATURES -INTEGER, PARAMETER :: R4Ki = real32 !< Kind for four-byte, floating-point numbers -INTEGER, PARAMETER :: R8Ki = real64 !< Kind for eight-byte floating-point numbers -#else INTEGER, PARAMETER :: R4Ki = SELECTED_REAL_KIND( 6, 30 ) !< Kind for four-byte, floating-point numbers INTEGER, PARAMETER :: R8Ki = SELECTED_REAL_KIND( 14, 300 ) !< Kind for eight-byte floating-point numbers + #endif INTEGER, PARAMETER :: BYTES_IN_R4Ki = 4 !< Number of bytes per R4Ki number diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index c795815058..5a9ab6adc7 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -7053,11 +7053,7 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, INTEGER(IntKi), OPTIONAL, INTENT(INOUT) :: Unit !< unit number for output file ! local variables: - REAL(ReKi), ALLOCATABLE :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE :: IntKiBuf(:) - - INTEGER(B4Ki) :: ArraySizes(3) + type(PackBuffer) :: Buf INTEGER(IntKi) :: unOut ! unit number for output file INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore @@ -7072,19 +7068,15 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, ErrStat = ErrID_None ErrMsg = "" - ! Get the arrays of data to be stored in the output file - CALL FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Turbine, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - + ! Initialize the pack buffer + call InitPackBuffer(Buf, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return - ArraySizes = 0 - IF ( ALLOCATED(ReKiBuf) ) ArraySizes(1) = SIZE(ReKiBuf) - IF ( ALLOCATED(DbKiBuf) ) ArraySizes(2) = SIZE(DbKiBuf) - IF ( ALLOCATED(IntKiBuf) ) ArraySizes(3) = SIZE(IntKiBuf) + ! Get the arrays of data to be stored in the output file + call FAST_PackTurbineType(Buf, Turbine) + call SetErrStat(Buf%ErrStat, Buf%ErrMsg, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return FileName = TRIM(CheckpointRoot)//'.chkp' DLLFileName = TRIM(CheckpointRoot)//'.dll.chkp' @@ -7098,37 +7090,24 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, CALL OpenBOutFile ( unOut, FileName, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev ) then - call cleanup() + IF (.NOT. PRESENT(Unit)) THEN CLOSE(unOut) unOut = -1 - END IF - - RETURN + end if + return end if - ! checkpoint file header: - WRITE (unOut, IOSTAT=ErrStat2) INT(ReKi ,B4Ki) ! let's make sure we've got the correct number of bytes for reals on restart. - WRITE (unOut, IOSTAT=ErrStat2) INT(DbKi ,B4Ki) ! let's make sure we've got the correct number of bytes for doubles on restart. - WRITE (unOut, IOSTAT=ErrStat2) INT(IntKi ,B4Ki) ! let's make sure we've got the correct number of bytes for integers on restart. - WRITE (unOut, IOSTAT=ErrStat2) AbortErrLev - WRITE (unOut, IOSTAT=ErrStat2) NumTurbines ! Number of turbines - WRITE (unOut, IOSTAT=ErrStat2) t_initial ! initial time - WRITE (unOut, IOSTAT=ErrStat2) n_t_global ! current time step + ! Checkpoint file header: + WRITE (unOut, IOSTAT=ErrStat2) AbortErrLev ! Abort error level + WRITE (unOut, IOSTAT=ErrStat2) NumTurbines ! Number of turbines + WRITE (unOut, IOSTAT=ErrStat2) t_initial ! initial time + WRITE (unOut, IOSTAT=ErrStat2) n_t_global ! current time step END IF - - ! data from current turbine at time step: - WRITE (unOut, IOSTAT=ErrStat2) ArraySizes ! Number of reals, doubles, and integers written to file - WRITE (unOut, IOSTAT=ErrStat2) ReKiBuf ! Packed reals - WRITE (unOut, IOSTAT=ErrStat2) DbKiBuf ! Packed doubles - WRITE (unOut, IOSTAT=ErrStat2) IntKiBuf ! Packed integers - - - IF ( ALLOCATED(ReKiBuf) ) DEALLOCATE(ReKiBuf) - IF ( ALLOCATED(DbKiBuf) ) DEALLOCATE(DbKiBuf) - IF ( ALLOCATED(IntKiBuf) ) DEALLOCATE(IntKiBuf) + ! data from current turbine at time step: + call WritePackBuffer(Buf, unOut, ErrStat2, ErrMsg2) !CALL FAST_CreateCheckpoint(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & ! Turbine%ED, Turbine%SrvD, Turbine%AD, Turbine%IfW, & @@ -7136,6 +7115,7 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, ! Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + ! If last turbine or no unit, close output unit IF (Turbine%TurbID == NumTurbines .OR. .NOT. PRESENT(Unit)) THEN CLOSE(unOut) unOut = -1 @@ -7164,16 +7144,7 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) end if END IF - - - call cleanup() -contains - subroutine cleanup() - IF ( ALLOCATED(ReKiBuf) ) DEALLOCATE(ReKiBuf) - IF ( ALLOCATED(DbKiBuf) ) DEALLOCATE(DbKiBuf) - IF ( ALLOCATED(IntKiBuf) ) DEALLOCATE(IntKiBuf) - end subroutine cleanup END SUBROUTINE FAST_CreateCheckpoint_T !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calls FAST_RestoreFromCheckpoint_T for an array of Turbine data structures. @@ -7236,11 +7207,7 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb INTEGER(IntKi), OPTIONAL, INTENT(INOUT) :: Unit !< unit number for output file ! local variables: - REAL(ReKi), ALLOCATABLE :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE :: IntKiBuf(:) - - INTEGER(B4Ki) :: ArraySizes(3) + type(PackBuffer) :: Buf INTEGER(IntKi) :: unIn ! unit number for input file INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore @@ -7265,61 +7232,31 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb CALL GetNewUnit( unIn, ErrStat2, ErrMsg2 ) - CALL OpenBInpFile ( unIn, FileName, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev ) RETURN - - ! checkpoint file header: - READ (unIn, IOSTAT=ErrStat2) ArraySizes ! let's make sure we've got the correct number of bytes for reals, doubles, and integers on restart. - - IF ( ArraySizes(1) /= ReKi ) CALL SetErrStat(ErrID_Fatal,"ReKi on restart is different than when checkpoint file was created.",ErrStat,ErrMsg,RoutineName) - IF ( ArraySizes(2) /= DbKi ) CALL SetErrStat(ErrID_Fatal,"DbKi on restart is different than when checkpoint file was created.",ErrStat,ErrMsg,RoutineName) - IF ( ArraySizes(3) /= IntKi ) CALL SetErrStat(ErrID_Fatal,"IntKi on restart is different than when checkpoint file was created.",ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(unIn) - unIn = -1 - IF (PRESENT(Unit)) Unit = unIn - RETURN - END IF + CALL OpenBInpFile(unIn, FileName, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev ) return - READ (unIn, IOSTAT=ErrStat2) AbortErrLev - READ (unIn, IOSTAT=ErrStat2) NumTurbines ! Number of turbines - READ (unIn, IOSTAT=ErrStat2) t_initial ! initial time - READ (unIn, IOSTAT=ErrStat2) n_t_global ! current time step + READ (unIn, IOSTAT=ErrStat2) AbortErrLev ! Abort error level + READ (unIn, IOSTAT=ErrStat2) NumTurbines ! Number of turbines + READ (unIn, IOSTAT=ErrStat2) t_initial ! initial time + READ (unIn, IOSTAT=ErrStat2) n_t_global ! current time step END IF ! in case the Turbine data structure isn't empty on entry of this routine: call FAST_DestroyTurbineType( Turbine, ErrStat2, ErrMsg2 ) - - ! data from current time step: - READ (unIn, IOSTAT=ErrStat2) ArraySizes ! Number of reals, doubles, and integers written to file - - ALLOCATE(ReKiBuf( ArraySizes(1)), STAT=ErrStat2) - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not allocate ReKiBuf", ErrStat, ErrMsg, RoutineName ) - ALLOCATE(DbKiBuf( ArraySizes(2)), STAT=ErrStat2) - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not allocate DbKiBuf", ErrStat, ErrMsg, RoutineName ) - ALLOCATE(IntKiBuf(ArraySizes(3)), STAT=ErrStat2) - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not allocate IntKiBuf", ErrStat, ErrMsg, RoutineName ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) return ! Read the packed arrays - IF (ErrStat < AbortErrLev) THEN - - READ (unIn, IOSTAT=ErrStat2) ReKiBuf ! Packed reals - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not read ReKiBuf", ErrStat, ErrMsg, RoutineName ) - READ (unIn, IOSTAT=ErrStat2) DbKiBuf ! Packed doubles - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not read DbKiBuf", ErrStat, ErrMsg, RoutineName ) - READ (unIn, IOSTAT=ErrStat2) IntKiBuf ! Packed integers - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not read IntKiBuf", ErrStat, ErrMsg, RoutineName ) - - END IF + call ReadPackBuffer(Buf, unIn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return ! Put the arrays back in the data types - IF (ErrStat < AbortErrLev) THEN - CALL FAST_UnpackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Turbine, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - + call FAST_UnpackTurbineType(Buf, Turbine) + call SetErrStat(Buf%ErrStat, Buf%ErrMsg, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return ! close file if necessary (do this after unpacking turbine data, so that TurbID is set) IF (Turbine%TurbID == NumTurbines .OR. .NOT. PRESENT(Unit)) THEN @@ -7329,15 +7266,9 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb IF (PRESENT(Unit)) Unit = unIn - - IF ( ALLOCATED(ReKiBuf) ) DEALLOCATE(ReKiBuf) - IF ( ALLOCATED(DbKiBuf) ) DEALLOCATE(DbKiBuf) - IF ( ALLOCATED(IntKiBuf) ) DEALLOCATE(IntKiBuf) - - ! A sort-of hack to restore MAP DLL data (in particular Turbine%MAP%OtherSt%C_Obj%object) - ! these must be the same variables that are used in MAP_Init because they get allocated in the DLL and - ! destroyed in MAP_End (also, inside the DLL) + ! these must be the same variables that are used in MAP_Init because they get allocated in the DLL and + ! destroyed in MAP_End (also, inside the DLL) IF (Turbine%p_FAST%CompMooring == Module_MAP) THEN CALL MAP_Restart( Turbine%MAP%Input(1), Turbine%MAP%p, Turbine%MAP%x(STATE_CURR), Turbine%MAP%xd(STATE_CURR), & Turbine%MAP%z(STATE_CURR), Turbine%MAP%OtherSt, Turbine%MAP%y, ErrStat2, ErrMsg2 ) @@ -7371,7 +7302,6 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb Turbine%HD%p%PointsToSeaState = .false. ! since the pointers aren't pointing to the same data as SeaState after restart, set this to avoid memory leaks and deallocation problems - ! deal with files that were open: IF (Turbine%p_FAST%WrTxtOutFile) THEN CALL OpenFunkFileAppend ( Turbine%y_FAST%UnOu, TRIM(Turbine%p_FAST%OutFileRoot)//'.out', ErrStat2, ErrMsg2) @@ -7380,8 +7310,8 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb CALL WrFileNR ( Turbine%y_FAST%UnOu, '#Restarting here') WRITE(Turbine%y_FAST%UnOu, '()') END IF - ! (ignoring for now; will have fort.x files if any were open [though I printed a warning about not outputting binary files earlier]) + ! (ignoring for now; will have fort.x files if any were open [though I printed a warning about not outputting binary files earlier]) END SUBROUTINE FAST_RestoreFromCheckpoint_T !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 893900335c..aa9ff1b0c6 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -80,12 +80,12 @@ MODULE FAST_Types ! ======================= ! ========= FAST_VTK_SurfaceType ======= TYPE, PUBLIC :: FAST_VTK_SurfaceType - INTEGER(IntKi) :: NumSectors !< number of sectors in which to split circles (higher number gives smoother surface) [-] - REAL(SiKi) :: HubRad !< Preconed hub radius (distance from the rotor apex to the blade root) [m] - REAL(SiKi) :: GroundRad !< radius for plotting circle on ground [m] - REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] + INTEGER(IntKi) :: NumSectors = 0_IntKi !< number of sectors in which to split circles (higher number gives smoother surface) [-] + REAL(SiKi) :: HubRad = 0.0_R4Ki !< Preconed hub radius (distance from the rotor apex to the blade root) [m] + REAL(SiKi) :: GroundRad = 0.0_R4Ki !< radius for plotting circle on ground [m] + REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox = 0.0_R4Ki !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: TowerRad !< radius of each ED tower node [m] - INTEGER(IntKi) , DIMENSION(1:2) :: NWaveElevPts !< number of points for wave elevation visualization [-] + INTEGER(IntKi) , DIMENSION(1:2) :: NWaveElevPts = 0_IntKi !< number of points for wave elevation visualization [-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< X-Y locations for WaveElev output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number. [m,-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< wave elevation at WaveElevXY; first dimension is time step; second dimension is point number [m,-] TYPE(FAST_VTK_BLSurfaceType) , DIMENSION(:), ALLOCATABLE :: BladeShape !< AirfoilCoords for each blade [m] @@ -96,12 +96,12 @@ MODULE FAST_Types TYPE, PUBLIC :: FAST_VTK_ModeShapeType CHARACTER(1024) :: CheckpointRoot !< name of the checkpoint file written by FAST when linearization data was produced [-] CHARACTER(1024) :: MatlabFileName !< name of the file with eigenvectors written by Matlab [-] - INTEGER(IntKi) :: VTKLinModes !< Number of modes to visualize [-] + INTEGER(IntKi) :: VTKLinModes = 0_IntKi !< Number of modes to visualize [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: VTKModes !< Which modes to visualize [-] - INTEGER(IntKi) :: VTKLinTim !< Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2) [-] - INTEGER(IntKi) :: VTKNLinTimes !< number of linearization times to use when VTKLinTim==2 [-] - REAL(ReKi) :: VTKLinScale !< Mode shape visualization scaling factor [-] - REAL(ReKi) :: VTKLinPhase !< Phase when making one animation for all LinTimes together (used only when VTKLinTim=1) [-] + INTEGER(IntKi) :: VTKLinTim = 0_IntKi !< Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2) [-] + INTEGER(IntKi) :: VTKNLinTimes = 0_IntKi !< number of linearization times to use when VTKLinTim==2 [-] + REAL(ReKi) :: VTKLinScale = 0.0_ReKi !< Mode shape visualization scaling factor [-] + REAL(ReKi) :: VTKLinPhase = 0.0_ReKi !< Phase when making one animation for all LinTimes together (used only when VTKLinTim=1) [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: DampingRatio !< damping ratios from mbc3 analysis [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: NaturalFreq_Hz !< natural frequency from mbc3 analysis [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: DampedFreq_Hz !< damped frequency from mbc3 analysis [-] @@ -111,46 +111,46 @@ MODULE FAST_Types ! ======================= ! ========= FAST_ParameterType ======= TYPE, PUBLIC :: FAST_ParameterType - REAL(DbKi) :: DT !< Integration time step [global time] [s] - 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} [-] - INTEGER(IntKi) :: NumCrctn !< Number of correction iterations [-] - INTEGER(IntKi) :: KMax !< Maximum number of input-output-solve iterations (KMax >= 1) [-] - 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(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; [-] - INTEGER(IntKi) :: SolveOption !< Switch to determine which solve option we are going to use (see Solve_FullOpt1, etc) [-] - INTEGER(IntKi) :: CompElast !< Compute blade loads (switch) {Module_ED; Module_BD} [-] - INTEGER(IntKi) :: CompInflow !< Compute inflow wind conditions (switch) {Module_None; Module_IfW; Module_OpFM} [-] - INTEGER(IntKi) :: CompAero !< Compute aerodynamic loads (switch) {Module_None; Module_AD14; Module_AD} [-] - INTEGER(IntKi) :: CompServo !< Compute control and electrical-drive dynamics (switch) {Module_None; Module_SrvD} [-] - INTEGER(IntKi) :: CompSeaSt !< Compute sea states; wave kinematics (switch) {Module_None; Module_SeaSt} [-] - INTEGER(IntKi) :: CompHydro !< Compute hydrodynamic loads (switch) {Module_None; Module_HD} [-] - INTEGER(IntKi) :: CompSub !< Compute sub-structural dynamics (switch) {Module_None; Module_HD} [-] - INTEGER(IntKi) :: CompMooring !< Compute mooring system (switch) {Module_None; Module_MAP; Module_FEAM; Module_MD; Module_Orca} [-] - INTEGER(IntKi) :: CompIce !< Compute ice loading (switch) {Module_None; Module_IceF, Module_IceD} [-] - INTEGER(IntKi) :: MHK !< MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine} [-] - LOGICAL :: UseDWM !< Use the DWM module in AeroDyn [-] - LOGICAL :: Linearize !< Linearization analysis (flag) [-] - 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 [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Integration time step [global time] [s] + REAL(DbKi) , DIMENSION(1:NumModules) :: DT_module = 0.0_R8Ki !< Integration time step [global time] [s] + INTEGER(IntKi) , DIMENSION(1:NumModules) :: n_substeps = 0_IntKi !< The number of module substeps for advancing states from t_global to t_global_next [-] + INTEGER(IntKi) :: n_TMax_m1 = 0_IntKi !< The time step of TMax - dt (the end time of the simulation) [(-)] + REAL(DbKi) :: TMax = 0.0_R8Ki !< Total run time [s] + INTEGER(IntKi) :: InterpOrder = 0_IntKi !< Interpolation order {0,1,2} [-] + INTEGER(IntKi) :: NumCrctn = 0_IntKi !< Number of correction iterations [-] + INTEGER(IntKi) :: KMax = 0_IntKi !< Maximum number of input-output-solve iterations (KMax >= 1) [-] + INTEGER(IntKi) :: numIceLegs = 0_IntKi !< number of suport-structure legs in contact with ice (IceDyn coupling) [-] + INTEGER(IntKi) :: nBeams = 0_IntKi !< number of BeamDyn instances [-] + LOGICAL :: BD_OutputSibling = .false. !< flag to determine if BD input is sibling of output mesh [-] + LOGICAL , DIMENSION(1:NumModules) :: ModuleInitialized = .false. !< An array determining if the module has been initialized [-] + REAL(DbKi) :: DT_Ujac = 0.0_R8Ki !< Time between when we need to re-calculate these Jacobians [s] + REAL(ReKi) :: UJacSclFact = 0.0_ReKi !< Scaling factor used to get similar magnitudes between accelerations, forces, and moments in Jacobians [-] + INTEGER(IntKi) , DIMENSION(1:9) :: SizeJac_Opt1 = 0_IntKi !< (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; [-] + INTEGER(IntKi) :: SolveOption = 0_IntKi !< Switch to determine which solve option we are going to use (see Solve_FullOpt1, etc) [-] + INTEGER(IntKi) :: CompElast = 0_IntKi !< Compute blade loads (switch) {Module_ED; Module_BD} [-] + INTEGER(IntKi) :: CompInflow = 0_IntKi !< Compute inflow wind conditions (switch) {Module_None; Module_IfW; Module_OpFM} [-] + INTEGER(IntKi) :: CompAero = 0_IntKi !< Compute aerodynamic loads (switch) {Module_None; Module_AD14; Module_AD} [-] + INTEGER(IntKi) :: CompServo = 0_IntKi !< Compute control and electrical-drive dynamics (switch) {Module_None; Module_SrvD} [-] + INTEGER(IntKi) :: CompSeaSt = 0_IntKi !< Compute sea states; wave kinematics (switch) {Module_None; Module_SeaSt} [-] + INTEGER(IntKi) :: CompHydro = 0_IntKi !< Compute hydrodynamic loads (switch) {Module_None; Module_HD} [-] + INTEGER(IntKi) :: CompSub = 0_IntKi !< Compute sub-structural dynamics (switch) {Module_None; Module_HD} [-] + INTEGER(IntKi) :: CompMooring = 0_IntKi !< Compute mooring system (switch) {Module_None; Module_MAP; Module_FEAM; Module_MD; Module_Orca} [-] + INTEGER(IntKi) :: CompIce = 0_IntKi !< Compute ice loading (switch) {Module_None; Module_IceF, Module_IceD} [-] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine} [-] + LOGICAL :: UseDWM = .false. !< Use the DWM module in AeroDyn [-] + LOGICAL :: Linearize = .false. !< Linearization analysis (flag) [-] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] LOGICAL :: FarmIntegration = .false. !< whether this is called from FAST.Farm (or another program that doesn't want FAST to call all of the init stuff first) [-] - REAL(SiKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used for graphics) [m] - REAL(ReKi) :: Gravity !< Gravitational acceleration [m/s^2] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: WtrDens !< Water density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic viscosity of working fluid [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound in working fluid [m/s] - REAL(ReKi) :: Patm !< Atmospheric pressure [Pa] - REAL(ReKi) :: Pvap !< Vapour pressure of working fluid [Pa] - REAL(ReKi) :: WtrDpth !< Water depth [m] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] + REAL(SiKi) , DIMENSION(1:3) :: TurbinePos = 0.0_R4Ki !< Initial position of turbine base (origin used for graphics) [m] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic viscosity of working fluid [m^2/s] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound in working fluid [m/s] + REAL(ReKi) :: Patm = 0.0_ReKi !< Atmospheric pressure [Pa] + REAL(ReKi) :: Pvap = 0.0_ReKi !< Vapour pressure of working fluid [Pa] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] CHARACTER(1024) :: EDFile !< The name of the ElastoDyn input file [-] 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 [-] @@ -161,50 +161,50 @@ MODULE FAST_Types CHARACTER(1024) :: SubFile !< Name of file containing sub-structural input parameters [-] CHARACTER(1024) :: MooringFile !< Name of file containing mooring system input parameters [-] CHARACTER(1024) :: IceFile !< Name of file containing ice loading input parameters [-] - REAL(DbKi) :: TStart !< Time to begin tabular output [s] - REAL(DbKi) :: DT_Out !< Time step for tabular output [s] - LOGICAL :: WrSttsTime !< Whether we should write the status times to the screen [-] - INTEGER(IntKi) :: n_SttsTime !< Number of time steps between screen status messages [-] - INTEGER(IntKi) :: n_ChkptTime !< Number of time steps between writing checkpoint files [-] - INTEGER(IntKi) :: n_DT_Out !< Number of time steps between writing a line in the time-marching output files [-] - INTEGER(IntKi) :: n_VTKTime !< Number of time steps between writing VTK files [-] - INTEGER(IntKi) :: TurbineType !< Type_LandBased, Type_Offshore_Fixed, Type_Offshore_Floating, Type_MHK_Fixed, or Type_MHK_Floating [-] - LOGICAL :: WrBinOutFile !< Write a binary output file? (.outb) [-] - LOGICAL :: WrTxtOutFile !< Write a text (formatted) output file? (.out) [-] - INTEGER(IntKi) :: WrBinMod !< If writing binary, which file format is to be written [1, 2, or 3] [-] - LOGICAL :: SumPrint !< Print summary data to file? (.sum) [-] + REAL(DbKi) :: TStart = 0.0_R8Ki !< Time to begin tabular output [s] + REAL(DbKi) :: DT_Out = 0.0_R8Ki !< Time step for tabular output [s] + LOGICAL :: WrSttsTime = .false. !< Whether we should write the status times to the screen [-] + INTEGER(IntKi) :: n_SttsTime = 0_IntKi !< Number of time steps between screen status messages [-] + INTEGER(IntKi) :: n_ChkptTime = 0_IntKi !< Number of time steps between writing checkpoint files [-] + INTEGER(IntKi) :: n_DT_Out = 0_IntKi !< Number of time steps between writing a line in the time-marching output files [-] + INTEGER(IntKi) :: n_VTKTime = 0_IntKi !< Number of time steps between writing VTK files [-] + INTEGER(IntKi) :: TurbineType = 0_IntKi !< Type_LandBased, Type_Offshore_Fixed, Type_Offshore_Floating, Type_MHK_Fixed, or Type_MHK_Floating [-] + LOGICAL :: WrBinOutFile = .false. !< Write a binary output file? (.outb) [-] + LOGICAL :: WrTxtOutFile = .false. !< Write a text (formatted) output file? (.out) [-] + INTEGER(IntKi) :: WrBinMod = 0_IntKi !< If writing binary, which file format is to be written [1, 2, or 3] [-] + LOGICAL :: SumPrint = .false. !< Print summary data to file? (.sum) [-] INTEGER(IntKi) :: WrVTK = 0 !< VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation} [-] - INTEGER(IntKi) :: VTK_Type !< Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)} [-] - LOGICAL :: VTK_fields !< Write mesh fields to VTK data files? (flag) {true/false} [-] + INTEGER(IntKi) :: VTK_Type = 0_IntKi !< Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)} [-] + LOGICAL :: VTK_fields = .false. !< Write mesh fields to VTK data files? (flag) {true/false} [-] CHARACTER(1) :: Delim !< Delimiter between columns of text output file (.out): space or tab [-] CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time); resulting field should be 10 characters [-] CHARACTER(20) :: OutFmt_t !< Format used for time channel in text tabular output; resulting field should be 10 characters [-] - INTEGER(IntKi) :: FmtWidth !< width of the time OutFmt specifier [-] - INTEGER(IntKi) :: TChanLen !< width of the time channel [-] + INTEGER(IntKi) :: FmtWidth = 0_IntKi !< width of the time OutFmt specifier [-] + INTEGER(IntKi) :: TChanLen = 0_IntKi !< width of the time channel [-] CHARACTER(1024) :: OutFileRoot !< The rootname of the output files [-] CHARACTER(1024) :: FTitle !< The description line from the FAST (glue-code) input file [-] CHARACTER(1024) :: VTK_OutFileRoot = '' !< The rootname of the VTK output files [-] - INTEGER(IntKi) :: VTK_tWidth !< Width of number of files for leading zeros in file name format [-] - REAL(DbKi) :: VTK_fps !< number of frames per second to output VTK data [-] + INTEGER(IntKi) :: VTK_tWidth = 0_IntKi !< Width of number of files for leading zeros in file name format [-] + REAL(DbKi) :: VTK_fps = 0.0_R8Ki !< number of frames per second to output VTK data [-] TYPE(FAST_VTK_SurfaceType) :: VTK_surface !< Data for VTK surface visualization [-] CHARACTER(4) :: Tdesc !< description of turbine ID (for FAST.Farm) screen printing [-] - LOGICAL :: CalcSteady !< Calculate a steady-state periodic operating point before linearization [unused if Linearize=False] [-] - INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [unused if Linearize=False; used only if CalcSteady=True] [-] - REAL(ReKi) :: TrimTol !< Tolerance for the rotational speed convergence (>0) [unused if Linearize=False; used only if CalcSteady=True] [-] - REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [unused if Linearize=False; used only if CalcSteady=True] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] - REAL(ReKi) :: Twr_Kdmp !< Damping factor for the tower [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] - REAL(ReKi) :: Bld_Kdmp !< Damping factor for the blades [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] - INTEGER(IntKi) :: NLinTimes !< Number of LinTimes, or equally-spaced azimuth steps in periodic linearized model (>0)[unused if Linearize=False] [-] - REAL(DbKi) :: AzimDelta !< difference between two consecutive azimuth positions in CalcSteady algorithm [rad] - INTEGER(IntKi) :: LinInputs !< Inputs included in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} [unused if Linearize=False] [-] - INTEGER(IntKi) :: LinOutputs !< Outputs included in linearization (switch) {0=none; 1=from OutList(s); 2=all module outputs (debug)} [unused if Linearize=False] [-] - LOGICAL :: LinOutJac !< Include full Jacabians in linearization output (for debug) (flag) [unused if Linearize=False; used only if LinInputs=LinOutputs=2] [-] - LOGICAL :: LinOutMod !< Write module-level linearization output files in addition to output for full system? (flag) [unused if Linearize=False] [-] + LOGICAL :: CalcSteady = .false. !< Calculate a steady-state periodic operating point before linearization [unused if Linearize=False] [-] + INTEGER(IntKi) :: TrimCase = 0_IntKi !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [unused if Linearize=False; used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimTol = 0.0_ReKi !< Tolerance for the rotational speed convergence (>0) [unused if Linearize=False; used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain = 0.0_ReKi !< Proportional gain for the rotational speed error (>0) [unused if Linearize=False; used only if CalcSteady=True] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: Twr_Kdmp = 0.0_ReKi !< Damping factor for the tower [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] + REAL(ReKi) :: Bld_Kdmp = 0.0_ReKi !< Damping factor for the blades [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] + INTEGER(IntKi) :: NLinTimes = 0_IntKi !< Number of LinTimes, or equally-spaced azimuth steps in periodic linearized model (>0)[unused if Linearize=False] [-] + REAL(DbKi) :: AzimDelta = 0.0_R8Ki !< difference between two consecutive azimuth positions in CalcSteady algorithm [rad] + INTEGER(IntKi) :: LinInputs = 0_IntKi !< Inputs included in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} [unused if Linearize=False] [-] + INTEGER(IntKi) :: LinOutputs = 0_IntKi !< Outputs included in linearization (switch) {0=none; 1=from OutList(s); 2=all module outputs (debug)} [unused if Linearize=False] [-] + LOGICAL :: LinOutJac = .false. !< Include full Jacabians in linearization output (for debug) (flag) [unused if Linearize=False; used only if LinInputs=LinOutputs=2] [-] + LOGICAL :: LinOutMod = .false. !< Write module-level linearization output files in addition to output for full system? (flag) [unused if Linearize=False] [-] 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(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 [-] + LOGICAL :: UseSC = .false. !< Use Supercontroller [-] + INTEGER(IntKi) :: Lin_NumMods = 0_IntKi !< number of modules in the linearization [-] + INTEGER(IntKi) , DIMENSION(1:NumModules) :: Lin_ModOrder = 0_IntKi !< indices that determine which order the modules are in the glue-code linearization matrix [-] + INTEGER(IntKi) :: LinInterpOrder = 0_IntKi !< Interpolation order for CalcSteady solution [-] END TYPE FAST_ParameterType ! ======================= ! ========= FAST_LinStateSave ======= @@ -305,9 +305,9 @@ MODULE FAST_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_x !< Whether corresponding continuous state is in rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_z !< Whether corresponding constraint state is in rotating frame [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Derivative order for continuous states [-] - INTEGER(IntKi) , DIMENSION(1:3) :: SizeLin !< sizes of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states [-] - INTEGER(IntKi) , DIMENSION(1:3) :: LinStartIndx !< the starting index in combined matrices of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states [-] - INTEGER(IntKi) :: NumOutputs !< number of WriteOutputs in each linearized module [-] + INTEGER(IntKi) , DIMENSION(1:3) :: SizeLin = 0_IntKi !< sizes of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states [-] + INTEGER(IntKi) , DIMENSION(1:3) :: LinStartIndx = 0_IntKi !< the starting index in combined matrices of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states [-] + INTEGER(IntKi) :: NumOutputs = 0_IntKi !< number of WriteOutputs in each linearized module [-] END TYPE FAST_LinType ! ======================= ! ========= FAST_ModLinType ======= @@ -319,22 +319,22 @@ MODULE FAST_Types TYPE, PUBLIC :: FAST_LinFileType 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] - REAL(ReKi) :: WindSpeed !< Wind speed at reference height [m/s] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: Azimuth = 0.0_ReKi !< Rotor azimuth position [rad] + REAL(ReKi) :: WindSpeed = 0.0_ReKi !< Wind speed at reference height [m/s] END TYPE FAST_LinFileType ! ======================= ! ========= FAST_MiscLinType ======= TYPE, PUBLIC :: FAST_MiscLinType REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: LinTimes !< List of times at which to linearize [s] - INTEGER(IntKi) :: CopyOP_CtrlCode !< mesh control code for copy type (new on first call; update otherwise) [-] + INTEGER(IntKi) :: CopyOP_CtrlCode = 0_IntKi !< mesh control code for copy type (new on first call; update otherwise) [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: AzimTarget !< target azimuth positions in CalcSteady algorithm [rad] - LOGICAL :: IsConverged !< whether the error calculation in the CalcSteady algorithm is converged [-] - LOGICAL :: FoundSteady !< whether the CalcSteady algorithm found a steady-state solution [-] - LOGICAL :: ForceLin !< whether the CalcSteady algorithm found a steady-state solution [-] - INTEGER(IntKi) :: n_rot !< number of rotations completed in CalcSteady algorithm [-] - INTEGER(IntKi) :: AzimIndx !< index into target azimuth array in CalcSteady algorithm [-] - INTEGER(IntKi) :: NextLinTimeIndx !< index for next time in LinTimes where linearization should occur [-] + LOGICAL :: IsConverged = .false. !< whether the error calculation in the CalcSteady algorithm is converged [-] + LOGICAL :: FoundSteady = .false. !< whether the CalcSteady algorithm found a steady-state solution [-] + LOGICAL :: ForceLin = .false. !< whether the CalcSteady algorithm found a steady-state solution [-] + INTEGER(IntKi) :: n_rot = 0_IntKi !< number of rotations completed in CalcSteady algorithm [-] + INTEGER(IntKi) :: AzimIndx = 0_IntKi !< index into target azimuth array in CalcSteady algorithm [-] + INTEGER(IntKi) :: NextLinTimeIndx = 0_IntKi !< index for next time in LinTimes where linearization should occur [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: Psi !< Azimuth angle at the current and previous time steps (uses LinInterpOrder); DbKi so that we can use registry-generated extrap/interp routines [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y_interp !< Interpolated outputs packed into an array [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y_ref !< Reference output range for CalcSteady error calculation [-] @@ -345,9 +345,9 @@ MODULE FAST_Types TYPE, PUBLIC :: FAST_OutputFileType REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TimeData !< Array to contain the time output data for the binary file (first output time and a time [fixed] increment) [-] 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(1:NumModules) :: numOuts !< number of outputs to print from each module [-] + INTEGER(IntKi) :: n_Out = 0_IntKi !< Time index into the AllOutData array [-] + INTEGER(IntKi) :: NOutSteps = 0_IntKi !< Maximum number of output steps [-] + INTEGER(IntKi) , DIMENSION(1:NumModules) :: numOuts = 0_IntKi !< 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 [-] @@ -356,13 +356,13 @@ MODULE FAST_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChannelUnits !< Units for the output channels [-] 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 [-] + LOGICAL :: WriteThisStep = .false. !< Whether this step will be written in the FAST output files [-] + INTEGER(IntKi) :: VTK_count = 0_IntKi !< Number of VTK files written (for naming output files) [-] + INTEGER(IntKi) :: VTK_LastWaveIndx = 0_IntKi !< last index into wave array [-] TYPE(FAST_LinFileType) :: Lin !< linearization data for output [-] - INTEGER(IntKi) :: ActualChanLen !< width of the column headers output in the text and/or binary file [-] + INTEGER(IntKi) :: ActualChanLen = 0_IntKi !< width of the column headers output in the text and/or binary file [-] TYPE(FAST_LinStateSave) :: op !< operating points of states and inputs for VTK output of mode shapes [-] - REAL(ReKi) , DIMENSION(1:5) :: DriverWriteOutput !< pitch and tsr for current aero map case, plus error, number of iterations, wind speed [-] + REAL(ReKi) , DIMENSION(1:5) :: DriverWriteOutput = 0.0_ReKi !< pitch and tsr for current aero map case, plus error, number of iterations, wind speed [-] END TYPE FAST_OutputFileType ! ======================= ! ========= IceDyn_Data ======= @@ -690,29 +690,29 @@ MODULE FAST_Types ! ======================= ! ========= FAST_ExternInputType ======= TYPE, PUBLIC :: FAST_ExternInputType - REAL(ReKi) :: GenTrq !< generator torque input from Simulink/Labview [-] - REAL(ReKi) :: ElecPwr !< electric power input from Simulink/Labview [-] - REAL(ReKi) :: YawPosCom !< yaw position command from Simulink/Labview [-] - REAL(ReKi) :: YawRateCom !< yaw rate command from Simulink/Labview [-] - REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom !< blade pitch commands from Simulink/Labview [rad] - REAL(ReKi) , DIMENSION(1:3) :: BlAirfoilCom !< blade airfoil commands from Simulink/Labview [-] - REAL(ReKi) :: HSSBrFrac !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW [-] - REAL(ReKi) , DIMENSION(1:3) :: LidarFocus !< lidar focus (relative to lidar location) [m] - REAL(ReKi) , DIMENSION(1:20) :: CableDeltaL !< Cable control DeltaL [m] - REAL(ReKi) , DIMENSION(1:20) :: CableDeltaLdot !< Cable control DeltaLdot [m/s] + REAL(ReKi) :: GenTrq = 0.0_ReKi !< generator torque input from Simulink/Labview [-] + REAL(ReKi) :: ElecPwr = 0.0_ReKi !< electric power input from Simulink/Labview [-] + REAL(ReKi) :: YawPosCom = 0.0_ReKi !< yaw position command from Simulink/Labview [-] + REAL(ReKi) :: YawRateCom = 0.0_ReKi !< yaw rate command from Simulink/Labview [-] + REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom = 0.0_ReKi !< blade pitch commands from Simulink/Labview [rad] + REAL(ReKi) , DIMENSION(1:3) :: BlAirfoilCom = 0.0_ReKi !< blade airfoil commands from Simulink/Labview [-] + REAL(ReKi) :: HSSBrFrac = 0.0_ReKi !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW [-] + REAL(ReKi) , DIMENSION(1:3) :: LidarFocus = 0.0_ReKi !< lidar focus (relative to lidar location) [m] + REAL(ReKi) , DIMENSION(1:20) :: CableDeltaL = 0.0_ReKi !< Cable control DeltaL [m] + REAL(ReKi) , DIMENSION(1:20) :: CableDeltaLdot = 0.0_ReKi !< Cable control DeltaLdot [m/s] END TYPE FAST_ExternInputType ! ======================= ! ========= FAST_MiscVarType ======= TYPE, PUBLIC :: FAST_MiscVarType - REAL(DbKi) :: TiLstPrn !< The simulation time of the last print (to file) [(s)] - REAL(DbKi) :: t_global !< Current simulation time (for global/FAST simulation) [(s)] - REAL(DbKi) :: NextJacCalcTime !< Time between calculating Jacobians in the HD-ED and SD-ED simulations [(s)] - REAL(ReKi) :: PrevClockTime !< Clock time at start of simulation in seconds [(s)] - REAL(ReKi) :: UsrTime1 !< User CPU time for simulation initialization [(s)] - REAL(ReKi) :: UsrTime2 !< User CPU time for simulation (without intialization) [(s)] - INTEGER(IntKi) , DIMENSION(1:8) :: StrtTime !< Start time of simulation (including intialization) [-] - INTEGER(IntKi) , DIMENSION(1:8) :: SimStrtTime !< Start time of simulation (after initialization) [-] - LOGICAL :: calcJacobian !< Should we calculate Jacobians in Option 1? [(flag)] + REAL(DbKi) :: TiLstPrn = 0.0_R8Ki !< The simulation time of the last print (to file) [(s)] + REAL(DbKi) :: t_global = 0.0_R8Ki !< Current simulation time (for global/FAST simulation) [(s)] + REAL(DbKi) :: NextJacCalcTime = 0.0_R8Ki !< Time between calculating Jacobians in the HD-ED and SD-ED simulations [(s)] + REAL(ReKi) :: PrevClockTime = 0.0_ReKi !< Clock time at start of simulation in seconds [(s)] + REAL(ReKi) :: UsrTime1 = 0.0_ReKi !< User CPU time for simulation initialization [(s)] + REAL(ReKi) :: UsrTime2 = 0.0_ReKi !< User CPU time for simulation (without intialization) [(s)] + INTEGER(IntKi) , DIMENSION(1:8) :: StrtTime = 0_IntKi !< Start time of simulation (including intialization) [-] + INTEGER(IntKi) , DIMENSION(1:8) :: SimStrtTime = 0_IntKi !< Start time of simulation (after initialization) [-] + LOGICAL :: calcJacobian = .false. !< Should we calculate Jacobians in Option 1? [(flag)] TYPE(FAST_ExternInputType) :: ExternInput !< external input values [-] TYPE(FAST_MiscLinType) :: Lin !< misc data for linearization analysis [-] END TYPE FAST_MiscVarType @@ -759,24 +759,24 @@ MODULE FAST_Types TYPE, PUBLIC :: FAST_ExternInitType REAL(DbKi) :: Tmax = -1 !< External code specified Tmax [s] INTEGER(IntKi) :: SensorType = SensorType_None !< lidar sensor type, which should not be pulsed at the moment; this input should be replaced with a section in the InflowWind input file [-] - LOGICAL :: LidRadialVel !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] + LOGICAL :: LidRadialVel = .false. !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] INTEGER(IntKi) :: TurbineID = 0 !< ID number for turbine (used to create output file naming convention) [-] - REAL(ReKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used for graphics or in FAST.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) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2Ctrl !< number of turbine specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumCtrl2SC !< number of controller outputs [to supercontroller] [-] + REAL(ReKi) , DIMENSION(1:3) :: TurbinePos = 0.0_ReKi !< Initial position of turbine base (origin used for graphics or in FAST.Farm) [m] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< number of turbine specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< number of controller outputs [to supercontroller] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: fromSCGlob !< Initial global inputs to the controller [from the supercontroller] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: fromSC !< Initial turbine specific inputs to the controller [from the supercontroller] [-] LOGICAL :: FarmIntegration = .false. !< whether this is called from FAST.Farm (or another program that doesn't want FAST to call all of the init stuff first) [-] - INTEGER(IntKi) , DIMENSION(1:4) :: windGrid_n !< number of grid points in the x, y, z, and t directions for IfW [-] - REAL(ReKi) , DIMENSION(1:4) :: windGrid_delta !< size between 2 consecutive grid points in each grid direction for IfW [m,m,m,s] - REAL(ReKi) , DIMENSION(1:3) :: windGrid_pZero !< fixed position of the XYZ grid (i.e., XYZ coordinates of IfW m%V(:,1,1,1,:)) [m] + INTEGER(IntKi) , DIMENSION(1:4) :: windGrid_n = 0_IntKi !< number of grid points in the x, y, z, and t directions for IfW [-] + REAL(ReKi) , DIMENSION(1:4) :: windGrid_delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction for IfW [m,m,m,s] + REAL(ReKi) , DIMENSION(1:3) :: windGrid_pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of IfW m%V(:,1,1,1,:)) [m] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: windGrid_data => NULL() !< Pointers to Wind velocity of disturbed wind (ambient + wakes) across each high-resolution domain around a turbine for each high-resolution step within a low-resolution step [m/s] 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) [-] + INTEGER(IntKi) :: NumActForcePtsBlade = 0_IntKi !< number of actuator line force points in blade [-] + INTEGER(IntKi) :: NumActForcePtsTower = 0_IntKi !< number of actuator line force points in tower [-] + INTEGER(IntKi) :: NodeClusterType = 0_IntKi !< Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] END TYPE FAST_ExternInitType ! ======================= ! ========= FAST_TurbineType ======= @@ -807,50047 +807,13856 @@ MODULE FAST_Types END TYPE FAST_TurbineType ! ======================= CONTAINS - SUBROUTINE FAST_CopyVTK_BLSurfaceType( SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_VTK_BLSurfaceType), INTENT(IN) :: SrcVTK_BLSurfaceTypeData - TYPE(FAST_VTK_BLSurfaceType), INTENT(INOUT) :: DstVTK_BLSurfaceTypeData - 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 = 'FAST_CopyVTK_BLSurfaceType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) THEN - i1_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,1) - i1_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,1) - i2_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,2) - i2_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,2) - i3_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,3) - i3_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,3) - IF (.NOT. ALLOCATED(DstVTK_BLSurfaceTypeData%AirfoilCoords)) THEN - ALLOCATE(DstVTK_BLSurfaceTypeData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_BLSurfaceTypeData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_BLSurfaceTypeData%AirfoilCoords = SrcVTK_BLSurfaceTypeData%AirfoilCoords -ENDIF - END SUBROUTINE FAST_CopyVTK_BLSurfaceType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_BLSurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(VTK_BLSurfaceTypeData%AirfoilCoords)) THEN - DEALLOCATE(VTK_BLSurfaceTypeData%AirfoilCoords) -ENDIF - END SUBROUTINE FAST_DestroyVTK_BLSurfaceType - - SUBROUTINE FAST_PackVTK_BLSurfaceType( 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(FAST_VTK_BLSurfaceType), 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 = 'FAST_PackVTK_BLSurfaceType' - ! 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 ! AirfoilCoords allocated yes/no - IF ( ALLOCATED(InData%AirfoilCoords) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AirfoilCoords upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AirfoilCoords) ! AirfoilCoords - 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%AirfoilCoords) ) 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%AirfoilCoords,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) - Int_Xferred = Int_Xferred + 2 - DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) - DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) - DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) - ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FAST_PackVTK_BLSurfaceType - - SUBROUTINE FAST_UnPackVTK_BLSurfaceType( 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(FAST_VTK_BLSurfaceType), 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 = 'FAST_UnPackVTK_BLSurfaceType' - ! 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 ! AirfoilCoords 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%AirfoilCoords)) DEALLOCATE(OutData%AirfoilCoords) - ALLOCATE(OutData%AirfoilCoords(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%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) - DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) - DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) - OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FAST_UnPackVTK_BLSurfaceType - - SUBROUTINE FAST_CopyVTK_SurfaceType( SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_VTK_SurfaceType), INTENT(IN) :: SrcVTK_SurfaceTypeData - TYPE(FAST_VTK_SurfaceType), INTENT(INOUT) :: DstVTK_SurfaceTypeData - 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 = 'FAST_CopyVTK_SurfaceType' -! +subroutine FAST_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_VTK_BLSurfaceType), intent(in) :: SrcVTK_BLSurfaceTypeData + type(FAST_VTK_BLSurfaceType), intent(inout) :: DstVTK_BLSurfaceTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyVTK_BLSurfaceType' ErrStat = ErrID_None - ErrMsg = "" - DstVTK_SurfaceTypeData%NumSectors = SrcVTK_SurfaceTypeData%NumSectors - DstVTK_SurfaceTypeData%HubRad = SrcVTK_SurfaceTypeData%HubRad - DstVTK_SurfaceTypeData%GroundRad = SrcVTK_SurfaceTypeData%GroundRad - DstVTK_SurfaceTypeData%NacelleBox = SrcVTK_SurfaceTypeData%NacelleBox -IF (ALLOCATED(SrcVTK_SurfaceTypeData%TowerRad)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%TowerRad,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%TowerRad,1) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%TowerRad)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%TowerRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%TowerRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_SurfaceTypeData%TowerRad = SrcVTK_SurfaceTypeData%TowerRad -ENDIF - DstVTK_SurfaceTypeData%NWaveElevPts = SrcVTK_SurfaceTypeData%NWaveElevPts -IF (ALLOCATED(SrcVTK_SurfaceTypeData%WaveElevXY)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%WaveElevXY,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%WaveElevXY,1) - i2_l = LBOUND(SrcVTK_SurfaceTypeData%WaveElevXY,2) - i2_u = UBOUND(SrcVTK_SurfaceTypeData%WaveElevXY,2) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%WaveElevXY)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_SurfaceTypeData%WaveElevXY = SrcVTK_SurfaceTypeData%WaveElevXY -ENDIF -IF (ALLOCATED(SrcVTK_SurfaceTypeData%WaveElev)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%WaveElev,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%WaveElev,1) - i2_l = LBOUND(SrcVTK_SurfaceTypeData%WaveElev,2) - i2_u = UBOUND(SrcVTK_SurfaceTypeData%WaveElev,2) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%WaveElev)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_SurfaceTypeData%WaveElev = SrcVTK_SurfaceTypeData%WaveElev -ENDIF -IF (ALLOCATED(SrcVTK_SurfaceTypeData%BladeShape)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%BladeShape,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%BladeShape,1) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%BladeShape)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcVTK_SurfaceTypeData%BladeShape,1), UBOUND(SrcVTK_SurfaceTypeData%BladeShape,1) - CALL FAST_Copyvtk_blsurfacetype( SrcVTK_SurfaceTypeData%BladeShape(i1), DstVTK_SurfaceTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcVTK_SurfaceTypeData%MorisonRad)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%MorisonRad,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%MorisonRad,1) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%MorisonRad)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%MorisonRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%MorisonRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_SurfaceTypeData%MorisonRad = SrcVTK_SurfaceTypeData%MorisonRad -ENDIF - END SUBROUTINE FAST_CopyVTK_SurfaceType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_SurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(VTK_SurfaceTypeData%TowerRad)) THEN - DEALLOCATE(VTK_SurfaceTypeData%TowerRad) -ENDIF -IF (ALLOCATED(VTK_SurfaceTypeData%WaveElevXY)) THEN - DEALLOCATE(VTK_SurfaceTypeData%WaveElevXY) -ENDIF -IF (ALLOCATED(VTK_SurfaceTypeData%WaveElev)) THEN - DEALLOCATE(VTK_SurfaceTypeData%WaveElev) -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(VTK_SurfaceTypeData%BladeShape) -ENDIF -IF (ALLOCATED(VTK_SurfaceTypeData%MorisonRad)) THEN - DEALLOCATE(VTK_SurfaceTypeData%MorisonRad) -ENDIF - END SUBROUTINE FAST_DestroyVTK_SurfaceType - - SUBROUTINE FAST_PackVTK_SurfaceType( 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(FAST_VTK_SurfaceType), 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 = 'FAST_PackVTK_SurfaceType' - ! 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 ! NumSectors - Re_BufSz = Re_BufSz + 1 ! HubRad - Re_BufSz = Re_BufSz + 1 ! GroundRad - Re_BufSz = Re_BufSz + SIZE(InData%NacelleBox) ! NacelleBox - Int_BufSz = Int_BufSz + 1 ! TowerRad allocated yes/no - IF ( ALLOCATED(InData%TowerRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TowerRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TowerRad) ! TowerRad - END IF - Int_BufSz = Int_BufSz + SIZE(InData%NWaveElevPts) ! NWaveElevPts - 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 ! 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 ! BladeShape allocated yes/no - IF ( ALLOCATED(InData%BladeShape) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeShape upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeShape - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeShape - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeShape - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MorisonRad allocated yes/no - IF ( ALLOCATED(InData%MorisonRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MorisonRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MorisonRad) ! MorisonRad - 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 - - IntKiBuf(Int_Xferred) = InData%NumSectors - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GroundRad - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%NacelleBox,2), UBOUND(InData%NacelleBox,2) - DO i1 = LBOUND(InData%NacelleBox,1), UBOUND(InData%NacelleBox,1) - ReKiBuf(Re_Xferred) = InData%NacelleBox(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%TowerRad) ) 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%TowerRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TowerRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TowerRad,1), UBOUND(InData%TowerRad,1) - ReKiBuf(Re_Xferred) = InData%TowerRad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%NWaveElevPts,1), UBOUND(InData%NWaveElevPts,1) - IntKiBuf(Int_Xferred) = InData%NWaveElevPts(i1) - Int_Xferred = Int_Xferred + 1 - END DO - 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 - 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%BladeShape) ) 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%BladeShape,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeShape,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%MorisonRad) ) 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%MorisonRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MorisonRad,1), UBOUND(InData%MorisonRad,1) - ReKiBuf(Re_Xferred) = InData%MorisonRad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackVTK_SurfaceType - - SUBROUTINE FAST_UnPackVTK_SurfaceType( 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(FAST_VTK_SurfaceType), 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 = 'FAST_UnPackVTK_SurfaceType' - ! 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%NumSectors = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HubRad = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%GroundRad = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%NacelleBox,1) - i1_u = UBOUND(OutData%NacelleBox,1) - i2_l = LBOUND(OutData%NacelleBox,2) - i2_u = UBOUND(OutData%NacelleBox,2) - DO i2 = LBOUND(OutData%NacelleBox,2), UBOUND(OutData%NacelleBox,2) - DO i1 = LBOUND(OutData%NacelleBox,1), UBOUND(OutData%NacelleBox,1) - OutData%NacelleBox(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TowerRad 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%TowerRad)) DEALLOCATE(OutData%TowerRad) - ALLOCATE(OutData%TowerRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TowerRad,1), UBOUND(OutData%TowerRad,1) - OutData%TowerRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%NWaveElevPts,1) - i1_u = UBOUND(OutData%NWaveElevPts,1) - DO i1 = LBOUND(OutData%NWaveElevPts,1), UBOUND(OutData%NWaveElevPts,1) - OutData%NWaveElevPts(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - 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 - 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 ! BladeShape 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%BladeShape)) DEALLOCATE(OutData%BladeShape) - ALLOCATE(OutData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeShape,1), UBOUND(OutData%BladeShape,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 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 - - 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 ! MorisonRad 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%MorisonRad)) DEALLOCATE(OutData%MorisonRad) - ALLOCATE(OutData%MorisonRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MorisonRad,1), UBOUND(OutData%MorisonRad,1) - OutData%MorisonRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackVTK_SurfaceType - - SUBROUTINE FAST_CopyVTK_ModeShapeType( SrcVTK_ModeShapeTypeData, DstVTK_ModeShapeTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_VTK_ModeShapeType), INTENT(IN) :: SrcVTK_ModeShapeTypeData - TYPE(FAST_VTK_ModeShapeType), INTENT(INOUT) :: DstVTK_ModeShapeTypeData - 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 = 'FAST_CopyVTK_ModeShapeType' -! + ErrMsg = '' + if (allocated(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) then + LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + if (.not. allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then + allocate(DstVTK_BLSurfaceTypeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_BLSurfaceTypeData%AirfoilCoords.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_BLSurfaceTypeData%AirfoilCoords = SrcVTK_BLSurfaceTypeData%AirfoilCoords + end if +end subroutine + +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 + character(*), parameter :: RoutineName = 'FAST_DestroyVTK_BLSurfaceType' ErrStat = ErrID_None - ErrMsg = "" - DstVTK_ModeShapeTypeData%CheckpointRoot = SrcVTK_ModeShapeTypeData%CheckpointRoot - DstVTK_ModeShapeTypeData%MatlabFileName = SrcVTK_ModeShapeTypeData%MatlabFileName - DstVTK_ModeShapeTypeData%VTKLinModes = SrcVTK_ModeShapeTypeData%VTKLinModes -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%VTKModes)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%VTKModes,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%VTKModes,1) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%VTKModes)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%VTKModes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%VTKModes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%VTKModes = SrcVTK_ModeShapeTypeData%VTKModes -ENDIF - DstVTK_ModeShapeTypeData%VTKLinTim = SrcVTK_ModeShapeTypeData%VTKLinTim - DstVTK_ModeShapeTypeData%VTKNLinTimes = SrcVTK_ModeShapeTypeData%VTKNLinTimes - DstVTK_ModeShapeTypeData%VTKLinScale = SrcVTK_ModeShapeTypeData%VTKLinScale - DstVTK_ModeShapeTypeData%VTKLinPhase = SrcVTK_ModeShapeTypeData%VTKLinPhase -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%DampingRatio)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%DampingRatio,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%DampingRatio,1) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%DampingRatio)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%DampingRatio(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampingRatio.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio -ENDIF -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz,1) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%NaturalFreq_Hz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%NaturalFreq_Hz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz -ENDIF -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%DampedFreq_Hz,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%DampedFreq_Hz,1) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%DampedFreq_Hz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampedFreq_Hz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz -ENDIF -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,1) - i2_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,2) - i2_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,2) - i3_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,3) - i3_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,3) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%x_eig_magnitude)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%x_eig_magnitude(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_magnitude.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude -ENDIF -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%x_eig_phase)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,1) - i2_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,2) - i2_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,2) - i3_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,3) - i3_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,3) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%x_eig_phase)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%x_eig_phase(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_phase.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%x_eig_phase = SrcVTK_ModeShapeTypeData%x_eig_phase -ENDIF - END SUBROUTINE FAST_CopyVTK_ModeShapeType - - 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 - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_ModeShapeType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(VTK_ModeShapeTypeData%VTKModes)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%VTKModes) -ENDIF -IF (ALLOCATED(VTK_ModeShapeTypeData%DampingRatio)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%DampingRatio) -ENDIF -IF (ALLOCATED(VTK_ModeShapeTypeData%NaturalFreq_Hz)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%NaturalFreq_Hz) -ENDIF -IF (ALLOCATED(VTK_ModeShapeTypeData%DampedFreq_Hz)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%DampedFreq_Hz) -ENDIF -IF (ALLOCATED(VTK_ModeShapeTypeData%x_eig_magnitude)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%x_eig_magnitude) -ENDIF -IF (ALLOCATED(VTK_ModeShapeTypeData%x_eig_phase)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%x_eig_phase) -ENDIF - END SUBROUTINE FAST_DestroyVTK_ModeShapeType - - SUBROUTINE FAST_PackVTK_ModeShapeType( 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(FAST_VTK_ModeShapeType), 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 = 'FAST_PackVTK_ModeShapeType' - ! 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%CheckpointRoot) ! CheckpointRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%MatlabFileName) ! MatlabFileName - Int_BufSz = Int_BufSz + 1 ! VTKLinModes - Int_BufSz = Int_BufSz + 1 ! VTKModes allocated yes/no - IF ( ALLOCATED(InData%VTKModes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VTKModes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%VTKModes) ! VTKModes - END IF - Int_BufSz = Int_BufSz + 1 ! VTKLinTim - Int_BufSz = Int_BufSz + 1 ! VTKNLinTimes - Re_BufSz = Re_BufSz + 1 ! VTKLinScale - Re_BufSz = Re_BufSz + 1 ! VTKLinPhase - Int_BufSz = Int_BufSz + 1 ! DampingRatio allocated yes/no - IF ( ALLOCATED(InData%DampingRatio) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DampingRatio upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DampingRatio) ! DampingRatio - END IF - Int_BufSz = Int_BufSz + 1 ! NaturalFreq_Hz allocated yes/no - IF ( ALLOCATED(InData%NaturalFreq_Hz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NaturalFreq_Hz upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%NaturalFreq_Hz) ! NaturalFreq_Hz - END IF - Int_BufSz = Int_BufSz + 1 ! DampedFreq_Hz allocated yes/no - IF ( ALLOCATED(InData%DampedFreq_Hz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DampedFreq_Hz upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DampedFreq_Hz) ! DampedFreq_Hz - END IF - Int_BufSz = Int_BufSz + 1 ! x_eig_magnitude allocated yes/no - IF ( ALLOCATED(InData%x_eig_magnitude) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! x_eig_magnitude upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x_eig_magnitude) ! x_eig_magnitude - END IF - Int_BufSz = Int_BufSz + 1 ! x_eig_phase allocated yes/no - IF ( ALLOCATED(InData%x_eig_phase) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! x_eig_phase upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x_eig_phase) ! x_eig_phase - 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%CheckpointRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%CheckpointRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%MatlabFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%MatlabFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%VTKLinModes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%VTKModes) ) 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%VTKModes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VTKModes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VTKModes,1), UBOUND(InData%VTKModes,1) - IntKiBuf(Int_Xferred) = InData%VTKModes(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%VTKLinTim - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKNLinTimes - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VTKLinScale - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VTKLinPhase - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%DampingRatio) ) 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%DampingRatio,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampingRatio,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DampingRatio,1), UBOUND(InData%DampingRatio,1) - DbKiBuf(Db_Xferred) = InData%DampingRatio(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NaturalFreq_Hz) ) 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%NaturalFreq_Hz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NaturalFreq_Hz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NaturalFreq_Hz,1), UBOUND(InData%NaturalFreq_Hz,1) - DbKiBuf(Db_Xferred) = InData%NaturalFreq_Hz(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DampedFreq_Hz) ) 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%DampedFreq_Hz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampedFreq_Hz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DampedFreq_Hz,1), UBOUND(InData%DampedFreq_Hz,1) - DbKiBuf(Db_Xferred) = InData%DampedFreq_Hz(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_eig_magnitude) ) 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%x_eig_magnitude,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_magnitude,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_magnitude,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_magnitude,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_magnitude,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_magnitude,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%x_eig_magnitude,3), UBOUND(InData%x_eig_magnitude,3) - DO i2 = LBOUND(InData%x_eig_magnitude,2), UBOUND(InData%x_eig_magnitude,2) - DO i1 = LBOUND(InData%x_eig_magnitude,1), UBOUND(InData%x_eig_magnitude,1) - DbKiBuf(Db_Xferred) = InData%x_eig_magnitude(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_eig_phase) ) 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%x_eig_phase,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_phase,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_phase,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_phase,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_phase,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_phase,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%x_eig_phase,3), UBOUND(InData%x_eig_phase,3) - DO i2 = LBOUND(InData%x_eig_phase,2), UBOUND(InData%x_eig_phase,2) - DO i1 = LBOUND(InData%x_eig_phase,1), UBOUND(InData%x_eig_phase,1) - DbKiBuf(Db_Xferred) = InData%x_eig_phase(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FAST_PackVTK_ModeShapeType - - SUBROUTINE FAST_UnPackVTK_ModeShapeType( 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(FAST_VTK_ModeShapeType), 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 = 'FAST_UnPackVTK_ModeShapeType' - ! 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%CheckpointRoot) - OutData%CheckpointRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%MatlabFileName) - OutData%MatlabFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%VTKLinModes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VTKModes 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%VTKModes)) DEALLOCATE(OutData%VTKModes) - ALLOCATE(OutData%VTKModes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTKModes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VTKModes,1), UBOUND(OutData%VTKModes,1) - OutData%VTKModes(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%VTKLinTim = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKNLinTimes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKLinScale = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VTKLinPhase = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampingRatio 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%DampingRatio)) DEALLOCATE(OutData%DampingRatio) - ALLOCATE(OutData%DampingRatio(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampingRatio.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DampingRatio,1), UBOUND(OutData%DampingRatio,1) - OutData%DampingRatio(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NaturalFreq_Hz 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%NaturalFreq_Hz)) DEALLOCATE(OutData%NaturalFreq_Hz) - ALLOCATE(OutData%NaturalFreq_Hz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NaturalFreq_Hz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NaturalFreq_Hz,1), UBOUND(OutData%NaturalFreq_Hz,1) - OutData%NaturalFreq_Hz(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampedFreq_Hz 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%DampedFreq_Hz)) DEALLOCATE(OutData%DampedFreq_Hz) - ALLOCATE(OutData%DampedFreq_Hz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampedFreq_Hz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DampedFreq_Hz,1), UBOUND(OutData%DampedFreq_Hz,1) - OutData%DampedFreq_Hz(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_eig_magnitude 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%x_eig_magnitude)) DEALLOCATE(OutData%x_eig_magnitude) - ALLOCATE(OutData%x_eig_magnitude(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%x_eig_magnitude.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%x_eig_magnitude,3), UBOUND(OutData%x_eig_magnitude,3) - DO i2 = LBOUND(OutData%x_eig_magnitude,2), UBOUND(OutData%x_eig_magnitude,2) - DO i1 = LBOUND(OutData%x_eig_magnitude,1), UBOUND(OutData%x_eig_magnitude,1) - OutData%x_eig_magnitude(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_eig_phase 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%x_eig_phase)) DEALLOCATE(OutData%x_eig_phase) - ALLOCATE(OutData%x_eig_phase(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%x_eig_phase.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%x_eig_phase,3), UBOUND(OutData%x_eig_phase,3) - DO i2 = LBOUND(OutData%x_eig_phase,2), UBOUND(OutData%x_eig_phase,2) - DO i1 = LBOUND(OutData%x_eig_phase,1), UBOUND(OutData%x_eig_phase,1) - OutData%x_eig_phase(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FAST_UnPackVTK_ModeShapeType - - SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ParameterType), INTENT(IN) :: SrcParamData - TYPE(FAST_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyParam' -! + ErrMsg = '' + if (allocated(VTK_BLSurfaceTypeData%AirfoilCoords)) then + deallocate(VTK_BLSurfaceTypeData%AirfoilCoords) + end if +end subroutine + +subroutine FAST_PackVTK_BLSurfaceType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_VTK_BLSurfaceType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackVTK_BLSurfaceType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%AirfoilCoords)) + if (allocated(InData%AirfoilCoords)) then + call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords), ubound(InData%AirfoilCoords)) + call RegPack(Buf, InData%AirfoilCoords) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackVTK_BLSurfaceType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_VTK_BLSurfaceType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackVTK_BLSurfaceType' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%AirfoilCoords)) deallocate(OutData%AirfoilCoords) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AirfoilCoords) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_VTK_SurfaceType), intent(in) :: SrcVTK_SurfaceTypeData + type(FAST_VTK_SurfaceType), intent(inout) :: DstVTK_SurfaceTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyVTK_SurfaceType' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%DT_module = SrcParamData%DT_module - DstParamData%n_substeps = SrcParamData%n_substeps - DstParamData%n_TMax_m1 = SrcParamData%n_TMax_m1 - DstParamData%TMax = SrcParamData%TMax - DstParamData%InterpOrder = SrcParamData%InterpOrder - DstParamData%NumCrctn = SrcParamData%NumCrctn - DstParamData%KMax = SrcParamData%KMax - DstParamData%numIceLegs = SrcParamData%numIceLegs - DstParamData%nBeams = SrcParamData%nBeams - DstParamData%BD_OutputSibling = SrcParamData%BD_OutputSibling - DstParamData%ModuleInitialized = SrcParamData%ModuleInitialized - DstParamData%DT_Ujac = SrcParamData%DT_Ujac - DstParamData%UJacSclFact = SrcParamData%UJacSclFact - DstParamData%SizeJac_Opt1 = SrcParamData%SizeJac_Opt1 - DstParamData%SolveOption = SrcParamData%SolveOption - DstParamData%CompElast = SrcParamData%CompElast - DstParamData%CompInflow = SrcParamData%CompInflow - DstParamData%CompAero = SrcParamData%CompAero - DstParamData%CompServo = SrcParamData%CompServo - DstParamData%CompSeaSt = SrcParamData%CompSeaSt - DstParamData%CompHydro = SrcParamData%CompHydro - DstParamData%CompSub = SrcParamData%CompSub - DstParamData%CompMooring = SrcParamData%CompMooring - DstParamData%CompIce = SrcParamData%CompIce - DstParamData%MHK = SrcParamData%MHK - DstParamData%UseDWM = SrcParamData%UseDWM - DstParamData%Linearize = SrcParamData%Linearize - DstParamData%WaveFieldMod = SrcParamData%WaveFieldMod - DstParamData%FarmIntegration = SrcParamData%FarmIntegration - DstParamData%TurbinePos = SrcParamData%TurbinePos - DstParamData%Gravity = SrcParamData%Gravity - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%WtrDens = SrcParamData%WtrDens - DstParamData%KinVisc = SrcParamData%KinVisc - DstParamData%SpdSound = SrcParamData%SpdSound - DstParamData%Patm = SrcParamData%Patm - DstParamData%Pvap = SrcParamData%Pvap - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%MSL2SWL = SrcParamData%MSL2SWL - DstParamData%EDFile = SrcParamData%EDFile - DstParamData%BDBldFile = SrcParamData%BDBldFile - DstParamData%InflowFile = SrcParamData%InflowFile - DstParamData%AeroFile = SrcParamData%AeroFile - DstParamData%ServoFile = SrcParamData%ServoFile - DstParamData%SeaStFile = SrcParamData%SeaStFile - DstParamData%HydroFile = SrcParamData%HydroFile - DstParamData%SubFile = SrcParamData%SubFile - DstParamData%MooringFile = SrcParamData%MooringFile - DstParamData%IceFile = SrcParamData%IceFile - DstParamData%TStart = SrcParamData%TStart - DstParamData%DT_Out = SrcParamData%DT_Out - DstParamData%WrSttsTime = SrcParamData%WrSttsTime - DstParamData%n_SttsTime = SrcParamData%n_SttsTime - DstParamData%n_ChkptTime = SrcParamData%n_ChkptTime - DstParamData%n_DT_Out = SrcParamData%n_DT_Out - DstParamData%n_VTKTime = SrcParamData%n_VTKTime - DstParamData%TurbineType = SrcParamData%TurbineType - DstParamData%WrBinOutFile = SrcParamData%WrBinOutFile - DstParamData%WrTxtOutFile = SrcParamData%WrTxtOutFile - DstParamData%WrBinMod = SrcParamData%WrBinMod - DstParamData%SumPrint = SrcParamData%SumPrint - DstParamData%WrVTK = SrcParamData%WrVTK - DstParamData%VTK_Type = SrcParamData%VTK_Type - DstParamData%VTK_fields = SrcParamData%VTK_fields - DstParamData%Delim = SrcParamData%Delim - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutFmt_t = SrcParamData%OutFmt_t - DstParamData%FmtWidth = SrcParamData%FmtWidth - DstParamData%TChanLen = SrcParamData%TChanLen - DstParamData%OutFileRoot = SrcParamData%OutFileRoot - DstParamData%FTitle = SrcParamData%FTitle - DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot - DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth - DstParamData%VTK_fps = SrcParamData%VTK_fps - CALL FAST_Copyvtk_surfacetype( SrcParamData%VTK_surface, DstParamData%VTK_surface, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%Tdesc = SrcParamData%Tdesc - DstParamData%CalcSteady = SrcParamData%CalcSteady - DstParamData%TrimCase = SrcParamData%TrimCase - DstParamData%TrimTol = SrcParamData%TrimTol - DstParamData%TrimGain = SrcParamData%TrimGain - DstParamData%Twr_Kdmp = SrcParamData%Twr_Kdmp - DstParamData%Bld_Kdmp = SrcParamData%Bld_Kdmp - DstParamData%NLinTimes = SrcParamData%NLinTimes - DstParamData%AzimDelta = SrcParamData%AzimDelta - DstParamData%LinInputs = SrcParamData%LinInputs - DstParamData%LinOutputs = SrcParamData%LinOutputs - DstParamData%LinOutJac = SrcParamData%LinOutJac - DstParamData%LinOutMod = SrcParamData%LinOutMod - CALL FAST_Copyvtk_modeshapetype( SrcParamData%VTK_modes, DstParamData%VTK_modes, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%UseSC = SrcParamData%UseSC - DstParamData%Lin_NumMods = SrcParamData%Lin_NumMods - DstParamData%Lin_ModOrder = SrcParamData%Lin_ModOrder - DstParamData%LinInterpOrder = SrcParamData%LinInterpOrder - END SUBROUTINE FAST_CopyParam - - SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(FAST_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 = 'FAST_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyParam - - SUBROUTINE FAST_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(FAST_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 = 'FAST_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 + SIZE(InData%DT_module) ! DT_module - Int_BufSz = Int_BufSz + SIZE(InData%n_substeps) ! n_substeps - Int_BufSz = Int_BufSz + 1 ! n_TMax_m1 - Db_BufSz = Db_BufSz + 1 ! TMax - Int_BufSz = Int_BufSz + 1 ! InterpOrder - Int_BufSz = Int_BufSz + 1 ! NumCrctn - Int_BufSz = Int_BufSz + 1 ! KMax - Int_BufSz = Int_BufSz + 1 ! numIceLegs - Int_BufSz = Int_BufSz + 1 ! nBeams - Int_BufSz = Int_BufSz + 1 ! BD_OutputSibling - Int_BufSz = Int_BufSz + SIZE(InData%ModuleInitialized) ! ModuleInitialized - Db_BufSz = Db_BufSz + 1 ! DT_Ujac - Re_BufSz = Re_BufSz + 1 ! UJacSclFact - Int_BufSz = Int_BufSz + SIZE(InData%SizeJac_Opt1) ! SizeJac_Opt1 - Int_BufSz = Int_BufSz + 1 ! SolveOption - Int_BufSz = Int_BufSz + 1 ! CompElast - Int_BufSz = Int_BufSz + 1 ! CompInflow - Int_BufSz = Int_BufSz + 1 ! CompAero - Int_BufSz = Int_BufSz + 1 ! CompServo - Int_BufSz = Int_BufSz + 1 ! CompSeaSt - Int_BufSz = Int_BufSz + 1 ! CompHydro - Int_BufSz = Int_BufSz + 1 ! CompSub - Int_BufSz = Int_BufSz + 1 ! CompMooring - Int_BufSz = Int_BufSz + 1 ! CompIce - Int_BufSz = Int_BufSz + 1 ! MHK - Int_BufSz = Int_BufSz + 1 ! UseDWM - Int_BufSz = Int_BufSz + 1 ! Linearize - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Int_BufSz = Int_BufSz + 1 ! FarmIntegration - Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Re_BufSz = Re_BufSz + 1 ! Patm - Re_BufSz = Re_BufSz + 1 ! Pvap - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1*LEN(InData%EDFile) ! EDFile - Int_BufSz = Int_BufSz + SIZE(InData%BDBldFile)*LEN(InData%BDBldFile) ! BDBldFile - Int_BufSz = Int_BufSz + 1*LEN(InData%InflowFile) ! InflowFile - Int_BufSz = Int_BufSz + 1*LEN(InData%AeroFile) ! AeroFile - Int_BufSz = Int_BufSz + 1*LEN(InData%ServoFile) ! ServoFile - Int_BufSz = Int_BufSz + 1*LEN(InData%SeaStFile) ! SeaStFile - Int_BufSz = Int_BufSz + 1*LEN(InData%HydroFile) ! HydroFile - Int_BufSz = Int_BufSz + 1*LEN(InData%SubFile) ! SubFile - Int_BufSz = Int_BufSz + 1*LEN(InData%MooringFile) ! MooringFile - Int_BufSz = Int_BufSz + 1*LEN(InData%IceFile) ! IceFile - Db_BufSz = Db_BufSz + 1 ! TStart - Db_BufSz = Db_BufSz + 1 ! DT_Out - Int_BufSz = Int_BufSz + 1 ! WrSttsTime - Int_BufSz = Int_BufSz + 1 ! n_SttsTime - Int_BufSz = Int_BufSz + 1 ! n_ChkptTime - Int_BufSz = Int_BufSz + 1 ! n_DT_Out - Int_BufSz = Int_BufSz + 1 ! n_VTKTime - Int_BufSz = Int_BufSz + 1 ! TurbineType - Int_BufSz = Int_BufSz + 1 ! WrBinOutFile - Int_BufSz = Int_BufSz + 1 ! WrTxtOutFile - Int_BufSz = Int_BufSz + 1 ! WrBinMod - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! WrVTK - Int_BufSz = Int_BufSz + 1 ! VTK_Type - Int_BufSz = Int_BufSz + 1 ! VTK_fields - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt_t) ! OutFmt_t - Int_BufSz = Int_BufSz + 1 ! FmtWidth - Int_BufSz = Int_BufSz + 1 ! TChanLen - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle - Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileRoot) ! VTK_OutFileRoot - Int_BufSz = Int_BufSz + 1 ! VTK_tWidth - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VTK_surface - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VTK_surface - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VTK_surface - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%Tdesc) ! Tdesc - Int_BufSz = Int_BufSz + 1 ! CalcSteady - Int_BufSz = Int_BufSz + 1 ! TrimCase - Re_BufSz = Re_BufSz + 1 ! TrimTol - Re_BufSz = Re_BufSz + 1 ! TrimGain - Re_BufSz = Re_BufSz + 1 ! Twr_Kdmp - Re_BufSz = Re_BufSz + 1 ! Bld_Kdmp - Int_BufSz = Int_BufSz + 1 ! NLinTimes - Db_BufSz = Db_BufSz + 1 ! AzimDelta - Int_BufSz = Int_BufSz + 1 ! LinInputs - Int_BufSz = Int_BufSz + 1 ! LinOutputs - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VTK_modes - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VTK_modes - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VTK_modes - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! UseSC - Int_BufSz = Int_BufSz + 1 ! Lin_NumMods - Int_BufSz = Int_BufSz + SIZE(InData%Lin_ModOrder) ! Lin_ModOrder - Int_BufSz = Int_BufSz + 1 ! LinInterpOrder - 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 - DO i1 = LBOUND(InData%DT_module,1), UBOUND(InData%DT_module,1) - DbKiBuf(Db_Xferred) = InData%DT_module(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%n_substeps,1), UBOUND(InData%n_substeps,1) - IntKiBuf(Int_Xferred) = InData%n_substeps(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%n_TMax_m1 - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InterpOrder - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCrctn - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%KMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numIceLegs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nBeams - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%BD_OutputSibling, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%ModuleInitialized,1), UBOUND(InData%ModuleInitialized,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%ModuleInitialized(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%DT_Ujac - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UJacSclFact - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%SizeJac_Opt1,1), UBOUND(InData%SizeJac_Opt1,1) - IntKiBuf(Int_Xferred) = InData%SizeJac_Opt1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%SolveOption - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompElast - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompInflow - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompAero - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompServo - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompSeaSt - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompHydro - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompSub - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompMooring - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompIce - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FarmIntegration, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) - ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%EDFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%EDFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%BDBldFile,1), UBOUND(InData%BDBldFile,1) - DO I = 1, LEN(InData%BDBldFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%BDBldFile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - DO I = 1, LEN(InData%InflowFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InflowFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%AeroFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AeroFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%ServoFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%ServoFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%SeaStFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SeaStFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HydroFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%HydroFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%SubFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SubFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%MooringFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%MooringFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%IceFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%IceFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%TStart - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT_Out - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrSttsTime, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_SttsTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_ChkptTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_DT_Out - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_VTKTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TurbineType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrBinOutFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrTxtOutFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrBinMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTK_Type - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%VTK_fields, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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%OutFmt_t) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_t(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%FmtWidth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TChanLen - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%FTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%VTK_OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%VTK_tWidth - 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 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 - DO I = 1, LEN(InData%Tdesc) - IntKiBuf(Int_Xferred) = ICHAR(InData%Tdesc(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%CalcSteady, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TrimCase - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TrimTol - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TrimGain - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Twr_Kdmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Bld_Kdmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NLinTimes - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%AzimDelta - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%LinInputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%LinOutputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutJac, IntKiBuf(1)) - 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 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) = TRANSFER(InData%UseSC, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Lin_NumMods - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%Lin_ModOrder,1), UBOUND(InData%Lin_ModOrder,1) - IntKiBuf(Int_Xferred) = InData%Lin_ModOrder(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%LinInterpOrder - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_PackParam - - SUBROUTINE FAST_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(FAST_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_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 - i1_l = LBOUND(OutData%DT_module,1) - i1_u = UBOUND(OutData%DT_module,1) - DO i1 = LBOUND(OutData%DT_module,1), UBOUND(OutData%DT_module,1) - OutData%DT_module(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%n_substeps,1) - i1_u = UBOUND(OutData%n_substeps,1) - DO i1 = LBOUND(OutData%n_substeps,1), UBOUND(OutData%n_substeps,1) - OutData%n_substeps(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%n_TMax_m1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%InterpOrder = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumCrctn = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%KMax = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%numIceLegs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nBeams = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BD_OutputSibling = TRANSFER(IntKiBuf(Int_Xferred), OutData%BD_OutputSibling) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%ModuleInitialized,1) - i1_u = UBOUND(OutData%ModuleInitialized,1) - DO i1 = LBOUND(OutData%ModuleInitialized,1), UBOUND(OutData%ModuleInitialized,1) - OutData%ModuleInitialized(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ModuleInitialized(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%DT_Ujac = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%UJacSclFact = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%SizeJac_Opt1,1) - i1_u = UBOUND(OutData%SizeJac_Opt1,1) - DO i1 = LBOUND(OutData%SizeJac_Opt1,1), UBOUND(OutData%SizeJac_Opt1,1) - OutData%SizeJac_Opt1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%SolveOption = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompElast = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompInflow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompAero = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompServo = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompSeaSt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompHydro = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompSub = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompMooring = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompIce = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) - Int_Xferred = Int_Xferred + 1 - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FarmIntegration = TRANSFER(IntKiBuf(Int_Xferred), OutData%FarmIntegration) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TurbinePos,1) - i1_u = UBOUND(OutData%TurbinePos,1) - DO i1 = LBOUND(OutData%TurbinePos,1), UBOUND(OutData%TurbinePos,1) - OutData%TurbinePos(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = 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 - DO I = 1, LEN(OutData%EDFile) - OutData%EDFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%BDBldFile,1) - i1_u = UBOUND(OutData%BDBldFile,1) - DO i1 = LBOUND(OutData%BDBldFile,1), UBOUND(OutData%BDBldFile,1) - DO I = 1, LEN(OutData%BDBldFile) - OutData%BDBldFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - DO I = 1, LEN(OutData%InflowFile) - OutData%InflowFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%AeroFile) - OutData%AeroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%ServoFile) - OutData%ServoFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%SeaStFile) - OutData%SeaStFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HydroFile) - OutData%HydroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%SubFile) - OutData%SubFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%MooringFile) - OutData%MooringFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%IceFile) - OutData%IceFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TStart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DT_Out = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WrSttsTime = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrSttsTime) - Int_Xferred = Int_Xferred + 1 - OutData%n_SttsTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_ChkptTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_DT_Out = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_VTKTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrBinOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrBinOutFile) - Int_Xferred = Int_Xferred + 1 - OutData%WrTxtOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrTxtOutFile) - Int_Xferred = Int_Xferred + 1 - OutData%WrBinMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_Type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_fields = TRANSFER(IntKiBuf(Int_Xferred), OutData%VTK_fields) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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%OutFmt_t) - OutData%OutFmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%FmtWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TChanLen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%FTitle) - OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%VTK_OutFileRoot) - OutData%VTK_OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%VTK_tWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_fps = DbKiBuf(Db_Xferred) - Db_Xferred = Db_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 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 - - 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%Tdesc) - OutData%Tdesc(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CalcSteady = TRANSFER(IntKiBuf(Int_Xferred), OutData%CalcSteady) - Int_Xferred = Int_Xferred + 1 - OutData%TrimCase = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TrimTol = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TrimGain = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Twr_Kdmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Bld_Kdmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NLinTimes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AzimDelta = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%LinInputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutJac = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutJac) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutMod) - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%UseSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseSC) - Int_Xferred = Int_Xferred + 1 - OutData%Lin_NumMods = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%Lin_ModOrder,1) - i1_u = UBOUND(OutData%Lin_ModOrder,1) - DO i1 = LBOUND(OutData%Lin_ModOrder,1), UBOUND(OutData%Lin_ModOrder,1) - OutData%Lin_ModOrder(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%LinInterpOrder = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_UnPackParam - - SUBROUTINE FAST_CopyLinStateSave( SrcLinStateSaveData, DstLinStateSaveData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_LinStateSave), INTENT(INOUT) :: SrcLinStateSaveData - TYPE(FAST_LinStateSave), INTENT(INOUT) :: DstLinStateSaveData - 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 = 'FAST_CopyLinStateSave' -! + ErrMsg = '' + DstVTK_SurfaceTypeData%NumSectors = SrcVTK_SurfaceTypeData%NumSectors + DstVTK_SurfaceTypeData%HubRad = SrcVTK_SurfaceTypeData%HubRad + DstVTK_SurfaceTypeData%GroundRad = SrcVTK_SurfaceTypeData%GroundRad + DstVTK_SurfaceTypeData%NacelleBox = SrcVTK_SurfaceTypeData%NacelleBox + if (allocated(SrcVTK_SurfaceTypeData%TowerRad)) then + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%TowerRad) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%TowerRad) + if (.not. allocated(DstVTK_SurfaceTypeData%TowerRad)) then + allocate(DstVTK_SurfaceTypeData%TowerRad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%TowerRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_SurfaceTypeData%TowerRad = SrcVTK_SurfaceTypeData%TowerRad + end if + DstVTK_SurfaceTypeData%NWaveElevPts = SrcVTK_SurfaceTypeData%NWaveElevPts + if (allocated(SrcVTK_SurfaceTypeData%WaveElevXY)) then + LB(1:2) = lbound(SrcVTK_SurfaceTypeData%WaveElevXY) + UB(1:2) = ubound(SrcVTK_SurfaceTypeData%WaveElevXY) + if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevXY)) then + allocate(DstVTK_SurfaceTypeData%WaveElevXY(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElevXY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_SurfaceTypeData%WaveElevXY = SrcVTK_SurfaceTypeData%WaveElevXY + end if + if (allocated(SrcVTK_SurfaceTypeData%WaveElev)) then + LB(1:2) = lbound(SrcVTK_SurfaceTypeData%WaveElev) + UB(1:2) = ubound(SrcVTK_SurfaceTypeData%WaveElev) + if (.not. allocated(DstVTK_SurfaceTypeData%WaveElev)) then + allocate(DstVTK_SurfaceTypeData%WaveElev(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_SurfaceTypeData%WaveElev = SrcVTK_SurfaceTypeData%WaveElev + end if + if (allocated(SrcVTK_SurfaceTypeData%BladeShape)) then + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%BladeShape) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%BladeShape) + if (.not. allocated(DstVTK_SurfaceTypeData%BladeShape)) then + allocate(DstVTK_SurfaceTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%BladeShape.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FAST_CopyVTK_BLSurfaceType(SrcVTK_SurfaceTypeData%BladeShape(i1), DstVTK_SurfaceTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcVTK_SurfaceTypeData%MorisonRad)) then + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%MorisonRad) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%MorisonRad) + if (.not. allocated(DstVTK_SurfaceTypeData%MorisonRad)) then + allocate(DstVTK_SurfaceTypeData%MorisonRad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%MorisonRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_SurfaceTypeData%MorisonRad = SrcVTK_SurfaceTypeData%MorisonRad + end if +end subroutine + +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 + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyVTK_SurfaceType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcLinStateSaveData%x_IceD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_IceD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_IceD,1) - i2_l = LBOUND(SrcLinStateSaveData%x_IceD,2) - i2_u = UBOUND(SrcLinStateSaveData%x_IceD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_IceD)) THEN - ALLOCATE(DstLinStateSaveData%x_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%x_IceD,2), UBOUND(SrcLinStateSaveData%x_IceD,2) - DO i1 = LBOUND(SrcLinStateSaveData%x_IceD,1), UBOUND(SrcLinStateSaveData%x_IceD,1) - CALL IceD_CopyContState( SrcLinStateSaveData%x_IceD(i1,i2), DstLinStateSaveData%x_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_IceD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_IceD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_IceD,1) - i2_l = LBOUND(SrcLinStateSaveData%xd_IceD,2) - i2_u = UBOUND(SrcLinStateSaveData%xd_IceD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_IceD)) THEN - ALLOCATE(DstLinStateSaveData%xd_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%xd_IceD,2), UBOUND(SrcLinStateSaveData%xd_IceD,2) - DO i1 = LBOUND(SrcLinStateSaveData%xd_IceD,1), UBOUND(SrcLinStateSaveData%xd_IceD,1) - CALL IceD_CopyDiscState( SrcLinStateSaveData%xd_IceD(i1,i2), DstLinStateSaveData%xd_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_IceD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_IceD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_IceD,1) - i2_l = LBOUND(SrcLinStateSaveData%z_IceD,2) - i2_u = UBOUND(SrcLinStateSaveData%z_IceD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_IceD)) THEN - ALLOCATE(DstLinStateSaveData%z_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%z_IceD,2), UBOUND(SrcLinStateSaveData%z_IceD,2) - DO i1 = LBOUND(SrcLinStateSaveData%z_IceD,1), UBOUND(SrcLinStateSaveData%z_IceD,1) - CALL IceD_CopyConstrState( SrcLinStateSaveData%z_IceD(i1,i2), DstLinStateSaveData%z_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_IceD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_IceD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_IceD,1) - i2_l = LBOUND(SrcLinStateSaveData%OtherSt_IceD,2) - i2_u = UBOUND(SrcLinStateSaveData%OtherSt_IceD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_IceD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%OtherSt_IceD,2), UBOUND(SrcLinStateSaveData%OtherSt_IceD,2) - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_IceD,1), UBOUND(SrcLinStateSaveData%OtherSt_IceD,1) - CALL IceD_CopyOtherState( SrcLinStateSaveData%OtherSt_IceD(i1,i2), DstLinStateSaveData%OtherSt_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_IceD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_IceD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_IceD,1) - i2_l = LBOUND(SrcLinStateSaveData%u_IceD,2) - i2_u = UBOUND(SrcLinStateSaveData%u_IceD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_IceD)) THEN - ALLOCATE(DstLinStateSaveData%u_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%u_IceD,2), UBOUND(SrcLinStateSaveData%u_IceD,2) - DO i1 = LBOUND(SrcLinStateSaveData%u_IceD,1), UBOUND(SrcLinStateSaveData%u_IceD,1) - CALL IceD_CopyInput( SrcLinStateSaveData%u_IceD(i1,i2), DstLinStateSaveData%u_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_BD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_BD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_BD,1) - i2_l = LBOUND(SrcLinStateSaveData%x_BD,2) - i2_u = UBOUND(SrcLinStateSaveData%x_BD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_BD)) THEN - ALLOCATE(DstLinStateSaveData%x_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%x_BD,2), UBOUND(SrcLinStateSaveData%x_BD,2) - DO i1 = LBOUND(SrcLinStateSaveData%x_BD,1), UBOUND(SrcLinStateSaveData%x_BD,1) - CALL BD_CopyContState( SrcLinStateSaveData%x_BD(i1,i2), DstLinStateSaveData%x_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_BD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_BD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_BD,1) - i2_l = LBOUND(SrcLinStateSaveData%xd_BD,2) - i2_u = UBOUND(SrcLinStateSaveData%xd_BD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_BD)) THEN - ALLOCATE(DstLinStateSaveData%xd_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%xd_BD,2), UBOUND(SrcLinStateSaveData%xd_BD,2) - DO i1 = LBOUND(SrcLinStateSaveData%xd_BD,1), UBOUND(SrcLinStateSaveData%xd_BD,1) - CALL BD_CopyDiscState( SrcLinStateSaveData%xd_BD(i1,i2), DstLinStateSaveData%xd_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_BD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_BD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_BD,1) - i2_l = LBOUND(SrcLinStateSaveData%z_BD,2) - i2_u = UBOUND(SrcLinStateSaveData%z_BD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_BD)) THEN - ALLOCATE(DstLinStateSaveData%z_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%z_BD,2), UBOUND(SrcLinStateSaveData%z_BD,2) - DO i1 = LBOUND(SrcLinStateSaveData%z_BD,1), UBOUND(SrcLinStateSaveData%z_BD,1) - CALL BD_CopyConstrState( SrcLinStateSaveData%z_BD(i1,i2), DstLinStateSaveData%z_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_BD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_BD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_BD,1) - i2_l = LBOUND(SrcLinStateSaveData%OtherSt_BD,2) - i2_u = UBOUND(SrcLinStateSaveData%OtherSt_BD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_BD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%OtherSt_BD,2), UBOUND(SrcLinStateSaveData%OtherSt_BD,2) - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_BD,1), UBOUND(SrcLinStateSaveData%OtherSt_BD,1) - CALL BD_CopyOtherState( SrcLinStateSaveData%OtherSt_BD(i1,i2), DstLinStateSaveData%OtherSt_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_BD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_BD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_BD,1) - i2_l = LBOUND(SrcLinStateSaveData%u_BD,2) - i2_u = UBOUND(SrcLinStateSaveData%u_BD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_BD)) THEN - ALLOCATE(DstLinStateSaveData%u_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%u_BD,2), UBOUND(SrcLinStateSaveData%u_BD,2) - DO i1 = LBOUND(SrcLinStateSaveData%u_BD,1), UBOUND(SrcLinStateSaveData%u_BD,1) - CALL BD_CopyInput( SrcLinStateSaveData%u_BD(i1,i2), DstLinStateSaveData%u_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_ED)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_ED,1) - i1_u = UBOUND(SrcLinStateSaveData%x_ED,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_ED)) THEN - ALLOCATE(DstLinStateSaveData%x_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_ED,1), UBOUND(SrcLinStateSaveData%x_ED,1) - CALL ED_CopyContState( SrcLinStateSaveData%x_ED(i1), DstLinStateSaveData%x_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_ED)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_ED,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_ED,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_ED)) THEN - ALLOCATE(DstLinStateSaveData%xd_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_ED,1), UBOUND(SrcLinStateSaveData%xd_ED,1) - CALL ED_CopyDiscState( SrcLinStateSaveData%xd_ED(i1), DstLinStateSaveData%xd_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_ED)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_ED,1) - i1_u = UBOUND(SrcLinStateSaveData%z_ED,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_ED)) THEN - ALLOCATE(DstLinStateSaveData%z_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_ED,1), UBOUND(SrcLinStateSaveData%z_ED,1) - CALL ED_CopyConstrState( SrcLinStateSaveData%z_ED(i1), DstLinStateSaveData%z_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_ED)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_ED,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_ED,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_ED)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_ED,1), UBOUND(SrcLinStateSaveData%OtherSt_ED,1) - CALL ED_CopyOtherState( SrcLinStateSaveData%OtherSt_ED(i1), DstLinStateSaveData%OtherSt_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_ED)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_ED,1) - i1_u = UBOUND(SrcLinStateSaveData%u_ED,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_ED)) THEN - ALLOCATE(DstLinStateSaveData%u_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_ED,1), UBOUND(SrcLinStateSaveData%u_ED,1) - CALL ED_CopyInput( SrcLinStateSaveData%u_ED(i1), DstLinStateSaveData%u_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_SrvD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_SrvD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_SrvD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_SrvD)) THEN - ALLOCATE(DstLinStateSaveData%x_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_SrvD,1), UBOUND(SrcLinStateSaveData%x_SrvD,1) - CALL SrvD_CopyContState( SrcLinStateSaveData%x_SrvD(i1), DstLinStateSaveData%x_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_SrvD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_SrvD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_SrvD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_SrvD)) THEN - ALLOCATE(DstLinStateSaveData%xd_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_SrvD,1), UBOUND(SrcLinStateSaveData%xd_SrvD,1) - CALL SrvD_CopyDiscState( SrcLinStateSaveData%xd_SrvD(i1), DstLinStateSaveData%xd_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_SrvD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_SrvD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_SrvD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_SrvD)) THEN - ALLOCATE(DstLinStateSaveData%z_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_SrvD,1), UBOUND(SrcLinStateSaveData%z_SrvD,1) - CALL SrvD_CopyConstrState( SrcLinStateSaveData%z_SrvD(i1), DstLinStateSaveData%z_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_SrvD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_SrvD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_SrvD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_SrvD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_SrvD,1), UBOUND(SrcLinStateSaveData%OtherSt_SrvD,1) - CALL SrvD_CopyOtherState( SrcLinStateSaveData%OtherSt_SrvD(i1), DstLinStateSaveData%OtherSt_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_SrvD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_SrvD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_SrvD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_SrvD)) THEN - ALLOCATE(DstLinStateSaveData%u_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_SrvD,1), UBOUND(SrcLinStateSaveData%u_SrvD,1) - CALL SrvD_CopyInput( SrcLinStateSaveData%u_SrvD(i1), DstLinStateSaveData%u_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_AD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_AD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_AD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_AD)) THEN - ALLOCATE(DstLinStateSaveData%x_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_AD,1), UBOUND(SrcLinStateSaveData%x_AD,1) - CALL AD_CopyContState( SrcLinStateSaveData%x_AD(i1), DstLinStateSaveData%x_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_AD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_AD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_AD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_AD)) THEN - ALLOCATE(DstLinStateSaveData%xd_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_AD,1), UBOUND(SrcLinStateSaveData%xd_AD,1) - CALL AD_CopyDiscState( SrcLinStateSaveData%xd_AD(i1), DstLinStateSaveData%xd_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_AD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_AD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_AD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_AD)) THEN - ALLOCATE(DstLinStateSaveData%z_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_AD,1), UBOUND(SrcLinStateSaveData%z_AD,1) - CALL AD_CopyConstrState( SrcLinStateSaveData%z_AD(i1), DstLinStateSaveData%z_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_AD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_AD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_AD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_AD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_AD,1), UBOUND(SrcLinStateSaveData%OtherSt_AD,1) - CALL AD_CopyOtherState( SrcLinStateSaveData%OtherSt_AD(i1), DstLinStateSaveData%OtherSt_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_AD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_AD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_AD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_AD)) THEN - ALLOCATE(DstLinStateSaveData%u_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_AD,1), UBOUND(SrcLinStateSaveData%u_AD,1) - CALL AD_CopyInput( SrcLinStateSaveData%u_AD(i1), DstLinStateSaveData%u_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_IfW)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_IfW,1) - i1_u = UBOUND(SrcLinStateSaveData%x_IfW,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_IfW)) THEN - ALLOCATE(DstLinStateSaveData%x_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_IfW,1), UBOUND(SrcLinStateSaveData%x_IfW,1) - CALL InflowWind_CopyContState( SrcLinStateSaveData%x_IfW(i1), DstLinStateSaveData%x_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_IfW)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_IfW,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_IfW,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_IfW)) THEN - ALLOCATE(DstLinStateSaveData%xd_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_IfW,1), UBOUND(SrcLinStateSaveData%xd_IfW,1) - CALL InflowWind_CopyDiscState( SrcLinStateSaveData%xd_IfW(i1), DstLinStateSaveData%xd_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_IfW)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_IfW,1) - i1_u = UBOUND(SrcLinStateSaveData%z_IfW,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_IfW)) THEN - ALLOCATE(DstLinStateSaveData%z_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_IfW,1), UBOUND(SrcLinStateSaveData%z_IfW,1) - CALL InflowWind_CopyConstrState( SrcLinStateSaveData%z_IfW(i1), DstLinStateSaveData%z_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_IfW)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_IfW,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_IfW,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_IfW)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_IfW,1), UBOUND(SrcLinStateSaveData%OtherSt_IfW,1) - CALL InflowWind_CopyOtherState( SrcLinStateSaveData%OtherSt_IfW(i1), DstLinStateSaveData%OtherSt_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_IfW)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_IfW,1) - i1_u = UBOUND(SrcLinStateSaveData%u_IfW,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_IfW)) THEN - ALLOCATE(DstLinStateSaveData%u_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_IfW,1), UBOUND(SrcLinStateSaveData%u_IfW,1) - CALL InflowWind_CopyInput( SrcLinStateSaveData%u_IfW(i1), DstLinStateSaveData%u_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_SD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_SD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_SD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_SD)) THEN - ALLOCATE(DstLinStateSaveData%x_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_SD,1), UBOUND(SrcLinStateSaveData%x_SD,1) - CALL SD_CopyContState( SrcLinStateSaveData%x_SD(i1), DstLinStateSaveData%x_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_SD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_SD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_SD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_SD)) THEN - ALLOCATE(DstLinStateSaveData%xd_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_SD,1), UBOUND(SrcLinStateSaveData%xd_SD,1) - CALL SD_CopyDiscState( SrcLinStateSaveData%xd_SD(i1), DstLinStateSaveData%xd_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_SD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_SD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_SD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_SD)) THEN - ALLOCATE(DstLinStateSaveData%z_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_SD,1), UBOUND(SrcLinStateSaveData%z_SD,1) - CALL SD_CopyConstrState( SrcLinStateSaveData%z_SD(i1), DstLinStateSaveData%z_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_SD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_SD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_SD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_SD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_SD,1), UBOUND(SrcLinStateSaveData%OtherSt_SD,1) - CALL SD_CopyOtherState( SrcLinStateSaveData%OtherSt_SD(i1), DstLinStateSaveData%OtherSt_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_SD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_SD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_SD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_SD)) THEN - ALLOCATE(DstLinStateSaveData%u_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_SD,1), UBOUND(SrcLinStateSaveData%u_SD,1) - CALL SD_CopyInput( SrcLinStateSaveData%u_SD(i1), DstLinStateSaveData%u_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_ExtPtfm)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_ExtPtfm,1) - i1_u = UBOUND(SrcLinStateSaveData%x_ExtPtfm,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_ExtPtfm)) THEN - ALLOCATE(DstLinStateSaveData%x_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_ExtPtfm,1), UBOUND(SrcLinStateSaveData%x_ExtPtfm,1) - CALL ExtPtfm_CopyContState( SrcLinStateSaveData%x_ExtPtfm(i1), DstLinStateSaveData%x_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_ExtPtfm)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_ExtPtfm,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_ExtPtfm,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_ExtPtfm)) THEN - ALLOCATE(DstLinStateSaveData%xd_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_ExtPtfm,1), UBOUND(SrcLinStateSaveData%xd_ExtPtfm,1) - CALL ExtPtfm_CopyDiscState( SrcLinStateSaveData%xd_ExtPtfm(i1), DstLinStateSaveData%xd_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_ExtPtfm)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_ExtPtfm,1) - i1_u = UBOUND(SrcLinStateSaveData%z_ExtPtfm,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_ExtPtfm)) THEN - ALLOCATE(DstLinStateSaveData%z_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_ExtPtfm,1), UBOUND(SrcLinStateSaveData%z_ExtPtfm,1) - CALL ExtPtfm_CopyConstrState( SrcLinStateSaveData%z_ExtPtfm(i1), DstLinStateSaveData%z_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_ExtPtfm)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_ExtPtfm)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1), UBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1) - CALL ExtPtfm_CopyOtherState( SrcLinStateSaveData%OtherSt_ExtPtfm(i1), DstLinStateSaveData%OtherSt_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_ExtPtfm)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_ExtPtfm,1) - i1_u = UBOUND(SrcLinStateSaveData%u_ExtPtfm,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_ExtPtfm)) THEN - ALLOCATE(DstLinStateSaveData%u_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_ExtPtfm,1), UBOUND(SrcLinStateSaveData%u_ExtPtfm,1) - CALL ExtPtfm_CopyInput( SrcLinStateSaveData%u_ExtPtfm(i1), DstLinStateSaveData%u_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_HD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_HD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_HD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_HD)) THEN - ALLOCATE(DstLinStateSaveData%x_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_HD,1), UBOUND(SrcLinStateSaveData%x_HD,1) - CALL HydroDyn_CopyContState( SrcLinStateSaveData%x_HD(i1), DstLinStateSaveData%x_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_HD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_HD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_HD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_HD)) THEN - ALLOCATE(DstLinStateSaveData%xd_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_HD,1), UBOUND(SrcLinStateSaveData%xd_HD,1) - CALL HydroDyn_CopyDiscState( SrcLinStateSaveData%xd_HD(i1), DstLinStateSaveData%xd_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_HD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_HD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_HD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_HD)) THEN - ALLOCATE(DstLinStateSaveData%z_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_HD,1), UBOUND(SrcLinStateSaveData%z_HD,1) - CALL HydroDyn_CopyConstrState( SrcLinStateSaveData%z_HD(i1), DstLinStateSaveData%z_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_HD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_HD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_HD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_HD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_HD,1), UBOUND(SrcLinStateSaveData%OtherSt_HD,1) - CALL HydroDyn_CopyOtherState( SrcLinStateSaveData%OtherSt_HD(i1), DstLinStateSaveData%OtherSt_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_HD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_HD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_HD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_HD)) THEN - ALLOCATE(DstLinStateSaveData%u_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_HD,1), UBOUND(SrcLinStateSaveData%u_HD,1) - CALL HydroDyn_CopyInput( SrcLinStateSaveData%u_HD(i1), DstLinStateSaveData%u_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_IceF)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_IceF,1) - i1_u = UBOUND(SrcLinStateSaveData%x_IceF,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_IceF)) THEN - ALLOCATE(DstLinStateSaveData%x_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_IceF,1), UBOUND(SrcLinStateSaveData%x_IceF,1) - CALL IceFloe_CopyContState( SrcLinStateSaveData%x_IceF(i1), DstLinStateSaveData%x_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_IceF)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_IceF,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_IceF,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_IceF)) THEN - ALLOCATE(DstLinStateSaveData%xd_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_IceF,1), UBOUND(SrcLinStateSaveData%xd_IceF,1) - CALL IceFloe_CopyDiscState( SrcLinStateSaveData%xd_IceF(i1), DstLinStateSaveData%xd_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_IceF)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_IceF,1) - i1_u = UBOUND(SrcLinStateSaveData%z_IceF,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_IceF)) THEN - ALLOCATE(DstLinStateSaveData%z_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_IceF,1), UBOUND(SrcLinStateSaveData%z_IceF,1) - CALL IceFloe_CopyConstrState( SrcLinStateSaveData%z_IceF(i1), DstLinStateSaveData%z_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_IceF)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_IceF,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_IceF,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_IceF)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_IceF,1), UBOUND(SrcLinStateSaveData%OtherSt_IceF,1) - CALL IceFloe_CopyOtherState( SrcLinStateSaveData%OtherSt_IceF(i1), DstLinStateSaveData%OtherSt_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_IceF)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_IceF,1) - i1_u = UBOUND(SrcLinStateSaveData%u_IceF,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_IceF)) THEN - ALLOCATE(DstLinStateSaveData%u_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_IceF,1), UBOUND(SrcLinStateSaveData%u_IceF,1) - CALL IceFloe_CopyInput( SrcLinStateSaveData%u_IceF(i1), DstLinStateSaveData%u_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_MAP)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_MAP,1) - i1_u = UBOUND(SrcLinStateSaveData%x_MAP,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_MAP)) THEN - ALLOCATE(DstLinStateSaveData%x_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_MAP,1), UBOUND(SrcLinStateSaveData%x_MAP,1) - CALL MAP_CopyContState( SrcLinStateSaveData%x_MAP(i1), DstLinStateSaveData%x_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_MAP)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_MAP,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_MAP,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_MAP)) THEN - ALLOCATE(DstLinStateSaveData%xd_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_MAP,1), UBOUND(SrcLinStateSaveData%xd_MAP,1) - CALL MAP_CopyDiscState( SrcLinStateSaveData%xd_MAP(i1), DstLinStateSaveData%xd_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_MAP)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_MAP,1) - i1_u = UBOUND(SrcLinStateSaveData%z_MAP,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_MAP)) THEN - ALLOCATE(DstLinStateSaveData%z_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_MAP,1), UBOUND(SrcLinStateSaveData%z_MAP,1) - CALL MAP_CopyConstrState( SrcLinStateSaveData%z_MAP(i1), DstLinStateSaveData%z_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_MAP)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_MAP,1) - i1_u = UBOUND(SrcLinStateSaveData%u_MAP,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_MAP)) THEN - ALLOCATE(DstLinStateSaveData%u_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_MAP,1), UBOUND(SrcLinStateSaveData%u_MAP,1) - CALL MAP_CopyInput( SrcLinStateSaveData%u_MAP(i1), DstLinStateSaveData%u_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_FEAM)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_FEAM,1) - i1_u = UBOUND(SrcLinStateSaveData%x_FEAM,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_FEAM)) THEN - ALLOCATE(DstLinStateSaveData%x_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_FEAM,1), UBOUND(SrcLinStateSaveData%x_FEAM,1) - CALL FEAM_CopyContState( SrcLinStateSaveData%x_FEAM(i1), DstLinStateSaveData%x_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_FEAM)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_FEAM,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_FEAM,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_FEAM)) THEN - ALLOCATE(DstLinStateSaveData%xd_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_FEAM,1), UBOUND(SrcLinStateSaveData%xd_FEAM,1) - CALL FEAM_CopyDiscState( SrcLinStateSaveData%xd_FEAM(i1), DstLinStateSaveData%xd_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_FEAM)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_FEAM,1) - i1_u = UBOUND(SrcLinStateSaveData%z_FEAM,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_FEAM)) THEN - ALLOCATE(DstLinStateSaveData%z_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_FEAM,1), UBOUND(SrcLinStateSaveData%z_FEAM,1) - CALL FEAM_CopyConstrState( SrcLinStateSaveData%z_FEAM(i1), DstLinStateSaveData%z_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_FEAM)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_FEAM,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_FEAM,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_FEAM)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_FEAM,1), UBOUND(SrcLinStateSaveData%OtherSt_FEAM,1) - CALL FEAM_CopyOtherState( SrcLinStateSaveData%OtherSt_FEAM(i1), DstLinStateSaveData%OtherSt_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_FEAM)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_FEAM,1) - i1_u = UBOUND(SrcLinStateSaveData%u_FEAM,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_FEAM)) THEN - ALLOCATE(DstLinStateSaveData%u_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_FEAM,1), UBOUND(SrcLinStateSaveData%u_FEAM,1) - CALL FEAM_CopyInput( SrcLinStateSaveData%u_FEAM(i1), DstLinStateSaveData%u_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_MD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_MD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_MD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_MD)) THEN - ALLOCATE(DstLinStateSaveData%x_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_MD,1), UBOUND(SrcLinStateSaveData%x_MD,1) - CALL MD_CopyContState( SrcLinStateSaveData%x_MD(i1), DstLinStateSaveData%x_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_MD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_MD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_MD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_MD)) THEN - ALLOCATE(DstLinStateSaveData%xd_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_MD,1), UBOUND(SrcLinStateSaveData%xd_MD,1) - CALL MD_CopyDiscState( SrcLinStateSaveData%xd_MD(i1), DstLinStateSaveData%xd_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_MD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_MD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_MD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_MD)) THEN - ALLOCATE(DstLinStateSaveData%z_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_MD,1), UBOUND(SrcLinStateSaveData%z_MD,1) - CALL MD_CopyConstrState( SrcLinStateSaveData%z_MD(i1), DstLinStateSaveData%z_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_MD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_MD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_MD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_MD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_MD,1), UBOUND(SrcLinStateSaveData%OtherSt_MD,1) - CALL MD_CopyOtherState( SrcLinStateSaveData%OtherSt_MD(i1), DstLinStateSaveData%OtherSt_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_MD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_MD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_MD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_MD)) THEN - ALLOCATE(DstLinStateSaveData%u_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_MD,1), UBOUND(SrcLinStateSaveData%u_MD,1) - CALL MD_CopyInput( SrcLinStateSaveData%u_MD(i1), DstLinStateSaveData%u_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FAST_CopyLinStateSave - - SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) - TYPE(FAST_LinStateSave), INTENT(INOUT) :: LinStateSaveData - 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 = 'FAST_DestroyLinStateSave' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%x_IceD) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%xd_IceD) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%z_IceD) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_IceD) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%u_IceD) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%x_BD) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%xd_BD) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%z_BD) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_BD) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%u_BD) -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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_MD) -ENDIF - END SUBROUTINE FAST_DestroyLinStateSave - - SUBROUTINE FAST_PackLinStateSave( 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(FAST_LinStateSave), 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 = 'FAST_PackLinStateSave' - ! 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 ! x_IceD allocated yes/no - IF ( ALLOCATED(InData%x_IceD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x_IceD upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%x_IceD,2), UBOUND(InData%x_IceD,2) - DO i1 = LBOUND(InData%x_IceD,1), UBOUND(InData%x_IceD,1) - Int_BufSz = Int_BufSz + 3 ! x_IceD: size of buffers for each call to pack subtype - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_IceD allocated yes/no - IF ( ALLOCATED(InData%xd_IceD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd_IceD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd_IceD,2), UBOUND(InData%xd_IceD,2) - DO i1 = LBOUND(InData%xd_IceD,1), UBOUND(InData%xd_IceD,1) - Int_BufSz = Int_BufSz + 3 ! xd_IceD: size of buffers for each call to pack subtype - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_IceD allocated yes/no - IF ( ALLOCATED(InData%z_IceD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z_IceD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z_IceD,2), UBOUND(InData%z_IceD,2) - DO i1 = LBOUND(InData%z_IceD,1), UBOUND(InData%z_IceD,1) - Int_BufSz = Int_BufSz + 3 ! z_IceD: size of buffers for each call to pack subtype - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_IceD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_IceD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt_IceD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt_IceD,2), UBOUND(InData%OtherSt_IceD,2) - DO i1 = LBOUND(InData%OtherSt_IceD,1), UBOUND(InData%OtherSt_IceD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_IceD: size of buffers for each call to pack subtype - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_IceD allocated yes/no - IF ( ALLOCATED(InData%u_IceD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_IceD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_IceD,2), UBOUND(InData%u_IceD,2) - DO i1 = LBOUND(InData%u_IceD,1), UBOUND(InData%u_IceD,1) - Int_BufSz = Int_BufSz + 3 ! u_IceD: size of buffers for each call to pack subtype - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_BD allocated yes/no - IF ( ALLOCATED(InData%x_BD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x_BD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%x_BD,2), UBOUND(InData%x_BD,2) - DO i1 = LBOUND(InData%x_BD,1), UBOUND(InData%x_BD,1) - Int_BufSz = Int_BufSz + 3 ! x_BD: size of buffers for each call to pack subtype - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_BD allocated yes/no - IF ( ALLOCATED(InData%xd_BD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd_BD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd_BD,2), UBOUND(InData%xd_BD,2) - DO i1 = LBOUND(InData%xd_BD,1), UBOUND(InData%xd_BD,1) - Int_BufSz = Int_BufSz + 3 ! xd_BD: size of buffers for each call to pack subtype - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_BD allocated yes/no - IF ( ALLOCATED(InData%z_BD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z_BD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z_BD,2), UBOUND(InData%z_BD,2) - DO i1 = LBOUND(InData%z_BD,1), UBOUND(InData%z_BD,1) - Int_BufSz = Int_BufSz + 3 ! z_BD: size of buffers for each call to pack subtype - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_BD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_BD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt_BD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt_BD,2), UBOUND(InData%OtherSt_BD,2) - DO i1 = LBOUND(InData%OtherSt_BD,1), UBOUND(InData%OtherSt_BD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_BD: size of buffers for each call to pack subtype - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_BD allocated yes/no - IF ( ALLOCATED(InData%u_BD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_BD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_BD,2), UBOUND(InData%u_BD,2) - DO i1 = LBOUND(InData%u_BD,1), UBOUND(InData%u_BD,1) - Int_BufSz = Int_BufSz + 3 ! u_BD: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_ED allocated yes/no - IF ( ALLOCATED(InData%x_ED) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_ED upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_ED,1), UBOUND(InData%x_ED,1) - Int_BufSz = Int_BufSz + 3 ! x_ED: size of buffers for each call to pack subtype - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_ED allocated yes/no - IF ( ALLOCATED(InData%xd_ED) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_ED upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_ED,1), UBOUND(InData%xd_ED,1) - Int_BufSz = Int_BufSz + 3 ! xd_ED: size of buffers for each call to pack subtype - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_ED allocated yes/no - IF ( ALLOCATED(InData%z_ED) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_ED upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_ED,1), UBOUND(InData%z_ED,1) - Int_BufSz = Int_BufSz + 3 ! z_ED: size of buffers for each call to pack subtype - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_ED allocated yes/no - IF ( ALLOCATED(InData%OtherSt_ED) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_ED upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_ED,1), UBOUND(InData%OtherSt_ED,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_ED: size of buffers for each call to pack subtype - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_ED allocated yes/no - IF ( ALLOCATED(InData%u_ED) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_ED upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_ED,1), UBOUND(InData%u_ED,1) - Int_BufSz = Int_BufSz + 3 ! u_ED: size of buffers for each call to pack subtype - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_SrvD allocated yes/no - IF ( ALLOCATED(InData%x_SrvD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_SrvD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_SrvD,1), UBOUND(InData%x_SrvD,1) - Int_BufSz = Int_BufSz + 3 ! x_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_SrvD allocated yes/no - IF ( ALLOCATED(InData%xd_SrvD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_SrvD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_SrvD,1), UBOUND(InData%xd_SrvD,1) - Int_BufSz = Int_BufSz + 3 ! xd_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_SrvD allocated yes/no - IF ( ALLOCATED(InData%z_SrvD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_SrvD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_SrvD,1), UBOUND(InData%z_SrvD,1) - Int_BufSz = Int_BufSz + 3 ! z_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_SrvD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_SrvD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_SrvD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_SrvD,1), UBOUND(InData%OtherSt_SrvD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_SrvD allocated yes/no - IF ( ALLOCATED(InData%u_SrvD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_SrvD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_SrvD,1), UBOUND(InData%u_SrvD,1) - Int_BufSz = Int_BufSz + 3 ! u_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_AD allocated yes/no - IF ( ALLOCATED(InData%x_AD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_AD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_AD,1), UBOUND(InData%x_AD,1) - Int_BufSz = Int_BufSz + 3 ! x_AD: size of buffers for each call to pack subtype - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_AD allocated yes/no - IF ( ALLOCATED(InData%xd_AD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_AD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_AD,1), UBOUND(InData%xd_AD,1) - Int_BufSz = Int_BufSz + 3 ! xd_AD: size of buffers for each call to pack subtype - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_AD allocated yes/no - IF ( ALLOCATED(InData%z_AD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_AD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_AD,1), UBOUND(InData%z_AD,1) - Int_BufSz = Int_BufSz + 3 ! z_AD: size of buffers for each call to pack subtype - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_AD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_AD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_AD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_AD,1), UBOUND(InData%OtherSt_AD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_AD: size of buffers for each call to pack subtype - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_AD allocated yes/no - IF ( ALLOCATED(InData%u_AD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_AD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_AD,1), UBOUND(InData%u_AD,1) - Int_BufSz = Int_BufSz + 3 ! u_AD: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_IfW allocated yes/no - IF ( ALLOCATED(InData%x_IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_IfW,1), UBOUND(InData%x_IfW,1) - Int_BufSz = Int_BufSz + 3 ! x_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_IfW allocated yes/no - IF ( ALLOCATED(InData%xd_IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_IfW,1), UBOUND(InData%xd_IfW,1) - Int_BufSz = Int_BufSz + 3 ! xd_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_IfW allocated yes/no - IF ( ALLOCATED(InData%z_IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_IfW,1), UBOUND(InData%z_IfW,1) - Int_BufSz = Int_BufSz + 3 ! z_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_IfW allocated yes/no - IF ( ALLOCATED(InData%OtherSt_IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_IfW,1), UBOUND(InData%OtherSt_IfW,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_IfW allocated yes/no - IF ( ALLOCATED(InData%u_IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_IfW,1), UBOUND(InData%u_IfW,1) - Int_BufSz = Int_BufSz + 3 ! u_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_SD allocated yes/no - IF ( ALLOCATED(InData%x_SD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_SD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_SD,1), UBOUND(InData%x_SD,1) - Int_BufSz = Int_BufSz + 3 ! x_SD: size of buffers for each call to pack subtype - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_SD allocated yes/no - IF ( ALLOCATED(InData%xd_SD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_SD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_SD,1), UBOUND(InData%xd_SD,1) - Int_BufSz = Int_BufSz + 3 ! xd_SD: size of buffers for each call to pack subtype - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_SD allocated yes/no - IF ( ALLOCATED(InData%z_SD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_SD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_SD,1), UBOUND(InData%z_SD,1) - Int_BufSz = Int_BufSz + 3 ! z_SD: size of buffers for each call to pack subtype - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_SD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_SD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_SD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_SD,1), UBOUND(InData%OtherSt_SD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_SD: size of buffers for each call to pack subtype - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_SD allocated yes/no - IF ( ALLOCATED(InData%u_SD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_SD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_SD,1), UBOUND(InData%u_SD,1) - Int_BufSz = Int_BufSz + 3 ! u_SD: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_ExtPtfm allocated yes/no - IF ( ALLOCATED(InData%x_ExtPtfm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_ExtPtfm upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_ExtPtfm,1), UBOUND(InData%x_ExtPtfm,1) - Int_BufSz = Int_BufSz + 3 ! x_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_ExtPtfm allocated yes/no - IF ( ALLOCATED(InData%xd_ExtPtfm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_ExtPtfm upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_ExtPtfm,1), UBOUND(InData%xd_ExtPtfm,1) - Int_BufSz = Int_BufSz + 3 ! xd_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_ExtPtfm allocated yes/no - IF ( ALLOCATED(InData%z_ExtPtfm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_ExtPtfm upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_ExtPtfm,1), UBOUND(InData%z_ExtPtfm,1) - Int_BufSz = Int_BufSz + 3 ! z_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_ExtPtfm allocated yes/no - IF ( ALLOCATED(InData%OtherSt_ExtPtfm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_ExtPtfm upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_ExtPtfm,1), UBOUND(InData%OtherSt_ExtPtfm,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_ExtPtfm allocated yes/no - IF ( ALLOCATED(InData%u_ExtPtfm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_ExtPtfm upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_ExtPtfm,1), UBOUND(InData%u_ExtPtfm,1) - Int_BufSz = Int_BufSz + 3 ! u_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_HD allocated yes/no - IF ( ALLOCATED(InData%x_HD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_HD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_HD,1), UBOUND(InData%x_HD,1) - Int_BufSz = Int_BufSz + 3 ! x_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_HD allocated yes/no - IF ( ALLOCATED(InData%xd_HD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_HD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_HD,1), UBOUND(InData%xd_HD,1) - Int_BufSz = Int_BufSz + 3 ! xd_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_HD allocated yes/no - IF ( ALLOCATED(InData%z_HD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_HD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_HD,1), UBOUND(InData%z_HD,1) - Int_BufSz = Int_BufSz + 3 ! z_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_HD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_HD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_HD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_HD,1), UBOUND(InData%OtherSt_HD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_HD allocated yes/no - IF ( ALLOCATED(InData%u_HD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_HD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_HD,1), UBOUND(InData%u_HD,1) - Int_BufSz = Int_BufSz + 3 ! u_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_IceF allocated yes/no - IF ( ALLOCATED(InData%x_IceF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_IceF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_IceF,1), UBOUND(InData%x_IceF,1) - Int_BufSz = Int_BufSz + 3 ! x_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_IceF allocated yes/no - IF ( ALLOCATED(InData%xd_IceF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_IceF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_IceF,1), UBOUND(InData%xd_IceF,1) - Int_BufSz = Int_BufSz + 3 ! xd_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_IceF allocated yes/no - IF ( ALLOCATED(InData%z_IceF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_IceF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_IceF,1), UBOUND(InData%z_IceF,1) - Int_BufSz = Int_BufSz + 3 ! z_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_IceF allocated yes/no - IF ( ALLOCATED(InData%OtherSt_IceF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_IceF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_IceF,1), UBOUND(InData%OtherSt_IceF,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_IceF allocated yes/no - IF ( ALLOCATED(InData%u_IceF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_IceF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_IceF,1), UBOUND(InData%u_IceF,1) - Int_BufSz = Int_BufSz + 3 ! u_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_MAP allocated yes/no - IF ( ALLOCATED(InData%x_MAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_MAP upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_MAP,1), UBOUND(InData%x_MAP,1) - Int_BufSz = Int_BufSz + 3 ! x_MAP: size of buffers for each call to pack subtype - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_MAP allocated yes/no - IF ( ALLOCATED(InData%xd_MAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_MAP upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_MAP,1), UBOUND(InData%xd_MAP,1) - Int_BufSz = Int_BufSz + 3 ! xd_MAP: size of buffers for each call to pack subtype - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_MAP allocated yes/no - IF ( ALLOCATED(InData%z_MAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_MAP upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_MAP,1), UBOUND(InData%z_MAP,1) - Int_BufSz = Int_BufSz + 3 ! z_MAP: size of buffers for each call to pack subtype - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_MAP allocated yes/no - IF ( ALLOCATED(InData%u_MAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_MAP upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_MAP,1), UBOUND(InData%u_MAP,1) - Int_BufSz = Int_BufSz + 3 ! u_MAP: size of buffers for each call to pack subtype - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_FEAM allocated yes/no - IF ( ALLOCATED(InData%x_FEAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_FEAM upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_FEAM,1), UBOUND(InData%x_FEAM,1) - Int_BufSz = Int_BufSz + 3 ! x_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_FEAM allocated yes/no - IF ( ALLOCATED(InData%xd_FEAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_FEAM upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_FEAM,1), UBOUND(InData%xd_FEAM,1) - Int_BufSz = Int_BufSz + 3 ! xd_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_FEAM allocated yes/no - IF ( ALLOCATED(InData%z_FEAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_FEAM upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_FEAM,1), UBOUND(InData%z_FEAM,1) - Int_BufSz = Int_BufSz + 3 ! z_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_FEAM allocated yes/no - IF ( ALLOCATED(InData%OtherSt_FEAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_FEAM upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_FEAM,1), UBOUND(InData%OtherSt_FEAM,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_FEAM allocated yes/no - IF ( ALLOCATED(InData%u_FEAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_FEAM upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_FEAM,1), UBOUND(InData%u_FEAM,1) - Int_BufSz = Int_BufSz + 3 ! u_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_MD allocated yes/no - IF ( ALLOCATED(InData%x_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_MD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_MD,1), UBOUND(InData%x_MD,1) - Int_BufSz = Int_BufSz + 3 ! x_MD: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_MD allocated yes/no - IF ( ALLOCATED(InData%xd_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_MD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_MD,1), UBOUND(InData%xd_MD,1) - Int_BufSz = Int_BufSz + 3 ! xd_MD: size of buffers for each call to pack subtype - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_MD allocated yes/no - IF ( ALLOCATED(InData%z_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_MD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_MD,1), UBOUND(InData%z_MD,1) - Int_BufSz = Int_BufSz + 3 ! z_MD: size of buffers for each call to pack subtype - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_MD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_MD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_MD,1), UBOUND(InData%OtherSt_MD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_MD: size of buffers for each call to pack subtype - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_MD allocated yes/no - IF ( ALLOCATED(InData%u_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_MD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_MD,1), UBOUND(InData%u_MD,1) - Int_BufSz = Int_BufSz + 3 ! u_MD: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%x_IceD) ) 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%x_IceD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IceD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_IceD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IceD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%x_IceD,2), UBOUND(InData%x_IceD,2) - DO i1 = LBOUND(InData%x_IceD,1), UBOUND(InData%x_IceD,1) - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x_IceD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%xd_IceD) ) 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%xd_IceD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IceD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_IceD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IceD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xd_IceD,2), UBOUND(InData%xd_IceD,2) - DO i1 = LBOUND(InData%xd_IceD,1), UBOUND(InData%xd_IceD,1) - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd_IceD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%z_IceD) ) 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%z_IceD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IceD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IceD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IceD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%z_IceD,2), UBOUND(InData%z_IceD,2) - DO i1 = LBOUND(InData%z_IceD,1), UBOUND(InData%z_IceD,1) - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z_IceD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_IceD) ) 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%OtherSt_IceD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IceD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IceD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IceD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OtherSt_IceD,2), UBOUND(InData%OtherSt_IceD,2) - DO i1 = LBOUND(InData%OtherSt_IceD,1), UBOUND(InData%OtherSt_IceD,1) - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_IceD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%u_IceD) ) 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%u_IceD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IceD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_IceD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IceD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_IceD,2), UBOUND(InData%u_IceD,2) - DO i1 = LBOUND(InData%u_IceD,1), UBOUND(InData%u_IceD,1) - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_IceD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%x_BD) ) 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%x_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_BD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_BD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_BD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%x_BD,2), UBOUND(InData%x_BD,2) - DO i1 = LBOUND(InData%x_BD,1), UBOUND(InData%x_BD,1) - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x_BD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%xd_BD) ) 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%xd_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_BD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xd_BD,2), UBOUND(InData%xd_BD,2) - DO i1 = LBOUND(InData%xd_BD,1), UBOUND(InData%xd_BD,1) - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd_BD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%z_BD) ) 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%z_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_BD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_BD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_BD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%z_BD,2), UBOUND(InData%z_BD,2) - DO i1 = LBOUND(InData%z_BD,1), UBOUND(InData%z_BD,1) - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z_BD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_BD) ) 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%OtherSt_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_BD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_BD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_BD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OtherSt_BD,2), UBOUND(InData%OtherSt_BD,2) - DO i1 = LBOUND(InData%OtherSt_BD,1), UBOUND(InData%OtherSt_BD,1) - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_BD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%u_BD) ) 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%u_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_BD,2), UBOUND(InData%u_BD,2) - DO i1 = LBOUND(InData%u_BD,1), UBOUND(InData%u_BD,1) - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_BD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%x_ED) ) 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%x_ED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_ED,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_ED,1), UBOUND(InData%x_ED,1) - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_ED - 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 - IF ( .NOT. ALLOCATED(InData%xd_ED) ) 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%xd_ED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_ED,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_ED,1), UBOUND(InData%xd_ED,1) - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_ED - 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 - IF ( .NOT. ALLOCATED(InData%z_ED) ) 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%z_ED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_ED,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_ED,1), UBOUND(InData%z_ED,1) - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_ED - 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 - IF ( .NOT. ALLOCATED(InData%OtherSt_ED) ) 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%OtherSt_ED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_ED,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_ED,1), UBOUND(InData%OtherSt_ED,1) - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_ED - 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 - IF ( .NOT. ALLOCATED(InData%u_ED) ) 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%u_ED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_ED,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_ED,1), UBOUND(InData%u_ED,1) - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_ED - 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 - IF ( .NOT. ALLOCATED(InData%x_SrvD) ) 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%x_SrvD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_SrvD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_SrvD,1), UBOUND(InData%x_SrvD,1) - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_SrvD - 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 - IF ( .NOT. ALLOCATED(InData%xd_SrvD) ) 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%xd_SrvD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_SrvD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_SrvD,1), UBOUND(InData%xd_SrvD,1) - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_SrvD - 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 - IF ( .NOT. ALLOCATED(InData%z_SrvD) ) 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%z_SrvD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_SrvD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_SrvD,1), UBOUND(InData%z_SrvD,1) - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_SrvD - 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 - IF ( .NOT. ALLOCATED(InData%OtherSt_SrvD) ) 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%OtherSt_SrvD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_SrvD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_SrvD,1), UBOUND(InData%OtherSt_SrvD,1) - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_SrvD - 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 - IF ( .NOT. ALLOCATED(InData%u_SrvD) ) 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%u_SrvD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SrvD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_SrvD,1), UBOUND(InData%u_SrvD,1) - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SrvD - 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 - IF ( .NOT. ALLOCATED(InData%x_AD) ) 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%x_AD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_AD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_AD,1), UBOUND(InData%x_AD,1) - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_AD - 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 - IF ( .NOT. ALLOCATED(InData%xd_AD) ) 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%xd_AD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_AD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_AD,1), UBOUND(InData%xd_AD,1) - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_AD - 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 - IF ( .NOT. ALLOCATED(InData%z_AD) ) 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%z_AD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_AD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_AD,1), UBOUND(InData%z_AD,1) - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_AD - 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 - IF ( .NOT. ALLOCATED(InData%OtherSt_AD) ) 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%OtherSt_AD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_AD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_AD,1), UBOUND(InData%OtherSt_AD,1) - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_AD - 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 - IF ( .NOT. ALLOCATED(InData%u_AD) ) 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%u_AD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_AD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_AD,1), UBOUND(InData%u_AD,1) - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_AD - 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 - IF ( .NOT. ALLOCATED(InData%x_IfW) ) 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%x_IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_IfW,1), UBOUND(InData%x_IfW,1) - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_IfW - 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 - IF ( .NOT. ALLOCATED(InData%xd_IfW) ) 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%xd_IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_IfW,1), UBOUND(InData%xd_IfW,1) - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_IfW - 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 - IF ( .NOT. ALLOCATED(InData%z_IfW) ) 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%z_IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_IfW,1), UBOUND(InData%z_IfW,1) - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_IfW - 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 - IF ( .NOT. ALLOCATED(InData%OtherSt_IfW) ) 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%OtherSt_IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_IfW,1), UBOUND(InData%OtherSt_IfW,1) - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_IfW - 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 - IF ( .NOT. ALLOCATED(InData%u_IfW) ) 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%u_IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_IfW,1), UBOUND(InData%u_IfW,1) - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_IfW - 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 - IF ( .NOT. ALLOCATED(InData%x_SD) ) 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%x_SD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_SD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_SD,1), UBOUND(InData%x_SD,1) - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_SD - 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 - IF ( .NOT. ALLOCATED(InData%xd_SD) ) 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%xd_SD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_SD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_SD,1), UBOUND(InData%xd_SD,1) - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_SD - 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 - IF ( .NOT. ALLOCATED(InData%z_SD) ) 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%z_SD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_SD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_SD,1), UBOUND(InData%z_SD,1) - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_SD - 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 - IF ( .NOT. ALLOCATED(InData%OtherSt_SD) ) 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%OtherSt_SD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_SD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_SD,1), UBOUND(InData%OtherSt_SD,1) - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_SD - 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 - IF ( .NOT. ALLOCATED(InData%u_SD) ) 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%u_SD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_SD,1), UBOUND(InData%u_SD,1) - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SD - 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 - IF ( .NOT. ALLOCATED(InData%x_ExtPtfm) ) 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%x_ExtPtfm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_ExtPtfm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_ExtPtfm,1), UBOUND(InData%x_ExtPtfm,1) - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_ExtPtfm - 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 - IF ( .NOT. ALLOCATED(InData%xd_ExtPtfm) ) 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%xd_ExtPtfm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_ExtPtfm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_ExtPtfm,1), UBOUND(InData%xd_ExtPtfm,1) - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_ExtPtfm - 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 - IF ( .NOT. ALLOCATED(InData%z_ExtPtfm) ) 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%z_ExtPtfm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_ExtPtfm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_ExtPtfm,1), UBOUND(InData%z_ExtPtfm,1) - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_ExtPtfm - 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 - IF ( .NOT. ALLOCATED(InData%OtherSt_ExtPtfm) ) 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%OtherSt_ExtPtfm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_ExtPtfm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_ExtPtfm,1), UBOUND(InData%OtherSt_ExtPtfm,1) - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_ExtPtfm - 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 - IF ( .NOT. ALLOCATED(InData%u_ExtPtfm) ) 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%u_ExtPtfm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_ExtPtfm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_ExtPtfm,1), UBOUND(InData%u_ExtPtfm,1) - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_ExtPtfm - 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 - IF ( .NOT. ALLOCATED(InData%x_HD) ) 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%x_HD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_HD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_HD,1), UBOUND(InData%x_HD,1) - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_HD - 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 - IF ( .NOT. ALLOCATED(InData%xd_HD) ) 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%xd_HD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_HD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_HD,1), UBOUND(InData%xd_HD,1) - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_HD - 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 - IF ( .NOT. ALLOCATED(InData%z_HD) ) 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%z_HD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_HD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_HD,1), UBOUND(InData%z_HD,1) - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_HD - 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 - IF ( .NOT. ALLOCATED(InData%OtherSt_HD) ) 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%OtherSt_HD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_HD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_HD,1), UBOUND(InData%OtherSt_HD,1) - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_HD - 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 - IF ( .NOT. ALLOCATED(InData%u_HD) ) 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%u_HD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_HD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_HD,1), UBOUND(InData%u_HD,1) - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_HD - 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 - IF ( .NOT. ALLOCATED(InData%x_IceF) ) 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%x_IceF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IceF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_IceF,1), UBOUND(InData%x_IceF,1) - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_IceF - 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 - IF ( .NOT. ALLOCATED(InData%xd_IceF) ) 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%xd_IceF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IceF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_IceF,1), UBOUND(InData%xd_IceF,1) - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_IceF - 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 - IF ( .NOT. ALLOCATED(InData%z_IceF) ) 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%z_IceF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IceF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_IceF,1), UBOUND(InData%z_IceF,1) - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_IceF - 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 - IF ( .NOT. ALLOCATED(InData%OtherSt_IceF) ) 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%OtherSt_IceF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IceF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_IceF,1), UBOUND(InData%OtherSt_IceF,1) - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_IceF - 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 - IF ( .NOT. ALLOCATED(InData%u_IceF) ) 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%u_IceF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IceF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_IceF,1), UBOUND(InData%u_IceF,1) - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_IceF - 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 - IF ( .NOT. ALLOCATED(InData%x_MAP) ) 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%x_MAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_MAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_MAP,1), UBOUND(InData%x_MAP,1) - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_MAP - 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 - IF ( .NOT. ALLOCATED(InData%xd_MAP) ) 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%xd_MAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_MAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_MAP,1), UBOUND(InData%xd_MAP,1) - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_MAP - 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 - IF ( .NOT. ALLOCATED(InData%z_MAP) ) 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%z_MAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_MAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_MAP,1), UBOUND(InData%z_MAP,1) - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_MAP - 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 - IF ( .NOT. ALLOCATED(InData%u_MAP) ) 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%u_MAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_MAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_MAP,1), UBOUND(InData%u_MAP,1) - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_MAP - 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 - IF ( .NOT. ALLOCATED(InData%x_FEAM) ) 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%x_FEAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_FEAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_FEAM,1), UBOUND(InData%x_FEAM,1) - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_FEAM - 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 - IF ( .NOT. ALLOCATED(InData%xd_FEAM) ) 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%xd_FEAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_FEAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_FEAM,1), UBOUND(InData%xd_FEAM,1) - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_FEAM - 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 - IF ( .NOT. ALLOCATED(InData%z_FEAM) ) 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%z_FEAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_FEAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_FEAM,1), UBOUND(InData%z_FEAM,1) - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_FEAM - 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 - IF ( .NOT. ALLOCATED(InData%OtherSt_FEAM) ) 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%OtherSt_FEAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_FEAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_FEAM,1), UBOUND(InData%OtherSt_FEAM,1) - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_FEAM - 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 - IF ( .NOT. ALLOCATED(InData%u_FEAM) ) 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%u_FEAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_FEAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_FEAM,1), UBOUND(InData%u_FEAM,1) - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_FEAM - 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 - IF ( .NOT. ALLOCATED(InData%x_MD) ) 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%x_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_MD,1), UBOUND(InData%x_MD,1) - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_MD - 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 - IF ( .NOT. ALLOCATED(InData%xd_MD) ) 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%xd_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_MD,1), UBOUND(InData%xd_MD,1) - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_MD - 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 - IF ( .NOT. ALLOCATED(InData%z_MD) ) 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%z_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_MD,1), UBOUND(InData%z_MD,1) - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_MD - 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 - IF ( .NOT. ALLOCATED(InData%OtherSt_MD) ) 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%OtherSt_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_MD,1), UBOUND(InData%OtherSt_MD,1) - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_MD - 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 - IF ( .NOT. ALLOCATED(InData%u_MD) ) 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%u_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_MD,1), UBOUND(InData%u_MD,1) - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_MD - 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 - END SUBROUTINE FAST_PackLinStateSave - - SUBROUTINE FAST_UnPackLinStateSave( 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(FAST_LinStateSave), 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 = 'FAST_UnPackLinStateSave' - ! 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 ! x_IceD 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%x_IceD)) DEALLOCATE(OutData%x_IceD) - ALLOCATE(OutData%x_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%x_IceD,2), UBOUND(OutData%x_IceD,2) - DO i1 = LBOUND(OutData%x_IceD,1), UBOUND(OutData%x_IceD,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 IceD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! x_IceD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_IceD 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%xd_IceD)) DEALLOCATE(OutData%xd_IceD) - ALLOCATE(OutData%xd_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xd_IceD,2), UBOUND(OutData%xd_IceD,2) - DO i1 = LBOUND(OutData%xd_IceD,1), UBOUND(OutData%xd_IceD,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 IceD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! xd_IceD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_IceD 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%z_IceD)) DEALLOCATE(OutData%z_IceD) - ALLOCATE(OutData%z_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%z_IceD,2), UBOUND(OutData%z_IceD,2) - DO i1 = LBOUND(OutData%z_IceD,1), UBOUND(OutData%z_IceD,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 IceD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! z_IceD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_IceD 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%OtherSt_IceD)) DEALLOCATE(OutData%OtherSt_IceD) - ALLOCATE(OutData%OtherSt_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OtherSt_IceD,2), UBOUND(OutData%OtherSt_IceD,2) - DO i1 = LBOUND(OutData%OtherSt_IceD,1), UBOUND(OutData%OtherSt_IceD,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 IceD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt_IceD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_IceD 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%u_IceD)) DEALLOCATE(OutData%u_IceD) - ALLOCATE(OutData%u_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_IceD,2), UBOUND(OutData%u_IceD,2) - DO i1 = LBOUND(OutData%u_IceD,1), UBOUND(OutData%u_IceD,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 IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! u_IceD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_BD 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%x_BD)) DEALLOCATE(OutData%x_BD) - ALLOCATE(OutData%x_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%x_BD,2), UBOUND(OutData%x_BD,2) - DO i1 = LBOUND(OutData%x_BD,1), UBOUND(OutData%x_BD,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 BD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_BD(i1,i2), ErrStat2, ErrMsg2 ) ! x_BD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_BD 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%xd_BD)) DEALLOCATE(OutData%xd_BD) - ALLOCATE(OutData%xd_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xd_BD,2), UBOUND(OutData%xd_BD,2) - DO i1 = LBOUND(OutData%xd_BD,1), UBOUND(OutData%xd_BD,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 BD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_BD(i1,i2), ErrStat2, ErrMsg2 ) ! xd_BD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_BD 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%z_BD)) DEALLOCATE(OutData%z_BD) - ALLOCATE(OutData%z_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%z_BD,2), UBOUND(OutData%z_BD,2) - DO i1 = LBOUND(OutData%z_BD,1), UBOUND(OutData%z_BD,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 BD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_BD(i1,i2), ErrStat2, ErrMsg2 ) ! z_BD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_BD 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%OtherSt_BD)) DEALLOCATE(OutData%OtherSt_BD) - ALLOCATE(OutData%OtherSt_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OtherSt_BD,2), UBOUND(OutData%OtherSt_BD,2) - DO i1 = LBOUND(OutData%OtherSt_BD,1), UBOUND(OutData%OtherSt_BD,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 BD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt_BD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BD 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%u_BD)) DEALLOCATE(OutData%u_BD) - ALLOCATE(OutData%u_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_BD,2), UBOUND(OutData%u_BD,2) - DO i1 = LBOUND(OutData%u_BD,1), UBOUND(OutData%u_BD,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 BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_BD(i1,i2), ErrStat2, ErrMsg2 ) ! u_BD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_ED 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%x_ED)) DEALLOCATE(OutData%x_ED) - ALLOCATE(OutData%x_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_ED,1), UBOUND(OutData%x_ED,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 ED_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_ED(i1), ErrStat2, ErrMsg2 ) ! x_ED - 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 ! xd_ED 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%xd_ED)) DEALLOCATE(OutData%xd_ED) - ALLOCATE(OutData%xd_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_ED,1), UBOUND(OutData%xd_ED,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 ED_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_ED(i1), ErrStat2, ErrMsg2 ) ! xd_ED - 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 ! z_ED 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%z_ED)) DEALLOCATE(OutData%z_ED) - ALLOCATE(OutData%z_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_ED,1), UBOUND(OutData%z_ED,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 ED_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_ED(i1), ErrStat2, ErrMsg2 ) ! z_ED - 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 ! OtherSt_ED 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%OtherSt_ED)) DEALLOCATE(OutData%OtherSt_ED) - ALLOCATE(OutData%OtherSt_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_ED,1), UBOUND(OutData%OtherSt_ED,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 ED_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_ED(i1), ErrStat2, ErrMsg2 ) ! OtherSt_ED - 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 ! u_ED 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%u_ED)) DEALLOCATE(OutData%u_ED) - ALLOCATE(OutData%u_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_ED,1), UBOUND(OutData%u_ED,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 ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_ED(i1), ErrStat2, ErrMsg2 ) ! u_ED - 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 ! x_SrvD 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%x_SrvD)) DEALLOCATE(OutData%x_SrvD) - ALLOCATE(OutData%x_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_SrvD,1), UBOUND(OutData%x_SrvD,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 SrvD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_SrvD(i1), ErrStat2, ErrMsg2 ) ! x_SrvD - 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 ! xd_SrvD 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%xd_SrvD)) DEALLOCATE(OutData%xd_SrvD) - ALLOCATE(OutData%xd_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_SrvD,1), UBOUND(OutData%xd_SrvD,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 SrvD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_SrvD(i1), ErrStat2, ErrMsg2 ) ! xd_SrvD - 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 ! z_SrvD 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%z_SrvD)) DEALLOCATE(OutData%z_SrvD) - ALLOCATE(OutData%z_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_SrvD,1), UBOUND(OutData%z_SrvD,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 SrvD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_SrvD(i1), ErrStat2, ErrMsg2 ) ! z_SrvD - 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 ! OtherSt_SrvD 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%OtherSt_SrvD)) DEALLOCATE(OutData%OtherSt_SrvD) - ALLOCATE(OutData%OtherSt_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_SrvD,1), UBOUND(OutData%OtherSt_SrvD,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 SrvD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_SrvD - 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 ! u_SrvD 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%u_SrvD)) DEALLOCATE(OutData%u_SrvD) - ALLOCATE(OutData%u_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_SrvD,1), UBOUND(OutData%u_SrvD,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 SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_SrvD(i1), ErrStat2, ErrMsg2 ) ! u_SrvD - 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 ! x_AD 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%x_AD)) DEALLOCATE(OutData%x_AD) - ALLOCATE(OutData%x_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_AD,1), UBOUND(OutData%x_AD,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 AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_AD(i1), ErrStat2, ErrMsg2 ) ! x_AD - 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 ! xd_AD 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%xd_AD)) DEALLOCATE(OutData%xd_AD) - ALLOCATE(OutData%xd_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_AD,1), UBOUND(OutData%xd_AD,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 AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_AD(i1), ErrStat2, ErrMsg2 ) ! xd_AD - 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 ! z_AD 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%z_AD)) DEALLOCATE(OutData%z_AD) - ALLOCATE(OutData%z_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_AD,1), UBOUND(OutData%z_AD,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 AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_AD(i1), ErrStat2, ErrMsg2 ) ! z_AD - 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 ! OtherSt_AD 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%OtherSt_AD)) DEALLOCATE(OutData%OtherSt_AD) - ALLOCATE(OutData%OtherSt_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_AD,1), UBOUND(OutData%OtherSt_AD,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 AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_AD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_AD - 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 ! u_AD 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%u_AD)) DEALLOCATE(OutData%u_AD) - ALLOCATE(OutData%u_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_AD,1), UBOUND(OutData%u_AD,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 AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_AD(i1), ErrStat2, ErrMsg2 ) ! u_AD - 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 ! x_IfW 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%x_IfW)) DEALLOCATE(OutData%x_IfW) - ALLOCATE(OutData%x_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_IfW,1), UBOUND(OutData%x_IfW,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 InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_IfW(i1), ErrStat2, ErrMsg2 ) ! x_IfW - 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 ! xd_IfW 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%xd_IfW)) DEALLOCATE(OutData%xd_IfW) - ALLOCATE(OutData%xd_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_IfW,1), UBOUND(OutData%xd_IfW,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 InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_IfW(i1), ErrStat2, ErrMsg2 ) ! xd_IfW - 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 ! z_IfW 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%z_IfW)) DEALLOCATE(OutData%z_IfW) - ALLOCATE(OutData%z_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_IfW,1), UBOUND(OutData%z_IfW,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 InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_IfW(i1), ErrStat2, ErrMsg2 ) ! z_IfW - 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 ! OtherSt_IfW 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%OtherSt_IfW)) DEALLOCATE(OutData%OtherSt_IfW) - ALLOCATE(OutData%OtherSt_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_IfW,1), UBOUND(OutData%OtherSt_IfW,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 InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_IfW(i1), ErrStat2, ErrMsg2 ) ! OtherSt_IfW - 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 ! u_IfW 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%u_IfW)) DEALLOCATE(OutData%u_IfW) - ALLOCATE(OutData%u_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_IfW,1), UBOUND(OutData%u_IfW,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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IfW(i1), ErrStat2, ErrMsg2 ) ! u_IfW - 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 ! x_SD 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%x_SD)) DEALLOCATE(OutData%x_SD) - ALLOCATE(OutData%x_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_SD,1), UBOUND(OutData%x_SD,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 SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_SD(i1), ErrStat2, ErrMsg2 ) ! x_SD - 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 ! xd_SD 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%xd_SD)) DEALLOCATE(OutData%xd_SD) - ALLOCATE(OutData%xd_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_SD,1), UBOUND(OutData%xd_SD,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 SD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_SD(i1), ErrStat2, ErrMsg2 ) ! xd_SD - 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 ! z_SD 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%z_SD)) DEALLOCATE(OutData%z_SD) - ALLOCATE(OutData%z_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_SD,1), UBOUND(OutData%z_SD,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 SD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_SD(i1), ErrStat2, ErrMsg2 ) ! z_SD - 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 ! OtherSt_SD 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%OtherSt_SD)) DEALLOCATE(OutData%OtherSt_SD) - ALLOCATE(OutData%OtherSt_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_SD,1), UBOUND(OutData%OtherSt_SD,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 SD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_SD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_SD - 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 ! u_SD 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%u_SD)) DEALLOCATE(OutData%u_SD) - ALLOCATE(OutData%u_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_SD,1), UBOUND(OutData%u_SD,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 SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_SD(i1), ErrStat2, ErrMsg2 ) ! u_SD - 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 ! x_ExtPtfm 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%x_ExtPtfm)) DEALLOCATE(OutData%x_ExtPtfm) - ALLOCATE(OutData%x_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_ExtPtfm,1), UBOUND(OutData%x_ExtPtfm,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 ExtPtfm_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! x_ExtPtfm - 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 ! xd_ExtPtfm 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%xd_ExtPtfm)) DEALLOCATE(OutData%xd_ExtPtfm) - ALLOCATE(OutData%xd_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_ExtPtfm,1), UBOUND(OutData%xd_ExtPtfm,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 ExtPtfm_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! xd_ExtPtfm - 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 ! z_ExtPtfm 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%z_ExtPtfm)) DEALLOCATE(OutData%z_ExtPtfm) - ALLOCATE(OutData%z_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_ExtPtfm,1), UBOUND(OutData%z_ExtPtfm,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 ExtPtfm_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! z_ExtPtfm - 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 ! OtherSt_ExtPtfm 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%OtherSt_ExtPtfm)) DEALLOCATE(OutData%OtherSt_ExtPtfm) - ALLOCATE(OutData%OtherSt_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_ExtPtfm,1), UBOUND(OutData%OtherSt_ExtPtfm,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 ExtPtfm_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! OtherSt_ExtPtfm - 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 ! u_ExtPtfm 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%u_ExtPtfm)) DEALLOCATE(OutData%u_ExtPtfm) - ALLOCATE(OutData%u_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_ExtPtfm,1), UBOUND(OutData%u_ExtPtfm,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 ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! u_ExtPtfm - 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 ! x_HD 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%x_HD)) DEALLOCATE(OutData%x_HD) - ALLOCATE(OutData%x_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_HD,1), UBOUND(OutData%x_HD,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 HydroDyn_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_HD(i1), ErrStat2, ErrMsg2 ) ! x_HD - 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 ! xd_HD 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%xd_HD)) DEALLOCATE(OutData%xd_HD) - ALLOCATE(OutData%xd_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_HD,1), UBOUND(OutData%xd_HD,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 HydroDyn_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_HD(i1), ErrStat2, ErrMsg2 ) ! xd_HD - 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 ! z_HD 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%z_HD)) DEALLOCATE(OutData%z_HD) - ALLOCATE(OutData%z_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_HD,1), UBOUND(OutData%z_HD,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 HydroDyn_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_HD(i1), ErrStat2, ErrMsg2 ) ! z_HD - 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 ! OtherSt_HD 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%OtherSt_HD)) DEALLOCATE(OutData%OtherSt_HD) - ALLOCATE(OutData%OtherSt_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_HD,1), UBOUND(OutData%OtherSt_HD,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 HydroDyn_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_HD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_HD - 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 ! u_HD 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%u_HD)) DEALLOCATE(OutData%u_HD) - ALLOCATE(OutData%u_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_HD,1), UBOUND(OutData%u_HD,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 HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_HD(i1), ErrStat2, ErrMsg2 ) ! u_HD - 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 ! x_IceF 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%x_IceF)) DEALLOCATE(OutData%x_IceF) - ALLOCATE(OutData%x_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_IceF,1), UBOUND(OutData%x_IceF,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 IceFloe_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_IceF(i1), ErrStat2, ErrMsg2 ) ! x_IceF - 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 ! xd_IceF 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%xd_IceF)) DEALLOCATE(OutData%xd_IceF) - ALLOCATE(OutData%xd_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_IceF,1), UBOUND(OutData%xd_IceF,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 IceFloe_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_IceF(i1), ErrStat2, ErrMsg2 ) ! xd_IceF - 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 ! z_IceF 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%z_IceF)) DEALLOCATE(OutData%z_IceF) - ALLOCATE(OutData%z_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_IceF,1), UBOUND(OutData%z_IceF,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 IceFloe_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_IceF(i1), ErrStat2, ErrMsg2 ) ! z_IceF - 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 ! OtherSt_IceF 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%OtherSt_IceF)) DEALLOCATE(OutData%OtherSt_IceF) - ALLOCATE(OutData%OtherSt_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_IceF,1), UBOUND(OutData%OtherSt_IceF,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 IceFloe_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_IceF(i1), ErrStat2, ErrMsg2 ) ! OtherSt_IceF - 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 ! u_IceF 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%u_IceF)) DEALLOCATE(OutData%u_IceF) - ALLOCATE(OutData%u_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_IceF,1), UBOUND(OutData%u_IceF,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 IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IceF(i1), ErrStat2, ErrMsg2 ) ! u_IceF - 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 ! x_MAP 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%x_MAP)) DEALLOCATE(OutData%x_MAP) - ALLOCATE(OutData%x_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_MAP,1), UBOUND(OutData%x_MAP,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 MAP_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_MAP(i1), ErrStat2, ErrMsg2 ) ! x_MAP - 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 ! xd_MAP 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%xd_MAP)) DEALLOCATE(OutData%xd_MAP) - ALLOCATE(OutData%xd_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_MAP,1), UBOUND(OutData%xd_MAP,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 MAP_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_MAP(i1), ErrStat2, ErrMsg2 ) ! xd_MAP - 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 ! z_MAP 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%z_MAP)) DEALLOCATE(OutData%z_MAP) - ALLOCATE(OutData%z_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_MAP,1), UBOUND(OutData%z_MAP,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 MAP_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_MAP(i1), ErrStat2, ErrMsg2 ) ! z_MAP - 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 ! u_MAP 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%u_MAP)) DEALLOCATE(OutData%u_MAP) - ALLOCATE(OutData%u_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_MAP,1), UBOUND(OutData%u_MAP,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 MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_MAP(i1), ErrStat2, ErrMsg2 ) ! u_MAP - 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 ! x_FEAM 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%x_FEAM)) DEALLOCATE(OutData%x_FEAM) - ALLOCATE(OutData%x_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_FEAM,1), UBOUND(OutData%x_FEAM,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 FEAM_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_FEAM(i1), ErrStat2, ErrMsg2 ) ! x_FEAM - 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 ! xd_FEAM 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%xd_FEAM)) DEALLOCATE(OutData%xd_FEAM) - ALLOCATE(OutData%xd_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_FEAM,1), UBOUND(OutData%xd_FEAM,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 FEAM_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_FEAM(i1), ErrStat2, ErrMsg2 ) ! xd_FEAM - 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 ! z_FEAM 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%z_FEAM)) DEALLOCATE(OutData%z_FEAM) - ALLOCATE(OutData%z_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_FEAM,1), UBOUND(OutData%z_FEAM,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 FEAM_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_FEAM(i1), ErrStat2, ErrMsg2 ) ! z_FEAM - 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 ! OtherSt_FEAM 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%OtherSt_FEAM)) DEALLOCATE(OutData%OtherSt_FEAM) - ALLOCATE(OutData%OtherSt_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_FEAM,1), UBOUND(OutData%OtherSt_FEAM,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 FEAM_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2 ) ! OtherSt_FEAM - 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 ! u_FEAM 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%u_FEAM)) DEALLOCATE(OutData%u_FEAM) - ALLOCATE(OutData%u_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_FEAM,1), UBOUND(OutData%u_FEAM,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 FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_FEAM(i1), ErrStat2, ErrMsg2 ) ! u_FEAM - 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 ! x_MD 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%x_MD)) DEALLOCATE(OutData%x_MD) - ALLOCATE(OutData%x_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_MD,1), UBOUND(OutData%x_MD,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 MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_MD(i1), ErrStat2, ErrMsg2 ) ! x_MD - 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 ! xd_MD 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%xd_MD)) DEALLOCATE(OutData%xd_MD) - ALLOCATE(OutData%xd_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_MD,1), UBOUND(OutData%xd_MD,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 MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_MD(i1), ErrStat2, ErrMsg2 ) ! xd_MD - 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 ! z_MD 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%z_MD)) DEALLOCATE(OutData%z_MD) - ALLOCATE(OutData%z_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_MD,1), UBOUND(OutData%z_MD,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 MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_MD(i1), ErrStat2, ErrMsg2 ) ! z_MD - 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 ! OtherSt_MD 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%OtherSt_MD)) DEALLOCATE(OutData%OtherSt_MD) - ALLOCATE(OutData%OtherSt_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_MD,1), UBOUND(OutData%OtherSt_MD,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 MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_MD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_MD - 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 ! u_MD 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%u_MD)) DEALLOCATE(OutData%u_MD) - ALLOCATE(OutData%u_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_MD,1), UBOUND(OutData%u_MD,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 MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_MD(i1), ErrStat2, ErrMsg2 ) ! u_MD - 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 - END SUBROUTINE FAST_UnPackLinStateSave - - SUBROUTINE FAST_CopyLinType( SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_LinType), INTENT(IN) :: SrcLinTypeData - TYPE(FAST_LinType), INTENT(INOUT) :: DstLinTypeData - 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 = 'FAST_CopyLinType' -! + ErrMsg = '' + if (allocated(VTK_SurfaceTypeData%TowerRad)) then + deallocate(VTK_SurfaceTypeData%TowerRad) + end if + if (allocated(VTK_SurfaceTypeData%WaveElevXY)) then + deallocate(VTK_SurfaceTypeData%WaveElevXY) + end if + if (allocated(VTK_SurfaceTypeData%WaveElev)) then + deallocate(VTK_SurfaceTypeData%WaveElev) + end if + if (allocated(VTK_SurfaceTypeData%BladeShape)) then + LB(1:1) = lbound(VTK_SurfaceTypeData%BladeShape) + UB(1:1) = ubound(VTK_SurfaceTypeData%BladeShape) + do i1 = LB(1), UB(1) + call FAST_DestroyVTK_BLSurfaceType(VTK_SurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(VTK_SurfaceTypeData%BladeShape) + end if + if (allocated(VTK_SurfaceTypeData%MorisonRad)) then + deallocate(VTK_SurfaceTypeData%MorisonRad) + end if +end subroutine + +subroutine FAST_PackVTK_SurfaceType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_VTK_SurfaceType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackVTK_SurfaceType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%NumSectors) + call RegPack(Buf, InData%HubRad) + call RegPack(Buf, InData%GroundRad) + call RegPack(Buf, InData%NacelleBox) + call RegPack(Buf, allocated(InData%TowerRad)) + if (allocated(InData%TowerRad)) then + call RegPackBounds(Buf, 1, lbound(InData%TowerRad), ubound(InData%TowerRad)) + call RegPack(Buf, InData%TowerRad) + end if + call RegPack(Buf, InData%NWaveElevPts) + call RegPack(Buf, allocated(InData%WaveElevXY)) + if (allocated(InData%WaveElevXY)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevXY), ubound(InData%WaveElevXY)) + call RegPack(Buf, InData%WaveElevXY) + end if + call RegPack(Buf, allocated(InData%WaveElev)) + if (allocated(InData%WaveElev)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElev), ubound(InData%WaveElev)) + call RegPack(Buf, InData%WaveElev) + end if + call RegPack(Buf, allocated(InData%BladeShape)) + if (allocated(InData%BladeShape)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) + LB(1:1) = lbound(InData%BladeShape) + UB(1:1) = ubound(InData%BladeShape) + do i1 = LB(1), UB(1) + call FAST_PackVTK_BLSurfaceType(Buf, InData%BladeShape(i1)) + end do + end if + call RegPack(Buf, allocated(InData%MorisonRad)) + if (allocated(InData%MorisonRad)) then + call RegPackBounds(Buf, 1, lbound(InData%MorisonRad), ubound(InData%MorisonRad)) + call RegPack(Buf, InData%MorisonRad) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackVTK_SurfaceType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_VTK_SurfaceType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackVTK_SurfaceType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NumSectors) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HubRad) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GroundRad) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacelleBox) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TowerRad)) deallocate(OutData%TowerRad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TowerRad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TowerRad) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NWaveElevPts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WaveElevXY)) deallocate(OutData%WaveElevXY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevXY(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevXY) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveElev)) deallocate(OutData%WaveElev) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeShape(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FAST_UnpackVTK_BLSurfaceType(Buf, OutData%BladeShape(i1)) ! BladeShape + end do + end if + if (allocated(OutData%MorisonRad)) deallocate(OutData%MorisonRad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MorisonRad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MorisonRad) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShapeTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_VTK_ModeShapeType), intent(in) :: SrcVTK_ModeShapeTypeData + type(FAST_VTK_ModeShapeType), intent(inout) :: DstVTK_ModeShapeTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyVTK_ModeShapeType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcLinTypeData%Names_u)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_u,1) - i1_u = UBOUND(SrcLinTypeData%Names_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_u)) THEN - ALLOCATE(DstLinTypeData%Names_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_u = SrcLinTypeData%Names_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_y)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_y,1) - i1_u = UBOUND(SrcLinTypeData%Names_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_y)) THEN - ALLOCATE(DstLinTypeData%Names_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_y = SrcLinTypeData%Names_y -ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_x)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_x,1) - i1_u = UBOUND(SrcLinTypeData%Names_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_x)) THEN - ALLOCATE(DstLinTypeData%Names_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_x = SrcLinTypeData%Names_x -ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_xd)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_xd,1) - i1_u = UBOUND(SrcLinTypeData%Names_xd,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_xd)) THEN - ALLOCATE(DstLinTypeData%Names_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd -ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_z)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_z,1) - i1_u = UBOUND(SrcLinTypeData%Names_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_z)) THEN - ALLOCATE(DstLinTypeData%Names_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_z = SrcLinTypeData%Names_z -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_u)) THEN - i1_l = LBOUND(SrcLinTypeData%op_u,1) - i1_u = UBOUND(SrcLinTypeData%op_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_u)) THEN - ALLOCATE(DstLinTypeData%op_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_u = SrcLinTypeData%op_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_y)) THEN - i1_l = LBOUND(SrcLinTypeData%op_y,1) - i1_u = UBOUND(SrcLinTypeData%op_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_y)) THEN - ALLOCATE(DstLinTypeData%op_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_y = SrcLinTypeData%op_y -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_x)) THEN - i1_l = LBOUND(SrcLinTypeData%op_x,1) - i1_u = UBOUND(SrcLinTypeData%op_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_x)) THEN - ALLOCATE(DstLinTypeData%op_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_x = SrcLinTypeData%op_x -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_dx)) THEN - i1_l = LBOUND(SrcLinTypeData%op_dx,1) - i1_u = UBOUND(SrcLinTypeData%op_dx,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_dx)) THEN - ALLOCATE(DstLinTypeData%op_dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_dx = SrcLinTypeData%op_dx -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_xd)) THEN - i1_l = LBOUND(SrcLinTypeData%op_xd,1) - i1_u = UBOUND(SrcLinTypeData%op_xd,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_xd)) THEN - ALLOCATE(DstLinTypeData%op_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_xd = SrcLinTypeData%op_xd -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_z)) THEN - i1_l = LBOUND(SrcLinTypeData%op_z,1) - i1_u = UBOUND(SrcLinTypeData%op_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_z)) THEN - ALLOCATE(DstLinTypeData%op_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_z = SrcLinTypeData%op_z -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_x_eig_mag)) THEN - i1_l = LBOUND(SrcLinTypeData%op_x_eig_mag,1) - i1_u = UBOUND(SrcLinTypeData%op_x_eig_mag,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_x_eig_mag)) THEN - ALLOCATE(DstLinTypeData%op_x_eig_mag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_mag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_x_eig_mag = SrcLinTypeData%op_x_eig_mag -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_x_eig_phase)) THEN - i1_l = LBOUND(SrcLinTypeData%op_x_eig_phase,1) - i1_u = UBOUND(SrcLinTypeData%op_x_eig_phase,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_x_eig_phase)) THEN - ALLOCATE(DstLinTypeData%op_x_eig_phase(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_phase.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_x_eig_phase = SrcLinTypeData%op_x_eig_phase -ENDIF -IF (ALLOCATED(SrcLinTypeData%Use_u)) THEN - i1_l = LBOUND(SrcLinTypeData%Use_u,1) - i1_u = UBOUND(SrcLinTypeData%Use_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Use_u)) THEN - ALLOCATE(DstLinTypeData%Use_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Use_u = SrcLinTypeData%Use_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%Use_y)) THEN - i1_l = LBOUND(SrcLinTypeData%Use_y,1) - i1_u = UBOUND(SrcLinTypeData%Use_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Use_y)) THEN - ALLOCATE(DstLinTypeData%Use_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Use_y = SrcLinTypeData%Use_y -ENDIF -IF (ALLOCATED(SrcLinTypeData%A)) THEN - i1_l = LBOUND(SrcLinTypeData%A,1) - i1_u = UBOUND(SrcLinTypeData%A,1) - i2_l = LBOUND(SrcLinTypeData%A,2) - i2_u = UBOUND(SrcLinTypeData%A,2) - IF (.NOT. ALLOCATED(DstLinTypeData%A)) THEN - ALLOCATE(DstLinTypeData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%A = SrcLinTypeData%A -ENDIF -IF (ALLOCATED(SrcLinTypeData%B)) THEN - i1_l = LBOUND(SrcLinTypeData%B,1) - i1_u = UBOUND(SrcLinTypeData%B,1) - i2_l = LBOUND(SrcLinTypeData%B,2) - i2_u = UBOUND(SrcLinTypeData%B,2) - IF (.NOT. ALLOCATED(DstLinTypeData%B)) THEN - ALLOCATE(DstLinTypeData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%B = SrcLinTypeData%B -ENDIF -IF (ALLOCATED(SrcLinTypeData%C)) THEN - i1_l = LBOUND(SrcLinTypeData%C,1) - i1_u = UBOUND(SrcLinTypeData%C,1) - i2_l = LBOUND(SrcLinTypeData%C,2) - i2_u = UBOUND(SrcLinTypeData%C,2) - IF (.NOT. ALLOCATED(DstLinTypeData%C)) THEN - ALLOCATE(DstLinTypeData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%C = SrcLinTypeData%C -ENDIF -IF (ALLOCATED(SrcLinTypeData%D)) THEN - i1_l = LBOUND(SrcLinTypeData%D,1) - i1_u = UBOUND(SrcLinTypeData%D,1) - i2_l = LBOUND(SrcLinTypeData%D,2) - i2_u = UBOUND(SrcLinTypeData%D,2) - IF (.NOT. ALLOCATED(DstLinTypeData%D)) THEN - ALLOCATE(DstLinTypeData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%D = SrcLinTypeData%D -ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRotation)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRotation,1) - i1_u = UBOUND(SrcLinTypeData%StateRotation,1) - i2_l = LBOUND(SrcLinTypeData%StateRotation,2) - i2_u = UBOUND(SrcLinTypeData%StateRotation,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRotation)) THEN - ALLOCATE(DstLinTypeData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation -ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRel_x)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRel_x,1) - i1_u = UBOUND(SrcLinTypeData%StateRel_x,1) - i2_l = LBOUND(SrcLinTypeData%StateRel_x,2) - i2_u = UBOUND(SrcLinTypeData%StateRel_x,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_x)) THEN - ALLOCATE(DstLinTypeData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x -ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRel_xdot)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRel_xdot,1) - i1_u = UBOUND(SrcLinTypeData%StateRel_xdot,1) - i2_l = LBOUND(SrcLinTypeData%StateRel_xdot,2) - i2_u = UBOUND(SrcLinTypeData%StateRel_xdot,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_xdot)) THEN - ALLOCATE(DstLinTypeData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot -ENDIF -IF (ALLOCATED(SrcLinTypeData%IsLoad_u)) THEN - i1_l = LBOUND(SrcLinTypeData%IsLoad_u,1) - i1_u = UBOUND(SrcLinTypeData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%IsLoad_u)) THEN - ALLOCATE(DstLinTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_u)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_u,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_u)) THEN - ALLOCATE(DstLinTypeData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_y)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_y,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_y)) THEN - ALLOCATE(DstLinTypeData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_x)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_x,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_x)) THEN - ALLOCATE(DstLinTypeData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_z)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_z,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_z)) THEN - ALLOCATE(DstLinTypeData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z -ENDIF -IF (ALLOCATED(SrcLinTypeData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcLinTypeData%DerivOrder_x,1) - i1_u = UBOUND(SrcLinTypeData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%DerivOrder_x)) THEN - ALLOCATE(DstLinTypeData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%DerivOrder_x = SrcLinTypeData%DerivOrder_x -ENDIF - DstLinTypeData%SizeLin = SrcLinTypeData%SizeLin - DstLinTypeData%LinStartIndx = SrcLinTypeData%LinStartIndx - DstLinTypeData%NumOutputs = SrcLinTypeData%NumOutputs - END SUBROUTINE FAST_CopyLinType - - SUBROUTINE FAST_DestroyLinType( LinTypeData, ErrStat, ErrMsg ) - TYPE(FAST_LinType), INTENT(INOUT) :: LinTypeData - 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 = 'FAST_DestroyLinType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(LinTypeData%Names_u)) THEN - DEALLOCATE(LinTypeData%Names_u) -ENDIF -IF (ALLOCATED(LinTypeData%Names_y)) THEN - DEALLOCATE(LinTypeData%Names_y) -ENDIF -IF (ALLOCATED(LinTypeData%Names_x)) THEN - DEALLOCATE(LinTypeData%Names_x) -ENDIF -IF (ALLOCATED(LinTypeData%Names_xd)) THEN - DEALLOCATE(LinTypeData%Names_xd) -ENDIF -IF (ALLOCATED(LinTypeData%Names_z)) THEN - DEALLOCATE(LinTypeData%Names_z) -ENDIF -IF (ALLOCATED(LinTypeData%op_u)) THEN - DEALLOCATE(LinTypeData%op_u) -ENDIF -IF (ALLOCATED(LinTypeData%op_y)) THEN - DEALLOCATE(LinTypeData%op_y) -ENDIF -IF (ALLOCATED(LinTypeData%op_x)) THEN - DEALLOCATE(LinTypeData%op_x) -ENDIF -IF (ALLOCATED(LinTypeData%op_dx)) THEN - DEALLOCATE(LinTypeData%op_dx) -ENDIF -IF (ALLOCATED(LinTypeData%op_xd)) THEN - DEALLOCATE(LinTypeData%op_xd) -ENDIF -IF (ALLOCATED(LinTypeData%op_z)) THEN - DEALLOCATE(LinTypeData%op_z) -ENDIF -IF (ALLOCATED(LinTypeData%op_x_eig_mag)) THEN - DEALLOCATE(LinTypeData%op_x_eig_mag) -ENDIF -IF (ALLOCATED(LinTypeData%op_x_eig_phase)) THEN - DEALLOCATE(LinTypeData%op_x_eig_phase) -ENDIF -IF (ALLOCATED(LinTypeData%Use_u)) THEN - DEALLOCATE(LinTypeData%Use_u) -ENDIF -IF (ALLOCATED(LinTypeData%Use_y)) THEN - DEALLOCATE(LinTypeData%Use_y) -ENDIF -IF (ALLOCATED(LinTypeData%A)) THEN - DEALLOCATE(LinTypeData%A) -ENDIF -IF (ALLOCATED(LinTypeData%B)) THEN - DEALLOCATE(LinTypeData%B) -ENDIF -IF (ALLOCATED(LinTypeData%C)) THEN - DEALLOCATE(LinTypeData%C) -ENDIF -IF (ALLOCATED(LinTypeData%D)) THEN - DEALLOCATE(LinTypeData%D) -ENDIF -IF (ALLOCATED(LinTypeData%StateRotation)) THEN - DEALLOCATE(LinTypeData%StateRotation) -ENDIF -IF (ALLOCATED(LinTypeData%StateRel_x)) THEN - DEALLOCATE(LinTypeData%StateRel_x) -ENDIF -IF (ALLOCATED(LinTypeData%StateRel_xdot)) THEN - DEALLOCATE(LinTypeData%StateRel_xdot) -ENDIF -IF (ALLOCATED(LinTypeData%IsLoad_u)) THEN - DEALLOCATE(LinTypeData%IsLoad_u) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_u)) THEN - DEALLOCATE(LinTypeData%RotFrame_u) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_y)) THEN - DEALLOCATE(LinTypeData%RotFrame_y) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_x)) THEN - DEALLOCATE(LinTypeData%RotFrame_x) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_z)) THEN - DEALLOCATE(LinTypeData%RotFrame_z) -ENDIF -IF (ALLOCATED(LinTypeData%DerivOrder_x)) THEN - DEALLOCATE(LinTypeData%DerivOrder_x) -ENDIF - END SUBROUTINE FAST_DestroyLinType - - SUBROUTINE FAST_PackLinType( 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(FAST_LinType), 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 = 'FAST_PackLinType' - ! 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 ! Names_u allocated yes/no - IF ( ALLOCATED(InData%Names_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_u)*LEN(InData%Names_u) ! Names_u - END IF - Int_BufSz = Int_BufSz + 1 ! Names_y allocated yes/no - IF ( ALLOCATED(InData%Names_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_y)*LEN(InData%Names_y) ! Names_y - END IF - Int_BufSz = Int_BufSz + 1 ! Names_x allocated yes/no - IF ( ALLOCATED(InData%Names_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_x)*LEN(InData%Names_x) ! Names_x - END IF - Int_BufSz = Int_BufSz + 1 ! Names_xd allocated yes/no - IF ( ALLOCATED(InData%Names_xd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_xd upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_xd)*LEN(InData%Names_xd) ! Names_xd - END IF - Int_BufSz = Int_BufSz + 1 ! Names_z allocated yes/no - IF ( ALLOCATED(InData%Names_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_z upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_z)*LEN(InData%Names_z) ! Names_z - END IF - Int_BufSz = Int_BufSz + 1 ! op_u allocated yes/no - IF ( ALLOCATED(InData%op_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_u) ! op_u - END IF - Int_BufSz = Int_BufSz + 1 ! op_y allocated yes/no - IF ( ALLOCATED(InData%op_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_y) ! op_y - END IF - Int_BufSz = Int_BufSz + 1 ! op_x allocated yes/no - IF ( ALLOCATED(InData%op_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_x upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_x) ! op_x - END IF - Int_BufSz = Int_BufSz + 1 ! op_dx allocated yes/no - IF ( ALLOCATED(InData%op_dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_dx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_dx) ! op_dx - END IF - Int_BufSz = Int_BufSz + 1 ! op_xd allocated yes/no - IF ( ALLOCATED(InData%op_xd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_xd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_xd) ! op_xd - END IF - Int_BufSz = Int_BufSz + 1 ! op_z allocated yes/no - IF ( ALLOCATED(InData%op_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_z) ! op_z - END IF - Int_BufSz = Int_BufSz + 1 ! op_x_eig_mag allocated yes/no - IF ( ALLOCATED(InData%op_x_eig_mag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_x_eig_mag upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%op_x_eig_mag) ! op_x_eig_mag - END IF - Int_BufSz = Int_BufSz + 1 ! op_x_eig_phase allocated yes/no - IF ( ALLOCATED(InData%op_x_eig_phase) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_x_eig_phase upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%op_x_eig_phase) ! op_x_eig_phase - END IF - Int_BufSz = Int_BufSz + 1 ! Use_u allocated yes/no - IF ( ALLOCATED(InData%Use_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Use_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Use_u) ! Use_u - END IF - Int_BufSz = Int_BufSz + 1 ! Use_y allocated yes/no - IF ( ALLOCATED(InData%Use_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Use_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Use_y) ! Use_y - END IF - Int_BufSz = Int_BufSz + 1 ! A allocated yes/no - IF ( ALLOCATED(InData%A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! A upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%A) ! A - END IF - Int_BufSz = Int_BufSz + 1 ! B allocated yes/no - IF ( ALLOCATED(InData%B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%B) ! B - END IF - Int_BufSz = Int_BufSz + 1 ! C allocated yes/no - IF ( ALLOCATED(InData%C) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%C) ! C - END IF - Int_BufSz = Int_BufSz + 1 ! D allocated yes/no - IF ( ALLOCATED(InData%D) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%D) ! D - END IF - Int_BufSz = Int_BufSz + 1 ! StateRotation allocated yes/no - IF ( ALLOCATED(InData%StateRotation) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StateRotation upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StateRotation) ! StateRotation - END IF - Int_BufSz = Int_BufSz + 1 ! StateRel_x allocated yes/no - IF ( ALLOCATED(InData%StateRel_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StateRel_x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StateRel_x) ! StateRel_x - END IF - Int_BufSz = Int_BufSz + 1 ! StateRel_xdot allocated yes/no - IF ( ALLOCATED(InData%StateRel_xdot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StateRel_xdot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StateRel_xdot) ! StateRel_xdot - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_z allocated yes/no - IF ( ALLOCATED(InData%RotFrame_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_z upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_z) ! RotFrame_z - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - Int_BufSz = Int_BufSz + SIZE(InData%SizeLin) ! SizeLin - Int_BufSz = Int_BufSz + SIZE(InData%LinStartIndx) ! LinStartIndx - Int_BufSz = Int_BufSz + 1 ! NumOutputs - 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%Names_u) ) 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%Names_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Names_u,1), UBOUND(InData%Names_u,1) - DO I = 1, LEN(InData%Names_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Names_y) ) 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%Names_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Names_y,1), UBOUND(InData%Names_y,1) - DO I = 1, LEN(InData%Names_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Names_x) ) 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%Names_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Names_x,1), UBOUND(InData%Names_x,1) - DO I = 1, LEN(InData%Names_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Names_xd) ) 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%Names_xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_xd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Names_xd,1), UBOUND(InData%Names_xd,1) - DO I = 1, LEN(InData%Names_xd) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_xd(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Names_z) ) 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%Names_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Names_z,1), UBOUND(InData%Names_z,1) - DO I = 1, LEN(InData%Names_z) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_z(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_u) ) 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%op_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_u,1), UBOUND(InData%op_u,1) - ReKiBuf(Re_Xferred) = InData%op_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_y) ) 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%op_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_y,1), UBOUND(InData%op_y,1) - ReKiBuf(Re_Xferred) = InData%op_y(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_x) ) 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%op_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_x,1), UBOUND(InData%op_x,1) - ReKiBuf(Re_Xferred) = InData%op_x(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_dx) ) 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%op_dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_dx,1), UBOUND(InData%op_dx,1) - ReKiBuf(Re_Xferred) = InData%op_dx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_xd) ) 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%op_xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_xd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_xd,1), UBOUND(InData%op_xd,1) - ReKiBuf(Re_Xferred) = InData%op_xd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_z) ) 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%op_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_z,1), UBOUND(InData%op_z,1) - ReKiBuf(Re_Xferred) = InData%op_z(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_x_eig_mag) ) 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%op_x_eig_mag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x_eig_mag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_x_eig_mag,1), UBOUND(InData%op_x_eig_mag,1) - DbKiBuf(Db_Xferred) = InData%op_x_eig_mag(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_x_eig_phase) ) 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%op_x_eig_phase,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x_eig_phase,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_x_eig_phase,1), UBOUND(InData%op_x_eig_phase,1) - DbKiBuf(Db_Xferred) = InData%op_x_eig_phase(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Use_u) ) 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%Use_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Use_u,1), UBOUND(InData%Use_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Use_y) ) 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%Use_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Use_y,1), UBOUND(InData%Use_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%A) ) 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%A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) - DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) - DbKiBuf(Db_Xferred) = InData%A(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%B) ) 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%B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) - DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) - DbKiBuf(Db_Xferred) = InData%B(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C) ) 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%C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) - DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) - DbKiBuf(Db_Xferred) = InData%C(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D) ) 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%D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D,2), UBOUND(InData%D,2) - DO i1 = LBOUND(InData%D,1), UBOUND(InData%D,1) - DbKiBuf(Db_Xferred) = InData%D(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StateRotation) ) 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%StateRotation,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRotation,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRotation,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRotation,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StateRotation,2), UBOUND(InData%StateRotation,2) - DO i1 = LBOUND(InData%StateRotation,1), UBOUND(InData%StateRotation,1) - DbKiBuf(Db_Xferred) = InData%StateRotation(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StateRel_x) ) 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%StateRel_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StateRel_x,2), UBOUND(InData%StateRel_x,2) - DO i1 = LBOUND(InData%StateRel_x,1), UBOUND(InData%StateRel_x,1) - DbKiBuf(Db_Xferred) = InData%StateRel_x(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StateRel_xdot) ) 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%StateRel_xdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_xdot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_xdot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_xdot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StateRel_xdot,2), UBOUND(InData%StateRel_xdot,2) - DO i1 = LBOUND(InData%StateRel_xdot,1), UBOUND(InData%StateRel_xdot,1) - DbKiBuf(Db_Xferred) = InData%StateRel_xdot(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) 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%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) 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%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) 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%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) 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%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_z) ) 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%RotFrame_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_z,1), UBOUND(InData%RotFrame_z,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_z(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) 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%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%SizeLin,1), UBOUND(InData%SizeLin,1) - IntKiBuf(Int_Xferred) = InData%SizeLin(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinStartIndx,1), UBOUND(InData%LinStartIndx,1) - IntKiBuf(Int_Xferred) = InData%LinStartIndx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NumOutputs - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_PackLinType - - SUBROUTINE FAST_UnPackLinType( 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(FAST_LinType), 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 = 'FAST_UnPackLinType' - ! 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 ! Names_u 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%Names_u)) DEALLOCATE(OutData%Names_u) - ALLOCATE(OutData%Names_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Names_u,1), UBOUND(OutData%Names_u,1) - DO I = 1, LEN(OutData%Names_u) - OutData%Names_u(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 ! Names_y 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%Names_y)) DEALLOCATE(OutData%Names_y) - ALLOCATE(OutData%Names_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Names_y,1), UBOUND(OutData%Names_y,1) - DO I = 1, LEN(OutData%Names_y) - OutData%Names_y(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 ! Names_x 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%Names_x)) DEALLOCATE(OutData%Names_x) - ALLOCATE(OutData%Names_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Names_x,1), UBOUND(OutData%Names_x,1) - DO I = 1, LEN(OutData%Names_x) - OutData%Names_x(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 ! Names_xd 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%Names_xd)) DEALLOCATE(OutData%Names_xd) - ALLOCATE(OutData%Names_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Names_xd,1), UBOUND(OutData%Names_xd,1) - DO I = 1, LEN(OutData%Names_xd) - OutData%Names_xd(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 ! Names_z 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%Names_z)) DEALLOCATE(OutData%Names_z) - ALLOCATE(OutData%Names_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Names_z,1), UBOUND(OutData%Names_z,1) - DO I = 1, LEN(OutData%Names_z) - OutData%Names_z(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 ! op_u 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%op_u)) DEALLOCATE(OutData%op_u) - ALLOCATE(OutData%op_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_u,1), UBOUND(OutData%op_u,1) - OutData%op_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_y 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%op_y)) DEALLOCATE(OutData%op_y) - ALLOCATE(OutData%op_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_y,1), UBOUND(OutData%op_y,1) - OutData%op_y(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x 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%op_x)) DEALLOCATE(OutData%op_x) - ALLOCATE(OutData%op_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_x,1), UBOUND(OutData%op_x,1) - OutData%op_x(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_dx 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%op_dx)) DEALLOCATE(OutData%op_dx) - ALLOCATE(OutData%op_dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_dx,1), UBOUND(OutData%op_dx,1) - OutData%op_dx(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_xd 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%op_xd)) DEALLOCATE(OutData%op_xd) - ALLOCATE(OutData%op_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_xd,1), UBOUND(OutData%op_xd,1) - OutData%op_xd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_z 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%op_z)) DEALLOCATE(OutData%op_z) - ALLOCATE(OutData%op_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_z,1), UBOUND(OutData%op_z,1) - OutData%op_z(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x_eig_mag 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%op_x_eig_mag)) DEALLOCATE(OutData%op_x_eig_mag) - ALLOCATE(OutData%op_x_eig_mag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_mag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_x_eig_mag,1), UBOUND(OutData%op_x_eig_mag,1) - OutData%op_x_eig_mag(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x_eig_phase 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%op_x_eig_phase)) DEALLOCATE(OutData%op_x_eig_phase) - ALLOCATE(OutData%op_x_eig_phase(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_phase.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_x_eig_phase,1), UBOUND(OutData%op_x_eig_phase,1) - OutData%op_x_eig_phase(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_u 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%Use_u)) DEALLOCATE(OutData%Use_u) - ALLOCATE(OutData%Use_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Use_u,1), UBOUND(OutData%Use_u,1) - OutData%Use_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_y 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%Use_y)) DEALLOCATE(OutData%Use_y) - ALLOCATE(OutData%Use_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Use_y,1), UBOUND(OutData%Use_y,1) - OutData%Use_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A 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%A)) DEALLOCATE(OutData%A) - ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) - DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) - OutData%A(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B 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%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) - DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) - OutData%B(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C 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%C)) DEALLOCATE(OutData%C) - ALLOCATE(OutData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) - DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) - OutData%C(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D 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%D)) DEALLOCATE(OutData%D) - ALLOCATE(OutData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D,2), UBOUND(OutData%D,2) - DO i1 = LBOUND(OutData%D,1), UBOUND(OutData%D,1) - OutData%D(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRotation 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%StateRotation)) DEALLOCATE(OutData%StateRotation) - ALLOCATE(OutData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRotation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StateRotation,2), UBOUND(OutData%StateRotation,2) - DO i1 = LBOUND(OutData%StateRotation,1), UBOUND(OutData%StateRotation,1) - OutData%StateRotation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_x 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%StateRel_x)) DEALLOCATE(OutData%StateRel_x) - ALLOCATE(OutData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StateRel_x,2), UBOUND(OutData%StateRel_x,2) - DO i1 = LBOUND(OutData%StateRel_x,1), UBOUND(OutData%StateRel_x,1) - OutData%StateRel_x(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_xdot 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%StateRel_xdot)) DEALLOCATE(OutData%StateRel_xdot) - ALLOCATE(OutData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StateRel_xdot,2), UBOUND(OutData%StateRel_xdot,2) - DO i1 = LBOUND(OutData%StateRel_xdot,1), UBOUND(OutData%StateRel_xdot,1) - OutData%StateRel_xdot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u 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%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u 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%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y 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%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x 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%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_z 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%RotFrame_z)) DEALLOCATE(OutData%RotFrame_z) - ALLOCATE(OutData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_z,1), UBOUND(OutData%RotFrame_z,1) - OutData%RotFrame_z(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_z(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x 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%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%SizeLin,1) - i1_u = UBOUND(OutData%SizeLin,1) - DO i1 = LBOUND(OutData%SizeLin,1), UBOUND(OutData%SizeLin,1) - OutData%SizeLin(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinStartIndx,1) - i1_u = UBOUND(OutData%LinStartIndx,1) - DO i1 = LBOUND(OutData%LinStartIndx,1), UBOUND(OutData%LinStartIndx,1) - OutData%LinStartIndx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NumOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_UnPackLinType - - SUBROUTINE FAST_CopyModLinType( SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ModLinType), INTENT(IN) :: SrcModLinTypeData - TYPE(FAST_ModLinType), INTENT(INOUT) :: DstModLinTypeData - 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 = 'FAST_CopyModLinType' -! + ErrMsg = '' + DstVTK_ModeShapeTypeData%CheckpointRoot = SrcVTK_ModeShapeTypeData%CheckpointRoot + DstVTK_ModeShapeTypeData%MatlabFileName = SrcVTK_ModeShapeTypeData%MatlabFileName + DstVTK_ModeShapeTypeData%VTKLinModes = SrcVTK_ModeShapeTypeData%VTKLinModes + if (allocated(SrcVTK_ModeShapeTypeData%VTKModes)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%VTKModes) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%VTKModes) + if (.not. allocated(DstVTK_ModeShapeTypeData%VTKModes)) then + allocate(DstVTK_ModeShapeTypeData%VTKModes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%VTKModes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%VTKModes = SrcVTK_ModeShapeTypeData%VTKModes + end if + DstVTK_ModeShapeTypeData%VTKLinTim = SrcVTK_ModeShapeTypeData%VTKLinTim + DstVTK_ModeShapeTypeData%VTKNLinTimes = SrcVTK_ModeShapeTypeData%VTKNLinTimes + DstVTK_ModeShapeTypeData%VTKLinScale = SrcVTK_ModeShapeTypeData%VTKLinScale + DstVTK_ModeShapeTypeData%VTKLinPhase = SrcVTK_ModeShapeTypeData%VTKLinPhase + if (allocated(SrcVTK_ModeShapeTypeData%DampingRatio)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampingRatio) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampingRatio) + if (.not. allocated(DstVTK_ModeShapeTypeData%DampingRatio)) then + allocate(DstVTK_ModeShapeTypeData%DampingRatio(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampingRatio.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio + end if + if (allocated(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz) + if (.not. allocated(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) then + allocate(DstVTK_ModeShapeTypeData%NaturalFreq_Hz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%NaturalFreq_Hz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz + end if + if (allocated(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz) + if (.not. allocated(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) then + allocate(DstVTK_ModeShapeTypeData%DampedFreq_Hz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampedFreq_Hz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz + end if + if (allocated(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) then + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_magnitude) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_magnitude) + if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_magnitude)) then + allocate(DstVTK_ModeShapeTypeData%x_eig_magnitude(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_magnitude.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude + end if + if (allocated(SrcVTK_ModeShapeTypeData%x_eig_phase)) then + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_phase) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_phase) + if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_phase)) then + allocate(DstVTK_ModeShapeTypeData%x_eig_phase(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_phase.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%x_eig_phase = SrcVTK_ModeShapeTypeData%x_eig_phase + end if +end subroutine + +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 + character(*), parameter :: RoutineName = 'FAST_DestroyVTK_ModeShapeType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcModLinTypeData%Instance)) THEN - i1_l = LBOUND(SrcModLinTypeData%Instance,1) - i1_u = UBOUND(SrcModLinTypeData%Instance,1) - IF (.NOT. ALLOCATED(DstModLinTypeData%Instance)) THEN - ALLOCATE(DstModLinTypeData%Instance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%Instance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModLinTypeData%Instance,1), UBOUND(SrcModLinTypeData%Instance,1) - CALL FAST_Copylintype( SrcModLinTypeData%Instance(i1), DstModLinTypeData%Instance(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FAST_CopyModLinType - - SUBROUTINE FAST_DestroyModLinType( ModLinTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ModLinType), INTENT(INOUT) :: ModLinTypeData - 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 = 'FAST_DestroyModLinType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ModLinTypeData%Instance)) THEN -DO i1 = LBOUND(ModLinTypeData%Instance,1), UBOUND(ModLinTypeData%Instance,1) - CALL FAST_DestroyLinType( ModLinTypeData%Instance(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModLinTypeData%Instance) -ENDIF - END SUBROUTINE FAST_DestroyModLinType - - SUBROUTINE FAST_PackModLinType( 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(FAST_ModLinType), 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 = 'FAST_PackModLinType' - ! 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 ! Instance allocated yes/no - IF ( ALLOCATED(InData%Instance) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Instance upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Instance - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Instance - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Instance - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%Instance) ) 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%Instance,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Instance,1) - 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 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 - END SUBROUTINE FAST_PackModLinType - - SUBROUTINE FAST_UnPackModLinType( 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(FAST_ModLinType), 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 = 'FAST_UnPackModLinType' - ! 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 ! Instance 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%Instance)) DEALLOCATE(OutData%Instance) - ALLOCATE(OutData%Instance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Instance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Instance,1), UBOUND(OutData%Instance,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 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 - - 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 - END SUBROUTINE FAST_UnPackModLinType - - SUBROUTINE FAST_CopyLinFileType( SrcLinFileTypeData, DstLinFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_LinFileType), INTENT(IN) :: SrcLinFileTypeData - TYPE(FAST_LinFileType), INTENT(INOUT) :: DstLinFileTypeData - 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 = 'FAST_CopyLinFileType' -! + ErrMsg = '' + if (allocated(VTK_ModeShapeTypeData%VTKModes)) then + deallocate(VTK_ModeShapeTypeData%VTKModes) + end if + if (allocated(VTK_ModeShapeTypeData%DampingRatio)) then + deallocate(VTK_ModeShapeTypeData%DampingRatio) + end if + if (allocated(VTK_ModeShapeTypeData%NaturalFreq_Hz)) then + deallocate(VTK_ModeShapeTypeData%NaturalFreq_Hz) + end if + if (allocated(VTK_ModeShapeTypeData%DampedFreq_Hz)) then + deallocate(VTK_ModeShapeTypeData%DampedFreq_Hz) + end if + if (allocated(VTK_ModeShapeTypeData%x_eig_magnitude)) then + deallocate(VTK_ModeShapeTypeData%x_eig_magnitude) + end if + if (allocated(VTK_ModeShapeTypeData%x_eig_phase)) then + deallocate(VTK_ModeShapeTypeData%x_eig_phase) + end if +end subroutine + +subroutine FAST_PackVTK_ModeShapeType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_VTK_ModeShapeType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackVTK_ModeShapeType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%CheckpointRoot) + call RegPack(Buf, InData%MatlabFileName) + call RegPack(Buf, InData%VTKLinModes) + call RegPack(Buf, allocated(InData%VTKModes)) + if (allocated(InData%VTKModes)) then + call RegPackBounds(Buf, 1, lbound(InData%VTKModes), ubound(InData%VTKModes)) + call RegPack(Buf, InData%VTKModes) + end if + call RegPack(Buf, InData%VTKLinTim) + call RegPack(Buf, InData%VTKNLinTimes) + call RegPack(Buf, InData%VTKLinScale) + call RegPack(Buf, InData%VTKLinPhase) + call RegPack(Buf, allocated(InData%DampingRatio)) + if (allocated(InData%DampingRatio)) then + call RegPackBounds(Buf, 1, lbound(InData%DampingRatio), ubound(InData%DampingRatio)) + call RegPack(Buf, InData%DampingRatio) + end if + call RegPack(Buf, allocated(InData%NaturalFreq_Hz)) + if (allocated(InData%NaturalFreq_Hz)) then + call RegPackBounds(Buf, 1, lbound(InData%NaturalFreq_Hz), ubound(InData%NaturalFreq_Hz)) + call RegPack(Buf, InData%NaturalFreq_Hz) + end if + call RegPack(Buf, allocated(InData%DampedFreq_Hz)) + if (allocated(InData%DampedFreq_Hz)) then + call RegPackBounds(Buf, 1, lbound(InData%DampedFreq_Hz), ubound(InData%DampedFreq_Hz)) + call RegPack(Buf, InData%DampedFreq_Hz) + end if + call RegPack(Buf, allocated(InData%x_eig_magnitude)) + if (allocated(InData%x_eig_magnitude)) then + call RegPackBounds(Buf, 3, lbound(InData%x_eig_magnitude), ubound(InData%x_eig_magnitude)) + call RegPack(Buf, InData%x_eig_magnitude) + end if + call RegPack(Buf, allocated(InData%x_eig_phase)) + if (allocated(InData%x_eig_phase)) then + call RegPackBounds(Buf, 3, lbound(InData%x_eig_phase), ubound(InData%x_eig_phase)) + call RegPack(Buf, InData%x_eig_phase) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackVTK_ModeShapeType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_VTK_ModeShapeType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackVTK_ModeShapeType' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%CheckpointRoot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MatlabFileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKLinModes) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%VTKModes)) deallocate(OutData%VTKModes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VTKModes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTKModes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VTKModes) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%VTKLinTim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKNLinTimes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKLinScale) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTKLinPhase) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%DampingRatio)) deallocate(OutData%DampingRatio) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DampingRatio(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampingRatio.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DampingRatio) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%NaturalFreq_Hz)) deallocate(OutData%NaturalFreq_Hz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NaturalFreq_Hz(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NaturalFreq_Hz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NaturalFreq_Hz) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DampedFreq_Hz)) deallocate(OutData%DampedFreq_Hz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DampedFreq_Hz(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampedFreq_Hz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DampedFreq_Hz) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%x_eig_magnitude)) deallocate(OutData%x_eig_magnitude) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_eig_magnitude(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_magnitude.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x_eig_magnitude) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%x_eig_phase)) deallocate(OutData%x_eig_phase) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_eig_phase(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_phase.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x_eig_phase) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(FAST_ParameterType), intent(in) :: SrcParamData + type(FAST_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcLinFileTypeData%Modules,1), UBOUND(SrcLinFileTypeData%Modules,1) - CALL FAST_Copymodlintype( SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL FAST_Copylintype( SrcLinFileTypeData%Glue, DstLinFileTypeData%Glue, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstLinFileTypeData%RotSpeed = SrcLinFileTypeData%RotSpeed - DstLinFileTypeData%Azimuth = SrcLinFileTypeData%Azimuth - DstLinFileTypeData%WindSpeed = SrcLinFileTypeData%WindSpeed - END SUBROUTINE FAST_CopyLinFileType - - SUBROUTINE FAST_DestroyLinFileType( LinFileTypeData, ErrStat, ErrMsg ) - TYPE(FAST_LinFileType), INTENT(INOUT) :: LinFileTypeData - 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 = 'FAST_DestroyLinFileType' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(LinFileTypeData%Modules,1), UBOUND(LinFileTypeData%Modules,1) - CALL FAST_DestroyModLinType( LinFileTypeData%Modules(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL FAST_DestroyLinType( LinFileTypeData%Glue, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyLinFileType - - SUBROUTINE FAST_PackLinFileType( 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(FAST_LinFileType), 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 = 'FAST_PackLinFileType' - ! 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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Modules - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Modules - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Modules - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Glue - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Glue - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Glue - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! Azimuth - Re_BufSz = Re_BufSz + 1 ! WindSpeed - 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 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 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 - 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 - - 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%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Azimuth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WindSpeed - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FAST_PackLinFileType - - SUBROUTINE FAST_UnPackLinFileType( 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(FAST_LinFileType), 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 = 'FAST_UnPackLinFileType' - ! 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 - i1_l = LBOUND(OutData%Modules,1) - i1_u = UBOUND(OutData%Modules,1) - DO i1 = LBOUND(OutData%Modules,1), UBOUND(OutData%Modules,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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - 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 FAST_UnpackLinType( Re_Buf, Db_Buf, Int_Buf, OutData%Glue, ErrStat2, ErrMsg2 ) ! Glue - 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%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Azimuth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FAST_UnPackLinFileType - - SUBROUTINE FAST_CopyMiscLinType( SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_MiscLinType), INTENT(IN) :: SrcMiscLinTypeData - TYPE(FAST_MiscLinType), INTENT(INOUT) :: DstMiscLinTypeData - 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 = 'FAST_CopyMiscLinType' -! + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%DT_module = SrcParamData%DT_module + DstParamData%n_substeps = SrcParamData%n_substeps + DstParamData%n_TMax_m1 = SrcParamData%n_TMax_m1 + DstParamData%TMax = SrcParamData%TMax + DstParamData%InterpOrder = SrcParamData%InterpOrder + DstParamData%NumCrctn = SrcParamData%NumCrctn + DstParamData%KMax = SrcParamData%KMax + DstParamData%numIceLegs = SrcParamData%numIceLegs + DstParamData%nBeams = SrcParamData%nBeams + DstParamData%BD_OutputSibling = SrcParamData%BD_OutputSibling + DstParamData%ModuleInitialized = SrcParamData%ModuleInitialized + DstParamData%DT_Ujac = SrcParamData%DT_Ujac + DstParamData%UJacSclFact = SrcParamData%UJacSclFact + DstParamData%SizeJac_Opt1 = SrcParamData%SizeJac_Opt1 + DstParamData%SolveOption = SrcParamData%SolveOption + DstParamData%CompElast = SrcParamData%CompElast + DstParamData%CompInflow = SrcParamData%CompInflow + DstParamData%CompAero = SrcParamData%CompAero + DstParamData%CompServo = SrcParamData%CompServo + DstParamData%CompSeaSt = SrcParamData%CompSeaSt + DstParamData%CompHydro = SrcParamData%CompHydro + DstParamData%CompSub = SrcParamData%CompSub + DstParamData%CompMooring = SrcParamData%CompMooring + DstParamData%CompIce = SrcParamData%CompIce + DstParamData%MHK = SrcParamData%MHK + DstParamData%UseDWM = SrcParamData%UseDWM + DstParamData%Linearize = SrcParamData%Linearize + DstParamData%WaveFieldMod = SrcParamData%WaveFieldMod + DstParamData%FarmIntegration = SrcParamData%FarmIntegration + DstParamData%TurbinePos = SrcParamData%TurbinePos + DstParamData%Gravity = SrcParamData%Gravity + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%WtrDens = SrcParamData%WtrDens + DstParamData%KinVisc = SrcParamData%KinVisc + DstParamData%SpdSound = SrcParamData%SpdSound + DstParamData%Patm = SrcParamData%Patm + DstParamData%Pvap = SrcParamData%Pvap + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%MSL2SWL = SrcParamData%MSL2SWL + DstParamData%EDFile = SrcParamData%EDFile + DstParamData%BDBldFile = SrcParamData%BDBldFile + DstParamData%InflowFile = SrcParamData%InflowFile + DstParamData%AeroFile = SrcParamData%AeroFile + DstParamData%ServoFile = SrcParamData%ServoFile + DstParamData%SeaStFile = SrcParamData%SeaStFile + DstParamData%HydroFile = SrcParamData%HydroFile + DstParamData%SubFile = SrcParamData%SubFile + DstParamData%MooringFile = SrcParamData%MooringFile + DstParamData%IceFile = SrcParamData%IceFile + DstParamData%TStart = SrcParamData%TStart + DstParamData%DT_Out = SrcParamData%DT_Out + DstParamData%WrSttsTime = SrcParamData%WrSttsTime + DstParamData%n_SttsTime = SrcParamData%n_SttsTime + DstParamData%n_ChkptTime = SrcParamData%n_ChkptTime + DstParamData%n_DT_Out = SrcParamData%n_DT_Out + DstParamData%n_VTKTime = SrcParamData%n_VTKTime + DstParamData%TurbineType = SrcParamData%TurbineType + DstParamData%WrBinOutFile = SrcParamData%WrBinOutFile + DstParamData%WrTxtOutFile = SrcParamData%WrTxtOutFile + DstParamData%WrBinMod = SrcParamData%WrBinMod + DstParamData%SumPrint = SrcParamData%SumPrint + DstParamData%WrVTK = SrcParamData%WrVTK + DstParamData%VTK_Type = SrcParamData%VTK_Type + DstParamData%VTK_fields = SrcParamData%VTK_fields + DstParamData%Delim = SrcParamData%Delim + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutFmt_t = SrcParamData%OutFmt_t + DstParamData%FmtWidth = SrcParamData%FmtWidth + DstParamData%TChanLen = SrcParamData%TChanLen + DstParamData%OutFileRoot = SrcParamData%OutFileRoot + DstParamData%FTitle = SrcParamData%FTitle + DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot + DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth + DstParamData%VTK_fps = SrcParamData%VTK_fps + call FAST_CopyVTK_SurfaceType(SrcParamData%VTK_surface, DstParamData%VTK_surface, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%Tdesc = SrcParamData%Tdesc + DstParamData%CalcSteady = SrcParamData%CalcSteady + DstParamData%TrimCase = SrcParamData%TrimCase + DstParamData%TrimTol = SrcParamData%TrimTol + DstParamData%TrimGain = SrcParamData%TrimGain + DstParamData%Twr_Kdmp = SrcParamData%Twr_Kdmp + DstParamData%Bld_Kdmp = SrcParamData%Bld_Kdmp + DstParamData%NLinTimes = SrcParamData%NLinTimes + DstParamData%AzimDelta = SrcParamData%AzimDelta + DstParamData%LinInputs = SrcParamData%LinInputs + DstParamData%LinOutputs = SrcParamData%LinOutputs + DstParamData%LinOutJac = SrcParamData%LinOutJac + DstParamData%LinOutMod = SrcParamData%LinOutMod + call FAST_CopyVTK_ModeShapeType(SrcParamData%VTK_modes, DstParamData%VTK_modes, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%UseSC = SrcParamData%UseSC + DstParamData%Lin_NumMods = SrcParamData%Lin_NumMods + DstParamData%Lin_ModOrder = SrcParamData%Lin_ModOrder + DstParamData%LinInterpOrder = SrcParamData%LinInterpOrder +end subroutine + +subroutine FAST_DestroyParam(ParamData, ErrStat, ErrMsg) + type(FAST_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyParam' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscLinTypeData%LinTimes)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%LinTimes,1) - i1_u = UBOUND(SrcMiscLinTypeData%LinTimes,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%LinTimes)) THEN - ALLOCATE(DstMiscLinTypeData%LinTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%LinTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%LinTimes = SrcMiscLinTypeData%LinTimes -ENDIF - DstMiscLinTypeData%CopyOP_CtrlCode = SrcMiscLinTypeData%CopyOP_CtrlCode -IF (ALLOCATED(SrcMiscLinTypeData%AzimTarget)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%AzimTarget,1) - i1_u = UBOUND(SrcMiscLinTypeData%AzimTarget,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%AzimTarget)) THEN - ALLOCATE(DstMiscLinTypeData%AzimTarget(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%AzimTarget.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%AzimTarget = SrcMiscLinTypeData%AzimTarget -ENDIF - DstMiscLinTypeData%IsConverged = SrcMiscLinTypeData%IsConverged - DstMiscLinTypeData%FoundSteady = SrcMiscLinTypeData%FoundSteady - DstMiscLinTypeData%ForceLin = SrcMiscLinTypeData%ForceLin - DstMiscLinTypeData%n_rot = SrcMiscLinTypeData%n_rot - DstMiscLinTypeData%AzimIndx = SrcMiscLinTypeData%AzimIndx - DstMiscLinTypeData%NextLinTimeIndx = SrcMiscLinTypeData%NextLinTimeIndx -IF (ALLOCATED(SrcMiscLinTypeData%Psi)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%Psi,1) - i1_u = UBOUND(SrcMiscLinTypeData%Psi,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%Psi)) THEN - ALLOCATE(DstMiscLinTypeData%Psi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Psi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%Psi = SrcMiscLinTypeData%Psi -ENDIF -IF (ALLOCATED(SrcMiscLinTypeData%y_interp)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%y_interp,1) - i1_u = UBOUND(SrcMiscLinTypeData%y_interp,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_interp)) THEN - ALLOCATE(DstMiscLinTypeData%y_interp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_interp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%y_interp = SrcMiscLinTypeData%y_interp -ENDIF -IF (ALLOCATED(SrcMiscLinTypeData%y_ref)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%y_ref,1) - i1_u = UBOUND(SrcMiscLinTypeData%y_ref,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_ref)) THEN - ALLOCATE(DstMiscLinTypeData%y_ref(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_ref.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%y_ref = SrcMiscLinTypeData%y_ref -ENDIF -IF (ALLOCATED(SrcMiscLinTypeData%Y_prevRot)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,1) - i1_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,1) - i2_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,2) - i2_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,2) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%Y_prevRot)) THEN - ALLOCATE(DstMiscLinTypeData%Y_prevRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Y_prevRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%Y_prevRot = SrcMiscLinTypeData%Y_prevRot -ENDIF - END SUBROUTINE FAST_CopyMiscLinType - - SUBROUTINE FAST_DestroyMiscLinType( MiscLinTypeData, ErrStat, ErrMsg ) - TYPE(FAST_MiscLinType), INTENT(INOUT) :: MiscLinTypeData - 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 = 'FAST_DestroyMiscLinType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscLinTypeData%LinTimes)) THEN - DEALLOCATE(MiscLinTypeData%LinTimes) -ENDIF -IF (ALLOCATED(MiscLinTypeData%AzimTarget)) THEN - DEALLOCATE(MiscLinTypeData%AzimTarget) -ENDIF -IF (ALLOCATED(MiscLinTypeData%Psi)) THEN - DEALLOCATE(MiscLinTypeData%Psi) -ENDIF -IF (ALLOCATED(MiscLinTypeData%y_interp)) THEN - DEALLOCATE(MiscLinTypeData%y_interp) -ENDIF -IF (ALLOCATED(MiscLinTypeData%y_ref)) THEN - DEALLOCATE(MiscLinTypeData%y_ref) -ENDIF -IF (ALLOCATED(MiscLinTypeData%Y_prevRot)) THEN - DEALLOCATE(MiscLinTypeData%Y_prevRot) -ENDIF - END SUBROUTINE FAST_DestroyMiscLinType - - SUBROUTINE FAST_PackMiscLinType( 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(FAST_MiscLinType), 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 = 'FAST_PackMiscLinType' - ! 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 ! LinTimes allocated yes/no - IF ( ALLOCATED(InData%LinTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LinTimes) ! LinTimes - END IF - Int_BufSz = Int_BufSz + 1 ! CopyOP_CtrlCode - Int_BufSz = Int_BufSz + 1 ! AzimTarget allocated yes/no - IF ( ALLOCATED(InData%AzimTarget) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AzimTarget upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%AzimTarget) ! AzimTarget - END IF - Int_BufSz = Int_BufSz + 1 ! IsConverged - Int_BufSz = Int_BufSz + 1 ! FoundSteady - Int_BufSz = Int_BufSz + 1 ! ForceLin - Int_BufSz = Int_BufSz + 1 ! n_rot - Int_BufSz = Int_BufSz + 1 ! AzimIndx - Int_BufSz = Int_BufSz + 1 ! NextLinTimeIndx - Int_BufSz = Int_BufSz + 1 ! Psi allocated yes/no - IF ( ALLOCATED(InData%Psi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Psi upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Psi) ! Psi - END IF - Int_BufSz = Int_BufSz + 1 ! y_interp allocated yes/no - IF ( ALLOCATED(InData%y_interp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_interp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y_interp) ! y_interp - END IF - Int_BufSz = Int_BufSz + 1 ! y_ref allocated yes/no - IF ( ALLOCATED(InData%y_ref) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_ref upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y_ref) ! y_ref - END IF - Int_BufSz = Int_BufSz + 1 ! Y_prevRot allocated yes/no - IF ( ALLOCATED(InData%Y_prevRot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Y_prevRot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y_prevRot) ! Y_prevRot - 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%LinTimes) ) 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%LinTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinTimes,1), UBOUND(InData%LinTimes,1) - DbKiBuf(Db_Xferred) = InData%LinTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%CopyOP_CtrlCode - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AzimTarget) ) 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%AzimTarget,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AzimTarget,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AzimTarget,1), UBOUND(InData%AzimTarget,1) - DbKiBuf(Db_Xferred) = InData%AzimTarget(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsConverged, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FoundSteady, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ForceLin, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_rot - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AzimIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NextLinTimeIndx - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Psi) ) 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%Psi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Psi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Psi,1), UBOUND(InData%Psi,1) - DbKiBuf(Db_Xferred) = InData%Psi(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y_interp) ) 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%y_interp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_interp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) - ReKiBuf(Re_Xferred) = InData%y_interp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y_ref) ) 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%y_ref,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_ref,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_ref,1), UBOUND(InData%y_ref,1) - ReKiBuf(Re_Xferred) = InData%y_ref(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y_prevRot) ) 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%Y_prevRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_prevRot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y_prevRot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_prevRot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Y_prevRot,2), UBOUND(InData%Y_prevRot,2) - DO i1 = LBOUND(InData%Y_prevRot,1), UBOUND(InData%Y_prevRot,1) - ReKiBuf(Re_Xferred) = InData%Y_prevRot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_PackMiscLinType - - SUBROUTINE FAST_UnPackMiscLinType( 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(FAST_MiscLinType), 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 = 'FAST_UnPackMiscLinType' - ! 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 ! LinTimes 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%LinTimes)) DEALLOCATE(OutData%LinTimes) - ALLOCATE(OutData%LinTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinTimes,1), UBOUND(OutData%LinTimes,1) - OutData%LinTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%CopyOP_CtrlCode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AzimTarget 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%AzimTarget)) DEALLOCATE(OutData%AzimTarget) - ALLOCATE(OutData%AzimTarget(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimTarget.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AzimTarget,1), UBOUND(OutData%AzimTarget,1) - OutData%AzimTarget(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%IsConverged = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsConverged) - Int_Xferred = Int_Xferred + 1 - OutData%FoundSteady = TRANSFER(IntKiBuf(Int_Xferred), OutData%FoundSteady) - Int_Xferred = Int_Xferred + 1 - OutData%ForceLin = TRANSFER(IntKiBuf(Int_Xferred), OutData%ForceLin) - Int_Xferred = Int_Xferred + 1 - OutData%n_rot = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AzimIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NextLinTimeIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Psi 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%Psi)) DEALLOCATE(OutData%Psi) - ALLOCATE(OutData%Psi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Psi,1), UBOUND(OutData%Psi,1) - OutData%Psi(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_interp 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%y_interp)) DEALLOCATE(OutData%y_interp) - ALLOCATE(OutData%y_interp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_interp,1), UBOUND(OutData%y_interp,1) - OutData%y_interp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_ref 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%y_ref)) DEALLOCATE(OutData%y_ref) - ALLOCATE(OutData%y_ref(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_ref.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_ref,1), UBOUND(OutData%y_ref,1) - OutData%y_ref(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_prevRot 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%Y_prevRot)) DEALLOCATE(OutData%Y_prevRot) - ALLOCATE(OutData%Y_prevRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_prevRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Y_prevRot,2), UBOUND(OutData%Y_prevRot,2) - DO i1 = LBOUND(OutData%Y_prevRot,1), UBOUND(OutData%Y_prevRot,1) - OutData%Y_prevRot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_UnPackMiscLinType - - SUBROUTINE FAST_CopyOutputFileType( SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_OutputFileType), INTENT(INOUT) :: SrcOutputFileTypeData - TYPE(FAST_OutputFileType), INTENT(INOUT) :: DstOutputFileTypeData - 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 = 'FAST_CopyOutputFileType' -! + ErrMsg = '' + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%DT_module) + call RegPack(Buf, InData%n_substeps) + call RegPack(Buf, InData%n_TMax_m1) + call RegPack(Buf, InData%TMax) + call RegPack(Buf, InData%InterpOrder) + call RegPack(Buf, InData%NumCrctn) + call RegPack(Buf, InData%KMax) + call RegPack(Buf, InData%numIceLegs) + call RegPack(Buf, InData%nBeams) + call RegPack(Buf, InData%BD_OutputSibling) + call RegPack(Buf, InData%ModuleInitialized) + call RegPack(Buf, InData%DT_Ujac) + call RegPack(Buf, InData%UJacSclFact) + call RegPack(Buf, InData%SizeJac_Opt1) + call RegPack(Buf, InData%SolveOption) + call RegPack(Buf, InData%CompElast) + call RegPack(Buf, InData%CompInflow) + call RegPack(Buf, InData%CompAero) + call RegPack(Buf, InData%CompServo) + call RegPack(Buf, InData%CompSeaSt) + call RegPack(Buf, InData%CompHydro) + call RegPack(Buf, InData%CompSub) + call RegPack(Buf, InData%CompMooring) + call RegPack(Buf, InData%CompIce) + call RegPack(Buf, InData%MHK) + call RegPack(Buf, InData%UseDWM) + call RegPack(Buf, InData%Linearize) + call RegPack(Buf, InData%WaveFieldMod) + call RegPack(Buf, InData%FarmIntegration) + call RegPack(Buf, InData%TurbinePos) + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%AirDens) + call RegPack(Buf, InData%WtrDens) + call RegPack(Buf, InData%KinVisc) + call RegPack(Buf, InData%SpdSound) + call RegPack(Buf, InData%Patm) + call RegPack(Buf, InData%Pvap) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%MSL2SWL) + call RegPack(Buf, InData%EDFile) + call RegPack(Buf, InData%BDBldFile) + call RegPack(Buf, InData%InflowFile) + call RegPack(Buf, InData%AeroFile) + call RegPack(Buf, InData%ServoFile) + call RegPack(Buf, InData%SeaStFile) + call RegPack(Buf, InData%HydroFile) + call RegPack(Buf, InData%SubFile) + call RegPack(Buf, InData%MooringFile) + call RegPack(Buf, InData%IceFile) + call RegPack(Buf, InData%TStart) + call RegPack(Buf, InData%DT_Out) + call RegPack(Buf, InData%WrSttsTime) + call RegPack(Buf, InData%n_SttsTime) + call RegPack(Buf, InData%n_ChkptTime) + call RegPack(Buf, InData%n_DT_Out) + call RegPack(Buf, InData%n_VTKTime) + call RegPack(Buf, InData%TurbineType) + call RegPack(Buf, InData%WrBinOutFile) + call RegPack(Buf, InData%WrTxtOutFile) + call RegPack(Buf, InData%WrBinMod) + call RegPack(Buf, InData%SumPrint) + call RegPack(Buf, InData%WrVTK) + call RegPack(Buf, InData%VTK_Type) + call RegPack(Buf, InData%VTK_fields) + call RegPack(Buf, InData%Delim) + call RegPack(Buf, InData%OutFmt) + call RegPack(Buf, InData%OutFmt_t) + call RegPack(Buf, InData%FmtWidth) + call RegPack(Buf, InData%TChanLen) + call RegPack(Buf, InData%OutFileRoot) + call RegPack(Buf, InData%FTitle) + call RegPack(Buf, InData%VTK_OutFileRoot) + call RegPack(Buf, InData%VTK_tWidth) + call RegPack(Buf, InData%VTK_fps) + call FAST_PackVTK_SurfaceType(Buf, InData%VTK_surface) + call RegPack(Buf, InData%Tdesc) + call RegPack(Buf, InData%CalcSteady) + call RegPack(Buf, InData%TrimCase) + call RegPack(Buf, InData%TrimTol) + call RegPack(Buf, InData%TrimGain) + call RegPack(Buf, InData%Twr_Kdmp) + call RegPack(Buf, InData%Bld_Kdmp) + call RegPack(Buf, InData%NLinTimes) + call RegPack(Buf, InData%AzimDelta) + call RegPack(Buf, InData%LinInputs) + call RegPack(Buf, InData%LinOutputs) + call RegPack(Buf, InData%LinOutJac) + call RegPack(Buf, InData%LinOutMod) + call FAST_PackVTK_ModeShapeType(Buf, InData%VTK_modes) + call RegPack(Buf, InData%UseSC) + call RegPack(Buf, InData%Lin_NumMods) + call RegPack(Buf, InData%Lin_ModOrder) + call RegPack(Buf, InData%LinInterpOrder) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackParam' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DT_module) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_substeps) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_TMax_m1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InterpOrder) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumCrctn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%KMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%numIceLegs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nBeams) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BD_OutputSibling) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ModuleInitialized) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DT_Ujac) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UJacSclFact) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SizeJac_Opt1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SolveOption) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompElast) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompInflow) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompAero) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompServo) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompSeaSt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompHydro) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompSub) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompMooring) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CompIce) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UseDWM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FarmIntegration) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TurbinePos) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Patm) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Pvap) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EDFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BDBldFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InflowFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AeroFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ServoFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SeaStFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HydroFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SubFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MooringFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IceFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TStart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DT_Out) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrSttsTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_SttsTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_ChkptTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_DT_Out) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_VTKTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TurbineType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrBinOutFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrTxtOutFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrBinMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrVTK) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTK_Type) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTK_fields) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt_t) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FmtWidth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TChanLen) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FTitle) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTK_OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTK_tWidth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTK_fps) + if (RegCheckErr(Buf, RoutineName)) return + call FAST_UnpackVTK_SurfaceType(Buf, OutData%VTK_surface) ! VTK_surface + call RegUnpack(Buf, OutData%Tdesc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CalcSteady) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TrimCase) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TrimTol) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TrimGain) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Twr_Kdmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Bld_Kdmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NLinTimes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AzimDelta) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinInputs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinOutputs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinOutJac) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinOutMod) + if (RegCheckErr(Buf, RoutineName)) return + call FAST_UnpackVTK_ModeShapeType(Buf, OutData%VTK_modes) ! VTK_modes + call RegUnpack(Buf, OutData%UseSC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Lin_NumMods) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Lin_ModOrder) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinInterpOrder) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlCode, ErrStat, ErrMsg) + type(FAST_LinStateSave), intent(inout) :: SrcLinStateSaveData + type(FAST_LinStateSave), intent(inout) :: DstLinStateSaveData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyLinStateSave' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputFileTypeData%TimeData)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%TimeData,1) - i1_u = UBOUND(SrcOutputFileTypeData%TimeData,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%TimeData)) THEN - ALLOCATE(DstOutputFileTypeData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData -ENDIF -IF (ALLOCATED(SrcOutputFileTypeData%AllOutData)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%AllOutData,1) - i1_u = UBOUND(SrcOutputFileTypeData%AllOutData,1) - i2_l = LBOUND(SrcOutputFileTypeData%AllOutData,2) - i2_u = UBOUND(SrcOutputFileTypeData%AllOutData,2) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%AllOutData)) THEN - ALLOCATE(DstOutputFileTypeData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%AllOutData = SrcOutputFileTypeData%AllOutData -ENDIF - DstOutputFileTypeData%n_Out = SrcOutputFileTypeData%n_Out - DstOutputFileTypeData%NOutSteps = SrcOutputFileTypeData%NOutSteps - DstOutputFileTypeData%numOuts = SrcOutputFileTypeData%numOuts - DstOutputFileTypeData%UnOu = SrcOutputFileTypeData%UnOu - DstOutputFileTypeData%UnSum = SrcOutputFileTypeData%UnSum - DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra - DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines -IF (ALLOCATED(SrcOutputFileTypeData%ChannelNames)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%ChannelNames,1) - i1_u = UBOUND(SrcOutputFileTypeData%ChannelNames,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelNames)) THEN - ALLOCATE(DstOutputFileTypeData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames -ENDIF -IF (ALLOCATED(SrcOutputFileTypeData%ChannelUnits)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%ChannelUnits,1) - i1_u = UBOUND(SrcOutputFileTypeData%ChannelUnits,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelUnits)) THEN - ALLOCATE(DstOutputFileTypeData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits -ENDIF - DO i1 = LBOUND(SrcOutputFileTypeData%Module_Ver,1), UBOUND(SrcOutputFileTypeData%Module_Ver,1) - CALL NWTC_Library_Copyprogdesc( SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DstOutputFileTypeData%Module_Abrev = SrcOutputFileTypeData%Module_Abrev - DstOutputFileTypeData%WriteThisStep = SrcOutputFileTypeData%WriteThisStep - DstOutputFileTypeData%VTK_count = SrcOutputFileTypeData%VTK_count - DstOutputFileTypeData%VTK_LastWaveIndx = SrcOutputFileTypeData%VTK_LastWaveIndx - CALL FAST_Copylinfiletype( SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstOutputFileTypeData%ActualChanLen = SrcOutputFileTypeData%ActualChanLen - CALL FAST_Copylinstatesave( SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput - END SUBROUTINE FAST_CopyOutputFileType - - SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg ) - TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutputFileTypeData - 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 = 'FAST_DestroyOutputFileType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputFileTypeData%TimeData)) THEN - DEALLOCATE(OutputFileTypeData%TimeData) -ENDIF -IF (ALLOCATED(OutputFileTypeData%AllOutData)) THEN - DEALLOCATE(OutputFileTypeData%AllOutData) -ENDIF -IF (ALLOCATED(OutputFileTypeData%ChannelNames)) THEN - DEALLOCATE(OutputFileTypeData%ChannelNames) -ENDIF -IF (ALLOCATED(OutputFileTypeData%ChannelUnits)) THEN - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL FAST_DestroyLinFileType( OutputFileTypeData%Lin, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyLinStateSave( OutputFileTypeData%op, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyOutputFileType - - SUBROUTINE FAST_PackOutputFileType( 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(FAST_OutputFileType), 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 = 'FAST_PackOutputFileType' - ! 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 ! TimeData allocated yes/no - IF ( ALLOCATED(InData%TimeData) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TimeData upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TimeData) ! TimeData - END IF - Int_BufSz = Int_BufSz + 1 ! AllOutData allocated yes/no - IF ( ALLOCATED(InData%AllOutData) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AllOutData upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOutData) ! AllOutData - END IF - Int_BufSz = Int_BufSz + 1 ! n_Out - Int_BufSz = Int_BufSz + 1 ! NOutSteps - Int_BufSz = Int_BufSz + SIZE(InData%numOuts) ! numOuts - Int_BufSz = Int_BufSz + 1 ! UnOu - Int_BufSz = Int_BufSz + 1 ! UnSum - Int_BufSz = Int_BufSz + 1 ! UnGra - Int_BufSz = Int_BufSz + SIZE(InData%FileDescLines)*LEN(InData%FileDescLines) ! FileDescLines - Int_BufSz = Int_BufSz + 1 ! ChannelNames allocated yes/no - IF ( ALLOCATED(InData%ChannelNames) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChannelNames upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChannelNames)*LEN(InData%ChannelNames) ! ChannelNames - END IF - Int_BufSz = Int_BufSz + 1 ! ChannelUnits allocated yes/no - IF ( ALLOCATED(InData%ChannelUnits) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChannelUnits upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChannelUnits)*LEN(InData%ChannelUnits) ! ChannelUnits - END IF - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Module_Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Module_Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Module_Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + SIZE(InData%Module_Abrev)*LEN(InData%Module_Abrev) ! Module_Abrev - Int_BufSz = Int_BufSz + 1 ! WriteThisStep - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Lin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Lin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Lin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! op - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! op - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! op - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + SIZE(InData%DriverWriteOutput) ! DriverWriteOutput - 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%TimeData) ) 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%TimeData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TimeData,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TimeData,1), UBOUND(InData%TimeData,1) - DbKiBuf(Db_Xferred) = InData%TimeData(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AllOutData) ) 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%AllOutData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AllOutData,2), UBOUND(InData%AllOutData,2) - DO i1 = LBOUND(InData%AllOutData,1), UBOUND(InData%AllOutData,1) - ReKiBuf(Re_Xferred) = InData%AllOutData(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n_Out - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutSteps - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%numOuts,1), UBOUND(InData%numOuts,1) - IntKiBuf(Int_Xferred) = InData%numOuts(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%UnOu - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnGra - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%FileDescLines,1), UBOUND(InData%FileDescLines,1) - DO I = 1, LEN(InData%FileDescLines) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileDescLines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - IF ( .NOT. ALLOCATED(InData%ChannelNames) ) 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%ChannelNames,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelNames,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ChannelNames,1), UBOUND(InData%ChannelNames,1) - DO I = 1, LEN(InData%ChannelNames) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ChannelUnits) ) 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%ChannelUnits,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelUnits,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ChannelUnits,1), UBOUND(InData%ChannelUnits,1) - DO I = 1, LEN(InData%ChannelUnits) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelUnits(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 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 - DO i1 = LBOUND(InData%Module_Abrev,1), UBOUND(InData%Module_Abrev,1) - DO I = 1, LEN(InData%Module_Abrev) - IntKiBuf(Int_Xferred) = ICHAR(InData%Module_Abrev(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%WriteThisStep, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTK_count - 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 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%ActualChanLen - Int_Xferred = Int_Xferred + 1 - 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 - - 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 - DO i1 = LBOUND(InData%DriverWriteOutput,1), UBOUND(InData%DriverWriteOutput,1) - ReKiBuf(Re_Xferred) = InData%DriverWriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FAST_PackOutputFileType - - SUBROUTINE FAST_UnPackOutputFileType( 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(FAST_OutputFileType), 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 = 'FAST_UnPackOutputFileType' - ! 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 ! TimeData 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%TimeData)) DEALLOCATE(OutData%TimeData) - ALLOCATE(OutData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TimeData,1), UBOUND(OutData%TimeData,1) - OutData%TimeData(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOutData 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%AllOutData)) DEALLOCATE(OutData%AllOutData) - ALLOCATE(OutData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AllOutData,2), UBOUND(OutData%AllOutData,2) - DO i1 = LBOUND(OutData%AllOutData,1), UBOUND(OutData%AllOutData,1) - OutData%AllOutData(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%n_Out = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%numOuts,1) - i1_u = UBOUND(OutData%numOuts,1) - DO i1 = LBOUND(OutData%numOuts,1), UBOUND(OutData%numOuts,1) - OutData%numOuts(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%UnOu = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnGra = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%FileDescLines,1) - i1_u = UBOUND(OutData%FileDescLines,1) - DO i1 = LBOUND(OutData%FileDescLines,1), UBOUND(OutData%FileDescLines,1) - DO I = 1, LEN(OutData%FileDescLines) - OutData%FileDescLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChannelNames 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%ChannelNames)) DEALLOCATE(OutData%ChannelNames) - ALLOCATE(OutData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ChannelNames,1), UBOUND(OutData%ChannelNames,1) - DO I = 1, LEN(OutData%ChannelNames) - OutData%ChannelNames(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 ! ChannelUnits 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%ChannelUnits)) DEALLOCATE(OutData%ChannelUnits) - ALLOCATE(OutData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ChannelUnits,1), UBOUND(OutData%ChannelUnits,1) - DO I = 1, LEN(OutData%ChannelUnits) - OutData%ChannelUnits(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - i1_l = LBOUND(OutData%Module_Ver,1) - i1_u = UBOUND(OutData%Module_Ver,1) - DO i1 = LBOUND(OutData%Module_Ver,1), UBOUND(OutData%Module_Ver,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_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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%Module_Abrev,1) - i1_u = UBOUND(OutData%Module_Abrev,1) - DO i1 = LBOUND(OutData%Module_Abrev,1), UBOUND(OutData%Module_Abrev,1) - DO I = 1, LEN(OutData%Module_Abrev) - OutData%Module_Abrev(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - OutData%WriteThisStep = TRANSFER(IntKiBuf(Int_Xferred), OutData%WriteThisStep) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_count = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_LastWaveIndx = 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 FAST_UnpackLinFileType( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin - 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%ActualChanLen = 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 FAST_UnpackLinStateSave( Re_Buf, Db_Buf, Int_Buf, OutData%op, ErrStat2, ErrMsg2 ) ! op - 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) - i1_l = LBOUND(OutData%DriverWriteOutput,1) - i1_u = UBOUND(OutData%DriverWriteOutput,1) - DO i1 = LBOUND(OutData%DriverWriteOutput,1), UBOUND(OutData%DriverWriteOutput,1) - OutData%DriverWriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FAST_UnPackOutputFileType - - SUBROUTINE FAST_CopyIceDyn_Data( SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceDyn_Data), INTENT(INOUT) :: SrcIceDyn_DataData - TYPE(IceDyn_Data), INTENT(INOUT) :: DstIceDyn_DataData - 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 = 'FAST_CopyIceDyn_Data' -! + ErrMsg = '' + if (allocated(SrcLinStateSaveData%x_IceD)) then + LB(1:2) = lbound(SrcLinStateSaveData%x_IceD) + UB(1:2) = ubound(SrcLinStateSaveData%x_IceD) + if (.not. allocated(DstLinStateSaveData%x_IceD)) then + allocate(DstLinStateSaveData%x_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyContState(SrcLinStateSaveData%x_IceD(i1,i2), DstLinStateSaveData%x_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%xd_IceD)) then + LB(1:2) = lbound(SrcLinStateSaveData%xd_IceD) + UB(1:2) = ubound(SrcLinStateSaveData%xd_IceD) + if (.not. allocated(DstLinStateSaveData%xd_IceD)) then + allocate(DstLinStateSaveData%xd_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyDiscState(SrcLinStateSaveData%xd_IceD(i1,i2), DstLinStateSaveData%xd_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%z_IceD)) then + LB(1:2) = lbound(SrcLinStateSaveData%z_IceD) + UB(1:2) = ubound(SrcLinStateSaveData%z_IceD) + if (.not. allocated(DstLinStateSaveData%z_IceD)) then + allocate(DstLinStateSaveData%z_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyConstrState(SrcLinStateSaveData%z_IceD(i1,i2), DstLinStateSaveData%z_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_IceD)) then + LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_IceD) + UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_IceD) + if (.not. allocated(DstLinStateSaveData%OtherSt_IceD)) then + allocate(DstLinStateSaveData%OtherSt_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyOtherState(SrcLinStateSaveData%OtherSt_IceD(i1,i2), DstLinStateSaveData%OtherSt_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%u_IceD)) then + LB(1:2) = lbound(SrcLinStateSaveData%u_IceD) + UB(1:2) = ubound(SrcLinStateSaveData%u_IceD) + if (.not. allocated(DstLinStateSaveData%u_IceD)) then + allocate(DstLinStateSaveData%u_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyInput(SrcLinStateSaveData%u_IceD(i1,i2), DstLinStateSaveData%u_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%x_BD)) then + LB(1:2) = lbound(SrcLinStateSaveData%x_BD) + UB(1:2) = ubound(SrcLinStateSaveData%x_BD) + if (.not. allocated(DstLinStateSaveData%x_BD)) then + allocate(DstLinStateSaveData%x_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyContState(SrcLinStateSaveData%x_BD(i1,i2), DstLinStateSaveData%x_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%xd_BD)) then + LB(1:2) = lbound(SrcLinStateSaveData%xd_BD) + UB(1:2) = ubound(SrcLinStateSaveData%xd_BD) + if (.not. allocated(DstLinStateSaveData%xd_BD)) then + allocate(DstLinStateSaveData%xd_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyDiscState(SrcLinStateSaveData%xd_BD(i1,i2), DstLinStateSaveData%xd_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%z_BD)) then + LB(1:2) = lbound(SrcLinStateSaveData%z_BD) + UB(1:2) = ubound(SrcLinStateSaveData%z_BD) + if (.not. allocated(DstLinStateSaveData%z_BD)) then + allocate(DstLinStateSaveData%z_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyConstrState(SrcLinStateSaveData%z_BD(i1,i2), DstLinStateSaveData%z_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_BD)) then + LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_BD) + UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_BD) + if (.not. allocated(DstLinStateSaveData%OtherSt_BD)) then + allocate(DstLinStateSaveData%OtherSt_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyOtherState(SrcLinStateSaveData%OtherSt_BD(i1,i2), DstLinStateSaveData%OtherSt_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%u_BD)) then + LB(1:2) = lbound(SrcLinStateSaveData%u_BD) + UB(1:2) = ubound(SrcLinStateSaveData%u_BD) + if (.not. allocated(DstLinStateSaveData%u_BD)) then + allocate(DstLinStateSaveData%u_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyInput(SrcLinStateSaveData%u_BD(i1,i2), DstLinStateSaveData%u_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%x_ED)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_ED) + UB(1:1) = ubound(SrcLinStateSaveData%x_ED) + if (.not. allocated(DstLinStateSaveData%x_ED)) then + allocate(DstLinStateSaveData%x_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyContState(SrcLinStateSaveData%x_ED(i1), DstLinStateSaveData%x_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_ED)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_ED) + UB(1:1) = ubound(SrcLinStateSaveData%xd_ED) + if (.not. allocated(DstLinStateSaveData%xd_ED)) then + allocate(DstLinStateSaveData%xd_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyDiscState(SrcLinStateSaveData%xd_ED(i1), DstLinStateSaveData%xd_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_ED)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_ED) + UB(1:1) = ubound(SrcLinStateSaveData%z_ED) + if (.not. allocated(DstLinStateSaveData%z_ED)) then + allocate(DstLinStateSaveData%z_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyConstrState(SrcLinStateSaveData%z_ED(i1), DstLinStateSaveData%z_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_ED)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ED) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ED) + if (.not. allocated(DstLinStateSaveData%OtherSt_ED)) then + allocate(DstLinStateSaveData%OtherSt_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyOtherState(SrcLinStateSaveData%OtherSt_ED(i1), DstLinStateSaveData%OtherSt_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_ED)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_ED) + UB(1:1) = ubound(SrcLinStateSaveData%u_ED) + if (.not. allocated(DstLinStateSaveData%u_ED)) then + allocate(DstLinStateSaveData%u_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyInput(SrcLinStateSaveData%u_ED(i1), DstLinStateSaveData%u_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_SrvD)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_SrvD) + UB(1:1) = ubound(SrcLinStateSaveData%x_SrvD) + if (.not. allocated(DstLinStateSaveData%x_SrvD)) then + allocate(DstLinStateSaveData%x_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SrvD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyContState(SrcLinStateSaveData%x_SrvD(i1), DstLinStateSaveData%x_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_SrvD)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_SrvD) + UB(1:1) = ubound(SrcLinStateSaveData%xd_SrvD) + if (.not. allocated(DstLinStateSaveData%xd_SrvD)) then + allocate(DstLinStateSaveData%xd_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SrvD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyDiscState(SrcLinStateSaveData%xd_SrvD(i1), DstLinStateSaveData%xd_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_SrvD)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_SrvD) + UB(1:1) = ubound(SrcLinStateSaveData%z_SrvD) + if (.not. allocated(DstLinStateSaveData%z_SrvD)) then + allocate(DstLinStateSaveData%z_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SrvD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyConstrState(SrcLinStateSaveData%z_SrvD(i1), DstLinStateSaveData%z_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_SrvD)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SrvD) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SrvD) + if (.not. allocated(DstLinStateSaveData%OtherSt_SrvD)) then + allocate(DstLinStateSaveData%OtherSt_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SrvD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyOtherState(SrcLinStateSaveData%OtherSt_SrvD(i1), DstLinStateSaveData%OtherSt_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_SrvD)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_SrvD) + UB(1:1) = ubound(SrcLinStateSaveData%u_SrvD) + if (.not. allocated(DstLinStateSaveData%u_SrvD)) then + allocate(DstLinStateSaveData%u_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SrvD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyInput(SrcLinStateSaveData%u_SrvD(i1), DstLinStateSaveData%u_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_AD)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_AD) + UB(1:1) = ubound(SrcLinStateSaveData%x_AD) + if (.not. allocated(DstLinStateSaveData%x_AD)) then + allocate(DstLinStateSaveData%x_AD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_AD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyContState(SrcLinStateSaveData%x_AD(i1), DstLinStateSaveData%x_AD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_AD)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_AD) + UB(1:1) = ubound(SrcLinStateSaveData%xd_AD) + if (.not. allocated(DstLinStateSaveData%xd_AD)) then + allocate(DstLinStateSaveData%xd_AD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_AD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyDiscState(SrcLinStateSaveData%xd_AD(i1), DstLinStateSaveData%xd_AD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_AD)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_AD) + UB(1:1) = ubound(SrcLinStateSaveData%z_AD) + if (.not. allocated(DstLinStateSaveData%z_AD)) then + allocate(DstLinStateSaveData%z_AD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_AD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyConstrState(SrcLinStateSaveData%z_AD(i1), DstLinStateSaveData%z_AD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_AD)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_AD) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_AD) + if (.not. allocated(DstLinStateSaveData%OtherSt_AD)) then + allocate(DstLinStateSaveData%OtherSt_AD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_AD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyOtherState(SrcLinStateSaveData%OtherSt_AD(i1), DstLinStateSaveData%OtherSt_AD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_AD)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_AD) + UB(1:1) = ubound(SrcLinStateSaveData%u_AD) + if (.not. allocated(DstLinStateSaveData%u_AD)) then + allocate(DstLinStateSaveData%u_AD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_AD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyInput(SrcLinStateSaveData%u_AD(i1), DstLinStateSaveData%u_AD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_IfW)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_IfW) + UB(1:1) = ubound(SrcLinStateSaveData%x_IfW) + if (.not. allocated(DstLinStateSaveData%x_IfW)) then + allocate(DstLinStateSaveData%x_IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyContState(SrcLinStateSaveData%x_IfW(i1), DstLinStateSaveData%x_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_IfW)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_IfW) + UB(1:1) = ubound(SrcLinStateSaveData%xd_IfW) + if (.not. allocated(DstLinStateSaveData%xd_IfW)) then + allocate(DstLinStateSaveData%xd_IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyDiscState(SrcLinStateSaveData%xd_IfW(i1), DstLinStateSaveData%xd_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_IfW)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_IfW) + UB(1:1) = ubound(SrcLinStateSaveData%z_IfW) + if (.not. allocated(DstLinStateSaveData%z_IfW)) then + allocate(DstLinStateSaveData%z_IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyConstrState(SrcLinStateSaveData%z_IfW(i1), DstLinStateSaveData%z_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_IfW)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IfW) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IfW) + if (.not. allocated(DstLinStateSaveData%OtherSt_IfW)) then + allocate(DstLinStateSaveData%OtherSt_IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyOtherState(SrcLinStateSaveData%OtherSt_IfW(i1), DstLinStateSaveData%OtherSt_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_IfW)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_IfW) + UB(1:1) = ubound(SrcLinStateSaveData%u_IfW) + if (.not. allocated(DstLinStateSaveData%u_IfW)) then + allocate(DstLinStateSaveData%u_IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyInput(SrcLinStateSaveData%u_IfW(i1), DstLinStateSaveData%u_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_SD)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_SD) + UB(1:1) = ubound(SrcLinStateSaveData%x_SD) + if (.not. allocated(DstLinStateSaveData%x_SD)) then + allocate(DstLinStateSaveData%x_SD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyContState(SrcLinStateSaveData%x_SD(i1), DstLinStateSaveData%x_SD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_SD)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_SD) + UB(1:1) = ubound(SrcLinStateSaveData%xd_SD) + if (.not. allocated(DstLinStateSaveData%xd_SD)) then + allocate(DstLinStateSaveData%xd_SD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyDiscState(SrcLinStateSaveData%xd_SD(i1), DstLinStateSaveData%xd_SD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_SD)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_SD) + UB(1:1) = ubound(SrcLinStateSaveData%z_SD) + if (.not. allocated(DstLinStateSaveData%z_SD)) then + allocate(DstLinStateSaveData%z_SD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyConstrState(SrcLinStateSaveData%z_SD(i1), DstLinStateSaveData%z_SD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_SD)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SD) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SD) + if (.not. allocated(DstLinStateSaveData%OtherSt_SD)) then + allocate(DstLinStateSaveData%OtherSt_SD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyOtherState(SrcLinStateSaveData%OtherSt_SD(i1), DstLinStateSaveData%OtherSt_SD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_SD)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_SD) + UB(1:1) = ubound(SrcLinStateSaveData%u_SD) + if (.not. allocated(DstLinStateSaveData%u_SD)) then + allocate(DstLinStateSaveData%u_SD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyInput(SrcLinStateSaveData%u_SD(i1), DstLinStateSaveData%u_SD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_ExtPtfm)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_ExtPtfm) + UB(1:1) = ubound(SrcLinStateSaveData%x_ExtPtfm) + if (.not. allocated(DstLinStateSaveData%x_ExtPtfm)) then + allocate(DstLinStateSaveData%x_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ExtPtfm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyContState(SrcLinStateSaveData%x_ExtPtfm(i1), DstLinStateSaveData%x_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_ExtPtfm)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_ExtPtfm) + UB(1:1) = ubound(SrcLinStateSaveData%xd_ExtPtfm) + if (.not. allocated(DstLinStateSaveData%xd_ExtPtfm)) then + allocate(DstLinStateSaveData%xd_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ExtPtfm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyDiscState(SrcLinStateSaveData%xd_ExtPtfm(i1), DstLinStateSaveData%xd_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_ExtPtfm)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_ExtPtfm) + UB(1:1) = ubound(SrcLinStateSaveData%z_ExtPtfm) + if (.not. allocated(DstLinStateSaveData%z_ExtPtfm)) then + allocate(DstLinStateSaveData%z_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ExtPtfm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyConstrState(SrcLinStateSaveData%z_ExtPtfm(i1), DstLinStateSaveData%z_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_ExtPtfm)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ExtPtfm) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ExtPtfm) + if (.not. allocated(DstLinStateSaveData%OtherSt_ExtPtfm)) then + allocate(DstLinStateSaveData%OtherSt_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ExtPtfm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyOtherState(SrcLinStateSaveData%OtherSt_ExtPtfm(i1), DstLinStateSaveData%OtherSt_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_ExtPtfm)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_ExtPtfm) + UB(1:1) = ubound(SrcLinStateSaveData%u_ExtPtfm) + if (.not. allocated(DstLinStateSaveData%u_ExtPtfm)) then + allocate(DstLinStateSaveData%u_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ExtPtfm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyInput(SrcLinStateSaveData%u_ExtPtfm(i1), DstLinStateSaveData%u_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_HD)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_HD) + UB(1:1) = ubound(SrcLinStateSaveData%x_HD) + if (.not. allocated(DstLinStateSaveData%x_HD)) then + allocate(DstLinStateSaveData%x_HD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_HD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyContState(SrcLinStateSaveData%x_HD(i1), DstLinStateSaveData%x_HD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_HD)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_HD) + UB(1:1) = ubound(SrcLinStateSaveData%xd_HD) + if (.not. allocated(DstLinStateSaveData%xd_HD)) then + allocate(DstLinStateSaveData%xd_HD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_HD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyDiscState(SrcLinStateSaveData%xd_HD(i1), DstLinStateSaveData%xd_HD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_HD)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_HD) + UB(1:1) = ubound(SrcLinStateSaveData%z_HD) + if (.not. allocated(DstLinStateSaveData%z_HD)) then + allocate(DstLinStateSaveData%z_HD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_HD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyConstrState(SrcLinStateSaveData%z_HD(i1), DstLinStateSaveData%z_HD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_HD)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_HD) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_HD) + if (.not. allocated(DstLinStateSaveData%OtherSt_HD)) then + allocate(DstLinStateSaveData%OtherSt_HD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_HD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyOtherState(SrcLinStateSaveData%OtherSt_HD(i1), DstLinStateSaveData%OtherSt_HD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_HD)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_HD) + UB(1:1) = ubound(SrcLinStateSaveData%u_HD) + if (.not. allocated(DstLinStateSaveData%u_HD)) then + allocate(DstLinStateSaveData%u_HD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_HD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyInput(SrcLinStateSaveData%u_HD(i1), DstLinStateSaveData%u_HD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_IceF)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_IceF) + UB(1:1) = ubound(SrcLinStateSaveData%x_IceF) + if (.not. allocated(DstLinStateSaveData%x_IceF)) then + allocate(DstLinStateSaveData%x_IceF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyContState(SrcLinStateSaveData%x_IceF(i1), DstLinStateSaveData%x_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_IceF)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_IceF) + UB(1:1) = ubound(SrcLinStateSaveData%xd_IceF) + if (.not. allocated(DstLinStateSaveData%xd_IceF)) then + allocate(DstLinStateSaveData%xd_IceF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyDiscState(SrcLinStateSaveData%xd_IceF(i1), DstLinStateSaveData%xd_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_IceF)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_IceF) + UB(1:1) = ubound(SrcLinStateSaveData%z_IceF) + if (.not. allocated(DstLinStateSaveData%z_IceF)) then + allocate(DstLinStateSaveData%z_IceF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyConstrState(SrcLinStateSaveData%z_IceF(i1), DstLinStateSaveData%z_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_IceF)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IceF) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IceF) + if (.not. allocated(DstLinStateSaveData%OtherSt_IceF)) then + allocate(DstLinStateSaveData%OtherSt_IceF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyOtherState(SrcLinStateSaveData%OtherSt_IceF(i1), DstLinStateSaveData%OtherSt_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_IceF)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_IceF) + UB(1:1) = ubound(SrcLinStateSaveData%u_IceF) + if (.not. allocated(DstLinStateSaveData%u_IceF)) then + allocate(DstLinStateSaveData%u_IceF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyInput(SrcLinStateSaveData%u_IceF(i1), DstLinStateSaveData%u_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_MAP)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_MAP) + UB(1:1) = ubound(SrcLinStateSaveData%x_MAP) + if (.not. allocated(DstLinStateSaveData%x_MAP)) then + allocate(DstLinStateSaveData%x_MAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyContState(SrcLinStateSaveData%x_MAP(i1), DstLinStateSaveData%x_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_MAP)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_MAP) + UB(1:1) = ubound(SrcLinStateSaveData%xd_MAP) + if (.not. allocated(DstLinStateSaveData%xd_MAP)) then + allocate(DstLinStateSaveData%xd_MAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyDiscState(SrcLinStateSaveData%xd_MAP(i1), DstLinStateSaveData%xd_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_MAP)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_MAP) + UB(1:1) = ubound(SrcLinStateSaveData%z_MAP) + if (.not. allocated(DstLinStateSaveData%z_MAP)) then + allocate(DstLinStateSaveData%z_MAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyConstrState(SrcLinStateSaveData%z_MAP(i1), DstLinStateSaveData%z_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_MAP)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_MAP) + UB(1:1) = ubound(SrcLinStateSaveData%u_MAP) + if (.not. allocated(DstLinStateSaveData%u_MAP)) then + allocate(DstLinStateSaveData%u_MAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyInput(SrcLinStateSaveData%u_MAP(i1), DstLinStateSaveData%u_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_FEAM)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_FEAM) + UB(1:1) = ubound(SrcLinStateSaveData%x_FEAM) + if (.not. allocated(DstLinStateSaveData%x_FEAM)) then + allocate(DstLinStateSaveData%x_FEAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_FEAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyContState(SrcLinStateSaveData%x_FEAM(i1), DstLinStateSaveData%x_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_FEAM)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_FEAM) + UB(1:1) = ubound(SrcLinStateSaveData%xd_FEAM) + if (.not. allocated(DstLinStateSaveData%xd_FEAM)) then + allocate(DstLinStateSaveData%xd_FEAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_FEAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyDiscState(SrcLinStateSaveData%xd_FEAM(i1), DstLinStateSaveData%xd_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_FEAM)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_FEAM) + UB(1:1) = ubound(SrcLinStateSaveData%z_FEAM) + if (.not. allocated(DstLinStateSaveData%z_FEAM)) then + allocate(DstLinStateSaveData%z_FEAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_FEAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyConstrState(SrcLinStateSaveData%z_FEAM(i1), DstLinStateSaveData%z_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_FEAM)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_FEAM) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_FEAM) + if (.not. allocated(DstLinStateSaveData%OtherSt_FEAM)) then + allocate(DstLinStateSaveData%OtherSt_FEAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_FEAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyOtherState(SrcLinStateSaveData%OtherSt_FEAM(i1), DstLinStateSaveData%OtherSt_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_FEAM)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_FEAM) + UB(1:1) = ubound(SrcLinStateSaveData%u_FEAM) + if (.not. allocated(DstLinStateSaveData%u_FEAM)) then + allocate(DstLinStateSaveData%u_FEAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_FEAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyInput(SrcLinStateSaveData%u_FEAM(i1), DstLinStateSaveData%u_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_MD)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_MD) + UB(1:1) = ubound(SrcLinStateSaveData%x_MD) + if (.not. allocated(DstLinStateSaveData%x_MD)) then + allocate(DstLinStateSaveData%x_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyContState(SrcLinStateSaveData%x_MD(i1), DstLinStateSaveData%x_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_MD)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_MD) + UB(1:1) = ubound(SrcLinStateSaveData%xd_MD) + if (.not. allocated(DstLinStateSaveData%xd_MD)) then + allocate(DstLinStateSaveData%xd_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyDiscState(SrcLinStateSaveData%xd_MD(i1), DstLinStateSaveData%xd_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_MD)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_MD) + UB(1:1) = ubound(SrcLinStateSaveData%z_MD) + if (.not. allocated(DstLinStateSaveData%z_MD)) then + allocate(DstLinStateSaveData%z_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyConstrState(SrcLinStateSaveData%z_MD(i1), DstLinStateSaveData%z_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_MD)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_MD) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_MD) + if (.not. allocated(DstLinStateSaveData%OtherSt_MD)) then + allocate(DstLinStateSaveData%OtherSt_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyOtherState(SrcLinStateSaveData%OtherSt_MD(i1), DstLinStateSaveData%OtherSt_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_MD)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_MD) + UB(1:1) = ubound(SrcLinStateSaveData%u_MD) + if (.not. allocated(DstLinStateSaveData%u_MD)) then + allocate(DstLinStateSaveData%u_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyInput(SrcLinStateSaveData%u_MD(i1), DstLinStateSaveData%u_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) + type(FAST_LinStateSave), intent(inout) :: LinStateSaveData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyLinStateSave' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcIceDyn_DataData%x)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%x,1) - i1_u = UBOUND(SrcIceDyn_DataData%x,1) - i2_l = LBOUND(SrcIceDyn_DataData%x,2) - i2_u = UBOUND(SrcIceDyn_DataData%x,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%x)) THEN - ALLOCATE(DstIceDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%x,2), UBOUND(SrcIceDyn_DataData%x,2) - DO i1 = LBOUND(SrcIceDyn_DataData%x,1), UBOUND(SrcIceDyn_DataData%x,1) - CALL IceD_CopyContState( SrcIceDyn_DataData%x(i1,i2), DstIceDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%xd)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%xd,1) - i1_u = UBOUND(SrcIceDyn_DataData%xd,1) - i2_l = LBOUND(SrcIceDyn_DataData%xd,2) - i2_u = UBOUND(SrcIceDyn_DataData%xd,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%xd)) THEN - ALLOCATE(DstIceDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%xd,2), UBOUND(SrcIceDyn_DataData%xd,2) - DO i1 = LBOUND(SrcIceDyn_DataData%xd,1), UBOUND(SrcIceDyn_DataData%xd,1) - CALL IceD_CopyDiscState( SrcIceDyn_DataData%xd(i1,i2), DstIceDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%z)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%z,1) - i1_u = UBOUND(SrcIceDyn_DataData%z,1) - i2_l = LBOUND(SrcIceDyn_DataData%z,2) - i2_u = UBOUND(SrcIceDyn_DataData%z,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%z)) THEN - ALLOCATE(DstIceDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%z,2), UBOUND(SrcIceDyn_DataData%z,2) - DO i1 = LBOUND(SrcIceDyn_DataData%z,1), UBOUND(SrcIceDyn_DataData%z,1) - CALL IceD_CopyConstrState( SrcIceDyn_DataData%z(i1,i2), DstIceDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%OtherSt)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%OtherSt,1) - i1_u = UBOUND(SrcIceDyn_DataData%OtherSt,1) - i2_l = LBOUND(SrcIceDyn_DataData%OtherSt,2) - i2_u = UBOUND(SrcIceDyn_DataData%OtherSt,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%OtherSt)) THEN - ALLOCATE(DstIceDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%OtherSt,2), UBOUND(SrcIceDyn_DataData%OtherSt,2) - DO i1 = LBOUND(SrcIceDyn_DataData%OtherSt,1), UBOUND(SrcIceDyn_DataData%OtherSt,1) - CALL IceD_CopyOtherState( SrcIceDyn_DataData%OtherSt(i1,i2), DstIceDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%p)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%p,1) - i1_u = UBOUND(SrcIceDyn_DataData%p,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%p)) THEN - ALLOCATE(DstIceDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%p,1), UBOUND(SrcIceDyn_DataData%p,1) - CALL IceD_CopyParam( SrcIceDyn_DataData%p(i1), DstIceDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%u)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%u,1) - i1_u = UBOUND(SrcIceDyn_DataData%u,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%u)) THEN - ALLOCATE(DstIceDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%u,1), UBOUND(SrcIceDyn_DataData%u,1) - CALL IceD_CopyInput( SrcIceDyn_DataData%u(i1), DstIceDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%y)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%y,1) - i1_u = UBOUND(SrcIceDyn_DataData%y,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%y)) THEN - ALLOCATE(DstIceDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%y,1), UBOUND(SrcIceDyn_DataData%y,1) - CALL IceD_CopyOutput( SrcIceDyn_DataData%y(i1), DstIceDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%m)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%m,1) - i1_u = UBOUND(SrcIceDyn_DataData%m,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%m)) THEN - ALLOCATE(DstIceDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%m,1), UBOUND(SrcIceDyn_DataData%m,1) - CALL IceD_CopyMisc( SrcIceDyn_DataData%m(i1), DstIceDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%Input,1) - i1_u = UBOUND(SrcIceDyn_DataData%Input,1) - i2_l = LBOUND(SrcIceDyn_DataData%Input,2) - i2_u = UBOUND(SrcIceDyn_DataData%Input,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%Input)) THEN - ALLOCATE(DstIceDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%Input,2), UBOUND(SrcIceDyn_DataData%Input,2) - DO i1 = LBOUND(SrcIceDyn_DataData%Input,1), UBOUND(SrcIceDyn_DataData%Input,1) - CALL IceD_CopyInput( SrcIceDyn_DataData%Input(i1,i2), DstIceDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcIceDyn_DataData%InputTimes,1) - i2_l = LBOUND(SrcIceDyn_DataData%InputTimes,2) - i2_u = UBOUND(SrcIceDyn_DataData%InputTimes,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%InputTimes)) THEN - ALLOCATE(DstIceDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyIceDyn_Data - - SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg ) - TYPE(IceDyn_Data), INTENT(INOUT) :: IceDyn_DataData - 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 = 'FAST_DestroyIceDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%x) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%xd) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%z) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%OtherSt) -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 ) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceDyn_DataData%m) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%Input) -ENDIF -IF (ALLOCATED(IceDyn_DataData%InputTimes)) THEN - DEALLOCATE(IceDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyIceDyn_Data - - SUBROUTINE FAST_PackIceDyn_Data( 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(IceDyn_Data), 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 = 'FAST_PackIceDyn_Data' - ! 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 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no - IF ( ALLOCATED(InData%xd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt allocated yes/no - IF ( ALLOCATED(InData%OtherSt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! p allocated yes/no - IF ( ALLOCATED(InData%p) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! p upper/lower bounds for each dimension - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL IceD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u allocated yes/no - IF ( ALLOCATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL IceD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! m allocated yes/no - IF ( ALLOCATED(InData%m) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m upper/lower bounds for each dimension - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL IceD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Input upper/lower bounds for each dimension - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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%x) ) 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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%xd) ) 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%xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%z) ) 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%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt) ) 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%OtherSt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%p) ) 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%p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - CALL IceD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, OnlySize ) ! 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 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u) ) 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%u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - IF ( .NOT. ALLOCATED(InData%y) ) 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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - CALL IceD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - IF ( .NOT. ALLOCATED(InData%m) ) 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%m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - CALL IceD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, OnlySize ) ! 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InputTimes,2), UBOUND(InData%InputTimes,2) - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_PackIceDyn_Data - - SUBROUTINE FAST_UnPackIceDyn_Data( 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(IceDyn_Data), 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 = 'FAST_UnPackIceDyn_Data' - ! 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 ! x 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%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%x,2), UBOUND(OutData%x,2) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 IceD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd 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%xd)) DEALLOCATE(OutData%xd) - ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 IceD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z 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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 IceD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt 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%OtherSt)) DEALLOCATE(OutData%OtherSt) - ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 IceD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p 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%p)) DEALLOCATE(OutData%p) - ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,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 IceD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! 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) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u 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%u)) DEALLOCATE(OutData%u) - ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,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 IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u - 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 ! y 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,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 IceD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y - 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 ! m 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%m)) DEALLOCATE(OutData%m) - ALLOCATE(OutData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,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 IceD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Input,2), UBOUND(OutData%Input,2) - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1,i2), ErrStat2, ErrMsg2 ) ! Input - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InputTimes,2), UBOUND(OutData%InputTimes,2) - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_UnPackIceDyn_Data - - SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BeamDyn_Data), INTENT(INOUT) :: SrcBeamDyn_DataData - TYPE(BeamDyn_Data), INTENT(INOUT) :: DstBeamDyn_DataData - 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 = 'FAST_CopyBeamDyn_Data' -! + ErrMsg = '' + if (allocated(LinStateSaveData%x_IceD)) then + LB(1:2) = lbound(LinStateSaveData%x_IceD) + UB(1:2) = ubound(LinStateSaveData%x_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyContState(LinStateSaveData%x_IceD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%x_IceD) + end if + if (allocated(LinStateSaveData%xd_IceD)) then + LB(1:2) = lbound(LinStateSaveData%xd_IceD) + UB(1:2) = ubound(LinStateSaveData%xd_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyDiscState(LinStateSaveData%xd_IceD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%xd_IceD) + end if + if (allocated(LinStateSaveData%z_IceD)) then + LB(1:2) = lbound(LinStateSaveData%z_IceD) + UB(1:2) = ubound(LinStateSaveData%z_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyConstrState(LinStateSaveData%z_IceD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%z_IceD) + end if + if (allocated(LinStateSaveData%OtherSt_IceD)) then + LB(1:2) = lbound(LinStateSaveData%OtherSt_IceD) + UB(1:2) = ubound(LinStateSaveData%OtherSt_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyOtherState(LinStateSaveData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%OtherSt_IceD) + end if + if (allocated(LinStateSaveData%u_IceD)) then + LB(1:2) = lbound(LinStateSaveData%u_IceD) + UB(1:2) = ubound(LinStateSaveData%u_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyInput(LinStateSaveData%u_IceD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%u_IceD) + end if + if (allocated(LinStateSaveData%x_BD)) then + LB(1:2) = lbound(LinStateSaveData%x_BD) + UB(1:2) = ubound(LinStateSaveData%x_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyContState(LinStateSaveData%x_BD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%x_BD) + end if + if (allocated(LinStateSaveData%xd_BD)) then + LB(1:2) = lbound(LinStateSaveData%xd_BD) + UB(1:2) = ubound(LinStateSaveData%xd_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyDiscState(LinStateSaveData%xd_BD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%xd_BD) + end if + if (allocated(LinStateSaveData%z_BD)) then + LB(1:2) = lbound(LinStateSaveData%z_BD) + UB(1:2) = ubound(LinStateSaveData%z_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyConstrState(LinStateSaveData%z_BD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%z_BD) + end if + if (allocated(LinStateSaveData%OtherSt_BD)) then + LB(1:2) = lbound(LinStateSaveData%OtherSt_BD) + UB(1:2) = ubound(LinStateSaveData%OtherSt_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyOtherState(LinStateSaveData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%OtherSt_BD) + end if + if (allocated(LinStateSaveData%u_BD)) then + LB(1:2) = lbound(LinStateSaveData%u_BD) + UB(1:2) = ubound(LinStateSaveData%u_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyInput(LinStateSaveData%u_BD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%u_BD) + end if + if (allocated(LinStateSaveData%x_ED)) then + LB(1:1) = lbound(LinStateSaveData%x_ED) + UB(1:1) = ubound(LinStateSaveData%x_ED) + do i1 = LB(1), UB(1) + call ED_DestroyContState(LinStateSaveData%x_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_ED) + end if + if (allocated(LinStateSaveData%xd_ED)) then + LB(1:1) = lbound(LinStateSaveData%xd_ED) + UB(1:1) = ubound(LinStateSaveData%xd_ED) + do i1 = LB(1), UB(1) + call ED_DestroyDiscState(LinStateSaveData%xd_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_ED) + end if + if (allocated(LinStateSaveData%z_ED)) then + LB(1:1) = lbound(LinStateSaveData%z_ED) + UB(1:1) = ubound(LinStateSaveData%z_ED) + do i1 = LB(1), UB(1) + call ED_DestroyConstrState(LinStateSaveData%z_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_ED) + end if + if (allocated(LinStateSaveData%OtherSt_ED)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_ED) + UB(1:1) = ubound(LinStateSaveData%OtherSt_ED) + do i1 = LB(1), UB(1) + call ED_DestroyOtherState(LinStateSaveData%OtherSt_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_ED) + end if + if (allocated(LinStateSaveData%u_ED)) then + LB(1:1) = lbound(LinStateSaveData%u_ED) + UB(1:1) = ubound(LinStateSaveData%u_ED) + do i1 = LB(1), UB(1) + call ED_DestroyInput(LinStateSaveData%u_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_ED) + end if + if (allocated(LinStateSaveData%x_SrvD)) then + LB(1:1) = lbound(LinStateSaveData%x_SrvD) + UB(1:1) = ubound(LinStateSaveData%x_SrvD) + do i1 = LB(1), UB(1) + call SrvD_DestroyContState(LinStateSaveData%x_SrvD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_SrvD) + end if + if (allocated(LinStateSaveData%xd_SrvD)) then + LB(1:1) = lbound(LinStateSaveData%xd_SrvD) + UB(1:1) = ubound(LinStateSaveData%xd_SrvD) + do i1 = LB(1), UB(1) + call SrvD_DestroyDiscState(LinStateSaveData%xd_SrvD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_SrvD) + end if + if (allocated(LinStateSaveData%z_SrvD)) then + LB(1:1) = lbound(LinStateSaveData%z_SrvD) + UB(1:1) = ubound(LinStateSaveData%z_SrvD) + do i1 = LB(1), UB(1) + call SrvD_DestroyConstrState(LinStateSaveData%z_SrvD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_SrvD) + end if + if (allocated(LinStateSaveData%OtherSt_SrvD)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_SrvD) + UB(1:1) = ubound(LinStateSaveData%OtherSt_SrvD) + do i1 = LB(1), UB(1) + call SrvD_DestroyOtherState(LinStateSaveData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_SrvD) + end if + if (allocated(LinStateSaveData%u_SrvD)) then + LB(1:1) = lbound(LinStateSaveData%u_SrvD) + UB(1:1) = ubound(LinStateSaveData%u_SrvD) + do i1 = LB(1), UB(1) + call SrvD_DestroyInput(LinStateSaveData%u_SrvD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_SrvD) + end if + if (allocated(LinStateSaveData%x_AD)) then + LB(1:1) = lbound(LinStateSaveData%x_AD) + UB(1:1) = ubound(LinStateSaveData%x_AD) + do i1 = LB(1), UB(1) + call AD_DestroyContState(LinStateSaveData%x_AD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_AD) + end if + if (allocated(LinStateSaveData%xd_AD)) then + LB(1:1) = lbound(LinStateSaveData%xd_AD) + UB(1:1) = ubound(LinStateSaveData%xd_AD) + do i1 = LB(1), UB(1) + call AD_DestroyDiscState(LinStateSaveData%xd_AD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_AD) + end if + if (allocated(LinStateSaveData%z_AD)) then + LB(1:1) = lbound(LinStateSaveData%z_AD) + UB(1:1) = ubound(LinStateSaveData%z_AD) + do i1 = LB(1), UB(1) + call AD_DestroyConstrState(LinStateSaveData%z_AD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_AD) + end if + if (allocated(LinStateSaveData%OtherSt_AD)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_AD) + UB(1:1) = ubound(LinStateSaveData%OtherSt_AD) + do i1 = LB(1), UB(1) + call AD_DestroyOtherState(LinStateSaveData%OtherSt_AD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_AD) + end if + if (allocated(LinStateSaveData%u_AD)) then + LB(1:1) = lbound(LinStateSaveData%u_AD) + UB(1:1) = ubound(LinStateSaveData%u_AD) + do i1 = LB(1), UB(1) + call AD_DestroyInput(LinStateSaveData%u_AD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_AD) + end if + if (allocated(LinStateSaveData%x_IfW)) then + LB(1:1) = lbound(LinStateSaveData%x_IfW) + UB(1:1) = ubound(LinStateSaveData%x_IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyContState(LinStateSaveData%x_IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_IfW) + end if + if (allocated(LinStateSaveData%xd_IfW)) then + LB(1:1) = lbound(LinStateSaveData%xd_IfW) + UB(1:1) = ubound(LinStateSaveData%xd_IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyDiscState(LinStateSaveData%xd_IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_IfW) + end if + if (allocated(LinStateSaveData%z_IfW)) then + LB(1:1) = lbound(LinStateSaveData%z_IfW) + UB(1:1) = ubound(LinStateSaveData%z_IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyConstrState(LinStateSaveData%z_IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_IfW) + end if + if (allocated(LinStateSaveData%OtherSt_IfW)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_IfW) + UB(1:1) = ubound(LinStateSaveData%OtherSt_IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyOtherState(LinStateSaveData%OtherSt_IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_IfW) + end if + if (allocated(LinStateSaveData%u_IfW)) then + LB(1:1) = lbound(LinStateSaveData%u_IfW) + UB(1:1) = ubound(LinStateSaveData%u_IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyInput(LinStateSaveData%u_IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_IfW) + end if + if (allocated(LinStateSaveData%x_SD)) then + LB(1:1) = lbound(LinStateSaveData%x_SD) + UB(1:1) = ubound(LinStateSaveData%x_SD) + do i1 = LB(1), UB(1) + call SD_DestroyContState(LinStateSaveData%x_SD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_SD) + end if + if (allocated(LinStateSaveData%xd_SD)) then + LB(1:1) = lbound(LinStateSaveData%xd_SD) + UB(1:1) = ubound(LinStateSaveData%xd_SD) + do i1 = LB(1), UB(1) + call SD_DestroyDiscState(LinStateSaveData%xd_SD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_SD) + end if + if (allocated(LinStateSaveData%z_SD)) then + LB(1:1) = lbound(LinStateSaveData%z_SD) + UB(1:1) = ubound(LinStateSaveData%z_SD) + do i1 = LB(1), UB(1) + call SD_DestroyConstrState(LinStateSaveData%z_SD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_SD) + end if + if (allocated(LinStateSaveData%OtherSt_SD)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_SD) + UB(1:1) = ubound(LinStateSaveData%OtherSt_SD) + do i1 = LB(1), UB(1) + call SD_DestroyOtherState(LinStateSaveData%OtherSt_SD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_SD) + end if + if (allocated(LinStateSaveData%u_SD)) then + LB(1:1) = lbound(LinStateSaveData%u_SD) + UB(1:1) = ubound(LinStateSaveData%u_SD) + do i1 = LB(1), UB(1) + call SD_DestroyInput(LinStateSaveData%u_SD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_SD) + end if + if (allocated(LinStateSaveData%x_ExtPtfm)) then + LB(1:1) = lbound(LinStateSaveData%x_ExtPtfm) + UB(1:1) = ubound(LinStateSaveData%x_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyContState(LinStateSaveData%x_ExtPtfm(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_ExtPtfm) + end if + if (allocated(LinStateSaveData%xd_ExtPtfm)) then + LB(1:1) = lbound(LinStateSaveData%xd_ExtPtfm) + UB(1:1) = ubound(LinStateSaveData%xd_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyDiscState(LinStateSaveData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_ExtPtfm) + end if + if (allocated(LinStateSaveData%z_ExtPtfm)) then + LB(1:1) = lbound(LinStateSaveData%z_ExtPtfm) + UB(1:1) = ubound(LinStateSaveData%z_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyConstrState(LinStateSaveData%z_ExtPtfm(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_ExtPtfm) + end if + if (allocated(LinStateSaveData%OtherSt_ExtPtfm)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_ExtPtfm) + UB(1:1) = ubound(LinStateSaveData%OtherSt_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyOtherState(LinStateSaveData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_ExtPtfm) + end if + if (allocated(LinStateSaveData%u_ExtPtfm)) then + LB(1:1) = lbound(LinStateSaveData%u_ExtPtfm) + UB(1:1) = ubound(LinStateSaveData%u_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyInput(LinStateSaveData%u_ExtPtfm(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_ExtPtfm) + end if + if (allocated(LinStateSaveData%x_HD)) then + LB(1:1) = lbound(LinStateSaveData%x_HD) + UB(1:1) = ubound(LinStateSaveData%x_HD) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyContState(LinStateSaveData%x_HD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_HD) + end if + if (allocated(LinStateSaveData%xd_HD)) then + LB(1:1) = lbound(LinStateSaveData%xd_HD) + UB(1:1) = ubound(LinStateSaveData%xd_HD) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyDiscState(LinStateSaveData%xd_HD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_HD) + end if + if (allocated(LinStateSaveData%z_HD)) then + LB(1:1) = lbound(LinStateSaveData%z_HD) + UB(1:1) = ubound(LinStateSaveData%z_HD) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyConstrState(LinStateSaveData%z_HD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_HD) + end if + if (allocated(LinStateSaveData%OtherSt_HD)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_HD) + UB(1:1) = ubound(LinStateSaveData%OtherSt_HD) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyOtherState(LinStateSaveData%OtherSt_HD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_HD) + end if + if (allocated(LinStateSaveData%u_HD)) then + LB(1:1) = lbound(LinStateSaveData%u_HD) + UB(1:1) = ubound(LinStateSaveData%u_HD) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyInput(LinStateSaveData%u_HD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_HD) + end if + if (allocated(LinStateSaveData%x_IceF)) then + LB(1:1) = lbound(LinStateSaveData%x_IceF) + UB(1:1) = ubound(LinStateSaveData%x_IceF) + do i1 = LB(1), UB(1) + call IceFloe_DestroyContState(LinStateSaveData%x_IceF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_IceF) + end if + if (allocated(LinStateSaveData%xd_IceF)) then + LB(1:1) = lbound(LinStateSaveData%xd_IceF) + UB(1:1) = ubound(LinStateSaveData%xd_IceF) + do i1 = LB(1), UB(1) + call IceFloe_DestroyDiscState(LinStateSaveData%xd_IceF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_IceF) + end if + if (allocated(LinStateSaveData%z_IceF)) then + LB(1:1) = lbound(LinStateSaveData%z_IceF) + UB(1:1) = ubound(LinStateSaveData%z_IceF) + do i1 = LB(1), UB(1) + call IceFloe_DestroyConstrState(LinStateSaveData%z_IceF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_IceF) + end if + if (allocated(LinStateSaveData%OtherSt_IceF)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_IceF) + UB(1:1) = ubound(LinStateSaveData%OtherSt_IceF) + do i1 = LB(1), UB(1) + call IceFloe_DestroyOtherState(LinStateSaveData%OtherSt_IceF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_IceF) + end if + if (allocated(LinStateSaveData%u_IceF)) then + LB(1:1) = lbound(LinStateSaveData%u_IceF) + UB(1:1) = ubound(LinStateSaveData%u_IceF) + do i1 = LB(1), UB(1) + call IceFloe_DestroyInput(LinStateSaveData%u_IceF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_IceF) + end if + if (allocated(LinStateSaveData%x_MAP)) then + LB(1:1) = lbound(LinStateSaveData%x_MAP) + UB(1:1) = ubound(LinStateSaveData%x_MAP) + do i1 = LB(1), UB(1) + call MAP_DestroyContState(LinStateSaveData%x_MAP(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_MAP) + end if + if (allocated(LinStateSaveData%xd_MAP)) then + LB(1:1) = lbound(LinStateSaveData%xd_MAP) + UB(1:1) = ubound(LinStateSaveData%xd_MAP) + do i1 = LB(1), UB(1) + call MAP_DestroyDiscState(LinStateSaveData%xd_MAP(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_MAP) + end if + if (allocated(LinStateSaveData%z_MAP)) then + LB(1:1) = lbound(LinStateSaveData%z_MAP) + UB(1:1) = ubound(LinStateSaveData%z_MAP) + do i1 = LB(1), UB(1) + call MAP_DestroyConstrState(LinStateSaveData%z_MAP(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_MAP) + end if + if (allocated(LinStateSaveData%u_MAP)) then + LB(1:1) = lbound(LinStateSaveData%u_MAP) + UB(1:1) = ubound(LinStateSaveData%u_MAP) + do i1 = LB(1), UB(1) + call MAP_DestroyInput(LinStateSaveData%u_MAP(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_MAP) + end if + if (allocated(LinStateSaveData%x_FEAM)) then + LB(1:1) = lbound(LinStateSaveData%x_FEAM) + UB(1:1) = ubound(LinStateSaveData%x_FEAM) + do i1 = LB(1), UB(1) + call FEAM_DestroyContState(LinStateSaveData%x_FEAM(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_FEAM) + end if + if (allocated(LinStateSaveData%xd_FEAM)) then + LB(1:1) = lbound(LinStateSaveData%xd_FEAM) + UB(1:1) = ubound(LinStateSaveData%xd_FEAM) + do i1 = LB(1), UB(1) + call FEAM_DestroyDiscState(LinStateSaveData%xd_FEAM(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_FEAM) + end if + if (allocated(LinStateSaveData%z_FEAM)) then + LB(1:1) = lbound(LinStateSaveData%z_FEAM) + UB(1:1) = ubound(LinStateSaveData%z_FEAM) + do i1 = LB(1), UB(1) + call FEAM_DestroyConstrState(LinStateSaveData%z_FEAM(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_FEAM) + end if + if (allocated(LinStateSaveData%OtherSt_FEAM)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_FEAM) + UB(1:1) = ubound(LinStateSaveData%OtherSt_FEAM) + do i1 = LB(1), UB(1) + call FEAM_DestroyOtherState(LinStateSaveData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_FEAM) + end if + if (allocated(LinStateSaveData%u_FEAM)) then + LB(1:1) = lbound(LinStateSaveData%u_FEAM) + UB(1:1) = ubound(LinStateSaveData%u_FEAM) + do i1 = LB(1), UB(1) + call FEAM_DestroyInput(LinStateSaveData%u_FEAM(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_FEAM) + end if + if (allocated(LinStateSaveData%x_MD)) then + LB(1:1) = lbound(LinStateSaveData%x_MD) + UB(1:1) = ubound(LinStateSaveData%x_MD) + do i1 = LB(1), UB(1) + call MD_DestroyContState(LinStateSaveData%x_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_MD) + end if + if (allocated(LinStateSaveData%xd_MD)) then + LB(1:1) = lbound(LinStateSaveData%xd_MD) + UB(1:1) = ubound(LinStateSaveData%xd_MD) + do i1 = LB(1), UB(1) + call MD_DestroyDiscState(LinStateSaveData%xd_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_MD) + end if + if (allocated(LinStateSaveData%z_MD)) then + LB(1:1) = lbound(LinStateSaveData%z_MD) + UB(1:1) = ubound(LinStateSaveData%z_MD) + do i1 = LB(1), UB(1) + call MD_DestroyConstrState(LinStateSaveData%z_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_MD) + end if + if (allocated(LinStateSaveData%OtherSt_MD)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_MD) + UB(1:1) = ubound(LinStateSaveData%OtherSt_MD) + do i1 = LB(1), UB(1) + call MD_DestroyOtherState(LinStateSaveData%OtherSt_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_MD) + end if + if (allocated(LinStateSaveData%u_MD)) then + LB(1:1) = lbound(LinStateSaveData%u_MD) + UB(1:1) = ubound(LinStateSaveData%u_MD) + do i1 = LB(1), UB(1) + call MD_DestroyInput(LinStateSaveData%u_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_MD) + end if +end subroutine + +subroutine FAST_PackLinStateSave(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinStateSave), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackLinStateSave' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%x_IceD)) + if (allocated(InData%x_IceD)) then + call RegPackBounds(Buf, 2, lbound(InData%x_IceD), ubound(InData%x_IceD)) + LB(1:2) = lbound(InData%x_IceD) + UB(1:2) = ubound(InData%x_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackContState(Buf, InData%x_IceD(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%xd_IceD)) + if (allocated(InData%xd_IceD)) then + call RegPackBounds(Buf, 2, lbound(InData%xd_IceD), ubound(InData%xd_IceD)) + LB(1:2) = lbound(InData%xd_IceD) + UB(1:2) = ubound(InData%xd_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackDiscState(Buf, InData%xd_IceD(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%z_IceD)) + if (allocated(InData%z_IceD)) then + call RegPackBounds(Buf, 2, lbound(InData%z_IceD), ubound(InData%z_IceD)) + LB(1:2) = lbound(InData%z_IceD) + UB(1:2) = ubound(InData%z_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackConstrState(Buf, InData%z_IceD(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%OtherSt_IceD)) + if (allocated(InData%OtherSt_IceD)) then + call RegPackBounds(Buf, 2, lbound(InData%OtherSt_IceD), ubound(InData%OtherSt_IceD)) + LB(1:2) = lbound(InData%OtherSt_IceD) + UB(1:2) = ubound(InData%OtherSt_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackOtherState(Buf, InData%OtherSt_IceD(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%u_IceD)) + if (allocated(InData%u_IceD)) then + call RegPackBounds(Buf, 2, lbound(InData%u_IceD), ubound(InData%u_IceD)) + LB(1:2) = lbound(InData%u_IceD) + UB(1:2) = ubound(InData%u_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackInput(Buf, InData%u_IceD(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%x_BD)) + if (allocated(InData%x_BD)) then + call RegPackBounds(Buf, 2, lbound(InData%x_BD), ubound(InData%x_BD)) + LB(1:2) = lbound(InData%x_BD) + UB(1:2) = ubound(InData%x_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackContState(Buf, InData%x_BD(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%xd_BD)) + if (allocated(InData%xd_BD)) then + call RegPackBounds(Buf, 2, lbound(InData%xd_BD), ubound(InData%xd_BD)) + LB(1:2) = lbound(InData%xd_BD) + UB(1:2) = ubound(InData%xd_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackDiscState(Buf, InData%xd_BD(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%z_BD)) + if (allocated(InData%z_BD)) then + call RegPackBounds(Buf, 2, lbound(InData%z_BD), ubound(InData%z_BD)) + LB(1:2) = lbound(InData%z_BD) + UB(1:2) = ubound(InData%z_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackConstrState(Buf, InData%z_BD(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%OtherSt_BD)) + if (allocated(InData%OtherSt_BD)) then + call RegPackBounds(Buf, 2, lbound(InData%OtherSt_BD), ubound(InData%OtherSt_BD)) + LB(1:2) = lbound(InData%OtherSt_BD) + UB(1:2) = ubound(InData%OtherSt_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackOtherState(Buf, InData%OtherSt_BD(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%u_BD)) + if (allocated(InData%u_BD)) then + call RegPackBounds(Buf, 2, lbound(InData%u_BD), ubound(InData%u_BD)) + LB(1:2) = lbound(InData%u_BD) + UB(1:2) = ubound(InData%u_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackInput(Buf, InData%u_BD(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%x_ED)) + if (allocated(InData%x_ED)) then + call RegPackBounds(Buf, 1, lbound(InData%x_ED), ubound(InData%x_ED)) + LB(1:1) = lbound(InData%x_ED) + UB(1:1) = ubound(InData%x_ED) + do i1 = LB(1), UB(1) + call ED_PackContState(Buf, InData%x_ED(i1)) + end do + end if + call RegPack(Buf, allocated(InData%xd_ED)) + if (allocated(InData%xd_ED)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_ED), ubound(InData%xd_ED)) + LB(1:1) = lbound(InData%xd_ED) + UB(1:1) = ubound(InData%xd_ED) + do i1 = LB(1), UB(1) + call ED_PackDiscState(Buf, InData%xd_ED(i1)) + end do + end if + call RegPack(Buf, allocated(InData%z_ED)) + if (allocated(InData%z_ED)) then + call RegPackBounds(Buf, 1, lbound(InData%z_ED), ubound(InData%z_ED)) + LB(1:1) = lbound(InData%z_ED) + UB(1:1) = ubound(InData%z_ED) + do i1 = LB(1), UB(1) + call ED_PackConstrState(Buf, InData%z_ED(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OtherSt_ED)) + if (allocated(InData%OtherSt_ED)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ED), ubound(InData%OtherSt_ED)) + LB(1:1) = lbound(InData%OtherSt_ED) + UB(1:1) = ubound(InData%OtherSt_ED) + do i1 = LB(1), UB(1) + call ED_PackOtherState(Buf, InData%OtherSt_ED(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u_ED)) + if (allocated(InData%u_ED)) then + call RegPackBounds(Buf, 1, lbound(InData%u_ED), ubound(InData%u_ED)) + LB(1:1) = lbound(InData%u_ED) + UB(1:1) = ubound(InData%u_ED) + do i1 = LB(1), UB(1) + call ED_PackInput(Buf, InData%u_ED(i1)) + end do + end if + call RegPack(Buf, allocated(InData%x_SrvD)) + if (allocated(InData%x_SrvD)) then + call RegPackBounds(Buf, 1, lbound(InData%x_SrvD), ubound(InData%x_SrvD)) + LB(1:1) = lbound(InData%x_SrvD) + UB(1:1) = ubound(InData%x_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackContState(Buf, InData%x_SrvD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%xd_SrvD)) + if (allocated(InData%xd_SrvD)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_SrvD), ubound(InData%xd_SrvD)) + LB(1:1) = lbound(InData%xd_SrvD) + UB(1:1) = ubound(InData%xd_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackDiscState(Buf, InData%xd_SrvD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%z_SrvD)) + if (allocated(InData%z_SrvD)) then + call RegPackBounds(Buf, 1, lbound(InData%z_SrvD), ubound(InData%z_SrvD)) + LB(1:1) = lbound(InData%z_SrvD) + UB(1:1) = ubound(InData%z_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackConstrState(Buf, InData%z_SrvD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OtherSt_SrvD)) + if (allocated(InData%OtherSt_SrvD)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SrvD), ubound(InData%OtherSt_SrvD)) + LB(1:1) = lbound(InData%OtherSt_SrvD) + UB(1:1) = ubound(InData%OtherSt_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackOtherState(Buf, InData%OtherSt_SrvD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u_SrvD)) + if (allocated(InData%u_SrvD)) then + call RegPackBounds(Buf, 1, lbound(InData%u_SrvD), ubound(InData%u_SrvD)) + LB(1:1) = lbound(InData%u_SrvD) + UB(1:1) = ubound(InData%u_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackInput(Buf, InData%u_SrvD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%x_AD)) + if (allocated(InData%x_AD)) then + call RegPackBounds(Buf, 1, lbound(InData%x_AD), ubound(InData%x_AD)) + LB(1:1) = lbound(InData%x_AD) + UB(1:1) = ubound(InData%x_AD) + do i1 = LB(1), UB(1) + call AD_PackContState(Buf, InData%x_AD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%xd_AD)) + if (allocated(InData%xd_AD)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_AD), ubound(InData%xd_AD)) + LB(1:1) = lbound(InData%xd_AD) + UB(1:1) = ubound(InData%xd_AD) + do i1 = LB(1), UB(1) + call AD_PackDiscState(Buf, InData%xd_AD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%z_AD)) + if (allocated(InData%z_AD)) then + call RegPackBounds(Buf, 1, lbound(InData%z_AD), ubound(InData%z_AD)) + LB(1:1) = lbound(InData%z_AD) + UB(1:1) = ubound(InData%z_AD) + do i1 = LB(1), UB(1) + call AD_PackConstrState(Buf, InData%z_AD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OtherSt_AD)) + if (allocated(InData%OtherSt_AD)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_AD), ubound(InData%OtherSt_AD)) + LB(1:1) = lbound(InData%OtherSt_AD) + UB(1:1) = ubound(InData%OtherSt_AD) + do i1 = LB(1), UB(1) + call AD_PackOtherState(Buf, InData%OtherSt_AD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u_AD)) + if (allocated(InData%u_AD)) then + call RegPackBounds(Buf, 1, lbound(InData%u_AD), ubound(InData%u_AD)) + LB(1:1) = lbound(InData%u_AD) + UB(1:1) = ubound(InData%u_AD) + do i1 = LB(1), UB(1) + call AD_PackInput(Buf, InData%u_AD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%x_IfW)) + if (allocated(InData%x_IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%x_IfW), ubound(InData%x_IfW)) + LB(1:1) = lbound(InData%x_IfW) + UB(1:1) = ubound(InData%x_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackContState(Buf, InData%x_IfW(i1)) + end do + end if + call RegPack(Buf, allocated(InData%xd_IfW)) + if (allocated(InData%xd_IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_IfW), ubound(InData%xd_IfW)) + LB(1:1) = lbound(InData%xd_IfW) + UB(1:1) = ubound(InData%xd_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackDiscState(Buf, InData%xd_IfW(i1)) + end do + end if + call RegPack(Buf, allocated(InData%z_IfW)) + if (allocated(InData%z_IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%z_IfW), ubound(InData%z_IfW)) + LB(1:1) = lbound(InData%z_IfW) + UB(1:1) = ubound(InData%z_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackConstrState(Buf, InData%z_IfW(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OtherSt_IfW)) + if (allocated(InData%OtherSt_IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IfW), ubound(InData%OtherSt_IfW)) + LB(1:1) = lbound(InData%OtherSt_IfW) + UB(1:1) = ubound(InData%OtherSt_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackOtherState(Buf, InData%OtherSt_IfW(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u_IfW)) + if (allocated(InData%u_IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%u_IfW), ubound(InData%u_IfW)) + LB(1:1) = lbound(InData%u_IfW) + UB(1:1) = ubound(InData%u_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackInput(Buf, InData%u_IfW(i1)) + end do + end if + call RegPack(Buf, allocated(InData%x_SD)) + if (allocated(InData%x_SD)) then + call RegPackBounds(Buf, 1, lbound(InData%x_SD), ubound(InData%x_SD)) + LB(1:1) = lbound(InData%x_SD) + UB(1:1) = ubound(InData%x_SD) + do i1 = LB(1), UB(1) + call SD_PackContState(Buf, InData%x_SD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%xd_SD)) + if (allocated(InData%xd_SD)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_SD), ubound(InData%xd_SD)) + LB(1:1) = lbound(InData%xd_SD) + UB(1:1) = ubound(InData%xd_SD) + do i1 = LB(1), UB(1) + call SD_PackDiscState(Buf, InData%xd_SD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%z_SD)) + if (allocated(InData%z_SD)) then + call RegPackBounds(Buf, 1, lbound(InData%z_SD), ubound(InData%z_SD)) + LB(1:1) = lbound(InData%z_SD) + UB(1:1) = ubound(InData%z_SD) + do i1 = LB(1), UB(1) + call SD_PackConstrState(Buf, InData%z_SD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OtherSt_SD)) + if (allocated(InData%OtherSt_SD)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SD), ubound(InData%OtherSt_SD)) + LB(1:1) = lbound(InData%OtherSt_SD) + UB(1:1) = ubound(InData%OtherSt_SD) + do i1 = LB(1), UB(1) + call SD_PackOtherState(Buf, InData%OtherSt_SD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u_SD)) + if (allocated(InData%u_SD)) then + call RegPackBounds(Buf, 1, lbound(InData%u_SD), ubound(InData%u_SD)) + LB(1:1) = lbound(InData%u_SD) + UB(1:1) = ubound(InData%u_SD) + do i1 = LB(1), UB(1) + call SD_PackInput(Buf, InData%u_SD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%x_ExtPtfm)) + if (allocated(InData%x_ExtPtfm)) then + call RegPackBounds(Buf, 1, lbound(InData%x_ExtPtfm), ubound(InData%x_ExtPtfm)) + LB(1:1) = lbound(InData%x_ExtPtfm) + UB(1:1) = ubound(InData%x_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackContState(Buf, InData%x_ExtPtfm(i1)) + end do + end if + call RegPack(Buf, allocated(InData%xd_ExtPtfm)) + if (allocated(InData%xd_ExtPtfm)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_ExtPtfm), ubound(InData%xd_ExtPtfm)) + LB(1:1) = lbound(InData%xd_ExtPtfm) + UB(1:1) = ubound(InData%xd_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackDiscState(Buf, InData%xd_ExtPtfm(i1)) + end do + end if + call RegPack(Buf, allocated(InData%z_ExtPtfm)) + if (allocated(InData%z_ExtPtfm)) then + call RegPackBounds(Buf, 1, lbound(InData%z_ExtPtfm), ubound(InData%z_ExtPtfm)) + LB(1:1) = lbound(InData%z_ExtPtfm) + UB(1:1) = ubound(InData%z_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackConstrState(Buf, InData%z_ExtPtfm(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OtherSt_ExtPtfm)) + if (allocated(InData%OtherSt_ExtPtfm)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ExtPtfm), ubound(InData%OtherSt_ExtPtfm)) + LB(1:1) = lbound(InData%OtherSt_ExtPtfm) + UB(1:1) = ubound(InData%OtherSt_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackOtherState(Buf, InData%OtherSt_ExtPtfm(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u_ExtPtfm)) + if (allocated(InData%u_ExtPtfm)) then + call RegPackBounds(Buf, 1, lbound(InData%u_ExtPtfm), ubound(InData%u_ExtPtfm)) + LB(1:1) = lbound(InData%u_ExtPtfm) + UB(1:1) = ubound(InData%u_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackInput(Buf, InData%u_ExtPtfm(i1)) + end do + end if + call RegPack(Buf, allocated(InData%x_HD)) + if (allocated(InData%x_HD)) then + call RegPackBounds(Buf, 1, lbound(InData%x_HD), ubound(InData%x_HD)) + LB(1:1) = lbound(InData%x_HD) + UB(1:1) = ubound(InData%x_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackContState(Buf, InData%x_HD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%xd_HD)) + if (allocated(InData%xd_HD)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_HD), ubound(InData%xd_HD)) + LB(1:1) = lbound(InData%xd_HD) + UB(1:1) = ubound(InData%xd_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackDiscState(Buf, InData%xd_HD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%z_HD)) + if (allocated(InData%z_HD)) then + call RegPackBounds(Buf, 1, lbound(InData%z_HD), ubound(InData%z_HD)) + LB(1:1) = lbound(InData%z_HD) + UB(1:1) = ubound(InData%z_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackConstrState(Buf, InData%z_HD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OtherSt_HD)) + if (allocated(InData%OtherSt_HD)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_HD), ubound(InData%OtherSt_HD)) + LB(1:1) = lbound(InData%OtherSt_HD) + UB(1:1) = ubound(InData%OtherSt_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackOtherState(Buf, InData%OtherSt_HD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u_HD)) + if (allocated(InData%u_HD)) then + call RegPackBounds(Buf, 1, lbound(InData%u_HD), ubound(InData%u_HD)) + LB(1:1) = lbound(InData%u_HD) + UB(1:1) = ubound(InData%u_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackInput(Buf, InData%u_HD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%x_IceF)) + if (allocated(InData%x_IceF)) then + call RegPackBounds(Buf, 1, lbound(InData%x_IceF), ubound(InData%x_IceF)) + LB(1:1) = lbound(InData%x_IceF) + UB(1:1) = ubound(InData%x_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackContState(Buf, InData%x_IceF(i1)) + end do + end if + call RegPack(Buf, allocated(InData%xd_IceF)) + if (allocated(InData%xd_IceF)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_IceF), ubound(InData%xd_IceF)) + LB(1:1) = lbound(InData%xd_IceF) + UB(1:1) = ubound(InData%xd_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackDiscState(Buf, InData%xd_IceF(i1)) + end do + end if + call RegPack(Buf, allocated(InData%z_IceF)) + if (allocated(InData%z_IceF)) then + call RegPackBounds(Buf, 1, lbound(InData%z_IceF), ubound(InData%z_IceF)) + LB(1:1) = lbound(InData%z_IceF) + UB(1:1) = ubound(InData%z_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackConstrState(Buf, InData%z_IceF(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OtherSt_IceF)) + if (allocated(InData%OtherSt_IceF)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IceF), ubound(InData%OtherSt_IceF)) + LB(1:1) = lbound(InData%OtherSt_IceF) + UB(1:1) = ubound(InData%OtherSt_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackOtherState(Buf, InData%OtherSt_IceF(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u_IceF)) + if (allocated(InData%u_IceF)) then + call RegPackBounds(Buf, 1, lbound(InData%u_IceF), ubound(InData%u_IceF)) + LB(1:1) = lbound(InData%u_IceF) + UB(1:1) = ubound(InData%u_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackInput(Buf, InData%u_IceF(i1)) + end do + end if + call RegPack(Buf, allocated(InData%x_MAP)) + if (allocated(InData%x_MAP)) then + call RegPackBounds(Buf, 1, lbound(InData%x_MAP), ubound(InData%x_MAP)) + LB(1:1) = lbound(InData%x_MAP) + UB(1:1) = ubound(InData%x_MAP) + do i1 = LB(1), UB(1) + call MAP_PackContState(Buf, InData%x_MAP(i1)) + end do + end if + call RegPack(Buf, allocated(InData%xd_MAP)) + if (allocated(InData%xd_MAP)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_MAP), ubound(InData%xd_MAP)) + LB(1:1) = lbound(InData%xd_MAP) + UB(1:1) = ubound(InData%xd_MAP) + do i1 = LB(1), UB(1) + call MAP_PackDiscState(Buf, InData%xd_MAP(i1)) + end do + end if + call RegPack(Buf, allocated(InData%z_MAP)) + if (allocated(InData%z_MAP)) then + call RegPackBounds(Buf, 1, lbound(InData%z_MAP), ubound(InData%z_MAP)) + LB(1:1) = lbound(InData%z_MAP) + UB(1:1) = ubound(InData%z_MAP) + do i1 = LB(1), UB(1) + call MAP_PackConstrState(Buf, InData%z_MAP(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u_MAP)) + if (allocated(InData%u_MAP)) then + call RegPackBounds(Buf, 1, lbound(InData%u_MAP), ubound(InData%u_MAP)) + LB(1:1) = lbound(InData%u_MAP) + UB(1:1) = ubound(InData%u_MAP) + do i1 = LB(1), UB(1) + call MAP_PackInput(Buf, InData%u_MAP(i1)) + end do + end if + call RegPack(Buf, allocated(InData%x_FEAM)) + if (allocated(InData%x_FEAM)) then + call RegPackBounds(Buf, 1, lbound(InData%x_FEAM), ubound(InData%x_FEAM)) + LB(1:1) = lbound(InData%x_FEAM) + UB(1:1) = ubound(InData%x_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackContState(Buf, InData%x_FEAM(i1)) + end do + end if + call RegPack(Buf, allocated(InData%xd_FEAM)) + if (allocated(InData%xd_FEAM)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_FEAM), ubound(InData%xd_FEAM)) + LB(1:1) = lbound(InData%xd_FEAM) + UB(1:1) = ubound(InData%xd_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackDiscState(Buf, InData%xd_FEAM(i1)) + end do + end if + call RegPack(Buf, allocated(InData%z_FEAM)) + if (allocated(InData%z_FEAM)) then + call RegPackBounds(Buf, 1, lbound(InData%z_FEAM), ubound(InData%z_FEAM)) + LB(1:1) = lbound(InData%z_FEAM) + UB(1:1) = ubound(InData%z_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackConstrState(Buf, InData%z_FEAM(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OtherSt_FEAM)) + if (allocated(InData%OtherSt_FEAM)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_FEAM), ubound(InData%OtherSt_FEAM)) + LB(1:1) = lbound(InData%OtherSt_FEAM) + UB(1:1) = ubound(InData%OtherSt_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackOtherState(Buf, InData%OtherSt_FEAM(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u_FEAM)) + if (allocated(InData%u_FEAM)) then + call RegPackBounds(Buf, 1, lbound(InData%u_FEAM), ubound(InData%u_FEAM)) + LB(1:1) = lbound(InData%u_FEAM) + UB(1:1) = ubound(InData%u_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackInput(Buf, InData%u_FEAM(i1)) + end do + end if + call RegPack(Buf, allocated(InData%x_MD)) + if (allocated(InData%x_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%x_MD), ubound(InData%x_MD)) + LB(1:1) = lbound(InData%x_MD) + UB(1:1) = ubound(InData%x_MD) + do i1 = LB(1), UB(1) + call MD_PackContState(Buf, InData%x_MD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%xd_MD)) + if (allocated(InData%xd_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_MD), ubound(InData%xd_MD)) + LB(1:1) = lbound(InData%xd_MD) + UB(1:1) = ubound(InData%xd_MD) + do i1 = LB(1), UB(1) + call MD_PackDiscState(Buf, InData%xd_MD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%z_MD)) + if (allocated(InData%z_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%z_MD), ubound(InData%z_MD)) + LB(1:1) = lbound(InData%z_MD) + UB(1:1) = ubound(InData%z_MD) + do i1 = LB(1), UB(1) + call MD_PackConstrState(Buf, InData%z_MD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OtherSt_MD)) + if (allocated(InData%OtherSt_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_MD), ubound(InData%OtherSt_MD)) + LB(1:1) = lbound(InData%OtherSt_MD) + UB(1:1) = ubound(InData%OtherSt_MD) + do i1 = LB(1), UB(1) + call MD_PackOtherState(Buf, InData%OtherSt_MD(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u_MD)) + if (allocated(InData%u_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%u_MD), ubound(InData%u_MD)) + LB(1:1) = lbound(InData%u_MD) + UB(1:1) = ubound(InData%u_MD) + do i1 = LB(1), UB(1) + call MD_PackInput(Buf, InData%u_MD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackLinStateSave(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinStateSave), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackLinStateSave' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%x_IceD)) deallocate(OutData%x_IceD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackContState(Buf, OutData%x_IceD(i1,i2)) ! x_IceD + end do + end do + end if + if (allocated(OutData%xd_IceD)) deallocate(OutData%xd_IceD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackDiscState(Buf, OutData%xd_IceD(i1,i2)) ! xd_IceD + end do + end do + end if + if (allocated(OutData%z_IceD)) deallocate(OutData%z_IceD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackConstrState(Buf, OutData%z_IceD(i1,i2)) ! z_IceD + end do + end do + end if + if (allocated(OutData%OtherSt_IceD)) deallocate(OutData%OtherSt_IceD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackOtherState(Buf, OutData%OtherSt_IceD(i1,i2)) ! OtherSt_IceD + end do + end do + end if + if (allocated(OutData%u_IceD)) deallocate(OutData%u_IceD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackInput(Buf, OutData%u_IceD(i1,i2)) ! u_IceD + end do + end do + end if + if (allocated(OutData%x_BD)) deallocate(OutData%x_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackContState(Buf, OutData%x_BD(i1,i2)) ! x_BD + end do + end do + end if + if (allocated(OutData%xd_BD)) deallocate(OutData%xd_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackDiscState(Buf, OutData%xd_BD(i1,i2)) ! xd_BD + end do + end do + end if + if (allocated(OutData%z_BD)) deallocate(OutData%z_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackConstrState(Buf, OutData%z_BD(i1,i2)) ! z_BD + end do + end do + end if + if (allocated(OutData%OtherSt_BD)) deallocate(OutData%OtherSt_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackOtherState(Buf, OutData%OtherSt_BD(i1,i2)) ! OtherSt_BD + end do + end do + end if + if (allocated(OutData%u_BD)) deallocate(OutData%u_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackInput(Buf, OutData%u_BD(i1,i2)) ! u_BD + end do + end do + end if + if (allocated(OutData%x_ED)) deallocate(OutData%x_ED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackContState(Buf, OutData%x_ED(i1)) ! x_ED + end do + end if + if (allocated(OutData%xd_ED)) deallocate(OutData%xd_ED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackDiscState(Buf, OutData%xd_ED(i1)) ! xd_ED + end do + end if + if (allocated(OutData%z_ED)) deallocate(OutData%z_ED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackConstrState(Buf, OutData%z_ED(i1)) ! z_ED + end do + end if + if (allocated(OutData%OtherSt_ED)) deallocate(OutData%OtherSt_ED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackOtherState(Buf, OutData%OtherSt_ED(i1)) ! OtherSt_ED + end do + end if + if (allocated(OutData%u_ED)) deallocate(OutData%u_ED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackInput(Buf, OutData%u_ED(i1)) ! u_ED + end do + end if + if (allocated(OutData%x_SrvD)) deallocate(OutData%x_SrvD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackContState(Buf, OutData%x_SrvD(i1)) ! x_SrvD + end do + end if + if (allocated(OutData%xd_SrvD)) deallocate(OutData%xd_SrvD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackDiscState(Buf, OutData%xd_SrvD(i1)) ! xd_SrvD + end do + end if + if (allocated(OutData%z_SrvD)) deallocate(OutData%z_SrvD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackConstrState(Buf, OutData%z_SrvD(i1)) ! z_SrvD + end do + end if + if (allocated(OutData%OtherSt_SrvD)) deallocate(OutData%OtherSt_SrvD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackOtherState(Buf, OutData%OtherSt_SrvD(i1)) ! OtherSt_SrvD + end do + end if + if (allocated(OutData%u_SrvD)) deallocate(OutData%u_SrvD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackInput(Buf, OutData%u_SrvD(i1)) ! u_SrvD + end do + end if + if (allocated(OutData%x_AD)) deallocate(OutData%x_AD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackContState(Buf, OutData%x_AD(i1)) ! x_AD + end do + end if + if (allocated(OutData%xd_AD)) deallocate(OutData%xd_AD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackDiscState(Buf, OutData%xd_AD(i1)) ! xd_AD + end do + end if + if (allocated(OutData%z_AD)) deallocate(OutData%z_AD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackConstrState(Buf, OutData%z_AD(i1)) ! z_AD + end do + end if + if (allocated(OutData%OtherSt_AD)) deallocate(OutData%OtherSt_AD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackOtherState(Buf, OutData%OtherSt_AD(i1)) ! OtherSt_AD + end do + end if + if (allocated(OutData%u_AD)) deallocate(OutData%u_AD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackInput(Buf, OutData%u_AD(i1)) ! u_AD + end do + end if + if (allocated(OutData%x_IfW)) deallocate(OutData%x_IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackContState(Buf, OutData%x_IfW(i1)) ! x_IfW + end do + end if + if (allocated(OutData%xd_IfW)) deallocate(OutData%xd_IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackDiscState(Buf, OutData%xd_IfW(i1)) ! xd_IfW + end do + end if + if (allocated(OutData%z_IfW)) deallocate(OutData%z_IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackConstrState(Buf, OutData%z_IfW(i1)) ! z_IfW + end do + end if + if (allocated(OutData%OtherSt_IfW)) deallocate(OutData%OtherSt_IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackOtherState(Buf, OutData%OtherSt_IfW(i1)) ! OtherSt_IfW + end do + end if + if (allocated(OutData%u_IfW)) deallocate(OutData%u_IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackInput(Buf, OutData%u_IfW(i1)) ! u_IfW + end do + end if + if (allocated(OutData%x_SD)) deallocate(OutData%x_SD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackContState(Buf, OutData%x_SD(i1)) ! x_SD + end do + end if + if (allocated(OutData%xd_SD)) deallocate(OutData%xd_SD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackDiscState(Buf, OutData%xd_SD(i1)) ! xd_SD + end do + end if + if (allocated(OutData%z_SD)) deallocate(OutData%z_SD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackConstrState(Buf, OutData%z_SD(i1)) ! z_SD + end do + end if + if (allocated(OutData%OtherSt_SD)) deallocate(OutData%OtherSt_SD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackOtherState(Buf, OutData%OtherSt_SD(i1)) ! OtherSt_SD + end do + end if + if (allocated(OutData%u_SD)) deallocate(OutData%u_SD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackInput(Buf, OutData%u_SD(i1)) ! u_SD + end do + end if + if (allocated(OutData%x_ExtPtfm)) deallocate(OutData%x_ExtPtfm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackContState(Buf, OutData%x_ExtPtfm(i1)) ! x_ExtPtfm + end do + end if + if (allocated(OutData%xd_ExtPtfm)) deallocate(OutData%xd_ExtPtfm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackDiscState(Buf, OutData%xd_ExtPtfm(i1)) ! xd_ExtPtfm + end do + end if + if (allocated(OutData%z_ExtPtfm)) deallocate(OutData%z_ExtPtfm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackConstrState(Buf, OutData%z_ExtPtfm(i1)) ! z_ExtPtfm + end do + end if + if (allocated(OutData%OtherSt_ExtPtfm)) deallocate(OutData%OtherSt_ExtPtfm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackOtherState(Buf, OutData%OtherSt_ExtPtfm(i1)) ! OtherSt_ExtPtfm + end do + end if + if (allocated(OutData%u_ExtPtfm)) deallocate(OutData%u_ExtPtfm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackInput(Buf, OutData%u_ExtPtfm(i1)) ! u_ExtPtfm + end do + end if + if (allocated(OutData%x_HD)) deallocate(OutData%x_HD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackContState(Buf, OutData%x_HD(i1)) ! x_HD + end do + end if + if (allocated(OutData%xd_HD)) deallocate(OutData%xd_HD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackDiscState(Buf, OutData%xd_HD(i1)) ! xd_HD + end do + end if + if (allocated(OutData%z_HD)) deallocate(OutData%z_HD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackConstrState(Buf, OutData%z_HD(i1)) ! z_HD + end do + end if + if (allocated(OutData%OtherSt_HD)) deallocate(OutData%OtherSt_HD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackOtherState(Buf, OutData%OtherSt_HD(i1)) ! OtherSt_HD + end do + end if + if (allocated(OutData%u_HD)) deallocate(OutData%u_HD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackInput(Buf, OutData%u_HD(i1)) ! u_HD + end do + end if + if (allocated(OutData%x_IceF)) deallocate(OutData%x_IceF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackContState(Buf, OutData%x_IceF(i1)) ! x_IceF + end do + end if + if (allocated(OutData%xd_IceF)) deallocate(OutData%xd_IceF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackDiscState(Buf, OutData%xd_IceF(i1)) ! xd_IceF + end do + end if + if (allocated(OutData%z_IceF)) deallocate(OutData%z_IceF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackConstrState(Buf, OutData%z_IceF(i1)) ! z_IceF + end do + end if + if (allocated(OutData%OtherSt_IceF)) deallocate(OutData%OtherSt_IceF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackOtherState(Buf, OutData%OtherSt_IceF(i1)) ! OtherSt_IceF + end do + end if + if (allocated(OutData%u_IceF)) deallocate(OutData%u_IceF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackInput(Buf, OutData%u_IceF(i1)) ! u_IceF + end do + end if + if (allocated(OutData%x_MAP)) deallocate(OutData%x_MAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackContState(Buf, OutData%x_MAP(i1)) ! x_MAP + end do + end if + if (allocated(OutData%xd_MAP)) deallocate(OutData%xd_MAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackDiscState(Buf, OutData%xd_MAP(i1)) ! xd_MAP + end do + end if + if (allocated(OutData%z_MAP)) deallocate(OutData%z_MAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackConstrState(Buf, OutData%z_MAP(i1)) ! z_MAP + end do + end if + if (allocated(OutData%u_MAP)) deallocate(OutData%u_MAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackInput(Buf, OutData%u_MAP(i1)) ! u_MAP + end do + end if + if (allocated(OutData%x_FEAM)) deallocate(OutData%x_FEAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackContState(Buf, OutData%x_FEAM(i1)) ! x_FEAM + end do + end if + if (allocated(OutData%xd_FEAM)) deallocate(OutData%xd_FEAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackDiscState(Buf, OutData%xd_FEAM(i1)) ! xd_FEAM + end do + end if + if (allocated(OutData%z_FEAM)) deallocate(OutData%z_FEAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackConstrState(Buf, OutData%z_FEAM(i1)) ! z_FEAM + end do + end if + if (allocated(OutData%OtherSt_FEAM)) deallocate(OutData%OtherSt_FEAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackOtherState(Buf, OutData%OtherSt_FEAM(i1)) ! OtherSt_FEAM + end do + end if + if (allocated(OutData%u_FEAM)) deallocate(OutData%u_FEAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackInput(Buf, OutData%u_FEAM(i1)) ! u_FEAM + end do + end if + if (allocated(OutData%x_MD)) deallocate(OutData%x_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackContState(Buf, OutData%x_MD(i1)) ! x_MD + end do + end if + if (allocated(OutData%xd_MD)) deallocate(OutData%xd_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackDiscState(Buf, OutData%xd_MD(i1)) ! xd_MD + end do + end if + if (allocated(OutData%z_MD)) deallocate(OutData%z_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackConstrState(Buf, OutData%z_MD(i1)) ! z_MD + end do + end if + if (allocated(OutData%OtherSt_MD)) deallocate(OutData%OtherSt_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackOtherState(Buf, OutData%OtherSt_MD(i1)) ! OtherSt_MD + end do + end if + if (allocated(OutData%u_MD)) deallocate(OutData%u_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackInput(Buf, OutData%u_MD(i1)) ! u_MD + end do + end if +end subroutine + +subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_LinType), intent(in) :: SrcLinTypeData + type(FAST_LinType), intent(inout) :: DstLinTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyLinType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBeamDyn_DataData%x)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%x,1) - i1_u = UBOUND(SrcBeamDyn_DataData%x,1) - i2_l = LBOUND(SrcBeamDyn_DataData%x,2) - i2_u = UBOUND(SrcBeamDyn_DataData%x,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%x)) THEN - ALLOCATE(DstBeamDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%x,2), UBOUND(SrcBeamDyn_DataData%x,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%x,1), UBOUND(SrcBeamDyn_DataData%x,1) - CALL BD_CopyContState( SrcBeamDyn_DataData%x(i1,i2), DstBeamDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%xd)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%xd,1) - i1_u = UBOUND(SrcBeamDyn_DataData%xd,1) - i2_l = LBOUND(SrcBeamDyn_DataData%xd,2) - i2_u = UBOUND(SrcBeamDyn_DataData%xd,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%xd)) THEN - ALLOCATE(DstBeamDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%xd,2), UBOUND(SrcBeamDyn_DataData%xd,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%xd,1), UBOUND(SrcBeamDyn_DataData%xd,1) - CALL BD_CopyDiscState( SrcBeamDyn_DataData%xd(i1,i2), DstBeamDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%z)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%z,1) - i1_u = UBOUND(SrcBeamDyn_DataData%z,1) - i2_l = LBOUND(SrcBeamDyn_DataData%z,2) - i2_u = UBOUND(SrcBeamDyn_DataData%z,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%z)) THEN - ALLOCATE(DstBeamDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%z,2), UBOUND(SrcBeamDyn_DataData%z,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%z,1), UBOUND(SrcBeamDyn_DataData%z,1) - CALL BD_CopyConstrState( SrcBeamDyn_DataData%z(i1,i2), DstBeamDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%OtherSt)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%OtherSt,1) - i1_u = UBOUND(SrcBeamDyn_DataData%OtherSt,1) - i2_l = LBOUND(SrcBeamDyn_DataData%OtherSt,2) - i2_u = UBOUND(SrcBeamDyn_DataData%OtherSt,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%OtherSt)) THEN - ALLOCATE(DstBeamDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%OtherSt,2), UBOUND(SrcBeamDyn_DataData%OtherSt,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%OtherSt,1), UBOUND(SrcBeamDyn_DataData%OtherSt,1) - CALL BD_CopyOtherState( SrcBeamDyn_DataData%OtherSt(i1,i2), DstBeamDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%p)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%p,1) - i1_u = UBOUND(SrcBeamDyn_DataData%p,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%p)) THEN - ALLOCATE(DstBeamDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%p,1), UBOUND(SrcBeamDyn_DataData%p,1) - CALL BD_CopyParam( SrcBeamDyn_DataData%p(i1), DstBeamDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%u)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%u,1) - i1_u = UBOUND(SrcBeamDyn_DataData%u,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%u)) THEN - ALLOCATE(DstBeamDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%u,1), UBOUND(SrcBeamDyn_DataData%u,1) - CALL BD_CopyInput( SrcBeamDyn_DataData%u(i1), DstBeamDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%y)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%y,1) - i1_u = UBOUND(SrcBeamDyn_DataData%y,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y)) THEN - ALLOCATE(DstBeamDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%y,1), UBOUND(SrcBeamDyn_DataData%y,1) - CALL BD_CopyOutput( SrcBeamDyn_DataData%y(i1), DstBeamDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%m)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%m,1) - i1_u = UBOUND(SrcBeamDyn_DataData%m,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%m)) THEN - ALLOCATE(DstBeamDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%m,1), UBOUND(SrcBeamDyn_DataData%m,1) - CALL BD_CopyMisc( SrcBeamDyn_DataData%m(i1), DstBeamDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%Output,1) - i1_u = UBOUND(SrcBeamDyn_DataData%Output,1) - i2_l = LBOUND(SrcBeamDyn_DataData%Output,2) - i2_u = UBOUND(SrcBeamDyn_DataData%Output,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Output)) THEN - ALLOCATE(DstBeamDyn_DataData%Output(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%Output,2), UBOUND(SrcBeamDyn_DataData%Output,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%Output,1), UBOUND(SrcBeamDyn_DataData%Output,1) - CALL BD_CopyOutput( SrcBeamDyn_DataData%Output(i1,i2), DstBeamDyn_DataData%Output(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%y_interp)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%y_interp,1) - i1_u = UBOUND(SrcBeamDyn_DataData%y_interp,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y_interp)) THEN - ALLOCATE(DstBeamDyn_DataData%y_interp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y_interp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%y_interp,1), UBOUND(SrcBeamDyn_DataData%y_interp,1) - CALL BD_CopyOutput( SrcBeamDyn_DataData%y_interp(i1), DstBeamDyn_DataData%y_interp(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%Input,1) - i1_u = UBOUND(SrcBeamDyn_DataData%Input,1) - i2_l = LBOUND(SrcBeamDyn_DataData%Input,2) - i2_u = UBOUND(SrcBeamDyn_DataData%Input,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Input)) THEN - ALLOCATE(DstBeamDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%Input,2), UBOUND(SrcBeamDyn_DataData%Input,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%Input,1), UBOUND(SrcBeamDyn_DataData%Input,1) - CALL BD_CopyInput( SrcBeamDyn_DataData%Input(i1,i2), DstBeamDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcBeamDyn_DataData%InputTimes,1) - i2_l = LBOUND(SrcBeamDyn_DataData%InputTimes,2) - i2_u = UBOUND(SrcBeamDyn_DataData%InputTimes,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%InputTimes)) THEN - ALLOCATE(DstBeamDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyBeamDyn_Data - - SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg ) - TYPE(BeamDyn_Data), INTENT(INOUT) :: BeamDyn_DataData - 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 = 'FAST_DestroyBeamDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%x) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%xd) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%z) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%OtherSt) -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 ) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%m) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%Output) -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%y_interp) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%Input) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%InputTimes)) THEN - DEALLOCATE(BeamDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyBeamDyn_Data - - SUBROUTINE FAST_PackBeamDyn_Data( 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(BeamDyn_Data), 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 = 'FAST_PackBeamDyn_Data' - ! 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 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no - IF ( ALLOCATED(InData%xd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt allocated yes/no - IF ( ALLOCATED(InData%OtherSt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! p allocated yes/no - IF ( ALLOCATED(InData%p) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! p upper/lower bounds for each dimension - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL BD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u allocated yes/no - IF ( ALLOCATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! m allocated yes/no - IF ( ALLOCATED(InData%m) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m upper/lower bounds for each dimension - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL BD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Output upper/lower bounds for each dimension - DO i2 = LBOUND(InData%Output,2), UBOUND(InData%Output,2) - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_interp allocated yes/no - IF ( ALLOCATED(InData%y_interp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_interp upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Input upper/lower bounds for each dimension - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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%x) ) 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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%xd) ) 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%xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%z) ) 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%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt) ) 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%OtherSt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%p) ) 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%p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - CALL BD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, OnlySize ) ! 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 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u) ) 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%u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - IF ( .NOT. ALLOCATED(InData%y) ) 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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - IF ( .NOT. ALLOCATED(InData%m) ) 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%m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - CALL BD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, OnlySize ) ! 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Output,2), UBOUND(InData%Output,2) - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%y_interp) ) 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%y_interp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_interp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InputTimes,2), UBOUND(InData%InputTimes,2) - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_PackBeamDyn_Data - - SUBROUTINE FAST_UnPackBeamDyn_Data( 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(BeamDyn_Data), 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 = 'FAST_UnPackBeamDyn_Data' - ! 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 ! x 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%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%x,2), UBOUND(OutData%x,2) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 BD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd 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%xd)) DEALLOCATE(OutData%xd) - ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 BD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z 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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 BD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt 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%OtherSt)) DEALLOCATE(OutData%OtherSt) - ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 BD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p 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%p)) DEALLOCATE(OutData%p) - ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,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 BD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! 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) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u 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%u)) DEALLOCATE(OutData%u) - ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,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 BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u - 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 ! y 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,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 BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y - 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 ! m 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%m)) DEALLOCATE(OutData%m) - ALLOCATE(OutData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,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 BD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output 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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Output,2), UBOUND(OutData%Output,2) - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1,i2), ErrStat2, ErrMsg2 ) ! Output - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_interp 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%y_interp)) DEALLOCATE(OutData%y_interp) - ALLOCATE(OutData%y_interp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_interp,1), UBOUND(OutData%y_interp,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 BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp(i1), ErrStat2, ErrMsg2 ) ! y_interp - 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 ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Input,2), UBOUND(OutData%Input,2) - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1,i2), ErrStat2, ErrMsg2 ) ! Input - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InputTimes,2), UBOUND(OutData%InputTimes,2) - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_UnPackBeamDyn_Data - - SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: SrcElastoDyn_DataData - TYPE(ElastoDyn_Data), INTENT(INOUT) :: DstElastoDyn_DataData - 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 = 'FAST_CopyElastoDyn_Data' -! + ErrMsg = '' + if (allocated(SrcLinTypeData%Names_u)) then + LB(1:1) = lbound(SrcLinTypeData%Names_u) + UB(1:1) = ubound(SrcLinTypeData%Names_u) + if (.not. allocated(DstLinTypeData%Names_u)) then + allocate(DstLinTypeData%Names_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Names_u = SrcLinTypeData%Names_u + end if + if (allocated(SrcLinTypeData%Names_y)) then + LB(1:1) = lbound(SrcLinTypeData%Names_y) + UB(1:1) = ubound(SrcLinTypeData%Names_y) + if (.not. allocated(DstLinTypeData%Names_y)) then + allocate(DstLinTypeData%Names_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Names_y = SrcLinTypeData%Names_y + end if + if (allocated(SrcLinTypeData%Names_x)) then + LB(1:1) = lbound(SrcLinTypeData%Names_x) + UB(1:1) = ubound(SrcLinTypeData%Names_x) + if (.not. allocated(DstLinTypeData%Names_x)) then + allocate(DstLinTypeData%Names_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Names_x = SrcLinTypeData%Names_x + end if + if (allocated(SrcLinTypeData%Names_xd)) then + LB(1:1) = lbound(SrcLinTypeData%Names_xd) + UB(1:1) = ubound(SrcLinTypeData%Names_xd) + if (.not. allocated(DstLinTypeData%Names_xd)) then + allocate(DstLinTypeData%Names_xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd + end if + if (allocated(SrcLinTypeData%Names_z)) then + LB(1:1) = lbound(SrcLinTypeData%Names_z) + UB(1:1) = ubound(SrcLinTypeData%Names_z) + if (.not. allocated(DstLinTypeData%Names_z)) then + allocate(DstLinTypeData%Names_z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Names_z = SrcLinTypeData%Names_z + end if + if (allocated(SrcLinTypeData%op_u)) then + LB(1:1) = lbound(SrcLinTypeData%op_u) + UB(1:1) = ubound(SrcLinTypeData%op_u) + if (.not. allocated(DstLinTypeData%op_u)) then + allocate(DstLinTypeData%op_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_u = SrcLinTypeData%op_u + end if + if (allocated(SrcLinTypeData%op_y)) then + LB(1:1) = lbound(SrcLinTypeData%op_y) + UB(1:1) = ubound(SrcLinTypeData%op_y) + if (.not. allocated(DstLinTypeData%op_y)) then + allocate(DstLinTypeData%op_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_y = SrcLinTypeData%op_y + end if + if (allocated(SrcLinTypeData%op_x)) then + LB(1:1) = lbound(SrcLinTypeData%op_x) + UB(1:1) = ubound(SrcLinTypeData%op_x) + if (.not. allocated(DstLinTypeData%op_x)) then + allocate(DstLinTypeData%op_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_x = SrcLinTypeData%op_x + end if + if (allocated(SrcLinTypeData%op_dx)) then + LB(1:1) = lbound(SrcLinTypeData%op_dx) + UB(1:1) = ubound(SrcLinTypeData%op_dx) + if (.not. allocated(DstLinTypeData%op_dx)) then + allocate(DstLinTypeData%op_dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_dx = SrcLinTypeData%op_dx + end if + if (allocated(SrcLinTypeData%op_xd)) then + LB(1:1) = lbound(SrcLinTypeData%op_xd) + UB(1:1) = ubound(SrcLinTypeData%op_xd) + if (.not. allocated(DstLinTypeData%op_xd)) then + allocate(DstLinTypeData%op_xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_xd = SrcLinTypeData%op_xd + end if + if (allocated(SrcLinTypeData%op_z)) then + LB(1:1) = lbound(SrcLinTypeData%op_z) + UB(1:1) = ubound(SrcLinTypeData%op_z) + if (.not. allocated(DstLinTypeData%op_z)) then + allocate(DstLinTypeData%op_z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_z = SrcLinTypeData%op_z + end if + if (allocated(SrcLinTypeData%op_x_eig_mag)) then + LB(1:1) = lbound(SrcLinTypeData%op_x_eig_mag) + UB(1:1) = ubound(SrcLinTypeData%op_x_eig_mag) + if (.not. allocated(DstLinTypeData%op_x_eig_mag)) then + allocate(DstLinTypeData%op_x_eig_mag(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_mag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_x_eig_mag = SrcLinTypeData%op_x_eig_mag + end if + if (allocated(SrcLinTypeData%op_x_eig_phase)) then + LB(1:1) = lbound(SrcLinTypeData%op_x_eig_phase) + UB(1:1) = ubound(SrcLinTypeData%op_x_eig_phase) + if (.not. allocated(DstLinTypeData%op_x_eig_phase)) then + allocate(DstLinTypeData%op_x_eig_phase(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_phase.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_x_eig_phase = SrcLinTypeData%op_x_eig_phase + end if + if (allocated(SrcLinTypeData%Use_u)) then + LB(1:1) = lbound(SrcLinTypeData%Use_u) + UB(1:1) = ubound(SrcLinTypeData%Use_u) + if (.not. allocated(DstLinTypeData%Use_u)) then + allocate(DstLinTypeData%Use_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Use_u = SrcLinTypeData%Use_u + end if + if (allocated(SrcLinTypeData%Use_y)) then + LB(1:1) = lbound(SrcLinTypeData%Use_y) + UB(1:1) = ubound(SrcLinTypeData%Use_y) + if (.not. allocated(DstLinTypeData%Use_y)) then + allocate(DstLinTypeData%Use_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Use_y = SrcLinTypeData%Use_y + end if + if (allocated(SrcLinTypeData%A)) then + LB(1:2) = lbound(SrcLinTypeData%A) + UB(1:2) = ubound(SrcLinTypeData%A) + if (.not. allocated(DstLinTypeData%A)) then + allocate(DstLinTypeData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%A = SrcLinTypeData%A + end if + if (allocated(SrcLinTypeData%B)) then + LB(1:2) = lbound(SrcLinTypeData%B) + UB(1:2) = ubound(SrcLinTypeData%B) + if (.not. allocated(DstLinTypeData%B)) then + allocate(DstLinTypeData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%B = SrcLinTypeData%B + end if + if (allocated(SrcLinTypeData%C)) then + LB(1:2) = lbound(SrcLinTypeData%C) + UB(1:2) = ubound(SrcLinTypeData%C) + if (.not. allocated(DstLinTypeData%C)) then + allocate(DstLinTypeData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%C = SrcLinTypeData%C + end if + if (allocated(SrcLinTypeData%D)) then + LB(1:2) = lbound(SrcLinTypeData%D) + UB(1:2) = ubound(SrcLinTypeData%D) + if (.not. allocated(DstLinTypeData%D)) then + allocate(DstLinTypeData%D(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%D.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%D = SrcLinTypeData%D + end if + if (allocated(SrcLinTypeData%StateRotation)) then + LB(1:2) = lbound(SrcLinTypeData%StateRotation) + UB(1:2) = ubound(SrcLinTypeData%StateRotation) + if (.not. allocated(DstLinTypeData%StateRotation)) then + allocate(DstLinTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation + end if + if (allocated(SrcLinTypeData%StateRel_x)) then + LB(1:2) = lbound(SrcLinTypeData%StateRel_x) + UB(1:2) = ubound(SrcLinTypeData%StateRel_x) + if (.not. allocated(DstLinTypeData%StateRel_x)) then + allocate(DstLinTypeData%StateRel_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x + end if + if (allocated(SrcLinTypeData%StateRel_xdot)) then + LB(1:2) = lbound(SrcLinTypeData%StateRel_xdot) + UB(1:2) = ubound(SrcLinTypeData%StateRel_xdot) + if (.not. allocated(DstLinTypeData%StateRel_xdot)) then + allocate(DstLinTypeData%StateRel_xdot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_xdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot + end if + if (allocated(SrcLinTypeData%IsLoad_u)) then + LB(1:1) = lbound(SrcLinTypeData%IsLoad_u) + UB(1:1) = ubound(SrcLinTypeData%IsLoad_u) + if (.not. allocated(DstLinTypeData%IsLoad_u)) then + allocate(DstLinTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u + end if + if (allocated(SrcLinTypeData%RotFrame_u)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_u) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_u) + if (.not. allocated(DstLinTypeData%RotFrame_u)) then + allocate(DstLinTypeData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u + end if + if (allocated(SrcLinTypeData%RotFrame_y)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_y) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_y) + if (.not. allocated(DstLinTypeData%RotFrame_y)) then + allocate(DstLinTypeData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y + end if + if (allocated(SrcLinTypeData%RotFrame_x)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_x) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_x) + if (.not. allocated(DstLinTypeData%RotFrame_x)) then + allocate(DstLinTypeData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x + end if + if (allocated(SrcLinTypeData%RotFrame_z)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_z) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_z) + if (.not. allocated(DstLinTypeData%RotFrame_z)) then + allocate(DstLinTypeData%RotFrame_z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z + end if + if (allocated(SrcLinTypeData%DerivOrder_x)) then + LB(1:1) = lbound(SrcLinTypeData%DerivOrder_x) + UB(1:1) = ubound(SrcLinTypeData%DerivOrder_x) + if (.not. allocated(DstLinTypeData%DerivOrder_x)) then + allocate(DstLinTypeData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%DerivOrder_x = SrcLinTypeData%DerivOrder_x + end if + DstLinTypeData%SizeLin = SrcLinTypeData%SizeLin + DstLinTypeData%LinStartIndx = SrcLinTypeData%LinStartIndx + DstLinTypeData%NumOutputs = SrcLinTypeData%NumOutputs +end subroutine + +subroutine FAST_DestroyLinType(LinTypeData, ErrStat, ErrMsg) + type(FAST_LinType), intent(inout) :: LinTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyLinType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcElastoDyn_DataData%x,1), UBOUND(SrcElastoDyn_DataData%x,1) - CALL ED_CopyContState( SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%xd,1), UBOUND(SrcElastoDyn_DataData%xd,1) - CALL ED_CopyDiscState( SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%z,1), UBOUND(SrcElastoDyn_DataData%z,1) - CALL ED_CopyConstrState( SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%OtherSt,1), UBOUND(SrcElastoDyn_DataData%OtherSt,1) - CALL ED_CopyOtherState( SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL ED_CopyParam( SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyInput( SrcElastoDyn_DataData%u, DstElastoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyOutput( SrcElastoDyn_DataData%y, DstElastoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyMisc( SrcElastoDyn_DataData%m, DstElastoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcElastoDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%Output,1) - i1_u = UBOUND(SrcElastoDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Output)) THEN - ALLOCATE(DstElastoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcElastoDyn_DataData%Output,1), UBOUND(SrcElastoDyn_DataData%Output,1) - CALL ED_CopyOutput( SrcElastoDyn_DataData%Output(i1), DstElastoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL ED_CopyOutput( SrcElastoDyn_DataData%y_interp, DstElastoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcElastoDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%Input,1) - i1_u = UBOUND(SrcElastoDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Input)) THEN - ALLOCATE(DstElastoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcElastoDyn_DataData%Input,1), UBOUND(SrcElastoDyn_DataData%Input,1) - CALL ED_CopyInput( SrcElastoDyn_DataData%Input(i1), DstElastoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcElastoDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcElastoDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%InputTimes)) THEN - ALLOCATE(DstElastoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyElastoDyn_Data - - SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg ) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ElastoDyn_DataData - 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 = 'FAST_DestroyElastoDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(ElastoDyn_DataData%x,1), UBOUND(ElastoDyn_DataData%x,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL ED_DestroyParam( ElastoDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyInput( ElastoDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyOutput( ElastoDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ElastoDyn_DataData%Output) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ElastoDyn_DataData%Input) -ENDIF -IF (ALLOCATED(ElastoDyn_DataData%InputTimes)) THEN - DEALLOCATE(ElastoDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyElastoDyn_Data - - SUBROUTINE FAST_PackElastoDyn_Data( 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(ElastoDyn_Data), 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 = 'FAST_PackElastoDyn_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL ED_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL ED_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL ED_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL ED_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackElastoDyn_Data - - SUBROUTINE FAST_UnPackElastoDyn_Data( 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(ElastoDyn_Data), 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 = 'FAST_UnPackElastoDyn_Data' - ! 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 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 ED_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 ED_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 ED_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 ED_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 ED_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 ED_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output 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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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 ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackElastoDyn_Data - - SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrcServoDyn_DataData - TYPE(ServoDyn_Data), INTENT(INOUT) :: DstServoDyn_DataData - 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 = 'FAST_CopyServoDyn_Data' -! + ErrMsg = '' + if (allocated(LinTypeData%Names_u)) then + deallocate(LinTypeData%Names_u) + end if + if (allocated(LinTypeData%Names_y)) then + deallocate(LinTypeData%Names_y) + end if + if (allocated(LinTypeData%Names_x)) then + deallocate(LinTypeData%Names_x) + end if + if (allocated(LinTypeData%Names_xd)) then + deallocate(LinTypeData%Names_xd) + end if + if (allocated(LinTypeData%Names_z)) then + deallocate(LinTypeData%Names_z) + end if + if (allocated(LinTypeData%op_u)) then + deallocate(LinTypeData%op_u) + end if + if (allocated(LinTypeData%op_y)) then + deallocate(LinTypeData%op_y) + end if + if (allocated(LinTypeData%op_x)) then + deallocate(LinTypeData%op_x) + end if + if (allocated(LinTypeData%op_dx)) then + deallocate(LinTypeData%op_dx) + end if + if (allocated(LinTypeData%op_xd)) then + deallocate(LinTypeData%op_xd) + end if + if (allocated(LinTypeData%op_z)) then + deallocate(LinTypeData%op_z) + end if + if (allocated(LinTypeData%op_x_eig_mag)) then + deallocate(LinTypeData%op_x_eig_mag) + end if + if (allocated(LinTypeData%op_x_eig_phase)) then + deallocate(LinTypeData%op_x_eig_phase) + end if + if (allocated(LinTypeData%Use_u)) then + deallocate(LinTypeData%Use_u) + end if + if (allocated(LinTypeData%Use_y)) then + deallocate(LinTypeData%Use_y) + end if + if (allocated(LinTypeData%A)) then + deallocate(LinTypeData%A) + end if + if (allocated(LinTypeData%B)) then + deallocate(LinTypeData%B) + end if + if (allocated(LinTypeData%C)) then + deallocate(LinTypeData%C) + end if + if (allocated(LinTypeData%D)) then + deallocate(LinTypeData%D) + end if + if (allocated(LinTypeData%StateRotation)) then + deallocate(LinTypeData%StateRotation) + end if + if (allocated(LinTypeData%StateRel_x)) then + deallocate(LinTypeData%StateRel_x) + end if + if (allocated(LinTypeData%StateRel_xdot)) then + deallocate(LinTypeData%StateRel_xdot) + end if + if (allocated(LinTypeData%IsLoad_u)) then + deallocate(LinTypeData%IsLoad_u) + end if + if (allocated(LinTypeData%RotFrame_u)) then + deallocate(LinTypeData%RotFrame_u) + end if + if (allocated(LinTypeData%RotFrame_y)) then + deallocate(LinTypeData%RotFrame_y) + end if + if (allocated(LinTypeData%RotFrame_x)) then + deallocate(LinTypeData%RotFrame_x) + end if + if (allocated(LinTypeData%RotFrame_z)) then + deallocate(LinTypeData%RotFrame_z) + end if + if (allocated(LinTypeData%DerivOrder_x)) then + deallocate(LinTypeData%DerivOrder_x) + end if +end subroutine + +subroutine FAST_PackLinType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackLinType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Names_u)) + if (allocated(InData%Names_u)) then + call RegPackBounds(Buf, 1, lbound(InData%Names_u), ubound(InData%Names_u)) + call RegPack(Buf, InData%Names_u) + end if + call RegPack(Buf, allocated(InData%Names_y)) + if (allocated(InData%Names_y)) then + call RegPackBounds(Buf, 1, lbound(InData%Names_y), ubound(InData%Names_y)) + call RegPack(Buf, InData%Names_y) + end if + call RegPack(Buf, allocated(InData%Names_x)) + if (allocated(InData%Names_x)) then + call RegPackBounds(Buf, 1, lbound(InData%Names_x), ubound(InData%Names_x)) + call RegPack(Buf, InData%Names_x) + end if + call RegPack(Buf, allocated(InData%Names_xd)) + if (allocated(InData%Names_xd)) then + call RegPackBounds(Buf, 1, lbound(InData%Names_xd), ubound(InData%Names_xd)) + call RegPack(Buf, InData%Names_xd) + end if + call RegPack(Buf, allocated(InData%Names_z)) + if (allocated(InData%Names_z)) then + call RegPackBounds(Buf, 1, lbound(InData%Names_z), ubound(InData%Names_z)) + call RegPack(Buf, InData%Names_z) + end if + call RegPack(Buf, allocated(InData%op_u)) + if (allocated(InData%op_u)) then + call RegPackBounds(Buf, 1, lbound(InData%op_u), ubound(InData%op_u)) + call RegPack(Buf, InData%op_u) + end if + call RegPack(Buf, allocated(InData%op_y)) + if (allocated(InData%op_y)) then + call RegPackBounds(Buf, 1, lbound(InData%op_y), ubound(InData%op_y)) + call RegPack(Buf, InData%op_y) + end if + call RegPack(Buf, allocated(InData%op_x)) + if (allocated(InData%op_x)) then + call RegPackBounds(Buf, 1, lbound(InData%op_x), ubound(InData%op_x)) + call RegPack(Buf, InData%op_x) + end if + call RegPack(Buf, allocated(InData%op_dx)) + if (allocated(InData%op_dx)) then + call RegPackBounds(Buf, 1, lbound(InData%op_dx), ubound(InData%op_dx)) + call RegPack(Buf, InData%op_dx) + end if + call RegPack(Buf, allocated(InData%op_xd)) + if (allocated(InData%op_xd)) then + call RegPackBounds(Buf, 1, lbound(InData%op_xd), ubound(InData%op_xd)) + call RegPack(Buf, InData%op_xd) + end if + call RegPack(Buf, allocated(InData%op_z)) + if (allocated(InData%op_z)) then + call RegPackBounds(Buf, 1, lbound(InData%op_z), ubound(InData%op_z)) + call RegPack(Buf, InData%op_z) + end if + call RegPack(Buf, allocated(InData%op_x_eig_mag)) + if (allocated(InData%op_x_eig_mag)) then + call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_mag), ubound(InData%op_x_eig_mag)) + call RegPack(Buf, InData%op_x_eig_mag) + end if + call RegPack(Buf, allocated(InData%op_x_eig_phase)) + if (allocated(InData%op_x_eig_phase)) then + call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_phase), ubound(InData%op_x_eig_phase)) + call RegPack(Buf, InData%op_x_eig_phase) + end if + call RegPack(Buf, allocated(InData%Use_u)) + if (allocated(InData%Use_u)) then + call RegPackBounds(Buf, 1, lbound(InData%Use_u), ubound(InData%Use_u)) + call RegPack(Buf, InData%Use_u) + end if + call RegPack(Buf, allocated(InData%Use_y)) + if (allocated(InData%Use_y)) then + call RegPackBounds(Buf, 1, lbound(InData%Use_y), ubound(InData%Use_y)) + call RegPack(Buf, InData%Use_y) + end if + call RegPack(Buf, allocated(InData%A)) + if (allocated(InData%A)) then + call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) + call RegPack(Buf, InData%A) + end if + call RegPack(Buf, allocated(InData%B)) + if (allocated(InData%B)) then + call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) + call RegPack(Buf, InData%B) + end if + call RegPack(Buf, allocated(InData%C)) + if (allocated(InData%C)) then + call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) + call RegPack(Buf, InData%C) + end if + call RegPack(Buf, allocated(InData%D)) + if (allocated(InData%D)) then + call RegPackBounds(Buf, 2, lbound(InData%D), ubound(InData%D)) + call RegPack(Buf, InData%D) + end if + call RegPack(Buf, allocated(InData%StateRotation)) + if (allocated(InData%StateRotation)) then + call RegPackBounds(Buf, 2, lbound(InData%StateRotation), ubound(InData%StateRotation)) + call RegPack(Buf, InData%StateRotation) + end if + call RegPack(Buf, allocated(InData%StateRel_x)) + if (allocated(InData%StateRel_x)) then + call RegPackBounds(Buf, 2, lbound(InData%StateRel_x), ubound(InData%StateRel_x)) + call RegPack(Buf, InData%StateRel_x) + end if + call RegPack(Buf, allocated(InData%StateRel_xdot)) + if (allocated(InData%StateRel_xdot)) then + call RegPackBounds(Buf, 2, lbound(InData%StateRel_xdot), ubound(InData%StateRel_xdot)) + call RegPack(Buf, InData%StateRel_xdot) + end if + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + call RegPack(Buf, allocated(InData%RotFrame_z)) + if (allocated(InData%RotFrame_z)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_z), ubound(InData%RotFrame_z)) + call RegPack(Buf, InData%RotFrame_z) + end if + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + call RegPack(Buf, InData%SizeLin) + call RegPack(Buf, InData%LinStartIndx) + call RegPack(Buf, InData%NumOutputs) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackLinType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackLinType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Names_u)) deallocate(OutData%Names_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Names_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Names_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Names_y)) deallocate(OutData%Names_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Names_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Names_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Names_x)) deallocate(OutData%Names_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Names_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Names_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Names_xd)) deallocate(OutData%Names_xd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Names_xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Names_xd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Names_z)) deallocate(OutData%Names_z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Names_z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Names_z) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%op_u)) deallocate(OutData%op_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%op_y)) deallocate(OutData%op_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%op_x)) deallocate(OutData%op_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%op_dx)) deallocate(OutData%op_dx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_dx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_dx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%op_xd)) deallocate(OutData%op_xd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_xd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%op_z)) deallocate(OutData%op_z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_z) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%op_x_eig_mag)) deallocate(OutData%op_x_eig_mag) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_x_eig_mag(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_mag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_x_eig_mag) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%op_x_eig_phase)) deallocate(OutData%op_x_eig_phase) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_x_eig_phase(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_phase.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_x_eig_phase) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Use_u)) deallocate(OutData%Use_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Use_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Use_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Use_y)) deallocate(OutData%Use_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Use_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Use_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%A)) deallocate(OutData%A) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%A(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%A) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%B)) deallocate(OutData%B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%B) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%C)) deallocate(OutData%C) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%D)) deallocate(OutData%D) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StateRotation)) deallocate(OutData%StateRotation) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StateRotation(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRotation.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StateRotation) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StateRel_x)) deallocate(OutData%StateRel_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StateRel_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StateRel_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StateRel_xdot)) deallocate(OutData%StateRel_xdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StateRel_xdot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_xdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StateRel_xdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_z)) deallocate(OutData%RotFrame_z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_z) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%SizeLin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinStartIndx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOutputs) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_ModLinType), intent(in) :: SrcModLinTypeData + type(FAST_ModLinType), intent(inout) :: DstModLinTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyModLinType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcServoDyn_DataData%x,1), UBOUND(SrcServoDyn_DataData%x,1) - CALL SrvD_CopyContState( SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%xd,1), UBOUND(SrcServoDyn_DataData%xd,1) - CALL SrvD_CopyDiscState( SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%z,1), UBOUND(SrcServoDyn_DataData%z,1) - CALL SrvD_CopyConstrState( SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%OtherSt,1), UBOUND(SrcServoDyn_DataData%OtherSt,1) - CALL SrvD_CopyOtherState( SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL SrvD_CopyParam( SrcServoDyn_DataData%p, DstServoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyInput( SrcServoDyn_DataData%u, DstServoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyOutput( SrcServoDyn_DataData%y, DstServoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyMisc( SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcServoDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%Output,1) - i1_u = UBOUND(SrcServoDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%Output)) THEN - ALLOCATE(DstServoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcServoDyn_DataData%Output,1), UBOUND(SrcServoDyn_DataData%Output,1) - CALL SrvD_CopyOutput( SrcServoDyn_DataData%Output(i1), DstServoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SrvD_CopyOutput( SrcServoDyn_DataData%y_interp, DstServoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcServoDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%Input,1) - i1_u = UBOUND(SrcServoDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%Input)) THEN - ALLOCATE(DstServoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcServoDyn_DataData%Input,1), UBOUND(SrcServoDyn_DataData%Input,1) - CALL SrvD_CopyInput( SrcServoDyn_DataData%Input(i1), DstServoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcServoDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcServoDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%InputTimes)) THEN - ALLOCATE(DstServoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyServoDyn_Data - - SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg ) - TYPE(ServoDyn_Data), INTENT(INOUT) :: ServoDyn_DataData - 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 = 'FAST_DestroyServoDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(ServoDyn_DataData%x,1), UBOUND(ServoDyn_DataData%x,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL SrvD_DestroyParam( ServoDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyInput( ServoDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyOutput( ServoDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ServoDyn_DataData%Output) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ServoDyn_DataData%Input) -ENDIF -IF (ALLOCATED(ServoDyn_DataData%InputTimes)) THEN - DEALLOCATE(ServoDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyServoDyn_Data - - SUBROUTINE FAST_PackServoDyn_Data( 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(ServoDyn_Data), 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 = 'FAST_PackServoDyn_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SrvD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL SrvD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackServoDyn_Data - - SUBROUTINE FAST_UnPackServoDyn_Data( 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(ServoDyn_Data), 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 = 'FAST_UnPackServoDyn_Data' - ! 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 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 SrvD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 SrvD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 SrvD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 SrvD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 SrvD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 SrvD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output 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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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 SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackServoDyn_Data - - SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroDyn14_Data), INTENT(INOUT) :: SrcAeroDyn14_DataData - TYPE(AeroDyn14_Data), INTENT(INOUT) :: DstAeroDyn14_DataData - 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 = 'FAST_CopyAeroDyn14_Data' -! + ErrMsg = '' + if (allocated(SrcModLinTypeData%Instance)) then + LB(1:1) = lbound(SrcModLinTypeData%Instance) + UB(1:1) = ubound(SrcModLinTypeData%Instance) + if (.not. allocated(DstModLinTypeData%Instance)) then + allocate(DstModLinTypeData%Instance(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%Instance.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FAST_CopyLinType(SrcModLinTypeData%Instance(i1), DstModLinTypeData%Instance(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FAST_DestroyModLinType(ModLinTypeData, ErrStat, ErrMsg) + type(FAST_ModLinType), intent(inout) :: ModLinTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyModLinType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcAeroDyn14_DataData%x,1), UBOUND(SrcAeroDyn14_DataData%x,1) - CALL AD14_CopyContState( SrcAeroDyn14_DataData%x(i1), DstAeroDyn14_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%xd,1), UBOUND(SrcAeroDyn14_DataData%xd,1) - CALL AD14_CopyDiscState( SrcAeroDyn14_DataData%xd(i1), DstAeroDyn14_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%z,1), UBOUND(SrcAeroDyn14_DataData%z,1) - CALL AD14_CopyConstrState( SrcAeroDyn14_DataData%z(i1), DstAeroDyn14_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%OtherSt,1), UBOUND(SrcAeroDyn14_DataData%OtherSt,1) - CALL AD14_CopyOtherState( SrcAeroDyn14_DataData%OtherSt(i1), DstAeroDyn14_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AD14_CopyParam( SrcAeroDyn14_DataData%p, DstAeroDyn14_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyInput( SrcAeroDyn14_DataData%u, DstAeroDyn14_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyOutput( SrcAeroDyn14_DataData%y, DstAeroDyn14_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyMisc( SrcAeroDyn14_DataData%m, DstAeroDyn14_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn14_DataData%Input)) THEN - i1_l = LBOUND(SrcAeroDyn14_DataData%Input,1) - i1_u = UBOUND(SrcAeroDyn14_DataData%Input,1) - IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%Input)) THEN - ALLOCATE(DstAeroDyn14_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn14_DataData%Input,1), UBOUND(SrcAeroDyn14_DataData%Input,1) - CALL AD14_CopyInput( SrcAeroDyn14_DataData%Input(i1), DstAeroDyn14_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcAeroDyn14_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcAeroDyn14_DataData%InputTimes,1) - i1_u = UBOUND(SrcAeroDyn14_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%InputTimes)) THEN - ALLOCATE(DstAeroDyn14_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAeroDyn14_DataData%InputTimes = SrcAeroDyn14_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyAeroDyn14_Data - - SUBROUTINE FAST_DestroyAeroDyn14_Data( AeroDyn14_DataData, ErrStat, ErrMsg ) - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AeroDyn14_DataData - 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 = 'FAST_DestroyAeroDyn14_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(AeroDyn14_DataData%x,1), UBOUND(AeroDyn14_DataData%x,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL AD14_DestroyParam( AeroDyn14_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInput( AeroDyn14_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyOutput( AeroDyn14_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(AeroDyn14_DataData%Input) -ENDIF -IF (ALLOCATED(AeroDyn14_DataData%InputTimes)) THEN - DEALLOCATE(AeroDyn14_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyAeroDyn14_Data - - SUBROUTINE FAST_PackAeroDyn14_Data( 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(AeroDyn14_Data), 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 = 'FAST_PackAeroDyn14_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL AD14_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL AD14_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL AD14_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL AD14_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL AD14_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL AD14_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL AD14_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL AD14_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL AD14_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL AD14_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL AD14_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL AD14_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL AD14_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL AD14_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackAeroDyn14_Data - - SUBROUTINE FAST_UnPackAeroDyn14_Data( 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(AeroDyn14_Data), 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 = 'FAST_UnPackAeroDyn14_Data' - ! 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 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 AD14_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 AD14_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 AD14_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 AD14_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 AD14_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 AD14_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 AD14_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackAeroDyn14_Data - - SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroDyn_Data), INTENT(INOUT) :: SrcAeroDyn_DataData - TYPE(AeroDyn_Data), INTENT(INOUT) :: DstAeroDyn_DataData - 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 = 'FAST_CopyAeroDyn_Data' -! + ErrMsg = '' + if (allocated(ModLinTypeData%Instance)) then + LB(1:1) = lbound(ModLinTypeData%Instance) + UB(1:1) = ubound(ModLinTypeData%Instance) + do i1 = LB(1), UB(1) + call FAST_DestroyLinType(ModLinTypeData%Instance(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModLinTypeData%Instance) + end if +end subroutine + +subroutine FAST_PackModLinType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ModLinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackModLinType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Instance)) + if (allocated(InData%Instance)) then + call RegPackBounds(Buf, 1, lbound(InData%Instance), ubound(InData%Instance)) + LB(1:1) = lbound(InData%Instance) + UB(1:1) = ubound(InData%Instance) + do i1 = LB(1), UB(1) + call FAST_PackLinType(Buf, InData%Instance(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackModLinType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ModLinType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackModLinType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Instance)) deallocate(OutData%Instance) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Instance(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Instance.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FAST_UnpackLinType(Buf, OutData%Instance(i1)) ! Instance + end do + end if +end subroutine + +subroutine FAST_CopyLinFileType(SrcLinFileTypeData, DstLinFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_LinFileType), intent(in) :: SrcLinFileTypeData + type(FAST_LinFileType), intent(inout) :: DstLinFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyLinFileType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcAeroDyn_DataData%x,1), UBOUND(SrcAeroDyn_DataData%x,1) - CALL AD_CopyContState( SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%xd,1), UBOUND(SrcAeroDyn_DataData%xd,1) - CALL AD_CopyDiscState( SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%z,1), UBOUND(SrcAeroDyn_DataData%z,1) - CALL AD_CopyConstrState( SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%OtherSt,1), UBOUND(SrcAeroDyn_DataData%OtherSt,1) - CALL AD_CopyOtherState( SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AD_CopyParam( SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyInput( SrcAeroDyn_DataData%u, DstAeroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyOutput( SrcAeroDyn_DataData%y, DstAeroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyMisc( SrcAeroDyn_DataData%m, DstAeroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%Output,1) - i1_u = UBOUND(SrcAeroDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Output)) THEN - ALLOCATE(DstAeroDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn_DataData%Output,1), UBOUND(SrcAeroDyn_DataData%Output,1) - CALL AD_CopyOutput( SrcAeroDyn_DataData%Output(i1), DstAeroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL AD_CopyOutput( SrcAeroDyn_DataData%y_interp, DstAeroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%Input,1) - i1_u = UBOUND(SrcAeroDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Input)) THEN - ALLOCATE(DstAeroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn_DataData%Input,1), UBOUND(SrcAeroDyn_DataData%Input,1) - CALL AD_CopyInput( SrcAeroDyn_DataData%Input(i1), DstAeroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcAeroDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcAeroDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%InputTimes)) THEN - ALLOCATE(DstAeroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyAeroDyn_Data - - SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg ) - TYPE(AeroDyn_Data), INTENT(INOUT) :: AeroDyn_DataData - 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 = 'FAST_DestroyAeroDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(AeroDyn_DataData%x,1), UBOUND(AeroDyn_DataData%x,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL AD_DestroyParam( AeroDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyInput( AeroDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyOutput( AeroDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(AeroDyn_DataData%Output) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(AeroDyn_DataData%Input) -ENDIF -IF (ALLOCATED(AeroDyn_DataData%InputTimes)) THEN - DEALLOCATE(AeroDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyAeroDyn_Data - - SUBROUTINE FAST_PackAeroDyn_Data( 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(AeroDyn_Data), 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 = 'FAST_PackAeroDyn_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackAeroDyn_Data - - SUBROUTINE FAST_UnPackAeroDyn_Data( 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(AeroDyn_Data), 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 = 'FAST_UnPackAeroDyn_Data' - ! 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 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 AD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 AD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output 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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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 AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackAeroDyn_Data - - SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_Data), INTENT(IN) :: SrcInflowWind_DataData - TYPE(InflowWind_Data), INTENT(INOUT) :: DstInflowWind_DataData - 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 = 'FAST_CopyInflowWind_Data' -! + ErrMsg = '' + LB(1:1) = lbound(SrcLinFileTypeData%Modules) + UB(1:1) = ubound(SrcLinFileTypeData%Modules) + do i1 = LB(1), UB(1) + call FAST_CopyModLinType(SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call FAST_CopyLinType(SrcLinFileTypeData%Glue, DstLinFileTypeData%Glue, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstLinFileTypeData%RotSpeed = SrcLinFileTypeData%RotSpeed + DstLinFileTypeData%Azimuth = SrcLinFileTypeData%Azimuth + DstLinFileTypeData%WindSpeed = SrcLinFileTypeData%WindSpeed +end subroutine + +subroutine FAST_DestroyLinFileType(LinFileTypeData, ErrStat, ErrMsg) + type(FAST_LinFileType), intent(inout) :: LinFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyLinFileType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcInflowWind_DataData%x,1), UBOUND(SrcInflowWind_DataData%x,1) - CALL InflowWind_CopyContState( SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%xd,1), UBOUND(SrcInflowWind_DataData%xd,1) - CALL InflowWind_CopyDiscState( SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%z,1), UBOUND(SrcInflowWind_DataData%z,1) - CALL InflowWind_CopyConstrState( SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%OtherSt,1), UBOUND(SrcInflowWind_DataData%OtherSt,1) - CALL InflowWind_CopyOtherState( SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL InflowWind_CopyParam( SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyMisc( SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInflowWind_DataData%Output)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%Output,1) - i1_u = UBOUND(SrcInflowWind_DataData%Output,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%Output)) THEN - ALLOCATE(DstInflowWind_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInflowWind_DataData%Output,1), UBOUND(SrcInflowWind_DataData%Output,1) - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%Output(i1), DstInflowWind_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y_interp, DstInflowWind_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInflowWind_DataData%Input)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%Input,1) - i1_u = UBOUND(SrcInflowWind_DataData%Input,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%Input)) THEN - ALLOCATE(DstInflowWind_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInflowWind_DataData%Input,1), UBOUND(SrcInflowWind_DataData%Input,1) - CALL InflowWind_CopyInput( SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInflowWind_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%InputTimes,1) - i1_u = UBOUND(SrcInflowWind_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%InputTimes)) THEN - ALLOCATE(DstInflowWind_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyInflowWind_Data - - SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg ) - TYPE(InflowWind_Data), INTENT(INOUT) :: InflowWind_DataData - 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 = 'FAST_DestroyInflowWind_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(InflowWind_DataData%x,1), UBOUND(InflowWind_DataData%x,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL InflowWind_DestroyParam( InflowWind_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( InflowWind_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InflowWind_DataData%Output) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InflowWind_DataData%Input) -ENDIF -IF (ALLOCATED(InflowWind_DataData%InputTimes)) THEN - DEALLOCATE(InflowWind_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyInflowWind_Data - - SUBROUTINE FAST_PackInflowWind_Data( 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(InflowWind_Data), 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 = 'FAST_PackInflowWind_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackInflowWind_Data - - SUBROUTINE FAST_UnPackInflowWind_Data( 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(InflowWind_Data), 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 = 'FAST_UnPackInflowWind_Data' - ! 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 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output 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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackInflowWind_Data - - SUBROUTINE FAST_CopyOpenFOAM_Data( SrcOpenFOAM_DataData, DstOpenFOAM_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: SrcOpenFOAM_DataData - TYPE(OpenFOAM_Data), INTENT(INOUT) :: DstOpenFOAM_DataData - 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 = 'FAST_CopyOpenFOAM_Data' -! + ErrMsg = '' + LB(1:1) = lbound(LinFileTypeData%Modules) + UB(1:1) = ubound(LinFileTypeData%Modules) + do i1 = LB(1), UB(1) + call FAST_DestroyModLinType(LinFileTypeData%Modules(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call FAST_DestroyLinType(LinFileTypeData%Glue, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackLinFileType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackLinFileType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%Modules) + UB(1:1) = ubound(InData%Modules) + do i1 = LB(1), UB(1) + call FAST_PackModLinType(Buf, InData%Modules(i1)) + end do + call FAST_PackLinType(Buf, InData%Glue) + call RegPack(Buf, InData%RotSpeed) + call RegPack(Buf, InData%Azimuth) + call RegPack(Buf, InData%WindSpeed) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackLinFileType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackLinFileType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%Modules) + UB(1:1) = ubound(OutData%Modules) + do i1 = LB(1), UB(1) + call FAST_UnpackModLinType(Buf, OutData%Modules(i1)) ! Modules + end do + call FAST_UnpackLinType(Buf, OutData%Glue) ! Glue + call RegUnpack(Buf, OutData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Azimuth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WindSpeed) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_MiscLinType), intent(in) :: SrcMiscLinTypeData + type(FAST_MiscLinType), intent(inout) :: DstMiscLinTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyMiscLinType' ErrStat = ErrID_None - ErrMsg = "" - CALL OpFM_CopyInput( SrcOpenFOAM_DataData%u, DstOpenFOAM_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyOutput( SrcOpenFOAM_DataData%y, DstOpenFOAM_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyParam( SrcOpenFOAM_DataData%p, DstOpenFOAM_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyMisc( SrcOpenFOAM_DataData%m, DstOpenFOAM_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyOpenFOAM_Data - - SUBROUTINE FAST_DestroyOpenFOAM_Data( OpenFOAM_DataData, ErrStat, ErrMsg ) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpenFOAM_DataData - 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 = 'FAST_DestroyOpenFOAM_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL OpFM_DestroyInput( OpenFOAM_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyOutput( OpenFOAM_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyParam( OpenFOAM_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyMisc( OpenFOAM_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyOpenFOAM_Data - - SUBROUTINE FAST_PackOpenFOAM_Data( 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(OpenFOAM_Data), 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 = 'FAST_PackOpenFOAM_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL OpFM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL OpFM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL OpFM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL OpFM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! 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 - 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 - - CALL OpFM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL OpFM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL OpFM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL OpFM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 FAST_PackOpenFOAM_Data - - SUBROUTINE FAST_UnPackOpenFOAM_Data( 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(OpenFOAM_Data), 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 = 'FAST_UnPackOpenFOAM_Data' - ! 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 - 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 OpFM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 OpFM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 OpFM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 OpFM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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 FAST_UnPackOpenFOAM_Data - - SUBROUTINE FAST_CopySCDataEx_Data( SrcSCDataEx_DataData, DstSCDataEx_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SCDataEx_Data), INTENT(IN) :: SrcSCDataEx_DataData - TYPE(SCDataEx_Data), INTENT(INOUT) :: DstSCDataEx_DataData - 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 = 'FAST_CopySCDataEx_Data' -! + ErrMsg = '' + if (allocated(SrcMiscLinTypeData%LinTimes)) then + LB(1:1) = lbound(SrcMiscLinTypeData%LinTimes) + UB(1:1) = ubound(SrcMiscLinTypeData%LinTimes) + if (.not. allocated(DstMiscLinTypeData%LinTimes)) then + allocate(DstMiscLinTypeData%LinTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%LinTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%LinTimes = SrcMiscLinTypeData%LinTimes + end if + DstMiscLinTypeData%CopyOP_CtrlCode = SrcMiscLinTypeData%CopyOP_CtrlCode + if (allocated(SrcMiscLinTypeData%AzimTarget)) then + LB(1:1) = lbound(SrcMiscLinTypeData%AzimTarget) + UB(1:1) = ubound(SrcMiscLinTypeData%AzimTarget) + if (.not. allocated(DstMiscLinTypeData%AzimTarget)) then + allocate(DstMiscLinTypeData%AzimTarget(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%AzimTarget.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%AzimTarget = SrcMiscLinTypeData%AzimTarget + end if + DstMiscLinTypeData%IsConverged = SrcMiscLinTypeData%IsConverged + DstMiscLinTypeData%FoundSteady = SrcMiscLinTypeData%FoundSteady + DstMiscLinTypeData%ForceLin = SrcMiscLinTypeData%ForceLin + DstMiscLinTypeData%n_rot = SrcMiscLinTypeData%n_rot + DstMiscLinTypeData%AzimIndx = SrcMiscLinTypeData%AzimIndx + DstMiscLinTypeData%NextLinTimeIndx = SrcMiscLinTypeData%NextLinTimeIndx + if (allocated(SrcMiscLinTypeData%Psi)) then + LB(1:1) = lbound(SrcMiscLinTypeData%Psi) + UB(1:1) = ubound(SrcMiscLinTypeData%Psi) + if (.not. allocated(DstMiscLinTypeData%Psi)) then + allocate(DstMiscLinTypeData%Psi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Psi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%Psi = SrcMiscLinTypeData%Psi + end if + if (allocated(SrcMiscLinTypeData%y_interp)) then + LB(1:1) = lbound(SrcMiscLinTypeData%y_interp) + UB(1:1) = ubound(SrcMiscLinTypeData%y_interp) + if (.not. allocated(DstMiscLinTypeData%y_interp)) then + allocate(DstMiscLinTypeData%y_interp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_interp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%y_interp = SrcMiscLinTypeData%y_interp + end if + if (allocated(SrcMiscLinTypeData%y_ref)) then + LB(1:1) = lbound(SrcMiscLinTypeData%y_ref) + UB(1:1) = ubound(SrcMiscLinTypeData%y_ref) + if (.not. allocated(DstMiscLinTypeData%y_ref)) then + allocate(DstMiscLinTypeData%y_ref(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_ref.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%y_ref = SrcMiscLinTypeData%y_ref + end if + if (allocated(SrcMiscLinTypeData%Y_prevRot)) then + LB(1:2) = lbound(SrcMiscLinTypeData%Y_prevRot) + UB(1:2) = ubound(SrcMiscLinTypeData%Y_prevRot) + if (.not. allocated(DstMiscLinTypeData%Y_prevRot)) then + allocate(DstMiscLinTypeData%Y_prevRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Y_prevRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%Y_prevRot = SrcMiscLinTypeData%Y_prevRot + end if +end subroutine + +subroutine FAST_DestroyMiscLinType(MiscLinTypeData, ErrStat, ErrMsg) + type(FAST_MiscLinType), intent(inout) :: MiscLinTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyMiscLinType' ErrStat = ErrID_None - ErrMsg = "" - CALL SC_DX_CopyInput( SrcSCDataEx_DataData%u, DstSCDataEx_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_DX_CopyOutput( SrcSCDataEx_DataData%y, DstSCDataEx_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_DX_CopyParam( SrcSCDataEx_DataData%p, DstSCDataEx_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopySCDataEx_Data - - SUBROUTINE FAST_DestroySCDataEx_Data( SCDataEx_DataData, ErrStat, ErrMsg ) - TYPE(SCDataEx_Data), INTENT(INOUT) :: SCDataEx_DataData - 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 = 'FAST_DestroySCDataEx_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DX_DestroyParam( SCDataEx_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroySCDataEx_Data - - SUBROUTINE FAST_PackSCDataEx_Data( 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(SCDataEx_Data), 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 = 'FAST_PackSCDataEx_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SC_DX_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SC_DX_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SC_DX_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - 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 - - CALL SC_DX_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL SC_DX_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL SC_DX_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - END SUBROUTINE FAST_PackSCDataEx_Data - - SUBROUTINE FAST_UnPackSCDataEx_Data( 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(SCDataEx_Data), 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 = 'FAST_UnPackSCDataEx_Data' - ! 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 - 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 SC_DX_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 SC_DX_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 SC_DX_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - END SUBROUTINE FAST_UnPackSCDataEx_Data - - SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SubDyn_Data), INTENT(INOUT) :: SrcSubDyn_DataData - TYPE(SubDyn_Data), INTENT(INOUT) :: DstSubDyn_DataData - 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 = 'FAST_CopySubDyn_Data' -! + ErrMsg = '' + if (allocated(MiscLinTypeData%LinTimes)) then + deallocate(MiscLinTypeData%LinTimes) + end if + if (allocated(MiscLinTypeData%AzimTarget)) then + deallocate(MiscLinTypeData%AzimTarget) + end if + if (allocated(MiscLinTypeData%Psi)) then + deallocate(MiscLinTypeData%Psi) + end if + if (allocated(MiscLinTypeData%y_interp)) then + deallocate(MiscLinTypeData%y_interp) + end if + if (allocated(MiscLinTypeData%y_ref)) then + deallocate(MiscLinTypeData%y_ref) + end if + if (allocated(MiscLinTypeData%Y_prevRot)) then + deallocate(MiscLinTypeData%Y_prevRot) + end if +end subroutine + +subroutine FAST_PackMiscLinType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_MiscLinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackMiscLinType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%LinTimes)) + if (allocated(InData%LinTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%LinTimes), ubound(InData%LinTimes)) + call RegPack(Buf, InData%LinTimes) + end if + call RegPack(Buf, InData%CopyOP_CtrlCode) + call RegPack(Buf, allocated(InData%AzimTarget)) + if (allocated(InData%AzimTarget)) then + call RegPackBounds(Buf, 1, lbound(InData%AzimTarget), ubound(InData%AzimTarget)) + call RegPack(Buf, InData%AzimTarget) + end if + call RegPack(Buf, InData%IsConverged) + call RegPack(Buf, InData%FoundSteady) + call RegPack(Buf, InData%ForceLin) + call RegPack(Buf, InData%n_rot) + call RegPack(Buf, InData%AzimIndx) + call RegPack(Buf, InData%NextLinTimeIndx) + call RegPack(Buf, allocated(InData%Psi)) + if (allocated(InData%Psi)) then + call RegPackBounds(Buf, 1, lbound(InData%Psi), ubound(InData%Psi)) + call RegPack(Buf, InData%Psi) + end if + call RegPack(Buf, allocated(InData%y_interp)) + if (allocated(InData%y_interp)) then + call RegPackBounds(Buf, 1, lbound(InData%y_interp), ubound(InData%y_interp)) + call RegPack(Buf, InData%y_interp) + end if + call RegPack(Buf, allocated(InData%y_ref)) + if (allocated(InData%y_ref)) then + call RegPackBounds(Buf, 1, lbound(InData%y_ref), ubound(InData%y_ref)) + call RegPack(Buf, InData%y_ref) + end if + call RegPack(Buf, allocated(InData%Y_prevRot)) + if (allocated(InData%Y_prevRot)) then + call RegPackBounds(Buf, 2, lbound(InData%Y_prevRot), ubound(InData%Y_prevRot)) + call RegPack(Buf, InData%Y_prevRot) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackMiscLinType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_MiscLinType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackMiscLinType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%LinTimes)) deallocate(OutData%LinTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%CopyOP_CtrlCode) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AzimTarget)) deallocate(OutData%AzimTarget) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AzimTarget(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimTarget.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AzimTarget) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%IsConverged) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FoundSteady) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ForceLin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_rot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AzimIndx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NextLinTimeIndx) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Psi)) deallocate(OutData%Psi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Psi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Psi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%y_interp)) deallocate(OutData%y_interp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_interp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%y_interp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%y_ref)) deallocate(OutData%y_ref) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_ref(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_ref.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%y_ref) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Y_prevRot)) deallocate(OutData%Y_prevRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y_prevRot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_prevRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y_prevRot) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_OutputFileType), intent(inout) :: SrcOutputFileTypeData + type(FAST_OutputFileType), intent(inout) :: DstOutputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyOutputFileType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcSubDyn_DataData%x,1), UBOUND(SrcSubDyn_DataData%x,1) - CALL SD_CopyContState( SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%xd,1), UBOUND(SrcSubDyn_DataData%xd,1) - CALL SD_CopyDiscState( SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%z,1), UBOUND(SrcSubDyn_DataData%z,1) - CALL SD_CopyConstrState( SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%OtherSt,1), UBOUND(SrcSubDyn_DataData%OtherSt,1) - CALL SD_CopyOtherState( SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL SD_CopyParam( SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyInput( SrcSubDyn_DataData%u, DstSubDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyOutput( SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyMisc( SrcSubDyn_DataData%m, DstSubDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSubDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%Input,1) - i1_u = UBOUND(SrcSubDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%Input)) THEN - ALLOCATE(DstSubDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcSubDyn_DataData%Input,1), UBOUND(SrcSubDyn_DataData%Input,1) - CALL SD_CopyInput( SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcSubDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%Output,1) - i1_u = UBOUND(SrcSubDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%Output)) THEN - ALLOCATE(DstSubDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcSubDyn_DataData%Output,1), UBOUND(SrcSubDyn_DataData%Output,1) - CALL SD_CopyOutput( SrcSubDyn_DataData%Output(i1), DstSubDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SD_CopyOutput( SrcSubDyn_DataData%y_interp, DstSubDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSubDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcSubDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%InputTimes)) THEN - ALLOCATE(DstSubDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopySubDyn_Data - - SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg ) - TYPE(SubDyn_Data), INTENT(INOUT) :: SubDyn_DataData - 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 = 'FAST_DestroySubDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(SubDyn_DataData%x,1), UBOUND(SubDyn_DataData%x,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL SD_DestroyParam( SubDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyInput( SubDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyOutput( SubDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(SubDyn_DataData%Output) -ENDIF - 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) -ENDIF - END SUBROUTINE FAST_DestroySubDyn_Data - - SUBROUTINE FAST_PackSubDyn_Data( 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(SubDyn_Data), 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 = 'FAST_PackSubDyn_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 - IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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 - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackSubDyn_Data - - SUBROUTINE FAST_UnPackSubDyn_Data( 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(SubDyn_Data), 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 = 'FAST_UnPackSubDyn_Data' - ! 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 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 SD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 SD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 SD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 SD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 SD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! Output 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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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 SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackSubDyn_Data - - SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_Data), INTENT(INOUT) :: SrcExtPtfm_DataData - TYPE(ExtPtfm_Data), INTENT(INOUT) :: DstExtPtfm_DataData - 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 = 'FAST_CopyExtPtfm_Data' -! + ErrMsg = '' + if (allocated(SrcOutputFileTypeData%TimeData)) then + LB(1:1) = lbound(SrcOutputFileTypeData%TimeData) + UB(1:1) = ubound(SrcOutputFileTypeData%TimeData) + if (.not. allocated(DstOutputFileTypeData%TimeData)) then + allocate(DstOutputFileTypeData%TimeData(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%TimeData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData + end if + if (allocated(SrcOutputFileTypeData%AllOutData)) then + LB(1:2) = lbound(SrcOutputFileTypeData%AllOutData) + UB(1:2) = ubound(SrcOutputFileTypeData%AllOutData) + if (.not. allocated(DstOutputFileTypeData%AllOutData)) then + allocate(DstOutputFileTypeData%AllOutData(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%AllOutData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputFileTypeData%AllOutData = SrcOutputFileTypeData%AllOutData + end if + DstOutputFileTypeData%n_Out = SrcOutputFileTypeData%n_Out + DstOutputFileTypeData%NOutSteps = SrcOutputFileTypeData%NOutSteps + DstOutputFileTypeData%numOuts = SrcOutputFileTypeData%numOuts + DstOutputFileTypeData%UnOu = SrcOutputFileTypeData%UnOu + DstOutputFileTypeData%UnSum = SrcOutputFileTypeData%UnSum + DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra + DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines + if (allocated(SrcOutputFileTypeData%ChannelNames)) then + LB(1:1) = lbound(SrcOutputFileTypeData%ChannelNames) + UB(1:1) = ubound(SrcOutputFileTypeData%ChannelNames) + if (.not. allocated(DstOutputFileTypeData%ChannelNames)) then + allocate(DstOutputFileTypeData%ChannelNames(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelNames.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames + end if + if (allocated(SrcOutputFileTypeData%ChannelUnits)) then + LB(1:1) = lbound(SrcOutputFileTypeData%ChannelUnits) + UB(1:1) = ubound(SrcOutputFileTypeData%ChannelUnits) + if (.not. allocated(DstOutputFileTypeData%ChannelUnits)) then + allocate(DstOutputFileTypeData%ChannelUnits(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelUnits.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits + end if + LB(1:1) = lbound(SrcOutputFileTypeData%Module_Ver) + UB(1:1) = ubound(SrcOutputFileTypeData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyProgDesc(SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + DstOutputFileTypeData%Module_Abrev = SrcOutputFileTypeData%Module_Abrev + DstOutputFileTypeData%WriteThisStep = SrcOutputFileTypeData%WriteThisStep + DstOutputFileTypeData%VTK_count = SrcOutputFileTypeData%VTK_count + DstOutputFileTypeData%VTK_LastWaveIndx = SrcOutputFileTypeData%VTK_LastWaveIndx + call FAST_CopyLinFileType(SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstOutputFileTypeData%ActualChanLen = SrcOutputFileTypeData%ActualChanLen + call FAST_CopyLinStateSave(SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput +end subroutine + +subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) + type(FAST_OutputFileType), intent(inout) :: OutputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyOutputFileType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcExtPtfm_DataData%x,1), UBOUND(SrcExtPtfm_DataData%x,1) - CALL ExtPtfm_CopyContState( SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%xd,1), UBOUND(SrcExtPtfm_DataData%xd,1) - CALL ExtPtfm_CopyDiscState( SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%z,1), UBOUND(SrcExtPtfm_DataData%z,1) - CALL ExtPtfm_CopyConstrState( SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%OtherSt,1), UBOUND(SrcExtPtfm_DataData%OtherSt,1) - CALL ExtPtfm_CopyOtherState( SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL ExtPtfm_CopyParam( SrcExtPtfm_DataData%p, DstExtPtfm_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%u, DstExtPtfm_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyOutput( SrcExtPtfm_DataData%y, DstExtPtfm_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyMisc( SrcExtPtfm_DataData%m, DstExtPtfm_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcExtPtfm_DataData%Input)) THEN - i1_l = LBOUND(SrcExtPtfm_DataData%Input,1) - i1_u = UBOUND(SrcExtPtfm_DataData%Input,1) - IF (.NOT. ALLOCATED(DstExtPtfm_DataData%Input)) THEN - ALLOCATE(DstExtPtfm_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcExtPtfm_DataData%Input,1), UBOUND(SrcExtPtfm_DataData%Input,1) - CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%Input(i1), DstExtPtfm_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcExtPtfm_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcExtPtfm_DataData%InputTimes,1) - i1_u = UBOUND(SrcExtPtfm_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstExtPtfm_DataData%InputTimes)) THEN - ALLOCATE(DstExtPtfm_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyExtPtfm_Data - - SUBROUTINE FAST_DestroyExtPtfm_Data( ExtPtfm_DataData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm_DataData - 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 = 'FAST_DestroyExtPtfm_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(ExtPtfm_DataData%x,1), UBOUND(ExtPtfm_DataData%x,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL ExtPtfm_DestroyParam( ExtPtfm_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyOutput( ExtPtfm_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ExtPtfm_DataData%Input) -ENDIF -IF (ALLOCATED(ExtPtfm_DataData%InputTimes)) THEN - DEALLOCATE(ExtPtfm_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyExtPtfm_Data - - SUBROUTINE FAST_PackExtPtfm_Data( 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(ExtPtfm_Data), 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 = 'FAST_PackExtPtfm_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL ExtPtfm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL ExtPtfm_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL ExtPtfm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL ExtPtfm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL ExtPtfm_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL ExtPtfm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackExtPtfm_Data - - SUBROUTINE FAST_UnPackExtPtfm_Data( 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(ExtPtfm_Data), 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 = 'FAST_UnPackExtPtfm_Data' - ! 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 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 ExtPtfm_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 ExtPtfm_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 ExtPtfm_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 ExtPtfm_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 ExtPtfm_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 ExtPtfm_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 ExtPtfm_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackExtPtfm_Data - - SUBROUTINE FAST_CopySeaState_Data( SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaState_Data), INTENT(IN) :: SrcSeaState_DataData - TYPE(SeaState_Data), INTENT(INOUT) :: DstSeaState_DataData - 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 = 'FAST_CopySeaState_Data' -! + ErrMsg = '' + if (allocated(OutputFileTypeData%TimeData)) then + deallocate(OutputFileTypeData%TimeData) + end if + if (allocated(OutputFileTypeData%AllOutData)) then + deallocate(OutputFileTypeData%AllOutData) + end if + if (allocated(OutputFileTypeData%ChannelNames)) then + deallocate(OutputFileTypeData%ChannelNames) + end if + if (allocated(OutputFileTypeData%ChannelUnits)) then + deallocate(OutputFileTypeData%ChannelUnits) + end if + LB(1:1) = lbound(OutputFileTypeData%Module_Ver) + UB(1:1) = ubound(OutputFileTypeData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyProgDesc(OutputFileTypeData%Module_Ver(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call FAST_DestroyLinFileType(OutputFileTypeData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyLinStateSave(OutputFileTypeData%op, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackOutputFileType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_OutputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackOutputFileType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%TimeData)) + if (allocated(InData%TimeData)) then + call RegPackBounds(Buf, 1, lbound(InData%TimeData), ubound(InData%TimeData)) + call RegPack(Buf, InData%TimeData) + end if + call RegPack(Buf, allocated(InData%AllOutData)) + if (allocated(InData%AllOutData)) then + call RegPackBounds(Buf, 2, lbound(InData%AllOutData), ubound(InData%AllOutData)) + call RegPack(Buf, InData%AllOutData) + end if + call RegPack(Buf, InData%n_Out) + call RegPack(Buf, InData%NOutSteps) + call RegPack(Buf, InData%numOuts) + call RegPack(Buf, InData%UnOu) + call RegPack(Buf, InData%UnSum) + call RegPack(Buf, InData%UnGra) + call RegPack(Buf, InData%FileDescLines) + call RegPack(Buf, allocated(InData%ChannelNames)) + if (allocated(InData%ChannelNames)) then + call RegPackBounds(Buf, 1, lbound(InData%ChannelNames), ubound(InData%ChannelNames)) + call RegPack(Buf, InData%ChannelNames) + end if + call RegPack(Buf, allocated(InData%ChannelUnits)) + if (allocated(InData%ChannelUnits)) then + call RegPackBounds(Buf, 1, lbound(InData%ChannelUnits), ubound(InData%ChannelUnits)) + call RegPack(Buf, InData%ChannelUnits) + end if + LB(1:1) = lbound(InData%Module_Ver) + UB(1:1) = ubound(InData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_PackProgDesc(Buf, InData%Module_Ver(i1)) + end do + call RegPack(Buf, InData%Module_Abrev) + call RegPack(Buf, InData%WriteThisStep) + call RegPack(Buf, InData%VTK_count) + call RegPack(Buf, InData%VTK_LastWaveIndx) + call FAST_PackLinFileType(Buf, InData%Lin) + call RegPack(Buf, InData%ActualChanLen) + call FAST_PackLinStateSave(Buf, InData%op) + call RegPack(Buf, InData%DriverWriteOutput) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackOutputFileType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_OutputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackOutputFileType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%TimeData)) deallocate(OutData%TimeData) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TimeData(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TimeData) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AllOutData)) deallocate(OutData%AllOutData) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOutData(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOutData) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%n_Out) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NOutSteps) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%numOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnOu) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnSum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnGra) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FileDescLines) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ChannelNames)) deallocate(OutData%ChannelNames) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ChannelNames(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelNames.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ChannelNames) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ChannelUnits)) deallocate(OutData%ChannelUnits) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ChannelUnits(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelUnits.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ChannelUnits) + if (RegCheckErr(Buf, RoutineName)) return + end if + LB(1:1) = lbound(OutData%Module_Ver) + UB(1:1) = ubound(OutData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackProgDesc(Buf, OutData%Module_Ver(i1)) ! Module_Ver + end do + call RegUnpack(Buf, OutData%Module_Abrev) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WriteThisStep) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTK_count) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTK_LastWaveIndx) + if (RegCheckErr(Buf, RoutineName)) return + call FAST_UnpackLinFileType(Buf, OutData%Lin) ! Lin + call RegUnpack(Buf, OutData%ActualChanLen) + if (RegCheckErr(Buf, RoutineName)) return + call FAST_UnpackLinStateSave(Buf, OutData%op) ! op + call RegUnpack(Buf, OutData%DriverWriteOutput) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(IceDyn_Data), intent(inout) :: SrcIceDyn_DataData + type(IceDyn_Data), intent(inout) :: DstIceDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyIceDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcSeaState_DataData%x,1), UBOUND(SrcSeaState_DataData%x,1) - CALL SeaSt_CopyContState( SrcSeaState_DataData%x(i1), DstSeaState_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSeaState_DataData%xd,1), UBOUND(SrcSeaState_DataData%xd,1) - CALL SeaSt_CopyDiscState( SrcSeaState_DataData%xd(i1), DstSeaState_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSeaState_DataData%z,1), UBOUND(SrcSeaState_DataData%z,1) - CALL SeaSt_CopyConstrState( SrcSeaState_DataData%z(i1), DstSeaState_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSeaState_DataData%OtherSt,1), UBOUND(SrcSeaState_DataData%OtherSt,1) - CALL SeaSt_CopyOtherState( SrcSeaState_DataData%OtherSt(i1), DstSeaState_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL SeaSt_CopyParam( SrcSeaState_DataData%p, DstSeaState_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SeaSt_CopyInput( SrcSeaState_DataData%u, DstSeaState_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SeaSt_CopyOutput( SrcSeaState_DataData%y, DstSeaState_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SeaSt_CopyMisc( SrcSeaState_DataData%m, DstSeaState_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSeaState_DataData%Input)) THEN - i1_l = LBOUND(SrcSeaState_DataData%Input,1) - i1_u = UBOUND(SrcSeaState_DataData%Input,1) - IF (.NOT. ALLOCATED(DstSeaState_DataData%Input)) THEN - ALLOCATE(DstSeaState_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcSeaState_DataData%Input,1), UBOUND(SrcSeaState_DataData%Input,1) - CALL SeaSt_CopyInput( SrcSeaState_DataData%Input(i1), DstSeaState_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcSeaState_DataData%Output)) THEN - i1_l = LBOUND(SrcSeaState_DataData%Output,1) - i1_u = UBOUND(SrcSeaState_DataData%Output,1) - IF (.NOT. ALLOCATED(DstSeaState_DataData%Output)) THEN - ALLOCATE(DstSeaState_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcSeaState_DataData%Output,1), UBOUND(SrcSeaState_DataData%Output,1) - CALL SeaSt_CopyOutput( SrcSeaState_DataData%Output(i1), DstSeaState_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SeaSt_CopyOutput( SrcSeaState_DataData%y_interp, DstSeaState_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSeaState_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcSeaState_DataData%InputTimes,1) - i1_u = UBOUND(SrcSeaState_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstSeaState_DataData%InputTimes)) THEN - ALLOCATE(DstSeaState_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaState_DataData%InputTimes = SrcSeaState_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopySeaState_Data - - SUBROUTINE FAST_DestroySeaState_Data( SeaState_DataData, ErrStat, ErrMsg ) - TYPE(SeaState_Data), INTENT(INOUT) :: SeaState_DataData - 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 = 'FAST_DestroySeaState_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(SeaState_DataData%x,1), UBOUND(SeaState_DataData%x,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL SeaSt_DestroyParam( SeaState_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyInput( SeaState_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyOutput( SeaState_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(SeaState_DataData%Output) -ENDIF - 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) -ENDIF - END SUBROUTINE FAST_DestroySeaState_Data - - SUBROUTINE FAST_PackSeaState_Data( 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(SeaState_Data), 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 = 'FAST_PackSeaState_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL SeaSt_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SeaSt_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SeaSt_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL SeaSt_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SeaSt_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SeaSt_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SeaSt_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SeaSt_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL SeaSt_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL SeaSt_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL SeaSt_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL SeaSt_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL SeaSt_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL SeaSt_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL SeaSt_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL SeaSt_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL SeaSt_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL SeaSt_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL SeaSt_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL SeaSt_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 - IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL SeaSt_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL SeaSt_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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 - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackSeaState_Data - - SUBROUTINE FAST_UnPackSeaState_Data( 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(SeaState_Data), 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 = 'FAST_UnPackSeaState_Data' - ! 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 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! Output 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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackSeaState_Data - - SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_Data), INTENT(INOUT) :: SrcHydroDyn_DataData - TYPE(HydroDyn_Data), INTENT(INOUT) :: DstHydroDyn_DataData - 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 = 'FAST_CopyHydroDyn_Data' -! + ErrMsg = '' + if (allocated(SrcIceDyn_DataData%x)) then + LB(1:2) = lbound(SrcIceDyn_DataData%x) + UB(1:2) = ubound(SrcIceDyn_DataData%x) + if (.not. allocated(DstIceDyn_DataData%x)) then + allocate(DstIceDyn_DataData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyContState(SrcIceDyn_DataData%x(i1,i2), DstIceDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcIceDyn_DataData%xd)) then + LB(1:2) = lbound(SrcIceDyn_DataData%xd) + UB(1:2) = ubound(SrcIceDyn_DataData%xd) + if (.not. allocated(DstIceDyn_DataData%xd)) then + allocate(DstIceDyn_DataData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyDiscState(SrcIceDyn_DataData%xd(i1,i2), DstIceDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcIceDyn_DataData%z)) then + LB(1:2) = lbound(SrcIceDyn_DataData%z) + UB(1:2) = ubound(SrcIceDyn_DataData%z) + if (.not. allocated(DstIceDyn_DataData%z)) then + allocate(DstIceDyn_DataData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyConstrState(SrcIceDyn_DataData%z(i1,i2), DstIceDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcIceDyn_DataData%OtherSt)) then + LB(1:2) = lbound(SrcIceDyn_DataData%OtherSt) + UB(1:2) = ubound(SrcIceDyn_DataData%OtherSt) + if (.not. allocated(DstIceDyn_DataData%OtherSt)) then + allocate(DstIceDyn_DataData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyOtherState(SrcIceDyn_DataData%OtherSt(i1,i2), DstIceDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcIceDyn_DataData%p)) then + LB(1:1) = lbound(SrcIceDyn_DataData%p) + UB(1:1) = ubound(SrcIceDyn_DataData%p) + if (.not. allocated(DstIceDyn_DataData%p)) then + allocate(DstIceDyn_DataData%p(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%p.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceD_CopyParam(SrcIceDyn_DataData%p(i1), DstIceDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceDyn_DataData%u)) then + LB(1:1) = lbound(SrcIceDyn_DataData%u) + UB(1:1) = ubound(SrcIceDyn_DataData%u) + if (.not. allocated(DstIceDyn_DataData%u)) then + allocate(DstIceDyn_DataData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceD_CopyInput(SrcIceDyn_DataData%u(i1), DstIceDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceDyn_DataData%y)) then + LB(1:1) = lbound(SrcIceDyn_DataData%y) + UB(1:1) = ubound(SrcIceDyn_DataData%y) + if (.not. allocated(DstIceDyn_DataData%y)) then + allocate(DstIceDyn_DataData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceD_CopyOutput(SrcIceDyn_DataData%y(i1), DstIceDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceDyn_DataData%m)) then + LB(1:1) = lbound(SrcIceDyn_DataData%m) + UB(1:1) = ubound(SrcIceDyn_DataData%m) + if (.not. allocated(DstIceDyn_DataData%m)) then + allocate(DstIceDyn_DataData%m(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceD_CopyMisc(SrcIceDyn_DataData%m(i1), DstIceDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceDyn_DataData%Input)) then + LB(1:2) = lbound(SrcIceDyn_DataData%Input) + UB(1:2) = ubound(SrcIceDyn_DataData%Input) + if (.not. allocated(DstIceDyn_DataData%Input)) then + allocate(DstIceDyn_DataData%Input(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyInput(SrcIceDyn_DataData%Input(i1,i2), DstIceDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcIceDyn_DataData%InputTimes)) then + LB(1:2) = lbound(SrcIceDyn_DataData%InputTimes) + UB(1:2) = ubound(SrcIceDyn_DataData%InputTimes) + if (.not. allocated(DstIceDyn_DataData%InputTimes)) then + allocate(DstIceDyn_DataData%InputTimes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) + type(IceDyn_Data), intent(inout) :: IceDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyIceDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcHydroDyn_DataData%x,1), UBOUND(SrcHydroDyn_DataData%x,1) - CALL HydroDyn_CopyContState( SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%xd,1), UBOUND(SrcHydroDyn_DataData%xd,1) - CALL HydroDyn_CopyDiscState( SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%z,1), UBOUND(SrcHydroDyn_DataData%z,1) - CALL HydroDyn_CopyConstrState( SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%OtherSt,1), UBOUND(SrcHydroDyn_DataData%OtherSt,1) - CALL HydroDyn_CopyOtherState( SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL HydroDyn_CopyParam( SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%u, DstHydroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y, DstHydroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyMisc( SrcHydroDyn_DataData%m, DstHydroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcHydroDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%Output,1) - i1_u = UBOUND(SrcHydroDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Output)) THEN - ALLOCATE(DstHydroDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcHydroDyn_DataData%Output,1), UBOUND(SrcHydroDyn_DataData%Output,1) - CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%Output(i1), DstHydroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y_interp, DstHydroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcHydroDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%Input,1) - i1_u = UBOUND(SrcHydroDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Input)) THEN - ALLOCATE(DstHydroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcHydroDyn_DataData%Input,1), UBOUND(SrcHydroDyn_DataData%Input,1) - CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%Input(i1), DstHydroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcHydroDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcHydroDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%InputTimes)) THEN - ALLOCATE(DstHydroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyHydroDyn_Data - - SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg ) - TYPE(HydroDyn_Data), INTENT(INOUT) :: HydroDyn_DataData - 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 = 'FAST_DestroyHydroDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(HydroDyn_DataData%x,1), UBOUND(HydroDyn_DataData%x,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL HydroDyn_DestroyParam( HydroDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyInput( HydroDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(HydroDyn_DataData%Output) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(HydroDyn_DataData%Input) -ENDIF -IF (ALLOCATED(HydroDyn_DataData%InputTimes)) THEN - DEALLOCATE(HydroDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyHydroDyn_Data - - SUBROUTINE FAST_PackHydroDyn_Data( 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(HydroDyn_Data), 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 = 'FAST_PackHydroDyn_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL HydroDyn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL HydroDyn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL HydroDyn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL HydroDyn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackHydroDyn_Data - - SUBROUTINE FAST_UnPackHydroDyn_Data( 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(HydroDyn_Data), 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 = 'FAST_UnPackHydroDyn_Data' - ! 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 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 HydroDyn_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 HydroDyn_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 HydroDyn_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 HydroDyn_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 HydroDyn_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 HydroDyn_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output 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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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 HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackHydroDyn_Data - - SUBROUTINE FAST_CopyIceFloe_Data( SrcIceFloe_DataData, DstIceFloe_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_Data), INTENT(INOUT) :: SrcIceFloe_DataData - TYPE(IceFloe_Data), INTENT(INOUT) :: DstIceFloe_DataData - 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 = 'FAST_CopyIceFloe_Data' -! + ErrMsg = '' + if (allocated(IceDyn_DataData%x)) then + LB(1:2) = lbound(IceDyn_DataData%x) + UB(1:2) = ubound(IceDyn_DataData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyContState(IceDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%x) + end if + if (allocated(IceDyn_DataData%xd)) then + LB(1:2) = lbound(IceDyn_DataData%xd) + UB(1:2) = ubound(IceDyn_DataData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyDiscState(IceDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%xd) + end if + if (allocated(IceDyn_DataData%z)) then + LB(1:2) = lbound(IceDyn_DataData%z) + UB(1:2) = ubound(IceDyn_DataData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyConstrState(IceDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%z) + end if + if (allocated(IceDyn_DataData%OtherSt)) then + LB(1:2) = lbound(IceDyn_DataData%OtherSt) + UB(1:2) = ubound(IceDyn_DataData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyOtherState(IceDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%OtherSt) + end if + if (allocated(IceDyn_DataData%p)) then + LB(1:1) = lbound(IceDyn_DataData%p) + UB(1:1) = ubound(IceDyn_DataData%p) + do i1 = LB(1), UB(1) + call IceD_DestroyParam(IceDyn_DataData%p(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceDyn_DataData%p) + end if + if (allocated(IceDyn_DataData%u)) then + LB(1:1) = lbound(IceDyn_DataData%u) + UB(1:1) = ubound(IceDyn_DataData%u) + do i1 = LB(1), UB(1) + call IceD_DestroyInput(IceDyn_DataData%u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceDyn_DataData%u) + end if + if (allocated(IceDyn_DataData%y)) then + LB(1:1) = lbound(IceDyn_DataData%y) + UB(1:1) = ubound(IceDyn_DataData%y) + do i1 = LB(1), UB(1) + call IceD_DestroyOutput(IceDyn_DataData%y(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceDyn_DataData%y) + end if + if (allocated(IceDyn_DataData%m)) then + LB(1:1) = lbound(IceDyn_DataData%m) + UB(1:1) = ubound(IceDyn_DataData%m) + do i1 = LB(1), UB(1) + call IceD_DestroyMisc(IceDyn_DataData%m(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceDyn_DataData%m) + end if + if (allocated(IceDyn_DataData%Input)) then + LB(1:2) = lbound(IceDyn_DataData%Input) + UB(1:2) = ubound(IceDyn_DataData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyInput(IceDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%Input) + end if + if (allocated(IceDyn_DataData%InputTimes)) then + deallocate(IceDyn_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackIceDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackIceDyn_Data' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(Buf, 2, lbound(InData%x), ubound(InData%x)) + LB(1:2) = lbound(InData%x) + UB(1:2) = ubound(InData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackContState(Buf, InData%x(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(Buf, 2, lbound(InData%xd), ubound(InData%xd)) + LB(1:2) = lbound(InData%xd) + UB(1:2) = ubound(InData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackDiscState(Buf, InData%xd(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(Buf, 2, lbound(InData%z), ubound(InData%z)) + LB(1:2) = lbound(InData%z) + UB(1:2) = ubound(InData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackConstrState(Buf, InData%z(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(Buf, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:2) = lbound(InData%OtherSt) + UB(1:2) = ubound(InData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackOtherState(Buf, InData%OtherSt(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%p)) + if (allocated(InData%p)) then + call RegPackBounds(Buf, 1, lbound(InData%p), ubound(InData%p)) + LB(1:1) = lbound(InData%p) + UB(1:1) = ubound(InData%p) + do i1 = LB(1), UB(1) + call IceD_PackParam(Buf, InData%p(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) + LB(1:1) = lbound(InData%u) + UB(1:1) = ubound(InData%u) + do i1 = LB(1), UB(1) + call IceD_PackInput(Buf, InData%u(i1)) + end do + end if + call RegPack(Buf, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + LB(1:1) = lbound(InData%y) + UB(1:1) = ubound(InData%y) + do i1 = LB(1), UB(1) + call IceD_PackOutput(Buf, InData%y(i1)) + end do + end if + call RegPack(Buf, allocated(InData%m)) + if (allocated(InData%m)) then + call RegPackBounds(Buf, 1, lbound(InData%m), ubound(InData%m)) + LB(1:1) = lbound(InData%m) + UB(1:1) = ubound(InData%m) + do i1 = LB(1), UB(1) + call IceD_PackMisc(Buf, InData%m(i1)) + end do + end if + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 2, lbound(InData%Input), ubound(InData%Input)) + LB(1:2) = lbound(InData%Input) + UB(1:2) = ubound(InData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackInput(Buf, InData%Input(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 2, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackIceDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackIceDyn_Data' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackContState(Buf, OutData%x(i1,i2)) ! x + end do + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackDiscState(Buf, OutData%xd(i1,i2)) ! xd + end do + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackConstrState(Buf, OutData%z(i1,i2)) ! z + end do + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackOtherState(Buf, OutData%OtherSt(i1,i2)) ! OtherSt + end do + end do + end if + if (allocated(OutData%p)) deallocate(OutData%p) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%p(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackParam(Buf, OutData%p(i1)) ! p + end do + end if + if (allocated(OutData%u)) deallocate(OutData%u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackInput(Buf, OutData%u(i1)) ! u + end do + end if + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackOutput(Buf, OutData%y(i1)) ! y + end do + end if + if (allocated(OutData%m)) deallocate(OutData%m) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackMisc(Buf, OutData%m(i1)) ! m + end do + end if + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackInput(Buf, OutData%Input(i1,i2)) ! Input + end do + end do + end if + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(BeamDyn_Data), intent(inout) :: SrcBeamDyn_DataData + type(BeamDyn_Data), intent(inout) :: DstBeamDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyBeamDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcIceFloe_DataData%x,1), UBOUND(SrcIceFloe_DataData%x,1) - CALL IceFloe_CopyContState( SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%xd,1), UBOUND(SrcIceFloe_DataData%xd,1) - CALL IceFloe_CopyDiscState( SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%z,1), UBOUND(SrcIceFloe_DataData%z,1) - CALL IceFloe_CopyConstrState( SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%OtherSt,1), UBOUND(SrcIceFloe_DataData%OtherSt,1) - CALL IceFloe_CopyOtherState( SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL IceFloe_CopyParam( SrcIceFloe_DataData%p, DstIceFloe_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyInput( SrcIceFloe_DataData%u, DstIceFloe_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyOutput( SrcIceFloe_DataData%y, DstIceFloe_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyMisc( SrcIceFloe_DataData%m, DstIceFloe_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcIceFloe_DataData%Input)) THEN - i1_l = LBOUND(SrcIceFloe_DataData%Input,1) - i1_u = UBOUND(SrcIceFloe_DataData%Input,1) - IF (.NOT. ALLOCATED(DstIceFloe_DataData%Input)) THEN - ALLOCATE(DstIceFloe_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceFloe_DataData%Input,1), UBOUND(SrcIceFloe_DataData%Input,1) - CALL IceFloe_CopyInput( SrcIceFloe_DataData%Input(i1), DstIceFloe_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceFloe_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcIceFloe_DataData%InputTimes,1) - i1_u = UBOUND(SrcIceFloe_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstIceFloe_DataData%InputTimes)) THEN - ALLOCATE(DstIceFloe_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyIceFloe_Data - - SUBROUTINE FAST_DestroyIceFloe_Data( IceFloe_DataData, ErrStat, ErrMsg ) - TYPE(IceFloe_Data), INTENT(INOUT) :: IceFloe_DataData - 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 = 'FAST_DestroyIceFloe_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(IceFloe_DataData%x,1), UBOUND(IceFloe_DataData%x,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL IceFloe_DestroyParam( IceFloe_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyInput( IceFloe_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyOutput( IceFloe_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceFloe_DataData%Input) -ENDIF -IF (ALLOCATED(IceFloe_DataData%InputTimes)) THEN - DEALLOCATE(IceFloe_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyIceFloe_Data - - SUBROUTINE FAST_PackIceFloe_Data( 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(IceFloe_Data), 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 = 'FAST_PackIceFloe_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL IceFloe_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL IceFloe_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL IceFloe_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL IceFloe_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL IceFloe_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL IceFloe_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackIceFloe_Data - - SUBROUTINE FAST_UnPackIceFloe_Data( 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(IceFloe_Data), 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 = 'FAST_UnPackIceFloe_Data' - ! 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 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 IceFloe_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 IceFloe_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 IceFloe_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 IceFloe_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 IceFloe_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 IceFloe_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 IceFloe_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackIceFloe_Data - - SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_Data), INTENT(INOUT) :: SrcMAP_DataData - TYPE(MAP_Data), INTENT(INOUT) :: DstMAP_DataData - 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 = 'FAST_CopyMAP_Data' -! + ErrMsg = '' + if (allocated(SrcBeamDyn_DataData%x)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%x) + UB(1:2) = ubound(SrcBeamDyn_DataData%x) + if (.not. allocated(DstBeamDyn_DataData%x)) then + allocate(DstBeamDyn_DataData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyContState(SrcBeamDyn_DataData%x(i1,i2), DstBeamDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcBeamDyn_DataData%xd)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%xd) + UB(1:2) = ubound(SrcBeamDyn_DataData%xd) + if (.not. allocated(DstBeamDyn_DataData%xd)) then + allocate(DstBeamDyn_DataData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyDiscState(SrcBeamDyn_DataData%xd(i1,i2), DstBeamDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcBeamDyn_DataData%z)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%z) + UB(1:2) = ubound(SrcBeamDyn_DataData%z) + if (.not. allocated(DstBeamDyn_DataData%z)) then + allocate(DstBeamDyn_DataData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyConstrState(SrcBeamDyn_DataData%z(i1,i2), DstBeamDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcBeamDyn_DataData%OtherSt)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%OtherSt) + UB(1:2) = ubound(SrcBeamDyn_DataData%OtherSt) + if (.not. allocated(DstBeamDyn_DataData%OtherSt)) then + allocate(DstBeamDyn_DataData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyOtherState(SrcBeamDyn_DataData%OtherSt(i1,i2), DstBeamDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcBeamDyn_DataData%p)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%p) + UB(1:1) = ubound(SrcBeamDyn_DataData%p) + if (.not. allocated(DstBeamDyn_DataData%p)) then + allocate(DstBeamDyn_DataData%p(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%p.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyParam(SrcBeamDyn_DataData%p(i1), DstBeamDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcBeamDyn_DataData%u)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%u) + UB(1:1) = ubound(SrcBeamDyn_DataData%u) + if (.not. allocated(DstBeamDyn_DataData%u)) then + allocate(DstBeamDyn_DataData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyInput(SrcBeamDyn_DataData%u(i1), DstBeamDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcBeamDyn_DataData%y)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%y) + UB(1:1) = ubound(SrcBeamDyn_DataData%y) + if (.not. allocated(DstBeamDyn_DataData%y)) then + allocate(DstBeamDyn_DataData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyOutput(SrcBeamDyn_DataData%y(i1), DstBeamDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcBeamDyn_DataData%m)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%m) + UB(1:1) = ubound(SrcBeamDyn_DataData%m) + if (.not. allocated(DstBeamDyn_DataData%m)) then + allocate(DstBeamDyn_DataData%m(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyMisc(SrcBeamDyn_DataData%m(i1), DstBeamDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcBeamDyn_DataData%Output)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%Output) + UB(1:2) = ubound(SrcBeamDyn_DataData%Output) + if (.not. allocated(DstBeamDyn_DataData%Output)) then + allocate(DstBeamDyn_DataData%Output(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyOutput(SrcBeamDyn_DataData%Output(i1,i2), DstBeamDyn_DataData%Output(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcBeamDyn_DataData%y_interp)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%y_interp) + UB(1:1) = ubound(SrcBeamDyn_DataData%y_interp) + if (.not. allocated(DstBeamDyn_DataData%y_interp)) then + allocate(DstBeamDyn_DataData%y_interp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y_interp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyOutput(SrcBeamDyn_DataData%y_interp(i1), DstBeamDyn_DataData%y_interp(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcBeamDyn_DataData%Input)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%Input) + UB(1:2) = ubound(SrcBeamDyn_DataData%Input) + if (.not. allocated(DstBeamDyn_DataData%Input)) then + allocate(DstBeamDyn_DataData%Input(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyInput(SrcBeamDyn_DataData%Input(i1,i2), DstBeamDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcBeamDyn_DataData%InputTimes)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%InputTimes) + UB(1:2) = ubound(SrcBeamDyn_DataData%InputTimes) + if (.not. allocated(DstBeamDyn_DataData%InputTimes)) then + allocate(DstBeamDyn_DataData%InputTimes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) + type(BeamDyn_Data), intent(inout) :: BeamDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyBeamDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcMAP_DataData%x,1), UBOUND(SrcMAP_DataData%x,1) - CALL MAP_CopyContState( SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMAP_DataData%xd,1), UBOUND(SrcMAP_DataData%xd,1) - CALL MAP_CopyDiscState( SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMAP_DataData%z,1), UBOUND(SrcMAP_DataData%z,1) - CALL MAP_CopyConstrState( SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt, DstMAP_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyParam( SrcMAP_DataData%p, DstMAP_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyInput( SrcMAP_DataData%u, DstMAP_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyOutput( SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMAP_DataData%Output)) THEN - i1_l = LBOUND(SrcMAP_DataData%Output,1) - i1_u = UBOUND(SrcMAP_DataData%Output,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%Output)) THEN - ALLOCATE(DstMAP_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMAP_DataData%Output,1), UBOUND(SrcMAP_DataData%Output,1) - CALL MAP_CopyOutput( SrcMAP_DataData%Output(i1), DstMAP_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MAP_CopyOutput( SrcMAP_DataData%y_interp, DstMAP_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMAP_DataData%Input)) THEN - i1_l = LBOUND(SrcMAP_DataData%Input,1) - i1_u = UBOUND(SrcMAP_DataData%Input,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%Input)) THEN - ALLOCATE(DstMAP_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMAP_DataData%Input,1), UBOUND(SrcMAP_DataData%Input,1) - CALL MAP_CopyInput( SrcMAP_DataData%Input(i1), DstMAP_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMAP_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcMAP_DataData%InputTimes,1) - i1_u = UBOUND(SrcMAP_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%InputTimes)) THEN - ALLOCATE(DstMAP_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyMAP_Data - - SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg ) - TYPE(MAP_Data), INTENT(INOUT) :: MAP_DataData - 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 = 'FAST_DestroyMAP_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(MAP_DataData%x,1), UBOUND(MAP_DataData%x,1) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL MAP_DestroyOtherState( MAP_DataData%OtherSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyParam( MAP_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyInput( MAP_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyOutput( MAP_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MAP_DataData%Output) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MAP_DataData%Input) -ENDIF -IF (ALLOCATED(MAP_DataData%InputTimes)) THEN - DEALLOCATE(MAP_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyMAP_Data - - SUBROUTINE FAST_PackMAP_Data( 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(MAP_Data), 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 = 'FAST_PackMAP_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL MAP_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt_old: size of buffers for each call to pack subtype - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_old, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_old - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_old - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_old - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_old - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL MAP_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_old, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_old - 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 - IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackMAP_Data - - SUBROUTINE FAST_UnPackMAP_Data( 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(MAP_Data), 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 = 'FAST_UnPackMAP_Data' - ! 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 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 MAP_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 MAP_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 MAP_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - 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 MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - 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) - 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 MAP_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_old, ErrStat2, ErrMsg2 ) ! OtherSt_old - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output 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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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 MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackMAP_Data - - SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAMooring_Data), INTENT(INOUT) :: SrcFEAMooring_DataData - TYPE(FEAMooring_Data), INTENT(INOUT) :: DstFEAMooring_DataData - 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 = 'FAST_CopyFEAMooring_Data' -! + ErrMsg = '' + if (allocated(BeamDyn_DataData%x)) then + LB(1:2) = lbound(BeamDyn_DataData%x) + UB(1:2) = ubound(BeamDyn_DataData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyContState(BeamDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%x) + end if + if (allocated(BeamDyn_DataData%xd)) then + LB(1:2) = lbound(BeamDyn_DataData%xd) + UB(1:2) = ubound(BeamDyn_DataData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyDiscState(BeamDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%xd) + end if + if (allocated(BeamDyn_DataData%z)) then + LB(1:2) = lbound(BeamDyn_DataData%z) + UB(1:2) = ubound(BeamDyn_DataData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyConstrState(BeamDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%z) + end if + if (allocated(BeamDyn_DataData%OtherSt)) then + LB(1:2) = lbound(BeamDyn_DataData%OtherSt) + UB(1:2) = ubound(BeamDyn_DataData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyOtherState(BeamDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%OtherSt) + end if + if (allocated(BeamDyn_DataData%p)) then + LB(1:1) = lbound(BeamDyn_DataData%p) + UB(1:1) = ubound(BeamDyn_DataData%p) + do i1 = LB(1), UB(1) + call BD_DestroyParam(BeamDyn_DataData%p(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%p) + end if + if (allocated(BeamDyn_DataData%u)) then + LB(1:1) = lbound(BeamDyn_DataData%u) + UB(1:1) = ubound(BeamDyn_DataData%u) + do i1 = LB(1), UB(1) + call BD_DestroyInput(BeamDyn_DataData%u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%u) + end if + if (allocated(BeamDyn_DataData%y)) then + LB(1:1) = lbound(BeamDyn_DataData%y) + UB(1:1) = ubound(BeamDyn_DataData%y) + do i1 = LB(1), UB(1) + call BD_DestroyOutput(BeamDyn_DataData%y(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%y) + end if + if (allocated(BeamDyn_DataData%m)) then + LB(1:1) = lbound(BeamDyn_DataData%m) + UB(1:1) = ubound(BeamDyn_DataData%m) + do i1 = LB(1), UB(1) + call BD_DestroyMisc(BeamDyn_DataData%m(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%m) + end if + if (allocated(BeamDyn_DataData%Output)) then + LB(1:2) = lbound(BeamDyn_DataData%Output) + UB(1:2) = ubound(BeamDyn_DataData%Output) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyOutput(BeamDyn_DataData%Output(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%Output) + end if + if (allocated(BeamDyn_DataData%y_interp)) then + LB(1:1) = lbound(BeamDyn_DataData%y_interp) + UB(1:1) = ubound(BeamDyn_DataData%y_interp) + do i1 = LB(1), UB(1) + call BD_DestroyOutput(BeamDyn_DataData%y_interp(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%y_interp) + end if + if (allocated(BeamDyn_DataData%Input)) then + LB(1:2) = lbound(BeamDyn_DataData%Input) + UB(1:2) = ubound(BeamDyn_DataData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyInput(BeamDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%Input) + end if + if (allocated(BeamDyn_DataData%InputTimes)) then + deallocate(BeamDyn_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackBeamDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BeamDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackBeamDyn_Data' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(Buf, 2, lbound(InData%x), ubound(InData%x)) + LB(1:2) = lbound(InData%x) + UB(1:2) = ubound(InData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackContState(Buf, InData%x(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(Buf, 2, lbound(InData%xd), ubound(InData%xd)) + LB(1:2) = lbound(InData%xd) + UB(1:2) = ubound(InData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackDiscState(Buf, InData%xd(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(Buf, 2, lbound(InData%z), ubound(InData%z)) + LB(1:2) = lbound(InData%z) + UB(1:2) = ubound(InData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackConstrState(Buf, InData%z(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(Buf, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:2) = lbound(InData%OtherSt) + UB(1:2) = ubound(InData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackOtherState(Buf, InData%OtherSt(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%p)) + if (allocated(InData%p)) then + call RegPackBounds(Buf, 1, lbound(InData%p), ubound(InData%p)) + LB(1:1) = lbound(InData%p) + UB(1:1) = ubound(InData%p) + do i1 = LB(1), UB(1) + call BD_PackParam(Buf, InData%p(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) + LB(1:1) = lbound(InData%u) + UB(1:1) = ubound(InData%u) + do i1 = LB(1), UB(1) + call BD_PackInput(Buf, InData%u(i1)) + end do + end if + call RegPack(Buf, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + LB(1:1) = lbound(InData%y) + UB(1:1) = ubound(InData%y) + do i1 = LB(1), UB(1) + call BD_PackOutput(Buf, InData%y(i1)) + end do + end if + call RegPack(Buf, allocated(InData%m)) + if (allocated(InData%m)) then + call RegPackBounds(Buf, 1, lbound(InData%m), ubound(InData%m)) + LB(1:1) = lbound(InData%m) + UB(1:1) = ubound(InData%m) + do i1 = LB(1), UB(1) + call BD_PackMisc(Buf, InData%m(i1)) + end do + end if + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 2, lbound(InData%Output), ubound(InData%Output)) + LB(1:2) = lbound(InData%Output) + UB(1:2) = ubound(InData%Output) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackOutput(Buf, InData%Output(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%y_interp)) + if (allocated(InData%y_interp)) then + call RegPackBounds(Buf, 1, lbound(InData%y_interp), ubound(InData%y_interp)) + LB(1:1) = lbound(InData%y_interp) + UB(1:1) = ubound(InData%y_interp) + do i1 = LB(1), UB(1) + call BD_PackOutput(Buf, InData%y_interp(i1)) + end do + end if + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 2, lbound(InData%Input), ubound(InData%Input)) + LB(1:2) = lbound(InData%Input) + UB(1:2) = ubound(InData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackInput(Buf, InData%Input(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 2, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackBeamDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BeamDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackBeamDyn_Data' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackContState(Buf, OutData%x(i1,i2)) ! x + end do + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackDiscState(Buf, OutData%xd(i1,i2)) ! xd + end do + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackConstrState(Buf, OutData%z(i1,i2)) ! z + end do + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackOtherState(Buf, OutData%OtherSt(i1,i2)) ! OtherSt + end do + end do + end if + if (allocated(OutData%p)) deallocate(OutData%p) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%p(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackParam(Buf, OutData%p(i1)) ! p + end do + end if + if (allocated(OutData%u)) deallocate(OutData%u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackInput(Buf, OutData%u(i1)) ! u + end do + end if + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackOutput(Buf, OutData%y(i1)) ! y + end do + end if + if (allocated(OutData%m)) deallocate(OutData%m) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackMisc(Buf, OutData%m(i1)) ! m + end do + end if + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackOutput(Buf, OutData%Output(i1,i2)) ! Output + end do + end do + end if + if (allocated(OutData%y_interp)) deallocate(OutData%y_interp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_interp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackOutput(Buf, OutData%y_interp(i1)) ! y_interp + end do + end if + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackInput(Buf, OutData%Input(i1,i2)) ! Input + end do + end do + end if + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(ElastoDyn_Data), intent(inout) :: SrcElastoDyn_DataData + type(ElastoDyn_Data), intent(inout) :: DstElastoDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyElastoDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcFEAMooring_DataData%x,1), UBOUND(SrcFEAMooring_DataData%x,1) - CALL FEAM_CopyContState( SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%xd,1), UBOUND(SrcFEAMooring_DataData%xd,1) - CALL FEAM_CopyDiscState( SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%z,1), UBOUND(SrcFEAMooring_DataData%z,1) - CALL FEAM_CopyConstrState( SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%OtherSt,1), UBOUND(SrcFEAMooring_DataData%OtherSt,1) - CALL FEAM_CopyOtherState( SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL FEAM_CopyParam( SrcFEAMooring_DataData%p, DstFEAMooring_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyInput( SrcFEAMooring_DataData%u, DstFEAMooring_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyOutput( SrcFEAMooring_DataData%y, DstFEAMooring_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyMisc( SrcFEAMooring_DataData%m, DstFEAMooring_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcFEAMooring_DataData%Input)) THEN - i1_l = LBOUND(SrcFEAMooring_DataData%Input,1) - i1_u = UBOUND(SrcFEAMooring_DataData%Input,1) - IF (.NOT. ALLOCATED(DstFEAMooring_DataData%Input)) THEN - ALLOCATE(DstFEAMooring_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcFEAMooring_DataData%Input,1), UBOUND(SrcFEAMooring_DataData%Input,1) - CALL FEAM_CopyInput( SrcFEAMooring_DataData%Input(i1), DstFEAMooring_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcFEAMooring_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcFEAMooring_DataData%InputTimes,1) - i1_u = UBOUND(SrcFEAMooring_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstFEAMooring_DataData%InputTimes)) THEN - ALLOCATE(DstFEAMooring_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyFEAMooring_Data - - SUBROUTINE FAST_DestroyFEAMooring_Data( FEAMooring_DataData, ErrStat, ErrMsg ) - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAMooring_DataData - 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 = 'FAST_DestroyFEAMooring_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(FEAMooring_DataData%x,1), UBOUND(FEAMooring_DataData%x,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL FEAM_DestroyParam( FEAMooring_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyInput( FEAMooring_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyOutput( FEAMooring_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(FEAMooring_DataData%Input) -ENDIF -IF (ALLOCATED(FEAMooring_DataData%InputTimes)) THEN - DEALLOCATE(FEAMooring_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyFEAMooring_Data - - SUBROUTINE FAST_PackFEAMooring_Data( 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(FEAMooring_Data), 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 = 'FAST_PackFEAMooring_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL FEAM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL FEAM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL FEAM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL FEAM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL FEAM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL FEAM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackFEAMooring_Data - - SUBROUTINE FAST_UnPackFEAMooring_Data( 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(FEAMooring_Data), 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 = 'FAST_UnPackFEAMooring_Data' - ! 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 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 FEAM_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 FEAM_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 FEAM_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 FEAM_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 FEAM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 FEAM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 FEAM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackFEAMooring_Data - - SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MoorDyn_Data), INTENT(INOUT) :: SrcMoorDyn_DataData - TYPE(MoorDyn_Data), INTENT(INOUT) :: DstMoorDyn_DataData - 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 = 'FAST_CopyMoorDyn_Data' -! + ErrMsg = '' + LB(1:1) = lbound(SrcElastoDyn_DataData%x) + UB(1:1) = ubound(SrcElastoDyn_DataData%x) + do i1 = LB(1), UB(1) + call ED_CopyContState(SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcElastoDyn_DataData%xd) + UB(1:1) = ubound(SrcElastoDyn_DataData%xd) + do i1 = LB(1), UB(1) + call ED_CopyDiscState(SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcElastoDyn_DataData%z) + UB(1:1) = ubound(SrcElastoDyn_DataData%z) + do i1 = LB(1), UB(1) + call ED_CopyConstrState(SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcElastoDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcElastoDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ED_CopyOtherState(SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call ED_CopyParam(SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyInput(SrcElastoDyn_DataData%u, DstElastoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyOutput(SrcElastoDyn_DataData%y, DstElastoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyMisc(SrcElastoDyn_DataData%m, DstElastoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcElastoDyn_DataData%Output)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%Output) + UB(1:1) = ubound(SrcElastoDyn_DataData%Output) + if (.not. allocated(DstElastoDyn_DataData%Output)) then + allocate(DstElastoDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyOutput(SrcElastoDyn_DataData%Output(i1), DstElastoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call ED_CopyOutput(SrcElastoDyn_DataData%y_interp, DstElastoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcElastoDyn_DataData%Input)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%Input) + UB(1:1) = ubound(SrcElastoDyn_DataData%Input) + if (.not. allocated(DstElastoDyn_DataData%Input)) then + allocate(DstElastoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyInput(SrcElastoDyn_DataData%Input(i1), DstElastoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcElastoDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes) + if (.not. allocated(DstElastoDyn_DataData%InputTimes)) then + allocate(DstElastoDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) + type(ElastoDyn_Data), intent(inout) :: ElastoDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyElastoDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcMoorDyn_DataData%x,1), UBOUND(SrcMoorDyn_DataData%x,1) - CALL MD_CopyContState( SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%xd,1), UBOUND(SrcMoorDyn_DataData%xd,1) - CALL MD_CopyDiscState( SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%z,1), UBOUND(SrcMoorDyn_DataData%z,1) - CALL MD_CopyConstrState( SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%OtherSt,1), UBOUND(SrcMoorDyn_DataData%OtherSt,1) - CALL MD_CopyOtherState( SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL MD_CopyParam( SrcMoorDyn_DataData%p, DstMoorDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyInput( SrcMoorDyn_DataData%u, DstMoorDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyOutput( SrcMoorDyn_DataData%y, DstMoorDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyMisc( SrcMoorDyn_DataData%m, DstMoorDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMoorDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%Output,1) - i1_u = UBOUND(SrcMoorDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Output)) THEN - ALLOCATE(DstMoorDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMoorDyn_DataData%Output,1), UBOUND(SrcMoorDyn_DataData%Output,1) - CALL MD_CopyOutput( SrcMoorDyn_DataData%Output(i1), DstMoorDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MD_CopyOutput( SrcMoorDyn_DataData%y_interp, DstMoorDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMoorDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%Input,1) - i1_u = UBOUND(SrcMoorDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Input)) THEN - ALLOCATE(DstMoorDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMoorDyn_DataData%Input,1), UBOUND(SrcMoorDyn_DataData%Input,1) - CALL MD_CopyInput( SrcMoorDyn_DataData%Input(i1), DstMoorDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMoorDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcMoorDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%InputTimes)) THEN - ALLOCATE(DstMoorDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyMoorDyn_Data - - SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg ) - TYPE(MoorDyn_Data), INTENT(INOUT) :: MoorDyn_DataData - 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 = 'FAST_DestroyMoorDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(MoorDyn_DataData%x,1), UBOUND(MoorDyn_DataData%x,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL MD_DestroyParam( MoorDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInput( MoorDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyOutput( MoorDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MoorDyn_DataData%Output) -ENDIF - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MoorDyn_DataData%Input) -ENDIF -IF (ALLOCATED(MoorDyn_DataData%InputTimes)) THEN - DEALLOCATE(MoorDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyMoorDyn_Data - - SUBROUTINE FAST_PackMoorDyn_Data( 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(MoorDyn_Data), 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 = 'FAST_PackMoorDyn_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackMoorDyn_Data - - SUBROUTINE FAST_UnPackMoorDyn_Data( 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(MoorDyn_Data), 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 = 'FAST_UnPackMoorDyn_Data' - ! 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 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 MD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 MD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output 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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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 MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackMoorDyn_Data - - SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OrcaFlex_Data), INTENT(INOUT) :: SrcOrcaFlex_DataData - TYPE(OrcaFlex_Data), INTENT(INOUT) :: DstOrcaFlex_DataData - 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 = 'FAST_CopyOrcaFlex_Data' -! + ErrMsg = '' + LB(1:1) = lbound(ElastoDyn_DataData%x) + UB(1:1) = ubound(ElastoDyn_DataData%x) + do i1 = LB(1), UB(1) + call ED_DestroyContState(ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ElastoDyn_DataData%xd) + UB(1:1) = ubound(ElastoDyn_DataData%xd) + do i1 = LB(1), UB(1) + call ED_DestroyDiscState(ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ElastoDyn_DataData%z) + UB(1:1) = ubound(ElastoDyn_DataData%z) + do i1 = LB(1), UB(1) + call ED_DestroyConstrState(ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ElastoDyn_DataData%OtherSt) + UB(1:1) = ubound(ElastoDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ED_DestroyOtherState(ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call ED_DestroyParam(ElastoDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyInput(ElastoDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyOutput(ElastoDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyMisc(ElastoDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ElastoDyn_DataData%Output)) then + LB(1:1) = lbound(ElastoDyn_DataData%Output) + UB(1:1) = ubound(ElastoDyn_DataData%Output) + do i1 = LB(1), UB(1) + call ED_DestroyOutput(ElastoDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ElastoDyn_DataData%Output) + end if + call ED_DestroyOutput(ElastoDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ElastoDyn_DataData%Input)) then + LB(1:1) = lbound(ElastoDyn_DataData%Input) + UB(1:1) = ubound(ElastoDyn_DataData%Input) + do i1 = LB(1), UB(1) + call ED_DestroyInput(ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ElastoDyn_DataData%Input) + end if + if (allocated(ElastoDyn_DataData%InputTimes)) then + deallocate(ElastoDyn_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackElastoDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ElastoDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackElastoDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call ED_PackContState(Buf, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call ED_PackDiscState(Buf, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call ED_PackConstrState(Buf, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call ED_PackOtherState(Buf, InData%OtherSt(i1)) + end do + call ED_PackParam(Buf, InData%p) + call ED_PackInput(Buf, InData%u) + call ED_PackOutput(Buf, InData%y) + call ED_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call ED_PackOutput(Buf, InData%Output(i1)) + end do + end if + call ED_PackOutput(Buf, InData%y_interp) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call ED_PackInput(Buf, InData%Input(i1)) + end do + end if + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackElastoDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ElastoDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackElastoDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call ED_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call ED_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call ED_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call ED_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call ED_UnpackParam(Buf, OutData%p) ! p + call ED_UnpackInput(Buf, OutData%u) ! u + call ED_UnpackOutput(Buf, OutData%y) ! y + call ED_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + call ED_UnpackOutput(Buf, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(ServoDyn_Data), intent(inout) :: SrcServoDyn_DataData + type(ServoDyn_Data), intent(inout) :: DstServoDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyServoDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcOrcaFlex_DataData%x,1), UBOUND(SrcOrcaFlex_DataData%x,1) - CALL Orca_CopyContState( SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%xd,1), UBOUND(SrcOrcaFlex_DataData%xd,1) - CALL Orca_CopyDiscState( SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%z,1), UBOUND(SrcOrcaFlex_DataData%z,1) - CALL Orca_CopyConstrState( SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%OtherSt,1), UBOUND(SrcOrcaFlex_DataData%OtherSt,1) - CALL Orca_CopyOtherState( SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL Orca_CopyParam( SrcOrcaFlex_DataData%p, DstOrcaFlex_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyInput( SrcOrcaFlex_DataData%u, DstOrcaFlex_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyOutput( SrcOrcaFlex_DataData%y, DstOrcaFlex_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyMisc( SrcOrcaFlex_DataData%m, DstOrcaFlex_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOrcaFlex_DataData%Input)) THEN - i1_l = LBOUND(SrcOrcaFlex_DataData%Input,1) - i1_u = UBOUND(SrcOrcaFlex_DataData%Input,1) - IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%Input)) THEN - ALLOCATE(DstOrcaFlex_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOrcaFlex_DataData%Input,1), UBOUND(SrcOrcaFlex_DataData%Input,1) - CALL Orca_CopyInput( SrcOrcaFlex_DataData%Input(i1), DstOrcaFlex_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOrcaFlex_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcOrcaFlex_DataData%InputTimes,1) - i1_u = UBOUND(SrcOrcaFlex_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%InputTimes)) THEN - ALLOCATE(DstOrcaFlex_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyOrcaFlex_Data - - SUBROUTINE FAST_DestroyOrcaFlex_Data( OrcaFlex_DataData, ErrStat, ErrMsg ) - TYPE(OrcaFlex_Data), INTENT(INOUT) :: OrcaFlex_DataData - 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 = 'FAST_DestroyOrcaFlex_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(OrcaFlex_DataData%x,1), UBOUND(OrcaFlex_DataData%x,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL Orca_DestroyParam( OrcaFlex_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyInput( OrcaFlex_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyOutput( OrcaFlex_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OrcaFlex_DataData%Input) -ENDIF -IF (ALLOCATED(OrcaFlex_DataData%InputTimes)) THEN - DEALLOCATE(OrcaFlex_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyOrcaFlex_Data - - SUBROUTINE FAST_PackOrcaFlex_Data( 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(OrcaFlex_Data), 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 = 'FAST_PackOrcaFlex_Data' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL Orca_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL Orca_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL Orca_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL Orca_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL Orca_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL Orca_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL Orca_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL Orca_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL Orca_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL Orca_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL Orca_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL Orca_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL Orca_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 - CALL Orca_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! 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 - IF ( .NOT. ALLOCATED(InData%Input) ) 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%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 - IF ( .NOT. ALLOCATED(InData%InputTimes) ) 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%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackOrcaFlex_Data - - SUBROUTINE FAST_UnPackOrcaFlex_Data( 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(OrcaFlex_Data), 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 = 'FAST_UnPackOrcaFlex_Data' - ! 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 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 Orca_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 Orca_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 Orca_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 Orca_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 Orca_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! 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) - 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 Orca_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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) - 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 Orca_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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) - 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 Orca_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input 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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 Orca_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes 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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackOrcaFlex_Data - - SUBROUTINE FAST_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: SrcModuleMapTypeData - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: DstModuleMapTypeData - 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 = 'FAST_CopyModuleMapType' -! + ErrMsg = '' + LB(1:1) = lbound(SrcServoDyn_DataData%x) + UB(1:1) = ubound(SrcServoDyn_DataData%x) + do i1 = LB(1), UB(1) + call SrvD_CopyContState(SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcServoDyn_DataData%xd) + UB(1:1) = ubound(SrcServoDyn_DataData%xd) + do i1 = LB(1), UB(1) + call SrvD_CopyDiscState(SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcServoDyn_DataData%z) + UB(1:1) = ubound(SrcServoDyn_DataData%z) + do i1 = LB(1), UB(1) + call SrvD_CopyConstrState(SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcServoDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcServoDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SrvD_CopyOtherState(SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call SrvD_CopyParam(SrcServoDyn_DataData%p, DstServoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyInput(SrcServoDyn_DataData%u, DstServoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyOutput(SrcServoDyn_DataData%y, DstServoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyMisc(SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcServoDyn_DataData%Output)) then + LB(1:1) = lbound(SrcServoDyn_DataData%Output) + UB(1:1) = ubound(SrcServoDyn_DataData%Output) + if (.not. allocated(DstServoDyn_DataData%Output)) then + allocate(DstServoDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyOutput(SrcServoDyn_DataData%Output(i1), DstServoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call SrvD_CopyOutput(SrcServoDyn_DataData%y_interp, DstServoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcServoDyn_DataData%Input)) then + LB(1:1) = lbound(SrcServoDyn_DataData%Input) + UB(1:1) = ubound(SrcServoDyn_DataData%Input) + if (.not. allocated(DstServoDyn_DataData%Input)) then + allocate(DstServoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyInput(SrcServoDyn_DataData%Input(i1), DstServoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcServoDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcServoDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcServoDyn_DataData%InputTimes) + if (.not. allocated(DstServoDyn_DataData%InputTimes)) then + allocate(DstServoDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) + type(ServoDyn_Data), intent(inout) :: ServoDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyServoDyn_Data' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P(i1), DstModuleMapTypeData%ED_P_2_BD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_P_2_ED_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_P_2_ED_P)) THEN - ALLOCATE(DstModuleMapTypeData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_P_2_ED_P(i1), DstModuleMapTypeData%BD_P_2_ED_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P_Hub(i1), DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_PRP_P, DstModuleMapTypeData%ED_P_2_HD_PRP_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SubStructure_2_HD_W_P, DstModuleMapTypeData%SubStructure_2_HD_W_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_W_P_2_SubStructure, DstModuleMapTypeData%HD_W_P_2_SubStructure, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SubStructure_2_HD_M_P, DstModuleMapTypeData%SubStructure_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_P_2_SubStructure, DstModuleMapTypeData%HD_M_P_2_SubStructure, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%Structure_2_Mooring, DstModuleMapTypeData%Structure_2_Mooring, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%Mooring_2_Structure, DstModuleMapTypeData%Mooring_2_Structure, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SD_TP, DstModuleMapTypeData%ED_P_2_SD_TP, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_TP_2_ED_P, DstModuleMapTypeData%SD_TP_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_NStC_P_N)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_NStC_P_N)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_NStC_P_N(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_NStC_P_N.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1), UBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_NStC_P_N(i1), DstModuleMapTypeData%ED_P_2_NStC_P_N(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%NStC_P_2_ED_P_N)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1) - i1_u = UBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%NStC_P_2_ED_P_N)) THEN - ALLOCATE(DstModuleMapTypeData%NStC_P_2_ED_P_N(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%NStC_P_2_ED_P_N.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1), UBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%NStC_P_2_ED_P_N(i1), DstModuleMapTypeData%NStC_P_2_ED_P_N(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%ED_L_2_TStC_P_T)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_L_2_TStC_P_T)) THEN - ALLOCATE(DstModuleMapTypeData%ED_L_2_TStC_P_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_TStC_P_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1), UBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_TStC_P_T(i1), DstModuleMapTypeData%ED_L_2_TStC_P_T(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%TStC_P_2_ED_P_T)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1) - i1_u = UBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%TStC_P_2_ED_P_T)) THEN - ALLOCATE(DstModuleMapTypeData%TStC_P_2_ED_P_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%TStC_P_2_ED_P_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1), UBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%TStC_P_2_ED_P_T(i1), DstModuleMapTypeData%TStC_P_2_ED_P_T(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%ED_L_2_BStC_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_L_2_BStC_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%ED_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2), UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1), UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BStC_P_2_ED_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BStC_P_2_ED_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%BStC_P_2_ED_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_ED_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2), UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1), UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_L_2_BStC_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_L_2_BStC_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%BD_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2), UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1), UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BStC_P_2_BD_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BStC_P_2_BD_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%BStC_P_2_BD_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_BD_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2), UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1), UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SStC_P_P_2_SubStructure)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1) - i1_u = UBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SStC_P_P_2_SubStructure)) THEN - ALLOCATE(DstModuleMapTypeData%SStC_P_P_2_SubStructure(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SStC_P_P_2_SubStructure.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1), UBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SStC_P_P_2_SubStructure(i1), DstModuleMapTypeData%SStC_P_P_2_SubStructure(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SubStructure_2_SStC_P_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SubStructure_2_SStC_P_P)) THEN - ALLOCATE(DstModuleMapTypeData%SubStructure_2_SStC_P_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SubStructure_2_SStC_P_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1), UBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SubStructure_2_SStC_P_P(i1), DstModuleMapTypeData%SubStructure_2_SStC_P_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SrvD_P_P, DstModuleMapTypeData%ED_P_2_SrvD_P_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%BDED_L_2_AD_L_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BDED_L_2_AD_L_B)) THEN - ALLOCATE(DstModuleMapTypeData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BDED_L_2_AD_L_B(i1), DstModuleMapTypeData%BDED_L_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%AD_L_2_BDED_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%AD_L_2_BDED_B)) THEN - ALLOCATE(DstModuleMapTypeData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_BDED_B(i1), DstModuleMapTypeData%AD_L_2_BDED_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_L_2_BD_L)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_L_2_BD_L)) THEN - ALLOCATE(DstModuleMapTypeData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_L_2_BD_L(i1), DstModuleMapTypeData%BD_L_2_BD_L(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_N, DstModuleMapTypeData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_N, DstModuleMapTypeData%AD_P_2_ED_P_N, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_TF, DstModuleMapTypeData%ED_P_2_AD_P_TF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_TF, DstModuleMapTypeData%AD_P_2_ED_P_TF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_AD_L_T, DstModuleMapTypeData%ED_L_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_ED_P_T, DstModuleMapTypeData%AD_L_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_AD_P_R)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_AD_P_R)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_R(i1), DstModuleMapTypeData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_H, DstModuleMapTypeData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_H, DstModuleMapTypeData%AD_P_2_ED_P_H, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceF_P_2_SD_P, DstModuleMapTypeData%IceF_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SDy3_P_2_IceF_P, DstModuleMapTypeData%SDy3_P_2_IceF_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%IceD_P_2_SD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%IceD_P_2_SD_P)) THEN - ALLOCATE(DstModuleMapTypeData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceD_P_2_SD_P(i1), DstModuleMapTypeData%IceD_P_2_SD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SDy3_P_2_IceD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SDy3_P_2_IceD_P)) THEN - ALLOCATE(DstModuleMapTypeData%SDy3_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SDy3_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1), UBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SDy3_P_2_IceD_P(i1), DstModuleMapTypeData%SDy3_P_2_IceD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_Opt1)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) - i2_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) - i2_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_Opt1)) THEN - ALLOCATE(DstModuleMapTypeData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_pivot)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_pivot)) THEN - ALLOCATE(DstModuleMapTypeData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,1) - i2_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,2) - i2_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jac_u_indx)) THEN - ALLOCATE(DstModuleMapTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jac_u_indx = SrcModuleMapTypeData%Jac_u_indx -ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_ED_NacelleLoads, DstModuleMapTypeData%u_ED_NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%SubstructureLoads_Tmp, DstModuleMapTypeData%SubstructureLoads_Tmp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%SubstructureLoads_Tmp2, DstModuleMapTypeData%SubstructureLoads_Tmp2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%PlatformLoads_Tmp, DstModuleMapTypeData%PlatformLoads_Tmp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%PlatformLoads_Tmp2, DstModuleMapTypeData%PlatformLoads_Tmp2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%SubstructureLoads_Tmp_Farm, DstModuleMapTypeData%SubstructureLoads_Tmp_Farm, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_TowerPtloads, DstModuleMapTypeData%u_ED_TowerPtloads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%u_ED_BladePtLoads)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_ED_BladePtLoads)) THEN - ALLOCATE(DstModuleMapTypeData%u_ED_BladePtLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_ED_BladePtLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1), UBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1) - CALL MeshCopy( SrcModuleMapTypeData%u_ED_BladePtLoads(i1), DstModuleMapTypeData%u_ED_BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_SD_TPMesh, DstModuleMapTypeData%u_SD_TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_HD_M_Mesh, DstModuleMapTypeData%u_HD_M_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_HD_W_Mesh, DstModuleMapTypeData%u_HD_W_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad, DstModuleMapTypeData%u_ED_HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad_2, DstModuleMapTypeData%u_ED_HubPtLoad_2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%u_BD_RootMotion)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BD_RootMotion)) THEN - ALLOCATE(DstModuleMapTypeData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1), UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - CALL MeshCopy( SrcModuleMapTypeData%u_BD_RootMotion(i1), DstModuleMapTypeData%u_BD_RootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - i1_u = UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN - ALLOCATE(DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - CALL MeshCopy( SrcModuleMapTypeData%y_BD_BldMotion_4Loads(i1), DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%u_BD_Distrload)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_BD_Distrload,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_BD_Distrload,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BD_Distrload)) THEN - ALLOCATE(DstModuleMapTypeData%u_BD_Distrload(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_Distrload.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_BD_Distrload,1), UBOUND(SrcModuleMapTypeData%u_BD_Distrload,1) - CALL MeshCopy( SrcModuleMapTypeData%u_BD_Distrload(i1), DstModuleMapTypeData%u_BD_Distrload(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_Orca_PtfmMesh, DstModuleMapTypeData%u_Orca_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ExtPtfm_PtfmMesh, DstModuleMapTypeData%u_ExtPtfm_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyModuleMapType - - SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData - 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 = 'FAST_DestroyModuleMapType' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%TStC_P_2_ED_P_T) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_L_2_BStC_P_B) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%BStC_P_2_ED_P_B) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%BD_L_2_BStC_P_B) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%BStC_P_2_BD_P_B) -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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%SDy3_P_2_IceD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jacobian_Opt1)) THEN - DEALLOCATE(ModuleMapTypeData%Jacobian_Opt1) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jacobian_pivot)) THEN - DEALLOCATE(ModuleMapTypeData%Jacobian_pivot) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jac_u_indx)) THEN - DEALLOCATE(ModuleMapTypeData%Jac_u_indx) -ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_ED_NacelleLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%PlatformLoads_Tmp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%PlatformLoads_Tmp2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp_Farm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_TowerPtloads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%u_ED_BladePtLoads)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_ED_BladePtLoads,1), UBOUND(ModuleMapTypeData%u_ED_BladePtLoads,1) - CALL MeshDestroy( ModuleMapTypeData%u_ED_BladePtLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_ED_BladePtLoads) -ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_SD_TPMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_HD_M_Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_HD_W_Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%u_BD_RootMotion)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_BD_RootMotion,1), UBOUND(ModuleMapTypeData%u_BD_RootMotion,1) - CALL MeshDestroy( ModuleMapTypeData%u_BD_RootMotion(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_BD_RootMotion) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN -DO i1 = LBOUND(ModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(ModuleMapTypeData%y_BD_BldMotion_4Loads,1) - CALL MeshDestroy( ModuleMapTypeData%y_BD_BldMotion_4Loads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%y_BD_BldMotion_4Loads) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%u_BD_Distrload)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_BD_Distrload,1), UBOUND(ModuleMapTypeData%u_BD_Distrload,1) - CALL MeshDestroy( ModuleMapTypeData%u_BD_Distrload(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_BD_Distrload) -ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_Orca_PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ExtPtfm_PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyModuleMapType - - SUBROUTINE FAST_PackModuleMapType( 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(FAST_ModuleMapType), 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 = 'FAST_PackModuleMapType' - ! 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 ! ED_P_2_BD_P allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_BD_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_BD_P upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_BD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_BD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_BD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BD_P_2_ED_P allocated yes/no - IF ( ALLOCATED(InData%BD_P_2_ED_P) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BD_P_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD_P_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD_P_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_BD_P_Hub allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_BD_P_Hub) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_BD_P_Hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_BD_P_Hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_BD_P_Hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_PRP_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_PRP_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_PRP_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubStructure_2_HD_W_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubStructure_2_HD_W_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubStructure_2_HD_W_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HD_W_P_2_SubStructure - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_W_P_2_SubStructure - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_W_P_2_SubStructure - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubStructure_2_HD_M_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubStructure_2_HD_M_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubStructure_2_HD_M_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HD_M_P_2_SubStructure - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_M_P_2_SubStructure - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_M_P_2_SubStructure - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Structure_2_Mooring - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Structure_2_Mooring - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Structure_2_Mooring - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mooring_2_Structure - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mooring_2_Structure - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mooring_2_Structure - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_SD_TP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_SD_TP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_SD_TP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SD_TP_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD_TP_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD_TP_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_NStC_P_N allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_NStC_P_N) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_NStC_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_NStC_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_NStC_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC_P_2_ED_P_N allocated yes/no - IF ( ALLOCATED(InData%NStC_P_2_ED_P_N) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC_P_2_ED_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC_P_2_ED_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC_P_2_ED_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ED_L_2_TStC_P_T allocated yes/no - IF ( ALLOCATED(InData%ED_L_2_TStC_P_T) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_TStC_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_TStC_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_TStC_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC_P_2_ED_P_T allocated yes/no - IF ( ALLOCATED(InData%TStC_P_2_ED_P_T) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC_P_2_ED_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC_P_2_ED_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC_P_2_ED_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ED_L_2_BStC_P_B allocated yes/no - IF ( ALLOCATED(InData%ED_L_2_BStC_P_B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ED_L_2_BStC_P_B upper/lower bounds for each dimension - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_BStC_P_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_BStC_P_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_BStC_P_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BStC_P_2_ED_P_B allocated yes/no - IF ( ALLOCATED(InData%BStC_P_2_ED_P_B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BStC_P_2_ED_P_B upper/lower bounds for each dimension - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC_P_2_ED_P_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC_P_2_ED_P_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC_P_2_ED_P_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BD_L_2_BStC_P_B allocated yes/no - IF ( ALLOCATED(InData%BD_L_2_BStC_P_B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BD_L_2_BStC_P_B upper/lower bounds for each dimension - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BD_L_2_BStC_P_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD_L_2_BStC_P_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD_L_2_BStC_P_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BStC_P_2_BD_P_B allocated yes/no - IF ( ALLOCATED(InData%BStC_P_2_BD_P_B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BStC_P_2_BD_P_B upper/lower bounds for each dimension - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC_P_2_BD_P_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC_P_2_BD_P_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC_P_2_BD_P_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC_P_P_2_SubStructure allocated yes/no - IF ( ALLOCATED(InData%SStC_P_P_2_SubStructure) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC_P_P_2_SubStructure - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC_P_P_2_SubStructure - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC_P_P_2_SubStructure - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SubStructure_2_SStC_P_P allocated yes/no - IF ( ALLOCATED(InData%SubStructure_2_SStC_P_P) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubStructure_2_SStC_P_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubStructure_2_SStC_P_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubStructure_2_SStC_P_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_SrvD_P_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_SrvD_P_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_SrvD_P_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BDED_L_2_AD_L_B allocated yes/no - IF ( ALLOCATED(InData%BDED_L_2_AD_L_B) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BDED_L_2_AD_L_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BDED_L_2_AD_L_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BDED_L_2_AD_L_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! AD_L_2_BDED_B allocated yes/no - IF ( ALLOCATED(InData%AD_L_2_BDED_B) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_BDED_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_BDED_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_BDED_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BD_L_2_BD_L allocated yes/no - IF ( ALLOCATED(InData%BD_L_2_BD_L) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BD_L_2_BD_L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD_L_2_BD_L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD_L_2_BD_L - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_ED_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_ED_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_ED_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_TF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_TF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_TF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_ED_P_TF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_ED_P_TF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_ED_P_TF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_AD_L_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_AD_L_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_AD_L_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_ED_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_ED_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_ED_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_AD_P_R allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_R - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_R - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_R - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_H - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_H - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_H - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_ED_P_H - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_ED_P_H - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_ED_P_H - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IceF_P_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceF_P_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceF_P_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SDy3_P_2_IceF_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SDy3_P_2_IceF_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SDy3_P_2_IceF_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IceD_P_2_SD_P allocated yes/no - IF ( ALLOCATED(InData%IceD_P_2_SD_P) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IceD_P_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceD_P_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceD_P_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SDy3_P_2_IceD_P allocated yes/no - IF ( ALLOCATED(InData%SDy3_P_2_IceD_P) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SDy3_P_2_IceD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SDy3_P_2_IceD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SDy3_P_2_IceD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Jacobian_Opt1 allocated yes/no - IF ( ALLOCATED(InData%Jacobian_Opt1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jacobian_Opt1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Jacobian_Opt1) ! Jacobian_Opt1 - END IF - Int_BufSz = Int_BufSz + 1 ! Jacobian_pivot allocated yes/no - IF ( ALLOCATED(InData%Jacobian_pivot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Jacobian_pivot upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jacobian_pivot) ! Jacobian_pivot - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_NacelleLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_NacelleLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_NacelleLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_NacelleLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_NacelleLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SubstructureLoads_Tmp: size of buffers for each call to pack subtype - CALL MeshPack( InData%SubstructureLoads_Tmp, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SubstructureLoads_Tmp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubstructureLoads_Tmp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubstructureLoads_Tmp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubstructureLoads_Tmp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SubstructureLoads_Tmp2: size of buffers for each call to pack subtype - CALL MeshPack( InData%SubstructureLoads_Tmp2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SubstructureLoads_Tmp2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubstructureLoads_Tmp2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubstructureLoads_Tmp2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubstructureLoads_Tmp2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! PlatformLoads_Tmp: size of buffers for each call to pack subtype - CALL MeshPack( InData%PlatformLoads_Tmp, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PlatformLoads_Tmp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PlatformLoads_Tmp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PlatformLoads_Tmp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PlatformLoads_Tmp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! PlatformLoads_Tmp2: size of buffers for each call to pack subtype - CALL MeshPack( InData%PlatformLoads_Tmp2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PlatformLoads_Tmp2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PlatformLoads_Tmp2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PlatformLoads_Tmp2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PlatformLoads_Tmp2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SubstructureLoads_Tmp_Farm: size of buffers for each call to pack subtype - CALL MeshPack( InData%SubstructureLoads_Tmp_Farm, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SubstructureLoads_Tmp_Farm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubstructureLoads_Tmp_Farm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubstructureLoads_Tmp_Farm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubstructureLoads_Tmp_Farm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_TowerPtloads: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_TowerPtloads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_TowerPtloads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_TowerPtloads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_TowerPtloads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_TowerPtloads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! u_ED_BladePtLoads allocated yes/no - IF ( ALLOCATED(InData%u_ED_BladePtLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_ED_BladePtLoads upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_ED_BladePtLoads,1), UBOUND(InData%u_ED_BladePtLoads,1) - Int_BufSz = Int_BufSz + 3 ! u_ED_BladePtLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_BladePtLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_BladePtLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_BladePtLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_BladePtLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! u_SD_TPMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_TPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SD_TPMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SD_TPMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SD_TPMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_HD_M_Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_HD_M_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_M_Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_HD_M_Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_HD_M_Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_HD_M_Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_HD_W_Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_HD_W_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_W_Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_HD_W_Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_HD_W_Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_HD_W_Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_HubPtLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_HubPtLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_HubPtLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_HubPtLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_HubPtLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_HubPtLoad_2: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_HubPtLoad_2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_HubPtLoad_2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_HubPtLoad_2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_HubPtLoad_2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! u_BD_RootMotion allocated yes/no - IF ( ALLOCATED(InData%u_BD_RootMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_BD_RootMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_BD_RootMotion,1), UBOUND(InData%u_BD_RootMotion,1) - Int_BufSz = Int_BufSz + 3 ! u_BD_RootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_BD_RootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_BD_RootMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BD_RootMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BD_RootMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_BD_BldMotion_4Loads allocated yes/no - IF ( ALLOCATED(InData%y_BD_BldMotion_4Loads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_BD_BldMotion_4Loads upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_BD_BldMotion_4Loads,1), UBOUND(InData%y_BD_BldMotion_4Loads,1) - Int_BufSz = Int_BufSz + 3 ! y_BD_BldMotion_4Loads: size of buffers for each call to pack subtype - CALL MeshPack( InData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! y_BD_BldMotion_4Loads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_BD_BldMotion_4Loads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_BD_BldMotion_4Loads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_BD_BldMotion_4Loads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_BD_Distrload allocated yes/no - IF ( ALLOCATED(InData%u_BD_Distrload) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_BD_Distrload upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_BD_Distrload,1), UBOUND(InData%u_BD_Distrload,1) - Int_BufSz = Int_BufSz + 3 ! u_BD_Distrload: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_BD_Distrload(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_BD_Distrload - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_BD_Distrload - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BD_Distrload - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BD_Distrload - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! u_Orca_PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_Orca_PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_Orca_PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_Orca_PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_Orca_PtfmMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ExtPtfm_PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ExtPtfm_PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ExtPtfm_PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ExtPtfm_PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ExtPtfm_PtfmMesh - 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 - - IF ( .NOT. ALLOCATED(InData%ED_P_2_BD_P) ) 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%ED_P_2_BD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_BD_P,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%BD_P_2_ED_P) ) 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%BD_P_2_ED_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_P_2_ED_P,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%ED_P_2_BD_P_Hub) ) 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%ED_P_2_BD_P_Hub,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_BD_P_Hub,1) - 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 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%ED_P_2_NStC_P_N) ) 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%ED_P_2_NStC_P_N,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_NStC_P_N,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%NStC_P_2_ED_P_N) ) 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%NStC_P_2_ED_P_N,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC_P_2_ED_P_N,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%ED_L_2_TStC_P_T) ) 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%ED_L_2_TStC_P_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_L_2_TStC_P_T,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%TStC_P_2_ED_P_T) ) 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%TStC_P_2_ED_P_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC_P_2_ED_P_T,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%ED_L_2_BStC_P_B) ) 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%ED_L_2_BStC_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_L_2_BStC_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_L_2_BStC_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_L_2_BStC_P_B,2) - Int_Xferred = Int_Xferred + 2 - - 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 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%BStC_P_2_ED_P_B) ) 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%BStC_P_2_ED_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_ED_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_ED_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_ED_P_B,2) - Int_Xferred = Int_Xferred + 2 - - 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 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%BD_L_2_BStC_P_B) ) 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%BD_L_2_BStC_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BStC_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_L_2_BStC_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BStC_P_B,2) - Int_Xferred = Int_Xferred + 2 - - 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 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%BStC_P_2_BD_P_B) ) 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%BStC_P_2_BD_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_BD_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_BD_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_BD_P_B,2) - Int_Xferred = Int_Xferred + 2 - - 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 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC_P_P_2_SubStructure) ) 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%SStC_P_P_2_SubStructure,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC_P_P_2_SubStructure,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%SubStructure_2_SStC_P_P) ) 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%SubStructure_2_SStC_P_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SubStructure_2_SStC_P_P,1) - 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 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%BDED_L_2_AD_L_B) ) 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%BDED_L_2_AD_L_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BDED_L_2_AD_L_B,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%AD_L_2_BDED_B) ) 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%AD_L_2_BDED_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_L_2_BDED_B,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%BD_L_2_BD_L) ) 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%BD_L_2_BD_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BD_L,1) - 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 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%ED_P_2_AD_P_R) ) 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%ED_P_2_AD_P_R,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_AD_P_R,1) - 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 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%IceD_P_2_SD_P) ) 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%IceD_P_2_SD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IceD_P_2_SD_P,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%SDy3_P_2_IceD_P) ) 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%SDy3_P_2_IceD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SDy3_P_2_IceD_P,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%Jacobian_Opt1) ) 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%Jacobian_Opt1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_Opt1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_Opt1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_Opt1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jacobian_Opt1,2), UBOUND(InData%Jacobian_Opt1,2) - DO i1 = LBOUND(InData%Jacobian_Opt1,1), UBOUND(InData%Jacobian_Opt1,1) - ReKiBuf(Re_Xferred) = InData%Jacobian_Opt1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jacobian_pivot) ) 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%Jacobian_pivot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_pivot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Jacobian_pivot,1), UBOUND(InData%Jacobian_pivot,1) - IntKiBuf(Int_Xferred) = InData%Jacobian_pivot(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) 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%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - CALL MeshPack( InData%u_ED_NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_NacelleLoads - 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 - CALL MeshPack( InData%SubstructureLoads_Tmp, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SubstructureLoads_Tmp - 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 - CALL MeshPack( InData%SubstructureLoads_Tmp2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SubstructureLoads_Tmp2 - 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 - CALL MeshPack( InData%PlatformLoads_Tmp, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PlatformLoads_Tmp - 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 - CALL MeshPack( InData%PlatformLoads_Tmp2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PlatformLoads_Tmp2 - 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 - CALL MeshPack( InData%SubstructureLoads_Tmp_Farm, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SubstructureLoads_Tmp_Farm - 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 - CALL MeshPack( InData%u_ED_TowerPtloads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_TowerPtloads - 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 - IF ( .NOT. ALLOCATED(InData%u_ED_BladePtLoads) ) 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%u_ED_BladePtLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_ED_BladePtLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_ED_BladePtLoads,1), UBOUND(InData%u_ED_BladePtLoads,1) - CALL MeshPack( InData%u_ED_BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_BladePtLoads - 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 - CALL MeshPack( InData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_TPMesh - 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 - CALL MeshPack( InData%u_HD_M_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_M_Mesh - 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 - CALL MeshPack( InData%u_HD_W_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_W_Mesh - 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 - CALL MeshPack( InData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_HubPtLoad - 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 - CALL MeshPack( InData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_HubPtLoad_2 - 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 - IF ( .NOT. ALLOCATED(InData%u_BD_RootMotion) ) 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%u_BD_RootMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD_RootMotion,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_BD_RootMotion,1), UBOUND(InData%u_BD_RootMotion,1) - CALL MeshPack( InData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_BD_RootMotion - 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 - IF ( .NOT. ALLOCATED(InData%y_BD_BldMotion_4Loads) ) 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%y_BD_BldMotion_4Loads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_BD_BldMotion_4Loads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_BD_BldMotion_4Loads,1), UBOUND(InData%y_BD_BldMotion_4Loads,1) - CALL MeshPack( InData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! y_BD_BldMotion_4Loads - 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 - IF ( .NOT. ALLOCATED(InData%u_BD_Distrload) ) 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%u_BD_Distrload,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD_Distrload,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_BD_Distrload,1), UBOUND(InData%u_BD_Distrload,1) - CALL MeshPack( InData%u_BD_Distrload(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_BD_Distrload - 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 - CALL MeshPack( InData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_Orca_PtfmMesh - 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 - CALL MeshPack( InData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ExtPtfm_PtfmMesh - 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 FAST_PackModuleMapType - - SUBROUTINE FAST_UnPackModuleMapType( 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(FAST_ModuleMapType), 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 = 'FAST_UnPackModuleMapType' - ! 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 ! ED_P_2_BD_P 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%ED_P_2_BD_P)) DEALLOCATE(OutData%ED_P_2_BD_P) - ALLOCATE(OutData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_BD_P,1), UBOUND(OutData%ED_P_2_BD_P,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_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 - - 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 ! BD_P_2_ED_P 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%BD_P_2_ED_P)) DEALLOCATE(OutData%BD_P_2_ED_P) - ALLOCATE(OutData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BD_P_2_ED_P,1), UBOUND(OutData%BD_P_2_ED_P,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_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 - - 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 ! ED_P_2_BD_P_Hub 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%ED_P_2_BD_P_Hub)) DEALLOCATE(OutData%ED_P_2_BD_P_Hub) - ALLOCATE(OutData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_BD_P_Hub,1), UBOUND(OutData%ED_P_2_BD_P_Hub,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_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 - - 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 - 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_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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 ! ED_P_2_NStC_P_N 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%ED_P_2_NStC_P_N)) DEALLOCATE(OutData%ED_P_2_NStC_P_N) - ALLOCATE(OutData%ED_P_2_NStC_P_N(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_NStC_P_N.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_NStC_P_N,1), UBOUND(OutData%ED_P_2_NStC_P_N,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_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 - - 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 ! NStC_P_2_ED_P_N 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%NStC_P_2_ED_P_N)) DEALLOCATE(OutData%NStC_P_2_ED_P_N) - ALLOCATE(OutData%NStC_P_2_ED_P_N(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_P_2_ED_P_N.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC_P_2_ED_P_N,1), UBOUND(OutData%NStC_P_2_ED_P_N,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_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 - - 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 ! ED_L_2_TStC_P_T 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%ED_L_2_TStC_P_T)) DEALLOCATE(OutData%ED_L_2_TStC_P_T) - ALLOCATE(OutData%ED_L_2_TStC_P_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_TStC_P_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_L_2_TStC_P_T,1), UBOUND(OutData%ED_L_2_TStC_P_T,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_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 - - 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 ! TStC_P_2_ED_P_T 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%TStC_P_2_ED_P_T)) DEALLOCATE(OutData%TStC_P_2_ED_P_T) - ALLOCATE(OutData%TStC_P_2_ED_P_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_P_2_ED_P_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC_P_2_ED_P_T,1), UBOUND(OutData%TStC_P_2_ED_P_T,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_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 - - 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 ! ED_L_2_BStC_P_B 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%ED_L_2_BStC_P_B)) DEALLOCATE(OutData%ED_L_2_BStC_P_B) - ALLOCATE(OutData%ED_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ED_L_2_BStC_P_B,2), UBOUND(OutData%ED_L_2_BStC_P_B,2) - DO i1 = LBOUND(OutData%ED_L_2_BStC_P_B,1), UBOUND(OutData%ED_L_2_BStC_P_B,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_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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC_P_2_ED_P_B 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%BStC_P_2_ED_P_B)) DEALLOCATE(OutData%BStC_P_2_ED_P_B) - ALLOCATE(OutData%BStC_P_2_ED_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_ED_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BStC_P_2_ED_P_B,2), UBOUND(OutData%BStC_P_2_ED_P_B,2) - DO i1 = LBOUND(OutData%BStC_P_2_ED_P_B,1), UBOUND(OutData%BStC_P_2_ED_P_B,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_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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_L_2_BStC_P_B 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%BD_L_2_BStC_P_B)) DEALLOCATE(OutData%BD_L_2_BStC_P_B) - ALLOCATE(OutData%BD_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BD_L_2_BStC_P_B,2), UBOUND(OutData%BD_L_2_BStC_P_B,2) - DO i1 = LBOUND(OutData%BD_L_2_BStC_P_B,1), UBOUND(OutData%BD_L_2_BStC_P_B,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_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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC_P_2_BD_P_B 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%BStC_P_2_BD_P_B)) DEALLOCATE(OutData%BStC_P_2_BD_P_B) - ALLOCATE(OutData%BStC_P_2_BD_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_BD_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BStC_P_2_BD_P_B,2), UBOUND(OutData%BStC_P_2_BD_P_B,2) - DO i1 = LBOUND(OutData%BStC_P_2_BD_P_B,1), UBOUND(OutData%BStC_P_2_BD_P_B,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_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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC_P_P_2_SubStructure 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%SStC_P_P_2_SubStructure)) DEALLOCATE(OutData%SStC_P_P_2_SubStructure) - ALLOCATE(OutData%SStC_P_P_2_SubStructure(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_P_P_2_SubStructure.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC_P_P_2_SubStructure,1), UBOUND(OutData%SStC_P_P_2_SubStructure,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_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 - - 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 ! SubStructure_2_SStC_P_P 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%SubStructure_2_SStC_P_P)) DEALLOCATE(OutData%SubStructure_2_SStC_P_P) - ALLOCATE(OutData%SubStructure_2_SStC_P_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SubStructure_2_SStC_P_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SubStructure_2_SStC_P_P,1), UBOUND(OutData%SubStructure_2_SStC_P_P,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_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 - - 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 - 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_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 - - 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 ! BDED_L_2_AD_L_B 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%BDED_L_2_AD_L_B)) DEALLOCATE(OutData%BDED_L_2_AD_L_B) - ALLOCATE(OutData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BDED_L_2_AD_L_B,1), UBOUND(OutData%BDED_L_2_AD_L_B,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_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 - - 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 ! AD_L_2_BDED_B 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%AD_L_2_BDED_B)) DEALLOCATE(OutData%AD_L_2_BDED_B) - ALLOCATE(OutData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AD_L_2_BDED_B,1), UBOUND(OutData%AD_L_2_BDED_B,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_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 - - 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 ! BD_L_2_BD_L 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%BD_L_2_BD_L)) DEALLOCATE(OutData%BD_L_2_BD_L) - ALLOCATE(OutData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BD_L_2_BD_L,1), UBOUND(OutData%BD_L_2_BD_L,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_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 - - 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 - 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_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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 ! ED_P_2_AD_P_R 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%ED_P_2_AD_P_R)) DEALLOCATE(OutData%ED_P_2_AD_P_R) - ALLOCATE(OutData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_AD_P_R,1), UBOUND(OutData%ED_P_2_AD_P_R,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_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 - - 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 - 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_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 - - 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 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 - - 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 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 - - 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 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 - - 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 ! IceD_P_2_SD_P 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%IceD_P_2_SD_P)) DEALLOCATE(OutData%IceD_P_2_SD_P) - ALLOCATE(OutData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IceD_P_2_SD_P,1), UBOUND(OutData%IceD_P_2_SD_P,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_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 - - 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 ! SDy3_P_2_IceD_P 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%SDy3_P_2_IceD_P)) DEALLOCATE(OutData%SDy3_P_2_IceD_P) - ALLOCATE(OutData%SDy3_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDy3_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SDy3_P_2_IceD_P,1), UBOUND(OutData%SDy3_P_2_IceD_P,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_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 - - 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 ! Jacobian_Opt1 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%Jacobian_Opt1)) DEALLOCATE(OutData%Jacobian_Opt1) - ALLOCATE(OutData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jacobian_Opt1,2), UBOUND(OutData%Jacobian_Opt1,2) - DO i1 = LBOUND(OutData%Jacobian_Opt1,1), UBOUND(OutData%Jacobian_Opt1,1) - OutData%Jacobian_Opt1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_pivot 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%Jacobian_pivot)) DEALLOCATE(OutData%Jacobian_pivot) - ALLOCATE(OutData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Jacobian_pivot,1), UBOUND(OutData%Jacobian_pivot,1) - OutData%Jacobian_pivot(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx 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%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 MeshUnpack( OutData%u_ED_NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_NacelleLoads - 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) - 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 MeshUnpack( OutData%SubstructureLoads_Tmp, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SubstructureLoads_Tmp - 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) - 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 MeshUnpack( OutData%SubstructureLoads_Tmp2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SubstructureLoads_Tmp2 - 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) - 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 MeshUnpack( OutData%PlatformLoads_Tmp, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PlatformLoads_Tmp - 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) - 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 MeshUnpack( OutData%PlatformLoads_Tmp2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PlatformLoads_Tmp2 - 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) - 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 MeshUnpack( OutData%SubstructureLoads_Tmp_Farm, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SubstructureLoads_Tmp_Farm - 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) - 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 MeshUnpack( OutData%u_ED_TowerPtloads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_TowerPtloads - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_ED_BladePtLoads 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%u_ED_BladePtLoads)) DEALLOCATE(OutData%u_ED_BladePtLoads) - ALLOCATE(OutData%u_ED_BladePtLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED_BladePtLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_ED_BladePtLoads,1), UBOUND(OutData%u_ED_BladePtLoads,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 MeshUnpack( OutData%u_ED_BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_BladePtLoads - 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 - 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 MeshUnpack( OutData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_TPMesh - 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) - 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 MeshUnpack( OutData%u_HD_M_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_M_Mesh - 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) - 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 MeshUnpack( OutData%u_HD_W_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_W_Mesh - 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) - 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 MeshUnpack( OutData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad - 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) - 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 MeshUnpack( OutData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad_2 - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BD_RootMotion 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%u_BD_RootMotion)) DEALLOCATE(OutData%u_BD_RootMotion) - ALLOCATE(OutData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_BD_RootMotion,1), UBOUND(OutData%u_BD_RootMotion,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 MeshUnpack( OutData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_BD_RootMotion - 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 ! y_BD_BldMotion_4Loads 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%y_BD_BldMotion_4Loads)) DEALLOCATE(OutData%y_BD_BldMotion_4Loads) - ALLOCATE(OutData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_BD_BldMotion_4Loads,1), UBOUND(OutData%y_BD_BldMotion_4Loads,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 MeshUnpack( OutData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! y_BD_BldMotion_4Loads - 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 ! u_BD_Distrload 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%u_BD_Distrload)) DEALLOCATE(OutData%u_BD_Distrload) - ALLOCATE(OutData%u_BD_Distrload(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_Distrload.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_BD_Distrload,1), UBOUND(OutData%u_BD_Distrload,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 MeshUnpack( OutData%u_BD_Distrload(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_BD_Distrload - 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 - 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 MeshUnpack( OutData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_Orca_PtfmMesh - 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) - 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 MeshUnpack( OutData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ExtPtfm_PtfmMesh - 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 FAST_UnPackModuleMapType - - SUBROUTINE FAST_CopyExternInputType( SrcExternInputTypeData, DstExternInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ExternInputType), INTENT(IN) :: SrcExternInputTypeData - TYPE(FAST_ExternInputType), INTENT(INOUT) :: DstExternInputTypeData - 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 = 'FAST_CopyExternInputType' -! + ErrMsg = '' + LB(1:1) = lbound(ServoDyn_DataData%x) + UB(1:1) = ubound(ServoDyn_DataData%x) + do i1 = LB(1), UB(1) + call SrvD_DestroyContState(ServoDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ServoDyn_DataData%xd) + UB(1:1) = ubound(ServoDyn_DataData%xd) + do i1 = LB(1), UB(1) + call SrvD_DestroyDiscState(ServoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ServoDyn_DataData%z) + UB(1:1) = ubound(ServoDyn_DataData%z) + do i1 = LB(1), UB(1) + call SrvD_DestroyConstrState(ServoDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ServoDyn_DataData%OtherSt) + UB(1:1) = ubound(ServoDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SrvD_DestroyOtherState(ServoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call SrvD_DestroyParam(ServoDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyInput(ServoDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyOutput(ServoDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyMisc(ServoDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ServoDyn_DataData%Output)) then + LB(1:1) = lbound(ServoDyn_DataData%Output) + UB(1:1) = ubound(ServoDyn_DataData%Output) + do i1 = LB(1), UB(1) + call SrvD_DestroyOutput(ServoDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ServoDyn_DataData%Output) + end if + call SrvD_DestroyOutput(ServoDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ServoDyn_DataData%Input)) then + LB(1:1) = lbound(ServoDyn_DataData%Input) + UB(1:1) = ubound(ServoDyn_DataData%Input) + do i1 = LB(1), UB(1) + call SrvD_DestroyInput(ServoDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ServoDyn_DataData%Input) + end if + if (allocated(ServoDyn_DataData%InputTimes)) then + deallocate(ServoDyn_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackServoDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ServoDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackServoDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SrvD_PackContState(Buf, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SrvD_PackDiscState(Buf, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SrvD_PackConstrState(Buf, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call SrvD_PackOtherState(Buf, InData%OtherSt(i1)) + end do + call SrvD_PackParam(Buf, InData%p) + call SrvD_PackInput(Buf, InData%u) + call SrvD_PackOutput(Buf, InData%y) + call SrvD_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call SrvD_PackOutput(Buf, InData%Output(i1)) + end do + end if + call SrvD_PackOutput(Buf, InData%y_interp) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call SrvD_PackInput(Buf, InData%Input(i1)) + end do + end if + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackServoDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ServoDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackServoDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call SrvD_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call SrvD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call SrvD_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call SrvD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call SrvD_UnpackParam(Buf, OutData%p) ! p + call SrvD_UnpackInput(Buf, OutData%u) ! u + call SrvD_UnpackOutput(Buf, OutData%y) ! y + call SrvD_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + call SrvD_UnpackOutput(Buf, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyAeroDyn14_Data(SrcAeroDyn14_DataData, DstAeroDyn14_DataData, CtrlCode, ErrStat, ErrMsg) + type(AeroDyn14_Data), intent(inout) :: SrcAeroDyn14_DataData + type(AeroDyn14_Data), intent(inout) :: DstAeroDyn14_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyAeroDyn14_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcAeroDyn14_DataData%x) + UB(1:1) = ubound(SrcAeroDyn14_DataData%x) + do i1 = LB(1), UB(1) + call AD14_CopyContState(SrcAeroDyn14_DataData%x(i1), DstAeroDyn14_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcAeroDyn14_DataData%xd) + UB(1:1) = ubound(SrcAeroDyn14_DataData%xd) + do i1 = LB(1), UB(1) + call AD14_CopyDiscState(SrcAeroDyn14_DataData%xd(i1), DstAeroDyn14_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcAeroDyn14_DataData%z) + UB(1:1) = ubound(SrcAeroDyn14_DataData%z) + do i1 = LB(1), UB(1) + call AD14_CopyConstrState(SrcAeroDyn14_DataData%z(i1), DstAeroDyn14_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcAeroDyn14_DataData%OtherSt) + UB(1:1) = ubound(SrcAeroDyn14_DataData%OtherSt) + do i1 = LB(1), UB(1) + call AD14_CopyOtherState(SrcAeroDyn14_DataData%OtherSt(i1), DstAeroDyn14_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call AD14_CopyParam(SrcAeroDyn14_DataData%p, DstAeroDyn14_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyInput(SrcAeroDyn14_DataData%u, DstAeroDyn14_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyOutput(SrcAeroDyn14_DataData%y, DstAeroDyn14_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyMisc(SrcAeroDyn14_DataData%m, DstAeroDyn14_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcAeroDyn14_DataData%Input)) then + LB(1:1) = lbound(SrcAeroDyn14_DataData%Input) + UB(1:1) = ubound(SrcAeroDyn14_DataData%Input) + if (.not. allocated(DstAeroDyn14_DataData%Input)) then + allocate(DstAeroDyn14_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD14_CopyInput(SrcAeroDyn14_DataData%Input(i1), DstAeroDyn14_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDyn14_DataData%InputTimes)) then + LB(1:1) = lbound(SrcAeroDyn14_DataData%InputTimes) + UB(1:1) = ubound(SrcAeroDyn14_DataData%InputTimes) + if (.not. allocated(DstAeroDyn14_DataData%InputTimes)) then + allocate(DstAeroDyn14_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroDyn14_DataData%InputTimes = SrcAeroDyn14_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyAeroDyn14_Data(AeroDyn14_DataData, ErrStat, ErrMsg) + type(AeroDyn14_Data), intent(inout) :: AeroDyn14_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyAeroDyn14_Data' ErrStat = ErrID_None - ErrMsg = "" - DstExternInputTypeData%GenTrq = SrcExternInputTypeData%GenTrq - DstExternInputTypeData%ElecPwr = SrcExternInputTypeData%ElecPwr - DstExternInputTypeData%YawPosCom = SrcExternInputTypeData%YawPosCom - DstExternInputTypeData%YawRateCom = SrcExternInputTypeData%YawRateCom - DstExternInputTypeData%BlPitchCom = SrcExternInputTypeData%BlPitchCom - DstExternInputTypeData%BlAirfoilCom = SrcExternInputTypeData%BlAirfoilCom - DstExternInputTypeData%HSSBrFrac = SrcExternInputTypeData%HSSBrFrac - DstExternInputTypeData%LidarFocus = SrcExternInputTypeData%LidarFocus - DstExternInputTypeData%CableDeltaL = SrcExternInputTypeData%CableDeltaL - DstExternInputTypeData%CableDeltaLdot = SrcExternInputTypeData%CableDeltaLdot - END SUBROUTINE FAST_CopyExternInputType - - SUBROUTINE FAST_DestroyExternInputType( ExternInputTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ExternInputType), INTENT(INOUT) :: ExternInputTypeData - 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 = 'FAST_DestroyExternInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE FAST_DestroyExternInputType - - SUBROUTINE FAST_PackExternInputType( 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(FAST_ExternInputType), 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 = 'FAST_PackExternInputType' - ! 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 ! GenTrq - Re_BufSz = Re_BufSz + 1 ! ElecPwr - Re_BufSz = Re_BufSz + 1 ! YawPosCom - Re_BufSz = Re_BufSz + 1 ! YawRateCom - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom - Re_BufSz = Re_BufSz + SIZE(InData%BlAirfoilCom) ! BlAirfoilCom - Re_BufSz = Re_BufSz + 1 ! HSSBrFrac - Re_BufSz = Re_BufSz + SIZE(InData%LidarFocus) ! LidarFocus - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaL) ! CableDeltaL - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaLdot) ! CableDeltaLdot - 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%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ElecPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) - ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%BlAirfoilCom,1), UBOUND(InData%BlAirfoilCom,1) - ReKiBuf(Re_Xferred) = InData%BlAirfoilCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%HSSBrFrac - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%LidarFocus,1), UBOUND(InData%LidarFocus,1) - ReKiBuf(Re_Xferred) = InData%LidarFocus(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%CableDeltaL,1), UBOUND(InData%CableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%CableDeltaLdot,1), UBOUND(InData%CableDeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FAST_PackExternInputType - - SUBROUTINE FAST_UnPackExternInputType( 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(FAST_ExternInputType), 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 = 'FAST_UnPackExternInputType' - ! 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%GenTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawPosCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%BlPitchCom,1) - i1_u = UBOUND(OutData%BlPitchCom,1) - DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) - OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%BlAirfoilCom,1) - i1_u = UBOUND(OutData%BlAirfoilCom,1) - DO i1 = LBOUND(OutData%BlAirfoilCom,1), UBOUND(OutData%BlAirfoilCom,1) - OutData%BlAirfoilCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%HSSBrFrac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%LidarFocus,1) - i1_u = UBOUND(OutData%LidarFocus,1) - DO i1 = LBOUND(OutData%LidarFocus,1), UBOUND(OutData%LidarFocus,1) - OutData%LidarFocus(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%CableDeltaL,1) - i1_u = UBOUND(OutData%CableDeltaL,1) - DO i1 = LBOUND(OutData%CableDeltaL,1), UBOUND(OutData%CableDeltaL,1) - OutData%CableDeltaL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%CableDeltaLdot,1) - i1_u = UBOUND(OutData%CableDeltaLdot,1) - DO i1 = LBOUND(OutData%CableDeltaLdot,1), UBOUND(OutData%CableDeltaLdot,1) - OutData%CableDeltaLdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FAST_UnPackExternInputType - - SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(FAST_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMisc' -! + ErrMsg = '' + LB(1:1) = lbound(AeroDyn14_DataData%x) + UB(1:1) = ubound(AeroDyn14_DataData%x) + do i1 = LB(1), UB(1) + call AD14_DestroyContState(AeroDyn14_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDyn14_DataData%xd) + UB(1:1) = ubound(AeroDyn14_DataData%xd) + do i1 = LB(1), UB(1) + call AD14_DestroyDiscState(AeroDyn14_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDyn14_DataData%z) + UB(1:1) = ubound(AeroDyn14_DataData%z) + do i1 = LB(1), UB(1) + call AD14_DestroyConstrState(AeroDyn14_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDyn14_DataData%OtherSt) + UB(1:1) = ubound(AeroDyn14_DataData%OtherSt) + do i1 = LB(1), UB(1) + call AD14_DestroyOtherState(AeroDyn14_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call AD14_DestroyParam(AeroDyn14_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyInput(AeroDyn14_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyOutput(AeroDyn14_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyMisc(AeroDyn14_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(AeroDyn14_DataData%Input)) then + LB(1:1) = lbound(AeroDyn14_DataData%Input) + UB(1:1) = ubound(AeroDyn14_DataData%Input) + do i1 = LB(1), UB(1) + call AD14_DestroyInput(AeroDyn14_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn14_DataData%Input) + end if + if (allocated(AeroDyn14_DataData%InputTimes)) then + deallocate(AeroDyn14_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackAeroDyn14_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AeroDyn14_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackAeroDyn14_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call AD14_PackContState(Buf, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call AD14_PackDiscState(Buf, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call AD14_PackConstrState(Buf, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call AD14_PackOtherState(Buf, InData%OtherSt(i1)) + end do + call AD14_PackParam(Buf, InData%p) + call AD14_PackInput(Buf, InData%u) + call AD14_PackOutput(Buf, InData%y) + call AD14_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call AD14_PackInput(Buf, InData%Input(i1)) + end do + end if + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackAeroDyn14_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AeroDyn14_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackAeroDyn14_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call AD14_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call AD14_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call AD14_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call AD14_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call AD14_UnpackParam(Buf, OutData%p) ! p + call AD14_UnpackInput(Buf, OutData%u) ! u + call AD14_UnpackOutput(Buf, OutData%y) ! y + call AD14_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD14_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(AeroDyn_Data), intent(inout) :: SrcAeroDyn_DataData + type(AeroDyn_Data), intent(inout) :: DstAeroDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyAeroDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%TiLstPrn = SrcMiscData%TiLstPrn - DstMiscData%t_global = SrcMiscData%t_global - DstMiscData%NextJacCalcTime = SrcMiscData%NextJacCalcTime - DstMiscData%PrevClockTime = SrcMiscData%PrevClockTime - DstMiscData%UsrTime1 = SrcMiscData%UsrTime1 - DstMiscData%UsrTime2 = SrcMiscData%UsrTime2 - DstMiscData%StrtTime = SrcMiscData%StrtTime - DstMiscData%SimStrtTime = SrcMiscData%SimStrtTime - DstMiscData%calcJacobian = SrcMiscData%calcJacobian - CALL FAST_Copyexterninputtype( SrcMiscData%ExternInput, DstMiscData%ExternInput, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copymisclintype( SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyMisc - - SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(FAST_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 = 'FAST_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL FAST_DestroyExternInputType( MiscData%ExternInput, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyMiscLinType( MiscData%Lin, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyMisc - - SUBROUTINE FAST_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(FAST_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 = 'FAST_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 - Db_BufSz = Db_BufSz + 1 ! TiLstPrn - Db_BufSz = Db_BufSz + 1 ! t_global - Db_BufSz = Db_BufSz + 1 ! NextJacCalcTime - Re_BufSz = Re_BufSz + 1 ! PrevClockTime - Re_BufSz = Re_BufSz + 1 ! UsrTime1 - Re_BufSz = Re_BufSz + 1 ! UsrTime2 - Int_BufSz = Int_BufSz + SIZE(InData%StrtTime) ! StrtTime - Int_BufSz = Int_BufSz + SIZE(InData%SimStrtTime) ! SimStrtTime - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ExternInput - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ExternInput - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ExternInput - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Lin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Lin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Lin - 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 - - DbKiBuf(Db_Xferred) = InData%TiLstPrn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%t_global - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%NextJacCalcTime - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PrevClockTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UsrTime1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UsrTime2 - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%StrtTime,1), UBOUND(InData%StrtTime,1) - IntKiBuf(Int_Xferred) = InData%StrtTime(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%SimStrtTime,1), UBOUND(InData%SimStrtTime,1) - IntKiBuf(Int_Xferred) = InData%SimStrtTime(i1) - Int_Xferred = Int_Xferred + 1 - 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 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 - 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 - - 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 FAST_PackMisc - - SUBROUTINE FAST_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(FAST_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_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%TiLstPrn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%t_global = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NextJacCalcTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%PrevClockTime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UsrTime1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UsrTime2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%StrtTime,1) - i1_u = UBOUND(OutData%StrtTime,1) - DO i1 = LBOUND(OutData%StrtTime,1), UBOUND(OutData%StrtTime,1) - OutData%StrtTime(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%SimStrtTime,1) - i1_u = UBOUND(OutData%SimStrtTime,1) - DO i1 = LBOUND(OutData%SimStrtTime,1), UBOUND(OutData%SimStrtTime,1) - OutData%SimStrtTime(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%calcJacobian = TRANSFER(IntKiBuf(Int_Xferred), OutData%calcJacobian) - 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 FAST_UnpackExternInputType( Re_Buf, Db_Buf, Int_Buf, OutData%ExternInput, ErrStat2, ErrMsg2 ) ! ExternInput - 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) - 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 FAST_UnpackMiscLinType( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin - 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 FAST_UnPackMisc - - SUBROUTINE FAST_CopyInitData( SrcInitDataData, DstInitDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_InitData), INTENT(INOUT) :: SrcInitDataData - TYPE(FAST_InitData), INTENT(INOUT) :: DstInitDataData - 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 = 'FAST_CopyInitData' -! + ErrMsg = '' + LB(1:1) = lbound(SrcAeroDyn_DataData%x) + UB(1:1) = ubound(SrcAeroDyn_DataData%x) + do i1 = LB(1), UB(1) + call AD_CopyContState(SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcAeroDyn_DataData%xd) + UB(1:1) = ubound(SrcAeroDyn_DataData%xd) + do i1 = LB(1), UB(1) + call AD_CopyDiscState(SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcAeroDyn_DataData%z) + UB(1:1) = ubound(SrcAeroDyn_DataData%z) + do i1 = LB(1), UB(1) + call AD_CopyConstrState(SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcAeroDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcAeroDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call AD_CopyOtherState(SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call AD_CopyParam(SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyInput(SrcAeroDyn_DataData%u, DstAeroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyOutput(SrcAeroDyn_DataData%y, DstAeroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyMisc(SrcAeroDyn_DataData%m, DstAeroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcAeroDyn_DataData%Output)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%Output) + UB(1:1) = ubound(SrcAeroDyn_DataData%Output) + if (.not. allocated(DstAeroDyn_DataData%Output)) then + allocate(DstAeroDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyOutput(SrcAeroDyn_DataData%Output(i1), DstAeroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call AD_CopyOutput(SrcAeroDyn_DataData%y_interp, DstAeroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcAeroDyn_DataData%Input)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%Input) + UB(1:1) = ubound(SrcAeroDyn_DataData%Input) + if (.not. allocated(DstAeroDyn_DataData%Input)) then + allocate(DstAeroDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyInput(SrcAeroDyn_DataData%Input(i1), DstAeroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcAeroDyn_DataData%InputTimes) + if (.not. allocated(DstAeroDyn_DataData%InputTimes)) then + allocate(DstAeroDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) + type(AeroDyn_Data), intent(inout) :: AeroDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyAeroDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - CALL ED_CopyInitInput( SrcInitDataData%InData_ED, DstInitDataData%InData_ED, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyInitOutput( SrcInitDataData%OutData_ED, DstInitDataData%OutData_ED, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL BD_CopyInitInput( SrcInitDataData%InData_BD, DstInitDataData%InData_BD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitDataData%OutData_BD)) THEN - i1_l = LBOUND(SrcInitDataData%OutData_BD,1) - i1_u = UBOUND(SrcInitDataData%OutData_BD,1) - IF (.NOT. ALLOCATED(DstInitDataData%OutData_BD)) THEN - ALLOCATE(DstInitDataData%OutData_BD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitDataData%OutData_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitDataData%OutData_BD,1), UBOUND(SrcInitDataData%OutData_BD,1) - CALL BD_CopyInitOutput( SrcInitDataData%OutData_BD(i1), DstInitDataData%OutData_BD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SrvD_CopyInitInput( SrcInitDataData%InData_SrvD, DstInitDataData%InData_SrvD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyInitOutput( SrcInitDataData%OutData_SrvD, DstInitDataData%OutData_SrvD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyInitInput( SrcInitDataData%InData_AD14, DstInitDataData%InData_AD14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyInitOutput( SrcInitDataData%OutData_AD14, DstInitDataData%OutData_AD14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyInitInput( SrcInitDataData%InData_AD, DstInitDataData%InData_AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyInitOutput( SrcInitDataData%OutData_AD, DstInitDataData%OutData_AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInitInput( SrcInitDataData%InData_IfW, DstInitDataData%InData_IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInitOutput( SrcInitDataData%OutData_IfW, DstInitDataData%OutData_IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyInitInput( SrcInitDataData%InData_OpFM, DstInitDataData%InData_OpFM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyInitOutput( SrcInitDataData%OutData_OpFM, DstInitDataData%OutData_OpFM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SeaSt_CopyInitInput( SrcInitDataData%InData_SeaSt, DstInitDataData%InData_SeaSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SeaSt_CopyInitOutput( SrcInitDataData%OutData_SeaSt, DstInitDataData%OutData_SeaSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyInitInput( SrcInitDataData%InData_HD, DstInitDataData%InData_HD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyInitOutput( SrcInitDataData%OutData_HD, DstInitDataData%OutData_HD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyInitInput( SrcInitDataData%InData_SD, DstInitDataData%InData_SD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyInitOutput( SrcInitDataData%OutData_SD, DstInitDataData%OutData_SD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyInitInput( SrcInitDataData%InData_ExtPtfm, DstInitDataData%InData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyInitOutput( SrcInitDataData%OutData_ExtPtfm, DstInitDataData%OutData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyInitInput( SrcInitDataData%InData_MAP, DstInitDataData%InData_MAP, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyInitOutput( SrcInitDataData%OutData_MAP, DstInitDataData%OutData_MAP, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyInitInput( SrcInitDataData%InData_FEAM, DstInitDataData%InData_FEAM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyInitOutput( SrcInitDataData%OutData_FEAM, DstInitDataData%OutData_FEAM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyInitInput( SrcInitDataData%InData_MD, DstInitDataData%InData_MD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyInitOutput( SrcInitDataData%OutData_MD, DstInitDataData%OutData_MD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyInitInput( SrcInitDataData%InData_Orca, DstInitDataData%InData_Orca, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyInitOutput( SrcInitDataData%OutData_Orca, DstInitDataData%OutData_Orca, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyInitInput( SrcInitDataData%InData_IceF, DstInitDataData%InData_IceF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyInitOutput( SrcInitDataData%OutData_IceF, DstInitDataData%OutData_IceF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceD_CopyInitInput( SrcInitDataData%InData_IceD, DstInitDataData%InData_IceD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceD_CopyInitOutput( SrcInitDataData%OutData_IceD, DstInitDataData%OutData_IceD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyInitData - - SUBROUTINE FAST_DestroyInitData( InitDataData, ErrStat, ErrMsg ) - TYPE(FAST_InitData), INTENT(INOUT) :: InitDataData - 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 = 'FAST_DestroyInitData' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL ED_DestroyInitInput( InitDataData%InData_ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyInitOutput( InitDataData%OutData_ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitDataData%OutData_BD) -ENDIF - CALL SrvD_DestroyInitInput( InitDataData%InData_SrvD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyInitOutput( InitDataData%OutData_SrvD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInitInput( InitDataData%InData_AD14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInitOutput( InitDataData%OutData_AD14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyInitInput( InitDataData%InData_AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyInitOutput( InitDataData%OutData_AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInitInput( InitDataData%InData_IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInitOutput( InitDataData%OutData_IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyInitInput( InitDataData%InData_OpFM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyInitOutput( InitDataData%OutData_OpFM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyInitInput( InitDataData%InData_SeaSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyInitOutput( InitDataData%OutData_SeaSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyInitInput( InitDataData%InData_HD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyInitOutput( InitDataData%OutData_HD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyInitInput( InitDataData%InData_SD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyInitOutput( InitDataData%OutData_SD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyInitInput( InitDataData%InData_ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyInitOutput( InitDataData%OutData_ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyInitInput( InitDataData%InData_MAP, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyInitOutput( InitDataData%OutData_MAP, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyInitInput( InitDataData%InData_FEAM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyInitOutput( InitDataData%OutData_FEAM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInitInput( InitDataData%InData_MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInitOutput( InitDataData%OutData_MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyInitInput( InitDataData%InData_Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyInitOutput( InitDataData%OutData_Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyInitInput( InitDataData%InData_IceF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyInitOutput( InitDataData%OutData_IceF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceD_DestroyInitInput( InitDataData%InData_IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceD_DestroyInitOutput( InitDataData%OutData_IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyInitData - - SUBROUTINE FAST_PackInitData( 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(FAST_InitData), 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 = 'FAST_PackInitData' - ! 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! InData_ED: size of buffers for each call to pack subtype - CALL ED_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ED, ErrStat2, ErrMsg2, .TRUE. ) ! InData_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_ED: size of buffers for each call to pack subtype - CALL ED_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ED, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_BD: size of buffers for each call to pack subtype - CALL BD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_BD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! OutData_BD allocated yes/no - IF ( ALLOCATED(InData%OutData_BD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutData_BD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OutData_BD,1), UBOUND(InData%OutData_BD,1) - Int_BufSz = Int_BufSz + 3 ! OutData_BD: size of buffers for each call to pack subtype - CALL BD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_BD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutData_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! InData_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_AD14: size of buffers for each call to pack subtype - CALL AD14_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD14, ErrStat2, ErrMsg2, .TRUE. ) ! InData_AD14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_AD14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_AD14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_AD14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_AD14: size of buffers for each call to pack subtype - CALL AD14_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD14, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_AD14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_AD14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_AD14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_AD14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_AD: size of buffers for each call to pack subtype - CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_AD: size of buffers for each call to pack subtype - CALL AD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IfW, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IfW, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_OpFM: size of buffers for each call to pack subtype - CALL OpFM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! InData_OpFM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_OpFM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_OpFM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_OpFM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_OpFM: size of buffers for each call to pack subtype - CALL OpFM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_OpFM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_OpFM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_OpFM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_OpFM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_SeaSt: size of buffers for each call to pack subtype - CALL SeaSt_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SeaSt, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SeaSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_SeaSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_SeaSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_SeaSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_SeaSt: size of buffers for each call to pack subtype - CALL SeaSt_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SeaSt, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SeaSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_SeaSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_SeaSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_SeaSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_HD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_HD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_SD: size of buffers for each call to pack subtype - CALL SD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_SD: size of buffers for each call to pack subtype - CALL SD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! InData_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_MAP: size of buffers for each call to pack subtype - CALL MAP_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MAP, ErrStat2, ErrMsg2, .TRUE. ) ! InData_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_MAP: size of buffers for each call to pack subtype - CALL MAP_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MAP, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! InData_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_MD: size of buffers for each call to pack subtype - CALL MD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_MD: size of buffers for each call to pack subtype - CALL MD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_Orca: size of buffers for each call to pack subtype - CALL Orca_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_Orca, ErrStat2, ErrMsg2, .TRUE. ) ! InData_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_Orca - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_Orca - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_Orca - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_Orca: size of buffers for each call to pack subtype - CALL Orca_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_Orca, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_Orca - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_Orca - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_Orca - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceF, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceF, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_IceD: size of buffers for each call to pack subtype - CALL IceD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_IceD: size of buffers for each call to pack subtype - CALL IceD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_IceD - 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 - - CALL ED_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ED, ErrStat2, ErrMsg2, OnlySize ) ! InData_ED - 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 - CALL ED_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ED, ErrStat2, ErrMsg2, OnlySize ) ! OutData_ED - 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 - CALL BD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_BD, ErrStat2, ErrMsg2, OnlySize ) ! InData_BD - 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 - IF ( .NOT. ALLOCATED(InData%OutData_BD) ) 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%OutData_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutData_BD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutData_BD,1), UBOUND(InData%OutData_BD,1) - CALL BD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_BD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutData_BD - 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 - CALL SrvD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SrvD, ErrStat2, ErrMsg2, OnlySize ) ! InData_SrvD - 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 - CALL SrvD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SrvD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SrvD - 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 - CALL AD14_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD14, ErrStat2, ErrMsg2, OnlySize ) ! InData_AD14 - 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 - CALL AD14_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD14, ErrStat2, ErrMsg2, OnlySize ) ! OutData_AD14 - 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 - CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD, ErrStat2, ErrMsg2, OnlySize ) ! InData_AD - 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 - CALL AD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_AD - 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 - CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IfW, ErrStat2, ErrMsg2, OnlySize ) ! InData_IfW - 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 - CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IfW, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IfW - 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 - CALL OpFM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_OpFM, ErrStat2, ErrMsg2, OnlySize ) ! InData_OpFM - 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 - CALL OpFM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_OpFM, ErrStat2, ErrMsg2, OnlySize ) ! OutData_OpFM - 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 - CALL SeaSt_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SeaSt, ErrStat2, ErrMsg2, OnlySize ) ! InData_SeaSt - 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 - CALL SeaSt_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SeaSt, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SeaSt - 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 - CALL HydroDyn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_HD, ErrStat2, ErrMsg2, OnlySize ) ! InData_HD - 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 - CALL HydroDyn_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_HD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_HD - 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 - CALL SD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SD, ErrStat2, ErrMsg2, OnlySize ) ! InData_SD - 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 - CALL SD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SD - 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 - CALL ExtPtfm_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! InData_ExtPtfm - 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 - CALL ExtPtfm_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! OutData_ExtPtfm - 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 - CALL MAP_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MAP, ErrStat2, ErrMsg2, OnlySize ) ! InData_MAP - 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 - CALL MAP_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MAP, ErrStat2, ErrMsg2, OnlySize ) ! OutData_MAP - 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 - CALL FEAM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_FEAM, ErrStat2, ErrMsg2, OnlySize ) ! InData_FEAM - 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 - CALL FEAM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_FEAM, ErrStat2, ErrMsg2, OnlySize ) ! OutData_FEAM - 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 - CALL MD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MD, ErrStat2, ErrMsg2, OnlySize ) ! InData_MD - 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 - CALL MD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_MD - 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 - CALL Orca_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_Orca, ErrStat2, ErrMsg2, OnlySize ) ! InData_Orca - 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 - CALL Orca_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_Orca, ErrStat2, ErrMsg2, OnlySize ) ! OutData_Orca - 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 - CALL IceFloe_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceF, ErrStat2, ErrMsg2, OnlySize ) ! InData_IceF - 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 - CALL IceFloe_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceF, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IceF - 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 - CALL IceD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceD, ErrStat2, ErrMsg2, OnlySize ) ! InData_IceD - 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 - CALL IceD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IceD - 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 FAST_PackInitData - - SUBROUTINE FAST_UnPackInitData( 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(FAST_InitData), 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 = 'FAST_UnPackInitData' - ! 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 - 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 ED_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_ED, ErrStat2, ErrMsg2 ) ! InData_ED - 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) - 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 ED_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_ED, ErrStat2, ErrMsg2 ) ! OutData_ED - 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) - 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 BD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_BD, ErrStat2, ErrMsg2 ) ! InData_BD - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutData_BD 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%OutData_BD)) DEALLOCATE(OutData%OutData_BD) - ALLOCATE(OutData%OutData_BD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutData_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutData_BD,1), UBOUND(OutData%OutData_BD,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 BD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_BD(i1), ErrStat2, ErrMsg2 ) ! OutData_BD - 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 - 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 SrvD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SrvD, ErrStat2, ErrMsg2 ) ! InData_SrvD - 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) - 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 SrvD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SrvD, ErrStat2, ErrMsg2 ) ! OutData_SrvD - 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) - 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 AD14_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_AD14, ErrStat2, ErrMsg2 ) ! InData_AD14 - 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) - 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 AD14_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_AD14, ErrStat2, ErrMsg2 ) ! OutData_AD14 - 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) - 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 AD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_AD, ErrStat2, ErrMsg2 ) ! InData_AD - 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) - 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 AD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_AD, ErrStat2, ErrMsg2 ) ! OutData_AD - 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) - 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 InflowWind_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IfW, ErrStat2, ErrMsg2 ) ! InData_IfW - 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) - 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 InflowWind_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IfW, ErrStat2, ErrMsg2 ) ! OutData_IfW - 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) - 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 OpFM_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_OpFM, ErrStat2, ErrMsg2 ) ! InData_OpFM - 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) - 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 OpFM_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_OpFM, ErrStat2, ErrMsg2 ) ! OutData_OpFM - 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) - 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_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SeaSt, ErrStat2, ErrMsg2 ) ! InData_SeaSt - 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) - 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_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SeaSt, ErrStat2, ErrMsg2 ) ! OutData_SeaSt - 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) - 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 HydroDyn_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_HD, ErrStat2, ErrMsg2 ) ! InData_HD - 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) - 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 HydroDyn_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_HD, ErrStat2, ErrMsg2 ) ! OutData_HD - 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) - 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 SD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SD, ErrStat2, ErrMsg2 ) ! InData_SD - 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) - 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 SD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SD, ErrStat2, ErrMsg2 ) ! OutData_SD - 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) - 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 ExtPtfm_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_ExtPtfm, ErrStat2, ErrMsg2 ) ! InData_ExtPtfm - 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) - 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 ExtPtfm_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_ExtPtfm, ErrStat2, ErrMsg2 ) ! OutData_ExtPtfm - 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) - 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 MAP_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_MAP, ErrStat2, ErrMsg2 ) ! InData_MAP - 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) - 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 MAP_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_MAP, ErrStat2, ErrMsg2 ) ! OutData_MAP - 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) - 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 FEAM_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_FEAM, ErrStat2, ErrMsg2 ) ! InData_FEAM - 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) - 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 FEAM_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_FEAM, ErrStat2, ErrMsg2 ) ! OutData_FEAM - 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) - 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 MD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_MD, ErrStat2, ErrMsg2 ) ! InData_MD - 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) - 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 MD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_MD, ErrStat2, ErrMsg2 ) ! OutData_MD - 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) - 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 Orca_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_Orca, ErrStat2, ErrMsg2 ) ! InData_Orca - 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) - 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 Orca_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_Orca, ErrStat2, ErrMsg2 ) ! OutData_Orca - 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) - 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 IceFloe_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IceF, ErrStat2, ErrMsg2 ) ! InData_IceF - 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) - 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 IceFloe_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IceF, ErrStat2, ErrMsg2 ) ! OutData_IceF - 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) - 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 IceD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IceD, ErrStat2, ErrMsg2 ) ! InData_IceD - 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) - 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 IceD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IceD, ErrStat2, ErrMsg2 ) ! OutData_IceD - 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 FAST_UnPackInitData - - SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ExternInitType), INTENT(IN) :: SrcExternInitTypeData - TYPE(FAST_ExternInitType), INTENT(INOUT) :: DstExternInitTypeData - 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 = 'FAST_CopyExternInitType' -! + ErrMsg = '' + LB(1:1) = lbound(AeroDyn_DataData%x) + UB(1:1) = ubound(AeroDyn_DataData%x) + do i1 = LB(1), UB(1) + call AD_DestroyContState(AeroDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDyn_DataData%xd) + UB(1:1) = ubound(AeroDyn_DataData%xd) + do i1 = LB(1), UB(1) + call AD_DestroyDiscState(AeroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDyn_DataData%z) + UB(1:1) = ubound(AeroDyn_DataData%z) + do i1 = LB(1), UB(1) + call AD_DestroyConstrState(AeroDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDyn_DataData%OtherSt) + UB(1:1) = ubound(AeroDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call AD_DestroyOtherState(AeroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call AD_DestroyParam(AeroDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyInput(AeroDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyOutput(AeroDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyMisc(AeroDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(AeroDyn_DataData%Output)) then + LB(1:1) = lbound(AeroDyn_DataData%Output) + UB(1:1) = ubound(AeroDyn_DataData%Output) + do i1 = LB(1), UB(1) + call AD_DestroyOutput(AeroDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn_DataData%Output) + end if + call AD_DestroyOutput(AeroDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(AeroDyn_DataData%Input)) then + LB(1:1) = lbound(AeroDyn_DataData%Input) + UB(1:1) = ubound(AeroDyn_DataData%Input) + do i1 = LB(1), UB(1) + call AD_DestroyInput(AeroDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn_DataData%Input) + end if + if (allocated(AeroDyn_DataData%InputTimes)) then + deallocate(AeroDyn_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackAeroDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AeroDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackAeroDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call AD_PackContState(Buf, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call AD_PackDiscState(Buf, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call AD_PackConstrState(Buf, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call AD_PackOtherState(Buf, InData%OtherSt(i1)) + end do + call AD_PackParam(Buf, InData%p) + call AD_PackInput(Buf, InData%u) + call AD_PackOutput(Buf, InData%y) + call AD_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call AD_PackOutput(Buf, InData%Output(i1)) + end do + end if + call AD_PackOutput(Buf, InData%y_interp) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call AD_PackInput(Buf, InData%Input(i1)) + end do + end if + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackAeroDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AeroDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackAeroDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call AD_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call AD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call AD_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call AD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call AD_UnpackParam(Buf, OutData%p) ! p + call AD_UnpackInput(Buf, OutData%u) ! u + call AD_UnpackOutput(Buf, OutData%y) ! y + call AD_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + call AD_UnpackOutput(Buf, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_Data), intent(in) :: SrcInflowWind_DataData + type(InflowWind_Data), intent(inout) :: DstInflowWind_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyInflowWind_Data' ErrStat = ErrID_None - ErrMsg = "" - DstExternInitTypeData%Tmax = SrcExternInitTypeData%Tmax - DstExternInitTypeData%SensorType = SrcExternInitTypeData%SensorType - DstExternInitTypeData%LidRadialVel = SrcExternInitTypeData%LidRadialVel - DstExternInitTypeData%TurbineID = SrcExternInitTypeData%TurbineID - DstExternInitTypeData%TurbinePos = SrcExternInitTypeData%TurbinePos - DstExternInitTypeData%WaveFieldMod = SrcExternInitTypeData%WaveFieldMod - DstExternInitTypeData%NumSC2CtrlGlob = SrcExternInitTypeData%NumSC2CtrlGlob - DstExternInitTypeData%NumSC2Ctrl = SrcExternInitTypeData%NumSC2Ctrl - DstExternInitTypeData%NumCtrl2SC = SrcExternInitTypeData%NumCtrl2SC -IF (ALLOCATED(SrcExternInitTypeData%fromSCGlob)) THEN - i1_l = LBOUND(SrcExternInitTypeData%fromSCGlob,1) - i1_u = UBOUND(SrcExternInitTypeData%fromSCGlob,1) - IF (.NOT. ALLOCATED(DstExternInitTypeData%fromSCGlob)) THEN - ALLOCATE(DstExternInitTypeData%fromSCGlob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExternInitTypeData%fromSCGlob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstExternInitTypeData%fromSCGlob = SrcExternInitTypeData%fromSCGlob -ENDIF -IF (ALLOCATED(SrcExternInitTypeData%fromSC)) THEN - i1_l = LBOUND(SrcExternInitTypeData%fromSC,1) - i1_u = UBOUND(SrcExternInitTypeData%fromSC,1) - IF (.NOT. ALLOCATED(DstExternInitTypeData%fromSC)) THEN - ALLOCATE(DstExternInitTypeData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExternInitTypeData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstExternInitTypeData%fromSC = SrcExternInitTypeData%fromSC -ENDIF - DstExternInitTypeData%FarmIntegration = SrcExternInitTypeData%FarmIntegration - DstExternInitTypeData%windGrid_n = SrcExternInitTypeData%windGrid_n - DstExternInitTypeData%windGrid_delta = SrcExternInitTypeData%windGrid_delta - DstExternInitTypeData%windGrid_pZero = SrcExternInitTypeData%windGrid_pZero - DstExternInitTypeData%windGrid_data => SrcExternInitTypeData%windGrid_data - DstExternInitTypeData%RootName = SrcExternInitTypeData%RootName - DstExternInitTypeData%NumActForcePtsBlade = SrcExternInitTypeData%NumActForcePtsBlade - DstExternInitTypeData%NumActForcePtsTower = SrcExternInitTypeData%NumActForcePtsTower - DstExternInitTypeData%NodeClusterType = SrcExternInitTypeData%NodeClusterType - END SUBROUTINE FAST_CopyExternInitType - - SUBROUTINE FAST_DestroyExternInitType( ExternInitTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ExternInitType), INTENT(INOUT) :: ExternInitTypeData - 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 = 'FAST_DestroyExternInitType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ExternInitTypeData%fromSCGlob)) THEN - DEALLOCATE(ExternInitTypeData%fromSCGlob) -ENDIF -IF (ALLOCATED(ExternInitTypeData%fromSC)) THEN - DEALLOCATE(ExternInitTypeData%fromSC) -ENDIF -NULLIFY(ExternInitTypeData%windGrid_data) - END SUBROUTINE FAST_DestroyExternInitType - - SUBROUTINE FAST_PackExternInitType( 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(FAST_ExternInitType), 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 = 'FAST_PackExternInitType' - ! 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 ! Tmax - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! LidRadialVel - Int_BufSz = Int_BufSz + 1 ! TurbineID - Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! fromSCGlob allocated yes/no - IF ( ALLOCATED(InData%fromSCGlob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCGlob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCGlob) ! fromSCGlob - END IF - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ALLOCATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - END IF - Int_BufSz = Int_BufSz + 1 ! FarmIntegration - Int_BufSz = Int_BufSz + SIZE(InData%windGrid_n) ! windGrid_n - Re_BufSz = Re_BufSz + SIZE(InData%windGrid_delta) ! windGrid_delta - Re_BufSz = Re_BufSz + SIZE(InData%windGrid_pZero) ! windGrid_pZero - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! NumActForcePtsBlade - Int_BufSz = Int_BufSz + 1 ! NumActForcePtsTower - Int_BufSz = Int_BufSz + 1 ! NodeClusterType - 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%Tmax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TurbineID - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) - ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%fromSCGlob) ) 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%fromSCGlob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCGlob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCGlob,1), UBOUND(InData%fromSCGlob,1) - ReKiBuf(Re_Xferred) = InData%fromSCGlob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fromSC) ) 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%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%FarmIntegration, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%windGrid_n,1), UBOUND(InData%windGrid_n,1) - IntKiBuf(Int_Xferred) = InData%windGrid_n(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%windGrid_delta,1), UBOUND(InData%windGrid_delta,1) - ReKiBuf(Re_Xferred) = InData%windGrid_delta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%windGrid_pZero,1), UBOUND(InData%windGrid_pZero,1) - ReKiBuf(Re_Xferred) = InData%windGrid_pZero(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NumActForcePtsBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumActForcePtsTower - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NodeClusterType - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_PackExternInitType - - SUBROUTINE FAST_UnPackExternInitType( 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(FAST_ExternInitType), 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 = 'FAST_UnPackExternInitType' - ! 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%Tmax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TurbinePos,1) - i1_u = UBOUND(OutData%TurbinePos,1) - DO i1 = LBOUND(OutData%TurbinePos,1), UBOUND(OutData%TurbinePos,1) - OutData%TurbinePos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCGlob 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%fromSCGlob)) DEALLOCATE(OutData%fromSCGlob) - ALLOCATE(OutData%fromSCGlob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCGlob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSCGlob,1), UBOUND(OutData%fromSCGlob,1) - OutData%fromSCGlob(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC 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%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%FarmIntegration = TRANSFER(IntKiBuf(Int_Xferred), OutData%FarmIntegration) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%windGrid_n,1) - i1_u = UBOUND(OutData%windGrid_n,1) - DO i1 = LBOUND(OutData%windGrid_n,1), UBOUND(OutData%windGrid_n,1) - OutData%windGrid_n(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%windGrid_delta,1) - i1_u = UBOUND(OutData%windGrid_delta,1) - DO i1 = LBOUND(OutData%windGrid_delta,1), UBOUND(OutData%windGrid_delta,1) - OutData%windGrid_delta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%windGrid_pZero,1) - i1_u = UBOUND(OutData%windGrid_pZero,1) - DO i1 = LBOUND(OutData%windGrid_pZero,1), UBOUND(OutData%windGrid_pZero,1) - OutData%windGrid_pZero(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - NULLIFY(OutData%windGrid_data) - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumActForcePtsBlade = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumActForcePtsTower = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NodeClusterType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_UnPackExternInitType - - SUBROUTINE FAST_CopyTurbineType( SrcTurbineTypeData, DstTurbineTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_TurbineType), INTENT(INOUT) :: SrcTurbineTypeData - TYPE(FAST_TurbineType), INTENT(INOUT) :: DstTurbineTypeData - 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 = 'FAST_CopyTurbineType' -! + ErrMsg = '' + LB(1:1) = lbound(SrcInflowWind_DataData%x) + UB(1:1) = ubound(SrcInflowWind_DataData%x) + do i1 = LB(1), UB(1) + call InflowWind_CopyContState(SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcInflowWind_DataData%xd) + UB(1:1) = ubound(SrcInflowWind_DataData%xd) + do i1 = LB(1), UB(1) + call InflowWind_CopyDiscState(SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcInflowWind_DataData%z) + UB(1:1) = ubound(SrcInflowWind_DataData%z) + do i1 = LB(1), UB(1) + call InflowWind_CopyConstrState(SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcInflowWind_DataData%OtherSt) + UB(1:1) = ubound(SrcInflowWind_DataData%OtherSt) + do i1 = LB(1), UB(1) + call InflowWind_CopyOtherState(SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call InflowWind_CopyParam(SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyMisc(SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInflowWind_DataData%Output)) then + LB(1:1) = lbound(SrcInflowWind_DataData%Output) + UB(1:1) = ubound(SrcInflowWind_DataData%Output) + if (.not. allocated(DstInflowWind_DataData%Output)) then + allocate(DstInflowWind_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyOutput(SrcInflowWind_DataData%Output(i1), DstInflowWind_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call InflowWind_CopyOutput(SrcInflowWind_DataData%y_interp, DstInflowWind_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInflowWind_DataData%Input)) then + LB(1:1) = lbound(SrcInflowWind_DataData%Input) + UB(1:1) = ubound(SrcInflowWind_DataData%Input) + if (.not. allocated(DstInflowWind_DataData%Input)) then + allocate(DstInflowWind_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyInput(SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInflowWind_DataData%InputTimes)) then + LB(1:1) = lbound(SrcInflowWind_DataData%InputTimes) + UB(1:1) = ubound(SrcInflowWind_DataData%InputTimes) + if (.not. allocated(DstInflowWind_DataData%InputTimes)) then + allocate(DstInflowWind_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) + type(InflowWind_Data), intent(inout) :: InflowWind_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyInflowWind_Data' ErrStat = ErrID_None - ErrMsg = "" - DstTurbineTypeData%TurbID = SrcTurbineTypeData%TurbID - CALL FAST_CopyParam( SrcTurbineTypeData%p_FAST, DstTurbineTypeData%p_FAST, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyoutputfiletype( SrcTurbineTypeData%y_FAST, DstTurbineTypeData%y_FAST, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_CopyMisc( SrcTurbineTypeData%m_FAST, DstTurbineTypeData%m_FAST, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copymodulemaptype( SrcTurbineTypeData%MeshMapData, DstTurbineTypeData%MeshMapData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyelastodyn_data( SrcTurbineTypeData%ED, DstTurbineTypeData%ED, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copybeamdyn_data( SrcTurbineTypeData%BD, DstTurbineTypeData%BD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyservodyn_data( SrcTurbineTypeData%SrvD, DstTurbineTypeData%SrvD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyaerodyn_data( SrcTurbineTypeData%AD, DstTurbineTypeData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyaerodyn14_data( SrcTurbineTypeData%AD14, DstTurbineTypeData%AD14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyinflowwind_data( SrcTurbineTypeData%IfW, DstTurbineTypeData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyopenfoam_data( SrcTurbineTypeData%OpFM, DstTurbineTypeData%OpFM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyscdataex_data( SrcTurbineTypeData%SC_DX, DstTurbineTypeData%SC_DX, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyseastate_data( SrcTurbineTypeData%SeaSt, DstTurbineTypeData%SeaSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyhydrodyn_data( SrcTurbineTypeData%HD, DstTurbineTypeData%HD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copysubdyn_data( SrcTurbineTypeData%SD, DstTurbineTypeData%SD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copymap_data( SrcTurbineTypeData%MAP, DstTurbineTypeData%MAP, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyfeamooring_data( SrcTurbineTypeData%FEAM, DstTurbineTypeData%FEAM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copymoordyn_data( SrcTurbineTypeData%MD, DstTurbineTypeData%MD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyorcaflex_data( SrcTurbineTypeData%Orca, DstTurbineTypeData%Orca, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyicefloe_data( SrcTurbineTypeData%IceF, DstTurbineTypeData%IceF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyicedyn_data( SrcTurbineTypeData%IceD, DstTurbineTypeData%IceD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyextptfm_data( SrcTurbineTypeData%ExtPtfm, DstTurbineTypeData%ExtPtfm, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyTurbineType - - SUBROUTINE FAST_DestroyTurbineType( TurbineTypeData, ErrStat, ErrMsg ) - TYPE(FAST_TurbineType), INTENT(INOUT) :: TurbineTypeData - 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 = 'FAST_DestroyTurbineType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL FAST_DestroyParam( TurbineTypeData%p_FAST, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyOutputFileType( TurbineTypeData%y_FAST, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyMisc( TurbineTypeData%m_FAST, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyModuleMapType( TurbineTypeData%MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyElastoDyn_Data( TurbineTypeData%ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyBeamDyn_Data( TurbineTypeData%BD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyServoDyn_Data( TurbineTypeData%SrvD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyAeroDyn_Data( TurbineTypeData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyAeroDyn14_Data( TurbineTypeData%AD14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyInflowWind_Data( TurbineTypeData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyOpenFOAM_Data( TurbineTypeData%OpFM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroySCDataEx_Data( TurbineTypeData%SC_DX, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroySeaState_Data( TurbineTypeData%SeaSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyHydroDyn_Data( TurbineTypeData%HD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroySubDyn_Data( TurbineTypeData%SD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyMAP_Data( TurbineTypeData%MAP, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyFEAMooring_Data( TurbineTypeData%FEAM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyMoorDyn_Data( TurbineTypeData%MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyOrcaFlex_Data( TurbineTypeData%Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyIceFloe_Data( TurbineTypeData%IceF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyIceDyn_Data( TurbineTypeData%IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyExtPtfm_Data( TurbineTypeData%ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyTurbineType - - SUBROUTINE FAST_PackTurbineType( 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(FAST_TurbineType), 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 = 'FAST_PackTurbineType' - ! 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 ! TurbID - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! p_FAST: size of buffers for each call to pack subtype - CALL FAST_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_FAST, ErrStat2, ErrMsg2, .TRUE. ) ! p_FAST - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p_FAST - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p_FAST - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p_FAST - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_FAST - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_FAST - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_FAST - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m_FAST: size of buffers for each call to pack subtype - CALL FAST_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_FAST, ErrStat2, ErrMsg2, .TRUE. ) ! m_FAST - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m_FAST - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m_FAST - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m_FAST - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MeshMapData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MeshMapData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MeshMapData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OpFM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OpFM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OpFM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SC_DX - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SC_DX - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SC_DX - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Orca - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Orca - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Orca - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ExtPtfm - 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 - - IntKiBuf(Int_Xferred) = InData%TurbID - Int_Xferred = Int_Xferred + 1 - CALL FAST_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_FAST, ErrStat2, ErrMsg2, OnlySize ) ! p_FAST - 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 - 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 - - 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 - CALL FAST_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_FAST, ErrStat2, ErrMsg2, OnlySize ) ! m_FAST - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 - 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 - - 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 FAST_PackTurbineType - - SUBROUTINE FAST_UnPackTurbineType( 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(FAST_TurbineType), 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 = 'FAST_UnPackTurbineType' - ! 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%TurbID = 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 FAST_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p_FAST, ErrStat2, ErrMsg2 ) ! p_FAST - 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) - 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 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 - - 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 FAST_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m_FAST, ErrStat2, ErrMsg2 ) ! m_FAST - 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) - 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 FAST_UnpackModuleMapType( Re_Buf, Db_Buf, Int_Buf, OutData%MeshMapData, ErrStat2, ErrMsg2 ) ! MeshMapData - 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) - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackTurbineType - + ErrMsg = '' + LB(1:1) = lbound(InflowWind_DataData%x) + UB(1:1) = ubound(InflowWind_DataData%x) + do i1 = LB(1), UB(1) + call InflowWind_DestroyContState(InflowWind_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(InflowWind_DataData%xd) + UB(1:1) = ubound(InflowWind_DataData%xd) + do i1 = LB(1), UB(1) + call InflowWind_DestroyDiscState(InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(InflowWind_DataData%z) + UB(1:1) = ubound(InflowWind_DataData%z) + do i1 = LB(1), UB(1) + call InflowWind_DestroyConstrState(InflowWind_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(InflowWind_DataData%OtherSt) + UB(1:1) = ubound(InflowWind_DataData%OtherSt) + do i1 = LB(1), UB(1) + call InflowWind_DestroyOtherState(InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call InflowWind_DestroyParam(InflowWind_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInput(InflowWind_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(InflowWind_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyMisc(InflowWind_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InflowWind_DataData%Output)) then + LB(1:1) = lbound(InflowWind_DataData%Output) + UB(1:1) = ubound(InflowWind_DataData%Output) + do i1 = LB(1), UB(1) + call InflowWind_DestroyOutput(InflowWind_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowWind_DataData%Output) + end if + call InflowWind_DestroyOutput(InflowWind_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InflowWind_DataData%Input)) then + LB(1:1) = lbound(InflowWind_DataData%Input) + UB(1:1) = ubound(InflowWind_DataData%Input) + do i1 = LB(1), UB(1) + call InflowWind_DestroyInput(InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowWind_DataData%Input) + end if + if (allocated(InflowWind_DataData%InputTimes)) then + deallocate(InflowWind_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackInflowWind_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackInflowWind_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call InflowWind_PackContState(Buf, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call InflowWind_PackDiscState(Buf, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call InflowWind_PackConstrState(Buf, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call InflowWind_PackOtherState(Buf, InData%OtherSt(i1)) + end do + call InflowWind_PackParam(Buf, InData%p) + call InflowWind_PackInput(Buf, InData%u) + call InflowWind_PackOutput(Buf, InData%y) + call InflowWind_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call InflowWind_PackOutput(Buf, InData%Output(i1)) + end do + end if + call InflowWind_PackOutput(Buf, InData%y_interp) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call InflowWind_PackInput(Buf, InData%Input(i1)) + end do + end if + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackInflowWind_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackInflowWind_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call InflowWind_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call InflowWind_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call InflowWind_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call InflowWind_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call InflowWind_UnpackParam(Buf, OutData%p) ! p + call InflowWind_UnpackInput(Buf, OutData%u) ! u + call InflowWind_UnpackOutput(Buf, OutData%y) ! y + call InflowWind_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + call InflowWind_UnpackOutput(Buf, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyOpenFOAM_Data(SrcOpenFOAM_DataData, DstOpenFOAM_DataData, CtrlCode, ErrStat, ErrMsg) + type(OpenFOAM_Data), intent(inout) :: SrcOpenFOAM_DataData + type(OpenFOAM_Data), intent(inout) :: DstOpenFOAM_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyOpenFOAM_Data' + ErrStat = ErrID_None + ErrMsg = '' + call OpFM_CopyInput(SrcOpenFOAM_DataData%u, DstOpenFOAM_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call OpFM_CopyOutput(SrcOpenFOAM_DataData%y, DstOpenFOAM_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call OpFM_CopyParam(SrcOpenFOAM_DataData%p, DstOpenFOAM_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call OpFM_CopyMisc(SrcOpenFOAM_DataData%m, DstOpenFOAM_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FAST_DestroyOpenFOAM_Data(OpenFOAM_DataData, ErrStat, ErrMsg) + type(OpenFOAM_Data), intent(inout) :: OpenFOAM_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyOpenFOAM_Data' + ErrStat = ErrID_None + ErrMsg = '' + call OpFM_DestroyInput(OpenFOAM_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call OpFM_DestroyOutput(OpenFOAM_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call OpFM_DestroyParam(OpenFOAM_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call OpFM_DestroyMisc(OpenFOAM_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackOpenFOAM_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OpenFOAM_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackOpenFOAM_Data' + if (Buf%ErrStat >= AbortErrLev) return + call OpFM_PackInput(Buf, InData%u) + call OpFM_PackOutput(Buf, InData%y) + call OpFM_PackParam(Buf, InData%p) + call OpFM_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackOpenFOAM_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OpenFOAM_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackOpenFOAM_Data' + if (Buf%ErrStat /= ErrID_None) return + call OpFM_UnpackInput(Buf, OutData%u) ! u + call OpFM_UnpackOutput(Buf, OutData%y) ! y + call OpFM_UnpackParam(Buf, OutData%p) ! p + call OpFM_UnpackMisc(Buf, OutData%m) ! m +end subroutine + +subroutine FAST_CopySCDataEx_Data(SrcSCDataEx_DataData, DstSCDataEx_DataData, CtrlCode, ErrStat, ErrMsg) + type(SCDataEx_Data), intent(in) :: SrcSCDataEx_DataData + type(SCDataEx_Data), intent(inout) :: DstSCDataEx_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopySCDataEx_Data' + ErrStat = ErrID_None + ErrMsg = '' + call SC_DX_CopyInput(SrcSCDataEx_DataData%u, DstSCDataEx_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_DX_CopyOutput(SrcSCDataEx_DataData%y, DstSCDataEx_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_DX_CopyParam(SrcSCDataEx_DataData%p, DstSCDataEx_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FAST_DestroySCDataEx_Data(SCDataEx_DataData, ErrStat, ErrMsg) + type(SCDataEx_Data), intent(inout) :: SCDataEx_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroySCDataEx_Data' + ErrStat = ErrID_None + ErrMsg = '' + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DX_DestroyParam(SCDataEx_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackSCDataEx_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SCDataEx_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSCDataEx_Data' + if (Buf%ErrStat >= AbortErrLev) return + call SC_DX_PackInput(Buf, InData%u) + call SC_DX_PackOutput(Buf, InData%y) + call SC_DX_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSCDataEx_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SCDataEx_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSCDataEx_Data' + if (Buf%ErrStat /= ErrID_None) return + call SC_DX_UnpackInput(Buf, OutData%u) ! u + call SC_DX_UnpackOutput(Buf, OutData%y) ! y + call SC_DX_UnpackParam(Buf, OutData%p) ! p +end subroutine + +subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(SubDyn_Data), intent(inout) :: SrcSubDyn_DataData + type(SubDyn_Data), intent(inout) :: DstSubDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopySubDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcSubDyn_DataData%x) + UB(1:1) = ubound(SrcSubDyn_DataData%x) + do i1 = LB(1), UB(1) + call SD_CopyContState(SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcSubDyn_DataData%xd) + UB(1:1) = ubound(SrcSubDyn_DataData%xd) + do i1 = LB(1), UB(1) + call SD_CopyDiscState(SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcSubDyn_DataData%z) + UB(1:1) = ubound(SrcSubDyn_DataData%z) + do i1 = LB(1), UB(1) + call SD_CopyConstrState(SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcSubDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcSubDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SD_CopyOtherState(SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call SD_CopyParam(SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyInput(SrcSubDyn_DataData%u, DstSubDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyOutput(SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyMisc(SrcSubDyn_DataData%m, DstSubDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSubDyn_DataData%Input)) then + LB(1:1) = lbound(SrcSubDyn_DataData%Input) + UB(1:1) = ubound(SrcSubDyn_DataData%Input) + if (.not. allocated(DstSubDyn_DataData%Input)) then + allocate(DstSubDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyInput(SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSubDyn_DataData%Output)) then + LB(1:1) = lbound(SrcSubDyn_DataData%Output) + UB(1:1) = ubound(SrcSubDyn_DataData%Output) + if (.not. allocated(DstSubDyn_DataData%Output)) then + allocate(DstSubDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyOutput(SrcSubDyn_DataData%Output(i1), DstSubDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call SD_CopyOutput(SrcSubDyn_DataData%y_interp, DstSubDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSubDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcSubDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcSubDyn_DataData%InputTimes) + if (.not. allocated(DstSubDyn_DataData%InputTimes)) then + allocate(DstSubDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) + type(SubDyn_Data), intent(inout) :: SubDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroySubDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SubDyn_DataData%x) + UB(1:1) = ubound(SubDyn_DataData%x) + do i1 = LB(1), UB(1) + call SD_DestroyContState(SubDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SubDyn_DataData%xd) + UB(1:1) = ubound(SubDyn_DataData%xd) + do i1 = LB(1), UB(1) + call SD_DestroyDiscState(SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SubDyn_DataData%z) + UB(1:1) = ubound(SubDyn_DataData%z) + do i1 = LB(1), UB(1) + call SD_DestroyConstrState(SubDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SubDyn_DataData%OtherSt) + UB(1:1) = ubound(SubDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SD_DestroyOtherState(SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call SD_DestroyParam(SubDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyInput(SubDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyOutput(SubDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyMisc(SubDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(SubDyn_DataData%Input)) then + LB(1:1) = lbound(SubDyn_DataData%Input) + UB(1:1) = ubound(SubDyn_DataData%Input) + do i1 = LB(1), UB(1) + call SD_DestroyInput(SubDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%Input) + end if + if (allocated(SubDyn_DataData%Output)) then + LB(1:1) = lbound(SubDyn_DataData%Output) + UB(1:1) = ubound(SubDyn_DataData%Output) + do i1 = LB(1), UB(1) + call SD_DestroyOutput(SubDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%Output) + end if + 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) + end if +end subroutine + +subroutine FAST_PackSubDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SubDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSubDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SD_PackContState(Buf, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SD_PackDiscState(Buf, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SD_PackConstrState(Buf, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call SD_PackOtherState(Buf, InData%OtherSt(i1)) + end do + call SD_PackParam(Buf, InData%p) + call SD_PackInput(Buf, InData%u) + call SD_PackOutput(Buf, InData%y) + call SD_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call SD_PackInput(Buf, InData%Input(i1)) + end do + end if + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call SD_PackOutput(Buf, InData%Output(i1)) + end do + end if + call SD_PackOutput(Buf, InData%y_interp) + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSubDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SubDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSubDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call SD_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call SD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call SD_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call SD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call SD_UnpackParam(Buf, OutData%p) ! p + call SD_UnpackInput(Buf, OutData%u) ! u + call SD_UnpackOutput(Buf, OutData%y) ! y + call SD_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + call SD_UnpackOutput(Buf, OutData%y_interp) ! y_interp + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_Data), intent(inout) :: SrcExtPtfm_DataData + type(ExtPtfm_Data), intent(inout) :: DstExtPtfm_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyExtPtfm_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcExtPtfm_DataData%x) + UB(1:1) = ubound(SrcExtPtfm_DataData%x) + do i1 = LB(1), UB(1) + call ExtPtfm_CopyContState(SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcExtPtfm_DataData%xd) + UB(1:1) = ubound(SrcExtPtfm_DataData%xd) + do i1 = LB(1), UB(1) + call ExtPtfm_CopyDiscState(SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcExtPtfm_DataData%z) + UB(1:1) = ubound(SrcExtPtfm_DataData%z) + do i1 = LB(1), UB(1) + call ExtPtfm_CopyConstrState(SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcExtPtfm_DataData%OtherSt) + UB(1:1) = ubound(SrcExtPtfm_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ExtPtfm_CopyOtherState(SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call ExtPtfm_CopyParam(SrcExtPtfm_DataData%p, DstExtPtfm_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyInput(SrcExtPtfm_DataData%u, DstExtPtfm_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyOutput(SrcExtPtfm_DataData%y, DstExtPtfm_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyMisc(SrcExtPtfm_DataData%m, DstExtPtfm_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcExtPtfm_DataData%Input)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%Input) + UB(1:1) = ubound(SrcExtPtfm_DataData%Input) + if (.not. allocated(DstExtPtfm_DataData%Input)) then + allocate(DstExtPtfm_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyInput(SrcExtPtfm_DataData%Input(i1), DstExtPtfm_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcExtPtfm_DataData%InputTimes)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%InputTimes) + UB(1:1) = ubound(SrcExtPtfm_DataData%InputTimes) + if (.not. allocated(DstExtPtfm_DataData%InputTimes)) then + allocate(DstExtPtfm_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) + type(ExtPtfm_Data), intent(inout) :: ExtPtfm_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyExtPtfm_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(ExtPtfm_DataData%x) + UB(1:1) = ubound(ExtPtfm_DataData%x) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyContState(ExtPtfm_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ExtPtfm_DataData%xd) + UB(1:1) = ubound(ExtPtfm_DataData%xd) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyDiscState(ExtPtfm_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ExtPtfm_DataData%z) + UB(1:1) = ubound(ExtPtfm_DataData%z) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyConstrState(ExtPtfm_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ExtPtfm_DataData%OtherSt) + UB(1:1) = ubound(ExtPtfm_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyOtherState(ExtPtfm_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call ExtPtfm_DestroyParam(ExtPtfm_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyInput(ExtPtfm_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyOutput(ExtPtfm_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyMisc(ExtPtfm_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ExtPtfm_DataData%Input)) then + LB(1:1) = lbound(ExtPtfm_DataData%Input) + UB(1:1) = ubound(ExtPtfm_DataData%Input) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyInput(ExtPtfm_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ExtPtfm_DataData%Input) + end if + if (allocated(ExtPtfm_DataData%InputTimes)) then + deallocate(ExtPtfm_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackExtPtfm_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackExtPtfm_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call ExtPtfm_PackContState(Buf, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call ExtPtfm_PackDiscState(Buf, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call ExtPtfm_PackConstrState(Buf, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call ExtPtfm_PackOtherState(Buf, InData%OtherSt(i1)) + end do + call ExtPtfm_PackParam(Buf, InData%p) + call ExtPtfm_PackInput(Buf, InData%u) + call ExtPtfm_PackOutput(Buf, InData%y) + call ExtPtfm_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call ExtPtfm_PackInput(Buf, InData%Input(i1)) + end do + end if + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackExtPtfm_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackExtPtfm_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call ExtPtfm_UnpackParam(Buf, OutData%p) ! p + call ExtPtfm_UnpackInput(Buf, OutData%u) ! u + call ExtPtfm_UnpackOutput(Buf, OutData%y) ! y + call ExtPtfm_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg) + type(SeaState_Data), intent(in) :: SrcSeaState_DataData + type(SeaState_Data), intent(inout) :: DstSeaState_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopySeaState_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcSeaState_DataData%x) + UB(1:1) = ubound(SrcSeaState_DataData%x) + do i1 = LB(1), UB(1) + call SeaSt_CopyContState(SrcSeaState_DataData%x(i1), DstSeaState_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcSeaState_DataData%xd) + UB(1:1) = ubound(SrcSeaState_DataData%xd) + do i1 = LB(1), UB(1) + call SeaSt_CopyDiscState(SrcSeaState_DataData%xd(i1), DstSeaState_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcSeaState_DataData%z) + UB(1:1) = ubound(SrcSeaState_DataData%z) + do i1 = LB(1), UB(1) + call SeaSt_CopyConstrState(SrcSeaState_DataData%z(i1), DstSeaState_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcSeaState_DataData%OtherSt) + UB(1:1) = ubound(SrcSeaState_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SeaSt_CopyOtherState(SrcSeaState_DataData%OtherSt(i1), DstSeaState_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call SeaSt_CopyParam(SrcSeaState_DataData%p, DstSeaState_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInput(SrcSeaState_DataData%u, DstSeaState_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyOutput(SrcSeaState_DataData%y, DstSeaState_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyMisc(SrcSeaState_DataData%m, DstSeaState_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSeaState_DataData%Input)) then + LB(1:1) = lbound(SrcSeaState_DataData%Input) + UB(1:1) = ubound(SrcSeaState_DataData%Input) + if (.not. allocated(DstSeaState_DataData%Input)) then + allocate(DstSeaState_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyInput(SrcSeaState_DataData%Input(i1), DstSeaState_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSeaState_DataData%Output)) then + LB(1:1) = lbound(SrcSeaState_DataData%Output) + UB(1:1) = ubound(SrcSeaState_DataData%Output) + if (.not. allocated(DstSeaState_DataData%Output)) then + allocate(DstSeaState_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyOutput(SrcSeaState_DataData%Output(i1), DstSeaState_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call SeaSt_CopyOutput(SrcSeaState_DataData%y_interp, DstSeaState_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSeaState_DataData%InputTimes)) then + LB(1:1) = lbound(SrcSeaState_DataData%InputTimes) + UB(1:1) = ubound(SrcSeaState_DataData%InputTimes) + if (.not. allocated(DstSeaState_DataData%InputTimes)) then + allocate(DstSeaState_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaState_DataData%InputTimes = SrcSeaState_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) + type(SeaState_Data), intent(inout) :: SeaState_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroySeaState_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SeaState_DataData%x) + UB(1:1) = ubound(SeaState_DataData%x) + do i1 = LB(1), UB(1) + call SeaSt_DestroyContState(SeaState_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SeaState_DataData%xd) + UB(1:1) = ubound(SeaState_DataData%xd) + do i1 = LB(1), UB(1) + call SeaSt_DestroyDiscState(SeaState_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SeaState_DataData%z) + UB(1:1) = ubound(SeaState_DataData%z) + do i1 = LB(1), UB(1) + call SeaSt_DestroyConstrState(SeaState_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SeaState_DataData%OtherSt) + UB(1:1) = ubound(SeaState_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SeaSt_DestroyOtherState(SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call SeaSt_DestroyParam(SeaState_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInput(SeaState_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyOutput(SeaState_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyMisc(SeaState_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(SeaState_DataData%Input)) then + LB(1:1) = lbound(SeaState_DataData%Input) + UB(1:1) = ubound(SeaState_DataData%Input) + do i1 = LB(1), UB(1) + call SeaSt_DestroyInput(SeaState_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%Input) + end if + if (allocated(SeaState_DataData%Output)) then + LB(1:1) = lbound(SeaState_DataData%Output) + UB(1:1) = ubound(SeaState_DataData%Output) + do i1 = LB(1), UB(1) + call SeaSt_DestroyOutput(SeaState_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%Output) + end if + 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) + end if +end subroutine + +subroutine FAST_PackSeaState_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaState_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSeaState_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SeaSt_PackContState(Buf, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SeaSt_PackDiscState(Buf, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SeaSt_PackConstrState(Buf, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call SeaSt_PackOtherState(Buf, InData%OtherSt(i1)) + end do + call SeaSt_PackParam(Buf, InData%p) + call SeaSt_PackInput(Buf, InData%u) + call SeaSt_PackOutput(Buf, InData%y) + call SeaSt_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call SeaSt_PackInput(Buf, InData%Input(i1)) + end do + end if + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call SeaSt_PackOutput(Buf, InData%Output(i1)) + end do + end if + call SeaSt_PackOutput(Buf, InData%y_interp) + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSeaState_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaState_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSeaState_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call SeaSt_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call SeaSt_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call SeaSt_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call SeaSt_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call SeaSt_UnpackParam(Buf, OutData%p) ! p + call SeaSt_UnpackInput(Buf, OutData%u) ! u + call SeaSt_UnpackOutput(Buf, OutData%y) ! y + call SeaSt_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + call SeaSt_UnpackOutput(Buf, OutData%y_interp) ! y_interp + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_Data), intent(inout) :: SrcHydroDyn_DataData + type(HydroDyn_Data), intent(inout) :: DstHydroDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyHydroDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcHydroDyn_DataData%x) + UB(1:1) = ubound(SrcHydroDyn_DataData%x) + do i1 = LB(1), UB(1) + call HydroDyn_CopyContState(SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcHydroDyn_DataData%xd) + UB(1:1) = ubound(SrcHydroDyn_DataData%xd) + do i1 = LB(1), UB(1) + call HydroDyn_CopyDiscState(SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcHydroDyn_DataData%z) + UB(1:1) = ubound(SrcHydroDyn_DataData%z) + do i1 = LB(1), UB(1) + call HydroDyn_CopyConstrState(SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcHydroDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcHydroDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call HydroDyn_CopyOtherState(SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call HydroDyn_CopyParam(SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyInput(SrcHydroDyn_DataData%u, DstHydroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyOutput(SrcHydroDyn_DataData%y, DstHydroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyMisc(SrcHydroDyn_DataData%m, DstHydroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcHydroDyn_DataData%Output)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%Output) + UB(1:1) = ubound(SrcHydroDyn_DataData%Output) + if (.not. allocated(DstHydroDyn_DataData%Output)) then + allocate(DstHydroDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyOutput(SrcHydroDyn_DataData%Output(i1), DstHydroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call HydroDyn_CopyOutput(SrcHydroDyn_DataData%y_interp, DstHydroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcHydroDyn_DataData%Input)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%Input) + UB(1:1) = ubound(SrcHydroDyn_DataData%Input) + if (.not. allocated(DstHydroDyn_DataData%Input)) then + allocate(DstHydroDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyInput(SrcHydroDyn_DataData%Input(i1), DstHydroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcHydroDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcHydroDyn_DataData%InputTimes) + if (.not. allocated(DstHydroDyn_DataData%InputTimes)) then + allocate(DstHydroDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) + type(HydroDyn_Data), intent(inout) :: HydroDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyHydroDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(HydroDyn_DataData%x) + UB(1:1) = ubound(HydroDyn_DataData%x) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyContState(HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(HydroDyn_DataData%xd) + UB(1:1) = ubound(HydroDyn_DataData%xd) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyDiscState(HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(HydroDyn_DataData%z) + UB(1:1) = ubound(HydroDyn_DataData%z) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyConstrState(HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(HydroDyn_DataData%OtherSt) + UB(1:1) = ubound(HydroDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyOtherState(HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call HydroDyn_DestroyParam(HydroDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyInput(HydroDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyOutput(HydroDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyMisc(HydroDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(HydroDyn_DataData%Output)) then + LB(1:1) = lbound(HydroDyn_DataData%Output) + UB(1:1) = ubound(HydroDyn_DataData%Output) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyOutput(HydroDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(HydroDyn_DataData%Output) + end if + call HydroDyn_DestroyOutput(HydroDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(HydroDyn_DataData%Input)) then + LB(1:1) = lbound(HydroDyn_DataData%Input) + UB(1:1) = ubound(HydroDyn_DataData%Input) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyInput(HydroDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(HydroDyn_DataData%Input) + end if + if (allocated(HydroDyn_DataData%InputTimes)) then + deallocate(HydroDyn_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackHydroDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackHydroDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call HydroDyn_PackContState(Buf, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call HydroDyn_PackDiscState(Buf, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call HydroDyn_PackConstrState(Buf, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call HydroDyn_PackOtherState(Buf, InData%OtherSt(i1)) + end do + call HydroDyn_PackParam(Buf, InData%p) + call HydroDyn_PackInput(Buf, InData%u) + call HydroDyn_PackOutput(Buf, InData%y) + call HydroDyn_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call HydroDyn_PackOutput(Buf, InData%Output(i1)) + end do + end if + call HydroDyn_PackOutput(Buf, InData%y_interp) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call HydroDyn_PackInput(Buf, InData%Input(i1)) + end do + end if + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackHydroDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackHydroDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call HydroDyn_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call HydroDyn_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call HydroDyn_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call HydroDyn_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call HydroDyn_UnpackParam(Buf, OutData%p) ! p + call HydroDyn_UnpackInput(Buf, OutData%u) ! u + call HydroDyn_UnpackOutput(Buf, OutData%y) ! y + call HydroDyn_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + call HydroDyn_UnpackOutput(Buf, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_Data), intent(inout) :: SrcIceFloe_DataData + type(IceFloe_Data), intent(inout) :: DstIceFloe_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyIceFloe_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcIceFloe_DataData%x) + UB(1:1) = ubound(SrcIceFloe_DataData%x) + do i1 = LB(1), UB(1) + call IceFloe_CopyContState(SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcIceFloe_DataData%xd) + UB(1:1) = ubound(SrcIceFloe_DataData%xd) + do i1 = LB(1), UB(1) + call IceFloe_CopyDiscState(SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcIceFloe_DataData%z) + UB(1:1) = ubound(SrcIceFloe_DataData%z) + do i1 = LB(1), UB(1) + call IceFloe_CopyConstrState(SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcIceFloe_DataData%OtherSt) + UB(1:1) = ubound(SrcIceFloe_DataData%OtherSt) + do i1 = LB(1), UB(1) + call IceFloe_CopyOtherState(SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call IceFloe_CopyParam(SrcIceFloe_DataData%p, DstIceFloe_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyInput(SrcIceFloe_DataData%u, DstIceFloe_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyOutput(SrcIceFloe_DataData%y, DstIceFloe_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyMisc(SrcIceFloe_DataData%m, DstIceFloe_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcIceFloe_DataData%Input)) then + LB(1:1) = lbound(SrcIceFloe_DataData%Input) + UB(1:1) = ubound(SrcIceFloe_DataData%Input) + if (.not. allocated(DstIceFloe_DataData%Input)) then + allocate(DstIceFloe_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyInput(SrcIceFloe_DataData%Input(i1), DstIceFloe_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceFloe_DataData%InputTimes)) then + LB(1:1) = lbound(SrcIceFloe_DataData%InputTimes) + UB(1:1) = ubound(SrcIceFloe_DataData%InputTimes) + if (.not. allocated(DstIceFloe_DataData%InputTimes)) then + allocate(DstIceFloe_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) + type(IceFloe_Data), intent(inout) :: IceFloe_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyIceFloe_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(IceFloe_DataData%x) + UB(1:1) = ubound(IceFloe_DataData%x) + do i1 = LB(1), UB(1) + call IceFloe_DestroyContState(IceFloe_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(IceFloe_DataData%xd) + UB(1:1) = ubound(IceFloe_DataData%xd) + do i1 = LB(1), UB(1) + call IceFloe_DestroyDiscState(IceFloe_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(IceFloe_DataData%z) + UB(1:1) = ubound(IceFloe_DataData%z) + do i1 = LB(1), UB(1) + call IceFloe_DestroyConstrState(IceFloe_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(IceFloe_DataData%OtherSt) + UB(1:1) = ubound(IceFloe_DataData%OtherSt) + do i1 = LB(1), UB(1) + call IceFloe_DestroyOtherState(IceFloe_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call IceFloe_DestroyParam(IceFloe_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyInput(IceFloe_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyOutput(IceFloe_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyMisc(IceFloe_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(IceFloe_DataData%Input)) then + LB(1:1) = lbound(IceFloe_DataData%Input) + UB(1:1) = ubound(IceFloe_DataData%Input) + do i1 = LB(1), UB(1) + call IceFloe_DestroyInput(IceFloe_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceFloe_DataData%Input) + end if + if (allocated(IceFloe_DataData%InputTimes)) then + deallocate(IceFloe_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackIceFloe_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackIceFloe_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call IceFloe_PackContState(Buf, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call IceFloe_PackDiscState(Buf, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call IceFloe_PackConstrState(Buf, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call IceFloe_PackOtherState(Buf, InData%OtherSt(i1)) + end do + call IceFloe_PackParam(Buf, InData%p) + call IceFloe_PackInput(Buf, InData%u) + call IceFloe_PackOutput(Buf, InData%y) + call IceFloe_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call IceFloe_PackInput(Buf, InData%Input(i1)) + end do + end if + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackIceFloe_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackIceFloe_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call IceFloe_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call IceFloe_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call IceFloe_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call IceFloe_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call IceFloe_UnpackParam(Buf, OutData%p) ! p + call IceFloe_UnpackInput(Buf, OutData%u) ! u + call IceFloe_UnpackOutput(Buf, OutData%y) ! y + call IceFloe_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat, ErrMsg) + type(MAP_Data), intent(inout) :: SrcMAP_DataData + type(MAP_Data), intent(inout) :: DstMAP_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyMAP_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcMAP_DataData%x) + UB(1:1) = ubound(SrcMAP_DataData%x) + do i1 = LB(1), UB(1) + call MAP_CopyContState(SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcMAP_DataData%xd) + UB(1:1) = ubound(SrcMAP_DataData%xd) + do i1 = LB(1), UB(1) + call MAP_CopyDiscState(SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcMAP_DataData%z) + UB(1:1) = ubound(SrcMAP_DataData%z) + do i1 = LB(1), UB(1) + call MAP_CopyConstrState(SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call MAP_CopyOtherState(SrcMAP_DataData%OtherSt, DstMAP_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyParam(SrcMAP_DataData%p, DstMAP_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyInput(SrcMAP_DataData%u, DstMAP_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyOutput(SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyOtherState(SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMAP_DataData%Output)) then + LB(1:1) = lbound(SrcMAP_DataData%Output) + UB(1:1) = ubound(SrcMAP_DataData%Output) + if (.not. allocated(DstMAP_DataData%Output)) then + allocate(DstMAP_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyOutput(SrcMAP_DataData%Output(i1), DstMAP_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MAP_CopyOutput(SrcMAP_DataData%y_interp, DstMAP_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMAP_DataData%Input)) then + LB(1:1) = lbound(SrcMAP_DataData%Input) + UB(1:1) = ubound(SrcMAP_DataData%Input) + if (.not. allocated(DstMAP_DataData%Input)) then + allocate(DstMAP_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyInput(SrcMAP_DataData%Input(i1), DstMAP_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMAP_DataData%InputTimes)) then + LB(1:1) = lbound(SrcMAP_DataData%InputTimes) + UB(1:1) = ubound(SrcMAP_DataData%InputTimes) + if (.not. allocated(DstMAP_DataData%InputTimes)) then + allocate(DstMAP_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) + type(MAP_Data), intent(inout) :: MAP_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyMAP_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(MAP_DataData%x) + UB(1:1) = ubound(MAP_DataData%x) + do i1 = LB(1), UB(1) + call MAP_DestroyContState(MAP_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MAP_DataData%xd) + UB(1:1) = ubound(MAP_DataData%xd) + do i1 = LB(1), UB(1) + call MAP_DestroyDiscState(MAP_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MAP_DataData%z) + UB(1:1) = ubound(MAP_DataData%z) + do i1 = LB(1), UB(1) + call MAP_DestroyConstrState(MAP_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call MAP_DestroyOtherState(MAP_DataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyParam(MAP_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyInput(MAP_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyOutput(MAP_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyOtherState(MAP_DataData%OtherSt_old, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MAP_DataData%Output)) then + LB(1:1) = lbound(MAP_DataData%Output) + UB(1:1) = ubound(MAP_DataData%Output) + do i1 = LB(1), UB(1) + call MAP_DestroyOutput(MAP_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MAP_DataData%Output) + end if + call MAP_DestroyOutput(MAP_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MAP_DataData%Input)) then + LB(1:1) = lbound(MAP_DataData%Input) + UB(1:1) = ubound(MAP_DataData%Input) + do i1 = LB(1), UB(1) + call MAP_DestroyInput(MAP_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MAP_DataData%Input) + end if + if (allocated(MAP_DataData%InputTimes)) then + deallocate(MAP_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackMAP_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackMAP_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call MAP_PackContState(Buf, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call MAP_PackDiscState(Buf, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call MAP_PackConstrState(Buf, InData%z(i1)) + end do + call MAP_PackOtherState(Buf, InData%OtherSt) + call MAP_PackParam(Buf, InData%p) + call MAP_PackInput(Buf, InData%u) + call MAP_PackOutput(Buf, InData%y) + call MAP_PackOtherState(Buf, InData%OtherSt_old) + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call MAP_PackOutput(Buf, InData%Output(i1)) + end do + end if + call MAP_PackOutput(Buf, InData%y_interp) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call MAP_PackInput(Buf, InData%Input(i1)) + end do + end if + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackMAP_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackMAP_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call MAP_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call MAP_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call MAP_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + call MAP_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt + call MAP_UnpackParam(Buf, OutData%p) ! p + call MAP_UnpackInput(Buf, OutData%u) ! u + call MAP_UnpackOutput(Buf, OutData%y) ! y + call MAP_UnpackOtherState(Buf, OutData%OtherSt_old) ! OtherSt_old + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + call MAP_UnpackOutput(Buf, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataData, CtrlCode, ErrStat, ErrMsg) + type(FEAMooring_Data), intent(inout) :: SrcFEAMooring_DataData + type(FEAMooring_Data), intent(inout) :: DstFEAMooring_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyFEAMooring_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcFEAMooring_DataData%x) + UB(1:1) = ubound(SrcFEAMooring_DataData%x) + do i1 = LB(1), UB(1) + call FEAM_CopyContState(SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcFEAMooring_DataData%xd) + UB(1:1) = ubound(SrcFEAMooring_DataData%xd) + do i1 = LB(1), UB(1) + call FEAM_CopyDiscState(SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcFEAMooring_DataData%z) + UB(1:1) = ubound(SrcFEAMooring_DataData%z) + do i1 = LB(1), UB(1) + call FEAM_CopyConstrState(SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcFEAMooring_DataData%OtherSt) + UB(1:1) = ubound(SrcFEAMooring_DataData%OtherSt) + do i1 = LB(1), UB(1) + call FEAM_CopyOtherState(SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call FEAM_CopyParam(SrcFEAMooring_DataData%p, DstFEAMooring_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyInput(SrcFEAMooring_DataData%u, DstFEAMooring_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyOutput(SrcFEAMooring_DataData%y, DstFEAMooring_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyMisc(SrcFEAMooring_DataData%m, DstFEAMooring_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcFEAMooring_DataData%Input)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%Input) + UB(1:1) = ubound(SrcFEAMooring_DataData%Input) + if (.not. allocated(DstFEAMooring_DataData%Input)) then + allocate(DstFEAMooring_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyInput(SrcFEAMooring_DataData%Input(i1), DstFEAMooring_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcFEAMooring_DataData%InputTimes)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%InputTimes) + UB(1:1) = ubound(SrcFEAMooring_DataData%InputTimes) + if (.not. allocated(DstFEAMooring_DataData%InputTimes)) then + allocate(DstFEAMooring_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) + type(FEAMooring_Data), intent(inout) :: FEAMooring_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyFEAMooring_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(FEAMooring_DataData%x) + UB(1:1) = ubound(FEAMooring_DataData%x) + do i1 = LB(1), UB(1) + call FEAM_DestroyContState(FEAMooring_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(FEAMooring_DataData%xd) + UB(1:1) = ubound(FEAMooring_DataData%xd) + do i1 = LB(1), UB(1) + call FEAM_DestroyDiscState(FEAMooring_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(FEAMooring_DataData%z) + UB(1:1) = ubound(FEAMooring_DataData%z) + do i1 = LB(1), UB(1) + call FEAM_DestroyConstrState(FEAMooring_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(FEAMooring_DataData%OtherSt) + UB(1:1) = ubound(FEAMooring_DataData%OtherSt) + do i1 = LB(1), UB(1) + call FEAM_DestroyOtherState(FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call FEAM_DestroyParam(FEAMooring_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FEAM_DestroyInput(FEAMooring_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FEAM_DestroyOutput(FEAMooring_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FEAM_DestroyMisc(FEAMooring_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(FEAMooring_DataData%Input)) then + LB(1:1) = lbound(FEAMooring_DataData%Input) + UB(1:1) = ubound(FEAMooring_DataData%Input) + do i1 = LB(1), UB(1) + call FEAM_DestroyInput(FEAMooring_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(FEAMooring_DataData%Input) + end if + if (allocated(FEAMooring_DataData%InputTimes)) then + deallocate(FEAMooring_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackFEAMooring_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAMooring_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackFEAMooring_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call FEAM_PackContState(Buf, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call FEAM_PackDiscState(Buf, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call FEAM_PackConstrState(Buf, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call FEAM_PackOtherState(Buf, InData%OtherSt(i1)) + end do + call FEAM_PackParam(Buf, InData%p) + call FEAM_PackInput(Buf, InData%u) + call FEAM_PackOutput(Buf, InData%y) + call FEAM_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call FEAM_PackInput(Buf, InData%Input(i1)) + end do + end if + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackFEAMooring_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAMooring_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackFEAMooring_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call FEAM_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call FEAM_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call FEAM_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call FEAM_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call FEAM_UnpackParam(Buf, OutData%p) ! p + call FEAM_UnpackInput(Buf, OutData%u) ! u + call FEAM_UnpackOutput(Buf, OutData%y) ! y + call FEAM_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(MoorDyn_Data), intent(inout) :: SrcMoorDyn_DataData + type(MoorDyn_Data), intent(inout) :: DstMoorDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyMoorDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcMoorDyn_DataData%x) + UB(1:1) = ubound(SrcMoorDyn_DataData%x) + do i1 = LB(1), UB(1) + call MD_CopyContState(SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcMoorDyn_DataData%xd) + UB(1:1) = ubound(SrcMoorDyn_DataData%xd) + do i1 = LB(1), UB(1) + call MD_CopyDiscState(SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcMoorDyn_DataData%z) + UB(1:1) = ubound(SrcMoorDyn_DataData%z) + do i1 = LB(1), UB(1) + call MD_CopyConstrState(SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcMoorDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcMoorDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call MD_CopyOtherState(SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call MD_CopyParam(SrcMoorDyn_DataData%p, DstMoorDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyInput(SrcMoorDyn_DataData%u, DstMoorDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyOutput(SrcMoorDyn_DataData%y, DstMoorDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyMisc(SrcMoorDyn_DataData%m, DstMoorDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMoorDyn_DataData%Output)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%Output) + UB(1:1) = ubound(SrcMoorDyn_DataData%Output) + if (.not. allocated(DstMoorDyn_DataData%Output)) then + allocate(DstMoorDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyOutput(SrcMoorDyn_DataData%Output(i1), DstMoorDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MD_CopyOutput(SrcMoorDyn_DataData%y_interp, DstMoorDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMoorDyn_DataData%Input)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%Input) + UB(1:1) = ubound(SrcMoorDyn_DataData%Input) + if (.not. allocated(DstMoorDyn_DataData%Input)) then + allocate(DstMoorDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyInput(SrcMoorDyn_DataData%Input(i1), DstMoorDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMoorDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcMoorDyn_DataData%InputTimes) + if (.not. allocated(DstMoorDyn_DataData%InputTimes)) then + allocate(DstMoorDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) + type(MoorDyn_Data), intent(inout) :: MoorDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyMoorDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(MoorDyn_DataData%x) + UB(1:1) = ubound(MoorDyn_DataData%x) + do i1 = LB(1), UB(1) + call MD_DestroyContState(MoorDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MoorDyn_DataData%xd) + UB(1:1) = ubound(MoorDyn_DataData%xd) + do i1 = LB(1), UB(1) + call MD_DestroyDiscState(MoorDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MoorDyn_DataData%z) + UB(1:1) = ubound(MoorDyn_DataData%z) + do i1 = LB(1), UB(1) + call MD_DestroyConstrState(MoorDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MoorDyn_DataData%OtherSt) + UB(1:1) = ubound(MoorDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call MD_DestroyOtherState(MoorDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call MD_DestroyParam(MoorDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyInput(MoorDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyOutput(MoorDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyMisc(MoorDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MoorDyn_DataData%Output)) then + LB(1:1) = lbound(MoorDyn_DataData%Output) + UB(1:1) = ubound(MoorDyn_DataData%Output) + do i1 = LB(1), UB(1) + call MD_DestroyOutput(MoorDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MoorDyn_DataData%Output) + end if + call MD_DestroyOutput(MoorDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MoorDyn_DataData%Input)) then + LB(1:1) = lbound(MoorDyn_DataData%Input) + UB(1:1) = ubound(MoorDyn_DataData%Input) + do i1 = LB(1), UB(1) + call MD_DestroyInput(MoorDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MoorDyn_DataData%Input) + end if + if (allocated(MoorDyn_DataData%InputTimes)) then + deallocate(MoorDyn_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackMoorDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MoorDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackMoorDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call MD_PackContState(Buf, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call MD_PackDiscState(Buf, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call MD_PackConstrState(Buf, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call MD_PackOtherState(Buf, InData%OtherSt(i1)) + end do + call MD_PackParam(Buf, InData%p) + call MD_PackInput(Buf, InData%u) + call MD_PackOutput(Buf, InData%y) + call MD_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call MD_PackOutput(Buf, InData%Output(i1)) + end do + end if + call MD_PackOutput(Buf, InData%y_interp) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call MD_PackInput(Buf, InData%Input(i1)) + end do + end if + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackMoorDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MoorDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackMoorDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call MD_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call MD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call MD_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call MD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call MD_UnpackParam(Buf, OutData%p) ! p + call MD_UnpackInput(Buf, OutData%u) ! u + call MD_UnpackOutput(Buf, OutData%y) ! y + call MD_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + call MD_UnpackOutput(Buf, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, CtrlCode, ErrStat, ErrMsg) + type(OrcaFlex_Data), intent(inout) :: SrcOrcaFlex_DataData + type(OrcaFlex_Data), intent(inout) :: DstOrcaFlex_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyOrcaFlex_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcOrcaFlex_DataData%x) + UB(1:1) = ubound(SrcOrcaFlex_DataData%x) + do i1 = LB(1), UB(1) + call Orca_CopyContState(SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcOrcaFlex_DataData%xd) + UB(1:1) = ubound(SrcOrcaFlex_DataData%xd) + do i1 = LB(1), UB(1) + call Orca_CopyDiscState(SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcOrcaFlex_DataData%z) + UB(1:1) = ubound(SrcOrcaFlex_DataData%z) + do i1 = LB(1), UB(1) + call Orca_CopyConstrState(SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcOrcaFlex_DataData%OtherSt) + UB(1:1) = ubound(SrcOrcaFlex_DataData%OtherSt) + do i1 = LB(1), UB(1) + call Orca_CopyOtherState(SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call Orca_CopyParam(SrcOrcaFlex_DataData%p, DstOrcaFlex_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Orca_CopyInput(SrcOrcaFlex_DataData%u, DstOrcaFlex_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Orca_CopyOutput(SrcOrcaFlex_DataData%y, DstOrcaFlex_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Orca_CopyMisc(SrcOrcaFlex_DataData%m, DstOrcaFlex_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOrcaFlex_DataData%Input)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%Input) + UB(1:1) = ubound(SrcOrcaFlex_DataData%Input) + if (.not. allocated(DstOrcaFlex_DataData%Input)) then + allocate(DstOrcaFlex_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Orca_CopyInput(SrcOrcaFlex_DataData%Input(i1), DstOrcaFlex_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOrcaFlex_DataData%InputTimes)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%InputTimes) + UB(1:1) = ubound(SrcOrcaFlex_DataData%InputTimes) + if (.not. allocated(DstOrcaFlex_DataData%InputTimes)) then + allocate(DstOrcaFlex_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) + type(OrcaFlex_Data), intent(inout) :: OrcaFlex_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyOrcaFlex_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(OrcaFlex_DataData%x) + UB(1:1) = ubound(OrcaFlex_DataData%x) + do i1 = LB(1), UB(1) + call Orca_DestroyContState(OrcaFlex_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(OrcaFlex_DataData%xd) + UB(1:1) = ubound(OrcaFlex_DataData%xd) + do i1 = LB(1), UB(1) + call Orca_DestroyDiscState(OrcaFlex_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(OrcaFlex_DataData%z) + UB(1:1) = ubound(OrcaFlex_DataData%z) + do i1 = LB(1), UB(1) + call Orca_DestroyConstrState(OrcaFlex_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(OrcaFlex_DataData%OtherSt) + UB(1:1) = ubound(OrcaFlex_DataData%OtherSt) + do i1 = LB(1), UB(1) + call Orca_DestroyOtherState(OrcaFlex_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call Orca_DestroyParam(OrcaFlex_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Orca_DestroyInput(OrcaFlex_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Orca_DestroyOutput(OrcaFlex_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Orca_DestroyMisc(OrcaFlex_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OrcaFlex_DataData%Input)) then + LB(1:1) = lbound(OrcaFlex_DataData%Input) + UB(1:1) = ubound(OrcaFlex_DataData%Input) + do i1 = LB(1), UB(1) + call Orca_DestroyInput(OrcaFlex_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OrcaFlex_DataData%Input) + end if + if (allocated(OrcaFlex_DataData%InputTimes)) then + deallocate(OrcaFlex_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackOrcaFlex_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OrcaFlex_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackOrcaFlex_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call Orca_PackContState(Buf, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call Orca_PackDiscState(Buf, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call Orca_PackConstrState(Buf, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call Orca_PackOtherState(Buf, InData%OtherSt(i1)) + end do + call Orca_PackParam(Buf, InData%p) + call Orca_PackInput(Buf, InData%u) + call Orca_PackOutput(Buf, InData%y) + call Orca_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call Orca_PackInput(Buf, InData%Input(i1)) + end do + end if + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackOrcaFlex_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OrcaFlex_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackOrcaFlex_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call Orca_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call Orca_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call Orca_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call Orca_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call Orca_UnpackParam(Buf, OutData%p) ! p + call Orca_UnpackInput(Buf, OutData%u) ! u + call Orca_UnpackOutput(Buf, OutData%y) ! y + call Orca_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Orca_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_ModuleMapType), intent(inout) :: SrcModuleMapTypeData + type(FAST_ModuleMapType), intent(inout) :: DstModuleMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyModuleMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcModuleMapTypeData%ED_P_2_BD_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P) + if (.not. allocated(DstModuleMapTypeData%ED_P_2_BD_P)) then + allocate(DstModuleMapTypeData%ED_P_2_BD_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_BD_P(i1), DstModuleMapTypeData%ED_P_2_BD_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%BD_P_2_ED_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%BD_P_2_ED_P) + UB(1:1) = ubound(SrcModuleMapTypeData%BD_P_2_ED_P) + if (.not. allocated(DstModuleMapTypeData%BD_P_2_ED_P)) then + allocate(DstModuleMapTypeData%BD_P_2_ED_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_P_2_ED_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BD_P_2_ED_P(i1), DstModuleMapTypeData%BD_P_2_ED_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub) + if (.not. allocated(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) then + allocate(DstModuleMapTypeData%ED_P_2_BD_P_Hub(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_BD_P_Hub(i1), DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_HD_PRP_P, DstModuleMapTypeData%ED_P_2_HD_PRP_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SubStructure_2_HD_W_P, DstModuleMapTypeData%SubStructure_2_HD_W_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%HD_W_P_2_SubStructure, DstModuleMapTypeData%HD_W_P_2_SubStructure, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SubStructure_2_HD_M_P, DstModuleMapTypeData%SubStructure_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%HD_M_P_2_SubStructure, DstModuleMapTypeData%HD_M_P_2_SubStructure, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%Structure_2_Mooring, DstModuleMapTypeData%Structure_2_Mooring, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%Mooring_2_Structure, DstModuleMapTypeData%Mooring_2_Structure, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_SD_TP, DstModuleMapTypeData%ED_P_2_SD_TP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SD_TP_2_ED_P, DstModuleMapTypeData%SD_TP_2_ED_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%ED_P_2_NStC_P_N)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_NStC_P_N) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_NStC_P_N) + if (.not. allocated(DstModuleMapTypeData%ED_P_2_NStC_P_N)) then + allocate(DstModuleMapTypeData%ED_P_2_NStC_P_N(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_NStC_P_N.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_NStC_P_N(i1), DstModuleMapTypeData%ED_P_2_NStC_P_N(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%NStC_P_2_ED_P_N)) then + LB(1:1) = lbound(SrcModuleMapTypeData%NStC_P_2_ED_P_N) + UB(1:1) = ubound(SrcModuleMapTypeData%NStC_P_2_ED_P_N) + if (.not. allocated(DstModuleMapTypeData%NStC_P_2_ED_P_N)) then + allocate(DstModuleMapTypeData%NStC_P_2_ED_P_N(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%NStC_P_2_ED_P_N.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%NStC_P_2_ED_P_N(i1), DstModuleMapTypeData%NStC_P_2_ED_P_N(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%ED_L_2_TStC_P_T)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_L_2_TStC_P_T) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_L_2_TStC_P_T) + if (.not. allocated(DstModuleMapTypeData%ED_L_2_TStC_P_T)) then + allocate(DstModuleMapTypeData%ED_L_2_TStC_P_T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_TStC_P_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_L_2_TStC_P_T(i1), DstModuleMapTypeData%ED_L_2_TStC_P_T(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%TStC_P_2_ED_P_T)) then + LB(1:1) = lbound(SrcModuleMapTypeData%TStC_P_2_ED_P_T) + UB(1:1) = ubound(SrcModuleMapTypeData%TStC_P_2_ED_P_T) + if (.not. allocated(DstModuleMapTypeData%TStC_P_2_ED_P_T)) then + allocate(DstModuleMapTypeData%TStC_P_2_ED_P_T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%TStC_P_2_ED_P_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%TStC_P_2_ED_P_T(i1), DstModuleMapTypeData%TStC_P_2_ED_P_T(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%ED_L_2_BStC_P_B)) then + LB(1:2) = lbound(SrcModuleMapTypeData%ED_L_2_BStC_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%ED_L_2_BStC_P_B) + if (.not. allocated(DstModuleMapTypeData%ED_L_2_BStC_P_B)) then + allocate(DstModuleMapTypeData%ED_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_BStC_P_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcModuleMapTypeData%BStC_P_2_ED_P_B)) then + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_ED_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_ED_P_B) + if (.not. allocated(DstModuleMapTypeData%BStC_P_2_ED_P_B)) then + allocate(DstModuleMapTypeData%BStC_P_2_ED_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_ED_P_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcModuleMapTypeData%BD_L_2_BStC_P_B)) then + LB(1:2) = lbound(SrcModuleMapTypeData%BD_L_2_BStC_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%BD_L_2_BStC_P_B) + if (.not. allocated(DstModuleMapTypeData%BD_L_2_BStC_P_B)) then + allocate(DstModuleMapTypeData%BD_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BStC_P_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcModuleMapTypeData%BStC_P_2_BD_P_B)) then + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_BD_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_BD_P_B) + if (.not. allocated(DstModuleMapTypeData%BStC_P_2_BD_P_B)) then + allocate(DstModuleMapTypeData%BStC_P_2_BD_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_BD_P_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcModuleMapTypeData%SStC_P_P_2_SubStructure)) then + LB(1:1) = lbound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure) + UB(1:1) = ubound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure) + if (.not. allocated(DstModuleMapTypeData%SStC_P_P_2_SubStructure)) then + allocate(DstModuleMapTypeData%SStC_P_P_2_SubStructure(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SStC_P_P_2_SubStructure.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SStC_P_P_2_SubStructure(i1), DstModuleMapTypeData%SStC_P_P_2_SubStructure(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%SubStructure_2_SStC_P_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P) + UB(1:1) = ubound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P) + if (.not. allocated(DstModuleMapTypeData%SubStructure_2_SStC_P_P)) then + allocate(DstModuleMapTypeData%SubStructure_2_SStC_P_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SubStructure_2_SStC_P_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SubStructure_2_SStC_P_P(i1), DstModuleMapTypeData%SubStructure_2_SStC_P_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_SrvD_P_P, DstModuleMapTypeData%ED_P_2_SrvD_P_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%BDED_L_2_AD_L_B)) then + LB(1:1) = lbound(SrcModuleMapTypeData%BDED_L_2_AD_L_B) + UB(1:1) = ubound(SrcModuleMapTypeData%BDED_L_2_AD_L_B) + if (.not. allocated(DstModuleMapTypeData%BDED_L_2_AD_L_B)) then + allocate(DstModuleMapTypeData%BDED_L_2_AD_L_B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BDED_L_2_AD_L_B(i1), DstModuleMapTypeData%BDED_L_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%AD_L_2_BDED_B)) then + LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_BDED_B) + UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_BDED_B) + if (.not. allocated(DstModuleMapTypeData%AD_L_2_BDED_B)) then + allocate(DstModuleMapTypeData%AD_L_2_BDED_B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%AD_L_2_BDED_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_L_2_BDED_B(i1), DstModuleMapTypeData%AD_L_2_BDED_B(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%BD_L_2_BD_L)) then + LB(1:1) = lbound(SrcModuleMapTypeData%BD_L_2_BD_L) + UB(1:1) = ubound(SrcModuleMapTypeData%BD_L_2_BD_L) + if (.not. allocated(DstModuleMapTypeData%BD_L_2_BD_L)) then + allocate(DstModuleMapTypeData%BD_L_2_BD_L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BD_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BD_L_2_BD_L(i1), DstModuleMapTypeData%BD_L_2_BD_L(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_AD_P_N, DstModuleMapTypeData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_P_2_ED_P_N, DstModuleMapTypeData%AD_P_2_ED_P_N, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_AD_P_TF, DstModuleMapTypeData%ED_P_2_AD_P_TF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_P_2_ED_P_TF, DstModuleMapTypeData%AD_P_2_ED_P_TF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_L_2_AD_L_T, DstModuleMapTypeData%ED_L_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_L_2_ED_P_T, DstModuleMapTypeData%AD_L_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%ED_P_2_AD_P_R)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_AD_P_R) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_AD_P_R) + if (.not. allocated(DstModuleMapTypeData%ED_P_2_AD_P_R)) then + allocate(DstModuleMapTypeData%ED_P_2_AD_P_R(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_AD_P_R.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_AD_P_R(i1), DstModuleMapTypeData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_AD_P_H, DstModuleMapTypeData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_P_2_ED_P_H, DstModuleMapTypeData%AD_P_2_ED_P_H, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%IceF_P_2_SD_P, DstModuleMapTypeData%IceF_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SDy3_P_2_IceF_P, DstModuleMapTypeData%SDy3_P_2_IceF_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%IceD_P_2_SD_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%IceD_P_2_SD_P) + UB(1:1) = ubound(SrcModuleMapTypeData%IceD_P_2_SD_P) + if (.not. allocated(DstModuleMapTypeData%IceD_P_2_SD_P)) then + allocate(DstModuleMapTypeData%IceD_P_2_SD_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%IceD_P_2_SD_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%IceD_P_2_SD_P(i1), DstModuleMapTypeData%IceD_P_2_SD_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%SDy3_P_2_IceD_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%SDy3_P_2_IceD_P) + UB(1:1) = ubound(SrcModuleMapTypeData%SDy3_P_2_IceD_P) + if (.not. allocated(DstModuleMapTypeData%SDy3_P_2_IceD_P)) then + allocate(DstModuleMapTypeData%SDy3_P_2_IceD_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SDy3_P_2_IceD_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SDy3_P_2_IceD_P(i1), DstModuleMapTypeData%SDy3_P_2_IceD_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%Jacobian_Opt1)) then + LB(1:2) = lbound(SrcModuleMapTypeData%Jacobian_Opt1) + UB(1:2) = ubound(SrcModuleMapTypeData%Jacobian_Opt1) + if (.not. allocated(DstModuleMapTypeData%Jacobian_Opt1)) then + allocate(DstModuleMapTypeData%Jacobian_Opt1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_Opt1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 + end if + if (allocated(SrcModuleMapTypeData%Jacobian_pivot)) then + LB(1:1) = lbound(SrcModuleMapTypeData%Jacobian_pivot) + UB(1:1) = ubound(SrcModuleMapTypeData%Jacobian_pivot) + if (.not. allocated(DstModuleMapTypeData%Jacobian_pivot)) then + allocate(DstModuleMapTypeData%Jacobian_pivot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_pivot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot + end if + if (allocated(SrcModuleMapTypeData%Jac_u_indx)) then + LB(1:2) = lbound(SrcModuleMapTypeData%Jac_u_indx) + UB(1:2) = ubound(SrcModuleMapTypeData%Jac_u_indx) + if (.not. allocated(DstModuleMapTypeData%Jac_u_indx)) then + allocate(DstModuleMapTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModuleMapTypeData%Jac_u_indx = SrcModuleMapTypeData%Jac_u_indx + end if + call MeshCopy(SrcModuleMapTypeData%u_ED_NacelleLoads, DstModuleMapTypeData%u_ED_NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%SubstructureLoads_Tmp, DstModuleMapTypeData%SubstructureLoads_Tmp, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%SubstructureLoads_Tmp2, DstModuleMapTypeData%SubstructureLoads_Tmp2, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%PlatformLoads_Tmp, DstModuleMapTypeData%PlatformLoads_Tmp, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%PlatformLoads_Tmp2, DstModuleMapTypeData%PlatformLoads_Tmp2, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%SubstructureLoads_Tmp_Farm, DstModuleMapTypeData%SubstructureLoads_Tmp_Farm, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_ED_TowerPtloads, DstModuleMapTypeData%u_ED_TowerPtloads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%u_ED_BladePtLoads)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_ED_BladePtLoads) + UB(1:1) = ubound(SrcModuleMapTypeData%u_ED_BladePtLoads) + if (.not. allocated(DstModuleMapTypeData%u_ED_BladePtLoads)) then + allocate(DstModuleMapTypeData%u_ED_BladePtLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_ED_BladePtLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcModuleMapTypeData%u_ED_BladePtLoads(i1), DstModuleMapTypeData%u_ED_BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcModuleMapTypeData%u_SD_TPMesh, DstModuleMapTypeData%u_SD_TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_HD_M_Mesh, DstModuleMapTypeData%u_HD_M_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_HD_W_Mesh, DstModuleMapTypeData%u_HD_W_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_ED_HubPtLoad, DstModuleMapTypeData%u_ED_HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_ED_HubPtLoad_2, DstModuleMapTypeData%u_ED_HubPtLoad_2, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%u_BD_RootMotion)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_RootMotion) + UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_RootMotion) + if (.not. allocated(DstModuleMapTypeData%u_BD_RootMotion)) then + allocate(DstModuleMapTypeData%u_BD_RootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_RootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcModuleMapTypeData%u_BD_RootMotion(i1), DstModuleMapTypeData%u_BD_RootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) then + LB(1:1) = lbound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads) + UB(1:1) = ubound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads) + if (.not. allocated(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) then + allocate(DstModuleMapTypeData%y_BD_BldMotion_4Loads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcModuleMapTypeData%y_BD_BldMotion_4Loads(i1), DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%u_BD_Distrload)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_Distrload) + UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_Distrload) + if (.not. allocated(DstModuleMapTypeData%u_BD_Distrload)) then + allocate(DstModuleMapTypeData%u_BD_Distrload(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_Distrload.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcModuleMapTypeData%u_BD_Distrload(i1), DstModuleMapTypeData%u_BD_Distrload(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcModuleMapTypeData%u_Orca_PtfmMesh, DstModuleMapTypeData%u_Orca_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_ExtPtfm_PtfmMesh, DstModuleMapTypeData%u_ExtPtfm_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) + type(FAST_ModuleMapType), intent(inout) :: ModuleMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyModuleMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModuleMapTypeData%ED_P_2_BD_P)) then + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ED_P_2_BD_P) + end if + if (allocated(ModuleMapTypeData%BD_P_2_ED_P)) then + LB(1:1) = lbound(ModuleMapTypeData%BD_P_2_ED_P) + UB(1:1) = ubound(ModuleMapTypeData%BD_P_2_ED_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%BD_P_2_ED_P) + end if + if (allocated(ModuleMapTypeData%ED_P_2_BD_P_Hub)) then + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P_Hub) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P_Hub) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ED_P_2_BD_P_Hub) + end if + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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 + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_NStC_P_N) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_NStC_P_N) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ED_P_2_NStC_P_N) + end if + if (allocated(ModuleMapTypeData%NStC_P_2_ED_P_N)) then + LB(1:1) = lbound(ModuleMapTypeData%NStC_P_2_ED_P_N) + UB(1:1) = ubound(ModuleMapTypeData%NStC_P_2_ED_P_N) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%NStC_P_2_ED_P_N) + end if + if (allocated(ModuleMapTypeData%ED_L_2_TStC_P_T)) then + LB(1:1) = lbound(ModuleMapTypeData%ED_L_2_TStC_P_T) + UB(1:1) = ubound(ModuleMapTypeData%ED_L_2_TStC_P_T) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ED_L_2_TStC_P_T) + end if + if (allocated(ModuleMapTypeData%TStC_P_2_ED_P_T)) then + LB(1:1) = lbound(ModuleMapTypeData%TStC_P_2_ED_P_T) + UB(1:1) = ubound(ModuleMapTypeData%TStC_P_2_ED_P_T) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%TStC_P_2_ED_P_T) + end if + if (allocated(ModuleMapTypeData%ED_L_2_BStC_P_B)) then + LB(1:2) = lbound(ModuleMapTypeData%ED_L_2_BStC_P_B) + UB(1:2) = ubound(ModuleMapTypeData%ED_L_2_BStC_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%ED_L_2_BStC_P_B) + end if + if (allocated(ModuleMapTypeData%BStC_P_2_ED_P_B)) then + LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_ED_P_B) + UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_ED_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%BStC_P_2_ED_P_B) + end if + if (allocated(ModuleMapTypeData%BD_L_2_BStC_P_B)) then + LB(1:2) = lbound(ModuleMapTypeData%BD_L_2_BStC_P_B) + UB(1:2) = ubound(ModuleMapTypeData%BD_L_2_BStC_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%BD_L_2_BStC_P_B) + end if + if (allocated(ModuleMapTypeData%BStC_P_2_BD_P_B)) then + LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_BD_P_B) + UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_BD_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%BStC_P_2_BD_P_B) + end if + if (allocated(ModuleMapTypeData%SStC_P_P_2_SubStructure)) then + LB(1:1) = lbound(ModuleMapTypeData%SStC_P_P_2_SubStructure) + UB(1:1) = ubound(ModuleMapTypeData%SStC_P_P_2_SubStructure) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%SStC_P_P_2_SubStructure) + end if + if (allocated(ModuleMapTypeData%SubStructure_2_SStC_P_P)) then + LB(1:1) = lbound(ModuleMapTypeData%SubStructure_2_SStC_P_P) + UB(1:1) = ubound(ModuleMapTypeData%SubStructure_2_SStC_P_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%SubStructure_2_SStC_P_P) + end if + 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 + LB(1:1) = lbound(ModuleMapTypeData%BDED_L_2_AD_L_B) + UB(1:1) = ubound(ModuleMapTypeData%BDED_L_2_AD_L_B) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%BDED_L_2_AD_L_B) + end if + if (allocated(ModuleMapTypeData%AD_L_2_BDED_B)) then + LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_BDED_B) + UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_BDED_B) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%AD_L_2_BDED_B) + end if + if (allocated(ModuleMapTypeData%BD_L_2_BD_L)) then + LB(1:1) = lbound(ModuleMapTypeData%BD_L_2_BD_L) + UB(1:1) = ubound(ModuleMapTypeData%BD_L_2_BD_L) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%BD_L_2_BD_L) + end if + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModuleMapTypeData%ED_P_2_AD_P_R)) then + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_AD_P_R) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_AD_P_R) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ED_P_2_AD_P_R) + end if + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModuleMapTypeData%IceD_P_2_SD_P)) then + LB(1:1) = lbound(ModuleMapTypeData%IceD_P_2_SD_P) + UB(1:1) = ubound(ModuleMapTypeData%IceD_P_2_SD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%IceD_P_2_SD_P) + end if + if (allocated(ModuleMapTypeData%SDy3_P_2_IceD_P)) then + LB(1:1) = lbound(ModuleMapTypeData%SDy3_P_2_IceD_P) + UB(1:1) = ubound(ModuleMapTypeData%SDy3_P_2_IceD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%SDy3_P_2_IceD_P) + end if + if (allocated(ModuleMapTypeData%Jacobian_Opt1)) then + deallocate(ModuleMapTypeData%Jacobian_Opt1) + end if + if (allocated(ModuleMapTypeData%Jacobian_pivot)) then + deallocate(ModuleMapTypeData%Jacobian_pivot) + end if + if (allocated(ModuleMapTypeData%Jac_u_indx)) then + deallocate(ModuleMapTypeData%Jac_u_indx) + end if + call MeshDestroy( ModuleMapTypeData%u_ED_NacelleLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%PlatformLoads_Tmp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%PlatformLoads_Tmp2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp_Farm, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_ED_TowerPtloads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModuleMapTypeData%u_ED_BladePtLoads)) then + LB(1:1) = lbound(ModuleMapTypeData%u_ED_BladePtLoads) + UB(1:1) = ubound(ModuleMapTypeData%u_ED_BladePtLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( ModuleMapTypeData%u_ED_BladePtLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_ED_BladePtLoads) + end if + call MeshDestroy( ModuleMapTypeData%u_SD_TPMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_HD_M_Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_HD_W_Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModuleMapTypeData%u_BD_RootMotion)) then + LB(1:1) = lbound(ModuleMapTypeData%u_BD_RootMotion) + UB(1:1) = ubound(ModuleMapTypeData%u_BD_RootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( ModuleMapTypeData%u_BD_RootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_BD_RootMotion) + end if + if (allocated(ModuleMapTypeData%y_BD_BldMotion_4Loads)) then + LB(1:1) = lbound(ModuleMapTypeData%y_BD_BldMotion_4Loads) + UB(1:1) = ubound(ModuleMapTypeData%y_BD_BldMotion_4Loads) + do i1 = LB(1), UB(1) + call MeshDestroy( ModuleMapTypeData%y_BD_BldMotion_4Loads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%y_BD_BldMotion_4Loads) + end if + if (allocated(ModuleMapTypeData%u_BD_Distrload)) then + LB(1:1) = lbound(ModuleMapTypeData%u_BD_Distrload) + UB(1:1) = ubound(ModuleMapTypeData%u_BD_Distrload) + do i1 = LB(1), UB(1) + call MeshDestroy( ModuleMapTypeData%u_BD_Distrload(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_BD_Distrload) + end if + call MeshDestroy( ModuleMapTypeData%u_Orca_PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_ExtPtfm_PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackModuleMapType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ModuleMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackModuleMapType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%ED_P_2_BD_P)) + if (allocated(InData%ED_P_2_BD_P)) then + call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_BD_P), ubound(InData%ED_P_2_BD_P)) + LB(1:1) = lbound(InData%ED_P_2_BD_P) + UB(1:1) = ubound(InData%ED_P_2_BD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_BD_P(i1)) + end do + end if + call RegPack(Buf, allocated(InData%BD_P_2_ED_P)) + if (allocated(InData%BD_P_2_ED_P)) then + call RegPackBounds(Buf, 1, lbound(InData%BD_P_2_ED_P), ubound(InData%BD_P_2_ED_P)) + LB(1:1) = lbound(InData%BD_P_2_ED_P) + UB(1:1) = ubound(InData%BD_P_2_ED_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%BD_P_2_ED_P(i1)) + end do + end if + call RegPack(Buf, allocated(InData%ED_P_2_BD_P_Hub)) + if (allocated(InData%ED_P_2_BD_P_Hub)) then + call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_BD_P_Hub), ubound(InData%ED_P_2_BD_P_Hub)) + LB(1:1) = lbound(InData%ED_P_2_BD_P_Hub) + UB(1:1) = ubound(InData%ED_P_2_BD_P_Hub) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_BD_P_Hub(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_HD_PRP_P) + call NWTC_Library_PackMeshMapType(Buf, InData%SubStructure_2_HD_W_P) + call NWTC_Library_PackMeshMapType(Buf, InData%HD_W_P_2_SubStructure) + call NWTC_Library_PackMeshMapType(Buf, InData%SubStructure_2_HD_M_P) + call NWTC_Library_PackMeshMapType(Buf, InData%HD_M_P_2_SubStructure) + call NWTC_Library_PackMeshMapType(Buf, InData%Structure_2_Mooring) + call NWTC_Library_PackMeshMapType(Buf, InData%Mooring_2_Structure) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_SD_TP) + call NWTC_Library_PackMeshMapType(Buf, InData%SD_TP_2_ED_P) + call RegPack(Buf, allocated(InData%ED_P_2_NStC_P_N)) + if (allocated(InData%ED_P_2_NStC_P_N)) then + call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_NStC_P_N), ubound(InData%ED_P_2_NStC_P_N)) + LB(1:1) = lbound(InData%ED_P_2_NStC_P_N) + UB(1:1) = ubound(InData%ED_P_2_NStC_P_N) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_NStC_P_N(i1)) + end do + end if + call RegPack(Buf, allocated(InData%NStC_P_2_ED_P_N)) + if (allocated(InData%NStC_P_2_ED_P_N)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC_P_2_ED_P_N), ubound(InData%NStC_P_2_ED_P_N)) + LB(1:1) = lbound(InData%NStC_P_2_ED_P_N) + UB(1:1) = ubound(InData%NStC_P_2_ED_P_N) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%NStC_P_2_ED_P_N(i1)) + end do + end if + call RegPack(Buf, allocated(InData%ED_L_2_TStC_P_T)) + if (allocated(InData%ED_L_2_TStC_P_T)) then + call RegPackBounds(Buf, 1, lbound(InData%ED_L_2_TStC_P_T), ubound(InData%ED_L_2_TStC_P_T)) + LB(1:1) = lbound(InData%ED_L_2_TStC_P_T) + UB(1:1) = ubound(InData%ED_L_2_TStC_P_T) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_L_2_TStC_P_T(i1)) + end do + end if + call RegPack(Buf, allocated(InData%TStC_P_2_ED_P_T)) + if (allocated(InData%TStC_P_2_ED_P_T)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC_P_2_ED_P_T), ubound(InData%TStC_P_2_ED_P_T)) + LB(1:1) = lbound(InData%TStC_P_2_ED_P_T) + UB(1:1) = ubound(InData%TStC_P_2_ED_P_T) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%TStC_P_2_ED_P_T(i1)) + end do + end if + call RegPack(Buf, allocated(InData%ED_L_2_BStC_P_B)) + if (allocated(InData%ED_L_2_BStC_P_B)) then + call RegPackBounds(Buf, 2, lbound(InData%ED_L_2_BStC_P_B), ubound(InData%ED_L_2_BStC_P_B)) + LB(1:2) = lbound(InData%ED_L_2_BStC_P_B) + UB(1:2) = ubound(InData%ED_L_2_BStC_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_L_2_BStC_P_B(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%BStC_P_2_ED_P_B)) + if (allocated(InData%BStC_P_2_ED_P_B)) then + call RegPackBounds(Buf, 2, lbound(InData%BStC_P_2_ED_P_B), ubound(InData%BStC_P_2_ED_P_B)) + LB(1:2) = lbound(InData%BStC_P_2_ED_P_B) + UB(1:2) = ubound(InData%BStC_P_2_ED_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%BStC_P_2_ED_P_B(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%BD_L_2_BStC_P_B)) + if (allocated(InData%BD_L_2_BStC_P_B)) then + call RegPackBounds(Buf, 2, lbound(InData%BD_L_2_BStC_P_B), ubound(InData%BD_L_2_BStC_P_B)) + LB(1:2) = lbound(InData%BD_L_2_BStC_P_B) + UB(1:2) = ubound(InData%BD_L_2_BStC_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%BD_L_2_BStC_P_B(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%BStC_P_2_BD_P_B)) + if (allocated(InData%BStC_P_2_BD_P_B)) then + call RegPackBounds(Buf, 2, lbound(InData%BStC_P_2_BD_P_B), ubound(InData%BStC_P_2_BD_P_B)) + LB(1:2) = lbound(InData%BStC_P_2_BD_P_B) + UB(1:2) = ubound(InData%BStC_P_2_BD_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%BStC_P_2_BD_P_B(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%SStC_P_P_2_SubStructure)) + if (allocated(InData%SStC_P_P_2_SubStructure)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC_P_P_2_SubStructure), ubound(InData%SStC_P_P_2_SubStructure)) + LB(1:1) = lbound(InData%SStC_P_P_2_SubStructure) + UB(1:1) = ubound(InData%SStC_P_P_2_SubStructure) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%SStC_P_P_2_SubStructure(i1)) + end do + end if + call RegPack(Buf, allocated(InData%SubStructure_2_SStC_P_P)) + if (allocated(InData%SubStructure_2_SStC_P_P)) then + call RegPackBounds(Buf, 1, lbound(InData%SubStructure_2_SStC_P_P), ubound(InData%SubStructure_2_SStC_P_P)) + LB(1:1) = lbound(InData%SubStructure_2_SStC_P_P) + UB(1:1) = ubound(InData%SubStructure_2_SStC_P_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%SubStructure_2_SStC_P_P(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_SrvD_P_P) + call RegPack(Buf, allocated(InData%BDED_L_2_AD_L_B)) + if (allocated(InData%BDED_L_2_AD_L_B)) then + call RegPackBounds(Buf, 1, lbound(InData%BDED_L_2_AD_L_B), ubound(InData%BDED_L_2_AD_L_B)) + LB(1:1) = lbound(InData%BDED_L_2_AD_L_B) + UB(1:1) = ubound(InData%BDED_L_2_AD_L_B) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%BDED_L_2_AD_L_B(i1)) + end do + end if + call RegPack(Buf, allocated(InData%AD_L_2_BDED_B)) + if (allocated(InData%AD_L_2_BDED_B)) then + call RegPackBounds(Buf, 1, lbound(InData%AD_L_2_BDED_B), ubound(InData%AD_L_2_BDED_B)) + LB(1:1) = lbound(InData%AD_L_2_BDED_B) + UB(1:1) = ubound(InData%AD_L_2_BDED_B) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%AD_L_2_BDED_B(i1)) + end do + end if + call RegPack(Buf, allocated(InData%BD_L_2_BD_L)) + if (allocated(InData%BD_L_2_BD_L)) then + call RegPackBounds(Buf, 1, lbound(InData%BD_L_2_BD_L), ubound(InData%BD_L_2_BD_L)) + LB(1:1) = lbound(InData%BD_L_2_BD_L) + UB(1:1) = ubound(InData%BD_L_2_BD_L) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%BD_L_2_BD_L(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_N) + call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_ED_P_N) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_TF) + call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_ED_P_TF) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_L_2_AD_L_T) + call NWTC_Library_PackMeshMapType(Buf, InData%AD_L_2_ED_P_T) + call RegPack(Buf, allocated(InData%ED_P_2_AD_P_R)) + if (allocated(InData%ED_P_2_AD_P_R)) then + call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) + LB(1:1) = lbound(InData%ED_P_2_AD_P_R) + UB(1:1) = ubound(InData%ED_P_2_AD_P_R) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_R(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_H) + call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_ED_P_H) + call NWTC_Library_PackMeshMapType(Buf, InData%IceF_P_2_SD_P) + call NWTC_Library_PackMeshMapType(Buf, InData%SDy3_P_2_IceF_P) + call RegPack(Buf, allocated(InData%IceD_P_2_SD_P)) + if (allocated(InData%IceD_P_2_SD_P)) then + call RegPackBounds(Buf, 1, lbound(InData%IceD_P_2_SD_P), ubound(InData%IceD_P_2_SD_P)) + LB(1:1) = lbound(InData%IceD_P_2_SD_P) + UB(1:1) = ubound(InData%IceD_P_2_SD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%IceD_P_2_SD_P(i1)) + end do + end if + call RegPack(Buf, allocated(InData%SDy3_P_2_IceD_P)) + if (allocated(InData%SDy3_P_2_IceD_P)) then + call RegPackBounds(Buf, 1, lbound(InData%SDy3_P_2_IceD_P), ubound(InData%SDy3_P_2_IceD_P)) + LB(1:1) = lbound(InData%SDy3_P_2_IceD_P) + UB(1:1) = ubound(InData%SDy3_P_2_IceD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%SDy3_P_2_IceD_P(i1)) + end do + end if + call RegPack(Buf, allocated(InData%Jacobian_Opt1)) + if (allocated(InData%Jacobian_Opt1)) then + call RegPackBounds(Buf, 2, lbound(InData%Jacobian_Opt1), ubound(InData%Jacobian_Opt1)) + call RegPack(Buf, InData%Jacobian_Opt1) + end if + call RegPack(Buf, allocated(InData%Jacobian_pivot)) + if (allocated(InData%Jacobian_pivot)) then + call RegPackBounds(Buf, 1, lbound(InData%Jacobian_pivot), ubound(InData%Jacobian_pivot)) + call RegPack(Buf, InData%Jacobian_pivot) + end if + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + call MeshPack(Buf, InData%u_ED_NacelleLoads) + call MeshPack(Buf, InData%SubstructureLoads_Tmp) + call MeshPack(Buf, InData%SubstructureLoads_Tmp2) + call MeshPack(Buf, InData%PlatformLoads_Tmp) + call MeshPack(Buf, InData%PlatformLoads_Tmp2) + call MeshPack(Buf, InData%SubstructureLoads_Tmp_Farm) + call MeshPack(Buf, InData%u_ED_TowerPtloads) + call RegPack(Buf, allocated(InData%u_ED_BladePtLoads)) + if (allocated(InData%u_ED_BladePtLoads)) then + call RegPackBounds(Buf, 1, lbound(InData%u_ED_BladePtLoads), ubound(InData%u_ED_BladePtLoads)) + LB(1:1) = lbound(InData%u_ED_BladePtLoads) + UB(1:1) = ubound(InData%u_ED_BladePtLoads) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%u_ED_BladePtLoads(i1)) + end do + end if + call MeshPack(Buf, InData%u_SD_TPMesh) + call MeshPack(Buf, InData%u_HD_M_Mesh) + call MeshPack(Buf, InData%u_HD_W_Mesh) + call MeshPack(Buf, InData%u_ED_HubPtLoad) + call MeshPack(Buf, InData%u_ED_HubPtLoad_2) + call RegPack(Buf, allocated(InData%u_BD_RootMotion)) + if (allocated(InData%u_BD_RootMotion)) then + call RegPackBounds(Buf, 1, lbound(InData%u_BD_RootMotion), ubound(InData%u_BD_RootMotion)) + LB(1:1) = lbound(InData%u_BD_RootMotion) + UB(1:1) = ubound(InData%u_BD_RootMotion) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%u_BD_RootMotion(i1)) + end do + end if + call RegPack(Buf, allocated(InData%y_BD_BldMotion_4Loads)) + if (allocated(InData%y_BD_BldMotion_4Loads)) then + call RegPackBounds(Buf, 1, lbound(InData%y_BD_BldMotion_4Loads), ubound(InData%y_BD_BldMotion_4Loads)) + LB(1:1) = lbound(InData%y_BD_BldMotion_4Loads) + UB(1:1) = ubound(InData%y_BD_BldMotion_4Loads) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%y_BD_BldMotion_4Loads(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u_BD_Distrload)) + if (allocated(InData%u_BD_Distrload)) then + call RegPackBounds(Buf, 1, lbound(InData%u_BD_Distrload), ubound(InData%u_BD_Distrload)) + LB(1:1) = lbound(InData%u_BD_Distrload) + UB(1:1) = ubound(InData%u_BD_Distrload) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%u_BD_Distrload(i1)) + end do + end if + call MeshPack(Buf, InData%u_Orca_PtfmMesh) + call MeshPack(Buf, InData%u_ExtPtfm_PtfmMesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackModuleMapType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ModuleMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackModuleMapType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%ED_P_2_BD_P)) deallocate(OutData%ED_P_2_BD_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ED_P_2_BD_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_BD_P(i1)) ! ED_P_2_BD_P + end do + end if + if (allocated(OutData%BD_P_2_ED_P)) deallocate(OutData%BD_P_2_ED_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BD_P_2_ED_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_P_2_ED_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%BD_P_2_ED_P(i1)) ! BD_P_2_ED_P + end do + end if + if (allocated(OutData%ED_P_2_BD_P_Hub)) deallocate(OutData%ED_P_2_BD_P_Hub) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ED_P_2_BD_P_Hub(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P_Hub.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_BD_P_Hub(i1)) ! ED_P_2_BD_P_Hub + end do + end if + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_HD_PRP_P) ! ED_P_2_HD_PRP_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SubStructure_2_HD_W_P) ! SubStructure_2_HD_W_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%HD_W_P_2_SubStructure) ! HD_W_P_2_SubStructure + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SubStructure_2_HD_M_P) ! SubStructure_2_HD_M_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%HD_M_P_2_SubStructure) ! HD_M_P_2_SubStructure + call NWTC_Library_UnpackMeshMapType(Buf, OutData%Structure_2_Mooring) ! Structure_2_Mooring + call NWTC_Library_UnpackMeshMapType(Buf, OutData%Mooring_2_Structure) ! Mooring_2_Structure + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_SD_TP) ! ED_P_2_SD_TP + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SD_TP_2_ED_P) ! SD_TP_2_ED_P + if (allocated(OutData%ED_P_2_NStC_P_N)) deallocate(OutData%ED_P_2_NStC_P_N) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ED_P_2_NStC_P_N(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_NStC_P_N.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_NStC_P_N(i1)) ! ED_P_2_NStC_P_N + end do + end if + if (allocated(OutData%NStC_P_2_ED_P_N)) deallocate(OutData%NStC_P_2_ED_P_N) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC_P_2_ED_P_N(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_P_2_ED_P_N.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%NStC_P_2_ED_P_N(i1)) ! NStC_P_2_ED_P_N + end do + end if + if (allocated(OutData%ED_L_2_TStC_P_T)) deallocate(OutData%ED_L_2_TStC_P_T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ED_L_2_TStC_P_T(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_TStC_P_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_L_2_TStC_P_T(i1)) ! ED_L_2_TStC_P_T + end do + end if + if (allocated(OutData%TStC_P_2_ED_P_T)) deallocate(OutData%TStC_P_2_ED_P_T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC_P_2_ED_P_T(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_P_2_ED_P_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%TStC_P_2_ED_P_T(i1)) ! TStC_P_2_ED_P_T + end do + end if + if (allocated(OutData%ED_L_2_BStC_P_B)) deallocate(OutData%ED_L_2_BStC_P_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ED_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_BStC_P_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_L_2_BStC_P_B(i1,i2)) ! ED_L_2_BStC_P_B + end do + end do + end if + if (allocated(OutData%BStC_P_2_ED_P_B)) deallocate(OutData%BStC_P_2_ED_P_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC_P_2_ED_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_ED_P_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%BStC_P_2_ED_P_B(i1,i2)) ! BStC_P_2_ED_P_B + end do + end do + end if + if (allocated(OutData%BD_L_2_BStC_P_B)) deallocate(OutData%BD_L_2_BStC_P_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BD_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BStC_P_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%BD_L_2_BStC_P_B(i1,i2)) ! BD_L_2_BStC_P_B + end do + end do + end if + if (allocated(OutData%BStC_P_2_BD_P_B)) deallocate(OutData%BStC_P_2_BD_P_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC_P_2_BD_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_BD_P_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%BStC_P_2_BD_P_B(i1,i2)) ! BStC_P_2_BD_P_B + end do + end do + end if + if (allocated(OutData%SStC_P_P_2_SubStructure)) deallocate(OutData%SStC_P_P_2_SubStructure) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC_P_P_2_SubStructure(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_P_P_2_SubStructure.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SStC_P_P_2_SubStructure(i1)) ! SStC_P_P_2_SubStructure + end do + end if + if (allocated(OutData%SubStructure_2_SStC_P_P)) deallocate(OutData%SubStructure_2_SStC_P_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SubStructure_2_SStC_P_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SubStructure_2_SStC_P_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SubStructure_2_SStC_P_P(i1)) ! SubStructure_2_SStC_P_P + end do + end if + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_SrvD_P_P) ! ED_P_2_SrvD_P_P + if (allocated(OutData%BDED_L_2_AD_L_B)) deallocate(OutData%BDED_L_2_AD_L_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BDED_L_2_AD_L_B(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_AD_L_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%BDED_L_2_AD_L_B(i1)) ! BDED_L_2_AD_L_B + end do + end if + if (allocated(OutData%AD_L_2_BDED_B)) deallocate(OutData%AD_L_2_BDED_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AD_L_2_BDED_B(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_BDED_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_L_2_BDED_B(i1)) ! AD_L_2_BDED_B + end do + end if + if (allocated(OutData%BD_L_2_BD_L)) deallocate(OutData%BD_L_2_BD_L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BD_L_2_BD_L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BD_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%BD_L_2_BD_L(i1)) ! BD_L_2_BD_L + end do + end if + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_N) ! ED_P_2_AD_P_N + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_ED_P_N) ! AD_P_2_ED_P_N + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_TF) ! ED_P_2_AD_P_TF + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_ED_P_TF) ! AD_P_2_ED_P_TF + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_L_2_AD_L_T) ! ED_L_2_AD_L_T + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_L_2_ED_P_T) ! AD_L_2_ED_P_T + if (allocated(OutData%ED_P_2_AD_P_R)) deallocate(OutData%ED_P_2_AD_P_R) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ED_P_2_AD_P_R(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_R(i1)) ! ED_P_2_AD_P_R + end do + end if + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_H) ! ED_P_2_AD_P_H + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_ED_P_H) ! AD_P_2_ED_P_H + call NWTC_Library_UnpackMeshMapType(Buf, OutData%IceF_P_2_SD_P) ! IceF_P_2_SD_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SDy3_P_2_IceF_P) ! SDy3_P_2_IceF_P + if (allocated(OutData%IceD_P_2_SD_P)) deallocate(OutData%IceD_P_2_SD_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IceD_P_2_SD_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceD_P_2_SD_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%IceD_P_2_SD_P(i1)) ! IceD_P_2_SD_P + end do + end if + if (allocated(OutData%SDy3_P_2_IceD_P)) deallocate(OutData%SDy3_P_2_IceD_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SDy3_P_2_IceD_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDy3_P_2_IceD_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SDy3_P_2_IceD_P(i1)) ! SDy3_P_2_IceD_P + end do + end if + if (allocated(OutData%Jacobian_Opt1)) deallocate(OutData%Jacobian_Opt1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jacobian_Opt1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_Opt1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jacobian_Opt1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jacobian_pivot)) deallocate(OutData%Jacobian_pivot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jacobian_pivot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_pivot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jacobian_pivot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + call MeshUnpack(Buf, OutData%u_ED_NacelleLoads) ! u_ED_NacelleLoads + call MeshUnpack(Buf, OutData%SubstructureLoads_Tmp) ! SubstructureLoads_Tmp + call MeshUnpack(Buf, OutData%SubstructureLoads_Tmp2) ! SubstructureLoads_Tmp2 + call MeshUnpack(Buf, OutData%PlatformLoads_Tmp) ! PlatformLoads_Tmp + call MeshUnpack(Buf, OutData%PlatformLoads_Tmp2) ! PlatformLoads_Tmp2 + call MeshUnpack(Buf, OutData%SubstructureLoads_Tmp_Farm) ! SubstructureLoads_Tmp_Farm + call MeshUnpack(Buf, OutData%u_ED_TowerPtloads) ! u_ED_TowerPtloads + if (allocated(OutData%u_ED_BladePtLoads)) deallocate(OutData%u_ED_BladePtLoads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_ED_BladePtLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED_BladePtLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%u_ED_BladePtLoads(i1)) ! u_ED_BladePtLoads + end do + end if + call MeshUnpack(Buf, OutData%u_SD_TPMesh) ! u_SD_TPMesh + call MeshUnpack(Buf, OutData%u_HD_M_Mesh) ! u_HD_M_Mesh + call MeshUnpack(Buf, OutData%u_HD_W_Mesh) ! u_HD_W_Mesh + call MeshUnpack(Buf, OutData%u_ED_HubPtLoad) ! u_ED_HubPtLoad + call MeshUnpack(Buf, OutData%u_ED_HubPtLoad_2) ! u_ED_HubPtLoad_2 + if (allocated(OutData%u_BD_RootMotion)) deallocate(OutData%u_BD_RootMotion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_BD_RootMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_RootMotion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%u_BD_RootMotion(i1)) ! u_BD_RootMotion + end do + end if + if (allocated(OutData%y_BD_BldMotion_4Loads)) deallocate(OutData%y_BD_BldMotion_4Loads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_BD_BldMotion_4Loads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BD_BldMotion_4Loads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%y_BD_BldMotion_4Loads(i1)) ! y_BD_BldMotion_4Loads + end do + end if + if (allocated(OutData%u_BD_Distrload)) deallocate(OutData%u_BD_Distrload) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_BD_Distrload(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_Distrload.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%u_BD_Distrload(i1)) ! u_BD_Distrload + end do + end if + call MeshUnpack(Buf, OutData%u_Orca_PtfmMesh) ! u_Orca_PtfmMesh + call MeshUnpack(Buf, OutData%u_ExtPtfm_PtfmMesh) ! u_ExtPtfm_PtfmMesh +end subroutine + +subroutine FAST_CopyExternInputType(SrcExternInputTypeData, DstExternInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_ExternInputType), intent(in) :: SrcExternInputTypeData + type(FAST_ExternInputType), intent(inout) :: DstExternInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_CopyExternInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstExternInputTypeData%GenTrq = SrcExternInputTypeData%GenTrq + DstExternInputTypeData%ElecPwr = SrcExternInputTypeData%ElecPwr + DstExternInputTypeData%YawPosCom = SrcExternInputTypeData%YawPosCom + DstExternInputTypeData%YawRateCom = SrcExternInputTypeData%YawRateCom + DstExternInputTypeData%BlPitchCom = SrcExternInputTypeData%BlPitchCom + DstExternInputTypeData%BlAirfoilCom = SrcExternInputTypeData%BlAirfoilCom + DstExternInputTypeData%HSSBrFrac = SrcExternInputTypeData%HSSBrFrac + DstExternInputTypeData%LidarFocus = SrcExternInputTypeData%LidarFocus + DstExternInputTypeData%CableDeltaL = SrcExternInputTypeData%CableDeltaL + DstExternInputTypeData%CableDeltaLdot = SrcExternInputTypeData%CableDeltaLdot +end subroutine + +subroutine FAST_DestroyExternInputType(ExternInputTypeData, ErrStat, ErrMsg) + type(FAST_ExternInputType), intent(inout) :: ExternInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyExternInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FAST_PackExternInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ExternInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackExternInputType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%GenTrq) + call RegPack(Buf, InData%ElecPwr) + call RegPack(Buf, InData%YawPosCom) + call RegPack(Buf, InData%YawRateCom) + call RegPack(Buf, InData%BlPitchCom) + call RegPack(Buf, InData%BlAirfoilCom) + call RegPack(Buf, InData%HSSBrFrac) + call RegPack(Buf, InData%LidarFocus) + call RegPack(Buf, InData%CableDeltaL) + call RegPack(Buf, InData%CableDeltaLdot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackExternInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ExternInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackExternInputType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%GenTrq) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ElecPwr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawPosCom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawRateCom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BlPitchCom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BlAirfoilCom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HSSBrFrac) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LidarFocus) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CableDeltaL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CableDeltaLdot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(FAST_MiscVarType), intent(in) :: SrcMiscData + type(FAST_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%TiLstPrn = SrcMiscData%TiLstPrn + DstMiscData%t_global = SrcMiscData%t_global + DstMiscData%NextJacCalcTime = SrcMiscData%NextJacCalcTime + DstMiscData%PrevClockTime = SrcMiscData%PrevClockTime + DstMiscData%UsrTime1 = SrcMiscData%UsrTime1 + DstMiscData%UsrTime2 = SrcMiscData%UsrTime2 + DstMiscData%StrtTime = SrcMiscData%StrtTime + DstMiscData%SimStrtTime = SrcMiscData%SimStrtTime + DstMiscData%calcJacobian = SrcMiscData%calcJacobian + call FAST_CopyExternInputType(SrcMiscData%ExternInput, DstMiscData%ExternInput, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyMiscLinType(SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FAST_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(FAST_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call FAST_DestroyExternInputType(MiscData%ExternInput, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyMiscLinType(MiscData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%TiLstPrn) + call RegPack(Buf, InData%t_global) + call RegPack(Buf, InData%NextJacCalcTime) + call RegPack(Buf, InData%PrevClockTime) + call RegPack(Buf, InData%UsrTime1) + call RegPack(Buf, InData%UsrTime2) + call RegPack(Buf, InData%StrtTime) + call RegPack(Buf, InData%SimStrtTime) + call RegPack(Buf, InData%calcJacobian) + call FAST_PackExternInputType(Buf, InData%ExternInput) + call FAST_PackMiscLinType(Buf, InData%Lin) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%TiLstPrn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%t_global) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NextJacCalcTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PrevClockTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UsrTime1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UsrTime2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StrtTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimStrtTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%calcJacobian) + if (RegCheckErr(Buf, RoutineName)) return + call FAST_UnpackExternInputType(Buf, OutData%ExternInput) ! ExternInput + call FAST_UnpackMiscLinType(Buf, OutData%Lin) ! Lin +end subroutine + +subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat, ErrMsg) + type(FAST_InitData), intent(inout) :: SrcInitDataData + type(FAST_InitData), intent(inout) :: DstInitDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyInitData' + ErrStat = ErrID_None + ErrMsg = '' + call ED_CopyInitInput(SrcInitDataData%InData_ED, DstInitDataData%InData_ED, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyInitOutput(SrcInitDataData%OutData_ED, DstInitDataData%OutData_ED, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BD_CopyInitInput(SrcInitDataData%InData_BD, DstInitDataData%InData_BD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitDataData%OutData_BD)) then + LB(1:1) = lbound(SrcInitDataData%OutData_BD) + UB(1:1) = ubound(SrcInitDataData%OutData_BD) + if (.not. allocated(DstInitDataData%OutData_BD)) then + allocate(DstInitDataData%OutData_BD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitDataData%OutData_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyInitOutput(SrcInitDataData%OutData_BD(i1), DstInitDataData%OutData_BD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call SrvD_CopyInitInput(SrcInitDataData%InData_SrvD, DstInitDataData%InData_SrvD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyInitOutput(SrcInitDataData%OutData_SrvD, DstInitDataData%OutData_SrvD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyInitInput(SrcInitDataData%InData_AD14, DstInitDataData%InData_AD14, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyInitOutput(SrcInitDataData%OutData_AD14, DstInitDataData%OutData_AD14, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyInitInput(SrcInitDataData%InData_AD, DstInitDataData%InData_AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyInitOutput(SrcInitDataData%OutData_AD, DstInitDataData%OutData_AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInitInput(SrcInitDataData%InData_IfW, DstInitDataData%InData_IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInitOutput(SrcInitDataData%OutData_IfW, DstInitDataData%OutData_IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call OpFM_CopyInitInput(SrcInitDataData%InData_OpFM, DstInitDataData%InData_OpFM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call OpFM_CopyInitOutput(SrcInitDataData%OutData_OpFM, DstInitDataData%OutData_OpFM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInitInput(SrcInitDataData%InData_SeaSt, DstInitDataData%InData_SeaSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInitOutput(SrcInitDataData%OutData_SeaSt, DstInitDataData%OutData_SeaSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyInitInput(SrcInitDataData%InData_HD, DstInitDataData%InData_HD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyInitOutput(SrcInitDataData%OutData_HD, DstInitDataData%OutData_HD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyInitInput(SrcInitDataData%InData_SD, DstInitDataData%InData_SD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyInitOutput(SrcInitDataData%OutData_SD, DstInitDataData%OutData_SD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyInitInput(SrcInitDataData%InData_ExtPtfm, DstInitDataData%InData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyInitOutput(SrcInitDataData%OutData_ExtPtfm, DstInitDataData%OutData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyInitInput(SrcInitDataData%InData_MAP, DstInitDataData%InData_MAP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyInitOutput(SrcInitDataData%OutData_MAP, DstInitDataData%OutData_MAP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyInitInput(SrcInitDataData%InData_FEAM, DstInitDataData%InData_FEAM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyInitOutput(SrcInitDataData%OutData_FEAM, DstInitDataData%OutData_FEAM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyInitInput(SrcInitDataData%InData_MD, DstInitDataData%InData_MD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyInitOutput(SrcInitDataData%OutData_MD, DstInitDataData%OutData_MD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Orca_CopyInitInput(SrcInitDataData%InData_Orca, DstInitDataData%InData_Orca, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Orca_CopyInitOutput(SrcInitDataData%OutData_Orca, DstInitDataData%OutData_Orca, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyInitInput(SrcInitDataData%InData_IceF, DstInitDataData%InData_IceF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyInitOutput(SrcInitDataData%OutData_IceF, DstInitDataData%OutData_IceF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceD_CopyInitInput(SrcInitDataData%InData_IceD, DstInitDataData%InData_IceD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceD_CopyInitOutput(SrcInitDataData%OutData_IceD, DstInitDataData%OutData_IceD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) + type(FAST_InitData), intent(inout) :: InitDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyInitData' + ErrStat = ErrID_None + ErrMsg = '' + call ED_DestroyInitInput(InitDataData%InData_ED, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyInitOutput(InitDataData%OutData_ED, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyInitInput(InitDataData%InData_BD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitDataData%OutData_BD)) then + LB(1:1) = lbound(InitDataData%OutData_BD) + UB(1:1) = ubound(InitDataData%OutData_BD) + do i1 = LB(1), UB(1) + call BD_DestroyInitOutput(InitDataData%OutData_BD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitDataData%OutData_BD) + end if + call SrvD_DestroyInitInput(InitDataData%InData_SrvD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyInitOutput(InitDataData%OutData_SrvD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyInitInput(InitDataData%InData_AD14, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyInitOutput(InitDataData%OutData_AD14, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyInitInput(InitDataData%InData_AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyInitOutput(InitDataData%OutData_AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInitInput(InitDataData%InData_IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInitOutput(InitDataData%OutData_IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call OpFM_DestroyInitInput(InitDataData%InData_OpFM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call OpFM_DestroyInitOutput(InitDataData%OutData_OpFM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInitInput(InitDataData%InData_SeaSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInitOutput(InitDataData%OutData_SeaSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyInitInput(InitDataData%InData_HD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyInitOutput(InitDataData%OutData_HD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyInitInput(InitDataData%InData_SD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyInitOutput(InitDataData%OutData_SD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyInitInput(InitDataData%InData_ExtPtfm, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyInitOutput(InitDataData%OutData_ExtPtfm, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyInitInput(InitDataData%InData_MAP, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyInitOutput(InitDataData%OutData_MAP, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FEAM_DestroyInitInput(InitDataData%InData_FEAM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FEAM_DestroyInitOutput(InitDataData%OutData_FEAM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyInitInput(InitDataData%InData_MD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyInitOutput(InitDataData%OutData_MD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Orca_DestroyInitInput(InitDataData%InData_Orca, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Orca_DestroyInitOutput(InitDataData%OutData_Orca, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyInitInput(InitDataData%InData_IceF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyInitOutput(InitDataData%OutData_IceF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceD_DestroyInitInput(InitDataData%InData_IceD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceD_DestroyInitOutput(InitDataData%OutData_IceD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackInitData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_InitData), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackInitData' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call ED_PackInitInput(Buf, InData%InData_ED) + call ED_PackInitOutput(Buf, InData%OutData_ED) + call BD_PackInitInput(Buf, InData%InData_BD) + call RegPack(Buf, allocated(InData%OutData_BD)) + if (allocated(InData%OutData_BD)) then + call RegPackBounds(Buf, 1, lbound(InData%OutData_BD), ubound(InData%OutData_BD)) + LB(1:1) = lbound(InData%OutData_BD) + UB(1:1) = ubound(InData%OutData_BD) + do i1 = LB(1), UB(1) + call BD_PackInitOutput(Buf, InData%OutData_BD(i1)) + end do + end if + call SrvD_PackInitInput(Buf, InData%InData_SrvD) + call SrvD_PackInitOutput(Buf, InData%OutData_SrvD) + call AD14_PackInitInput(Buf, InData%InData_AD14) + call AD14_PackInitOutput(Buf, InData%OutData_AD14) + call AD_PackInitInput(Buf, InData%InData_AD) + call AD_PackInitOutput(Buf, InData%OutData_AD) + call InflowWind_PackInitInput(Buf, InData%InData_IfW) + call InflowWind_PackInitOutput(Buf, InData%OutData_IfW) + call OpFM_PackInitInput(Buf, InData%InData_OpFM) + call OpFM_PackInitOutput(Buf, InData%OutData_OpFM) + call SeaSt_PackInitInput(Buf, InData%InData_SeaSt) + call SeaSt_PackInitOutput(Buf, InData%OutData_SeaSt) + call HydroDyn_PackInitInput(Buf, InData%InData_HD) + call HydroDyn_PackInitOutput(Buf, InData%OutData_HD) + call SD_PackInitInput(Buf, InData%InData_SD) + call SD_PackInitOutput(Buf, InData%OutData_SD) + call ExtPtfm_PackInitInput(Buf, InData%InData_ExtPtfm) + call ExtPtfm_PackInitOutput(Buf, InData%OutData_ExtPtfm) + call MAP_PackInitInput(Buf, InData%InData_MAP) + call MAP_PackInitOutput(Buf, InData%OutData_MAP) + call FEAM_PackInitInput(Buf, InData%InData_FEAM) + call FEAM_PackInitOutput(Buf, InData%OutData_FEAM) + call MD_PackInitInput(Buf, InData%InData_MD) + call MD_PackInitOutput(Buf, InData%OutData_MD) + call Orca_PackInitInput(Buf, InData%InData_Orca) + call Orca_PackInitOutput(Buf, InData%OutData_Orca) + call IceFloe_PackInitInput(Buf, InData%InData_IceF) + call IceFloe_PackInitOutput(Buf, InData%OutData_IceF) + call IceD_PackInitInput(Buf, InData%InData_IceD) + call IceD_PackInitOutput(Buf, InData%OutData_IceD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackInitData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_InitData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackInitData' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call ED_UnpackInitInput(Buf, OutData%InData_ED) ! InData_ED + call ED_UnpackInitOutput(Buf, OutData%OutData_ED) ! OutData_ED + call BD_UnpackInitInput(Buf, OutData%InData_BD) ! InData_BD + if (allocated(OutData%OutData_BD)) deallocate(OutData%OutData_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutData_BD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutData_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackInitOutput(Buf, OutData%OutData_BD(i1)) ! OutData_BD + end do + end if + call SrvD_UnpackInitInput(Buf, OutData%InData_SrvD) ! InData_SrvD + call SrvD_UnpackInitOutput(Buf, OutData%OutData_SrvD) ! OutData_SrvD + call AD14_UnpackInitInput(Buf, OutData%InData_AD14) ! InData_AD14 + call AD14_UnpackInitOutput(Buf, OutData%OutData_AD14) ! OutData_AD14 + call AD_UnpackInitInput(Buf, OutData%InData_AD) ! InData_AD + call AD_UnpackInitOutput(Buf, OutData%OutData_AD) ! OutData_AD + call InflowWind_UnpackInitInput(Buf, OutData%InData_IfW) ! InData_IfW + call InflowWind_UnpackInitOutput(Buf, OutData%OutData_IfW) ! OutData_IfW + call OpFM_UnpackInitInput(Buf, OutData%InData_OpFM) ! InData_OpFM + call OpFM_UnpackInitOutput(Buf, OutData%OutData_OpFM) ! OutData_OpFM + call SeaSt_UnpackInitInput(Buf, OutData%InData_SeaSt) ! InData_SeaSt + call SeaSt_UnpackInitOutput(Buf, OutData%OutData_SeaSt) ! OutData_SeaSt + call HydroDyn_UnpackInitInput(Buf, OutData%InData_HD) ! InData_HD + call HydroDyn_UnpackInitOutput(Buf, OutData%OutData_HD) ! OutData_HD + call SD_UnpackInitInput(Buf, OutData%InData_SD) ! InData_SD + call SD_UnpackInitOutput(Buf, OutData%OutData_SD) ! OutData_SD + call ExtPtfm_UnpackInitInput(Buf, OutData%InData_ExtPtfm) ! InData_ExtPtfm + call ExtPtfm_UnpackInitOutput(Buf, OutData%OutData_ExtPtfm) ! OutData_ExtPtfm + call MAP_UnpackInitInput(Buf, OutData%InData_MAP) ! InData_MAP + call MAP_UnpackInitOutput(Buf, OutData%OutData_MAP) ! OutData_MAP + call FEAM_UnpackInitInput(Buf, OutData%InData_FEAM) ! InData_FEAM + call FEAM_UnpackInitOutput(Buf, OutData%OutData_FEAM) ! OutData_FEAM + call MD_UnpackInitInput(Buf, OutData%InData_MD) ! InData_MD + call MD_UnpackInitOutput(Buf, OutData%OutData_MD) ! OutData_MD + call Orca_UnpackInitInput(Buf, OutData%InData_Orca) ! InData_Orca + call Orca_UnpackInitOutput(Buf, OutData%OutData_Orca) ! OutData_Orca + call IceFloe_UnpackInitInput(Buf, OutData%InData_IceF) ! InData_IceF + call IceFloe_UnpackInitOutput(Buf, OutData%OutData_IceF) ! OutData_IceF + call IceD_UnpackInitInput(Buf, OutData%InData_IceD) ! InData_IceD + call IceD_UnpackInitOutput(Buf, OutData%OutData_IceD) ! OutData_IceD +end subroutine + +subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_ExternInitType), intent(in) :: SrcExternInitTypeData + type(FAST_ExternInitType), intent(inout) :: DstExternInitTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyExternInitType' + ErrStat = ErrID_None + ErrMsg = '' + DstExternInitTypeData%Tmax = SrcExternInitTypeData%Tmax + DstExternInitTypeData%SensorType = SrcExternInitTypeData%SensorType + DstExternInitTypeData%LidRadialVel = SrcExternInitTypeData%LidRadialVel + DstExternInitTypeData%TurbineID = SrcExternInitTypeData%TurbineID + DstExternInitTypeData%TurbinePos = SrcExternInitTypeData%TurbinePos + DstExternInitTypeData%WaveFieldMod = SrcExternInitTypeData%WaveFieldMod + DstExternInitTypeData%NumSC2CtrlGlob = SrcExternInitTypeData%NumSC2CtrlGlob + DstExternInitTypeData%NumSC2Ctrl = SrcExternInitTypeData%NumSC2Ctrl + DstExternInitTypeData%NumCtrl2SC = SrcExternInitTypeData%NumCtrl2SC + if (allocated(SrcExternInitTypeData%fromSCGlob)) then + LB(1:1) = lbound(SrcExternInitTypeData%fromSCGlob) + UB(1:1) = ubound(SrcExternInitTypeData%fromSCGlob) + if (.not. allocated(DstExternInitTypeData%fromSCGlob)) then + allocate(DstExternInitTypeData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExternInitTypeData%fromSCGlob.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstExternInitTypeData%fromSCGlob = SrcExternInitTypeData%fromSCGlob + end if + if (allocated(SrcExternInitTypeData%fromSC)) then + LB(1:1) = lbound(SrcExternInitTypeData%fromSC) + UB(1:1) = ubound(SrcExternInitTypeData%fromSC) + if (.not. allocated(DstExternInitTypeData%fromSC)) then + allocate(DstExternInitTypeData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExternInitTypeData%fromSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstExternInitTypeData%fromSC = SrcExternInitTypeData%fromSC + end if + DstExternInitTypeData%FarmIntegration = SrcExternInitTypeData%FarmIntegration + DstExternInitTypeData%windGrid_n = SrcExternInitTypeData%windGrid_n + DstExternInitTypeData%windGrid_delta = SrcExternInitTypeData%windGrid_delta + DstExternInitTypeData%windGrid_pZero = SrcExternInitTypeData%windGrid_pZero + DstExternInitTypeData%windGrid_data => SrcExternInitTypeData%windGrid_data + DstExternInitTypeData%RootName = SrcExternInitTypeData%RootName + DstExternInitTypeData%NumActForcePtsBlade = SrcExternInitTypeData%NumActForcePtsBlade + DstExternInitTypeData%NumActForcePtsTower = SrcExternInitTypeData%NumActForcePtsTower + DstExternInitTypeData%NodeClusterType = SrcExternInitTypeData%NodeClusterType +end subroutine + +subroutine FAST_DestroyExternInitType(ExternInitTypeData, ErrStat, ErrMsg) + type(FAST_ExternInitType), intent(inout) :: ExternInitTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyExternInitType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ExternInitTypeData%fromSCGlob)) then + deallocate(ExternInitTypeData%fromSCGlob) + end if + if (allocated(ExternInitTypeData%fromSC)) then + deallocate(ExternInitTypeData%fromSC) + end if + nullify(ExternInitTypeData%windGrid_data) +end subroutine + +subroutine FAST_PackExternInitType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ExternInitType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackExternInitType' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Tmax) + call RegPack(Buf, InData%SensorType) + call RegPack(Buf, InData%LidRadialVel) + call RegPack(Buf, InData%TurbineID) + call RegPack(Buf, InData%TurbinePos) + call RegPack(Buf, InData%WaveFieldMod) + call RegPack(Buf, InData%NumSC2CtrlGlob) + call RegPack(Buf, InData%NumSC2Ctrl) + call RegPack(Buf, InData%NumCtrl2SC) + call RegPack(Buf, allocated(InData%fromSCGlob)) + if (allocated(InData%fromSCGlob)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob), ubound(InData%fromSCGlob)) + call RegPack(Buf, InData%fromSCGlob) + end if + call RegPack(Buf, allocated(InData%fromSC)) + if (allocated(InData%fromSC)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPack(Buf, InData%fromSC) + end if + call RegPack(Buf, InData%FarmIntegration) + call RegPack(Buf, InData%windGrid_n) + call RegPack(Buf, InData%windGrid_delta) + call RegPack(Buf, InData%windGrid_pZero) + call RegPack(Buf, associated(InData%windGrid_data)) + if (associated(InData%windGrid_data)) then + call RegPackBounds(Buf, 5, lbound(InData%windGrid_data), ubound(InData%windGrid_data)) + call RegPackPointer(Buf, c_loc(InData%windGrid_data), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%windGrid_data) + end if + end if + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%NumActForcePtsBlade) + call RegPack(Buf, InData%NumActForcePtsTower) + call RegPack(Buf, InData%NodeClusterType) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackExternInitType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ExternInitType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackExternInitType' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LidRadialVel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TurbineID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TurbinePos) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%fromSCGlob)) deallocate(OutData%fromSCGlob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSCGlob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCGlob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSCGlob) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%FarmIntegration) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%windGrid_n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%windGrid_delta) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%windGrid_pZero) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%windGrid_data)) deallocate(OutData%windGrid_data) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%windGrid_data, UB(1:5)-LB(1:5)) + OutData%windGrid_data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%windGrid_data + else + allocate(OutData%windGrid_data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%windGrid_data.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%windGrid_data) + call RegUnpack(Buf, OutData%windGrid_data) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%windGrid_data => null() + end if + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumActForcePtsBlade) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumActForcePtsTower) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NodeClusterType) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_CopyTurbineType(SrcTurbineTypeData, DstTurbineTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_TurbineType), intent(inout) :: SrcTurbineTypeData + type(FAST_TurbineType), intent(inout) :: DstTurbineTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyTurbineType' + ErrStat = ErrID_None + ErrMsg = '' + DstTurbineTypeData%TurbID = SrcTurbineTypeData%TurbID + call FAST_CopyParam(SrcTurbineTypeData%p_FAST, DstTurbineTypeData%p_FAST, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyOutputFileType(SrcTurbineTypeData%y_FAST, DstTurbineTypeData%y_FAST, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyMisc(SrcTurbineTypeData%m_FAST, DstTurbineTypeData%m_FAST, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyModuleMapType(SrcTurbineTypeData%MeshMapData, DstTurbineTypeData%MeshMapData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyElastoDyn_Data(SrcTurbineTypeData%ED, DstTurbineTypeData%ED, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyBeamDyn_Data(SrcTurbineTypeData%BD, DstTurbineTypeData%BD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyServoDyn_Data(SrcTurbineTypeData%SrvD, DstTurbineTypeData%SrvD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyAeroDyn_Data(SrcTurbineTypeData%AD, DstTurbineTypeData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyAeroDyn14_Data(SrcTurbineTypeData%AD14, DstTurbineTypeData%AD14, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyInflowWind_Data(SrcTurbineTypeData%IfW, DstTurbineTypeData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyOpenFOAM_Data(SrcTurbineTypeData%OpFM, DstTurbineTypeData%OpFM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopySCDataEx_Data(SrcTurbineTypeData%SC_DX, DstTurbineTypeData%SC_DX, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopySeaState_Data(SrcTurbineTypeData%SeaSt, DstTurbineTypeData%SeaSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyHydroDyn_Data(SrcTurbineTypeData%HD, DstTurbineTypeData%HD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopySubDyn_Data(SrcTurbineTypeData%SD, DstTurbineTypeData%SD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyMAP_Data(SrcTurbineTypeData%MAP, DstTurbineTypeData%MAP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyFEAMooring_Data(SrcTurbineTypeData%FEAM, DstTurbineTypeData%FEAM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyMoorDyn_Data(SrcTurbineTypeData%MD, DstTurbineTypeData%MD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyOrcaFlex_Data(SrcTurbineTypeData%Orca, DstTurbineTypeData%Orca, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyIceFloe_Data(SrcTurbineTypeData%IceF, DstTurbineTypeData%IceF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyIceDyn_Data(SrcTurbineTypeData%IceD, DstTurbineTypeData%IceD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyExtPtfm_Data(SrcTurbineTypeData%ExtPtfm, DstTurbineTypeData%ExtPtfm, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FAST_DestroyTurbineType(TurbineTypeData, ErrStat, ErrMsg) + type(FAST_TurbineType), intent(inout) :: TurbineTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyTurbineType' + ErrStat = ErrID_None + ErrMsg = '' + call FAST_DestroyParam(TurbineTypeData%p_FAST, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyOutputFileType(TurbineTypeData%y_FAST, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyMisc(TurbineTypeData%m_FAST, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyModuleMapType(TurbineTypeData%MeshMapData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyElastoDyn_Data(TurbineTypeData%ED, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyBeamDyn_Data(TurbineTypeData%BD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyServoDyn_Data(TurbineTypeData%SrvD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyAeroDyn_Data(TurbineTypeData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyAeroDyn14_Data(TurbineTypeData%AD14, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyInflowWind_Data(TurbineTypeData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyOpenFOAM_Data(TurbineTypeData%OpFM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroySCDataEx_Data(TurbineTypeData%SC_DX, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroySeaState_Data(TurbineTypeData%SeaSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyHydroDyn_Data(TurbineTypeData%HD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroySubDyn_Data(TurbineTypeData%SD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyMAP_Data(TurbineTypeData%MAP, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyFEAMooring_Data(TurbineTypeData%FEAM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyMoorDyn_Data(TurbineTypeData%MD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyOrcaFlex_Data(TurbineTypeData%Orca, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyIceFloe_Data(TurbineTypeData%IceF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyIceDyn_Data(TurbineTypeData%IceD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyExtPtfm_Data(TurbineTypeData%ExtPtfm, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackTurbineType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_TurbineType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackTurbineType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%TurbID) + call FAST_PackParam(Buf, InData%p_FAST) + call FAST_PackOutputFileType(Buf, InData%y_FAST) + call FAST_PackMisc(Buf, InData%m_FAST) + call FAST_PackModuleMapType(Buf, InData%MeshMapData) + call FAST_PackElastoDyn_Data(Buf, InData%ED) + call FAST_PackBeamDyn_Data(Buf, InData%BD) + call FAST_PackServoDyn_Data(Buf, InData%SrvD) + call FAST_PackAeroDyn_Data(Buf, InData%AD) + call FAST_PackAeroDyn14_Data(Buf, InData%AD14) + call FAST_PackInflowWind_Data(Buf, InData%IfW) + call FAST_PackOpenFOAM_Data(Buf, InData%OpFM) + call FAST_PackSCDataEx_Data(Buf, InData%SC_DX) + call FAST_PackSeaState_Data(Buf, InData%SeaSt) + call FAST_PackHydroDyn_Data(Buf, InData%HD) + call FAST_PackSubDyn_Data(Buf, InData%SD) + call FAST_PackMAP_Data(Buf, InData%MAP) + call FAST_PackFEAMooring_Data(Buf, InData%FEAM) + call FAST_PackMoorDyn_Data(Buf, InData%MD) + call FAST_PackOrcaFlex_Data(Buf, InData%Orca) + call FAST_PackIceFloe_Data(Buf, InData%IceF) + call FAST_PackIceDyn_Data(Buf, InData%IceD) + call FAST_PackExtPtfm_Data(Buf, InData%ExtPtfm) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackTurbineType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_TurbineType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackTurbineType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%TurbID) + if (RegCheckErr(Buf, RoutineName)) return + call FAST_UnpackParam(Buf, OutData%p_FAST) ! p_FAST + call FAST_UnpackOutputFileType(Buf, OutData%y_FAST) ! y_FAST + call FAST_UnpackMisc(Buf, OutData%m_FAST) ! m_FAST + call FAST_UnpackModuleMapType(Buf, OutData%MeshMapData) ! MeshMapData + call FAST_UnpackElastoDyn_Data(Buf, OutData%ED) ! ED + call FAST_UnpackBeamDyn_Data(Buf, OutData%BD) ! BD + call FAST_UnpackServoDyn_Data(Buf, OutData%SrvD) ! SrvD + call FAST_UnpackAeroDyn_Data(Buf, OutData%AD) ! AD + call FAST_UnpackAeroDyn14_Data(Buf, OutData%AD14) ! AD14 + call FAST_UnpackInflowWind_Data(Buf, OutData%IfW) ! IfW + call FAST_UnpackOpenFOAM_Data(Buf, OutData%OpFM) ! OpFM + call FAST_UnpackSCDataEx_Data(Buf, OutData%SC_DX) ! SC_DX + call FAST_UnpackSeaState_Data(Buf, OutData%SeaSt) ! SeaSt + call FAST_UnpackHydroDyn_Data(Buf, OutData%HD) ! HD + call FAST_UnpackSubDyn_Data(Buf, OutData%SD) ! SD + call FAST_UnpackMAP_Data(Buf, OutData%MAP) ! MAP + call FAST_UnpackFEAMooring_Data(Buf, OutData%FEAM) ! FEAM + call FAST_UnpackMoorDyn_Data(Buf, OutData%MD) ! MD + call FAST_UnpackOrcaFlex_Data(Buf, OutData%Orca) ! Orca + call FAST_UnpackIceFloe_Data(Buf, OutData%IceF) ! IceF + call FAST_UnpackIceDyn_Data(Buf, OutData%IceD) ! IceD + call FAST_UnpackExtPtfm_Data(Buf, OutData%ExtPtfm) ! ExtPtfm +end subroutine END MODULE FAST_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/openfast-registry/src/registry.hpp b/modules/openfast-registry/src/registry.hpp index 53f3de5d5c..8229622d75 100644 --- a/modules/openfast-registry/src/registry.hpp +++ b/modules/openfast-registry/src/registry.hpp @@ -54,7 +54,7 @@ struct InterfaceData struct DimSpec { - size_t i; + size_t i = 0; bool is_deferred = false; bool is_pointer = false; std::string lower_bound = "1"; @@ -161,7 +161,7 @@ struct Field } // Get field rank (number of dimensions) - this->rank = this->dims.size(); + this->rank = static_cast(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(), diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index f16d6c354b..58fb7582f3 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -1,4 +1,5 @@ #include +#include #include "registry.hpp" #include "templates.hpp" @@ -64,6 +65,7 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) auto file_name = mod.name + "_Types.f90"; auto file_path = out_dir + "/" + file_name; std::cerr << "generating " << file_name << std::endl; + bool is_NWTC_Library = false; // Open file, exit if error std::ofstream w(file_path); @@ -83,7 +85,8 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) // 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"; + w << "USE SysSubs\n" + << "USE ModReg\n"; else w << "USE NWTC_Library\n"; @@ -210,14 +213,50 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) w << " :: " << field.name << " "; + // Add field initialization if (field.is_pointer) { w << "=> NULL() "; } - else if (field.rank == 0 && !field.init_value.empty()) + else if (field.is_allocatable) + { + // No initialization + } + else if (!field.init_value.empty()) { w << "= " << field.init_value << " "; } + else + { + switch (field.data_type->tag) + { + case DataType::Tag::Real: + switch (field.data_type->basic.bit_size) + { + case 0: + w << "= 0.0_ReKi "; + break; + case 32: + w << "= 0.0_R4Ki "; + break; + case 64: + w << "= 0.0_R8Ki "; + break; + } + break; + case DataType::Tag::Integer: + w << "= 0_IntKi "; + break; + case DataType::Tag::Logical: + w << "= .false. "; + break; + case DataType::Tag::Character: + // w << "= '' "; // This breaks MAP (TODO) + break; + case DataType::Tag::Derived: + break; + } + } if (field.desc.compare("-") != 0 || field.units.compare("-") != 0) { @@ -277,138 +316,174 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) 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"; + auto routine_name = mod.nickname + "_Copy" + ddt.name_short; + std::string indent("\n"); + + bool has_alloc = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.is_allocatable; }); + bool has_ddt = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived; }); + bool has_ddt_arr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); + + w << indent << "subroutine " << routine_name << "(Src" << ddt.name_short + << "Data, Dst" << ddt.name_short << "Data, CtrlCode, ErrStat, ErrMsg)"; + indent += " "; + w << indent << "type(" << ddt.type_fortran << "), intent(" << (ddt.contains_mesh ? "inout" : "in") + << ") :: Src" << ddt.name_short << "Data"; + w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: Dst" << ddt.name_short << "Data"; + w << indent << "integer(IntKi), intent(in ) :: CtrlCode"; + w << indent << "integer(IntKi), intent( out) :: ErrStat"; + w << indent << "character(*), intent( out) :: ErrMsg"; + if (has_ddt_arr) + { + w << indent << "integer(IntKi) :: "; + for (int i = 1; i <= ddt.max_rank; i++) + w << (i > 1 ? ", " : "") << "i" << i; + w << ""; + } + if (has_ddt_arr || has_alloc) + w << indent << "integer(IntKi) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + if (has_ddt || has_alloc) + w << indent << "integer(IntKi) :: ErrStat2"; + if (has_ddt) + w << indent << "character(ErrMsgLen) :: ErrMsg2"; + w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; // Loop through fields for (auto &field : ddt.fields) { - std::string alloc_assoc = field.is_pointer ? "ASSOCIATED" : "ALLOCATED"; + 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 + // w << indent << "! " << field.name; + + // If field is a non-target pointer, associate the destination // pointer with the source pointer if (field.is_pointer && !field.is_target) { - w << " " << dst << " => " << src << "\n"; + w << indent << dst << " => " << src; continue; } - // If field is an allocatable array + // If field is allocatable if (field.is_allocatable) { - w << "IF (" << alloc_assoc << "(" << src << ")) THEN\n"; + w << indent << "if (" << alloc_assoc << "(" << src << ")) then"; + indent += " "; - std::string dims; - for (int d = 1; d <= field.rank; d++) + std::string dims(""); + if (field.rank > 0) { - 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 << indent << "LB(1:" << field.rank << ") = lbound(" << src << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ")"; + for (int d = 1; d <= field.rank; d++) + dims += ",LB(" + std::to_string(d) + "):UB(" + std::to_string(d) + ")"; + dims = "(" + dims.substr(1) + ")"; } - 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"; + // If dst alloc/assoc + w << indent << "if (.not. " << alloc_assoc << "(" << dst << ")) then"; + indent += " "; + w << indent << "allocate(" << dst << dims << ", stat=ErrStat2)"; + w << indent << "if (ErrStat2 /= 0) then"; + w << indent << " call SetErrStat(ErrID_Fatal, 'Error allocating " << dst << ".', ErrStat, ErrMsg, RoutineName)"; + w << indent << " return"; + w << indent << "end if"; // bjj: this needs to be updated if we've got multidimensional arrays - if (gen_c_code && field.is_pointer) + if (gen_c_code && field.is_pointer && + (field.data_type->tag != DataType::Tag::Derived)) { 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 << "("; + w << indent << dst_c << "_Len = size(" << dst << ")"; + w << indent << "if (" << dst_c << "_Len > 0) &"; + w << indent << " " << dst_c << " = c_loc(" << dst << "("; for (int d = 1; d <= field.rank; d++) - { - w << (d > 1 ? "," : "") << " i" << d << "_l"; - } - w << " ) )\n"; + w << (d > 1 ? "," : "") << "LB(" << d << ")"; + w << "))"; } - w << " END IF\n"; + // End if dst alloc/assoc + indent.erase(indent.size() - 3); + w << indent << "end if"; } - // includes mesh and dll_type + // If derived data type (includes mesh and dll_type) if (field.data_type->tag == DataType::Tag::Derived) { auto &ddt = field.data_type->derived; + // Get bounds for non-allocated field + if (field.rank > 0 && !field.is_allocatable) + { + w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ")"; + } + for (int d = field.rank; d >= 1; d--) { - w << " DO i" << d << " = LBOUND(" << src << "," << d << "), UBOUND(" << src - << "," << d << ")\n"; + w << indent << "do i" << d << " = LB(" << d << "), UB(" << d << ")"; + indent += " "; } 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"; + w << indent << "call MeshCopy(" << src << dimstr(field.rank) << ", " << dst + << dimstr(field.rank) << ", CtrlCode, ErrStat2, ErrMsg2 )"; + w << indent << "call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + w << indent << "if (ErrStat >= AbortErrLev) return"; } else if (ddt.name_short.compare("DLL_Type") == 0) { - w << " " << dst << " = " << src << "\n"; + w << indent << dst << " = " << src << ""; } else { - w << " CALL " << ddt.module->nickname << "_Copy" - << (ddt.interface == nullptr ? tolower(ddt.name_short) : ddt.name_short) << "( " + w << indent << "call " << ddt.module->nickname << "_Copy" << 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"; + << ", CtrlCode, ErrStat2, ErrMsg2)"; + w << indent << "call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + w << indent << "if (ErrStat >= AbortErrLev) return"; } for (auto &d : field.dims) - w << " ENDDO\n"; + { + indent.erase(indent.size() - 3); + w << indent << "end do"; + } } else { - w << " " << dst << " = " << src << "\n"; + // Copy values + w << indent << dst << " = " << src; + + // If C code and field isn't a pointer, copy data to C object 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"; + w << indent << "Dst" << tmp << " = Src" << tmp; } } } - // close IF (check on allocatable array) + // End if for source is allocated/associated + // If source is not allocated/associated, but destination is allocated if (field.is_allocatable) - w << "ENDIF\n"; + { + indent.erase(indent.size() - 3); + w << indent << "end if"; + } } - w << " END SUBROUTINE " << mod.nickname << "_Copy" << ddt.name_short << "\n" - << std::endl; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; } void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, @@ -416,106 +491,120 @@ void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &dd { auto ddt_data = ddt.name_short + "Data"; auto routine_name = mod.nickname + "_Destroy" + ddt.name_short; + std::string indent("\n"); + + bool has_ddt = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived; }); + bool has_ddt_arr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); + + w << indent << "subroutine " << routine_name << "(" << ddt_data << ", ErrStat, ErrMsg)"; + indent += " "; + w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: " << ddt_data; + w << indent << "integer(IntKi), intent( out) :: ErrStat"; + w << indent << "character(*), intent( out) :: ErrMsg"; + if (has_ddt_arr) + { + w << indent << "integer(IntKi) :: "; + for (int i = 1; i <= ddt.max_rank; i++) + w << (i > 1 ? ", " : "") << "i" << i; + w << indent << "integer(IntKi) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + } + if (has_ddt) + { + w << indent << "integer(IntKi) :: ErrStat2"; + w << indent << "character(ErrMsgLen) :: ErrMsg2"; + } + w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; - 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"; - + // Loop through fields in derived data type for (auto &field : ddt.fields) { - // Combine data name and field name - auto ddt_field = ddt_data + "%" + field.name; + auto var = ddt_data + "%" + field.name; + std::string alloc_assoc = field.is_pointer ? "associated" : "allocated"; + + // w << indent << "! " << field.name; // If non-target pointer field, just nullify pointer if (field.is_pointer && !field.is_target) { - w << "NULLIFY(" << ddt_field << ")\n"; + w << indent << "nullify(" << var << ")"; continue; } - // If field is an array with deferred dimensions + // If field is allocatable if (field.is_allocatable) { - w << "IF (" << (field.is_pointer ? "ASSOCIATED" : "ALLOCATED") << "(" << ddt_field - << ")) THEN\n"; + w << indent << "if (" << alloc_assoc << "(" << var << ")) then"; + indent += " "; } // If field is a derived data type, loop through elements and destroy if (field.data_type->tag == DataType::Tag::Derived) { + auto var_dims = var + dimstr(field.rank); + + if (field.rank > 0) + { + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; + } for (int d = field.rank; d >= 1; d--) { - w << "DO i" << d << " = LBOUND(" << ddt_field << "," << d << "), UBOUND(" - << ddt_field << "," << d << ")\n"; + w << indent << "do i" << d << " = LB(" << d << "), UB(" << d << ")"; + indent += " "; } - 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"; + w << indent << "call MeshDestroy( " << var_dims << ", ErrStat2, ErrMsg2)"; + w << indent << "call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; } 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"; + w << indent << "call FreeDynamicLib( " << var_dims << ", ErrStat2, ErrMsg2)"; + w << indent << "call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; } 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"; - } + w << indent << "call " << field.data_type->derived.module->nickname << "_Destroy" + << field.data_type->derived.name_short << "(" << var_dims << ", ErrStat2, ErrMsg2)"; + w << indent << "call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; } // Close for loops for (int d = field.rank; d >= 1; d--) - w << "ENDDO\n"; + { + indent.erase(indent.size() - 3); + w << indent << "end do"; + } } if (field.is_allocatable) { - w << " DEALLOCATE(" << ddt_field << ")\n"; + w << indent << "deallocate(" << var << ")"; if (field.is_pointer) - w << " " << ddt_field << " => NULL()\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 << indent << var << " => null()"; + + if (gen_c_code && (field.data_type->tag != DataType::Tag::Derived)) + { + auto var_c = ddt_data + "%C_obj%" + field.name; + w << indent << var_c << " = c_null_ptr"; + w << indent << var_c << "_Len = 0"; + } } - w << "ENDIF\n"; + + indent.erase(indent.size() - 3); + w << indent << "end if"; } } - w << " END SUBROUTINE " << mod.nickname << "_Destroy" << ddt.name_short << "\n\n"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; } void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, @@ -523,630 +612,305 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, { 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) + std::string indent("\n"); + + bool has_alloc = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.is_allocatable; }); + bool has_ptr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.is_pointer; }); + bool has_ddt_arr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); + + w << indent << "subroutine " << routine_name << "(Buf, Indata)"; + indent += " "; + w << indent << "type(PackBuffer), intent(inout) :: Buf"; + w << indent << "type(" << ddt.type_fortran << "), intent(in) :: InData"; + w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; + if (has_ddt_arr) { - // 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"; + w << indent << "integer(IntKi) :: "; + for (int i = 1; i <= ddt.max_rank; i++) + w << (i > 1 ? ", " : "") << "i" << i; + w << indent << "integer(IntKi) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + } + if (has_ptr) + { + w << indent << "logical :: PtrInIndex"; } - // 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"; + w << indent << "if (Buf%ErrStat >= AbortErrLev) return"; 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 << indent << "if (c_associated(InData%C_obj%object)) then"; + w << indent << " call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName)"; + w << indent << " return"; + w << indent << "end if"; } - 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 var = "InData%" + field.name; - auto assoc_alloc = field.is_pointer ? "ASSOCIATED" : "ALLOCATED"; - auto field_dims = field.name + dimstr(field.rank); + // w << indent << "! " << field.name; 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 << indent << "call RegPack(Buf, " << assoc_alloc << "(" << var << "))"; + w << indent << "if (" << assoc_alloc << "(" << var << ")) then"; + indent += " "; + if (field.rank > 0) { - 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 << indent << "call RegPackBounds(Buf, " << field.rank << ", lbound(" << var << "), ubound(" << var << "))"; } - w << "\n"; - mainIndent = " "; } - else + if (field.is_pointer) { - mainIndent = ""; + w << indent << "call RegPackPointer(Buf, c_loc(" << var << "), PtrInIndex)"; + w << indent << "if (.not. PtrInIndex) then"; + indent += " "; } // call individual routines to pack data from subtypes: if (field.data_type->tag == DataType::Tag::Derived) { - if (frst == 1) + auto field_dims = var + dimstr(field.rank); + + if (field.rank > 0) { - w << " ! Allocate buffers for subtypes, if any (we'll get sizes from these) \n"; - frst = false; + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; } for (int d = field.rank; d >= 1; d--) { - w << " DO i" << d << " = LBOUND(InData%" << field.name << "," << d - << "), UBOUND(InData%" << field.name << "," << d << ")\n"; + w << indent << "do i" << d << " = LB(" << d << "), UB(" << d << ")"; + indent += " "; } 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"; + w << indent << "call MeshPack(Buf, " << field_dims << ") "; } 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"; + w << indent << "call DLLTypePack(Buf, " << field_dims << ") "; } 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 << indent << "call " << field.data_type->derived.module->nickname << "_Pack" + << field.data_type->derived.name_short << "(Buf, " << field_dims << ") "; } - 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"; + indent.erase(indent.size() - 3); + w << indent << "end do"; } } 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"; - } + // Intrinsic types are handled by generic Pack method on buffer + w << indent << "call RegPack(Buf, " << var << ")"; + } - 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_pointer) + { + indent.erase(indent.size() - 3); + w << indent << "end if"; } if (field.is_allocatable) - w << " END IF\n"; + { + indent.erase(indent.size() - 3); + w << indent << "end if"; + } } - w << " END SUBROUTINE " << routine_name << "\n\n"; + // Check for pack errors at end of routine + w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; + + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; } 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++) + std::string indent("\n"); + + bool has_alloc = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.is_allocatable; }); + bool has_ptr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.is_pointer; }); + bool has_ddt_arr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); + + w << indent << "subroutine " << routine_name << "(Buf, OutData)"; + indent += " "; + w << indent << "type(PackBuffer), intent(inout) :: Buf"; + w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: OutData"; + w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; + if (has_ddt_arr) { - w << " INTEGER(IntKi) :: i" << d << ", i" << d << "_l, i" << d - << "_u ! bounds (upper/lower) for an array dimension " << d << "\n"; + w << indent << "integer(IntKi) :: "; + for (int i = 1; i <= ddt.max_rank; i++) + w << (i > 1 ? ", " : "") << "i" << i; + w << ""; } - 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"; + if (has_ddt_arr || has_alloc) + { + w << indent << "integer(IntKi) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + } + if (has_alloc) + { + w << indent << "integer(IntKi) :: stat"; + w << indent << "logical :: IsAllocAssoc"; + } + if (has_ptr) + { + w << indent << "integer(IntKi) :: PtrIdx"; + w << indent << "type(c_ptr) :: Ptr"; + } + w << indent << "if (Buf%ErrStat /= ErrID_None) return"; // 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; + auto assoc_alloc = field.is_pointer ? "associated" : "allocated"; - // Nullify non-target pointer fields and continue - if (field.is_pointer && !field.is_target) - { - w << " NULLIFY(" << var << ")\n"; - continue; - } + // w << indent << "! " << field.name << ""; 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 << indent << "if (" << assoc_alloc << "(" << var << ")) deallocate(" << var << ")"; + w << indent << "call RegUnpack(Buf, IsAllocAssoc)"; + w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; + w << indent << "if (IsAllocAssoc) then"; + indent += " "; + if (field.rank > 0) { - 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 << indent << "call RegUnpackBounds(Buf, " << field.rank << ", LB, UB)"; + w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; } + } - 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) + if (field.is_pointer) + { + w << indent << "call RegUnpackPointer(Buf, Ptr, PtrIdx)"; + w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; + w << indent << "if (c_associated(Ptr)) then"; + if (field.rank == 0) { - w << " " << var_c << "_Len = SIZE(" << var << ")\n"; - w << " IF (" << var_c << "_Len > 0) &\n"; - w << " " << var_c << " = C_LOC( " << var << "("; + w << indent << " call c_f_pointer(Ptr, " << var << ")"; + } + else + { + auto rank = std::to_string(field.rank); + w << indent << " call c_f_pointer(Ptr, " << var << ", UB(1:" << rank << ")-LB(1:" << rank << "))"; + std::string remap_dims; for (int d = 1; d <= field.rank; d++) - w << (d > 1 ? "," : "") << " i" << d << "_l"; - w << " ) )\n"; + remap_dims += std::string(d > 1 ? "," : "") + "LB(" + std::to_string(d) + "):"; + w << indent << " " << var << "(" << remap_dims << ") => " << var; } - mainIndent = " "; + w << indent << "else"; + indent += " "; } - else + + if (field.is_allocatable) { + std::string dims; 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 = ""; + dims += std::string(d == 1 ? "(" : "") + "LB(" + std::to_string(d) + ")" + + ":UB(" + std::to_string(d) + ")" + (d < field.rank ? "," : ")"); + w << indent << "allocate(" << var << dims << ",stat=stat)"; + w << indent << "if (stat /= 0) then "; + w << indent << " call SetErrStat(ErrID_Fatal, 'Error allocating " << var << ".', Buf%ErrStat, Buf%ErrMsg, RoutineName)"; + w << indent << " return"; + w << indent << "end if"; } - // Call individual routines to pack data from subtypes: - if (field.data_type->tag == DataType::Tag::Derived) + // If this is a pointer, set pointer in buffer pointer index + if (field.is_pointer) { - for (int d = field.rank; d >= 1; d--) - { - w << " DO i" << d << " = LBOUND(" << var << "," << d << "), UBOUND(" << var - << "," << d << ")\n"; - } + w << indent << "Buf%Pointers(PtrIdx) = c_loc(" << var << ")"; + } - // 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"; + // bjj: this needs to be updated if we've got multiple dimension arrays + if (gen_c_code && field.is_pointer && + (field.data_type->tag != DataType::Tag::Derived)) + { + w << indent << var_c << "_Len = size(" << var << ")"; + w << indent << "if (" << var_c << "_Len > 0) " << var_c << " = c_loc(" << var << "("; + for (int d = 1; d <= field.rank; d++) + w << (d > 1 ? "," : "") << "LB(" << d << ")"; + w << "))"; + } - 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 + // Call individual routines to unpack data from subtypes: + if (field.data_type->tag == DataType::Tag::Derived) + { + // Get bounds for non-allocated field + if (field.rank > 0 && !field.is_allocatable) { - 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 << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; } - 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 += " "; + w << indent << "do i" << d << " = LB(" << d << "), UB(" << d << ")"; + 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) + if (field.data_type->derived.name.compare("MeshType") == 0) { - w << indent << " " << var_dims << " = IntKiBuf(Int_Xferred)\n"; - w << indent << " Int_Xferred = Int_Xferred + 1\n"; + w << indent << "call MeshUnpack(Buf, " << var_dims << ") ! " << field.name << " "; } - else if (field.data_type->tag == DataType::Tag::Logical) + else if (field.data_type->derived.name.compare("DLL_Type") == 0) { - w << indent << " " << var_dims << " = TRANSFER(IntKiBuf(Int_Xferred), OutData%" - << field_dims << ")\n"; - w << indent << " Int_Xferred = Int_Xferred + 1\n"; + w << indent << "call DLLTypeUnpack(Buf, " << var_dims << ") ! " << field.name << " "; } - else if (field.data_type->tag == DataType::Tag::Character) + else { - - 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"; + w << indent << "call " << field.data_type->derived.module->nickname << "_Unpack" + << field.data_type->derived.name_short << "(Buf, " << var_dims << ") ! " << field.name << " "; } for (int d = field.rank; d >= 1; d--) { - indent = " " + mainIndent; - for (int i = 1; i < d; i++) - indent += " "; - w << indent << " END DO\n"; + indent.erase(indent.size() - 3); + w << indent << "end do"; } + } + else + { + // Intrinsic types are handled by generic unpack method on buffer + w << indent << "call RegUnpack(Buf, " << var << ")"; + w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; // 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"; + w << indent << var_c << " = " << var << ""; break; case DataType::Tag::Character: - w << " " << var_c << " = TRANSFER(" << var << ", " << var_c << " )\n"; + w << indent << var_c << " = transfer(" << var << ", " << var_c << " )"; break; case DataType::Tag::Derived: break; @@ -1154,18 +918,32 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt } } + if (field.is_pointer) + { + indent.erase(indent.size() - 3); + w << indent << "end if"; + } + if (field.is_allocatable) - w << " END IF\n"; + { + indent.erase(indent.size() - 3); + if (field.is_pointer) + { + w << indent << "else"; + w << indent << " " << var << " => null()"; + } + w << indent << "end if"; + } } - w << " END SUBROUTINE " << routine_name << "\n\n"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; } 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) + const Field &field, const std::string &deref, const int recurse_level, std::string &indent) { - std::string indent, tmp; - if (recurse_level > MAXRECURSE) { std::cerr << "REGISTRY ERROR: too many levels of array subtypes\n"; @@ -1183,8 +961,8 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const // check if this is an allocatable array: if (field.is_allocatable) { - w << "IF (" << assoc_alloc << "(" << vout << ") .AND. " << assoc_alloc << "(" << v1 - << ")) THEN\n"; + w << indent << "IF (" << assoc_alloc << "(" << vout << ") .AND. " << assoc_alloc << "(" << v1 << ")) THEN"; + indent += " "; } if (field.data_type->tag == DataType::Tag::Derived) @@ -1200,8 +978,8 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const 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"; + w << indent << "DO i" << recurse_level << j << " = LBOUND(" << uy << "_out" << field_var << "," << j << "),UBOUND(" << uy << "_out" << field_var << "," << j << ")"; + indent += " "; } if (field.rank > 0) @@ -1211,17 +989,17 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const { 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); + gen_extint_order(w, mod, uy, order, sub_field, field_var, recurse_level + 1, indent); + for (int j = field.rank; j > 0; j--) { - w << " ENDDO\n"; + indent.erase(indent.size() - 3); + w << indent << "END DO"; } } } @@ -1229,58 +1007,59 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const { for (int j = field.rank; j > 0; j--) { - w << " DO i" << j << " = LBOUND(" << vout << "," << j << "),UBOUND(" << vout << "," - << j << ")\n"; + w << indent << "DO i" << j << " = LBOUND(" << vout << "," << j << "),UBOUND(" << vout << "," << j << ")"; + indent += " "; } if (field.data_type->derived.name.compare("MeshType") == 0) { if (order == 0) { - w << " CALL MeshCopy(" << v1 + dims << ", " << vout + dims - << ", MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n"; + w << indent << "CALL MeshCopy(" << v1 + dims << ", " << vout + dims + << ", MESH_UPDATECOPY, ErrStat2, ErrMsg2)"; } else if (order == 1) { - w << " CALL MeshExtrapInterp1(" << v1 + dims << ", " << v2 + dims - << ", tin, " << vout + dims << ", tin_out, ErrStat2, ErrMsg2 )\n"; + w << indent << "CALL MeshExtrapInterp1(" << v1 + dims << ", " << v2 + dims + << ", tin, " << vout + dims << ", tin_out, ErrStat2, ErrMsg2)"; } else if (order == 2) { - w << " CALL MeshExtrapInterp2(" << v1 + dims << ", " << v2 + dims << ", " + w << indent << "CALL MeshExtrapInterp2(" << v1 + dims << ", " << v2 + dims << ", " << v3 + dims << ", tin, " << vout + dims - << ", tin_out, ErrStat2, ErrMsg2 )\n"; + << ", tin_out, ErrStat2, ErrMsg2)"; } } else { if (order == 0) { - w << " CALL " << field.data_type->derived.module->nickname << "_Copy" + w << indent << "CALL " << field.data_type->derived.module->nickname << "_Copy" << field.data_type->derived.name_short << "(" << v1 + dims << ", " - << vout + dims << ", MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n"; + << vout + dims << ", MESH_UPDATECOPY, ErrStat2, ErrMsg2)"; } else if (order == 1) { - w << " CALL " << field.data_type->derived.module->nickname << "_" + w << indent << "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"; + << ", tin_out, ErrStat2, ErrMsg2)"; } else if (order == 2) { - w << " CALL " << field.data_type->derived.module->nickname << "_" + w << indent << "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"; + << ", tin_out, ErrStat2, ErrMsg2)"; } } - w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"; + w << indent << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)"; for (int j = field.rank; j >= 1; j--) { - w << " ENDDO\n"; + indent.erase(indent.size() - 3); + w << indent << "END DO"; } } } @@ -1288,63 +1067,58 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const { 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 = ""; + w << indent << vout << " = " << v1; } - for (int j = field.rank; j > 0; j--) + if (order == 0 || field.gen_periodic == Period::TwoPi) { - w << indent << " DO i" << j << " = LBOUND(" << vout << "," << j << "),UBOUND(" << vout - << "," << j << ")\n"; - indent += " "; + for (int j = field.rank; j > 0; j--) + { + w << indent << "DO i" << j << " = LBOUND(" << vout << "," << j << "),UBOUND(" << vout << "," << j << ")"; + 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"; + w << indent << "CALL Angles_ExtrapInterp( " << v1 + dims << ", " << v2 + dims + << ", tin, " << vout + dims << ", tin_out )"; } else { - w << indent << " b = -(" << v1 + dims << " - " << v2 + dims << ")\n"; - w << indent << " " << vout + dims << " = " << v1 + dims << " + b * ScaleFactor\n"; + w << indent << vout << " = a1*" << v1 << " + a2*" << v2; }; } 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"; + w << indent << "CALL Angles_ExtrapInterp( " << v1 + dims << ", " << v2 + dims + << ", " << v3 + dims << ", tin, " << vout + dims << ", tin_out )"; } 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"; + w << indent << vout << " = a1*" << v1 << " + a2*" << v2 << " + a3*" << v3; } } - for (int j = field.rank; j >= 1; j--) + if (order == 0 || field.gen_periodic == Period::TwoPi) { - indent = ""; - for (int i = 1; i < j; i++) - indent += " "; - w << indent << " END DO\n"; + for (int j = field.rank; j >= 1; j--) + { + indent.erase(indent.size() - 3); + w << indent << "END DO"; + } } } // check if this is an allocatable array: if (field.is_allocatable) - w << "END IF ! check if allocated\n"; + { + indent.erase(indent.size() - 3); + w << indent << "END IF ! check if allocated"; + } } void calc_extint_order(std::ostream &w, const Module &mod, const Field &field, int recurse_level, @@ -1395,182 +1169,167 @@ void gen_ExtrapInterp1(std::ostream &w, const Module &mod, const DataType::Deriv 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"; + std::string indent("\n"); + std::string mod_ddt(mod.nickname + "_" + ddt.name_short); + + w << indent << "SUBROUTINE " << mod_ddt << "_ExtrapInterp1(" << uy << "1, " << uy << "2, tin, " << uy << "_out, tin_out, ErrStat, ErrMsg )"; + w << indent << "!"; + w << indent << "! This subroutine calculates a extrapolated (or interpolated) " << ddt.name_short << " " << uy << "_out at time t_out, from previous/future time"; + w << indent << "! values of " << uy << " (which has values associated with times in t). Order of the interpolation is 1."; + w << indent << "!"; + w << indent << "! f(t) = a + b * t, or"; + w << indent << "!"; + w << indent << "! where a and b are determined as the solution to"; + w << indent << "! f(t1) = " << uy << "1, f(t2) = " << uy << "2"; + w << indent << "!"; + w << indent << "!" << std::string(130, '.'); + w << indent; + indent += " "; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") << ") :: " << uy << "1 ! " << ddt.name_short << " at t1 > t2"; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") << ") :: " << uy << "2 ! " << ddt.name_short << " at t2 "; + w << indent << "REAL(" << type_kind << "), INTENT(IN ) :: tin(2) ! Times associated with the " << ddt.name_short << "s"; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << uy << "_out ! " << ddt.name_short << " at tin_out"; + w << indent << "REAL(" << type_kind << "), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to"; + w << indent << "INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation"; + w << indent << "CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None"; + w << indent << "! local variables"; + w << indent << "REAL(" << type_kind << ") :: t(2) ! Times associated with the " << ddt.name_short << "s"; + w << indent << "REAL(" << type_kind << ") :: t_out ! Time to which to be extrap/interpd"; + w << indent << "CHARACTER(*), PARAMETER :: RoutineName = '" << mod_ddt << "_ExtrapInterp1'"; + w << indent << "REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation"; + w << indent << "INTEGER(IntKi) :: ErrStat2 ! local errors"; + w << indent << "CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors"; + 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"; + w << indent << "INTEGER :: i" << i << j << " ! dim" << j + << " level " << i << " counter variable for arrays of ddts"; } } for (int j = 1; j <= max_rank; j++) { - w << " INTEGER :: i" << j << " ! dim" << j - << " counter variable for arrays\n"; + w << indent << "INTEGER :: i" << j << " ! dim" << j + << " counter variable for arrays"; } - 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; + w << indent << "! Initialize ErrStat"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; + w << indent << "! we'll subtract a constant from the times to resolve some "; + w << indent << "! numerical issues when t gets large (and to simplify the equations)"; + w << indent << "t = tin - tin(1)"; + w << indent << "t_out = tin_out - tin(1)"; + w << indent; + w << indent << "IF (EqualRealNos(t(1), t(2))) THEN"; + w << indent << " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName)"; + w << indent << " RETURN"; + w << indent << "END IF"; + w << indent; + w << indent << "! Calculate weighting factors from Lagrange polynomial"; + w << indent << "a1 = -(t_out - t(2))/t(2)"; + w << indent << "a2 = t_out/t(2)"; + w << indent; + + // Recursively generate extrap interp code for (const auto &field : ddt.fields) - gen_extint_order(w, mod, uy, 1, field, "", 0); + gen_extint_order(w, mod, uy, 1, field, "", 0, indent); - w << " END SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp1\n"; - w << "\n"; + indent.erase(indent.size() - 3); + w << indent << "END SUBROUTINE"; + w << indent; } 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"; + std::string indent("\n"); + std::string ddt_intent(ddt.contains_mesh == 1 ? "INOUT" : "IN"); + + w << indent << "SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp2(" << uy << "1, " + << uy << "2, " << uy << "3, tin, " << uy << "_out, tin_out, ErrStat, ErrMsg )"; + w << indent << "!"; + w << indent << "! This subroutine calculates a extrapolated (or interpolated) " << ddt.name_short << " " + << uy << "_out at time t_out, from previous/future time"; + w << indent << "! values of " << uy + << " (which has values associated with times in t). Order of the interpolation is 2."; + w << indent << "!"; + w << indent << "! expressions below based on either"; + w << indent << "!"; + w << indent << "! f(t) = a + b * t + c * t**2"; + w << indent << "!"; + w << indent << "! where a, b and c are determined as the solution to"; + w << indent << "! f(t1) = " << uy << "1, f(t2) = " << uy << "2, f(t3) = " << uy << "3"; + w << indent << "!"; + w << indent << "!" << std::string(130, '.') << ""; + w << indent << ""; + indent += " "; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(" << ddt_intent << ") :: " << uy << "1 ! " << ddt.name_short << " at t1 > t2 > t3"; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(" << ddt_intent << ") :: " << uy << "2 ! " << ddt.name_short << " at t2 > t3"; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(" << ddt_intent << ") :: " << uy << "3 ! " << ddt.name_short << " at t3"; + w << indent << "REAL(" << type_kind << "), INTENT(IN ) :: tin(3) ! Times associated with the " << ddt.name_short << "s"; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << uy << "_out ! " << ddt.name_short << " at tin_out"; + w << indent << "REAL(" << type_kind << "), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to"; + + w << indent << "INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation"; + w << indent << "CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None"; + w << indent << "! local variables"; + w << indent << "REAL(" << type_kind << ") :: t(3) ! Times associated with the " << ddt.name_short << "s"; + w << indent << "REAL(" << type_kind << ") :: t_out ! Time to which to be extrap/interpd"; + w << indent << "INTEGER(IntKi) :: order ! order of polynomial fit (max 2)"; + + w << indent << "REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation"; + // w << indent << "REAL(DbKi) :: b ! temporary for extrapolation/interpolation"; + // w << indent << "REAL(DbKi) :: c ! temporary for extrapolation/interpolation"; + // w << indent << "REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation"; + w << indent << "INTEGER(IntKi) :: ErrStat2 ! local errors"; + w << indent << "CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors"; + w << indent << "CHARACTER(*), PARAMETER :: RoutineName = '" << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp2'"; 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"; + w << indent << "INTEGER :: i" << i << j << " ! dim" << j << " level " << i << " counter variable for arrays of ddts"; } } for (int j = 1; j <= max_rank; j++) { - w << " INTEGER :: i" << j << " ! dim" << j - << " counter variable for arrays\n"; + w << indent << "INTEGER :: i" << j << " ! dim" << j << " counter variable for arrays"; } - 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 + w << indent << "! Initialize ErrStat"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; + w << indent << "! we'll subtract a constant from the times to resolve some "; + w << indent << "! numerical issues when t gets large (and to simplify the equations)"; + w << indent << "t = tin - tin(1)"; + w << indent << "t_out = tin_out - tin(1)"; + w << indent; + w << indent << "IF ( EqualRealNos( t(1), t(2) ) ) THEN"; + w << indent << " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)"; + w << indent << " RETURN"; + w << indent << "ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN"; + w << indent << " CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)"; + w << indent << " RETURN"; + w << indent << "ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN"; + w << indent << " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)"; + w << indent << " RETURN"; + w << indent << "END IF"; + w << indent; + // w << indent << "ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3)))"; + w << indent << "! Calculate Lagrange polynomial coefficients"; + w << indent << "a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3)))"; + w << indent << "a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3)))"; + w << indent << "a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2)))"; + + // Recursively generate extrap interp code for (const auto &field : ddt.fields) - { - gen_extint_order(w, mod, uy, 2, field, "", 0); - } + gen_extint_order(w, mod, uy, 2, field, "", 0, indent); - w << " END SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp2\n"; - w << "\n"; + indent.erase(indent.size() - 3); + w << indent << "END SUBROUTINE"; + w << indent; } void gen_ExtrapInterp(std::ostream &w, const Module &mod, std::string type_name_long, @@ -1586,77 +1345,71 @@ void gen_ExtrapInterp(std::ostream &w, const Module &mod, std::string type_name_ return; const auto &ddt = dt->derived; - std::string uy = tolower(ddt.name_short).compare("output") == 0 ? "y" : "u"; + std::string mod_ddt = mod.nickname + "_" + ddt.name_short; - 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"; + std::string uy = tolower(ddt.name_short).compare("output") == 0 ? "y" : "u"; + std::string indent("\n"); + + w << indent << "subroutine " << mod_ddt << "_ExtrapInterp(" << uy << ", t, " << uy << "_out, t_out, ErrStat, ErrMsg)"; + indent += " "; + w << indent << "!"; + w << indent << "! This subroutine calculates a extrapolated (or interpolated) " << ddt.name_short << " " + << uy << "_out at time t_out, from previous/future time"; + w << indent << "! values of " << uy + << " (which has values associated with times in t). Order of the interpolation is given by the size of " << uy; + w << indent << "!"; + w << indent << "! expressions below based on either"; + w << indent << "!"; + w << indent << "! f(t) = a"; + w << indent << "! f(t) = a + b * t, or"; + w << indent << "! f(t) = a + b * t + c * t**2"; + w << indent << "!"; + w << indent << "! where a, b and c are determined as the solution to"; + w << indent << "! f(t1) = " << uy << "1, f(t2) = " << uy << "2, f(t3) = " << uy << "3 (as appropriate)"; + w << indent << "!"; + w << indent << "!" << std::string(130, '-'); + w << indent << ""; + w << indent << "type(" << ddt.type_fortran << "), intent(" << (ddt.contains_mesh == 1 ? "inout" : "in") + << ") :: " << uy << "(:) ! " << ddt.name_short << " at t1 > t2 > t3"; + w << indent << "real(" << type_kind << "), intent(in ) :: t(:) ! Times associated with the " + << ddt.name_short << "s"; // 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"; + w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: " << uy << "_out ! " << ddt.name_short << " at tin_out"; + w << indent << "real(" << type_kind << "), intent(in ) :: t_out ! time to be extrap/interp'd to"; + w << indent << "integer(IntKi), intent( out) :: ErrStat ! Error status of the operation"; + w << indent << "character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None"; + w << indent << "! local variables"; + w << indent << "integer(IntKi) :: order ! order of polynomial fit (max 2)"; + w << indent << "integer(IntKi) :: ErrStat2 ! local errors"; + w << indent << "character(ErrMsgLen) :: ErrMsg2 ! local errors"; + w << indent << "character(*), PARAMETER :: RoutineName = '" << mod_ddt << "_ExtrapInterp'"; + w << indent; + w << indent << "! Initialize ErrStat"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; + w << indent << "if (size(t) /= size(" << uy << ")) then"; + w << indent << " call SetErrStat(ErrID_Fatal, 'size(t) must equal size(" << uy << ")', ErrStat, ErrMsg, RoutineName)"; + w << indent << " return"; + w << indent << "endif"; + w << indent << "order = size(" << uy << ") - 1"; + w << indent << "select case (order)"; + w << indent << "case (0)"; + w << indent << " call " << mod.nickname << "_Copy" << ddt.name_short << "(" << uy << "(1), " << uy << "_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2)"; + w << indent << " call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + w << indent << "case (1)"; + w << indent << " call " << mod_ddt << "_ExtrapInterp1(" << uy << "(1), " << uy << "(2), t, " << uy << "_out, t_out, ErrStat2, ErrMsg2)"; + w << indent << " call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + w << indent << "case (2)"; + w << indent << " call " << mod_ddt << "_ExtrapInterp2(" << uy << "(1), " << uy << "(2), " << uy << "(3), t, " << uy << "_out, t_out, ErrStat2, ErrMsg2)"; + w << indent << " call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + w << indent << "case default"; + w << indent << " call SetErrStat(ErrID_Fatal, 'size(" << uy << ") must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName)"; + w << indent << " return"; + w << indent << "end select"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; // bjj: this is max for module, not for type_name_long int max_rank = 0; // mod.module_ddt_list->max_ndims; @@ -1665,9 +1418,7 @@ void gen_ExtrapInterp(std::ostream &w, const Module &mod, std::string type_name_ // 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, @@ -1681,37 +1432,33 @@ void gen_ExtrapInterp(std::ostream &w, const Module &mod, std::string type_name_ 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"; + std::string indent("\n"); + + w << indent << "SUBROUTINE " << routine_name << "(" << ddt.name_short << "Data, ErrStat, ErrMsg, SkipPointers)"; + indent += " "; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << ddt.name_short << "Data"; + w << indent << "INTEGER(IntKi), INTENT( OUT) :: ErrStat"; + w << indent << "CHARACTER(*), INTENT( OUT) :: ErrMsg"; + w << indent << "LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers"; + w << indent << "! "; + w << indent << "LOGICAL :: SkipPointers_local"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = \"\""; + w << indent; + w << indent << "IF (PRESENT(SkipPointers)) THEN"; + w << indent << " SkipPointers_local = SkipPointers"; + w << indent << "ELSE"; + w << indent << " SkipPointers_local = .false."; + w << indent << "END IF"; // 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"; + << field.data_type->derived.name << " is not passed through C interface"; continue; } @@ -1719,15 +1466,15 @@ void gen_copy_c2f(std::ostream &w, const Module &mod, const DataType::Derived &d 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"; + w << indent; + w << indent << "! -- " << field.name << " " << ddt.name_short << " Data fields"; + w << indent << "IF ( .NOT. SkipPointers_local ) THEN"; + w << indent << " IF ( .NOT. C_ASSOCIATED( " << var_c << " ) ) THEN"; + w << indent << " NULLIFY( " << var_f << " )"; + w << indent << " ELSE"; + w << indent << " CALL C_F_POINTER(" << var_c << ", " << var_f << ", [" << var_c << "_Len])"; + w << indent << " END IF"; + w << indent << "END IF"; } else if (!field.is_allocatable) { @@ -1736,11 +1483,11 @@ void gen_copy_c2f(std::ostream &w, const Module &mod, const DataType::Derived &d case DataType::Tag::Real: case DataType::Tag::Integer: case DataType::Tag::Logical: - w << " " << var_f << " = " << var_c << "\n"; + w << indent << var_f << " = " << var_c; break; case DataType::Tag::Character: if (field.rank == 0) - w << " " << var_f << " = TRANSFER(" << var_c << ", " << var_f << " )\n"; + w << indent << var_f << " = TRANSFER(" << var_c << ", " << var_f << " )"; break; case DataType::Tag::Derived: break; @@ -1748,38 +1495,35 @@ void gen_copy_c2f(std::ostream &w, const Module &mod, const DataType::Derived &d } } - w << " END SUBROUTINE " << routine_name << "\n\n"; + indent.erase(indent.size() - 3); + w << indent << "END SUBROUTINE"; + w << indent; } 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"; + std::string indent("\n"); + + w << indent << "SUBROUTINE " << routine_name << "( " << ddt.name_short << "Data, ErrStat, ErrMsg, SkipPointers )"; + indent += " "; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << ddt.name_short << "Data"; + w << indent << "INTEGER(IntKi), INTENT( OUT) :: ErrStat"; + w << indent << "CHARACTER(*), INTENT( OUT) :: ErrMsg"; + w << indent << "LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers"; + w << indent << "! "; + w << indent << "LOGICAL :: SkipPointers_local"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; + w << indent; + w << indent << "IF (PRESENT(SkipPointers)) THEN"; + w << indent << " SkipPointers_local = SkipPointers"; + w << indent << "ELSE"; + w << indent << " SkipPointers_local = .false."; + w << indent << "END IF"; 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) { @@ -1793,36 +1537,34 @@ void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &d 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 << "("; + std::string dims; 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"; + dims += std::string(d > 1 ? "," : "") + "LBOUND(" + var_f + "," + std::to_string(d) + ")"; + w << indent; + w << indent << "! -- " << field.name << " " << ddt.name_short << " Data fields"; + w << indent << "IF (.NOT. SkipPointers_local ) THEN"; + w << indent << " IF (.NOT. ASSOCIATED(" << var_f << ")) THEN "; + w << indent << " " << var_c << "_Len = 0"; + w << indent << " " << var_c << " = C_NULL_PTR"; + w << indent << " ELSE"; + w << indent << " " << var_c << "_Len = SIZE(" << var_f << ")"; + w << indent << " IF (" << var_c << "_Len > 0) &"; + w << indent << " " << var_c << " = C_LOC(" << var_f << "(" << dims << "))"; + w << indent << " END IF"; + w << indent << "END IF"; } 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"; + w << indent << var_c << " = " << var_f; break; case DataType::Tag::Character: if (field.rank == 0) - w << " " << var_c << " = TRANSFER(" << var_f << ", " << var_c << " )\n"; + w << indent << var_c << " = TRANSFER(" << var_f << ", " << var_c << ")"; break; case DataType::Tag::Derived: break; @@ -1830,5 +1572,7 @@ void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &d } } - w << " END SUBROUTINE " << routine_name << "\n\n"; + indent.erase(indent.size() - 3); + w << indent << "END SUBROUTINE"; + w << indent; } \ No newline at end of file diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index 8f08e34127..46c91244d1 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -49,14 +49,14 @@ MODULE OpenFOAM_Types END TYPE OpFM_InitInputType_C TYPE, PUBLIC :: OpFM_InitInputType TYPE( OpFM_InitInputType_C ) :: C_obj - INTEGER(IntKi) :: NumActForcePtsBlade !< number of actuator line force points in blade -- from extern (used to linearly interpolate along AD15 blades) [-] - INTEGER(IntKi) :: NumActForcePtsTower !< number of actuator line force points in tower -- from extern (used to linearly interpolate along AD15 tower) [-] + INTEGER(IntKi) :: NumActForcePtsBlade = 0_IntKi !< number of actuator line force points in blade -- from extern (used to linearly interpolate along AD15 blades) [-] + INTEGER(IntKi) :: NumActForcePtsTower = 0_IntKi !< number of actuator line force points in tower -- from extern (used to linearly interpolate along AD15 tower) [-] REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: StructBldRNodes => NULL() !< Radius to structural model analysis nodes relative to hub [-] REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: StructTwrHNodes => NULL() !< Location of tower nodes from AD15 (relative to the tower rigid base height) [-] - REAL(ReKi) :: BladeLength !< Blade length [meters] - REAL(ReKi) :: TowerHeight !< Tower Height [meters] - REAL(ReKi) :: TowerBaseHeight !< Tower Base Height [meters] - INTEGER(IntKi) :: NodeClusterType !< Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] + REAL(ReKi) :: BladeLength = 0.0_ReKi !< Blade length [meters] + REAL(ReKi) :: TowerHeight = 0.0_ReKi !< Tower Height [meters] + REAL(ReKi) :: TowerBaseHeight = 0.0_ReKi !< Tower Base Height [meters] + INTEGER(IntKi) :: NodeClusterType = 0_IntKi !< Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] END TYPE OpFM_InitInputType ! ======================= ! ========= OpFM_InitOutputType_C ======= @@ -107,19 +107,19 @@ MODULE OpenFOAM_Types END TYPE OpFM_ParameterType_C TYPE, PUBLIC :: OpFM_ParameterType TYPE( OpFM_ParameterType_C ) :: C_obj - REAL(ReKi) :: AirDens !< Air density for normalization of loads sent to OpenFOAM [kg/m^3] - INTEGER(IntKi) :: NumBl !< Number of blades [-] - INTEGER(IntKi) :: NMappings !< Number of mappings [-] - INTEGER(IntKi) :: NnodesVel !< number of velocity nodes on FAST v8-OpenFOAM interface [-] - INTEGER(IntKi) :: NnodesForce !< number of force nodes on FAST v8-OpenFOAM interface [-] - INTEGER(IntKi) :: NnodesForceBlade !< number of force nodes on FAST v8-OpenFOAM interface [-] - INTEGER(IntKi) :: NnodesForceTower !< number of force nodes on FAST v8-OpenFOAM interface [-] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density for normalization of loads sent to OpenFOAM [kg/m^3] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades [-] + INTEGER(IntKi) :: NMappings = 0_IntKi !< Number of mappings [-] + INTEGER(IntKi) :: NnodesVel = 0_IntKi !< number of velocity nodes on FAST v8-OpenFOAM interface [-] + INTEGER(IntKi) :: NnodesForce = 0_IntKi !< number of force nodes on FAST v8-OpenFOAM interface [-] + INTEGER(IntKi) :: NnodesForceBlade = 0_IntKi !< number of force nodes on FAST v8-OpenFOAM interface [-] + INTEGER(IntKi) :: NnodesForceTower = 0_IntKi !< number of force nodes on FAST v8-OpenFOAM interface [-] REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: forceBldRnodes => NULL() !< Radial location of force nodes [-] REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: forceTwrHnodes => NULL() !< Vertical location of force nodes [-] - REAL(ReKi) :: BladeLength !< Blade length (same for all blades) [m] - REAL(ReKi) :: TowerHeight !< Tower height [m] - REAL(ReKi) :: TowerBaseHeight !< Tower base height [m] - INTEGER(IntKi) :: NodeClusterType !< Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] + REAL(ReKi) :: BladeLength = 0.0_ReKi !< Blade length (same for all blades) [m] + REAL(ReKi) :: TowerHeight = 0.0_ReKi !< Tower height [m] + REAL(ReKi) :: TowerBaseHeight = 0.0_ReKi !< Tower base height [m] + INTEGER(IntKi) :: NodeClusterType = 0_IntKi !< Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] END TYPE OpFM_ParameterType ! ======================= ! ========= OpFM_InputType_C ======= @@ -202,4018 +202,2817 @@ MODULE OpenFOAM_Types END TYPE OpFM_OutputType ! ======================= CONTAINS - SUBROUTINE OpFM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(OpFM_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + +subroutine OpFM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(OpFM_InitInputType), intent(in) :: SrcInitInputData + type(OpFM_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'OpFM_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%NumActForcePtsBlade = SrcInitInputData%NumActForcePtsBlade + DstInitInputData%C_obj%NumActForcePtsBlade = SrcInitInputData%C_obj%NumActForcePtsBlade + DstInitInputData%NumActForcePtsTower = SrcInitInputData%NumActForcePtsTower + DstInitInputData%C_obj%NumActForcePtsTower = SrcInitInputData%C_obj%NumActForcePtsTower + if (associated(SrcInitInputData%StructBldRNodes)) then + LB(1:1) = lbound(SrcInitInputData%StructBldRNodes) + UB(1:1) = ubound(SrcInitInputData%StructBldRNodes) + if (.not. associated(DstInitInputData%StructBldRNodes)) then + allocate(DstInitInputData%StructBldRNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInitInputData%StructBldRNodes = SrcInitInputData%StructBldRNodes + end if + if (associated(SrcInitInputData%StructTwrHNodes)) then + LB(1:1) = lbound(SrcInitInputData%StructTwrHNodes) + UB(1:1) = ubound(SrcInitInputData%StructTwrHNodes) + if (.not. associated(DstInitInputData%StructTwrHNodes)) then + allocate(DstInitInputData%StructTwrHNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInitInputData%StructTwrHNodes = SrcInitInputData%StructTwrHNodes + end if + DstInitInputData%BladeLength = SrcInitInputData%BladeLength + DstInitInputData%C_obj%BladeLength = SrcInitInputData%C_obj%BladeLength + DstInitInputData%TowerHeight = SrcInitInputData%TowerHeight + DstInitInputData%C_obj%TowerHeight = SrcInitInputData%C_obj%TowerHeight + DstInitInputData%TowerBaseHeight = SrcInitInputData%TowerBaseHeight + DstInitInputData%C_obj%TowerBaseHeight = SrcInitInputData%C_obj%TowerBaseHeight + DstInitInputData%NodeClusterType = SrcInitInputData%NodeClusterType + DstInitInputData%C_obj%NodeClusterType = SrcInitInputData%C_obj%NodeClusterType +end subroutine + +subroutine OpFM_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(OpFM_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'OpFM_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(InitInputData%StructBldRNodes)) then + deallocate(InitInputData%StructBldRNodes) + InitInputData%StructBldRNodes => null() + InitInputData%C_obj%StructBldRNodes = c_null_ptr + InitInputData%C_obj%StructBldRNodes_Len = 0 + end if + if (associated(InitInputData%StructTwrHNodes)) then + deallocate(InitInputData%StructTwrHNodes) + InitInputData%StructTwrHNodes => null() + InitInputData%C_obj%StructTwrHNodes = c_null_ptr + InitInputData%C_obj%StructTwrHNodes_Len = 0 + end if +end subroutine + +subroutine OpFM_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'OpFM_PackInitInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, InData%NumActForcePtsBlade) + call RegPack(Buf, InData%NumActForcePtsTower) + call RegPack(Buf, associated(InData%StructBldRNodes)) + if (associated(InData%StructBldRNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%StructBldRNodes), ubound(InData%StructBldRNodes)) + call RegPackPointer(Buf, c_loc(InData%StructBldRNodes), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%StructBldRNodes) + end if + end if + call RegPack(Buf, associated(InData%StructTwrHNodes)) + if (associated(InData%StructTwrHNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%StructTwrHNodes), ubound(InData%StructTwrHNodes)) + call RegPackPointer(Buf, c_loc(InData%StructTwrHNodes), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%StructTwrHNodes) + end if + end if + call RegPack(Buf, InData%BladeLength) + call RegPack(Buf, InData%TowerHeight) + call RegPack(Buf, InData%TowerBaseHeight) + call RegPack(Buf, InData%NodeClusterType) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine OpFM_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'OpFM_UnPackInitInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NumActForcePtsBlade) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumActForcePtsBlade = OutData%NumActForcePtsBlade + call RegUnpack(Buf, OutData%NumActForcePtsTower) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumActForcePtsTower = OutData%NumActForcePtsTower + if (associated(OutData%StructBldRNodes)) deallocate(OutData%StructBldRNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%StructBldRNodes, UB(1:1)-LB(1:1)) + OutData%StructBldRNodes(LB(1):) => OutData%StructBldRNodes + else + allocate(OutData%StructBldRNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StructBldRNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%StructBldRNodes) + OutData%C_obj%StructBldRNodes_Len = size(OutData%StructBldRNodes) + if (OutData%C_obj%StructBldRNodes_Len > 0) OutData%C_obj%StructBldRNodes = c_loc(OutData%StructBldRNodes(LB(1))) + call RegUnpack(Buf, OutData%StructBldRNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%StructBldRNodes => null() + end if + if (associated(OutData%StructTwrHNodes)) deallocate(OutData%StructTwrHNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%StructTwrHNodes, UB(1:1)-LB(1:1)) + OutData%StructTwrHNodes(LB(1):) => OutData%StructTwrHNodes + else + allocate(OutData%StructTwrHNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StructTwrHNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%StructTwrHNodes) + OutData%C_obj%StructTwrHNodes_Len = size(OutData%StructTwrHNodes) + if (OutData%C_obj%StructTwrHNodes_Len > 0) OutData%C_obj%StructTwrHNodes = c_loc(OutData%StructTwrHNodes(LB(1))) + call RegUnpack(Buf, OutData%StructTwrHNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%StructTwrHNodes => null() + end if + call RegUnpack(Buf, OutData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%BladeLength = OutData%BladeLength + call RegUnpack(Buf, OutData%TowerHeight) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%TowerHeight = OutData%TowerHeight + call RegUnpack(Buf, OutData%TowerBaseHeight) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight + call RegUnpack(Buf, OutData%NodeClusterType) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NodeClusterType = OutData%NodeClusterType +end subroutine + +SUBROUTINE OpFM_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers) + TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData 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 = 'OpFM_CopyInitInput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - DstInitInputData%NumActForcePtsBlade = SrcInitInputData%NumActForcePtsBlade - DstInitInputData%C_obj%NumActForcePtsBlade = SrcInitInputData%C_obj%NumActForcePtsBlade - DstInitInputData%NumActForcePtsTower = SrcInitInputData%NumActForcePtsTower - DstInitInputData%C_obj%NumActForcePtsTower = SrcInitInputData%C_obj%NumActForcePtsTower -IF (ASSOCIATED(SrcInitInputData%StructBldRNodes)) THEN - i1_l = LBOUND(SrcInitInputData%StructBldRNodes,1) - i1_u = UBOUND(SrcInitInputData%StructBldRNodes,1) - IF (.NOT. ASSOCIATED(DstInitInputData%StructBldRNodes)) THEN - ALLOCATE(DstInitInputData%StructBldRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInitInputData%StructBldRNodes = SrcInitInputData%StructBldRNodes -ENDIF -IF (ASSOCIATED(SrcInitInputData%StructTwrHNodes)) THEN - i1_l = LBOUND(SrcInitInputData%StructTwrHNodes,1) - i1_u = UBOUND(SrcInitInputData%StructTwrHNodes,1) - IF (.NOT. ASSOCIATED(DstInitInputData%StructTwrHNodes)) THEN - ALLOCATE(DstInitInputData%StructTwrHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInitInputData%StructTwrHNodes = SrcInitInputData%StructTwrHNodes -ENDIF - DstInitInputData%BladeLength = SrcInitInputData%BladeLength - DstInitInputData%C_obj%BladeLength = SrcInitInputData%C_obj%BladeLength - DstInitInputData%TowerHeight = SrcInitInputData%TowerHeight - DstInitInputData%C_obj%TowerHeight = SrcInitInputData%C_obj%TowerHeight - DstInitInputData%TowerBaseHeight = SrcInitInputData%TowerBaseHeight - DstInitInputData%C_obj%TowerBaseHeight = SrcInitInputData%C_obj%TowerBaseHeight - DstInitInputData%NodeClusterType = SrcInitInputData%NodeClusterType - DstInitInputData%C_obj%NodeClusterType = SrcInitInputData%C_obj%NodeClusterType - END SUBROUTINE OpFM_CopyInitInput - - SUBROUTINE OpFM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(OpFM_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 = 'OpFM_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(InitInputData%StructBldRNodes)) THEN - 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 - DEALLOCATE(InitInputData%StructTwrHNodes) - InitInputData%StructTwrHNodes => NULL() - InitInputData%C_obj%StructTwrHNodes = C_NULL_PTR - InitInputData%C_obj%StructTwrHNodes_Len = 0 -ENDIF - END SUBROUTINE OpFM_DestroyInitInput - - SUBROUTINE OpFM_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(OpFM_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 = 'OpFM_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 ! NumActForcePtsBlade - Int_BufSz = Int_BufSz + 1 ! NumActForcePtsTower - Int_BufSz = Int_BufSz + 1 ! StructBldRNodes allocated yes/no - IF ( ASSOCIATED(InData%StructBldRNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StructBldRNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StructBldRNodes) ! StructBldRNodes - END IF - Int_BufSz = Int_BufSz + 1 ! StructTwrHNodes allocated yes/no - IF ( ASSOCIATED(InData%StructTwrHNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StructTwrHNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StructTwrHNodes) ! StructTwrHNodes - END IF - Re_BufSz = Re_BufSz + 1 ! BladeLength - Re_BufSz = Re_BufSz + 1 ! TowerHeight - Re_BufSz = Re_BufSz + 1 ! TowerBaseHeight - Int_BufSz = Int_BufSz + 1 ! NodeClusterType - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NumActForcePtsBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumActForcePtsTower - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%StructBldRNodes) ) 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%StructBldRNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StructBldRNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StructBldRNodes,1), UBOUND(InData%StructBldRNodes,1) - ReKiBuf(Re_Xferred) = InData%StructBldRNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%StructTwrHNodes) ) 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%StructTwrHNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StructTwrHNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StructTwrHNodes,1), UBOUND(InData%StructTwrHNodes,1) - ReKiBuf(Re_Xferred) = InData%StructTwrHNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NodeClusterType - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE OpFM_PackInitInput - - SUBROUTINE OpFM_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(OpFM_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 = 'OpFM_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%NumActForcePtsBlade = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumActForcePtsBlade = OutData%NumActForcePtsBlade - OutData%NumActForcePtsTower = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumActForcePtsTower = OutData%NumActForcePtsTower - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StructBldRNodes 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%StructBldRNodes)) DEALLOCATE(OutData%StructBldRNodes) - ALLOCATE(OutData%StructBldRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%StructBldRNodes,1), UBOUND(OutData%StructBldRNodes,1) - OutData%StructBldRNodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StructTwrHNodes 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%StructTwrHNodes)) DEALLOCATE(OutData%StructTwrHNodes) - ALLOCATE(OutData%StructTwrHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%StructTwrHNodes,1), UBOUND(OutData%StructTwrHNodes,1) - OutData%StructTwrHNodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%BladeLength = OutData%BladeLength - OutData%TowerHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%TowerHeight = OutData%TowerHeight - OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight - OutData%NodeClusterType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NodeClusterType = OutData%NodeClusterType - END SUBROUTINE OpFM_UnPackInitInput - - SUBROUTINE OpFM_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%NumActForcePtsBlade = InitInputData%C_obj%NumActForcePtsBlade - InitInputData%NumActForcePtsTower = InitInputData%C_obj%NumActForcePtsTower - - ! -- StructBldRNodes InitInput Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructBldRNodes ) ) THEN - NULLIFY( InitInputData%StructBldRNodes ) - ELSE - CALL C_F_POINTER(InitInputData%C_obj%StructBldRNodes, InitInputData%StructBldRNodes, (/InitInputData%C_obj%StructBldRNodes_Len/)) - END IF - END IF - - ! -- StructTwrHNodes InitInput Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructTwrHNodes ) ) THEN - NULLIFY( InitInputData%StructTwrHNodes ) - ELSE - CALL C_F_POINTER(InitInputData%C_obj%StructTwrHNodes, InitInputData%StructTwrHNodes, (/InitInputData%C_obj%StructTwrHNodes_Len/)) - END IF - END IF - InitInputData%BladeLength = InitInputData%C_obj%BladeLength - InitInputData%TowerHeight = InitInputData%C_obj%TowerHeight - InitInputData%TowerBaseHeight = InitInputData%C_obj%TowerBaseHeight - InitInputData%NodeClusterType = InitInputData%C_obj%NodeClusterType - END SUBROUTINE OpFM_C2Fary_CopyInitInput - - SUBROUTINE OpFM_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%C_obj%NumActForcePtsBlade = InitInputData%NumActForcePtsBlade - InitInputData%C_obj%NumActForcePtsTower = InitInputData%NumActForcePtsTower - - ! -- 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 - 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) ) ) - 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 - 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) ) ) - END IF - END IF - InitInputData%C_obj%BladeLength = InitInputData%BladeLength - InitInputData%C_obj%TowerHeight = InitInputData%TowerHeight - InitInputData%C_obj%TowerBaseHeight = InitInputData%TowerBaseHeight - InitInputData%C_obj%NodeClusterType = InitInputData%NodeClusterType - END SUBROUTINE OpFM_F2C_CopyInitInput - - SUBROUTINE OpFM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%NumActForcePtsBlade = InitInputData%C_obj%NumActForcePtsBlade + InitInputData%NumActForcePtsTower = InitInputData%C_obj%NumActForcePtsTower + + ! -- StructBldRNodes InitInput Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructBldRNodes ) ) THEN + NULLIFY( InitInputData%StructBldRNodes ) + ELSE + CALL C_F_POINTER(InitInputData%C_obj%StructBldRNodes, InitInputData%StructBldRNodes, [InitInputData%C_obj%StructBldRNodes_Len]) + END IF + END IF + + ! -- StructTwrHNodes InitInput Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructTwrHNodes ) ) THEN + NULLIFY( InitInputData%StructTwrHNodes ) + ELSE + CALL C_F_POINTER(InitInputData%C_obj%StructTwrHNodes, InitInputData%StructTwrHNodes, [InitInputData%C_obj%StructTwrHNodes_Len]) + END IF + END IF + InitInputData%BladeLength = InitInputData%C_obj%BladeLength + InitInputData%TowerHeight = InitInputData%C_obj%TowerHeight + InitInputData%TowerBaseHeight = InitInputData%C_obj%TowerBaseHeight + InitInputData%NodeClusterType = InitInputData%C_obj%NodeClusterType +END SUBROUTINE + +SUBROUTINE OpFM_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData 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 = 'OpFM_CopyInitOutput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local 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 - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE OpFM_CopyInitOutput - - SUBROUTINE OpFM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(OpFM_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 = 'OpFM_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE OpFM_DestroyInitOutput - - SUBROUTINE OpFM_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(OpFM_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 = 'OpFM_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%C_obj%NumActForcePtsBlade = InitInputData%NumActForcePtsBlade + InitInputData%C_obj%NumActForcePtsTower = InitInputData%NumActForcePtsTower + + ! -- 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 + 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))) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + 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 + 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))) 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - 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 + END IF + InitInputData%C_obj%BladeLength = InitInputData%BladeLength + InitInputData%C_obj%TowerHeight = InitInputData%TowerHeight + InitInputData%C_obj%TowerBaseHeight = InitInputData%TowerBaseHeight + InitInputData%C_obj%NodeClusterType = InitInputData%NodeClusterType +END SUBROUTINE + +subroutine OpFM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(OpFM_InitOutputType), intent(in) :: SrcInitOutputData + type(OpFM_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'OpFM_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine OpFM_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(OpFM_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'OpFM_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine OpFM_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'OpFM_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine OpFM_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'OpFM_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine + +SUBROUTINE OpFM_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE - 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 - 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 +SUBROUTINE OpFM_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE + +subroutine OpFM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(OpFM_MiscVarType), intent(inout) :: SrcMiscData + type(OpFM_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'OpFM_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%ActForceMotionsPoints)) then + LB(1:1) = lbound(SrcMiscData%ActForceMotionsPoints) + UB(1:1) = ubound(SrcMiscData%ActForceMotionsPoints) + if (.not. allocated(DstMiscData%ActForceMotionsPoints)) then + allocate(DstMiscData%ActForceMotionsPoints(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ActForceMotionsPoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMiscData%ActForceMotionsPoints(i1), DstMiscData%ActForceMotionsPoints(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%ActForceLoadsPoints)) then + LB(1:1) = lbound(SrcMiscData%ActForceLoadsPoints) + UB(1:1) = ubound(SrcMiscData%ActForceLoadsPoints) + if (.not. allocated(DstMiscData%ActForceLoadsPoints)) then + allocate(DstMiscData%ActForceLoadsPoints(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ActForceLoadsPoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMiscData%ActForceLoadsPoints(i1), DstMiscData%ActForceLoadsPoints(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%Line2_to_Point_Loads)) then + LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Loads) + UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Loads) + if (.not. allocated(DstMiscData%Line2_to_Point_Loads)) then + allocate(DstMiscData%Line2_to_Point_Loads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line2_to_Point_Loads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMiscData%Line2_to_Point_Loads(i1), DstMiscData%Line2_to_Point_Loads(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%Line2_to_Point_Motions)) then + LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Motions) + UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Motions) + if (.not. allocated(DstMiscData%Line2_to_Point_Motions)) then + allocate(DstMiscData%Line2_to_Point_Motions(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line2_to_Point_Motions.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMiscData%Line2_to_Point_Motions(i1), DstMiscData%Line2_to_Point_Motions(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine OpFM_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(OpFM_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'OpFM_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%ActForceMotionsPoints)) then + LB(1:1) = lbound(MiscData%ActForceMotionsPoints) + UB(1:1) = ubound(MiscData%ActForceMotionsPoints) + do i1 = LB(1), UB(1) + call MeshDestroy( MiscData%ActForceMotionsPoints(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%ActForceMotionsPoints) + end if + if (allocated(MiscData%ActForceLoadsPoints)) then + LB(1:1) = lbound(MiscData%ActForceLoadsPoints) + UB(1:1) = ubound(MiscData%ActForceLoadsPoints) + do i1 = LB(1), UB(1) + call MeshDestroy( MiscData%ActForceLoadsPoints(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%ActForceLoadsPoints) + end if + if (allocated(MiscData%Line2_to_Point_Loads)) then + LB(1:1) = lbound(MiscData%Line2_to_Point_Loads) + UB(1:1) = ubound(MiscData%Line2_to_Point_Loads) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%Line2_to_Point_Loads) + end if + if (allocated(MiscData%Line2_to_Point_Motions)) then + LB(1:1) = lbound(MiscData%Line2_to_Point_Motions) + UB(1:1) = ubound(MiscData%Line2_to_Point_Motions) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%Line2_to_Point_Motions) + end if +end subroutine + +subroutine OpFM_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'OpFM_PackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, allocated(InData%ActForceMotionsPoints)) + if (allocated(InData%ActForceMotionsPoints)) then + call RegPackBounds(Buf, 1, lbound(InData%ActForceMotionsPoints), ubound(InData%ActForceMotionsPoints)) + LB(1:1) = lbound(InData%ActForceMotionsPoints) + UB(1:1) = ubound(InData%ActForceMotionsPoints) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%ActForceMotionsPoints(i1)) + end do + end if + call RegPack(Buf, allocated(InData%ActForceLoadsPoints)) + if (allocated(InData%ActForceLoadsPoints)) then + call RegPackBounds(Buf, 1, lbound(InData%ActForceLoadsPoints), ubound(InData%ActForceLoadsPoints)) + LB(1:1) = lbound(InData%ActForceLoadsPoints) + UB(1:1) = ubound(InData%ActForceLoadsPoints) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%ActForceLoadsPoints(i1)) + end do + end if + call RegPack(Buf, allocated(InData%Line2_to_Point_Loads)) + if (allocated(InData%Line2_to_Point_Loads)) then + call RegPackBounds(Buf, 1, lbound(InData%Line2_to_Point_Loads), ubound(InData%Line2_to_Point_Loads)) + LB(1:1) = lbound(InData%Line2_to_Point_Loads) + UB(1:1) = ubound(InData%Line2_to_Point_Loads) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%Line2_to_Point_Loads(i1)) + end do + end if + call RegPack(Buf, allocated(InData%Line2_to_Point_Motions)) + if (allocated(InData%Line2_to_Point_Motions)) then + call RegPackBounds(Buf, 1, lbound(InData%Line2_to_Point_Motions), ubound(InData%Line2_to_Point_Motions)) + LB(1:1) = lbound(InData%Line2_to_Point_Motions) + UB(1:1) = ubound(InData%Line2_to_Point_Motions) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%Line2_to_Point_Motions(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine OpFM_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'OpFM_UnPackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%ActForceMotionsPoints)) deallocate(OutData%ActForceMotionsPoints) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ActForceMotionsPoints(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceMotionsPoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%ActForceMotionsPoints(i1)) ! ActForceMotionsPoints + end do + end if + if (allocated(OutData%ActForceLoadsPoints)) deallocate(OutData%ActForceLoadsPoints) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ActForceLoadsPoints(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceLoadsPoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%ActForceLoadsPoints(i1)) ! ActForceLoadsPoints + end do + end if + if (allocated(OutData%Line2_to_Point_Loads)) deallocate(OutData%Line2_to_Point_Loads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Line2_to_Point_Loads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Loads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%Line2_to_Point_Loads(i1)) ! Line2_to_Point_Loads + end do + end if + if (allocated(OutData%Line2_to_Point_Motions)) deallocate(OutData%Line2_to_Point_Motions) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Line2_to_Point_Motions(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Motions.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%Line2_to_Point_Motions(i1)) ! Line2_to_Point_Motions + end do + end if +end subroutine + +SUBROUTINE OpFM_C2Fary_CopyMisc(MiscData, ErrStat, ErrMsg, SkipPointers) + TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE - 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) +SUBROUTINE OpFM_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE + +subroutine OpFM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(OpFM_ParameterType), intent(in) :: SrcParamData + type(OpFM_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'OpFM_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%C_obj%AirDens = SrcParamData%C_obj%AirDens + DstParamData%NumBl = SrcParamData%NumBl + DstParamData%C_obj%NumBl = SrcParamData%C_obj%NumBl + DstParamData%NMappings = SrcParamData%NMappings + DstParamData%C_obj%NMappings = SrcParamData%C_obj%NMappings + DstParamData%NnodesVel = SrcParamData%NnodesVel + DstParamData%C_obj%NnodesVel = SrcParamData%C_obj%NnodesVel + DstParamData%NnodesForce = SrcParamData%NnodesForce + DstParamData%C_obj%NnodesForce = SrcParamData%C_obj%NnodesForce + DstParamData%NnodesForceBlade = SrcParamData%NnodesForceBlade + DstParamData%C_obj%NnodesForceBlade = SrcParamData%C_obj%NnodesForceBlade + DstParamData%NnodesForceTower = SrcParamData%NnodesForceTower + DstParamData%C_obj%NnodesForceTower = SrcParamData%C_obj%NnodesForceTower + if (associated(SrcParamData%forceBldRnodes)) then + LB(1:1) = lbound(SrcParamData%forceBldRnodes) + UB(1:1) = ubound(SrcParamData%forceBldRnodes) + if (.not. associated(DstParamData%forceBldRnodes)) then + allocate(DstParamData%forceBldRnodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstParamData%forceBldRnodes = SrcParamData%forceBldRnodes + end if + if (associated(SrcParamData%forceTwrHnodes)) then + LB(1:1) = lbound(SrcParamData%forceTwrHnodes) + UB(1:1) = ubound(SrcParamData%forceTwrHnodes) + if (.not. associated(DstParamData%forceTwrHnodes)) then + allocate(DstParamData%forceTwrHnodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstParamData%forceTwrHnodes = SrcParamData%forceTwrHnodes + end if + DstParamData%BladeLength = SrcParamData%BladeLength + DstParamData%C_obj%BladeLength = SrcParamData%C_obj%BladeLength + DstParamData%TowerHeight = SrcParamData%TowerHeight + DstParamData%C_obj%TowerHeight = SrcParamData%C_obj%TowerHeight + DstParamData%TowerBaseHeight = SrcParamData%TowerBaseHeight + DstParamData%C_obj%TowerBaseHeight = SrcParamData%C_obj%TowerBaseHeight + DstParamData%NodeClusterType = SrcParamData%NodeClusterType + DstParamData%C_obj%NodeClusterType = SrcParamData%C_obj%NodeClusterType +end subroutine + +subroutine OpFM_DestroyParam(ParamData, ErrStat, ErrMsg) + type(OpFM_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'OpFM_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(ParamData%forceBldRnodes)) then + deallocate(ParamData%forceBldRnodes) + ParamData%forceBldRnodes => null() + ParamData%C_obj%forceBldRnodes = c_null_ptr + ParamData%C_obj%forceBldRnodes_Len = 0 + end if + if (associated(ParamData%forceTwrHnodes)) then + deallocate(ParamData%forceTwrHnodes) + ParamData%forceTwrHnodes => null() + ParamData%C_obj%forceTwrHnodes = c_null_ptr + ParamData%C_obj%forceTwrHnodes_Len = 0 + end if +end subroutine + +subroutine OpFM_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'OpFM_PackParam' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, InData%AirDens) + call RegPack(Buf, InData%NumBl) + call RegPack(Buf, InData%NMappings) + call RegPack(Buf, InData%NnodesVel) + call RegPack(Buf, InData%NnodesForce) + call RegPack(Buf, InData%NnodesForceBlade) + call RegPack(Buf, InData%NnodesForceTower) + call RegPack(Buf, associated(InData%forceBldRnodes)) + if (associated(InData%forceBldRnodes)) then + call RegPackBounds(Buf, 1, lbound(InData%forceBldRnodes), ubound(InData%forceBldRnodes)) + call RegPackPointer(Buf, c_loc(InData%forceBldRnodes), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%forceBldRnodes) + end if + end if + call RegPack(Buf, associated(InData%forceTwrHnodes)) + if (associated(InData%forceTwrHnodes)) then + call RegPackBounds(Buf, 1, lbound(InData%forceTwrHnodes), ubound(InData%forceTwrHnodes)) + call RegPackPointer(Buf, c_loc(InData%forceTwrHnodes), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%forceTwrHnodes) + end if + end if + call RegPack(Buf, InData%BladeLength) + call RegPack(Buf, InData%TowerHeight) + call RegPack(Buf, InData%TowerBaseHeight) + call RegPack(Buf, InData%NodeClusterType) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine OpFM_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'OpFM_UnPackParam' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%AirDens = OutData%AirDens + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumBl = OutData%NumBl + call RegUnpack(Buf, OutData%NMappings) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NMappings = OutData%NMappings + call RegUnpack(Buf, OutData%NnodesVel) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NnodesVel = OutData%NnodesVel + call RegUnpack(Buf, OutData%NnodesForce) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NnodesForce = OutData%NnodesForce + call RegUnpack(Buf, OutData%NnodesForceBlade) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NnodesForceBlade = OutData%NnodesForceBlade + call RegUnpack(Buf, OutData%NnodesForceTower) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NnodesForceTower = OutData%NnodesForceTower + if (associated(OutData%forceBldRnodes)) deallocate(OutData%forceBldRnodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%forceBldRnodes, UB(1:1)-LB(1:1)) + OutData%forceBldRnodes(LB(1):) => OutData%forceBldRnodes + else + allocate(OutData%forceBldRnodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceBldRnodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%forceBldRnodes) + OutData%C_obj%forceBldRnodes_Len = size(OutData%forceBldRnodes) + if (OutData%C_obj%forceBldRnodes_Len > 0) OutData%C_obj%forceBldRnodes = c_loc(OutData%forceBldRnodes(LB(1))) + call RegUnpack(Buf, OutData%forceBldRnodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%forceBldRnodes => null() + end if + if (associated(OutData%forceTwrHnodes)) deallocate(OutData%forceTwrHnodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%forceTwrHnodes, UB(1:1)-LB(1:1)) + OutData%forceTwrHnodes(LB(1):) => OutData%forceTwrHnodes + else + allocate(OutData%forceTwrHnodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceTwrHnodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%forceTwrHnodes) + OutData%C_obj%forceTwrHnodes_Len = size(OutData%forceTwrHnodes) + if (OutData%C_obj%forceTwrHnodes_Len > 0) OutData%C_obj%forceTwrHnodes = c_loc(OutData%forceTwrHnodes(LB(1))) + call RegUnpack(Buf, OutData%forceTwrHnodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%forceTwrHnodes => null() + end if + call RegUnpack(Buf, OutData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%BladeLength = OutData%BladeLength + call RegUnpack(Buf, OutData%TowerHeight) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%TowerHeight = OutData%TowerHeight + call RegUnpack(Buf, OutData%TowerBaseHeight) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight + call RegUnpack(Buf, OutData%NodeClusterType) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NodeClusterType = OutData%NodeClusterType +end subroutine + +SUBROUTINE OpFM_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) + TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%AirDens = ParamData%C_obj%AirDens + ParamData%NumBl = ParamData%C_obj%NumBl + ParamData%NMappings = ParamData%C_obj%NMappings + ParamData%NnodesVel = ParamData%C_obj%NnodesVel + ParamData%NnodesForce = ParamData%C_obj%NnodesForce + ParamData%NnodesForceBlade = ParamData%C_obj%NnodesForceBlade + ParamData%NnodesForceTower = ParamData%C_obj%NnodesForceTower + + ! -- forceBldRnodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceBldRnodes ) ) THEN + NULLIFY( ParamData%forceBldRnodes ) 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) + CALL C_F_POINTER(ParamData%C_obj%forceBldRnodes, ParamData%forceBldRnodes, [ParamData%C_obj%forceBldRnodes_Len]) + END IF + END IF + + ! -- forceTwrHnodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceTwrHnodes ) ) THEN + NULLIFY( ParamData%forceTwrHnodes ) ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE OpFM_PackInitOutput - - SUBROUTINE OpFM_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(OpFM_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 = 'OpFM_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 + CALL C_F_POINTER(ParamData%C_obj%forceTwrHnodes, ParamData%forceTwrHnodes, [ParamData%C_obj%forceTwrHnodes_Len]) 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 + ParamData%BladeLength = ParamData%C_obj%BladeLength + ParamData%TowerHeight = ParamData%C_obj%TowerHeight + ParamData%TowerBaseHeight = ParamData%C_obj%TowerBaseHeight + ParamData%NodeClusterType = ParamData%C_obj%NodeClusterType +END SUBROUTINE + +SUBROUTINE OpFM_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%C_obj%AirDens = ParamData%AirDens + ParamData%C_obj%NumBl = ParamData%NumBl + ParamData%C_obj%NMappings = ParamData%NMappings + ParamData%C_obj%NnodesVel = ParamData%NnodesVel + ParamData%C_obj%NnodesForce = ParamData%NnodesForce + ParamData%C_obj%NnodesForceBlade = ParamData%NnodesForceBlade + ParamData%C_obj%NnodesForceTower = ParamData%NnodesForceTower + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) 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) - END SUBROUTINE OpFM_UnPackInitOutput - - SUBROUTINE OpFM_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE OpFM_C2Fary_CopyInitOutput - - SUBROUTINE OpFM_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE OpFM_F2C_CopyInitOutput - - SUBROUTINE OpFM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + END IF + ParamData%C_obj%BladeLength = ParamData%BladeLength + ParamData%C_obj%TowerHeight = ParamData%TowerHeight + ParamData%C_obj%TowerBaseHeight = ParamData%TowerBaseHeight + ParamData%C_obj%NodeClusterType = ParamData%NodeClusterType +END SUBROUTINE + +subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(OpFM_InputType), intent(in) :: SrcInputData + type(OpFM_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'OpFM_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcInputData%pxVel)) then + LB(1:1) = lbound(SrcInputData%pxVel) + UB(1:1) = ubound(SrcInputData%pxVel) + if (.not. associated(DstInputData%pxVel)) then + allocate(DstInputData%pxVel(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%pxVel = SrcInputData%pxVel + end if + if (associated(SrcInputData%pyVel)) then + LB(1:1) = lbound(SrcInputData%pyVel) + UB(1:1) = ubound(SrcInputData%pyVel) + if (.not. associated(DstInputData%pyVel)) then + allocate(DstInputData%pyVel(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%pyVel = SrcInputData%pyVel + end if + if (associated(SrcInputData%pzVel)) then + LB(1:1) = lbound(SrcInputData%pzVel) + UB(1:1) = ubound(SrcInputData%pzVel) + if (.not. associated(DstInputData%pzVel)) then + allocate(DstInputData%pzVel(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%pzVel = SrcInputData%pzVel + end if + if (associated(SrcInputData%pxForce)) then + LB(1:1) = lbound(SrcInputData%pxForce) + UB(1:1) = ubound(SrcInputData%pxForce) + if (.not. associated(DstInputData%pxForce)) then + allocate(DstInputData%pxForce(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%pxForce = SrcInputData%pxForce + end if + if (associated(SrcInputData%pyForce)) then + LB(1:1) = lbound(SrcInputData%pyForce) + UB(1:1) = ubound(SrcInputData%pyForce) + if (.not. associated(DstInputData%pyForce)) then + allocate(DstInputData%pyForce(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%pyForce = SrcInputData%pyForce + end if + if (associated(SrcInputData%pzForce)) then + LB(1:1) = lbound(SrcInputData%pzForce) + UB(1:1) = ubound(SrcInputData%pzForce) + if (.not. associated(DstInputData%pzForce)) then + allocate(DstInputData%pzForce(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%pzForce = SrcInputData%pzForce + end if + if (associated(SrcInputData%xdotForce)) then + LB(1:1) = lbound(SrcInputData%xdotForce) + UB(1:1) = ubound(SrcInputData%xdotForce) + if (.not. associated(DstInputData%xdotForce)) then + allocate(DstInputData%xdotForce(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%xdotForce = SrcInputData%xdotForce + end if + if (associated(SrcInputData%ydotForce)) then + LB(1:1) = lbound(SrcInputData%ydotForce) + UB(1:1) = ubound(SrcInputData%ydotForce) + if (.not. associated(DstInputData%ydotForce)) then + allocate(DstInputData%ydotForce(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%ydotForce = SrcInputData%ydotForce + end if + if (associated(SrcInputData%zdotForce)) then + LB(1:1) = lbound(SrcInputData%zdotForce) + UB(1:1) = ubound(SrcInputData%zdotForce) + if (.not. associated(DstInputData%zdotForce)) then + allocate(DstInputData%zdotForce(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%zdotForce = SrcInputData%zdotForce + end if + if (associated(SrcInputData%pOrientation)) then + LB(1:1) = lbound(SrcInputData%pOrientation) + UB(1:1) = ubound(SrcInputData%pOrientation) + if (.not. associated(DstInputData%pOrientation)) then + allocate(DstInputData%pOrientation(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%pOrientation = SrcInputData%pOrientation + end if + if (associated(SrcInputData%fx)) then + LB(1:1) = lbound(SrcInputData%fx) + UB(1:1) = ubound(SrcInputData%fx) + if (.not. associated(DstInputData%fx)) then + allocate(DstInputData%fx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%fx = SrcInputData%fx + end if + if (associated(SrcInputData%fy)) then + LB(1:1) = lbound(SrcInputData%fy) + UB(1:1) = ubound(SrcInputData%fy) + if (.not. associated(DstInputData%fy)) then + allocate(DstInputData%fy(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%fy = SrcInputData%fy + end if + if (associated(SrcInputData%fz)) then + LB(1:1) = lbound(SrcInputData%fz) + UB(1:1) = ubound(SrcInputData%fz) + if (.not. associated(DstInputData%fz)) then + allocate(DstInputData%fz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%fz = SrcInputData%fz + end if + if (associated(SrcInputData%momentx)) then + LB(1:1) = lbound(SrcInputData%momentx) + UB(1:1) = ubound(SrcInputData%momentx) + if (.not. associated(DstInputData%momentx)) then + allocate(DstInputData%momentx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%momentx = SrcInputData%momentx + end if + if (associated(SrcInputData%momenty)) then + LB(1:1) = lbound(SrcInputData%momenty) + UB(1:1) = ubound(SrcInputData%momenty) + if (.not. associated(DstInputData%momenty)) then + allocate(DstInputData%momenty(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%momenty = SrcInputData%momenty + end if + if (associated(SrcInputData%momentz)) then + LB(1:1) = lbound(SrcInputData%momentz) + UB(1:1) = ubound(SrcInputData%momentz) + if (.not. associated(DstInputData%momentz)) then + allocate(DstInputData%momentz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%momentz = SrcInputData%momentz + end if + if (associated(SrcInputData%forceNodesChord)) then + LB(1:1) = lbound(SrcInputData%forceNodesChord) + UB(1:1) = ubound(SrcInputData%forceNodesChord) + if (.not. associated(DstInputData%forceNodesChord)) then + allocate(DstInputData%forceNodesChord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%forceNodesChord = SrcInputData%forceNodesChord + end if +end subroutine + +subroutine OpFM_DestroyInput(InputData, ErrStat, ErrMsg) + type(OpFM_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'OpFM_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(InputData%pxVel)) then + deallocate(InputData%pxVel) + InputData%pxVel => null() + InputData%C_obj%pxVel = c_null_ptr + InputData%C_obj%pxVel_Len = 0 + end if + if (associated(InputData%pyVel)) then + deallocate(InputData%pyVel) + InputData%pyVel => null() + InputData%C_obj%pyVel = c_null_ptr + InputData%C_obj%pyVel_Len = 0 + end if + if (associated(InputData%pzVel)) then + deallocate(InputData%pzVel) + InputData%pzVel => null() + InputData%C_obj%pzVel = c_null_ptr + InputData%C_obj%pzVel_Len = 0 + end if + if (associated(InputData%pxForce)) then + deallocate(InputData%pxForce) + InputData%pxForce => null() + InputData%C_obj%pxForce = c_null_ptr + InputData%C_obj%pxForce_Len = 0 + end if + if (associated(InputData%pyForce)) then + deallocate(InputData%pyForce) + InputData%pyForce => null() + InputData%C_obj%pyForce = c_null_ptr + InputData%C_obj%pyForce_Len = 0 + end if + if (associated(InputData%pzForce)) then + deallocate(InputData%pzForce) + InputData%pzForce => null() + InputData%C_obj%pzForce = c_null_ptr + InputData%C_obj%pzForce_Len = 0 + end if + if (associated(InputData%xdotForce)) then + deallocate(InputData%xdotForce) + InputData%xdotForce => null() + InputData%C_obj%xdotForce = c_null_ptr + InputData%C_obj%xdotForce_Len = 0 + end if + if (associated(InputData%ydotForce)) then + deallocate(InputData%ydotForce) + InputData%ydotForce => null() + InputData%C_obj%ydotForce = c_null_ptr + InputData%C_obj%ydotForce_Len = 0 + end if + if (associated(InputData%zdotForce)) then + deallocate(InputData%zdotForce) + InputData%zdotForce => null() + InputData%C_obj%zdotForce = c_null_ptr + InputData%C_obj%zdotForce_Len = 0 + end if + if (associated(InputData%pOrientation)) then + deallocate(InputData%pOrientation) + InputData%pOrientation => null() + InputData%C_obj%pOrientation = c_null_ptr + InputData%C_obj%pOrientation_Len = 0 + end if + if (associated(InputData%fx)) then + deallocate(InputData%fx) + InputData%fx => null() + InputData%C_obj%fx = c_null_ptr + InputData%C_obj%fx_Len = 0 + end if + if (associated(InputData%fy)) then + deallocate(InputData%fy) + InputData%fy => null() + InputData%C_obj%fy = c_null_ptr + InputData%C_obj%fy_Len = 0 + end if + if (associated(InputData%fz)) then + deallocate(InputData%fz) + InputData%fz => null() + InputData%C_obj%fz = c_null_ptr + InputData%C_obj%fz_Len = 0 + end if + if (associated(InputData%momentx)) then + deallocate(InputData%momentx) + InputData%momentx => null() + InputData%C_obj%momentx = c_null_ptr + InputData%C_obj%momentx_Len = 0 + end if + if (associated(InputData%momenty)) then + deallocate(InputData%momenty) + InputData%momenty => null() + InputData%C_obj%momenty = c_null_ptr + InputData%C_obj%momenty_Len = 0 + end if + if (associated(InputData%momentz)) then + deallocate(InputData%momentz) + InputData%momentz => null() + InputData%C_obj%momentz = c_null_ptr + InputData%C_obj%momentz_Len = 0 + end if + if (associated(InputData%forceNodesChord)) then + deallocate(InputData%forceNodesChord) + InputData%forceNodesChord => null() + InputData%C_obj%forceNodesChord = c_null_ptr + InputData%C_obj%forceNodesChord_Len = 0 + end if +end subroutine + +subroutine OpFM_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'OpFM_PackInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, associated(InData%pxVel)) + if (associated(InData%pxVel)) then + call RegPackBounds(Buf, 1, lbound(InData%pxVel), ubound(InData%pxVel)) + call RegPackPointer(Buf, c_loc(InData%pxVel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%pxVel) + end if + end if + call RegPack(Buf, associated(InData%pyVel)) + if (associated(InData%pyVel)) then + call RegPackBounds(Buf, 1, lbound(InData%pyVel), ubound(InData%pyVel)) + call RegPackPointer(Buf, c_loc(InData%pyVel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%pyVel) + end if + end if + call RegPack(Buf, associated(InData%pzVel)) + if (associated(InData%pzVel)) then + call RegPackBounds(Buf, 1, lbound(InData%pzVel), ubound(InData%pzVel)) + call RegPackPointer(Buf, c_loc(InData%pzVel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%pzVel) + end if + end if + call RegPack(Buf, associated(InData%pxForce)) + if (associated(InData%pxForce)) then + call RegPackBounds(Buf, 1, lbound(InData%pxForce), ubound(InData%pxForce)) + call RegPackPointer(Buf, c_loc(InData%pxForce), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%pxForce) + end if + end if + call RegPack(Buf, associated(InData%pyForce)) + if (associated(InData%pyForce)) then + call RegPackBounds(Buf, 1, lbound(InData%pyForce), ubound(InData%pyForce)) + call RegPackPointer(Buf, c_loc(InData%pyForce), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%pyForce) + end if + end if + call RegPack(Buf, associated(InData%pzForce)) + if (associated(InData%pzForce)) then + call RegPackBounds(Buf, 1, lbound(InData%pzForce), ubound(InData%pzForce)) + call RegPackPointer(Buf, c_loc(InData%pzForce), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%pzForce) + end if + end if + call RegPack(Buf, associated(InData%xdotForce)) + if (associated(InData%xdotForce)) then + call RegPackBounds(Buf, 1, lbound(InData%xdotForce), ubound(InData%xdotForce)) + call RegPackPointer(Buf, c_loc(InData%xdotForce), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%xdotForce) + end if + end if + call RegPack(Buf, associated(InData%ydotForce)) + if (associated(InData%ydotForce)) then + call RegPackBounds(Buf, 1, lbound(InData%ydotForce), ubound(InData%ydotForce)) + call RegPackPointer(Buf, c_loc(InData%ydotForce), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%ydotForce) + end if + end if + call RegPack(Buf, associated(InData%zdotForce)) + if (associated(InData%zdotForce)) then + call RegPackBounds(Buf, 1, lbound(InData%zdotForce), ubound(InData%zdotForce)) + call RegPackPointer(Buf, c_loc(InData%zdotForce), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%zdotForce) + end if + end if + call RegPack(Buf, associated(InData%pOrientation)) + if (associated(InData%pOrientation)) then + call RegPackBounds(Buf, 1, lbound(InData%pOrientation), ubound(InData%pOrientation)) + call RegPackPointer(Buf, c_loc(InData%pOrientation), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%pOrientation) + end if + end if + call RegPack(Buf, associated(InData%fx)) + if (associated(InData%fx)) then + call RegPackBounds(Buf, 1, lbound(InData%fx), ubound(InData%fx)) + call RegPackPointer(Buf, c_loc(InData%fx), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%fx) + end if + end if + call RegPack(Buf, associated(InData%fy)) + if (associated(InData%fy)) then + call RegPackBounds(Buf, 1, lbound(InData%fy), ubound(InData%fy)) + call RegPackPointer(Buf, c_loc(InData%fy), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%fy) + end if + end if + call RegPack(Buf, associated(InData%fz)) + if (associated(InData%fz)) then + call RegPackBounds(Buf, 1, lbound(InData%fz), ubound(InData%fz)) + call RegPackPointer(Buf, c_loc(InData%fz), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%fz) + end if + end if + call RegPack(Buf, associated(InData%momentx)) + if (associated(InData%momentx)) then + call RegPackBounds(Buf, 1, lbound(InData%momentx), ubound(InData%momentx)) + call RegPackPointer(Buf, c_loc(InData%momentx), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%momentx) + end if + end if + call RegPack(Buf, associated(InData%momenty)) + if (associated(InData%momenty)) then + call RegPackBounds(Buf, 1, lbound(InData%momenty), ubound(InData%momenty)) + call RegPackPointer(Buf, c_loc(InData%momenty), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%momenty) + end if + end if + call RegPack(Buf, associated(InData%momentz)) + if (associated(InData%momentz)) then + call RegPackBounds(Buf, 1, lbound(InData%momentz), ubound(InData%momentz)) + call RegPackPointer(Buf, c_loc(InData%momentz), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%momentz) + end if + end if + call RegPack(Buf, associated(InData%forceNodesChord)) + if (associated(InData%forceNodesChord)) then + call RegPackBounds(Buf, 1, lbound(InData%forceNodesChord), ubound(InData%forceNodesChord)) + call RegPackPointer(Buf, c_loc(InData%forceNodesChord), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%forceNodesChord) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine OpFM_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'OpFM_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%pxVel)) deallocate(OutData%pxVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%pxVel, UB(1:1)-LB(1:1)) + OutData%pxVel(LB(1):) => OutData%pxVel + else + allocate(OutData%pxVel(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%pxVel) + OutData%C_obj%pxVel_Len = size(OutData%pxVel) + if (OutData%C_obj%pxVel_Len > 0) OutData%C_obj%pxVel = c_loc(OutData%pxVel(LB(1))) + call RegUnpack(Buf, OutData%pxVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%pxVel => null() + end if + if (associated(OutData%pyVel)) deallocate(OutData%pyVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%pyVel, UB(1:1)-LB(1:1)) + OutData%pyVel(LB(1):) => OutData%pyVel + else + allocate(OutData%pyVel(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%pyVel) + OutData%C_obj%pyVel_Len = size(OutData%pyVel) + if (OutData%C_obj%pyVel_Len > 0) OutData%C_obj%pyVel = c_loc(OutData%pyVel(LB(1))) + call RegUnpack(Buf, OutData%pyVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%pyVel => null() + end if + if (associated(OutData%pzVel)) deallocate(OutData%pzVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%pzVel, UB(1:1)-LB(1:1)) + OutData%pzVel(LB(1):) => OutData%pzVel + else + allocate(OutData%pzVel(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%pzVel) + OutData%C_obj%pzVel_Len = size(OutData%pzVel) + if (OutData%C_obj%pzVel_Len > 0) OutData%C_obj%pzVel = c_loc(OutData%pzVel(LB(1))) + call RegUnpack(Buf, OutData%pzVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%pzVel => null() + end if + if (associated(OutData%pxForce)) deallocate(OutData%pxForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%pxForce, UB(1:1)-LB(1:1)) + OutData%pxForce(LB(1):) => OutData%pxForce + else + allocate(OutData%pxForce(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%pxForce) + OutData%C_obj%pxForce_Len = size(OutData%pxForce) + if (OutData%C_obj%pxForce_Len > 0) OutData%C_obj%pxForce = c_loc(OutData%pxForce(LB(1))) + call RegUnpack(Buf, OutData%pxForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%pxForce => null() + end if + if (associated(OutData%pyForce)) deallocate(OutData%pyForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%pyForce, UB(1:1)-LB(1:1)) + OutData%pyForce(LB(1):) => OutData%pyForce + else + allocate(OutData%pyForce(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%pyForce) + OutData%C_obj%pyForce_Len = size(OutData%pyForce) + if (OutData%C_obj%pyForce_Len > 0) OutData%C_obj%pyForce = c_loc(OutData%pyForce(LB(1))) + call RegUnpack(Buf, OutData%pyForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%pyForce => null() + end if + if (associated(OutData%pzForce)) deallocate(OutData%pzForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%pzForce, UB(1:1)-LB(1:1)) + OutData%pzForce(LB(1):) => OutData%pzForce + else + allocate(OutData%pzForce(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%pzForce) + OutData%C_obj%pzForce_Len = size(OutData%pzForce) + if (OutData%C_obj%pzForce_Len > 0) OutData%C_obj%pzForce = c_loc(OutData%pzForce(LB(1))) + call RegUnpack(Buf, OutData%pzForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%pzForce => null() + end if + if (associated(OutData%xdotForce)) deallocate(OutData%xdotForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%xdotForce, UB(1:1)-LB(1:1)) + OutData%xdotForce(LB(1):) => OutData%xdotForce + else + allocate(OutData%xdotForce(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdotForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%xdotForce) + OutData%C_obj%xdotForce_Len = size(OutData%xdotForce) + if (OutData%C_obj%xdotForce_Len > 0) OutData%C_obj%xdotForce = c_loc(OutData%xdotForce(LB(1))) + call RegUnpack(Buf, OutData%xdotForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%xdotForce => null() + end if + if (associated(OutData%ydotForce)) deallocate(OutData%ydotForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%ydotForce, UB(1:1)-LB(1:1)) + OutData%ydotForce(LB(1):) => OutData%ydotForce + else + allocate(OutData%ydotForce(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ydotForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%ydotForce) + OutData%C_obj%ydotForce_Len = size(OutData%ydotForce) + if (OutData%C_obj%ydotForce_Len > 0) OutData%C_obj%ydotForce = c_loc(OutData%ydotForce(LB(1))) + call RegUnpack(Buf, OutData%ydotForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%ydotForce => null() + end if + if (associated(OutData%zdotForce)) deallocate(OutData%zdotForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%zdotForce, UB(1:1)-LB(1:1)) + OutData%zdotForce(LB(1):) => OutData%zdotForce + else + allocate(OutData%zdotForce(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zdotForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%zdotForce) + OutData%C_obj%zdotForce_Len = size(OutData%zdotForce) + if (OutData%C_obj%zdotForce_Len > 0) OutData%C_obj%zdotForce = c_loc(OutData%zdotForce(LB(1))) + call RegUnpack(Buf, OutData%zdotForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%zdotForce => null() + end if + if (associated(OutData%pOrientation)) deallocate(OutData%pOrientation) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%pOrientation, UB(1:1)-LB(1:1)) + OutData%pOrientation(LB(1):) => OutData%pOrientation + else + allocate(OutData%pOrientation(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pOrientation.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%pOrientation) + OutData%C_obj%pOrientation_Len = size(OutData%pOrientation) + if (OutData%C_obj%pOrientation_Len > 0) OutData%C_obj%pOrientation = c_loc(OutData%pOrientation(LB(1))) + call RegUnpack(Buf, OutData%pOrientation) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%pOrientation => null() + end if + if (associated(OutData%fx)) deallocate(OutData%fx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%fx, UB(1:1)-LB(1:1)) + OutData%fx(LB(1):) => OutData%fx + else + allocate(OutData%fx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%fx) + OutData%C_obj%fx_Len = size(OutData%fx) + if (OutData%C_obj%fx_Len > 0) OutData%C_obj%fx = c_loc(OutData%fx(LB(1))) + call RegUnpack(Buf, OutData%fx) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%fx => null() + end if + if (associated(OutData%fy)) deallocate(OutData%fy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%fy, UB(1:1)-LB(1:1)) + OutData%fy(LB(1):) => OutData%fy + else + allocate(OutData%fy(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%fy) + OutData%C_obj%fy_Len = size(OutData%fy) + if (OutData%C_obj%fy_Len > 0) OutData%C_obj%fy = c_loc(OutData%fy(LB(1))) + call RegUnpack(Buf, OutData%fy) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%fy => null() + end if + if (associated(OutData%fz)) deallocate(OutData%fz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%fz, UB(1:1)-LB(1:1)) + OutData%fz(LB(1):) => OutData%fz + else + allocate(OutData%fz(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%fz) + OutData%C_obj%fz_Len = size(OutData%fz) + if (OutData%C_obj%fz_Len > 0) OutData%C_obj%fz = c_loc(OutData%fz(LB(1))) + call RegUnpack(Buf, OutData%fz) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%fz => null() + end if + if (associated(OutData%momentx)) deallocate(OutData%momentx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%momentx, UB(1:1)-LB(1:1)) + OutData%momentx(LB(1):) => OutData%momentx + else + allocate(OutData%momentx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%momentx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%momentx) + OutData%C_obj%momentx_Len = size(OutData%momentx) + if (OutData%C_obj%momentx_Len > 0) OutData%C_obj%momentx = c_loc(OutData%momentx(LB(1))) + call RegUnpack(Buf, OutData%momentx) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%momentx => null() + end if + if (associated(OutData%momenty)) deallocate(OutData%momenty) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%momenty, UB(1:1)-LB(1:1)) + OutData%momenty(LB(1):) => OutData%momenty + else + allocate(OutData%momenty(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%momenty.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%momenty) + OutData%C_obj%momenty_Len = size(OutData%momenty) + if (OutData%C_obj%momenty_Len > 0) OutData%C_obj%momenty = c_loc(OutData%momenty(LB(1))) + call RegUnpack(Buf, OutData%momenty) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%momenty => null() + end if + if (associated(OutData%momentz)) deallocate(OutData%momentz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%momentz, UB(1:1)-LB(1:1)) + OutData%momentz(LB(1):) => OutData%momentz + else + allocate(OutData%momentz(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%momentz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%momentz) + OutData%C_obj%momentz_Len = size(OutData%momentz) + if (OutData%C_obj%momentz_Len > 0) OutData%C_obj%momentz = c_loc(OutData%momentz(LB(1))) + call RegUnpack(Buf, OutData%momentz) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%momentz => null() + end if + if (associated(OutData%forceNodesChord)) deallocate(OutData%forceNodesChord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%forceNodesChord, UB(1:1)-LB(1:1)) + OutData%forceNodesChord(LB(1):) => OutData%forceNodesChord + else + allocate(OutData%forceNodesChord(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceNodesChord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%forceNodesChord) + OutData%C_obj%forceNodesChord_Len = size(OutData%forceNodesChord) + if (OutData%C_obj%forceNodesChord_Len > 0) OutData%C_obj%forceNodesChord = c_loc(OutData%forceNodesChord(LB(1))) + call RegUnpack(Buf, OutData%forceNodesChord) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%forceNodesChord => null() + end if +end subroutine + +SUBROUTINE OpFM_C2Fary_CopyInput(InputData, ErrStat, ErrMsg, SkipPointers) + TYPE(OpFM_InputType), INTENT(INOUT) :: InputData 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 = 'OpFM_CopyMisc' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcMiscData%ActForceMotionsPoints)) THEN - i1_l = LBOUND(SrcMiscData%ActForceMotionsPoints,1) - i1_u = UBOUND(SrcMiscData%ActForceMotionsPoints,1) - IF (.NOT. ALLOCATED(DstMiscData%ActForceMotionsPoints)) THEN - ALLOCATE(DstMiscData%ActForceMotionsPoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ActForceMotionsPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%ActForceMotionsPoints,1), UBOUND(SrcMiscData%ActForceMotionsPoints,1) - CALL MeshCopy( SrcMiscData%ActForceMotionsPoints(i1), DstMiscData%ActForceMotionsPoints(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%ActForceLoadsPoints)) THEN - i1_l = LBOUND(SrcMiscData%ActForceLoadsPoints,1) - i1_u = UBOUND(SrcMiscData%ActForceLoadsPoints,1) - IF (.NOT. ALLOCATED(DstMiscData%ActForceLoadsPoints)) THEN - ALLOCATE(DstMiscData%ActForceLoadsPoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ActForceLoadsPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%ActForceLoadsPoints,1), UBOUND(SrcMiscData%ActForceLoadsPoints,1) - CALL MeshCopy( SrcMiscData%ActForceLoadsPoints(i1), DstMiscData%ActForceLoadsPoints(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%Line2_to_Point_Loads)) THEN - i1_l = LBOUND(SrcMiscData%Line2_to_Point_Loads,1) - i1_u = UBOUND(SrcMiscData%Line2_to_Point_Loads,1) - IF (.NOT. ALLOCATED(DstMiscData%Line2_to_Point_Loads)) THEN - ALLOCATE(DstMiscData%Line2_to_Point_Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line2_to_Point_Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%Line2_to_Point_Loads,1), UBOUND(SrcMiscData%Line2_to_Point_Loads,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%Line2_to_Point_Loads(i1), DstMiscData%Line2_to_Point_Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%Line2_to_Point_Motions)) THEN - i1_l = LBOUND(SrcMiscData%Line2_to_Point_Motions,1) - i1_u = UBOUND(SrcMiscData%Line2_to_Point_Motions,1) - IF (.NOT. ALLOCATED(DstMiscData%Line2_to_Point_Motions)) THEN - ALLOCATE(DstMiscData%Line2_to_Point_Motions(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line2_to_Point_Motions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%Line2_to_Point_Motions,1), UBOUND(SrcMiscData%Line2_to_Point_Motions,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%Line2_to_Point_Motions(i1), DstMiscData%Line2_to_Point_Motions(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE OpFM_CopyMisc - - SUBROUTINE OpFM_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(OpFM_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 = 'OpFM_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%ActForceMotionsPoints)) THEN -DO i1 = LBOUND(MiscData%ActForceMotionsPoints,1), UBOUND(MiscData%ActForceMotionsPoints,1) - CALL MeshDestroy( MiscData%ActForceMotionsPoints(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%ActForceMotionsPoints) -ENDIF -IF (ALLOCATED(MiscData%ActForceLoadsPoints)) THEN -DO i1 = LBOUND(MiscData%ActForceLoadsPoints,1), UBOUND(MiscData%ActForceLoadsPoints,1) - CALL MeshDestroy( MiscData%ActForceLoadsPoints(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%ActForceLoadsPoints) -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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%Line2_to_Point_Motions) -ENDIF - END SUBROUTINE OpFM_DestroyMisc - - SUBROUTINE OpFM_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(OpFM_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 = 'OpFM_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 ! ActForceMotionsPoints allocated yes/no - IF ( ALLOCATED(InData%ActForceMotionsPoints) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ActForceMotionsPoints upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%ActForceMotionsPoints,1), UBOUND(InData%ActForceMotionsPoints,1) - Int_BufSz = Int_BufSz + 3 ! ActForceMotionsPoints: size of buffers for each call to pack subtype - CALL MeshPack( InData%ActForceMotionsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ActForceMotionsPoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ActForceMotionsPoints - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ActForceMotionsPoints - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- pxVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxVel ) ) THEN + NULLIFY( InputData%pxVel ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pxVel, InputData%pxVel, [InputData%C_obj%pxVel_Len]) END IF - IF(ALLOCATED(Int_Buf)) THEN ! ActForceMotionsPoints - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + END IF + + ! -- pyVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyVel ) ) THEN + NULLIFY( InputData%pyVel ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pyVel, InputData%pyVel, [InputData%C_obj%pyVel_Len]) END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ActForceLoadsPoints allocated yes/no - IF ( ALLOCATED(InData%ActForceLoadsPoints) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ActForceLoadsPoints upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ActForceLoadsPoints,1), UBOUND(InData%ActForceLoadsPoints,1) - Int_BufSz = Int_BufSz + 3 ! ActForceLoadsPoints: size of buffers for each call to pack subtype - CALL MeshPack( InData%ActForceLoadsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ActForceLoadsPoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ActForceLoadsPoints - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + END IF + + ! -- pzVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzVel ) ) THEN + NULLIFY( InputData%pzVel ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pzVel, InputData%pzVel, [InputData%C_obj%pzVel_Len]) END IF - IF(ALLOCATED(Db_Buf)) THEN ! ActForceLoadsPoints - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + END IF + + ! -- pxForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxForce ) ) THEN + NULLIFY( InputData%pxForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pxForce, InputData%pxForce, [InputData%C_obj%pxForce_Len]) END IF - IF(ALLOCATED(Int_Buf)) THEN ! ActForceLoadsPoints - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + END IF + + ! -- pyForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyForce ) ) THEN + NULLIFY( InputData%pyForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pyForce, InputData%pyForce, [InputData%C_obj%pyForce_Len]) END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Line2_to_Point_Loads allocated yes/no - IF ( ALLOCATED(InData%Line2_to_Point_Loads) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Line2_to_Point_Loads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + END IF + + ! -- pzForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzForce ) ) THEN + NULLIFY( InputData%pzForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pzForce, InputData%pzForce, [InputData%C_obj%pzForce_Len]) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Line2_to_Point_Loads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + END IF + + ! -- xdotForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%xdotForce ) ) THEN + NULLIFY( InputData%xdotForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%xdotForce, InputData%xdotForce, [InputData%C_obj%xdotForce_Len]) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Line2_to_Point_Loads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + END IF + + ! -- ydotForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%ydotForce ) ) THEN + NULLIFY( InputData%ydotForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%ydotForce, InputData%ydotForce, [InputData%C_obj%ydotForce_Len]) END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Line2_to_Point_Motions allocated yes/no - IF ( ALLOCATED(InData%Line2_to_Point_Motions) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Line2_to_Point_Motions - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + END IF + + ! -- zdotForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%zdotForce ) ) THEN + NULLIFY( InputData%zdotForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%zdotForce, InputData%zdotForce, [InputData%C_obj%zdotForce_Len]) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Line2_to_Point_Motions - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + END IF + + ! -- pOrientation Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pOrientation ) ) THEN + NULLIFY( InputData%pOrientation ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pOrientation, InputData%pOrientation, [InputData%C_obj%pOrientation_Len]) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Line2_to_Point_Motions - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + END IF + + ! -- fx Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fx ) ) THEN + NULLIFY( InputData%fx ) + ELSE + CALL C_F_POINTER(InputData%C_obj%fx, InputData%fx, [InputData%C_obj%fx_Len]) END IF - END DO - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%ActForceMotionsPoints) ) 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%ActForceMotionsPoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActForceMotionsPoints,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ActForceMotionsPoints,1), UBOUND(InData%ActForceMotionsPoints,1) - CALL MeshPack( InData%ActForceMotionsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ActForceMotionsPoints - 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) + END IF + + ! -- fy Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fy ) ) THEN + NULLIFY( InputData%fy ) 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) + CALL C_F_POINTER(InputData%C_obj%fy, InputData%fy, [InputData%C_obj%fy_Len]) + END IF + END IF + + ! -- fz Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fz ) ) THEN + NULLIFY( InputData%fz ) 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) + CALL C_F_POINTER(InputData%C_obj%fz, InputData%fz, [InputData%C_obj%fz_Len]) + END IF + END IF + + ! -- momentx Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentx ) ) THEN + NULLIFY( InputData%momentx ) ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ActForceLoadsPoints) ) 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%ActForceLoadsPoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActForceLoadsPoints,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ActForceLoadsPoints,1), UBOUND(InData%ActForceLoadsPoints,1) - CALL MeshPack( InData%ActForceLoadsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ActForceLoadsPoints - 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) + CALL C_F_POINTER(InputData%C_obj%momentx, InputData%momentx, [InputData%C_obj%momentx_Len]) + END IF + END IF + + ! -- momenty Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momenty ) ) THEN + NULLIFY( InputData%momenty ) 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) + CALL C_F_POINTER(InputData%C_obj%momenty, InputData%momenty, [InputData%C_obj%momenty_Len]) + END IF + END IF + + ! -- momentz Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentz ) ) THEN + NULLIFY( InputData%momentz ) 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) + CALL C_F_POINTER(InputData%C_obj%momentz, InputData%momentz, [InputData%C_obj%momentz_Len]) + END IF + END IF + + ! -- forceNodesChord Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%forceNodesChord ) ) THEN + NULLIFY( InputData%forceNodesChord ) ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Line2_to_Point_Loads) ) 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%Line2_to_Point_Loads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line2_to_Point_Loads,1) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + CALL C_F_POINTER(InputData%C_obj%forceNodesChord, InputData%forceNodesChord, [InputData%C_obj%forceNodesChord_Len]) + END IF + END IF +END SUBROUTINE - 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) +SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- 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 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) + 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 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) + 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 ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Line2_to_Point_Motions) ) 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%Line2_to_Point_Motions,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line2_to_Point_Motions,1) - 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 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) + 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 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) + 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 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) + 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 ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE OpFM_PackMisc - - SUBROUTINE OpFM_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(OpFM_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActForceMotionsPoints 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%ActForceMotionsPoints)) DEALLOCATE(OutData%ActForceMotionsPoints) - ALLOCATE(OutData%ActForceMotionsPoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceMotionsPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ActForceMotionsPoints,1), UBOUND(OutData%ActForceMotionsPoints,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 + 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 - 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 + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) END IF - CALL MeshUnpack( OutData%ActForceMotionsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ActForceMotionsPoints - 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 ! ActForceLoadsPoints 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%ActForceLoadsPoints)) DEALLOCATE(OutData%ActForceLoadsPoints) - ALLOCATE(OutData%ActForceLoadsPoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceLoadsPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ActForceLoadsPoints,1), UBOUND(OutData%ActForceLoadsPoints,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 + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) END IF - CALL MeshUnpack( OutData%ActForceLoadsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ActForceLoadsPoints - 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 ! Line2_to_Point_Loads 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%Line2_to_Point_Loads)) DEALLOCATE(OutData%Line2_to_Point_Loads) - ALLOCATE(OutData%Line2_to_Point_Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Line2_to_Point_Loads,1), UBOUND(OutData%Line2_to_Point_Loads,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 + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) 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 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 ! Line2_to_Point_Motions 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%Line2_to_Point_Motions)) DEALLOCATE(OutData%Line2_to_Point_Motions) - ALLOCATE(OutData%Line2_to_Point_Motions(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Motions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Line2_to_Point_Motions,1), UBOUND(OutData%Line2_to_Point_Motions,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 + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) 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 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 - END SUBROUTINE OpFM_UnPackMisc - - SUBROUTINE OpFM_C2Fary_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE OpFM_C2Fary_CopyMisc - - SUBROUTINE OpFM_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE OpFM_F2C_CopyMisc - - SUBROUTINE OpFM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_ParameterType), INTENT(IN) :: SrcParamData - TYPE(OpFM_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CopyParam' -! + END IF +END SUBROUTINE + +subroutine OpFM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(OpFM_OutputType), intent(in) :: SrcOutputData + type(OpFM_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'OpFM_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%C_obj%AirDens = SrcParamData%C_obj%AirDens - DstParamData%NumBl = SrcParamData%NumBl - DstParamData%C_obj%NumBl = SrcParamData%C_obj%NumBl - DstParamData%NMappings = SrcParamData%NMappings - DstParamData%C_obj%NMappings = SrcParamData%C_obj%NMappings - DstParamData%NnodesVel = SrcParamData%NnodesVel - DstParamData%C_obj%NnodesVel = SrcParamData%C_obj%NnodesVel - DstParamData%NnodesForce = SrcParamData%NnodesForce - DstParamData%C_obj%NnodesForce = SrcParamData%C_obj%NnodesForce - DstParamData%NnodesForceBlade = SrcParamData%NnodesForceBlade - DstParamData%C_obj%NnodesForceBlade = SrcParamData%C_obj%NnodesForceBlade - DstParamData%NnodesForceTower = SrcParamData%NnodesForceTower - DstParamData%C_obj%NnodesForceTower = SrcParamData%C_obj%NnodesForceTower -IF (ASSOCIATED(SrcParamData%forceBldRnodes)) THEN - i1_l = LBOUND(SrcParamData%forceBldRnodes,1) - i1_u = UBOUND(SrcParamData%forceBldRnodes,1) - IF (.NOT. ASSOCIATED(DstParamData%forceBldRnodes)) THEN - ALLOCATE(DstParamData%forceBldRnodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstParamData%forceBldRnodes = SrcParamData%forceBldRnodes -ENDIF -IF (ASSOCIATED(SrcParamData%forceTwrHnodes)) THEN - i1_l = LBOUND(SrcParamData%forceTwrHnodes,1) - i1_u = UBOUND(SrcParamData%forceTwrHnodes,1) - IF (.NOT. ASSOCIATED(DstParamData%forceTwrHnodes)) THEN - ALLOCATE(DstParamData%forceTwrHnodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstParamData%forceTwrHnodes = SrcParamData%forceTwrHnodes -ENDIF - DstParamData%BladeLength = SrcParamData%BladeLength - DstParamData%C_obj%BladeLength = SrcParamData%C_obj%BladeLength - DstParamData%TowerHeight = SrcParamData%TowerHeight - DstParamData%C_obj%TowerHeight = SrcParamData%C_obj%TowerHeight - DstParamData%TowerBaseHeight = SrcParamData%TowerBaseHeight - DstParamData%C_obj%TowerBaseHeight = SrcParamData%C_obj%TowerBaseHeight - DstParamData%NodeClusterType = SrcParamData%NodeClusterType - DstParamData%C_obj%NodeClusterType = SrcParamData%C_obj%NodeClusterType - END SUBROUTINE OpFM_CopyParam - - SUBROUTINE OpFM_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(OpFM_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 = 'OpFM_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(ParamData%forceBldRnodes)) THEN - 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 - DEALLOCATE(ParamData%forceTwrHnodes) - ParamData%forceTwrHnodes => NULL() - ParamData%C_obj%forceTwrHnodes = C_NULL_PTR - ParamData%C_obj%forceTwrHnodes_Len = 0 -ENDIF - END SUBROUTINE OpFM_DestroyParam - - SUBROUTINE OpFM_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(OpFM_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 = 'OpFM_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 - Re_BufSz = Re_BufSz + 1 ! AirDens - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1 ! NMappings - Int_BufSz = Int_BufSz + 1 ! NnodesVel - Int_BufSz = Int_BufSz + 1 ! NnodesForce - Int_BufSz = Int_BufSz + 1 ! NnodesForceBlade - Int_BufSz = Int_BufSz + 1 ! NnodesForceTower - Int_BufSz = Int_BufSz + 1 ! forceBldRnodes allocated yes/no - IF ( ASSOCIATED(InData%forceBldRnodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! forceBldRnodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%forceBldRnodes) ! forceBldRnodes - END IF - Int_BufSz = Int_BufSz + 1 ! forceTwrHnodes allocated yes/no - IF ( ASSOCIATED(InData%forceTwrHnodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! forceTwrHnodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%forceTwrHnodes) ! forceTwrHnodes - END IF - Re_BufSz = Re_BufSz + 1 ! BladeLength - Re_BufSz = Re_BufSz + 1 ! TowerHeight - Re_BufSz = Re_BufSz + 1 ! TowerBaseHeight - Int_BufSz = Int_BufSz + 1 ! NodeClusterType - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NMappings - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NnodesVel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NnodesForce - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NnodesForceBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NnodesForceTower - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%forceBldRnodes) ) 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%forceBldRnodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceBldRnodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%forceBldRnodes,1), UBOUND(InData%forceBldRnodes,1) - ReKiBuf(Re_Xferred) = InData%forceBldRnodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%forceTwrHnodes) ) 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%forceTwrHnodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceTwrHnodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%forceTwrHnodes,1), UBOUND(InData%forceTwrHnodes,1) - ReKiBuf(Re_Xferred) = InData%forceTwrHnodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NodeClusterType - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE OpFM_PackParam - - SUBROUTINE OpFM_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(OpFM_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_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%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%AirDens = OutData%AirDens - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumBl = OutData%NumBl - OutData%NMappings = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NMappings = OutData%NMappings - OutData%NnodesVel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NnodesVel = OutData%NnodesVel - OutData%NnodesForce = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NnodesForce = OutData%NnodesForce - OutData%NnodesForceBlade = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NnodesForceBlade = OutData%NnodesForceBlade - OutData%NnodesForceTower = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NnodesForceTower = OutData%NnodesForceTower - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceBldRnodes 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%forceBldRnodes)) DEALLOCATE(OutData%forceBldRnodes) - ALLOCATE(OutData%forceBldRnodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%forceBldRnodes,1), UBOUND(OutData%forceBldRnodes,1) - OutData%forceBldRnodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceTwrHnodes 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%forceTwrHnodes)) DEALLOCATE(OutData%forceTwrHnodes) - ALLOCATE(OutData%forceTwrHnodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%forceTwrHnodes,1), UBOUND(OutData%forceTwrHnodes,1) - OutData%forceTwrHnodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%BladeLength = OutData%BladeLength - OutData%TowerHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%TowerHeight = OutData%TowerHeight - OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight - OutData%NodeClusterType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NodeClusterType = OutData%NodeClusterType - END SUBROUTINE OpFM_UnPackParam - - SUBROUTINE OpFM_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%AirDens = ParamData%C_obj%AirDens - ParamData%NumBl = ParamData%C_obj%NumBl - ParamData%NMappings = ParamData%C_obj%NMappings - ParamData%NnodesVel = ParamData%C_obj%NnodesVel - ParamData%NnodesForce = ParamData%C_obj%NnodesForce - ParamData%NnodesForceBlade = ParamData%C_obj%NnodesForceBlade - ParamData%NnodesForceTower = ParamData%C_obj%NnodesForceTower - - ! -- forceBldRnodes Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceBldRnodes ) ) THEN - NULLIFY( ParamData%forceBldRnodes ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%forceBldRnodes, ParamData%forceBldRnodes, (/ParamData%C_obj%forceBldRnodes_Len/)) - END IF - END IF - - ! -- forceTwrHnodes Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceTwrHnodes ) ) THEN - NULLIFY( ParamData%forceTwrHnodes ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%forceTwrHnodes, ParamData%forceTwrHnodes, (/ParamData%C_obj%forceTwrHnodes_Len/)) - END IF - END IF - ParamData%BladeLength = ParamData%C_obj%BladeLength - ParamData%TowerHeight = ParamData%C_obj%TowerHeight - ParamData%TowerBaseHeight = ParamData%C_obj%TowerBaseHeight - ParamData%NodeClusterType = ParamData%C_obj%NodeClusterType - END SUBROUTINE OpFM_C2Fary_CopyParam - - SUBROUTINE OpFM_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%C_obj%AirDens = ParamData%AirDens - ParamData%C_obj%NumBl = ParamData%NumBl - ParamData%C_obj%NMappings = ParamData%NMappings - ParamData%C_obj%NnodesVel = ParamData%NnodesVel - ParamData%C_obj%NnodesForce = ParamData%NnodesForce - ParamData%C_obj%NnodesForceBlade = ParamData%NnodesForceBlade - ParamData%C_obj%NnodesForceTower = ParamData%NnodesForceTower - - ! -- 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 - 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) ) ) - 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 - 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) ) ) - END IF - END IF - ParamData%C_obj%BladeLength = ParamData%BladeLength - ParamData%C_obj%TowerHeight = ParamData%TowerHeight - ParamData%C_obj%TowerBaseHeight = ParamData%TowerBaseHeight - ParamData%C_obj%NodeClusterType = ParamData%NodeClusterType - END SUBROUTINE OpFM_F2C_CopyParam - - SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_InputType), INTENT(IN) :: SrcInputData - TYPE(OpFM_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + ErrMsg = '' + if (associated(SrcOutputData%u)) then + LB(1:1) = lbound(SrcOutputData%u) + UB(1:1) = ubound(SrcOutputData%u) + if (.not. associated(DstOutputData%u)) then + allocate(DstOutputData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOutputData%u = SrcOutputData%u + end if + if (associated(SrcOutputData%v)) then + LB(1:1) = lbound(SrcOutputData%v) + UB(1:1) = ubound(SrcOutputData%v) + if (.not. associated(DstOutputData%v)) then + allocate(DstOutputData%v(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOutputData%v = SrcOutputData%v + end if + if (associated(SrcOutputData%w)) then + LB(1:1) = lbound(SrcOutputData%w) + UB(1:1) = ubound(SrcOutputData%w) + if (.not. associated(DstOutputData%w)) then + allocate(DstOutputData%w(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOutputData%w = SrcOutputData%w + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine OpFM_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(OpFM_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'OpFM_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(OutputData%u)) then + deallocate(OutputData%u) + OutputData%u => null() + OutputData%C_obj%u = c_null_ptr + OutputData%C_obj%u_Len = 0 + end if + if (associated(OutputData%v)) then + deallocate(OutputData%v) + OutputData%v => null() + OutputData%C_obj%v = c_null_ptr + OutputData%C_obj%v_Len = 0 + end if + if (associated(OutputData%w)) then + deallocate(OutputData%w) + OutputData%w => null() + OutputData%C_obj%w = c_null_ptr + OutputData%C_obj%w_Len = 0 + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine OpFM_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'OpFM_PackOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, associated(InData%u)) + if (associated(InData%u)) then + call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) + call RegPackPointer(Buf, c_loc(InData%u), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%u) + end if + end if + call RegPack(Buf, associated(InData%v)) + if (associated(InData%v)) then + call RegPackBounds(Buf, 1, lbound(InData%v), ubound(InData%v)) + call RegPackPointer(Buf, c_loc(InData%v), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%v) + end if + end if + call RegPack(Buf, associated(InData%w)) + if (associated(InData%w)) then + call RegPackBounds(Buf, 1, lbound(InData%w), ubound(InData%w)) + call RegPackPointer(Buf, c_loc(InData%w), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%w) + end if + end if + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine OpFM_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'OpFM_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%u)) deallocate(OutData%u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%u, UB(1:1)-LB(1:1)) + OutData%u(LB(1):) => OutData%u + else + allocate(OutData%u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%u) + OutData%C_obj%u_Len = size(OutData%u) + if (OutData%C_obj%u_Len > 0) OutData%C_obj%u = c_loc(OutData%u(LB(1))) + call RegUnpack(Buf, OutData%u) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%u => null() + end if + if (associated(OutData%v)) deallocate(OutData%v) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%v, UB(1:1)-LB(1:1)) + OutData%v(LB(1):) => OutData%v + else + allocate(OutData%v(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%v.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%v) + OutData%C_obj%v_Len = size(OutData%v) + if (OutData%C_obj%v_Len > 0) OutData%C_obj%v = c_loc(OutData%v(LB(1))) + call RegUnpack(Buf, OutData%v) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%v => null() + end if + if (associated(OutData%w)) deallocate(OutData%w) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%w, UB(1:1)-LB(1:1)) + OutData%w(LB(1):) => OutData%w + else + allocate(OutData%w(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%w.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%w) + OutData%C_obj%w_Len = size(OutData%w) + if (OutData%C_obj%w_Len > 0) OutData%C_obj%w = c_loc(OutData%w(LB(1))) + call RegUnpack(Buf, OutData%w) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%w => null() + end if + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +SUBROUTINE OpFM_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData 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 = 'OpFM_CopyInput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" -IF (ASSOCIATED(SrcInputData%pxVel)) THEN - i1_l = LBOUND(SrcInputData%pxVel,1) - i1_u = UBOUND(SrcInputData%pxVel,1) - IF (.NOT. ASSOCIATED(DstInputData%pxVel)) THEN - ALLOCATE(DstInputData%pxVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%pxVel = SrcInputData%pxVel -ENDIF -IF (ASSOCIATED(SrcInputData%pyVel)) THEN - i1_l = LBOUND(SrcInputData%pyVel,1) - i1_u = UBOUND(SrcInputData%pyVel,1) - IF (.NOT. ASSOCIATED(DstInputData%pyVel)) THEN - ALLOCATE(DstInputData%pyVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%pyVel = SrcInputData%pyVel -ENDIF -IF (ASSOCIATED(SrcInputData%pzVel)) THEN - i1_l = LBOUND(SrcInputData%pzVel,1) - i1_u = UBOUND(SrcInputData%pzVel,1) - IF (.NOT. ASSOCIATED(DstInputData%pzVel)) THEN - ALLOCATE(DstInputData%pzVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%pzVel = SrcInputData%pzVel -ENDIF -IF (ASSOCIATED(SrcInputData%pxForce)) THEN - i1_l = LBOUND(SrcInputData%pxForce,1) - i1_u = UBOUND(SrcInputData%pxForce,1) - IF (.NOT. ASSOCIATED(DstInputData%pxForce)) THEN - ALLOCATE(DstInputData%pxForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%pxForce = SrcInputData%pxForce -ENDIF -IF (ASSOCIATED(SrcInputData%pyForce)) THEN - i1_l = LBOUND(SrcInputData%pyForce,1) - i1_u = UBOUND(SrcInputData%pyForce,1) - IF (.NOT. ASSOCIATED(DstInputData%pyForce)) THEN - ALLOCATE(DstInputData%pyForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%pyForce = SrcInputData%pyForce -ENDIF -IF (ASSOCIATED(SrcInputData%pzForce)) THEN - i1_l = LBOUND(SrcInputData%pzForce,1) - i1_u = UBOUND(SrcInputData%pzForce,1) - IF (.NOT. ASSOCIATED(DstInputData%pzForce)) THEN - ALLOCATE(DstInputData%pzForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%pzForce = SrcInputData%pzForce -ENDIF -IF (ASSOCIATED(SrcInputData%xdotForce)) THEN - i1_l = LBOUND(SrcInputData%xdotForce,1) - i1_u = UBOUND(SrcInputData%xdotForce,1) - IF (.NOT. ASSOCIATED(DstInputData%xdotForce)) THEN - ALLOCATE(DstInputData%xdotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%xdotForce = SrcInputData%xdotForce -ENDIF -IF (ASSOCIATED(SrcInputData%ydotForce)) THEN - i1_l = LBOUND(SrcInputData%ydotForce,1) - i1_u = UBOUND(SrcInputData%ydotForce,1) - IF (.NOT. ASSOCIATED(DstInputData%ydotForce)) THEN - ALLOCATE(DstInputData%ydotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%ydotForce = SrcInputData%ydotForce -ENDIF -IF (ASSOCIATED(SrcInputData%zdotForce)) THEN - i1_l = LBOUND(SrcInputData%zdotForce,1) - i1_u = UBOUND(SrcInputData%zdotForce,1) - IF (.NOT. ASSOCIATED(DstInputData%zdotForce)) THEN - ALLOCATE(DstInputData%zdotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%zdotForce = SrcInputData%zdotForce -ENDIF -IF (ASSOCIATED(SrcInputData%pOrientation)) THEN - i1_l = LBOUND(SrcInputData%pOrientation,1) - i1_u = UBOUND(SrcInputData%pOrientation,1) - IF (.NOT. ASSOCIATED(DstInputData%pOrientation)) THEN - ALLOCATE(DstInputData%pOrientation(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%pOrientation = SrcInputData%pOrientation -ENDIF -IF (ASSOCIATED(SrcInputData%fx)) THEN - i1_l = LBOUND(SrcInputData%fx,1) - i1_u = UBOUND(SrcInputData%fx,1) - IF (.NOT. ASSOCIATED(DstInputData%fx)) THEN - ALLOCATE(DstInputData%fx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%fx = SrcInputData%fx -ENDIF -IF (ASSOCIATED(SrcInputData%fy)) THEN - i1_l = LBOUND(SrcInputData%fy,1) - i1_u = UBOUND(SrcInputData%fy,1) - IF (.NOT. ASSOCIATED(DstInputData%fy)) THEN - ALLOCATE(DstInputData%fy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%fy = SrcInputData%fy -ENDIF -IF (ASSOCIATED(SrcInputData%fz)) THEN - i1_l = LBOUND(SrcInputData%fz,1) - i1_u = UBOUND(SrcInputData%fz,1) - IF (.NOT. ASSOCIATED(DstInputData%fz)) THEN - ALLOCATE(DstInputData%fz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%fz = SrcInputData%fz -ENDIF -IF (ASSOCIATED(SrcInputData%momentx)) THEN - i1_l = LBOUND(SrcInputData%momentx,1) - i1_u = UBOUND(SrcInputData%momentx,1) - IF (.NOT. ASSOCIATED(DstInputData%momentx)) THEN - ALLOCATE(DstInputData%momentx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%momentx = SrcInputData%momentx -ENDIF -IF (ASSOCIATED(SrcInputData%momenty)) THEN - i1_l = LBOUND(SrcInputData%momenty,1) - i1_u = UBOUND(SrcInputData%momenty,1) - IF (.NOT. ASSOCIATED(DstInputData%momenty)) THEN - ALLOCATE(DstInputData%momenty(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%momenty = SrcInputData%momenty -ENDIF -IF (ASSOCIATED(SrcInputData%momentz)) THEN - i1_l = LBOUND(SrcInputData%momentz,1) - i1_u = UBOUND(SrcInputData%momentz,1) - IF (.NOT. ASSOCIATED(DstInputData%momentz)) THEN - ALLOCATE(DstInputData%momentz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%momentz = SrcInputData%momentz -ENDIF -IF (ASSOCIATED(SrcInputData%forceNodesChord)) THEN - i1_l = LBOUND(SrcInputData%forceNodesChord,1) - i1_u = UBOUND(SrcInputData%forceNodesChord,1) - IF (.NOT. ASSOCIATED(DstInputData%forceNodesChord)) THEN - ALLOCATE(DstInputData%forceNodesChord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%forceNodesChord = SrcInputData%forceNodesChord -ENDIF - END SUBROUTINE OpFM_CopyInput - - SUBROUTINE OpFM_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(OpFM_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 = 'OpFM_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(InputData%pxVel)) THEN - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - DEALLOCATE(InputData%forceNodesChord) - InputData%forceNodesChord => NULL() - InputData%C_obj%forceNodesChord = C_NULL_PTR - InputData%C_obj%forceNodesChord_Len = 0 -ENDIF - END SUBROUTINE OpFM_DestroyInput - - SUBROUTINE OpFM_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(OpFM_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 = 'OpFM_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 - Int_BufSz = Int_BufSz + 1 ! pxVel allocated yes/no - IF ( ASSOCIATED(InData%pxVel) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pxVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pxVel) ! pxVel - END IF - Int_BufSz = Int_BufSz + 1 ! pyVel allocated yes/no - IF ( ASSOCIATED(InData%pyVel) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pyVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pyVel) ! pyVel - END IF - Int_BufSz = Int_BufSz + 1 ! pzVel allocated yes/no - IF ( ASSOCIATED(InData%pzVel) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pzVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pzVel) ! pzVel - END IF - Int_BufSz = Int_BufSz + 1 ! pxForce allocated yes/no - IF ( ASSOCIATED(InData%pxForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pxForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pxForce) ! pxForce - END IF - Int_BufSz = Int_BufSz + 1 ! pyForce allocated yes/no - IF ( ASSOCIATED(InData%pyForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pyForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pyForce) ! pyForce - END IF - Int_BufSz = Int_BufSz + 1 ! pzForce allocated yes/no - IF ( ASSOCIATED(InData%pzForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pzForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pzForce) ! pzForce - END IF - Int_BufSz = Int_BufSz + 1 ! xdotForce allocated yes/no - IF ( ASSOCIATED(InData%xdotForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xdotForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xdotForce) ! xdotForce - END IF - Int_BufSz = Int_BufSz + 1 ! ydotForce allocated yes/no - IF ( ASSOCIATED(InData%ydotForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ydotForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ydotForce) ! ydotForce - END IF - Int_BufSz = Int_BufSz + 1 ! zdotForce allocated yes/no - IF ( ASSOCIATED(InData%zdotForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zdotForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zdotForce) ! zdotForce - END IF - Int_BufSz = Int_BufSz + 1 ! pOrientation allocated yes/no - IF ( ASSOCIATED(InData%pOrientation) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pOrientation upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pOrientation) ! pOrientation - END IF - Int_BufSz = Int_BufSz + 1 ! fx allocated yes/no - IF ( ASSOCIATED(InData%fx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fx) ! fx - END IF - Int_BufSz = Int_BufSz + 1 ! fy allocated yes/no - IF ( ASSOCIATED(InData%fy) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fy) ! fy - END IF - Int_BufSz = Int_BufSz + 1 ! fz allocated yes/no - IF ( ASSOCIATED(InData%fz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fz) ! fz - END IF - Int_BufSz = Int_BufSz + 1 ! momentx allocated yes/no - IF ( ASSOCIATED(InData%momentx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! momentx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%momentx) ! momentx - END IF - Int_BufSz = Int_BufSz + 1 ! momenty allocated yes/no - IF ( ASSOCIATED(InData%momenty) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! momenty upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%momenty) ! momenty - END IF - Int_BufSz = Int_BufSz + 1 ! momentz allocated yes/no - IF ( ASSOCIATED(InData%momentz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! momentz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%momentz) ! momentz - END IF - Int_BufSz = Int_BufSz + 1 ! forceNodesChord allocated yes/no - IF ( ASSOCIATED(InData%forceNodesChord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! forceNodesChord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%forceNodesChord) ! forceNodesChord - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%pxVel) ) 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%pxVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxVel,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pxVel,1), UBOUND(InData%pxVel,1) - ReKiBuf(Re_Xferred) = InData%pxVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pyVel) ) 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%pyVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyVel,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pyVel,1), UBOUND(InData%pyVel,1) - ReKiBuf(Re_Xferred) = InData%pyVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pzVel) ) 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%pzVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzVel,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pzVel,1), UBOUND(InData%pzVel,1) - ReKiBuf(Re_Xferred) = InData%pzVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pxForce) ) 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%pxForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pxForce,1), UBOUND(InData%pxForce,1) - ReKiBuf(Re_Xferred) = InData%pxForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pyForce) ) 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%pyForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pyForce,1), UBOUND(InData%pyForce,1) - ReKiBuf(Re_Xferred) = InData%pyForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pzForce) ) 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%pzForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pzForce,1), UBOUND(InData%pzForce,1) - ReKiBuf(Re_Xferred) = InData%pzForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%xdotForce) ) 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%xdotForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdotForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xdotForce,1), UBOUND(InData%xdotForce,1) - ReKiBuf(Re_Xferred) = InData%xdotForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%ydotForce) ) 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%ydotForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ydotForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ydotForce,1), UBOUND(InData%ydotForce,1) - ReKiBuf(Re_Xferred) = InData%ydotForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%zdotForce) ) 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%zdotForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zdotForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zdotForce,1), UBOUND(InData%zdotForce,1) - ReKiBuf(Re_Xferred) = InData%zdotForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pOrientation) ) 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%pOrientation,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pOrientation,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pOrientation,1), UBOUND(InData%pOrientation,1) - ReKiBuf(Re_Xferred) = InData%pOrientation(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%fx) ) 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%fx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fx,1), UBOUND(InData%fx,1) - ReKiBuf(Re_Xferred) = InData%fx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%fy) ) 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%fy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fy,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fy,1), UBOUND(InData%fy,1) - ReKiBuf(Re_Xferred) = InData%fy(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%fz) ) 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%fz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fz,1), UBOUND(InData%fz,1) - ReKiBuf(Re_Xferred) = InData%fz(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%momentx) ) 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%momentx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momentx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%momentx,1), UBOUND(InData%momentx,1) - ReKiBuf(Re_Xferred) = InData%momentx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%momenty) ) 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%momenty,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momenty,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%momenty,1), UBOUND(InData%momenty,1) - ReKiBuf(Re_Xferred) = InData%momenty(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%momentz) ) 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%momentz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momentz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%momentz,1), UBOUND(InData%momentz,1) - ReKiBuf(Re_Xferred) = InData%momentz(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%forceNodesChord) ) 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%forceNodesChord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceNodesChord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%forceNodesChord,1), UBOUND(InData%forceNodesChord,1) - ReKiBuf(Re_Xferred) = InData%forceNodesChord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE OpFM_PackInput - - SUBROUTINE OpFM_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(OpFM_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pxVel 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%pxVel)) DEALLOCATE(OutData%pxVel) - ALLOCATE(OutData%pxVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%pxVel,1), UBOUND(OutData%pxVel,1) - OutData%pxVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyVel 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%pyVel)) DEALLOCATE(OutData%pyVel) - ALLOCATE(OutData%pyVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%pyVel,1), UBOUND(OutData%pyVel,1) - OutData%pyVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzVel 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%pzVel)) DEALLOCATE(OutData%pzVel) - ALLOCATE(OutData%pzVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%pzVel,1), UBOUND(OutData%pzVel,1) - OutData%pzVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pxForce 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%pxForce)) DEALLOCATE(OutData%pxForce) - ALLOCATE(OutData%pxForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%pxForce,1), UBOUND(OutData%pxForce,1) - OutData%pxForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyForce 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%pyForce)) DEALLOCATE(OutData%pyForce) - ALLOCATE(OutData%pyForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%pyForce,1), UBOUND(OutData%pyForce,1) - OutData%pyForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzForce 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%pzForce)) DEALLOCATE(OutData%pzForce) - ALLOCATE(OutData%pzForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%pzForce,1), UBOUND(OutData%pzForce,1) - OutData%pzForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdotForce 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%xdotForce)) DEALLOCATE(OutData%xdotForce) - ALLOCATE(OutData%xdotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%xdotForce,1), UBOUND(OutData%xdotForce,1) - OutData%xdotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ydotForce 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%ydotForce)) DEALLOCATE(OutData%ydotForce) - ALLOCATE(OutData%ydotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%ydotForce,1), UBOUND(OutData%ydotForce,1) - OutData%ydotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zdotForce 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%zdotForce)) DEALLOCATE(OutData%zdotForce) - ALLOCATE(OutData%zdotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%zdotForce,1), UBOUND(OutData%zdotForce,1) - OutData%zdotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pOrientation 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%pOrientation)) DEALLOCATE(OutData%pOrientation) - ALLOCATE(OutData%pOrientation(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%pOrientation,1), UBOUND(OutData%pOrientation,1) - OutData%pOrientation(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fx 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%fx)) DEALLOCATE(OutData%fx) - ALLOCATE(OutData%fx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%fx,1), UBOUND(OutData%fx,1) - OutData%fx(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fy 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%fy)) DEALLOCATE(OutData%fy) - ALLOCATE(OutData%fy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%fy,1), UBOUND(OutData%fy,1) - OutData%fy(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fz 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%fz)) DEALLOCATE(OutData%fz) - ALLOCATE(OutData%fz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%fz,1), UBOUND(OutData%fz,1) - OutData%fz(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momentx 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%momentx)) DEALLOCATE(OutData%momentx) - ALLOCATE(OutData%momentx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%momentx,1), UBOUND(OutData%momentx,1) - OutData%momentx(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momenty 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%momenty)) DEALLOCATE(OutData%momenty) - ALLOCATE(OutData%momenty(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%momenty,1), UBOUND(OutData%momenty,1) - OutData%momenty(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momentz 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%momentz)) DEALLOCATE(OutData%momentz) - ALLOCATE(OutData%momentz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%momentz,1), UBOUND(OutData%momentz,1) - OutData%momentz(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceNodesChord 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%forceNodesChord)) DEALLOCATE(OutData%forceNodesChord) - ALLOCATE(OutData%forceNodesChord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%forceNodesChord,1), UBOUND(OutData%forceNodesChord,1) - OutData%forceNodesChord(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE OpFM_UnPackInput - - SUBROUTINE OpFM_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- pxVel Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxVel ) ) THEN - NULLIFY( InputData%pxVel ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pxVel, InputData%pxVel, (/InputData%C_obj%pxVel_Len/)) - END IF - END IF - - ! -- pyVel Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyVel ) ) THEN - NULLIFY( InputData%pyVel ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pyVel, InputData%pyVel, (/InputData%C_obj%pyVel_Len/)) - END IF - END IF - - ! -- pzVel Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzVel ) ) THEN - NULLIFY( InputData%pzVel ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pzVel, InputData%pzVel, (/InputData%C_obj%pzVel_Len/)) - END IF - END IF - - ! -- pxForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxForce ) ) THEN - NULLIFY( InputData%pxForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pxForce, InputData%pxForce, (/InputData%C_obj%pxForce_Len/)) - END IF - END IF - - ! -- pyForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyForce ) ) THEN - NULLIFY( InputData%pyForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pyForce, InputData%pyForce, (/InputData%C_obj%pyForce_Len/)) - END IF - END IF - - ! -- pzForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzForce ) ) THEN - NULLIFY( InputData%pzForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pzForce, InputData%pzForce, (/InputData%C_obj%pzForce_Len/)) - END IF - END IF - - ! -- xdotForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%xdotForce ) ) THEN - NULLIFY( InputData%xdotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%xdotForce, InputData%xdotForce, (/InputData%C_obj%xdotForce_Len/)) - END IF - END IF - - ! -- ydotForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%ydotForce ) ) THEN - NULLIFY( InputData%ydotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%ydotForce, InputData%ydotForce, (/InputData%C_obj%ydotForce_Len/)) - END IF - END IF - - ! -- zdotForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%zdotForce ) ) THEN - NULLIFY( InputData%zdotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%zdotForce, InputData%zdotForce, (/InputData%C_obj%zdotForce_Len/)) - END IF - END IF - - ! -- pOrientation Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pOrientation ) ) THEN - NULLIFY( InputData%pOrientation ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pOrientation, InputData%pOrientation, (/InputData%C_obj%pOrientation_Len/)) - END IF - END IF - - ! -- fx Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fx ) ) THEN - NULLIFY( InputData%fx ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fx, InputData%fx, (/InputData%C_obj%fx_Len/)) - END IF - END IF - - ! -- fy Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fy ) ) THEN - NULLIFY( InputData%fy ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fy, InputData%fy, (/InputData%C_obj%fy_Len/)) - END IF - END IF - - ! -- fz Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fz ) ) THEN - NULLIFY( InputData%fz ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fz, InputData%fz, (/InputData%C_obj%fz_Len/)) - END IF - END IF - - ! -- momentx Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentx ) ) THEN - NULLIFY( InputData%momentx ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momentx, InputData%momentx, (/InputData%C_obj%momentx_Len/)) - END IF - END IF - - ! -- momenty Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momenty ) ) THEN - NULLIFY( InputData%momenty ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momenty, InputData%momenty, (/InputData%C_obj%momenty_Len/)) - END IF - END IF - - ! -- momentz Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentz ) ) THEN - NULLIFY( InputData%momentz ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momentz, InputData%momentz, (/InputData%C_obj%momentz_Len/)) - END IF - END IF - - ! -- forceNodesChord Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%forceNodesChord ) ) THEN - NULLIFY( InputData%forceNodesChord ) - ELSE - CALL C_F_POINTER(InputData%C_obj%forceNodesChord, InputData%forceNodesChord, (/InputData%C_obj%forceNodesChord_Len/)) - END IF - END IF - END SUBROUTINE OpFM_C2Fary_CopyInput - - SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - END IF - END IF - END SUBROUTINE OpFM_F2C_CopyInput + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- u Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%u ) ) THEN + NULLIFY( OutputData%u ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%u, OutputData%u, [OutputData%C_obj%u_Len]) + END IF + END IF + + ! -- v Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%v ) ) THEN + NULLIFY( OutputData%v ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%v, OutputData%v, [OutputData%C_obj%v_Len]) + END IF + END IF + + ! -- w Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%w ) ) THEN + NULLIFY( OutputData%w ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%w, OutputData%w, [OutputData%C_obj%w_Len]) + END IF + END IF +END SUBROUTINE - SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_OutputType), INTENT(IN) :: SrcOutputData - TYPE(OpFM_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode +SUBROUTINE OpFM_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData 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 = 'OpFM_CopyOutput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcOutputData%u)) THEN - i1_l = LBOUND(SrcOutputData%u,1) - i1_u = UBOUND(SrcOutputData%u,1) - IF (.NOT. ASSOCIATED(DstOutputData%u)) THEN - ALLOCATE(DstOutputData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOutputData%u = SrcOutputData%u -ENDIF -IF (ASSOCIATED(SrcOutputData%v)) THEN - i1_l = LBOUND(SrcOutputData%v,1) - i1_u = UBOUND(SrcOutputData%v,1) - IF (.NOT. ASSOCIATED(DstOutputData%v)) THEN - ALLOCATE(DstOutputData%v(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOutputData%v = SrcOutputData%v -ENDIF -IF (ASSOCIATED(SrcOutputData%w)) THEN - i1_l = LBOUND(SrcOutputData%w,1) - i1_u = UBOUND(SrcOutputData%w,1) - IF (.NOT. ASSOCIATED(DstOutputData%w)) THEN - ALLOCATE(DstOutputData%w(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOutputData%w = SrcOutputData%w -ENDIF -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 OpFM_CopyOutput - - SUBROUTINE OpFM_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(OpFM_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 = 'OpFM_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(OutputData%u)) THEN - 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 - 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 - DEALLOCATE(OutputData%w) - OutputData%w => NULL() - OutputData%C_obj%w = C_NULL_PTR - OutputData%C_obj%w_Len = 0 -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE OpFM_DestroyOutput - - SUBROUTINE OpFM_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(OpFM_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 = 'OpFM_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 ! u allocated yes/no - IF ( ASSOCIATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%u) ! u - END IF - Int_BufSz = Int_BufSz + 1 ! v allocated yes/no - IF ( ASSOCIATED(InData%v) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! v upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%v) ! v - END IF - Int_BufSz = Int_BufSz + 1 ! w allocated yes/no - IF ( ASSOCIATED(InData%w) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! w upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%w) ! w - END IF - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%u) ) 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%u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - ReKiBuf(Re_Xferred) = InData%u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%v) ) 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%v,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%v,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%v,1), UBOUND(InData%v,1) - ReKiBuf(Re_Xferred) = InData%v(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%w) ) 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%w,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%w,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%w,1), UBOUND(InData%w,1) - ReKiBuf(Re_Xferred) = InData%w(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 OpFM_PackOutput - - SUBROUTINE OpFM_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(OpFM_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 = 'OpFM_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 ! u 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%u)) DEALLOCATE(OutData%u) - ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) - OutData%u(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! v 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%v)) DEALLOCATE(OutData%v) - ALLOCATE(OutData%v(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%v,1), UBOUND(OutData%v,1) - OutData%v(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! w 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%w)) DEALLOCATE(OutData%w) - ALLOCATE(OutData%w(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%w,1), UBOUND(OutData%w,1) - OutData%w(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 OpFM_UnPackOutput - - SUBROUTINE OpFM_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- u Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%u ) ) THEN - NULLIFY( OutputData%u ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%u, OutputData%u, (/OutputData%C_obj%u_Len/)) - END IF - END IF - - ! -- v Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%v ) ) THEN - NULLIFY( OutputData%v ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%v, OutputData%v, (/OutputData%C_obj%v_Len/)) - END IF - END IF - - ! -- w Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%w ) ) THEN - NULLIFY( OutputData%w ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%w, OutputData%w, (/OutputData%C_obj%w_Len/)) - END IF - END IF - END SUBROUTINE OpFM_C2Fary_CopyOutput - - SUBROUTINE OpFM_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- 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 - 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) ) ) - 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 - 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) ) ) - 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 - 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) ) ) - END IF - END IF - END SUBROUTINE OpFM_F2C_CopyOutput - - - SUBROUTINE OpFM_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(OpFM_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(OpFM_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 + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- 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 + 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))) + 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 + 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))) + 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 + 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))) + END IF + END IF +END SUBROUTINE + +subroutine OpFM_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(OpFM_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(OpFM_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 = 'OpFM_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 OpFM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL OpFM_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 OpFM_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 OpFM_Input_ExtrapInterp - - - SUBROUTINE OpFM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call OpFM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call OpFM_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call OpFM_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE OpFM_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. @@ -4225,143 +3024,93 @@ SUBROUTINE OpFM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(OpFM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(OpFM_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(OpFM_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 + TYPE(OpFM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(OpFM_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(OpFM_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 = 'OpFM_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 - 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN - DO i1 = LBOUND(u_out%pxVel,1),UBOUND(u_out%pxVel,1) - b = -(u1%pxVel(i1) - u2%pxVel(i1)) - u_out%pxVel(i1) = u1%pxVel(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN - DO i1 = LBOUND(u_out%pyVel,1),UBOUND(u_out%pyVel,1) - b = -(u1%pyVel(i1) - u2%pyVel(i1)) - u_out%pyVel(i1) = u1%pyVel(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN - DO i1 = LBOUND(u_out%pzVel,1),UBOUND(u_out%pzVel,1) - b = -(u1%pzVel(i1) - u2%pzVel(i1)) - u_out%pzVel(i1) = u1%pzVel(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN - DO i1 = LBOUND(u_out%pxForce,1),UBOUND(u_out%pxForce,1) - b = -(u1%pxForce(i1) - u2%pxForce(i1)) - u_out%pxForce(i1) = u1%pxForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN - DO i1 = LBOUND(u_out%pyForce,1),UBOUND(u_out%pyForce,1) - b = -(u1%pyForce(i1) - u2%pyForce(i1)) - u_out%pyForce(i1) = u1%pyForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN - DO i1 = LBOUND(u_out%pzForce,1),UBOUND(u_out%pzForce,1) - b = -(u1%pzForce(i1) - u2%pzForce(i1)) - u_out%pzForce(i1) = u1%pzForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN - DO i1 = LBOUND(u_out%xdotForce,1),UBOUND(u_out%xdotForce,1) - b = -(u1%xdotForce(i1) - u2%xdotForce(i1)) - u_out%xdotForce(i1) = u1%xdotForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN - DO i1 = LBOUND(u_out%ydotForce,1),UBOUND(u_out%ydotForce,1) - b = -(u1%ydotForce(i1) - u2%ydotForce(i1)) - u_out%ydotForce(i1) = u1%ydotForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN - DO i1 = LBOUND(u_out%zdotForce,1),UBOUND(u_out%zdotForce,1) - b = -(u1%zdotForce(i1) - u2%zdotForce(i1)) - u_out%zdotForce(i1) = u1%zdotForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN - DO i1 = LBOUND(u_out%pOrientation,1),UBOUND(u_out%pOrientation,1) - b = -(u1%pOrientation(i1) - u2%pOrientation(i1)) - u_out%pOrientation(i1) = u1%pOrientation(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN - DO i1 = LBOUND(u_out%fx,1),UBOUND(u_out%fx,1) - b = -(u1%fx(i1) - u2%fx(i1)) - u_out%fx(i1) = u1%fx(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN - DO i1 = LBOUND(u_out%fy,1),UBOUND(u_out%fy,1) - b = -(u1%fy(i1) - u2%fy(i1)) - u_out%fy(i1) = u1%fy(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN - DO i1 = LBOUND(u_out%fz,1),UBOUND(u_out%fz,1) - b = -(u1%fz(i1) - u2%fz(i1)) - u_out%fz(i1) = u1%fz(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN - DO i1 = LBOUND(u_out%momentx,1),UBOUND(u_out%momentx,1) - b = -(u1%momentx(i1) - u2%momentx(i1)) - u_out%momentx(i1) = u1%momentx(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN - DO i1 = LBOUND(u_out%momenty,1),UBOUND(u_out%momenty,1) - b = -(u1%momenty(i1) - u2%momenty(i1)) - u_out%momenty(i1) = u1%momenty(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN - DO i1 = LBOUND(u_out%momentz,1),UBOUND(u_out%momentz,1) - b = -(u1%momentz(i1) - u2%momentz(i1)) - u_out%momentz(i1) = u1%momentz(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN - DO i1 = LBOUND(u_out%forceNodesChord,1),UBOUND(u_out%forceNodesChord,1) - b = -(u1%forceNodesChord(i1) - u2%forceNodesChord(i1)) - u_out%forceNodesChord(i1) = u1%forceNodesChord(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE OpFM_Input_ExtrapInterp1 - - - SUBROUTINE OpFM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN + u_out%pxVel = a1*u1%pxVel + a2*u2%pxVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN + u_out%pyVel = a1*u1%pyVel + a2*u2%pyVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN + u_out%pzVel = a1*u1%pzVel + a2*u2%pzVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN + u_out%pxForce = a1*u1%pxForce + a2*u2%pxForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN + u_out%pyForce = a1*u1%pyForce + a2*u2%pyForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN + u_out%pzForce = a1*u1%pzForce + a2*u2%pzForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN + u_out%xdotForce = a1*u1%xdotForce + a2*u2%xdotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN + u_out%ydotForce = a1*u1%ydotForce + a2*u2%ydotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN + u_out%zdotForce = a1*u1%zdotForce + a2*u2%zdotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN + u_out%pOrientation = a1*u1%pOrientation + a2*u2%pOrientation + END IF ! check if allocated + IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN + u_out%fx = a1*u1%fx + a2*u2%fx + END IF ! check if allocated + IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN + u_out%fy = a1*u1%fy + a2*u2%fy + END IF ! check if allocated + IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN + u_out%fz = a1*u1%fz + a2*u2%fz + END IF ! check if allocated + IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN + u_out%momentx = a1*u1%momentx + a2*u2%momentx + END IF ! check if allocated + IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN + u_out%momenty = a1*u1%momenty + a2*u2%momenty + END IF ! check if allocated + IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN + u_out%momentz = a1*u1%momentz + a2*u2%momentz + END IF ! check if allocated + IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN + u_out%forceNodesChord = a1*u1%forceNodesChord + a2*u2%forceNodesChord + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE OpFM_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. @@ -4375,220 +3124,153 @@ SUBROUTINE OpFM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(OpFM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(OpFM_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(OpFM_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(OpFM_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 + TYPE(OpFM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(OpFM_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(OpFM_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(OpFM_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 = 'OpFM_Input_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_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 + 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 + 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 + 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 (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN - DO i1 = LBOUND(u_out%pxVel,1),UBOUND(u_out%pxVel,1) - b = (t(3)**2*(u1%pxVel(i1) - u2%pxVel(i1)) + t(2)**2*(-u1%pxVel(i1) + u3%pxVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pxVel(i1) + t(3)*u2%pxVel(i1) - t(2)*u3%pxVel(i1) ) * scaleFactor - u_out%pxVel(i1) = u1%pxVel(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN - DO i1 = LBOUND(u_out%pyVel,1),UBOUND(u_out%pyVel,1) - b = (t(3)**2*(u1%pyVel(i1) - u2%pyVel(i1)) + t(2)**2*(-u1%pyVel(i1) + u3%pyVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pyVel(i1) + t(3)*u2%pyVel(i1) - t(2)*u3%pyVel(i1) ) * scaleFactor - u_out%pyVel(i1) = u1%pyVel(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN - DO i1 = LBOUND(u_out%pzVel,1),UBOUND(u_out%pzVel,1) - b = (t(3)**2*(u1%pzVel(i1) - u2%pzVel(i1)) + t(2)**2*(-u1%pzVel(i1) + u3%pzVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pzVel(i1) + t(3)*u2%pzVel(i1) - t(2)*u3%pzVel(i1) ) * scaleFactor - u_out%pzVel(i1) = u1%pzVel(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN - DO i1 = LBOUND(u_out%pxForce,1),UBOUND(u_out%pxForce,1) - b = (t(3)**2*(u1%pxForce(i1) - u2%pxForce(i1)) + t(2)**2*(-u1%pxForce(i1) + u3%pxForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pxForce(i1) + t(3)*u2%pxForce(i1) - t(2)*u3%pxForce(i1) ) * scaleFactor - u_out%pxForce(i1) = u1%pxForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN - DO i1 = LBOUND(u_out%pyForce,1),UBOUND(u_out%pyForce,1) - b = (t(3)**2*(u1%pyForce(i1) - u2%pyForce(i1)) + t(2)**2*(-u1%pyForce(i1) + u3%pyForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pyForce(i1) + t(3)*u2%pyForce(i1) - t(2)*u3%pyForce(i1) ) * scaleFactor - u_out%pyForce(i1) = u1%pyForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN - DO i1 = LBOUND(u_out%pzForce,1),UBOUND(u_out%pzForce,1) - b = (t(3)**2*(u1%pzForce(i1) - u2%pzForce(i1)) + t(2)**2*(-u1%pzForce(i1) + u3%pzForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pzForce(i1) + t(3)*u2%pzForce(i1) - t(2)*u3%pzForce(i1) ) * scaleFactor - u_out%pzForce(i1) = u1%pzForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN - DO i1 = LBOUND(u_out%xdotForce,1),UBOUND(u_out%xdotForce,1) - b = (t(3)**2*(u1%xdotForce(i1) - u2%xdotForce(i1)) + t(2)**2*(-u1%xdotForce(i1) + u3%xdotForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%xdotForce(i1) + t(3)*u2%xdotForce(i1) - t(2)*u3%xdotForce(i1) ) * scaleFactor - u_out%xdotForce(i1) = u1%xdotForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN - DO i1 = LBOUND(u_out%ydotForce,1),UBOUND(u_out%ydotForce,1) - b = (t(3)**2*(u1%ydotForce(i1) - u2%ydotForce(i1)) + t(2)**2*(-u1%ydotForce(i1) + u3%ydotForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%ydotForce(i1) + t(3)*u2%ydotForce(i1) - t(2)*u3%ydotForce(i1) ) * scaleFactor - u_out%ydotForce(i1) = u1%ydotForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN - DO i1 = LBOUND(u_out%zdotForce,1),UBOUND(u_out%zdotForce,1) - b = (t(3)**2*(u1%zdotForce(i1) - u2%zdotForce(i1)) + t(2)**2*(-u1%zdotForce(i1) + u3%zdotForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%zdotForce(i1) + t(3)*u2%zdotForce(i1) - t(2)*u3%zdotForce(i1) ) * scaleFactor - u_out%zdotForce(i1) = u1%zdotForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN - DO i1 = LBOUND(u_out%pOrientation,1),UBOUND(u_out%pOrientation,1) - b = (t(3)**2*(u1%pOrientation(i1) - u2%pOrientation(i1)) + t(2)**2*(-u1%pOrientation(i1) + u3%pOrientation(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pOrientation(i1) + t(3)*u2%pOrientation(i1) - t(2)*u3%pOrientation(i1) ) * scaleFactor - u_out%pOrientation(i1) = u1%pOrientation(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN - DO i1 = LBOUND(u_out%fx,1),UBOUND(u_out%fx,1) - b = (t(3)**2*(u1%fx(i1) - u2%fx(i1)) + t(2)**2*(-u1%fx(i1) + u3%fx(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%fx(i1) + t(3)*u2%fx(i1) - t(2)*u3%fx(i1) ) * scaleFactor - u_out%fx(i1) = u1%fx(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN - DO i1 = LBOUND(u_out%fy,1),UBOUND(u_out%fy,1) - b = (t(3)**2*(u1%fy(i1) - u2%fy(i1)) + t(2)**2*(-u1%fy(i1) + u3%fy(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%fy(i1) + t(3)*u2%fy(i1) - t(2)*u3%fy(i1) ) * scaleFactor - u_out%fy(i1) = u1%fy(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN - DO i1 = LBOUND(u_out%fz,1),UBOUND(u_out%fz,1) - b = (t(3)**2*(u1%fz(i1) - u2%fz(i1)) + t(2)**2*(-u1%fz(i1) + u3%fz(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%fz(i1) + t(3)*u2%fz(i1) - t(2)*u3%fz(i1) ) * scaleFactor - u_out%fz(i1) = u1%fz(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN - DO i1 = LBOUND(u_out%momentx,1),UBOUND(u_out%momentx,1) - b = (t(3)**2*(u1%momentx(i1) - u2%momentx(i1)) + t(2)**2*(-u1%momentx(i1) + u3%momentx(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%momentx(i1) + t(3)*u2%momentx(i1) - t(2)*u3%momentx(i1) ) * scaleFactor - u_out%momentx(i1) = u1%momentx(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN - DO i1 = LBOUND(u_out%momenty,1),UBOUND(u_out%momenty,1) - b = (t(3)**2*(u1%momenty(i1) - u2%momenty(i1)) + t(2)**2*(-u1%momenty(i1) + u3%momenty(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%momenty(i1) + t(3)*u2%momenty(i1) - t(2)*u3%momenty(i1) ) * scaleFactor - u_out%momenty(i1) = u1%momenty(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN - DO i1 = LBOUND(u_out%momentz,1),UBOUND(u_out%momentz,1) - b = (t(3)**2*(u1%momentz(i1) - u2%momentz(i1)) + t(2)**2*(-u1%momentz(i1) + u3%momentz(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%momentz(i1) + t(3)*u2%momentz(i1) - t(2)*u3%momentz(i1) ) * scaleFactor - u_out%momentz(i1) = u1%momentz(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN - DO i1 = LBOUND(u_out%forceNodesChord,1),UBOUND(u_out%forceNodesChord,1) - b = (t(3)**2*(u1%forceNodesChord(i1) - u2%forceNodesChord(i1)) + t(2)**2*(-u1%forceNodesChord(i1) + u3%forceNodesChord(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%forceNodesChord(i1) + t(3)*u2%forceNodesChord(i1) - t(2)*u3%forceNodesChord(i1) ) * scaleFactor - u_out%forceNodesChord(i1) = u1%forceNodesChord(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE OpFM_Input_ExtrapInterp2 - - - SUBROUTINE OpFM_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(OpFM_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(OpFM_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN + u_out%pxVel = a1*u1%pxVel + a2*u2%pxVel + a3*u3%pxVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN + u_out%pyVel = a1*u1%pyVel + a2*u2%pyVel + a3*u3%pyVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN + u_out%pzVel = a1*u1%pzVel + a2*u2%pzVel + a3*u3%pzVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN + u_out%pxForce = a1*u1%pxForce + a2*u2%pxForce + a3*u3%pxForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN + u_out%pyForce = a1*u1%pyForce + a2*u2%pyForce + a3*u3%pyForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN + u_out%pzForce = a1*u1%pzForce + a2*u2%pzForce + a3*u3%pzForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN + u_out%xdotForce = a1*u1%xdotForce + a2*u2%xdotForce + a3*u3%xdotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN + u_out%ydotForce = a1*u1%ydotForce + a2*u2%ydotForce + a3*u3%ydotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN + u_out%zdotForce = a1*u1%zdotForce + a2*u2%zdotForce + a3*u3%zdotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN + u_out%pOrientation = a1*u1%pOrientation + a2*u2%pOrientation + a3*u3%pOrientation + END IF ! check if allocated + IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN + u_out%fx = a1*u1%fx + a2*u2%fx + a3*u3%fx + END IF ! check if allocated + IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN + u_out%fy = a1*u1%fy + a2*u2%fy + a3*u3%fy + END IF ! check if allocated + IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN + u_out%fz = a1*u1%fz + a2*u2%fz + a3*u3%fz + END IF ! check if allocated + IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN + u_out%momentx = a1*u1%momentx + a2*u2%momentx + a3*u3%momentx + END IF ! check if allocated + IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN + u_out%momenty = a1*u1%momenty + a2*u2%momenty + a3*u3%momenty + END IF ! check if allocated + IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN + u_out%momentz = a1*u1%momentz + a2*u2%momentz + a3*u3%momentz + END IF ! check if allocated + IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN + u_out%forceNodesChord = a1*u1%forceNodesChord + a2*u2%forceNodesChord + a3*u3%forceNodesChord + END IF ! check if allocated +END SUBROUTINE + +subroutine OpFM_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(OpFM_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(OpFM_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 = 'OpFM_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 OpFM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL OpFM_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 OpFM_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 OpFM_Output_ExtrapInterp - - - SUBROUTINE OpFM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call OpFM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call OpFM_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call OpFM_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE OpFM_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. @@ -4600,65 +3282,54 @@ SUBROUTINE OpFM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(OpFM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(OpFM_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(OpFM_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 + TYPE(OpFM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(OpFM_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(OpFM_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 = 'OpFM_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN - DO i1 = LBOUND(y_out%u,1),UBOUND(y_out%u,1) - b = -(y1%u(i1) - y2%u(i1)) - y_out%u(i1) = y1%u(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN - DO i1 = LBOUND(y_out%v,1),UBOUND(y_out%v,1) - b = -(y1%v(i1) - y2%v(i1)) - y_out%v(i1) = y1%v(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN - DO i1 = LBOUND(y_out%w,1),UBOUND(y_out%w,1) - b = -(y1%w(i1) - y2%w(i1)) - y_out%w(i1) = y1%w(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -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 OpFM_Output_ExtrapInterp1 - - - SUBROUTINE OpFM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN + y_out%u = a1*y1%u + a2*y2%u + END IF ! check if allocated + IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN + y_out%v = a1*y1%v + a2*y2%v + END IF ! check if allocated + IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN + y_out%w = a1*y1%w + a2*y2%w + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE OpFM_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. @@ -4672,75 +3343,59 @@ SUBROUTINE OpFM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(OpFM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(OpFM_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(OpFM_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(OpFM_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 + TYPE(OpFM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(OpFM_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(OpFM_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(OpFM_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 = 'OpFM_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_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 + 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 + 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 + 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 (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN - DO i1 = LBOUND(y_out%u,1),UBOUND(y_out%u,1) - b = (t(3)**2*(y1%u(i1) - y2%u(i1)) + t(2)**2*(-y1%u(i1) + y3%u(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%u(i1) + t(3)*y2%u(i1) - t(2)*y3%u(i1) ) * scaleFactor - y_out%u(i1) = y1%u(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN - DO i1 = LBOUND(y_out%v,1),UBOUND(y_out%v,1) - b = (t(3)**2*(y1%v(i1) - y2%v(i1)) + t(2)**2*(-y1%v(i1) + y3%v(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%v(i1) + t(3)*y2%v(i1) - t(2)*y3%v(i1) ) * scaleFactor - y_out%v(i1) = y1%v(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN - DO i1 = LBOUND(y_out%w,1),UBOUND(y_out%w,1) - b = (t(3)**2*(y1%w(i1) - y2%w(i1)) + t(2)**2*(-y1%w(i1) + y3%w(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%w(i1) + t(3)*y2%w(i1) - t(2)*y3%w(i1) ) * scaleFactor - y_out%w(i1) = y1%w(i1) + b + c * t_out - END DO -END IF ! check if allocated -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 OpFM_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN + y_out%u = a1*y1%u + a2*y2%u + a3*y3%u + END IF ! check if allocated + IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN + y_out%v = a1*y1%v + a2*y2%v + a3*y3%v + END IF ! check if allocated + IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN + y_out%w = a1*y1%w + a2*y2%w + a3*y3%w + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE OpenFOAM_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 17ffff59f8..f2c1cc1ea3 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -37,7 +37,7 @@ MODULE OrcaFlexInterface_Types TYPE, PUBLIC :: Orca_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] CHARACTER(1024) :: RootName !< RootName for writing output files (echo file) [-] - REAL(ReKi) :: TMax !< Maximum Time [seconds] + REAL(ReKi) :: TMax = 0.0_ReKi !< Maximum Time [seconds] END TYPE Orca_InitInputType ! ======================= ! ========= Orca_InitOutputType ======= @@ -58,24 +58,24 @@ MODULE OrcaFlexInterface_Types ! ======================= ! ========= Orca_OtherStateType ======= TYPE, PUBLIC :: Orca_OtherStateType - REAL(SiKi) :: DummyOtherState !< Remove if you have OtherStates [-] + REAL(SiKi) :: DummyOtherState = 0.0_R4Ki !< Remove if you have OtherStates [-] END TYPE Orca_OtherStateType ! ======================= ! ========= Orca_MiscVarType ======= TYPE, PUBLIC :: Orca_MiscVarType - REAL(ReKi) , DIMENSION(1:6,1:6) :: PtfmAM !< Added mass matrix results from OrcaFlex [-] - REAL(ReKi) , DIMENSION(1:6) :: PtfmFt !< Force/moment results from OrcaFlex [-] - REAL(ReKi) , DIMENSION(1:6) :: F_PtfmAM !< Force/moment results calculated from the added mass and accel [-] + REAL(ReKi) , DIMENSION(1:6,1:6) :: PtfmAM = 0.0_ReKi !< Added mass matrix results from OrcaFlex [-] + REAL(ReKi) , DIMENSION(1:6) :: PtfmFt = 0.0_ReKi !< Force/moment results from OrcaFlex [-] + REAL(ReKi) , DIMENSION(1:6) :: F_PtfmAM = 0.0_ReKi !< Force/moment results calculated from the added mass and accel [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] - REAL(DbKi) :: LastTimeStep !< The last timestep called [-] + REAL(DbKi) :: LastTimeStep = 0.0_R8Ki !< The last timestep called [-] END TYPE Orca_MiscVarType ! ======================= ! ========= Orca_ParameterType ======= TYPE, PUBLIC :: Orca_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] TYPE(DLL_Type) :: DLL_Orca !< Info for the OrcaFlex DLL [-] CHARACTER(1024) :: SimNamePath !< Path with simulation rootname with null end character for passing to C [-] - INTEGER(IntKi) :: SimNamePathLen !< Length of SimNamePath (including null char) [-] + INTEGER(IntKi) :: SimNamePathLen = 0_IntKi !< Length of SimNamePath (including null char) [-] INTEGER(IntKi) :: NumOuts = 0 !< Number of parameters in the output list (number of outputs requested) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] END TYPE Orca_ParameterType @@ -93,2337 +93,789 @@ MODULE OrcaFlexInterface_Types ! ======================= ! ========= Orca_ContinuousStateType ======= TYPE, PUBLIC :: Orca_ContinuousStateType - REAL(ReKi) :: Dummy !< Dummy placeholder [-] + REAL(ReKi) :: Dummy = 0.0_ReKi !< Dummy placeholder [-] END TYPE Orca_ContinuousStateType ! ======================= ! ========= Orca_DiscreteStateType ======= TYPE, PUBLIC :: Orca_DiscreteStateType - REAL(ReKi) :: Dummy !< Dummy placeholder [-] + REAL(ReKi) :: Dummy = 0.0_ReKi !< Dummy placeholder [-] END TYPE Orca_DiscreteStateType ! ======================= ! ========= Orca_ConstraintStateType ======= TYPE, PUBLIC :: Orca_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Dummy placeholder [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Dummy placeholder [-] END TYPE Orca_ConstraintStateType ! ======================= CONTAINS - SUBROUTINE Orca_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Orca_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%TMax = SrcInitInputData%TMax - END SUBROUTINE Orca_CopyInitInput - - SUBROUTINE Orca_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(Orca_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 = 'Orca_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Orca_DestroyInitInput - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! TMax - 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%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%TMax - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_PackInitInput - - SUBROUTINE Orca_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(Orca_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_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%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_UnPackInitInput - - SUBROUTINE Orca_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Orca_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 = 'Orca_CopyInitOutput' -! +subroutine Orca_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Orca_InitInputType), intent(in) :: SrcInitInputData + type(Orca_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -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 - END SUBROUTINE Orca_CopyInitOutput - - SUBROUTINE Orca_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(Orca_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 = 'Orca_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE Orca_DestroyInitOutput - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 - 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 - - 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 - - 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 - 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 - END SUBROUTINE Orca_PackInitOutput - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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 - 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) - 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 - END SUBROUTINE Orca_UnPackInitOutput - - SUBROUTINE Orca_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(Orca_InputFile), INTENT(INOUT) :: DstInputFileData - 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 = 'Orca_CopyInputFile' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%TMax = SrcInitInputData%TMax +end subroutine + +subroutine Orca_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Orca_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DLL_FileName = SrcInputFileData%DLL_FileName - DstInputFileData%DLL_InitProcName = SrcInputFileData%DLL_InitProcName - DstInputFileData%DLL_CalcProcName = SrcInputFileData%DLL_CalcProcName - DstInputFileData%DLL_EndProcName = SrcInputFileData%DLL_EndProcName - DstInputFileData%DirRoot = SrcInputFileData%DirRoot - END SUBROUTINE Orca_CopyInputFile - - SUBROUTINE Orca_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(Orca_InputFile), INTENT(INOUT) :: InputFileData - 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 = 'Orca_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Orca_DestroyInputFile - - SUBROUTINE Orca_PackInputFile( 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(Orca_InputFile), 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 = 'Orca_PackInputFile' - ! 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%DLL_FileName) ! DLL_FileName - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InitProcName) ! DLL_InitProcName - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_CalcProcName) ! DLL_CalcProcName - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_EndProcName) ! DLL_EndProcName - 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 - - DO I = 1, LEN(InData%DLL_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_InitProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InitProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_CalcProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_CalcProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_EndProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_EndProcName(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 - END SUBROUTINE Orca_PackInputFile - - SUBROUTINE Orca_UnPackInputFile( 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(Orca_InputFile), 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 = 'Orca_UnPackInputFile' - ! 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%DLL_FileName) - OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_InitProcName) - OutData%DLL_InitProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_CalcProcName) - OutData%DLL_CalcProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_EndProcName) - OutData%DLL_EndProcName(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 - END SUBROUTINE Orca_UnPackInputFile - - SUBROUTINE Orca_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Orca_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 = 'Orca_CopyOtherState' -! + ErrMsg = '' +end subroutine + +subroutine Orca_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%TMax) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TMax) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Orca_InitOutputType), intent(in) :: SrcInitOutputData + type(Orca_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Orca_CopyOtherState - - SUBROUTINE Orca_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(Orca_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 = 'Orca_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Orca_DestroyOtherState - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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 - Re_BufSz = Re_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 - - ReKiBuf(Re_Xferred) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_PackOtherState - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_UnPackOtherState - - SUBROUTINE Orca_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Orca_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) :: 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_CopyMisc' -! + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine Orca_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Orca_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%PtfmAM = SrcMiscData%PtfmAM - DstMiscData%PtfmFt = SrcMiscData%PtfmFt - DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF - DstMiscData%LastTimeStep = SrcMiscData%LastTimeStep - END SUBROUTINE Orca_CopyMisc - - SUBROUTINE Orca_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(Orca_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 = 'Orca_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF - END SUBROUTINE Orca_DestroyMisc - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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 + SIZE(InData%PtfmAM) ! PtfmAM - Re_BufSz = Re_BufSz + SIZE(InData%PtfmFt) ! PtfmFt - Re_BufSz = Re_BufSz + SIZE(InData%F_PtfmAM) ! F_PtfmAM - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Db_BufSz = Db_BufSz + 1 ! LastTimeStep - 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 i2 = LBOUND(InData%PtfmAM,2), UBOUND(InData%PtfmAM,2) - DO i1 = LBOUND(InData%PtfmAM,1), UBOUND(InData%PtfmAM,1) - ReKiBuf(Re_Xferred) = InData%PtfmAM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%PtfmFt,1), UBOUND(InData%PtfmFt,1) - ReKiBuf(Re_Xferred) = InData%PtfmFt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%F_PtfmAM,1), UBOUND(InData%F_PtfmAM,1) - ReKiBuf(Re_Xferred) = InData%F_PtfmAM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%AllOuts) ) 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%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%LastTimeStep - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Orca_PackMisc - - SUBROUTINE Orca_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(Orca_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) :: 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_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 - i1_l = LBOUND(OutData%PtfmAM,1) - i1_u = UBOUND(OutData%PtfmAM,1) - i2_l = LBOUND(OutData%PtfmAM,2) - i2_u = UBOUND(OutData%PtfmAM,2) - DO i2 = LBOUND(OutData%PtfmAM,2), UBOUND(OutData%PtfmAM,2) - DO i1 = LBOUND(OutData%PtfmAM,1), UBOUND(OutData%PtfmAM,1) - OutData%PtfmAM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%PtfmFt,1) - i1_u = UBOUND(OutData%PtfmFt,1) - DO i1 = LBOUND(OutData%PtfmFt,1), UBOUND(OutData%PtfmFt,1) - OutData%PtfmFt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%F_PtfmAM,1) - i1_u = UBOUND(OutData%F_PtfmAM,1) - DO i1 = LBOUND(OutData%F_PtfmAM,1), UBOUND(OutData%F_PtfmAM,1) - OutData%F_PtfmAM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts 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%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%LastTimeStep = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Orca_UnPackMisc - - SUBROUTINE Orca_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Orca_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyParam' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine + +subroutine Orca_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine Orca_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(Orca_InputFile), intent(in) :: SrcInputFileData + type(Orca_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%DLL_Orca = SrcParamData%DLL_Orca - DstParamData%SimNamePath = SrcParamData%SimNamePath - DstParamData%SimNamePathLen = SrcParamData%SimNamePathLen - DstParamData%NumOuts = SrcParamData%NumOuts -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 - END SUBROUTINE Orca_CopyParam - - SUBROUTINE Orca_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(Orca_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 = 'Orca_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF - END SUBROUTINE Orca_DestroyParam - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DLL_Orca: size of buffers for each call to pack subtype - CALL DLLTypePack( InData%DLL_Orca, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DLL_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DLL_Orca - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DLL_Orca - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DLL_Orca - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%SimNamePath) ! SimNamePath - Int_BufSz = Int_BufSz + 1 ! SimNamePathLen - Int_BufSz = Int_BufSz + 1 ! NumOuts - 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 - 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 - 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 - CALL DLLTypePack( InData%DLL_Orca, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Orca - 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 - DO I = 1, LEN(InData%SimNamePath) - IntKiBuf(Int_Xferred) = ICHAR(InData%SimNamePath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%SimNamePathLen - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - 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 - END SUBROUTINE Orca_PackParam - - SUBROUTINE Orca_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(Orca_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_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 - 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 DLLTypeUnpack( OutData%DLL_Orca, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! DLL_Orca - 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%SimNamePath) - OutData%SimNamePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SimNamePathLen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 - END SUBROUTINE Orca_UnPackParam - - SUBROUTINE Orca_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_InputType), INTENT(INOUT) :: SrcInputData - TYPE(Orca_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 = 'Orca_CopyInput' -! + ErrMsg = '' + DstInputFileData%DLL_FileName = SrcInputFileData%DLL_FileName + DstInputFileData%DLL_InitProcName = SrcInputFileData%DLL_InitProcName + DstInputFileData%DLL_CalcProcName = SrcInputFileData%DLL_CalcProcName + DstInputFileData%DLL_EndProcName = SrcInputFileData%DLL_EndProcName + DstInputFileData%DirRoot = SrcInputFileData%DirRoot +end subroutine + +subroutine Orca_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(Orca_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_DestroyInputFile' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%PtfmMesh, DstInputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE Orca_CopyInput - - SUBROUTINE Orca_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(Orca_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 = 'Orca_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( InputData%PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Orca_DestroyInput - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtfmMesh - 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 - - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtfmMesh - 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 Orca_PackInput - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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 - 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 MeshUnpack( OutData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtfmMesh - 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 Orca_UnPackInput - - SUBROUTINE Orca_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(Orca_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 = 'Orca_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine Orca_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DLL_FileName) + call RegPack(Buf, InData%DLL_InitProcName) + call RegPack(Buf, InData%DLL_CalcProcName) + call RegPack(Buf, InData%DLL_EndProcName) + call RegPack(Buf, InData%DirRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackInputFile' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DLL_FileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DLL_InitProcName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DLL_CalcProcName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DLL_EndProcName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DirRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(Orca_OtherStateType), intent(in) :: SrcOtherStateData + type(Orca_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_CopyOtherState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%PtfmMesh, DstOutputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -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 Orca_CopyOutput - - SUBROUTINE Orca_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(Orca_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 = 'Orca_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE Orca_DestroyOutput - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtfmMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 - - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtfmMesh - 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 - 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 Orca_PackOutput - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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 - 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 MeshUnpack( OutData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtfmMesh - 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) - 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 Orca_UnPackOutput - - SUBROUTINE Orca_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Orca_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 = 'Orca_CopyContState' -! + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +subroutine Orca_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(Orca_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_DestroyOtherState' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%Dummy = SrcContStateData%Dummy - END SUBROUTINE Orca_CopyContState - - SUBROUTINE Orca_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(Orca_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 = 'Orca_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Orca_DestroyContState - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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 ! Dummy - 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%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_PackContState - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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%Dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_UnPackContState - - SUBROUTINE Orca_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Orca_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 = 'Orca_CopyDiscState' -! + ErrMsg = '' +end subroutine + +subroutine Orca_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Orca_MiscVarType), intent(in) :: SrcMiscData + type(Orca_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Orca_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%Dummy = SrcDiscStateData%Dummy - END SUBROUTINE Orca_CopyDiscState - - SUBROUTINE Orca_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(Orca_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 = 'Orca_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Orca_DestroyDiscState - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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 ! Dummy - 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%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_PackDiscState - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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%Dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_UnPackDiscState - - SUBROUTINE Orca_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Orca_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 = 'Orca_CopyConstrState' -! + ErrMsg = '' + DstMiscData%PtfmAM = SrcMiscData%PtfmAM + DstMiscData%PtfmFt = SrcMiscData%PtfmFt + DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + end if + DstMiscData%LastTimeStep = SrcMiscData%LastTimeStep +end subroutine + +subroutine Orca_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Orca_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_DestroyMisc' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Orca_CopyConstrState - - SUBROUTINE Orca_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(Orca_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 = 'Orca_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Orca_DestroyConstrState - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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 Orca_PackConstrState - - SUBROUTINE Orca_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(Orca_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 = 'Orca_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_UnPackConstrState - - - SUBROUTINE Orca_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(Orca_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Orca_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 + ErrMsg = '' + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if +end subroutine + +subroutine Orca_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%PtfmAM) + call RegPack(Buf, InData%PtfmFt) + call RegPack(Buf, InData%F_PtfmAM) + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + call RegPack(Buf, InData%LastTimeStep) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackMisc' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%PtfmAM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmFt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%F_PtfmAM) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%LastTimeStep) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Orca_ParameterType), intent(in) :: SrcParamData + type(Orca_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%DLL_Orca = SrcParamData%DLL_Orca + DstParamData%SimNamePath = SrcParamData%SimNamePath + DstParamData%SimNamePathLen = SrcParamData%SimNamePathLen + DstParamData%NumOuts = SrcParamData%NumOuts + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if +end subroutine + +subroutine Orca_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Orca_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + call FreeDynamicLib( ParamData%DLL_Orca, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if +end subroutine + +subroutine Orca_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackParam' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call DLLTypePack(Buf, InData%DLL_Orca) + call RegPack(Buf, InData%SimNamePath) + call RegPack(Buf, InData%SimNamePathLen) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackParam' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call DLLTypeUnpack(Buf, OutData%DLL_Orca) ! DLL_Orca + call RegUnpack(Buf, OutData%SimNamePath) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimNamePathLen) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if +end subroutine + +subroutine Orca_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(Orca_InputType), intent(inout) :: SrcInputData + type(Orca_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%PtfmMesh, DstInputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine Orca_DestroyInput(InputData, ErrStat, ErrMsg) + type(Orca_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Orca_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%PtfmMesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh +end subroutine + +subroutine Orca_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(Orca_OutputType), intent(inout) :: SrcOutputData + type(Orca_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%PtfmMesh, DstOutputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine Orca_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(Orca_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine Orca_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%PtfmMesh) + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine Orca_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(Orca_ContinuousStateType), intent(in) :: SrcContStateData + type(Orca_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%Dummy = SrcContStateData%Dummy +end subroutine + +subroutine Orca_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(Orca_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Orca_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(Orca_DiscreteStateType), intent(in) :: SrcDiscStateData + type(Orca_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%Dummy = SrcDiscStateData%Dummy +end subroutine + +subroutine Orca_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(Orca_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Orca_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(Orca_ConstraintStateType), intent(in) :: SrcConstrStateData + type(Orca_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine Orca_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(Orca_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Orca_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_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(Orca_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(Orca_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 = 'Orca_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 Orca_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Orca_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 Orca_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 Orca_Input_ExtrapInterp - - - SUBROUTINE Orca_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call Orca_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Orca_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Orca_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE Orca_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. @@ -2435,41 +887,42 @@ SUBROUTINE Orca_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(Orca_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(Orca_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Orca_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 + TYPE(Orca_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(Orca_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(Orca_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 = 'Orca_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(u1%PtfmMesh, u2%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE Orca_Input_ExtrapInterp1 - - - SUBROUTINE Orca_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%PtfmMesh, u2%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE Orca_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. @@ -2483,101 +936,102 @@ SUBROUTINE Orca_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(Orca_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(Orca_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(Orca_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Orca_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 + TYPE(Orca_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(Orca_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(Orca_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(Orca_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 = 'Orca_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Orca_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(u1%PtfmMesh, u2%PtfmMesh, u3%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE Orca_Input_ExtrapInterp2 - - - SUBROUTINE Orca_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(Orca_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Orca_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%PtfmMesh, u2%PtfmMesh, u3%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine Orca_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(Orca_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(Orca_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 = 'Orca_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 Orca_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Orca_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 Orca_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 Orca_Output_ExtrapInterp - - - SUBROUTINE Orca_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call Orca_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Orca_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Orca_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE Orca_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. @@ -2589,49 +1043,47 @@ SUBROUTINE Orca_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(Orca_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(Orca_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Orca_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 + TYPE(Orca_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(Orca_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(Orca_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 = 'Orca_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(y1%PtfmMesh, y2%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 Orca_Output_ExtrapInterp1 - - - SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%PtfmMesh, y2%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE Orca_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. @@ -2645,56 +1097,52 @@ SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(Orca_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(Orca_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(Orca_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Orca_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 + TYPE(Orca_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(Orca_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(Orca_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(Orca_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 = 'Orca_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Orca_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(y1%PtfmMesh, y2%PtfmMesh, y3%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 Orca_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%PtfmMesh, y2%PtfmMesh, y3%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE OrcaFlexInterface_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index 060b993dfc..f33e649352 100644 --- a/modules/seastate/src/Current_Types.f90 +++ b/modules/seastate/src/Current_Types.f90 @@ -35,18 +35,18 @@ MODULE Current_Types IMPLICIT NONE ! ========= Current_InitInputType ======= TYPE, PUBLIC :: Current_InitInputType - REAL(SiKi) :: CurrSSV0 !< [-] + REAL(SiKi) :: CurrSSV0 = 0.0_R4Ki !< [-] 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) :: CurrSSDir = 0.0_R4Ki !< [-] + REAL(SiKi) :: CurrNSRef = 0.0_R4Ki !< [-] + REAL(SiKi) :: CurrNSV0 = 0.0_R4Ki !< [-] + REAL(SiKi) :: CurrNSDir = 0.0_R4Ki !< [-] + REAL(SiKi) :: CurrDIV = 0.0_R4Ki !< [-] + REAL(SiKi) :: CurrDIDir = 0.0_R4Ki !< [-] + INTEGER(IntKi) :: CurrMod = 0_IntKi !< [-] + REAL(SiKi) :: WtrDpth = 0.0_R4Ki !< [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridzi !< [-] - INTEGER(IntKi) :: NGridPts !< [-] + INTEGER(IntKi) :: NGridPts = 0_IntKi !< [-] CHARACTER(1024) :: DirRoot !< [-] END TYPE Current_InitInputType ! ======================= @@ -54,511 +54,248 @@ MODULE Current_Types TYPE, PUBLIC :: Current_InitOutputType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVxi !< [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVyi !< [-] - REAL(SiKi) :: PCurrVxiPz0 !< [-] - REAL(SiKi) :: PCurrVyiPz0 !< [-] + REAL(SiKi) :: PCurrVxiPz0 = 0.0_R4Ki !< [-] + REAL(SiKi) :: PCurrVyiPz0 = 0.0_R4Ki !< [-] END TYPE Current_InitOutputType ! ======================= 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%WaveKinGridzi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinGridzi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinGridzi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinGridzi)) THEN - ALLOCATE(DstInitInputData%WaveKinGridzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi -ENDIF - DstInitInputData%NGridPts = SrcInitInputData%NGridPts - 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%WaveKinGridzi)) THEN - DEALLOCATE(InitInputData%WaveKinGridzi) -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 ! WaveKinGridzi allocated yes/no - IF ( ALLOCATED(InData%WaveKinGridzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinGridzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinGridzi) ! WaveKinGridzi - END IF - Int_BufSz = Int_BufSz + 1 ! NGridPts - 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%WaveKinGridzi) ) 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%WaveKinGridzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinGridzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinGridzi,1), UBOUND(InData%WaveKinGridzi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinGridzi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NGridPts - 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 ! WaveKinGridzi 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%WaveKinGridzi)) DEALLOCATE(OutData%WaveKinGridzi) - ALLOCATE(OutData%WaveKinGridzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinGridzi,1), UBOUND(OutData%WaveKinGridzi,1) - OutData%WaveKinGridzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NGridPts = 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' -! +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 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Current_CopyInitInput' 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 + 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%WaveKinGridzi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) + if (.not. allocated(DstInitInputData%WaveKinGridzi)) then + allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi + end if + DstInitInputData%NGridPts = SrcInitInputData%NGridPts + DstInitInputData%DirRoot = SrcInitInputData%DirRoot +end subroutine - 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) +subroutine Current_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Current_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Current_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%WaveKinGridzi)) then + deallocate(InitInputData%WaveKinGridzi) + end if +end subroutine - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 +subroutine Current_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Current_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Current_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%CurrSSV0) + call RegPack(Buf, InData%CurrSSDirChr) + call RegPack(Buf, InData%CurrSSDir) + call RegPack(Buf, InData%CurrNSRef) + call RegPack(Buf, InData%CurrNSV0) + call RegPack(Buf, InData%CurrNSDir) + call RegPack(Buf, InData%CurrDIV) + call RegPack(Buf, InData%CurrDIDir) + call RegPack(Buf, InData%CurrMod) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, allocated(InData%WaveKinGridzi)) + if (allocated(InData%WaveKinGridzi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) + call RegPack(Buf, InData%WaveKinGridzi) + end if + call RegPack(Buf, InData%NGridPts) + call RegPack(Buf, InData%DirRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine - 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 +subroutine Current_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Current_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Current_UnPackInitInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%CurrSSV0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CurrSSDirChr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CurrSSDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CurrNSRef) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CurrNSV0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CurrNSDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CurrDIV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CurrDIDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CurrMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WaveKinGridzi)) deallocate(OutData%WaveKinGridzi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinGridzi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinGridzi) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NGridPts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DirRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine - 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 +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 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Current_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%CurrVxi)) then + LB(1:1) = lbound(SrcInitOutputData%CurrVxi) + UB(1:1) = ubound(SrcInitOutputData%CurrVxi) + if (.not. allocated(DstInitOutputData%CurrVxi)) then + allocate(DstInitOutputData%CurrVxi(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%CurrVyi)) then + LB(1:1) = lbound(SrcInitOutputData%CurrVyi) + UB(1:1) = ubound(SrcInitOutputData%CurrVyi) + if (.not. allocated(DstInitOutputData%CurrVyi)) then + allocate(DstInitOutputData%CurrVyi(LB(1):UB(1)), 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 + end if + DstInitOutputData%PCurrVxiPz0 = SrcInitOutputData%PCurrVxiPz0 + DstInitOutputData%PCurrVyiPz0 = SrcInitOutputData%PCurrVyiPz0 +end subroutine - 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_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Current_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Current_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%CurrVxi)) then + deallocate(InitOutputData%CurrVxi) + end if + if (allocated(InitOutputData%CurrVyi)) then + deallocate(InitOutputData%CurrVyi) + end if +end subroutine - 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_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Current_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Current_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%CurrVxi)) + if (allocated(InData%CurrVxi)) then + call RegPackBounds(Buf, 1, lbound(InData%CurrVxi), ubound(InData%CurrVxi)) + call RegPack(Buf, InData%CurrVxi) + end if + call RegPack(Buf, allocated(InData%CurrVyi)) + if (allocated(InData%CurrVyi)) then + call RegPackBounds(Buf, 1, lbound(InData%CurrVyi), ubound(InData%CurrVyi)) + call RegPack(Buf, InData%CurrVyi) + end if + call RegPack(Buf, InData%PCurrVxiPz0) + call RegPack(Buf, InData%PCurrVyiPz0) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine Current_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Current_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Current_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%CurrVxi)) deallocate(OutData%CurrVxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CurrVxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CurrVxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CurrVyi)) deallocate(OutData%CurrVyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CurrVyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CurrVyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%PCurrVxiPz0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PCurrVyiPz0) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE Current_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 4b06eacd1d..c0626b5641 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -49,1447 +49,586 @@ MODULE SeaSt_WaveField_Types 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)] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Wave stretching model [-] + REAL(ReKi) :: EffWtrDpth = 0.0_ReKi !< Water depth [(-)] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Vertical distance from mean sea level to still water level [(m)] 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 ! ======================= 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 (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%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) - 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%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) - 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 ) - TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: SeaSt_WaveFieldTypeData - 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 = 'SeaSt_WaveField_DestroySeaSt_WaveFieldType' - - ErrStat = ErrID_None - ErrMsg = "" - -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%WaveElev0)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElev0) -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%WaveElevC)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElevC) -ENDIF -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 ) - 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 ( 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 ! 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 - 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 - 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 ! 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 - 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 - 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%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%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 - 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 - - 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%EffWtrDpth - 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 - 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_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 + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopySeaSt_WaveFieldType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveTime)) then + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveTime) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveTime) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveTime)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveTime(LB(1):UB(1)), 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 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveDynP)) then + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDynP) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDynP) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveDynP)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveDynP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveDynP = SrcSeaSt_WaveFieldTypeData%WaveDynP + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveAcc)) then + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAcc) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAcc) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveAcc)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveAcc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveAcc = SrcSeaSt_WaveFieldTypeData%WaveAcc + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveAccMCF)) then + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveAccMCF)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveAccMCF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveAccMCF = SrcSeaSt_WaveFieldTypeData%WaveAccMCF + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveVel)) then + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveVel) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveVel) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveVel)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveVel = SrcSeaSt_WaveFieldTypeData%WaveVel + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveDynP0)) then + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveDynP0)) then + allocate(DstSeaSt_WaveFieldTypeData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), 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 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveAcc0)) then + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveAcc0)) then + allocate(DstSeaSt_WaveFieldTypeData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveAcc0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%PWaveAcc0 = SrcSeaSt_WaveFieldTypeData%PWaveAcc0 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0)) then + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0)) then + allocate(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveAccMCF0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%PWaveAccMCF0 = SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveVel0)) then + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveVel0) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveVel0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveVel0)) then + allocate(DstSeaSt_WaveFieldTypeData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveVel0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%PWaveVel0 = SrcSeaSt_WaveFieldTypeData%PWaveVel0 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev0)) then + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev0) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev0)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveElev0(LB(1):UB(1)), 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 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev1)) then + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev1) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev1) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev1)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), 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 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev2)) then + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev2) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev2) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev2)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), 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 + end if + 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%WaveElevC)) then + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElevC)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), 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 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElevC0)) then + LB(1:2) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC0) + UB(1:2) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElevC0)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveDirArr)) then + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDirArr) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDirArr) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveDirArr)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveDirArr(LB(1):UB(1)), 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 + end if +end subroutine - 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 (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 ! 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 - 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 - 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 +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 + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_WaveField_DestroySeaSt_WaveFieldType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SeaSt_WaveFieldTypeData%WaveTime)) then + deallocate(SeaSt_WaveFieldTypeData%WaveTime) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveDynP)) then + deallocate(SeaSt_WaveFieldTypeData%WaveDynP) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveAcc)) then + deallocate(SeaSt_WaveFieldTypeData%WaveAcc) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveAccMCF)) then + deallocate(SeaSt_WaveFieldTypeData%WaveAccMCF) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveVel)) then + deallocate(SeaSt_WaveFieldTypeData%WaveVel) + end if + if (allocated(SeaSt_WaveFieldTypeData%PWaveDynP0)) then + deallocate(SeaSt_WaveFieldTypeData%PWaveDynP0) + end if + if (allocated(SeaSt_WaveFieldTypeData%PWaveAcc0)) then + deallocate(SeaSt_WaveFieldTypeData%PWaveAcc0) + end if + if (allocated(SeaSt_WaveFieldTypeData%PWaveAccMCF0)) then + deallocate(SeaSt_WaveFieldTypeData%PWaveAccMCF0) + end if + if (allocated(SeaSt_WaveFieldTypeData%PWaveVel0)) then + deallocate(SeaSt_WaveFieldTypeData%PWaveVel0) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveElev0)) then + deallocate(SeaSt_WaveFieldTypeData%WaveElev0) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveElev1)) then + deallocate(SeaSt_WaveFieldTypeData%WaveElev1) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveElev2)) then + deallocate(SeaSt_WaveFieldTypeData%WaveElev2) + end if + 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) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveElevC0)) then + deallocate(SeaSt_WaveFieldTypeData%WaveElevC0) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveDirArr)) then + deallocate(SeaSt_WaveFieldTypeData%WaveDirArr) + end if +end subroutine - 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%EffWtrDpth = ReKiBuf(Re_Xferred) - 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 - 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 +subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_WaveFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackSeaSt_WaveFieldType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WaveTime)) + if (allocated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPack(Buf, InData%WaveTime) + end if + call RegPack(Buf, allocated(InData%WaveDynP)) + if (allocated(InData%WaveDynP)) then + call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) + call RegPack(Buf, InData%WaveDynP) + end if + call RegPack(Buf, allocated(InData%WaveAcc)) + if (allocated(InData%WaveAcc)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) + call RegPack(Buf, InData%WaveAcc) + end if + call RegPack(Buf, allocated(InData%WaveAccMCF)) + if (allocated(InData%WaveAccMCF)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) + call RegPack(Buf, InData%WaveAccMCF) + end if + call RegPack(Buf, allocated(InData%WaveVel)) + if (allocated(InData%WaveVel)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) + call RegPack(Buf, InData%WaveVel) + end if + call RegPack(Buf, allocated(InData%PWaveDynP0)) + if (allocated(InData%PWaveDynP0)) then + call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) + call RegPack(Buf, InData%PWaveDynP0) + end if + call RegPack(Buf, allocated(InData%PWaveAcc0)) + if (allocated(InData%PWaveAcc0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) + call RegPack(Buf, InData%PWaveAcc0) + end if + call RegPack(Buf, allocated(InData%PWaveAccMCF0)) + if (allocated(InData%PWaveAccMCF0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) + call RegPack(Buf, InData%PWaveAccMCF0) + end if + call RegPack(Buf, allocated(InData%PWaveVel0)) + if (allocated(InData%PWaveVel0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) + call RegPack(Buf, InData%PWaveVel0) + end if + call RegPack(Buf, allocated(InData%WaveElev0)) + if (allocated(InData%WaveElev0)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) + call RegPack(Buf, InData%WaveElev0) + end if + call RegPack(Buf, allocated(InData%WaveElev1)) + if (allocated(InData%WaveElev1)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPack(Buf, InData%WaveElev1) + end if + call RegPack(Buf, allocated(InData%WaveElev2)) + if (allocated(InData%WaveElev2)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) + call RegPack(Buf, InData%WaveElev2) + end if + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + call RegPack(Buf, InData%WaveStMod) + call RegPack(Buf, InData%EffWtrDpth) + call RegPack(Buf, InData%MSL2SWL) + call RegPack(Buf, allocated(InData%WaveElevC)) + if (allocated(InData%WaveElevC)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) + call RegPack(Buf, InData%WaveElevC) + end if + call RegPack(Buf, allocated(InData%WaveElevC0)) + if (allocated(InData%WaveElevC0)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) + call RegPack(Buf, InData%WaveElevC0) + end if + call RegPack(Buf, allocated(InData%WaveDirArr)) + if (allocated(InData%WaveDirArr)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) + call RegPack(Buf, InData%WaveDirArr) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_WaveFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackSeaSt_WaveFieldType' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveDynP) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveAcc) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveAccMCF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveVel)) deallocate(OutData%WaveVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PWaveDynP0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PWaveAcc0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PWaveAccMCF0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PWaveVel0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev2) + if (RegCheckErr(Buf, RoutineName)) return + end if + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EffWtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveDirArr) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine END MODULE SeaSt_WaveField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 0855e36a45..e12645a9fd 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -656,7 +656,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init SUBROUTINE CleanUp() 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) + CALL NWTC_Library_DestroyFileInfoType(InFileInfo,ErrStat2, ErrMsg2);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 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) diff --git a/modules/seastate/src/SeaState_Interp_Types.f90 b/modules/seastate/src/SeaState_Interp_Types.f90 index 685dcba373..bc0ca2fcfd 100644 --- a/modules/seastate/src/SeaState_Interp_Types.f90 +++ b/modules/seastate/src/SeaState_Interp_Types.f90 @@ -35,10 +35,10 @@ MODULE SeaState_Interp_Types IMPLICIT NONE ! ========= SeaSt_Interp_InitInputType ======= TYPE, PUBLIC :: SeaSt_Interp_InitInputType - INTEGER(IntKi) , DIMENSION(1:4) :: n !< number of grid points in the t, x, y, and z directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta !< size between 2 consecutive grid points in each grid direction (time, x, y, z) [s,m,m,m] - REAL(ReKi) , DIMENSION(1:4) :: pZero !< fixed position of the time-X-Y-Z grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] - REAL(ReKi) :: Z_Depth !< grid depth [m] + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of grid points in the t, x, y, and z directions [-] + REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction (time, x, y, z) [s,m,m,m] + REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the time-X-Y-Z grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] END TYPE SeaSt_Interp_InitInputType ! ======================= ! ========= SeaSt_Interp_InitOutputType ======= @@ -48,748 +48,224 @@ MODULE SeaState_Interp_Types ! ======================= ! ========= SeaSt_Interp_MiscVarType ======= TYPE, PUBLIC :: SeaSt_Interp_MiscVarType - REAL(SiKi) , DIMENSION(1:8) :: N3D !< this is the 3-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] - REAL(SiKi) , DIMENSION(1:16) :: N4D !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] - INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Lo !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] - INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Hi !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] + REAL(SiKi) , DIMENSION(1:8) :: N3D = 0.0_R4Ki !< this is the 3-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] + REAL(SiKi) , DIMENSION(1:16) :: N4D = 0.0_R4Ki !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] + INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Lo = 0_IntKi !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] + INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Hi = 0_IntKi !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] LOGICAL :: FirstWarn_Clamp = .true. !< used to avoid too many 'Position has been clamped to the grid boundary' warning messages [-] END TYPE SeaSt_Interp_MiscVarType ! ======================= ! ========= SeaSt_Interp_ParameterType ======= TYPE, PUBLIC :: SeaSt_Interp_ParameterType - INTEGER(IntKi) , DIMENSION(1:4) :: n !< number of evenly-spaced grid points in the t, x, y, and z directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta !< size between 2 consecutive grid points in each grid direction [s,m,m,m] - REAL(ReKi) , DIMENSION(1:4) :: pZero !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] - REAL(ReKi) :: Z_Depth !< grid depth [m] + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the t, x, y, and z directions [-] + REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [s,m,m,m] + REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] END TYPE SeaSt_Interp_ParameterType ! ======================= CONTAINS - SUBROUTINE SeaSt_Interp_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SeaSt_Interp_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! 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 = 'SeaSt_Interp_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%n = SrcInitInputData%n - DstInitInputData%delta = SrcInitInputData%delta - DstInitInputData%pZero = SrcInitInputData%pZero - DstInitInputData%Z_Depth = SrcInitInputData%Z_Depth - END SUBROUTINE SeaSt_Interp_CopyInitInput - - SUBROUTINE SeaSt_Interp_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_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 = 'SeaSt_Interp_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SeaSt_Interp_DestroyInitInput - - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_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 = 'SeaSt_Interp_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 + SIZE(InData%n) ! n - Re_BufSz = Re_BufSz + SIZE(InData%delta) ! delta - Re_BufSz = Re_BufSz + SIZE(InData%pZero) ! pZero - Re_BufSz = Re_BufSz + 1 ! Z_Depth - 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 i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) - ReKiBuf(Re_Xferred) = InData%delta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) - ReKiBuf(Re_Xferred) = InData%pZero(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Z_Depth - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SeaSt_Interp_PackInitInput - - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_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 = 'SeaSt_Interp_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 - i1_l = LBOUND(OutData%n,1) - i1_u = UBOUND(OutData%n,1) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%delta,1) - i1_u = UBOUND(OutData%delta,1) - DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) - OutData%delta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%pZero,1) - i1_u = UBOUND(OutData%pZero,1) - DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) - OutData%pZero(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Z_Depth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SeaSt_Interp_UnPackInitInput - - SUBROUTINE SeaSt_Interp_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SeaSt_Interp_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_CopyInitOutput' -! +subroutine SeaSt_Interp_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_Interp_InitInputType), intent(in) :: SrcInitInputData + type(SeaSt_Interp_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE SeaSt_Interp_CopyInitOutput - - SUBROUTINE SeaSt_Interp_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SeaSt_Interp_DestroyInitOutput - - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_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 = 'SeaSt_Interp_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - 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 - - 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 - - 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_Interp_PackInitOutput - - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_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 - 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) - END SUBROUTINE SeaSt_Interp_UnPackInitOutput - - SUBROUTINE SeaSt_Interp_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! 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 = 'SeaSt_Interp_CopyMisc' -! + ErrMsg = '' + DstInitInputData%n = SrcInitInputData%n + DstInitInputData%delta = SrcInitInputData%delta + DstInitInputData%pZero = SrcInitInputData%pZero + DstInitInputData%Z_Depth = SrcInitInputData%Z_Depth +end subroutine + +subroutine SeaSt_Interp_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SeaSt_Interp_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%N3D = SrcMiscData%N3D - DstMiscData%N4D = SrcMiscData%N4D - DstMiscData%Indx_Lo = SrcMiscData%Indx_Lo - DstMiscData%Indx_Hi = SrcMiscData%Indx_Hi - DstMiscData%FirstWarn_Clamp = SrcMiscData%FirstWarn_Clamp - END SUBROUTINE SeaSt_Interp_CopyMisc - - SUBROUTINE SeaSt_Interp_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_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 = 'SeaSt_Interp_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SeaSt_Interp_DestroyMisc - - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_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 = 'SeaSt_Interp_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 + SIZE(InData%N3D) ! N3D - Re_BufSz = Re_BufSz + SIZE(InData%N4D) ! N4D - Int_BufSz = Int_BufSz + SIZE(InData%Indx_Lo) ! Indx_Lo - Int_BufSz = Int_BufSz + SIZE(InData%Indx_Hi) ! Indx_Hi - Int_BufSz = Int_BufSz + 1 ! FirstWarn_Clamp - 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 i1 = LBOUND(InData%N3D,1), UBOUND(InData%N3D,1) - ReKiBuf(Re_Xferred) = InData%N3D(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%N4D,1), UBOUND(InData%N4D,1) - ReKiBuf(Re_Xferred) = InData%N4D(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Indx_Lo,1), UBOUND(InData%Indx_Lo,1) - IntKiBuf(Int_Xferred) = InData%Indx_Lo(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Indx_Hi,1), UBOUND(InData%Indx_Hi,1) - IntKiBuf(Int_Xferred) = InData%Indx_Hi(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_Clamp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SeaSt_Interp_PackMisc - - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_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 - i1_l = LBOUND(OutData%N3D,1) - i1_u = UBOUND(OutData%N3D,1) - DO i1 = LBOUND(OutData%N3D,1), UBOUND(OutData%N3D,1) - OutData%N3D(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%N4D,1) - i1_u = UBOUND(OutData%N4D,1) - DO i1 = LBOUND(OutData%N4D,1), UBOUND(OutData%N4D,1) - OutData%N4D(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Indx_Lo,1) - i1_u = UBOUND(OutData%Indx_Lo,1) - DO i1 = LBOUND(OutData%Indx_Lo,1), UBOUND(OutData%Indx_Lo,1) - OutData%Indx_Lo(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Indx_Hi,1) - i1_u = UBOUND(OutData%Indx_Hi,1) - DO i1 = LBOUND(OutData%Indx_Hi,1), UBOUND(OutData%Indx_Hi,1) - OutData%Indx_Hi(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%FirstWarn_Clamp = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_Clamp) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SeaSt_Interp_UnPackMisc - - SUBROUTINE SeaSt_Interp_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SeaSt_Interp_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! 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 = 'SeaSt_Interp_CopyParam' -! + ErrMsg = '' +end subroutine + +subroutine SeaSt_Interp_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_Interp_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%n) + call RegPack(Buf, InData%delta) + call RegPack(Buf, InData%pZero) + call RegPack(Buf, InData%Z_Depth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_Interp_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%delta) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%pZero) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Z_Depth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_Interp_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_Interp_InitOutputType), intent(in) :: SrcInitOutputData + type(SeaSt_Interp_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%n = SrcParamData%n - DstParamData%delta = SrcParamData%delta - DstParamData%pZero = SrcParamData%pZero - DstParamData%Z_Depth = SrcParamData%Z_Depth - END SUBROUTINE SeaSt_Interp_CopyParam - - SUBROUTINE SeaSt_Interp_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_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 = 'SeaSt_Interp_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SeaSt_Interp_DestroyParam - - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_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 = 'SeaSt_Interp_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 - Int_BufSz = Int_BufSz + SIZE(InData%n) ! n - Re_BufSz = Re_BufSz + SIZE(InData%delta) ! delta - Re_BufSz = Re_BufSz + SIZE(InData%pZero) ! pZero - Re_BufSz = Re_BufSz + 1 ! Z_Depth - 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 i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) - ReKiBuf(Re_Xferred) = InData%delta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) - ReKiBuf(Re_Xferred) = InData%pZero(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Z_Depth - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SeaSt_Interp_PackParam - - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_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 - i1_l = LBOUND(OutData%n,1) - i1_u = UBOUND(OutData%n,1) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%delta,1) - i1_u = UBOUND(OutData%delta,1) - DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) - OutData%delta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%pZero,1) - i1_u = UBOUND(OutData%pZero,1) - DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) - OutData%pZero(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Z_Depth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SeaSt_Interp_UnPackParam - + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine SeaSt_Interp_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SeaSt_Interp_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SeaSt_Interp_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_Interp_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_Interp_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine + +subroutine SeaSt_Interp_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_Interp_MiscVarType), intent(in) :: SrcMiscData + type(SeaSt_Interp_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%N3D = SrcMiscData%N3D + DstMiscData%N4D = SrcMiscData%N4D + DstMiscData%Indx_Lo = SrcMiscData%Indx_Lo + DstMiscData%Indx_Hi = SrcMiscData%Indx_Hi + DstMiscData%FirstWarn_Clamp = SrcMiscData%FirstWarn_Clamp +end subroutine + +subroutine SeaSt_Interp_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SeaSt_Interp_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_Interp_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_Interp_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%N3D) + call RegPack(Buf, InData%N4D) + call RegPack(Buf, InData%Indx_Lo) + call RegPack(Buf, InData%Indx_Hi) + call RegPack(Buf, InData%FirstWarn_Clamp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_Interp_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%N3D) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%N4D) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Indx_Lo) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Indx_Hi) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FirstWarn_Clamp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_Interp_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_Interp_ParameterType), intent(in) :: SrcParamData + type(SeaSt_Interp_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%n = SrcParamData%n + DstParamData%delta = SrcParamData%delta + DstParamData%pZero = SrcParamData%pZero + DstParamData%Z_Depth = SrcParamData%Z_Depth +end subroutine + +subroutine SeaSt_Interp_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SeaSt_Interp_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_Interp_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_Interp_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%n) + call RegPack(Buf, InData%delta) + call RegPack(Buf, InData%pZero) + call RegPack(Buf, InData%Z_Depth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_Interp_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackParam' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%delta) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%pZero) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Z_Depth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE SeaState_Interp_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index b5127ace11..4bbcd889d9 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -40,30 +40,30 @@ MODULE SeaState_Types IMPLICIT NONE ! ========= SeaSt_InputFile ======= TYPE, PUBLIC :: SeaSt_InputFile - LOGICAL :: EchoFlag !< Echo the input file [-] - REAL(ReKi) :: MSL2SWL !< Mean Sea Level to Still Water Level offset [m] - REAL(ReKi) :: X_HalfWidth !< Half-width of the domain in the X direction [m] - REAL(ReKi) :: Y_HalfWidth !< Half-width of the domain in the Y direction [m] - REAL(ReKi) :: Z_Depth !< Depth of the domain the Z direction [m] - INTEGER(IntKi) :: NX !< Number of nodes in half of the X-direction domain [-] - INTEGER(IntKi) :: NY !< Number of nodes in half of the Y-direction domain [-] - INTEGER(IntKi) :: NZ !< Number of nodes in half of the Z-direction domain [-] + LOGICAL :: EchoFlag = .false. !< Echo the input file [-] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean Sea Level to Still Water Level offset [m] + REAL(ReKi) :: X_HalfWidth = 0.0_ReKi !< Half-width of the domain in the X direction [m] + REAL(ReKi) :: Y_HalfWidth = 0.0_ReKi !< Half-width of the domain in the Y direction [m] + REAL(ReKi) :: Z_Depth = 0.0_ReKi !< Depth of the domain the Z direction [m] + INTEGER(IntKi) :: NX = 0_IntKi !< Number of nodes in half of the X-direction domain [-] + INTEGER(IntKi) :: NY = 0_IntKi !< Number of nodes in half of the Y-direction domain [-] + INTEGER(IntKi) :: NZ = 0_IntKi !< Number of nodes in half of the Z-direction domain [-] TYPE(Waves_InitInputType) :: Waves !< Initialization data for Waves module [-] TYPE(Waves2_InitInputType) :: Waves2 !< Initialization data for Waves2 module [-] TYPE(Current_InitInputType) :: Current !< Initialization data for Current module [-] - LOGICAL :: Echo !< Echo the input files to a file with the same name as the input but with a .echo extension [T/F] [-] - INTEGER(IntKi) :: NWaveElev !< Number of user-requested points where the incident wave elevations can be output [-] + LOGICAL :: Echo = .false. !< Echo the input files to a file with the same name as the input but with a .echo extension [T/F] [-] + INTEGER(IntKi) :: NWaveElev = 0_IntKi !< Number of user-requested 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)] - INTEGER(IntKi) :: NWaveKin !< Number of points where the incident wave kinematics will be computed [-] + INTEGER(IntKi) :: NWaveKin = 0_IntKi !< 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)] - INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files] [-] - LOGICAL :: OutAll !< Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F] [-] - INTEGER(IntKi) :: NumOuts !< The number of outputs for this module as requested in the input file [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files] [-] + LOGICAL :: OutAll = .false. !< Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F] [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< The number of outputs for this module as requested in the input file [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< The user-requested output channel labels for this modules. This should really be dimensioned with MaxOutPts [-] - LOGICAL :: SeaStSum !< Generate a SeaState summary file [T/F] [-] + LOGICAL :: SeaStSum = .false. !< Generate a SeaState summary file [T/F] [-] CHARACTER(20) :: OutFmt !< Output format for numerical results [-] CHARACTER(20) :: OutSFmt !< Output format for header strings [-] END TYPE SeaSt_InputFile @@ -74,17 +74,17 @@ MODULE SeaState_Types LOGICAL :: UseInputFile = .TRUE. !< Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller [-] TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] CHARACTER(1024) :: OutRootName !< Supplied by Driver: The name of the root file (without extension) including the full path [-] - REAL(ReKi) :: Gravity !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: defWtrDens !< Default water density from the driver; may be overwritten [(kg/m^3)] - REAL(ReKi) :: defWtrDpth !< Default water depth from the driver; may be overwritten [m] - REAL(ReKi) :: defMSL2SWL !< Default mean sea level to still water level from the driver; may be overwritten [m] - REAL(DbKi) :: TMax !< Supplied by Driver: The total simulation time [(sec)] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] + REAL(ReKi) :: defWtrDens = 0.0_ReKi !< Default water density from the driver; may be overwritten [(kg/m^3)] + REAL(ReKi) :: defWtrDpth = 0.0_ReKi !< Default water depth from the driver; may be overwritten [m] + REAL(ReKi) :: defMSL2SWL = 0.0_ReKi !< Default mean sea level to still water level from the driver; may be overwritten [m] + REAL(DbKi) :: TMax = 0.0_R8Ki !< Supplied by Driver: The total simulation time [(sec)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< Supplied by Driver: X-Y locations for WaveElevation output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number. [m,-] - INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] - REAL(ReKi) :: PtfmLocationX !< Supplied by Driver: X coordinate of platform location in the wave field [m] - REAL(ReKi) :: PtfmLocationY !< Supplied by Driver: Y coordinate of platform location in the wave field [m] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + REAL(ReKi) :: PtfmLocationX = 0.0_ReKi !< Supplied by Driver: X coordinate of platform location in the wave field [m] + REAL(ReKi) :: PtfmLocationY = 0.0_ReKi !< Supplied by Driver: Y coordinate of platform location in the wave field [m] INTEGER(IntKi) :: WrWvKinMod = 0 !< 0,1, or 2 indicating whether we are going to write out kinematics files. [ignored if WaveMod = 6, if 1 or 2 then files are written using the outrootname] [-] - LOGICAL :: HasIce !< Supplied by Driver: Whether this simulation has ice loading (flag) [-] + LOGICAL :: HasIce = .false. !< Supplied by Driver: Whether this simulation has ice loading (flag) [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] END TYPE SeaSt_InitInputType ! ======================= @@ -93,17 +93,17 @@ MODULE SeaState_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< The is the list of all HD-related output channel header strings (includes all sub-module channels) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all HD-related output channel unit strings (includes all sub-module channels) [-] TYPE(ProgDesc) :: Ver !< Version of SeaState [-] - REAL(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)] - 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(ReKi) :: WtrDens = 0.0_ReKi !< 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)] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< 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 = 0.0_ReKi !< 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(:,:,:), 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)] - 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)] + REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] + REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] + REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] + LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] + REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: WaveDynP => NULL() !< Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] @@ -116,50 +116,50 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [-] 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 [-] - INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] - 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 } [-] - 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} [-] - INTEGER(IntKi) :: WaveDirMod !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] - 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) :: 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)] - LOGICAL :: InvalidWithSSExctn !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] + REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] + INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] + INTEGER(IntKi) :: WaveMod = 0_IntKi !< 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 } [-] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] + INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] + REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< 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 = 0.0_R4Ki !< 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) :: WvLowCOffD = 0.0_R4Ki !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] 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) :: MCFD = 0.0_R4Ki !< 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) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] END TYPE SeaSt_InitOutputType ! ======================= ! ========= SeaSt_ContinuousStateType ======= TYPE, PUBLIC :: SeaSt_ContinuousStateType - REAL(R8Ki) :: UnusedStates !< placeholder for states [-] + REAL(R8Ki) :: UnusedStates = 0.0_R8Ki !< placeholder for states [-] END TYPE SeaSt_ContinuousStateType ! ======================= ! ========= SeaSt_DiscreteStateType ======= TYPE, PUBLIC :: SeaSt_DiscreteStateType - REAL(R8Ki) :: UnusedStates !< placeholder for states [-] + REAL(R8Ki) :: UnusedStates = 0.0_R8Ki !< placeholder for states [-] END TYPE SeaSt_DiscreteStateType ! ======================= ! ========= SeaSt_ConstraintStateType ======= TYPE, PUBLIC :: SeaSt_ConstraintStateType - REAL(R8Ki) :: UnusedStates !< placeholder for states [-] + REAL(R8Ki) :: UnusedStates = 0.0_R8Ki !< placeholder for states [-] END TYPE SeaSt_ConstraintStateType ! ======================= ! ========= SeaSt_OtherStateType ======= TYPE, PUBLIC :: SeaSt_OtherStateType - REAL(R8Ki) :: UnusedStates !< placeholder for states [-] + REAL(R8Ki) :: UnusedStates = 0.0_R8Ki !< placeholder for states [-] END TYPE SeaSt_OtherStateType ! ======================= ! ========= SeaSt_MiscVarType ======= TYPE, PUBLIC :: SeaSt_MiscVarType - INTEGER(IntKi) :: Decimate !< The output decimation counter [-] - REAL(DbKi) :: LastOutTime !< Last time step which was written to the output file (sec) [-] - INTEGER(IntKi) :: LastIndWave !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] + INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] + INTEGER(IntKi) :: LastIndWave = 0_IntKi !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m !< misc var information from the SeaState Interpolation module [-] END TYPE SeaSt_MiscVarType ! ======================= @@ -167,15 +167,15 @@ MODULE SeaState_Types TYPE, PUBLIC :: SeaSt_ParameterType TYPE(Waves2_ParameterType) :: Waves2 !< Parameter data for the Waves2 module [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Array of time samples, (sec) [-] - REAL(DbKi) :: WaveDT !< Wave DT [sec] - INTEGER(IntKi) :: NGridPts !< Number of data points in the wave kinematics grid [-] - INTEGER(IntKi) , DIMENSION(1:3) :: NGrid !< Number of grid entries in x, y, and z [-] - REAL(ReKi) , DIMENSION(1:3) :: deltaGrid !< delta between grid points in x, y, and theta (for z) [m,m,rad] - REAL(ReKi) :: X_HalfWidth !< Half-width of the domain in the X direction [m] - REAL(ReKi) :: Y_HalfWidth !< Half-width of the domain in the Y direction [m] - REAL(ReKi) :: Z_Depth !< Depth of the domain the Z direction [m] - INTEGER(IntKi) :: NStepWave !< Number of user-requested data points in the wave kinematics arrays [-] - INTEGER(IntKi) :: NWaveElev !< Number of wave elevation outputs [-] + REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Wave DT [sec] + INTEGER(IntKi) :: NGridPts = 0_IntKi !< Number of data points in the wave kinematics grid [-] + INTEGER(IntKi) , DIMENSION(1:3) :: NGrid = 0_IntKi !< Number of grid entries in x, y, and z [-] + REAL(ReKi) , DIMENSION(1:3) :: deltaGrid = 0.0_ReKi !< delta between grid points in x, y, and theta (for z) [m,m,rad] + REAL(ReKi) :: X_HalfWidth = 0.0_ReKi !< Half-width of the domain in the X direction [m] + REAL(ReKi) :: Y_HalfWidth = 0.0_ReKi !< Half-width of the domain in the Y direction [m] + REAL(ReKi) :: Z_Depth = 0.0_ReKi !< Depth of the domain the Z direction [m] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of user-requested data points in the wave kinematics arrays [-] + INTEGER(IntKi) :: NWaveElev = 0_IntKi !< Number of wave elevation outputs [-] 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(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [-] @@ -190,28 +190,28 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] 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(:,:,:,:), POINTER :: PWaveAccMCF0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] - INTEGER(IntKi) :: NWaveKin !< Number of points where the incident wave kinematics can be output [-] + INTEGER(IntKi) :: NWaveKin = 0_IntKi !< Number of points where the incident wave kinematics can be output [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] - REAL(ReKi) :: WtrDpth !< Water depth [(m)] - REAL(DbKi) :: DT !< Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states [-] - INTEGER(IntKi) :: WaveStMod !< Wave stretching model [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(m)] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states [-] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Wave stretching model [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] - INTEGER(IntKi) :: NumOuts !< Number of SeaState module-level outputs (not the total number including sub-modules [-] - INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files] [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of SeaState module-level outputs (not the total number including sub-modules [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files] [-] CHARACTER(20) :: OutFmt !< Output format for numerical results [-] CHARACTER(20) :: OutSFmt !< Output format for header strings [-] CHARACTER(1) :: Delim !< Delimiter string for outputs, defaults to space [-] - INTEGER(IntKi) :: UnOutFile !< File unit for the SeaState outputs [-] - INTEGER(IntKi) :: OutDec !< Write every OutDec time steps [-] + INTEGER(IntKi) :: UnOutFile = 0_IntKi !< File unit for the SeaState outputs [-] + INTEGER(IntKi) :: OutDec = 0_IntKi !< Write every OutDec time steps [-] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Wave field [-] END TYPE SeaSt_ParameterType ! ======================= ! ========= SeaSt_InputType ======= TYPE, PUBLIC :: SeaSt_InputType - REAL(SiKi) :: DummyInput !< Remove this variable if you have inputs [-] + REAL(SiKi) :: DummyInput = 0.0_R4Ki !< Remove this variable if you have inputs [-] END TYPE SeaSt_InputType ! ======================= ! ========= SeaSt_OutputType ======= @@ -220,3969 +220,2449 @@ MODULE SeaState_Types END TYPE SeaSt_OutputType ! ======================= CONTAINS - SUBROUTINE SeaSt_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(SeaSt_InputFile), INTENT(INOUT) :: DstInputFileData - 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 = 'SeaSt_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag - DstInputFileData%MSL2SWL = SrcInputFileData%MSL2SWL - DstInputFileData%X_HalfWidth = SrcInputFileData%X_HalfWidth - DstInputFileData%Y_HalfWidth = SrcInputFileData%Y_HalfWidth - DstInputFileData%Z_Depth = SrcInputFileData%Z_Depth - DstInputFileData%NX = SrcInputFileData%NX - DstInputFileData%NY = SrcInputFileData%NY - DstInputFileData%NZ = SrcInputFileData%NZ - CALL Waves_CopyInitInput( SrcInputFileData%Waves, DstInputFileData%Waves, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Waves2_CopyInitInput( SrcInputFileData%Waves2, DstInputFileData%Waves2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Current_CopyInitInput( SrcInputFileData%Current, DstInputFileData%Current, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%NWaveElev = SrcInputFileData%NWaveElev -IF (ALLOCATED(SrcInputFileData%WaveElevxi)) THEN - i1_l = LBOUND(SrcInputFileData%WaveElevxi,1) - i1_u = UBOUND(SrcInputFileData%WaveElevxi,1) - IF (.NOT. ALLOCATED(DstInputFileData%WaveElevxi)) THEN - ALLOCATE(DstInputFileData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WaveElevxi = SrcInputFileData%WaveElevxi -ENDIF -IF (ALLOCATED(SrcInputFileData%WaveElevyi)) THEN - i1_l = LBOUND(SrcInputFileData%WaveElevyi,1) - i1_u = UBOUND(SrcInputFileData%WaveElevyi,1) - IF (.NOT. ALLOCATED(DstInputFileData%WaveElevyi)) THEN - ALLOCATE(DstInputFileData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WaveElevyi = SrcInputFileData%WaveElevyi -ENDIF - DstInputFileData%NWaveKin = SrcInputFileData%NWaveKin -IF (ALLOCATED(SrcInputFileData%WaveKinxi)) THEN - i1_l = LBOUND(SrcInputFileData%WaveKinxi,1) - i1_u = UBOUND(SrcInputFileData%WaveKinxi,1) - IF (.NOT. ALLOCATED(DstInputFileData%WaveKinxi)) THEN - ALLOCATE(DstInputFileData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WaveKinxi = SrcInputFileData%WaveKinxi -ENDIF -IF (ALLOCATED(SrcInputFileData%WaveKinyi)) THEN - i1_l = LBOUND(SrcInputFileData%WaveKinyi,1) - i1_u = UBOUND(SrcInputFileData%WaveKinyi,1) - IF (.NOT. ALLOCATED(DstInputFileData%WaveKinyi)) THEN - ALLOCATE(DstInputFileData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WaveKinyi = SrcInputFileData%WaveKinyi -ENDIF -IF (ALLOCATED(SrcInputFileData%WaveKinzi)) THEN - i1_l = LBOUND(SrcInputFileData%WaveKinzi,1) - i1_u = UBOUND(SrcInputFileData%WaveKinzi,1) - IF (.NOT. ALLOCATED(DstInputFileData%WaveKinzi)) THEN - ALLOCATE(DstInputFileData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WaveKinzi = SrcInputFileData%WaveKinzi -ENDIF - DstInputFileData%OutSwtch = SrcInputFileData%OutSwtch - DstInputFileData%OutAll = SrcInputFileData%OutAll - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%SeaStSum = SrcInputFileData%SeaStSum - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt - END SUBROUTINE SeaSt_CopyInputFile - - SUBROUTINE SeaSt_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(SeaSt_InputFile), INTENT(INOUT) :: InputFileData - 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 = 'SeaSt_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL Waves_DestroyInitInput( InputFileData%Waves, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Waves2_DestroyInitInput( InputFileData%Waves2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Current_DestroyInitInput( InputFileData%Current, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputFileData%WaveElevxi)) THEN - DEALLOCATE(InputFileData%WaveElevxi) -ENDIF -IF (ALLOCATED(InputFileData%WaveElevyi)) THEN - DEALLOCATE(InputFileData%WaveElevyi) -ENDIF -IF (ALLOCATED(InputFileData%WaveKinxi)) THEN - DEALLOCATE(InputFileData%WaveKinxi) -ENDIF -IF (ALLOCATED(InputFileData%WaveKinyi)) THEN - DEALLOCATE(InputFileData%WaveKinyi) -ENDIF -IF (ALLOCATED(InputFileData%WaveKinzi)) THEN - DEALLOCATE(InputFileData%WaveKinzi) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF - END SUBROUTINE SeaSt_DestroyInputFile - - SUBROUTINE SeaSt_PackInputFile( 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_InputFile), 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_PackInputFile' - ! 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 ! EchoFlag - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Re_BufSz = Re_BufSz + 1 ! X_HalfWidth - Re_BufSz = Re_BufSz + 1 ! Y_HalfWidth - Re_BufSz = Re_BufSz + 1 ! Z_Depth - Int_BufSz = Int_BufSz + 1 ! NX - Int_BufSz = Int_BufSz + 1 ! NY - Int_BufSz = Int_BufSz + 1 ! NZ - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Waves: size of buffers for each call to pack subtype - CALL Waves_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Waves, ErrStat2, ErrMsg2, .TRUE. ) ! Waves - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Waves2: size of buffers for each call to pack subtype - CALL Waves2_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, .TRUE. ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Current: size of buffers for each call to pack subtype - CALL Current_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Current, ErrStat2, ErrMsg2, .TRUE. ) ! Current - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Current - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Current - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Current - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Echo - 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 ! 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 ! OutSwtch - Int_BufSz = Int_BufSz + 1 ! OutAll - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1 ! SeaStSum - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - 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) = TRANSFER(InData%EchoFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X_HalfWidth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y_HalfWidth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z_Depth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NX - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NY - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NZ - Int_Xferred = Int_Xferred + 1 - CALL Waves_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Waves, ErrStat2, ErrMsg2, OnlySize ) ! Waves - 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 - CALL Waves2_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, OnlySize ) ! Waves2 - 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 - CALL Current_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Current, ErrStat2, ErrMsg2, OnlySize ) ! Current - 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) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_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 - 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) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) 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%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - 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 - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%SeaStSum, IntKiBuf(1)) - 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 - END SUBROUTINE SeaSt_PackInputFile - - SUBROUTINE SeaSt_UnPackInputFile( 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_InputFile), 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 = 'SeaSt_UnPackInputFile' - ! 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%EchoFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%EchoFlag) - Int_Xferred = Int_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X_HalfWidth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y_HalfWidth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z_Depth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NX = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NY = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NZ = 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 Waves_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Waves, ErrStat2, ErrMsg2 ) ! Waves - 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) - 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 Waves2_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Waves2, ErrStat2, ErrMsg2 ) ! Waves2 - 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) - 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 Current_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Current, ErrStat2, ErrMsg2 ) ! Current - 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%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_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 - 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%OutSwtch = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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%SeaStSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%SeaStSum) - 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 - END SUBROUTINE SeaSt_UnPackInputFile - - SUBROUTINE SeaSt_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SeaSt_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 = 'SeaSt_CopyInitInput' -! +subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_InputFile), intent(in) :: SrcInputFileData + type(SeaSt_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%OutRootName = SrcInitInputData%OutRootName - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%defWtrDens = SrcInitInputData%defWtrDens - DstInitInputData%defWtrDpth = SrcInitInputData%defWtrDpth - DstInitInputData%defMSL2SWL = SrcInitInputData%defMSL2SWL - DstInitInputData%TMax = SrcInitInputData%TMax -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%WaveFieldMod = SrcInitInputData%WaveFieldMod - DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX - DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY - DstInitInputData%WrWvKinMod = SrcInitInputData%WrWvKinMod - DstInitInputData%HasIce = SrcInitInputData%HasIce - DstInitInputData%Linearize = SrcInitInputData%Linearize - END SUBROUTINE SeaSt_CopyInitInput - - SUBROUTINE SeaSt_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SeaSt_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 = 'SeaSt_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitInputData%WaveElevXY)) THEN - DEALLOCATE(InitInputData%WaveElevXY) -ENDIF - END SUBROUTINE SeaSt_DestroyInitInput - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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 ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%OutRootName) ! OutRootName - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! defWtrDens - Re_BufSz = Re_BufSz + 1 ! defWtrDpth - Re_BufSz = Re_BufSz + 1 ! defMSL2SWL - Db_BufSz = Db_BufSz + 1 ! TMax - 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 ! WaveFieldMod - Re_BufSz = Re_BufSz + 1 ! PtfmLocationX - Re_BufSz = Re_BufSz + 1 ! PtfmLocationY - Int_BufSz = Int_BufSz + 1 ! WrWvKinMod - Int_BufSz = Int_BufSz + 1 ! HasIce - Int_BufSz = Int_BufSz + 1 ! Linearize - 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 - 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 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 - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defWtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defWtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defMSL2SWL - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMax - Db_Xferred = Db_Xferred + 1 - 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%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationY - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrWvKinMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HasIce, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SeaSt_PackInitInput - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defWtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defWtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defMSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - 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%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmLocationX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmLocationY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WrWvKinMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HasIce = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasIce) - Int_Xferred = Int_Xferred + 1 - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SeaSt_UnPackInitInput - - SUBROUTINE SeaSt_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SeaSt_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) :: 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_CopyInitOutput' -! + ErrMsg = '' + DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag + DstInputFileData%MSL2SWL = SrcInputFileData%MSL2SWL + DstInputFileData%X_HalfWidth = SrcInputFileData%X_HalfWidth + DstInputFileData%Y_HalfWidth = SrcInputFileData%Y_HalfWidth + DstInputFileData%Z_Depth = SrcInputFileData%Z_Depth + DstInputFileData%NX = SrcInputFileData%NX + DstInputFileData%NY = SrcInputFileData%NY + DstInputFileData%NZ = SrcInputFileData%NZ + call Waves_CopyInitInput(SrcInputFileData%Waves, DstInputFileData%Waves, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Waves2_CopyInitInput(SrcInputFileData%Waves2, DstInputFileData%Waves2, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Current_CopyInitInput(SrcInputFileData%Current, DstInputFileData%Current, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%NWaveElev = SrcInputFileData%NWaveElev + if (allocated(SrcInputFileData%WaveElevxi)) then + LB(1:1) = lbound(SrcInputFileData%WaveElevxi) + UB(1:1) = ubound(SrcInputFileData%WaveElevxi) + if (.not. allocated(DstInputFileData%WaveElevxi)) then + allocate(DstInputFileData%WaveElevxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveElevxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WaveElevxi = SrcInputFileData%WaveElevxi + end if + if (allocated(SrcInputFileData%WaveElevyi)) then + LB(1:1) = lbound(SrcInputFileData%WaveElevyi) + UB(1:1) = ubound(SrcInputFileData%WaveElevyi) + if (.not. allocated(DstInputFileData%WaveElevyi)) then + allocate(DstInputFileData%WaveElevyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveElevyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WaveElevyi = SrcInputFileData%WaveElevyi + end if + DstInputFileData%NWaveKin = SrcInputFileData%NWaveKin + if (allocated(SrcInputFileData%WaveKinxi)) then + LB(1:1) = lbound(SrcInputFileData%WaveKinxi) + UB(1:1) = ubound(SrcInputFileData%WaveKinxi) + if (.not. allocated(DstInputFileData%WaveKinxi)) then + allocate(DstInputFileData%WaveKinxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveKinxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WaveKinxi = SrcInputFileData%WaveKinxi + end if + if (allocated(SrcInputFileData%WaveKinyi)) then + LB(1:1) = lbound(SrcInputFileData%WaveKinyi) + UB(1:1) = ubound(SrcInputFileData%WaveKinyi) + if (.not. allocated(DstInputFileData%WaveKinyi)) then + allocate(DstInputFileData%WaveKinyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveKinyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WaveKinyi = SrcInputFileData%WaveKinyi + end if + if (allocated(SrcInputFileData%WaveKinzi)) then + LB(1:1) = lbound(SrcInputFileData%WaveKinzi) + UB(1:1) = ubound(SrcInputFileData%WaveKinzi) + if (.not. allocated(DstInputFileData%WaveKinzi)) then + allocate(DstInputFileData%WaveKinzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveKinzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WaveKinzi = SrcInputFileData%WaveKinzi + end if + DstInputFileData%OutSwtch = SrcInputFileData%OutSwtch + DstInputFileData%OutAll = SrcInputFileData%OutAll + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + end if + DstInputFileData%SeaStSum = SrcInputFileData%SeaStSum + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt +end subroutine + +subroutine SeaSt_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(SeaSt_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyInputFile' 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 - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%WtrDens = SrcInitOutputData%WtrDens - DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth - DstInitOutputData%MSL2SWL = SrcInitOutputData%MSL2SWL - DstInitOutputData%WaveElevC0 => SrcInitOutputData%WaveElevC0 - DstInitOutputData%WaveElevC => SrcInitOutputData%WaveElevC - DstInitOutputData%WaveDirArr => SrcInitOutputData%WaveDirArr - DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin - DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax - DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir - DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir - DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega - DstInitOutputData%WaveDynP => SrcInitOutputData%WaveDynP - DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc - DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF - DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel - DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 - DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 - DstInitOutputData%PWaveAccMCF0 => SrcInitOutputData%PWaveAccMCF0 - DstInitOutputData%PWaveVel0 => SrcInitOutputData%PWaveVel0 - DstInitOutputData%WaveElev1 => SrcInitOutputData%WaveElev1 - DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 - DstInitOutputData%WaveElev0 => SrcInitOutputData%WaveElev0 - DstInitOutputData%WaveTime => SrcInitOutputData%WaveTime - DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg - DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave - DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 - DstInitOutputData%WaveMod = SrcInitOutputData%WaveMod - DstInitOutputData%WaveStMod = SrcInitOutputData%WaveStMod - DstInitOutputData%WaveDirMod = SrcInitOutputData%WaveDirMod - DstInitOutputData%WvLowCOff = SrcInitOutputData%WvLowCOff - DstInitOutputData%WvHiCOff = SrcInitOutputData%WvHiCOff - DstInitOutputData%WvLowCOffD = SrcInitOutputData%WvLowCOffD - DstInitOutputData%WvHiCOffD = SrcInitOutputData%WvHiCOffD - DstInitOutputData%WvLowCOffS = SrcInitOutputData%WvLowCOffS - DstInitOutputData%WvHiCOffS = SrcInitOutputData%WvHiCOffS - DstInitOutputData%InvalidWithSSExctn = SrcInitOutputData%InvalidWithSSExctn - CALL SeaSt_Interp_CopyParam( SrcInitOutputData%SeaSt_Interp_p, DstInitOutputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%MCFD = SrcInitOutputData%MCFD -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 - DstInitOutputData%WaveField => SrcInitOutputData%WaveField - END SUBROUTINE SeaSt_CopyInitOutput - - SUBROUTINE SeaSt_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SeaSt_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 = 'SeaSt_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -NULLIFY(InitOutputData%WaveElevC0) -NULLIFY(InitOutputData%WaveElevC) -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) -NULLIFY(InitOutputData%WaveElev0) -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 -NULLIFY(InitOutputData%WaveField) - END SUBROUTINE SeaSt_DestroyInitOutput - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - 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 - Re_BufSz = Re_BufSz + 1 ! RhoXg - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - Int_BufSz = Int_BufSz + 1 ! WaveMod - Int_BufSz = Int_BufSz + 1 ! WaveStMod - Int_BufSz = Int_BufSz + 1 ! WaveDirMod - Re_BufSz = Re_BufSz + 1 ! WvLowCOff - Re_BufSz = Re_BufSz + 1 ! WvHiCOff - 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 + 1 ! InvalidWithSSExctn - 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 - 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 - 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 - 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 - - 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%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_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 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - 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 - END SUBROUTINE SeaSt_PackInitOutput - - SUBROUTINE SeaSt_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(SeaSt_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) :: 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 - NULLIFY(OutData%WaveElevC0) - NULLIFY(OutData%WaveElevC) - 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) - NULLIFY(OutData%WaveElev0) - NULLIFY(OutData%WaveTime) - 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 - 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 - 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 - 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 - NULLIFY(OutData%WaveField) - END SUBROUTINE SeaSt_UnPackInitOutput - - SUBROUTINE SeaSt_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SeaSt_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 = 'SeaSt_CopyContState' -! + ErrMsg = '' + call Waves_DestroyInitInput(InputFileData%Waves, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Waves2_DestroyInitInput(InputFileData%Waves2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Current_DestroyInitInput(InputFileData%Current, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputFileData%WaveElevxi)) then + deallocate(InputFileData%WaveElevxi) + end if + if (allocated(InputFileData%WaveElevyi)) then + deallocate(InputFileData%WaveElevyi) + end if + if (allocated(InputFileData%WaveKinxi)) then + deallocate(InputFileData%WaveKinxi) + end if + if (allocated(InputFileData%WaveKinyi)) then + deallocate(InputFileData%WaveKinyi) + end if + if (allocated(InputFileData%WaveKinzi)) then + deallocate(InputFileData%WaveKinzi) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if +end subroutine + +subroutine SeaSt_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%EchoFlag) + call RegPack(Buf, InData%MSL2SWL) + call RegPack(Buf, InData%X_HalfWidth) + call RegPack(Buf, InData%Y_HalfWidth) + call RegPack(Buf, InData%Z_Depth) + call RegPack(Buf, InData%NX) + call RegPack(Buf, InData%NY) + call RegPack(Buf, InData%NZ) + call Waves_PackInitInput(Buf, InData%Waves) + call Waves2_PackInitInput(Buf, InData%Waves2) + call Current_PackInitInput(Buf, InData%Current) + call RegPack(Buf, InData%Echo) + call RegPack(Buf, InData%NWaveElev) + call RegPack(Buf, allocated(InData%WaveElevxi)) + if (allocated(InData%WaveElevxi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElevxi), ubound(InData%WaveElevxi)) + call RegPack(Buf, InData%WaveElevxi) + end if + call RegPack(Buf, allocated(InData%WaveElevyi)) + if (allocated(InData%WaveElevyi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi), ubound(InData%WaveElevyi)) + call RegPack(Buf, InData%WaveElevyi) + end if + call RegPack(Buf, InData%NWaveKin) + call RegPack(Buf, allocated(InData%WaveKinxi)) + if (allocated(InData%WaveKinxi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinxi), ubound(InData%WaveKinxi)) + call RegPack(Buf, InData%WaveKinxi) + end if + call RegPack(Buf, allocated(InData%WaveKinyi)) + if (allocated(InData%WaveKinyi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinyi), ubound(InData%WaveKinyi)) + call RegPack(Buf, InData%WaveKinyi) + end if + call RegPack(Buf, allocated(InData%WaveKinzi)) + if (allocated(InData%WaveKinzi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi), ubound(InData%WaveKinzi)) + call RegPack(Buf, InData%WaveKinzi) + end if + call RegPack(Buf, InData%OutSwtch) + call RegPack(Buf, InData%OutAll) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + call RegPack(Buf, InData%SeaStSum) + call RegPack(Buf, InData%OutFmt) + call RegPack(Buf, InData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackInputFile' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%EchoFlag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%X_HalfWidth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Y_HalfWidth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Z_Depth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NX) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NY) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NZ) + if (RegCheckErr(Buf, RoutineName)) return + call Waves_UnpackInitInput(Buf, OutData%Waves) ! Waves + call Waves2_UnpackInitInput(Buf, OutData%Waves2) ! Waves2 + call Current_UnpackInitInput(Buf, OutData%Current) ! Current + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NWaveElev) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WaveElevxi)) deallocate(OutData%WaveElevxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveElevyi)) deallocate(OutData%WaveElevyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NWaveKin) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WaveKinxi)) deallocate(OutData%WaveKinxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveKinyi)) deallocate(OutData%WaveKinyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveKinzi)) deallocate(OutData%WaveKinzi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinzi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinzi) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutAll) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%SeaStSum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_InitInputType), intent(in) :: SrcInitInputData + type(SeaSt_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%UnusedStates = SrcContStateData%UnusedStates - END SUBROUTINE SeaSt_CopyContState - - SUBROUTINE SeaSt_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(SeaSt_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 = 'SeaSt_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SeaSt_DestroyContState - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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 - Db_BufSz = Db_BufSz + 1 ! UnusedStates - 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%UnusedStates - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_PackContState - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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%UnusedStates = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_UnPackContState - - SUBROUTINE SeaSt_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SeaSt_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 = 'SeaSt_CopyDiscState' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%OutRootName = SrcInitInputData%OutRootName + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%defWtrDens = SrcInitInputData%defWtrDens + DstInitInputData%defWtrDpth = SrcInitInputData%defWtrDpth + DstInitInputData%defMSL2SWL = SrcInitInputData%defMSL2SWL + DstInitInputData%TMax = SrcInitInputData%TMax + if (allocated(SrcInitInputData%WaveElevXY)) then + LB(1:2) = lbound(SrcInitInputData%WaveElevXY) + UB(1:2) = ubound(SrcInitInputData%WaveElevXY) + if (.not. allocated(DstInitInputData%WaveElevXY)) then + allocate(DstInitInputData%WaveElevXY(LB(1):UB(1),LB(2):UB(2)), 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 + end if + DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod + DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX + DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY + DstInitInputData%WrWvKinMod = SrcInitInputData%WrWvKinMod + DstInitInputData%HasIce = SrcInitInputData%HasIce + DstInitInputData%Linearize = SrcInitInputData%Linearize +end subroutine + +subroutine SeaSt_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SeaSt_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%UnusedStates = SrcDiscStateData%UnusedStates - END SUBROUTINE SeaSt_CopyDiscState - - SUBROUTINE SeaSt_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(SeaSt_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 = 'SeaSt_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SeaSt_DestroyDiscState - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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 - Db_BufSz = Db_BufSz + 1 ! UnusedStates - 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%UnusedStates - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_PackDiscState - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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%UnusedStates = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_UnPackDiscState - - SUBROUTINE SeaSt_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SeaSt_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 = 'SeaSt_CopyConstrState' -! + ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitInputData%WaveElevXY)) then + deallocate(InitInputData%WaveElevXY) + end if +end subroutine + +subroutine SeaSt_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) + call RegPack(Buf, InData%OutRootName) + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%defWtrDens) + call RegPack(Buf, InData%defWtrDpth) + call RegPack(Buf, InData%defMSL2SWL) + call RegPack(Buf, InData%TMax) + call RegPack(Buf, allocated(InData%WaveElevXY)) + if (allocated(InData%WaveElevXY)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevXY), ubound(InData%WaveElevXY)) + call RegPack(Buf, InData%WaveElevXY) + end if + call RegPack(Buf, InData%WaveFieldMod) + call RegPack(Buf, InData%PtfmLocationX) + call RegPack(Buf, InData%PtfmLocationY) + call RegPack(Buf, InData%WrWvKinMod) + call RegPack(Buf, InData%HasIce) + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData + call RegUnpack(Buf, OutData%OutRootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%defWtrDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%defWtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%defMSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TMax) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WaveElevXY)) deallocate(OutData%WaveElevXY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevXY(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevXY) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmLocationX) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmLocationY) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WrWvKinMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HasIce) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_InitOutputType), intent(in) :: SrcInitOutputData + type(SeaSt_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%UnusedStates = SrcConstrStateData%UnusedStates - END SUBROUTINE SeaSt_CopyConstrState - - SUBROUTINE SeaSt_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(SeaSt_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 = 'SeaSt_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SeaSt_DestroyConstrState - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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 - Db_BufSz = Db_BufSz + 1 ! UnusedStates - 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%UnusedStates - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_PackConstrState - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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%UnusedStates = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_UnPackConstrState - - SUBROUTINE SeaSt_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SeaSt_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 = 'SeaSt_CopyOtherState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%WtrDens = SrcInitOutputData%WtrDens + DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth + DstInitOutputData%MSL2SWL = SrcInitOutputData%MSL2SWL + DstInitOutputData%WaveElevC0 => SrcInitOutputData%WaveElevC0 + DstInitOutputData%WaveElevC => SrcInitOutputData%WaveElevC + DstInitOutputData%WaveDirArr => SrcInitOutputData%WaveDirArr + DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin + DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax + DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir + DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir + DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega + DstInitOutputData%WaveDynP => SrcInitOutputData%WaveDynP + DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc + DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF + DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel + DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 + DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 + DstInitOutputData%PWaveAccMCF0 => SrcInitOutputData%PWaveAccMCF0 + DstInitOutputData%PWaveVel0 => SrcInitOutputData%PWaveVel0 + DstInitOutputData%WaveElev1 => SrcInitOutputData%WaveElev1 + DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 + DstInitOutputData%WaveElev0 => SrcInitOutputData%WaveElev0 + DstInitOutputData%WaveTime => SrcInitOutputData%WaveTime + DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg + DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave + DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 + DstInitOutputData%WaveMod = SrcInitOutputData%WaveMod + DstInitOutputData%WaveStMod = SrcInitOutputData%WaveStMod + DstInitOutputData%WaveDirMod = SrcInitOutputData%WaveDirMod + DstInitOutputData%WvLowCOff = SrcInitOutputData%WvLowCOff + DstInitOutputData%WvHiCOff = SrcInitOutputData%WvHiCOff + DstInitOutputData%WvLowCOffD = SrcInitOutputData%WvLowCOffD + DstInitOutputData%WvHiCOffD = SrcInitOutputData%WvHiCOffD + DstInitOutputData%WvLowCOffS = SrcInitOutputData%WvLowCOffS + DstInitOutputData%WvHiCOffS = SrcInitOutputData%WvHiCOffS + DstInitOutputData%InvalidWithSSExctn = SrcInitOutputData%InvalidWithSSExctn + call SeaSt_Interp_CopyParam(SrcInitOutputData%SeaSt_Interp_p, DstInitOutputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%MCFD = SrcInitOutputData%MCFD + if (allocated(SrcInitOutputData%WaveElevSeries)) then + LB(1:2) = lbound(SrcInitOutputData%WaveElevSeries) + UB(1:2) = ubound(SrcInitOutputData%WaveElevSeries) + if (.not. allocated(DstInitOutputData%WaveElevSeries)) then + allocate(DstInitOutputData%WaveElevSeries(LB(1):UB(1),LB(2):UB(2)), 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 + end if + DstInitOutputData%WaveField => SrcInitOutputData%WaveField +end subroutine + +subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SeaSt_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%UnusedStates = SrcOtherStateData%UnusedStates - END SUBROUTINE SeaSt_CopyOtherState - - SUBROUTINE SeaSt_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(SeaSt_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 = 'SeaSt_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SeaSt_DestroyOtherState - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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 - Db_BufSz = Db_BufSz + 1 ! UnusedStates - 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%UnusedStates - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_PackOtherState - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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%UnusedStates = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_UnPackOtherState - - SUBROUTINE SeaSt_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SeaSt_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 = 'SeaSt_CopyMisc' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%WaveElevC0) + nullify(InitOutputData%WaveElevC) + 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) + nullify(InitOutputData%WaveElev0) + 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) + end if + nullify(InitOutputData%WaveField) +end subroutine + +subroutine SeaSt_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackInitOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, InData%WtrDens) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%MSL2SWL) + call RegPack(Buf, associated(InData%WaveElevC0)) + if (associated(InData%WaveElevC0)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC0) + end if + end if + call RegPack(Buf, associated(InData%WaveElevC)) + if (associated(InData%WaveElevC)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC) + end if + end if + call RegPack(Buf, associated(InData%WaveDirArr)) + if (associated(InData%WaveDirArr)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) + call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDirArr) + end if + end if + call RegPack(Buf, InData%WaveDirMin) + call RegPack(Buf, InData%WaveDirMax) + call RegPack(Buf, InData%WaveDir) + call RegPack(Buf, InData%WaveMultiDir) + call RegPack(Buf, InData%WaveDOmega) + call RegPack(Buf, associated(InData%WaveDynP)) + if (associated(InData%WaveDynP)) then + call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) + call RegPackPointer(Buf, c_loc(InData%WaveDynP), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDynP) + end if + end if + call RegPack(Buf, associated(InData%WaveAcc)) + if (associated(InData%WaveAcc)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) + call RegPackPointer(Buf, c_loc(InData%WaveAcc), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveAcc) + end if + end if + call RegPack(Buf, associated(InData%WaveAccMCF)) + if (associated(InData%WaveAccMCF)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) + call RegPackPointer(Buf, c_loc(InData%WaveAccMCF), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveAccMCF) + end if + end if + call RegPack(Buf, associated(InData%WaveVel)) + if (associated(InData%WaveVel)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) + call RegPackPointer(Buf, c_loc(InData%WaveVel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveVel) + end if + end if + call RegPack(Buf, associated(InData%PWaveDynP0)) + if (associated(InData%PWaveDynP0)) then + call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) + call RegPackPointer(Buf, c_loc(InData%PWaveDynP0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveDynP0) + end if + end if + call RegPack(Buf, associated(InData%PWaveAcc0)) + if (associated(InData%PWaveAcc0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) + call RegPackPointer(Buf, c_loc(InData%PWaveAcc0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveAcc0) + end if + end if + call RegPack(Buf, associated(InData%PWaveAccMCF0)) + if (associated(InData%PWaveAccMCF0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) + call RegPackPointer(Buf, c_loc(InData%PWaveAccMCF0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveAccMCF0) + end if + end if + call RegPack(Buf, associated(InData%PWaveVel0)) + if (associated(InData%PWaveVel0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) + call RegPackPointer(Buf, c_loc(InData%PWaveVel0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveVel0) + end if + end if + call RegPack(Buf, associated(InData%WaveElev1)) + if (associated(InData%WaveElev1)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPackPointer(Buf, c_loc(InData%WaveElev1), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev1) + end if + end if + call RegPack(Buf, associated(InData%WaveElev2)) + if (associated(InData%WaveElev2)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) + call RegPackPointer(Buf, c_loc(InData%WaveElev2), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev2) + end if + end if + call RegPack(Buf, associated(InData%WaveElev0)) + if (associated(InData%WaveElev0)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) + call RegPackPointer(Buf, c_loc(InData%WaveElev0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev0) + end if + end if + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + call RegPack(Buf, InData%RhoXg) + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, InData%NStepWave2) + call RegPack(Buf, InData%WaveMod) + call RegPack(Buf, InData%WaveStMod) + call RegPack(Buf, InData%WaveDirMod) + call RegPack(Buf, InData%WvLowCOff) + call RegPack(Buf, InData%WvHiCOff) + call RegPack(Buf, InData%WvLowCOffD) + call RegPack(Buf, InData%WvHiCOffD) + call RegPack(Buf, InData%WvLowCOffS) + call RegPack(Buf, InData%WvHiCOffS) + call RegPack(Buf, InData%InvalidWithSSExctn) + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + call RegPack(Buf, InData%MCFD) + call RegPack(Buf, allocated(InData%WaveElevSeries)) + if (allocated(InData%WaveElevSeries)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevSeries), ubound(InData%WaveElevSeries)) + call RegPack(Buf, InData%WaveElevSeries) + end if + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackInitOutput' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) + OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 + else + allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) + call RegUnpack(Buf, OutData%WaveElevC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC0 => null() + end if + if (associated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC, UB(1:3)-LB(1:3)) + OutData%WaveElevC(LB(1):,LB(2):,LB(3):) => OutData%WaveElevC + else + allocate(OutData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC) + call RegUnpack(Buf, OutData%WaveElevC) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC => null() + end if + if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) + OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr + else + allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) + call RegUnpack(Buf, OutData%WaveDirArr) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDirArr => null() + end if + call RegUnpack(Buf, OutData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDynP, UB(1:4)-LB(1:4)) + OutData%WaveDynP(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%WaveDynP + else + allocate(OutData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDynP) + call RegUnpack(Buf, OutData%WaveDynP) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDynP => null() + end if + if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveAcc, UB(1:5)-LB(1:5)) + OutData%WaveAcc(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAcc + else + allocate(OutData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAcc) + call RegUnpack(Buf, OutData%WaveAcc) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveAcc => null() + end if + if (associated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveAccMCF, UB(1:5)-LB(1:5)) + OutData%WaveAccMCF(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAccMCF + else + allocate(OutData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAccMCF) + call RegUnpack(Buf, OutData%WaveAccMCF) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveAccMCF => null() + end if + if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveVel, UB(1:5)-LB(1:5)) + OutData%WaveVel(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveVel + else + allocate(OutData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveVel) + call RegUnpack(Buf, OutData%WaveVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveVel => null() + end if + if (associated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveDynP0, UB(1:3)-LB(1:3)) + OutData%PWaveDynP0(LB(1):,LB(2):,LB(3):) => OutData%PWaveDynP0 + else + allocate(OutData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveDynP0) + call RegUnpack(Buf, OutData%PWaveDynP0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveDynP0 => null() + end if + if (associated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveAcc0, UB(1:4)-LB(1:4)) + OutData%PWaveAcc0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAcc0 + else + allocate(OutData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAcc0) + call RegUnpack(Buf, OutData%PWaveAcc0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveAcc0 => null() + end if + if (associated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveAccMCF0, UB(1:4)-LB(1:4)) + OutData%PWaveAccMCF0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAccMCF0 + else + allocate(OutData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAccMCF0) + call RegUnpack(Buf, OutData%PWaveAccMCF0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveAccMCF0 => null() + end if + if (associated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveVel0, UB(1:4)-LB(1:4)) + OutData%PWaveVel0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveVel0 + else + allocate(OutData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveVel0) + call RegUnpack(Buf, OutData%PWaveVel0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveVel0 => null() + end if + if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev1, UB(1:3)-LB(1:3)) + OutData%WaveElev1(LB(1):,LB(2):,LB(3):) => OutData%WaveElev1 + else + allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev1) + call RegUnpack(Buf, OutData%WaveElev1) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev1 => null() + end if + if (associated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev2, UB(1:3)-LB(1:3)) + OutData%WaveElev2(LB(1):,LB(2):,LB(3):) => OutData%WaveElev2 + else + allocate(OutData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev2) + call RegUnpack(Buf, OutData%WaveElev2) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev2 => null() + end if + if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev0, UB(1:1)-LB(1:1)) + OutData%WaveElev0(LB(1):) => OutData%WaveElev0 + else + allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev0) + call RegUnpack(Buf, OutData%WaveElev0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev0 => null() + end if + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + call RegUnpack(Buf, OutData%RhoXg) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDirMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOffD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOffD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOffS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%InvalidWithSSExctn) + if (RegCheckErr(Buf, RoutineName)) return + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p + call RegUnpack(Buf, OutData%MCFD) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WaveElevSeries)) deallocate(OutData%WaveElevSeries) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevSeries(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevSeries) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if +end subroutine + +subroutine SeaSt_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_ContinuousStateType), intent(in) :: SrcContStateData + type(SeaSt_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%Decimate = SrcMiscData%Decimate - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - CALL SeaSt_Interp_CopyMisc( SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE SeaSt_CopyMisc - - SUBROUTINE SeaSt_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SeaSt_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 = 'SeaSt_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL SeaSt_Interp_DestroyMisc( MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SeaSt_DestroyMisc - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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 ! Decimate - Db_BufSz = Db_BufSz + 1 ! LastOutTime - Int_BufSz = Int_BufSz + 1 ! LastIndWave - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - 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 - 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%Decimate - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - 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 SeaSt_PackMisc - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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%Decimate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LastOutTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - 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 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' -! + ErrMsg = '' + DstContStateData%UnusedStates = SrcContStateData%UnusedStates +end subroutine + +subroutine SeaSt_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SeaSt_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyContState' 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%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 - 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) - i1_u = UBOUND(SrcParamData%WaveKinxi,1) - IF (.NOT. ALLOCATED(DstParamData%WaveKinxi)) THEN - ALLOCATE(DstParamData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveKinxi = SrcParamData%WaveKinxi -ENDIF -IF (ALLOCATED(SrcParamData%WaveKinyi)) THEN - i1_l = LBOUND(SrcParamData%WaveKinyi,1) - i1_u = UBOUND(SrcParamData%WaveKinyi,1) - IF (.NOT. ALLOCATED(DstParamData%WaveKinyi)) THEN - ALLOCATE(DstParamData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveKinyi = SrcParamData%WaveKinyi -ENDIF -IF (ALLOCATED(SrcParamData%WaveKinzi)) THEN - i1_l = LBOUND(SrcParamData%WaveKinzi,1) - i1_u = UBOUND(SrcParamData%WaveKinzi,1) - IF (.NOT. ALLOCATED(DstParamData%WaveKinzi)) THEN - ALLOCATE(DstParamData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveKinzi = SrcParamData%WaveKinzi -ENDIF - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%DT = SrcParamData%DT - DstParamData%WaveStMod = SrcParamData%WaveStMod -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%OutSwtch = SrcParamData%OutSwtch - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - DstParamData%Delim = SrcParamData%Delim - DstParamData%UnOutFile = SrcParamData%UnOutFile - DstParamData%OutDec = SrcParamData%OutDec - 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 ) - TYPE(SeaSt_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 = 'SeaSt_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL Waves2_DestroyParam( ParamData%Waves2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -NULLIFY(ParamData%WaveTime) -IF (ALLOCATED(ParamData%WaveElevxi)) THEN - DEALLOCATE(ParamData%WaveElevxi) -ENDIF -IF (ALLOCATED(ParamData%WaveElevyi)) THEN - DEALLOCATE(ParamData%WaveElevyi) -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 -IF (ALLOCATED(ParamData%WaveKinyi)) THEN - DEALLOCATE(ParamData%WaveKinyi) -ENDIF -IF (ALLOCATED(ParamData%WaveKinzi)) THEN - DEALLOCATE(ParamData%WaveKinzi) -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 - CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, 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) - ParamData%WaveField => NULL() -ENDIF - END SUBROUTINE SeaSt_DestroyParam - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Waves2: size of buffers for each call to pack subtype - CALL Waves2_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, .TRUE. ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + 1 ! WaveDT - Int_BufSz = Int_BufSz + 1 ! NGridPts - Int_BufSz = Int_BufSz + SIZE(InData%NGrid) ! NGrid - Re_BufSz = Re_BufSz + SIZE(InData%deltaGrid) ! deltaGrid - Re_BufSz = Re_BufSz + 1 ! X_HalfWidth - Re_BufSz = Re_BufSz + 1 ! Y_HalfWidth - Re_BufSz = Re_BufSz + 1 ! Z_Depth - Int_BufSz = Int_BufSz + 1 ! NStepWave - 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 ! 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 - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! WaveStMod - 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 - 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 ! OutSwtch - 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 - Int_BufSz = Int_BufSz + 1 ! OutDec - 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 ! 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) - 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 - 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 - - CALL Waves2_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, OnlySize ) ! Waves2 - 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 - DbKiBuf(Db_Xferred) = InData%WaveDT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NGridPts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%NGrid,1), UBOUND(InData%NGrid,1) - IntKiBuf(Int_Xferred) = InData%NGrid(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%deltaGrid,1), UBOUND(InData%deltaGrid,1) - ReKiBuf(Re_Xferred) = InData%deltaGrid(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%X_HalfWidth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y_HalfWidth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z_Depth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_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 - 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 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - 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%OutSwtch - 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 - IntKiBuf(Int_Xferred) = InData%OutDec - 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 - 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 - - 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 IF - END SUBROUTINE SeaSt_PackParam - - SUBROUTINE SeaSt_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(SeaSt_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) :: 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_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 - 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 Waves2_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%Waves2, ErrStat2, ErrMsg2 ) ! Waves2 - 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%WaveTime) - OutData%WaveDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NGridPts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%NGrid,1) - i1_u = UBOUND(OutData%NGrid,1) - DO i1 = LBOUND(OutData%NGrid,1), UBOUND(OutData%NGrid,1) - OutData%NGrid(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%deltaGrid,1) - i1_u = UBOUND(OutData%deltaGrid,1) - DO i1 = LBOUND(OutData%deltaGrid,1), UBOUND(OutData%deltaGrid,1) - OutData%deltaGrid(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%X_HalfWidth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y_HalfWidth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z_Depth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_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 - 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 - 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%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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%OutSwtch = 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 - OutData%OutDec = 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) - 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 - 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 IF - END SUBROUTINE SeaSt_UnPackParam - - SUBROUTINE SeaSt_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_InputType), INTENT(IN) :: SrcInputData - TYPE(SeaSt_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 = 'SeaSt_CopyInput' -! + ErrMsg = '' +end subroutine + +subroutine SeaSt_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SeaSt_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstInputData%DummyInput = SrcInputData%DummyInput - END SUBROUTINE SeaSt_CopyInput - - SUBROUTINE SeaSt_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SeaSt_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 = 'SeaSt_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SeaSt_DestroyInput - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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 SeaSt_PackInput - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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 SeaSt_UnPackInput - - SUBROUTINE SeaSt_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_OutputType), INTENT(IN) :: SrcOutputData - TYPE(SeaSt_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 = 'SeaSt_CopyOutput' -! + ErrMsg = '' + DstDiscStateData%UnusedStates = SrcDiscStateData%UnusedStates +end subroutine + +subroutine SeaSt_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SeaSt_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyDiscState' 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 SeaSt_CopyOutput - - SUBROUTINE SeaSt_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SeaSt_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 = 'SeaSt_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE SeaSt_DestroyOutput - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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 SeaSt_PackOutput - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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 SeaSt_UnPackOutput - + ErrMsg = '' +end subroutine + +subroutine SeaSt_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SeaSt_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%UnusedStates = SrcConstrStateData%UnusedStates +end subroutine + +subroutine SeaSt_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SeaSt_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_OtherStateType), intent(in) :: SrcOtherStateData + type(SeaSt_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%UnusedStates = SrcOtherStateData%UnusedStates +end subroutine + +subroutine SeaSt_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SeaSt_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_MiscVarType), intent(in) :: SrcMiscData + type(SeaSt_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%Decimate = SrcMiscData%Decimate + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + call SeaSt_Interp_CopyMisc(SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine SeaSt_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SeaSt_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SeaSt_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Decimate) + call RegPack(Buf, InData%LastOutTime) + call RegPack(Buf, InData%LastIndWave) + call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Decimate) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LastOutTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return + call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m +end subroutine + +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 + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(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 + LB(1:1) = lbound(SrcParamData%WaveElevxi) + UB(1:1) = ubound(SrcParamData%WaveElevxi) + if (.not. allocated(DstParamData%WaveElevxi)) then + allocate(DstParamData%WaveElevxi(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%WaveElevyi)) then + LB(1:1) = lbound(SrcParamData%WaveElevyi) + UB(1:1) = ubound(SrcParamData%WaveElevyi) + if (.not. allocated(DstParamData%WaveElevyi)) then + allocate(DstParamData%WaveElevyi(LB(1):UB(1)), 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 + end if + 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 + LB(1:1) = lbound(SrcParamData%WaveKinxi) + UB(1:1) = ubound(SrcParamData%WaveKinxi) + if (.not. allocated(DstParamData%WaveKinxi)) then + allocate(DstParamData%WaveKinxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveKinxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveKinxi = SrcParamData%WaveKinxi + end if + if (allocated(SrcParamData%WaveKinyi)) then + LB(1:1) = lbound(SrcParamData%WaveKinyi) + UB(1:1) = ubound(SrcParamData%WaveKinyi) + if (.not. allocated(DstParamData%WaveKinyi)) then + allocate(DstParamData%WaveKinyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveKinyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveKinyi = SrcParamData%WaveKinyi + end if + if (allocated(SrcParamData%WaveKinzi)) then + LB(1:1) = lbound(SrcParamData%WaveKinzi) + UB(1:1) = ubound(SrcParamData%WaveKinzi) + if (.not. allocated(DstParamData%WaveKinzi)) then + allocate(DstParamData%WaveKinzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveKinzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveKinzi = SrcParamData%WaveKinzi + end if + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%DT = SrcParamData%DT + DstParamData%WaveStMod = SrcParamData%WaveStMod + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + DstParamData%Delim = SrcParamData%Delim + DstParamData%UnOutFile = SrcParamData%UnOutFile + DstParamData%OutDec = SrcParamData%OutDec + 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 + end if +end subroutine + +subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SeaSt_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + call Waves2_DestroyParam(ParamData%Waves2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(ParamData%WaveTime) + if (allocated(ParamData%WaveElevxi)) then + deallocate(ParamData%WaveElevxi) + end if + if (allocated(ParamData%WaveElevyi)) then + deallocate(ParamData%WaveElevyi) + end if + 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) + end if + if (allocated(ParamData%WaveKinyi)) then + deallocate(ParamData%WaveKinyi) + end if + if (allocated(ParamData%WaveKinzi)) then + deallocate(ParamData%WaveKinzi) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + call SeaSt_Interp_DestroyParam(ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (associated(ParamData%WaveField)) then + call SeaSt_WaveField_DestroySeaSt_WaveFieldType(ParamData%WaveField, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%WaveField) + ParamData%WaveField => null() + end if +end subroutine + +subroutine SeaSt_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackParam' + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(5) + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call Waves2_PackParam(Buf, InData%Waves2) + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + call RegPack(Buf, InData%WaveDT) + call RegPack(Buf, InData%NGridPts) + call RegPack(Buf, InData%NGrid) + call RegPack(Buf, InData%deltaGrid) + call RegPack(Buf, InData%X_HalfWidth) + call RegPack(Buf, InData%Y_HalfWidth) + call RegPack(Buf, InData%Z_Depth) + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, InData%NWaveElev) + call RegPack(Buf, allocated(InData%WaveElevxi)) + if (allocated(InData%WaveElevxi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElevxi), ubound(InData%WaveElevxi)) + call RegPack(Buf, InData%WaveElevxi) + end if + call RegPack(Buf, allocated(InData%WaveElevyi)) + if (allocated(InData%WaveElevyi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi), ubound(InData%WaveElevyi)) + call RegPack(Buf, InData%WaveElevyi) + end if + call RegPack(Buf, associated(InData%WaveElev1)) + if (associated(InData%WaveElev1)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPackPointer(Buf, c_loc(InData%WaveElev1), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev1) + end if + end if + call RegPack(Buf, associated(InData%WaveElev2)) + if (associated(InData%WaveElev2)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) + call RegPackPointer(Buf, c_loc(InData%WaveElev2), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev2) + end if + end if + call RegPack(Buf, associated(InData%PWaveDynP0)) + if (associated(InData%PWaveDynP0)) then + call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) + call RegPackPointer(Buf, c_loc(InData%PWaveDynP0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveDynP0) + end if + end if + call RegPack(Buf, associated(InData%WaveDynP)) + if (associated(InData%WaveDynP)) then + call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) + call RegPackPointer(Buf, c_loc(InData%WaveDynP), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDynP) + end if + end if + call RegPack(Buf, associated(InData%WaveAcc)) + if (associated(InData%WaveAcc)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) + call RegPackPointer(Buf, c_loc(InData%WaveAcc), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveAcc) + end if + end if + call RegPack(Buf, associated(InData%PWaveAcc0)) + if (associated(InData%PWaveAcc0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) + call RegPackPointer(Buf, c_loc(InData%PWaveAcc0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveAcc0) + end if + end if + call RegPack(Buf, associated(InData%WaveVel)) + if (associated(InData%WaveVel)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) + call RegPackPointer(Buf, c_loc(InData%WaveVel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveVel) + end if + end if + call RegPack(Buf, associated(InData%PWaveVel0)) + if (associated(InData%PWaveVel0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) + call RegPackPointer(Buf, c_loc(InData%PWaveVel0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveVel0) + end if + end if + call RegPack(Buf, associated(InData%WaveAccMCF)) + if (associated(InData%WaveAccMCF)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) + call RegPackPointer(Buf, c_loc(InData%WaveAccMCF), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveAccMCF) + end if + end if + call RegPack(Buf, associated(InData%WaveDirArr)) + if (associated(InData%WaveDirArr)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) + call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDirArr) + end if + end if + call RegPack(Buf, associated(InData%WaveElevC0)) + if (associated(InData%WaveElevC0)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC0) + end if + end if + call RegPack(Buf, associated(InData%PWaveAccMCF0)) + if (associated(InData%PWaveAccMCF0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) + call RegPackPointer(Buf, c_loc(InData%PWaveAccMCF0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveAccMCF0) + end if + end if + call RegPack(Buf, InData%NWaveKin) + call RegPack(Buf, allocated(InData%WaveKinxi)) + if (allocated(InData%WaveKinxi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinxi), ubound(InData%WaveKinxi)) + call RegPack(Buf, InData%WaveKinxi) + end if + call RegPack(Buf, allocated(InData%WaveKinyi)) + if (allocated(InData%WaveKinyi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinyi), ubound(InData%WaveKinyi)) + call RegPack(Buf, InData%WaveKinyi) + end if + call RegPack(Buf, allocated(InData%WaveKinzi)) + if (allocated(InData%WaveKinzi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi), ubound(InData%WaveKinzi)) + call RegPack(Buf, InData%WaveKinzi) + end if + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%WaveStMod) + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%OutSwtch) + call RegPack(Buf, InData%OutFmt) + call RegPack(Buf, InData%OutSFmt) + call RegPack(Buf, InData%Delim) + call RegPack(Buf, InData%UnOutFile) + call RegPack(Buf, InData%OutDec) + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackParam' + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call Waves2_UnpackParam(Buf, OutData%Waves2) ! Waves2 + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + call RegUnpack(Buf, OutData%WaveDT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NGridPts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NGrid) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%deltaGrid) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%X_HalfWidth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Y_HalfWidth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Z_Depth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NWaveElev) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WaveElevxi)) deallocate(OutData%WaveElevxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveElevyi)) deallocate(OutData%WaveElevyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev1, UB(1:3)-LB(1:3)) + OutData%WaveElev1(LB(1):,LB(2):,LB(3):) => OutData%WaveElev1 + else + allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev1) + call RegUnpack(Buf, OutData%WaveElev1) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev1 => null() + end if + if (associated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev2, UB(1:3)-LB(1:3)) + OutData%WaveElev2(LB(1):,LB(2):,LB(3):) => OutData%WaveElev2 + else + allocate(OutData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev2) + call RegUnpack(Buf, OutData%WaveElev2) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev2 => null() + end if + if (associated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveDynP0, UB(1:3)-LB(1:3)) + OutData%PWaveDynP0(LB(1):,LB(2):,LB(3):) => OutData%PWaveDynP0 + else + allocate(OutData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveDynP0) + call RegUnpack(Buf, OutData%PWaveDynP0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveDynP0 => null() + end if + if (associated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDynP, UB(1:4)-LB(1:4)) + OutData%WaveDynP(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%WaveDynP + else + allocate(OutData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDynP) + call RegUnpack(Buf, OutData%WaveDynP) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDynP => null() + end if + if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveAcc, UB(1:5)-LB(1:5)) + OutData%WaveAcc(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAcc + else + allocate(OutData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAcc) + call RegUnpack(Buf, OutData%WaveAcc) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveAcc => null() + end if + if (associated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveAcc0, UB(1:4)-LB(1:4)) + OutData%PWaveAcc0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAcc0 + else + allocate(OutData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAcc0) + call RegUnpack(Buf, OutData%PWaveAcc0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveAcc0 => null() + end if + if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveVel, UB(1:5)-LB(1:5)) + OutData%WaveVel(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveVel + else + allocate(OutData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveVel) + call RegUnpack(Buf, OutData%WaveVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveVel => null() + end if + if (associated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveVel0, UB(1:4)-LB(1:4)) + OutData%PWaveVel0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveVel0 + else + allocate(OutData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveVel0) + call RegUnpack(Buf, OutData%PWaveVel0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveVel0 => null() + end if + if (associated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveAccMCF, UB(1:5)-LB(1:5)) + OutData%WaveAccMCF(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAccMCF + else + allocate(OutData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAccMCF) + call RegUnpack(Buf, OutData%WaveAccMCF) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveAccMCF => null() + end if + if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) + OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr + else + allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) + call RegUnpack(Buf, OutData%WaveDirArr) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDirArr => null() + end if + if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) + OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 + else + allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) + call RegUnpack(Buf, OutData%WaveElevC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC0 => null() + end if + if (associated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveAccMCF0, UB(1:4)-LB(1:4)) + OutData%PWaveAccMCF0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAccMCF0 + else + allocate(OutData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAccMCF0) + call RegUnpack(Buf, OutData%PWaveAccMCF0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveAccMCF0 => null() + end if + call RegUnpack(Buf, OutData%NWaveKin) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WaveKinxi)) deallocate(OutData%WaveKinxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveKinyi)) deallocate(OutData%WaveKinyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveKinzi)) deallocate(OutData%WaveKinzi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinzi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinzi) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnOutFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutDec) + if (RegCheckErr(Buf, RoutineName)) return + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if +end subroutine + +subroutine SeaSt_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_InputType), intent(in) :: SrcInputData + type(SeaSt_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%DummyInput = SrcInputData%DummyInput +end subroutine + +subroutine SeaSt_DestroyInput(InputData, ErrStat, ErrMsg) + type(SeaSt_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyInput) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyInput) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_OutputType), intent(in) :: SrcOutputData + type(SeaSt_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SeaSt_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SeaSt_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SeaSt_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine SeaSt_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine END MODULE SeaState_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index c5015bbfae..2bdcf55998 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -35,29 +35,29 @@ MODULE Waves2_Types IMPLICIT NONE ! ========= Waves2_InitInputType ======= TYPE, PUBLIC :: Waves2_InitInputType - REAL(ReKi) :: Gravity !< Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDens !< Water density [(kg/m^3)] - REAL(ReKi) :: 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(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [(m/s^2)] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [(kg/m^3)] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(meters)] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] + INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] + REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< 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 = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] 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(:), POINTER :: WaveTime => NULL() !< Simulation times at which the instantaneous second order loads associated with the incident waves are determined [sec] - INTEGER(IntKi) , DIMENSION(1:3) :: nGrid !< Grid dimensions [-] - INTEGER(IntKi) :: NWaveElevGrid !< Number of grid points where the incident wave elevations can be output [-] - INTEGER(IntKi) :: NWaveKinGrid !< Number of grid points where the incident wave kinematics will be computed [-] + INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] + INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations can be output [-] + INTEGER(IntKi) :: NWaveKinGrid = 0_IntKi !< Number of grid points where the incident wave kinematics will be computed [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridxi !< xi-coordinates for grid points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridyi !< yi-coordinates for grid points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridzi !< zi-coordinates for grid 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)] + LOGICAL :: WvDiffQTFF = .false. !< Full difference QTF second order forces flag [(-)] + LOGICAL :: WvSumQTFF = .false. !< Full sum QTF second order forces flag [(-)] + REAL(SiKi) :: WvLowCOffD = 0.0_R4Ki !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] END TYPE Waves2_InitInputType ! ======================= ! ========= Waves2_InitOutputType ======= @@ -73,1266 +73,649 @@ MODULE Waves2_Types ! ======================= ! ========= Waves2_ParameterType ======= TYPE, PUBLIC :: Waves2_ParameterType - LOGICAL :: WvDiffQTFF !< Full difference QTF second order forces flag [(-)] - LOGICAL :: WvSumQTFF !< Full sum QTF second order forces flag [(-)] + LOGICAL :: WvDiffQTFF = .false. !< Full difference QTF second order forces flag [(-)] + LOGICAL :: WvSumQTFF = .false. !< Full sum QTF second order forces flag [(-)] END TYPE Waves2_ParameterType ! ======================= 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%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 - DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr - DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 - DstInitInputData%WaveTime => SrcInitInputData%WaveTime - DstInitInputData%nGrid = SrcInitInputData%nGrid - DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid - DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid -IF (ALLOCATED(SrcInitInputData%WaveKinGridxi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinGridxi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinGridxi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinGridxi)) THEN - ALLOCATE(DstInitInputData%WaveKinGridxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinGridyi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinGridyi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinGridyi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinGridyi)) THEN - ALLOCATE(DstInitInputData%WaveKinGridyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinGridzi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinGridzi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinGridzi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinGridzi)) THEN - ALLOCATE(DstInitInputData%WaveKinGridzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi -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 - 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 = "" - -NULLIFY(InitInputData%WaveDirArr) -NULLIFY(InitInputData%WaveElevC0) -NULLIFY(InitInputData%WaveTime) -IF (ALLOCATED(InitInputData%WaveKinGridxi)) THEN - DEALLOCATE(InitInputData%WaveKinGridxi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinGridyi)) THEN - DEALLOCATE(InitInputData%WaveKinGridyi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinGridzi)) THEN - DEALLOCATE(InitInputData%WaveKinGridzi) -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 - 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 + SIZE(InData%nGrid) ! nGrid - Int_BufSz = Int_BufSz + 1 ! NWaveElevGrid - Int_BufSz = Int_BufSz + 1 ! NWaveKinGrid - Int_BufSz = Int_BufSz + 1 ! WaveKinGridxi allocated yes/no - IF ( ALLOCATED(InData%WaveKinGridxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinGridxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinGridxi) ! WaveKinGridxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinGridyi allocated yes/no - IF ( ALLOCATED(InData%WaveKinGridyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinGridyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinGridyi) ! WaveKinGridyi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinGridzi allocated yes/no - IF ( ALLOCATED(InData%WaveKinGridzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinGridzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinGridzi) ! WaveKinGridzi - 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 - 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%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 - DO i1 = LBOUND(InData%nGrid,1), UBOUND(InData%nGrid,1) - IntKiBuf(Int_Xferred) = InData%nGrid(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NWaveElevGrid - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWaveKinGrid - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveKinGridxi) ) 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%WaveKinGridxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinGridxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinGridxi,1), UBOUND(InData%WaveKinGridxi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinGridxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinGridyi) ) 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%WaveKinGridyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinGridyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinGridyi,1), UBOUND(InData%WaveKinGridyi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinGridyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinGridzi) ) 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%WaveKinGridzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinGridzi,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WaveKinGridzi,1), UBOUND(InData%WaveKinGridzi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinGridzi(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 - 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%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%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 - 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) - OutData%nGrid(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NWaveElevGrid = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveKinGrid = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinGridxi 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%WaveKinGridxi)) DEALLOCATE(OutData%WaveKinGridxi) - ALLOCATE(OutData%WaveKinGridxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinGridxi,1), UBOUND(OutData%WaveKinGridxi,1) - OutData%WaveKinGridxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinGridyi 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%WaveKinGridyi)) DEALLOCATE(OutData%WaveKinGridyi) - ALLOCATE(OutData%WaveKinGridyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinGridyi,1), UBOUND(OutData%WaveKinGridyi,1) - OutData%WaveKinGridyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinGridzi 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%WaveKinGridzi)) DEALLOCATE(OutData%WaveKinGridzi) - ALLOCATE(OutData%WaveKinGridzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinGridzi,1), UBOUND(OutData%WaveKinGridzi,1) - OutData%WaveKinGridzi(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 - 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) :: 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_CopyInitOutput' -! +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 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Waves2_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" -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) - i4_l = LBOUND(SrcInitOutputData%WaveAcc2D,4) - i4_u = UBOUND(SrcInitOutputData%WaveAcc2D,4) - i5_l = LBOUND(SrcInitOutputData%WaveAcc2D,5) - i5_u = UBOUND(SrcInitOutputData%WaveAcc2D,5) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2D)) THEN - ALLOCATE(DstInitOutputData%WaveAcc2D(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%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) - i3_l = LBOUND(SrcInitOutputData%WaveDynP2D,3) - i3_u = UBOUND(SrcInitOutputData%WaveDynP2D,3) - i4_l = LBOUND(SrcInitOutputData%WaveDynP2D,4) - i4_u = UBOUND(SrcInitOutputData%WaveDynP2D,4) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2D)) THEN - ALLOCATE(DstInitOutputData%WaveDynP2D(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%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) - i4_l = LBOUND(SrcInitOutputData%WaveAcc2S,4) - i4_u = UBOUND(SrcInitOutputData%WaveAcc2S,4) - i5_l = LBOUND(SrcInitOutputData%WaveAcc2S,5) - i5_u = UBOUND(SrcInitOutputData%WaveAcc2S,5) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2S)) THEN - ALLOCATE(DstInitOutputData%WaveAcc2S(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%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) - i3_l = LBOUND(SrcInitOutputData%WaveDynP2S,3) - i3_u = UBOUND(SrcInitOutputData%WaveDynP2S,3) - i4_l = LBOUND(SrcInitOutputData%WaveDynP2S,4) - i4_u = UBOUND(SrcInitOutputData%WaveDynP2S,4) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2S)) THEN - ALLOCATE(DstInitOutputData%WaveDynP2S(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%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) - i4_l = LBOUND(SrcInitOutputData%WaveVel2D,4) - i4_u = UBOUND(SrcInitOutputData%WaveVel2D,4) - i5_l = LBOUND(SrcInitOutputData%WaveVel2D,5) - i5_u = UBOUND(SrcInitOutputData%WaveVel2D,5) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2D)) THEN - ALLOCATE(DstInitOutputData%WaveVel2D(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%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) - i4_l = LBOUND(SrcInitOutputData%WaveVel2S,4) - i4_u = UBOUND(SrcInitOutputData%WaveVel2S,4) - i5_l = LBOUND(SrcInitOutputData%WaveVel2S,5) - i5_u = UBOUND(SrcInitOutputData%WaveVel2S,5) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2S)) THEN - ALLOCATE(DstInitOutputData%WaveVel2S(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%WaveVel2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel2S = SrcInitOutputData%WaveVel2S -ENDIF - DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 - 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%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 -NULLIFY(InitOutputData%WaveElev2) - 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 ! WaveAcc2D allocated yes/no - IF ( ALLOCATED(InData%WaveAcc2D) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! 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*4 ! 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*5 ! 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*4 ! 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*5 ! 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*5 ! WaveVel2S upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2S) ! WaveVel2S - 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%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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAcc2D,5), UBOUND(InData%WaveAcc2D,5) - DO i4 = LBOUND(InData%WaveAcc2D,4), UBOUND(InData%WaveAcc2D,4) - 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,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%WaveDynP2D,4), UBOUND(InData%WaveDynP2D,4) - DO i3 = LBOUND(InData%WaveDynP2D,3), UBOUND(InData%WaveDynP2D,3) - 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,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAcc2S,5), UBOUND(InData%WaveAcc2S,5) - DO i4 = LBOUND(InData%WaveAcc2S,4), UBOUND(InData%WaveAcc2S,4) - 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,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%WaveDynP2S,4), UBOUND(InData%WaveDynP2S,4) - DO i3 = LBOUND(InData%WaveDynP2S,3), UBOUND(InData%WaveDynP2S,3) - 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,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveVel2D,5), UBOUND(InData%WaveVel2D,5) - DO i4 = LBOUND(InData%WaveVel2D,4), UBOUND(InData%WaveVel2D,4) - 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,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveVel2S,5), UBOUND(InData%WaveVel2S,5) - DO i4 = LBOUND(InData%WaveVel2S,4), UBOUND(InData%WaveVel2S,4) - 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,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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) :: 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_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 ! 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 - 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%WaveAcc2D)) DEALLOCATE(OutData%WaveAcc2D) - ALLOCATE(OutData%WaveAcc2D(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%WaveAcc2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAcc2D,5), UBOUND(OutData%WaveAcc2D,5) - DO i4 = LBOUND(OutData%WaveAcc2D,4), UBOUND(OutData%WaveAcc2D,4) - 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,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 ! 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 - 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%WaveDynP2D)) DEALLOCATE(OutData%WaveDynP2D) - ALLOCATE(OutData%WaveDynP2D(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%WaveDynP2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveDynP2D,4), UBOUND(OutData%WaveDynP2D,4) - DO i3 = LBOUND(OutData%WaveDynP2D,3), UBOUND(OutData%WaveDynP2D,3) - DO i2 = LBOUND(OutData%WaveDynP2D,2), UBOUND(OutData%WaveDynP2D,2) - DO i1 = LBOUND(OutData%WaveDynP2D,1), UBOUND(OutData%WaveDynP2D,1) - OutData%WaveDynP2D(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 ! 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 - 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%WaveAcc2S)) DEALLOCATE(OutData%WaveAcc2S) - ALLOCATE(OutData%WaveAcc2S(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%WaveAcc2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAcc2S,5), UBOUND(OutData%WaveAcc2S,5) - DO i4 = LBOUND(OutData%WaveAcc2S,4), UBOUND(OutData%WaveAcc2S,4) - 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,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 ! 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 - 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%WaveDynP2S)) DEALLOCATE(OutData%WaveDynP2S) - ALLOCATE(OutData%WaveDynP2S(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%WaveDynP2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveDynP2S,4), UBOUND(OutData%WaveDynP2S,4) - DO i3 = LBOUND(OutData%WaveDynP2S,3), UBOUND(OutData%WaveDynP2S,3) - DO i2 = LBOUND(OutData%WaveDynP2S,2), UBOUND(OutData%WaveDynP2S,2) - DO i1 = LBOUND(OutData%WaveDynP2S,1), UBOUND(OutData%WaveDynP2S,1) - OutData%WaveDynP2S(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 ! 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 - 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%WaveVel2D)) DEALLOCATE(OutData%WaveVel2D) - ALLOCATE(OutData%WaveVel2D(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%WaveVel2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveVel2D,5), UBOUND(OutData%WaveVel2D,5) - DO i4 = LBOUND(OutData%WaveVel2D,4), UBOUND(OutData%WaveVel2D,4) - 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,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 ! 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 - 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%WaveVel2S)) DEALLOCATE(OutData%WaveVel2S) - ALLOCATE(OutData%WaveVel2S(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%WaveVel2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveVel2S,5), UBOUND(OutData%WaveVel2S,5) - DO i4 = LBOUND(OutData%WaveVel2S,4), UBOUND(OutData%WaveVel2S,4) - 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,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - NULLIFY(OutData%WaveElev2) - END SUBROUTINE Waves2_UnPackInitOutput - - 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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyParam' -! + ErrMsg = '' + 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 + DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr + DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 + DstInitInputData%WaveTime => SrcInitInputData%WaveTime + DstInitInputData%nGrid = SrcInitInputData%nGrid + DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid + DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid + if (allocated(SrcInitInputData%WaveKinGridxi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi) + if (.not. allocated(DstInitInputData%WaveKinGridxi)) then + allocate(DstInitInputData%WaveKinGridxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi + end if + if (allocated(SrcInitInputData%WaveKinGridyi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi) + if (.not. allocated(DstInitInputData%WaveKinGridyi)) then + allocate(DstInitInputData%WaveKinGridyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi + end if + if (allocated(SrcInitInputData%WaveKinGridzi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) + if (.not. allocated(DstInitInputData%WaveKinGridzi)) then + allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi + end if + DstInitInputData%WvDiffQTFF = SrcInitInputData%WvDiffQTFF + DstInitInputData%WvSumQTFF = SrcInitInputData%WvSumQTFF + DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD + DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD + DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS + DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS +end subroutine + +subroutine Waves2_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Waves2_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Waves2_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%WvDiffQTFF = SrcParamData%WvDiffQTFF - DstParamData%WvSumQTFF = SrcParamData%WvSumQTFF - 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 = "" - - 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 - Int_BufSz = Int_BufSz + 1 ! WvDiffQTFF - Int_BufSz = Int_BufSz + 1 ! WvSumQTFF - 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) = TRANSFER(InData%WvDiffQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WvSumQTFF, IntKiBuf(1)) - 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) :: 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%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 - END SUBROUTINE Waves2_UnPackParam - + ErrMsg = '' + nullify(InitInputData%WaveDirArr) + nullify(InitInputData%WaveElevC0) + nullify(InitInputData%WaveTime) + if (allocated(InitInputData%WaveKinGridxi)) then + deallocate(InitInputData%WaveKinGridxi) + end if + if (allocated(InitInputData%WaveKinGridyi)) then + deallocate(InitInputData%WaveKinGridyi) + end if + if (allocated(InitInputData%WaveKinGridzi)) then + deallocate(InitInputData%WaveKinGridzi) + end if +end subroutine + +subroutine Waves2_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Waves2_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Waves2_PackInitInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%WtrDens) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, InData%NStepWave2) + call RegPack(Buf, InData%WaveDOmega) + call RegPack(Buf, InData%WaveStMod) + call RegPack(Buf, InData%WaveMultiDir) + call RegPack(Buf, associated(InData%WaveDirArr)) + if (associated(InData%WaveDirArr)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) + call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDirArr) + end if + end if + call RegPack(Buf, associated(InData%WaveElevC0)) + if (associated(InData%WaveElevC0)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC0) + end if + end if + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + call RegPack(Buf, InData%nGrid) + call RegPack(Buf, InData%NWaveElevGrid) + call RegPack(Buf, InData%NWaveKinGrid) + call RegPack(Buf, allocated(InData%WaveKinGridxi)) + if (allocated(InData%WaveKinGridxi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridxi), ubound(InData%WaveKinGridxi)) + call RegPack(Buf, InData%WaveKinGridxi) + end if + call RegPack(Buf, allocated(InData%WaveKinGridyi)) + if (allocated(InData%WaveKinGridyi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridyi), ubound(InData%WaveKinGridyi)) + call RegPack(Buf, InData%WaveKinGridyi) + end if + call RegPack(Buf, allocated(InData%WaveKinGridzi)) + if (allocated(InData%WaveKinGridzi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) + call RegPack(Buf, InData%WaveKinGridzi) + end if + call RegPack(Buf, InData%WvDiffQTFF) + call RegPack(Buf, InData%WvSumQTFF) + call RegPack(Buf, InData%WvLowCOffD) + call RegPack(Buf, InData%WvHiCOffD) + call RegPack(Buf, InData%WvLowCOffS) + call RegPack(Buf, InData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Waves2_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Waves2_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Waves2_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) + OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr + else + allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) + call RegUnpack(Buf, OutData%WaveDirArr) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDirArr => null() + end if + if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) + OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 + else + allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) + call RegUnpack(Buf, OutData%WaveElevC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC0 => null() + end if + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + call RegUnpack(Buf, OutData%nGrid) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NWaveElevGrid) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NWaveKinGrid) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WaveKinGridxi)) deallocate(OutData%WaveKinGridxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinGridxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinGridxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveKinGridyi)) deallocate(OutData%WaveKinGridyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinGridyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinGridyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveKinGridzi)) deallocate(OutData%WaveKinGridzi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinGridzi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinGridzi) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%WvDiffQTFF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvSumQTFF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOffD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOffD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOffS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Waves2_InitOutputType), intent(in) :: SrcInitOutputData + type(Waves2_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Waves2_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WaveAcc2D)) then + LB(1:5) = lbound(SrcInitOutputData%WaveAcc2D) + UB(1:5) = ubound(SrcInitOutputData%WaveAcc2D) + if (.not. allocated(DstInitOutputData%WaveAcc2D)) then + allocate(DstInitOutputData%WaveAcc2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2D.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveAcc2D = SrcInitOutputData%WaveAcc2D + end if + if (allocated(SrcInitOutputData%WaveDynP2D)) then + LB(1:4) = lbound(SrcInitOutputData%WaveDynP2D) + UB(1:4) = ubound(SrcInitOutputData%WaveDynP2D) + if (.not. allocated(DstInitOutputData%WaveDynP2D)) then + allocate(DstInitOutputData%WaveDynP2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2D.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveDynP2D = SrcInitOutputData%WaveDynP2D + end if + if (allocated(SrcInitOutputData%WaveAcc2S)) then + LB(1:5) = lbound(SrcInitOutputData%WaveAcc2S) + UB(1:5) = ubound(SrcInitOutputData%WaveAcc2S) + if (.not. allocated(DstInitOutputData%WaveAcc2S)) then + allocate(DstInitOutputData%WaveAcc2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2S.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveAcc2S = SrcInitOutputData%WaveAcc2S + end if + if (allocated(SrcInitOutputData%WaveDynP2S)) then + LB(1:4) = lbound(SrcInitOutputData%WaveDynP2S) + UB(1:4) = ubound(SrcInitOutputData%WaveDynP2S) + if (.not. allocated(DstInitOutputData%WaveDynP2S)) then + allocate(DstInitOutputData%WaveDynP2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2S.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveDynP2S = SrcInitOutputData%WaveDynP2S + end if + if (allocated(SrcInitOutputData%WaveVel2D)) then + LB(1:5) = lbound(SrcInitOutputData%WaveVel2D) + UB(1:5) = ubound(SrcInitOutputData%WaveVel2D) + if (.not. allocated(DstInitOutputData%WaveVel2D)) then + allocate(DstInitOutputData%WaveVel2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2D.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveVel2D = SrcInitOutputData%WaveVel2D + end if + if (allocated(SrcInitOutputData%WaveVel2S)) then + LB(1:5) = lbound(SrcInitOutputData%WaveVel2S) + UB(1:5) = ubound(SrcInitOutputData%WaveVel2S) + if (.not. allocated(DstInitOutputData%WaveVel2S)) then + allocate(DstInitOutputData%WaveVel2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2S.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveVel2S = SrcInitOutputData%WaveVel2S + end if + DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 +end subroutine + +subroutine Waves2_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Waves2_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Waves2_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WaveAcc2D)) then + deallocate(InitOutputData%WaveAcc2D) + end if + if (allocated(InitOutputData%WaveDynP2D)) then + deallocate(InitOutputData%WaveDynP2D) + end if + if (allocated(InitOutputData%WaveAcc2S)) then + deallocate(InitOutputData%WaveAcc2S) + end if + if (allocated(InitOutputData%WaveDynP2S)) then + deallocate(InitOutputData%WaveDynP2S) + end if + if (allocated(InitOutputData%WaveVel2D)) then + deallocate(InitOutputData%WaveVel2D) + end if + if (allocated(InitOutputData%WaveVel2S)) then + deallocate(InitOutputData%WaveVel2S) + end if + nullify(InitOutputData%WaveElev2) +end subroutine + +subroutine Waves2_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Waves2_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Waves2_PackInitOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WaveAcc2D)) + if (allocated(InData%WaveAcc2D)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAcc2D), ubound(InData%WaveAcc2D)) + call RegPack(Buf, InData%WaveAcc2D) + end if + call RegPack(Buf, allocated(InData%WaveDynP2D)) + if (allocated(InData%WaveDynP2D)) then + call RegPackBounds(Buf, 4, lbound(InData%WaveDynP2D), ubound(InData%WaveDynP2D)) + call RegPack(Buf, InData%WaveDynP2D) + end if + call RegPack(Buf, allocated(InData%WaveAcc2S)) + if (allocated(InData%WaveAcc2S)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAcc2S), ubound(InData%WaveAcc2S)) + call RegPack(Buf, InData%WaveAcc2S) + end if + call RegPack(Buf, allocated(InData%WaveDynP2S)) + if (allocated(InData%WaveDynP2S)) then + call RegPackBounds(Buf, 4, lbound(InData%WaveDynP2S), ubound(InData%WaveDynP2S)) + call RegPack(Buf, InData%WaveDynP2S) + end if + call RegPack(Buf, allocated(InData%WaveVel2D)) + if (allocated(InData%WaveVel2D)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveVel2D), ubound(InData%WaveVel2D)) + call RegPack(Buf, InData%WaveVel2D) + end if + call RegPack(Buf, allocated(InData%WaveVel2S)) + if (allocated(InData%WaveVel2S)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveVel2S), ubound(InData%WaveVel2S)) + call RegPack(Buf, InData%WaveVel2S) + end if + call RegPack(Buf, associated(InData%WaveElev2)) + if (associated(InData%WaveElev2)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) + call RegPackPointer(Buf, c_loc(InData%WaveElev2), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev2) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Waves2_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Waves2_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Waves2_UnPackInitOutput' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WaveAcc2D)) deallocate(OutData%WaveAcc2D) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveAcc2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveAcc2D) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveDynP2D)) deallocate(OutData%WaveDynP2D) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveDynP2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveDynP2D) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveAcc2S)) deallocate(OutData%WaveAcc2S) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveAcc2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2S.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveAcc2S) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveDynP2S)) deallocate(OutData%WaveDynP2S) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveDynP2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveDynP2S) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveVel2D)) deallocate(OutData%WaveVel2D) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveVel2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveVel2D) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveVel2S)) deallocate(OutData%WaveVel2S) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveVel2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2S.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveVel2S) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (associated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev2, UB(1:3)-LB(1:3)) + OutData%WaveElev2(LB(1):,LB(2):,LB(3):) => OutData%WaveElev2 + else + allocate(OutData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev2) + call RegUnpack(Buf, OutData%WaveElev2) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev2 => null() + end if +end subroutine + +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 + character(*), parameter :: RoutineName = 'Waves2_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%WvDiffQTFF = SrcParamData%WvDiffQTFF + DstParamData%WvSumQTFF = SrcParamData%WvSumQTFF +end subroutine + +subroutine Waves2_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Waves2_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Waves2_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Waves2_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Waves2_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Waves2_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%WvDiffQTFF) + call RegPack(Buf, InData%WvSumQTFF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Waves2_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Waves2_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Waves2_UnPackParam' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%WvDiffQTFF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvSumQTFF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE Waves2_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 2384e74cb7..ba7d81ef96 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -38,49 +38,49 @@ MODULE Waves_Types 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 [-] - REAL(ReKi) :: Gravity !< Gravitational acceleration [(m/s^2)] - INTEGER(IntKi) , DIMENSION(1:3) :: nGrid !< Grid dimensions [-] - 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 } [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [(m/s^2)] + INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] + REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< 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 = 0.0_R4Ki !< 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 = 0.0_R4Ki !< Mean incident wave propagation heading direction [(degrees)] + INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] + LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] + INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] + REAL(SiKi) :: WaveDirSpread = 0.0_R4Ki !< Spreading coefficient [WaveMod=2,3,4 and WaveDirMod=1] [-] + REAL(SiKi) :: WaveDirRange = 0.0_R4Ki !< Range of wave directions (full range: WaveDir +/- WaveDirRange/2) [only used if WaveMod=6] [(degrees)] + REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Time step for incident wave calculations [(sec)] + REAL(SiKi) :: WaveHs = 0.0_R4Ki !< Significant wave height of incident waves [(meters)] + INTEGER(IntKi) :: WaveMod = 0_IntKi !< 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] [-] + LOGICAL :: WaveNDAmp = .false. !< Flag for normally-distributed amplitudes in incident waves spectrum [flag] [-] + REAL(SiKi) :: WavePhase = 0.0_R4Ki !< Specified phase for regular waves [(radians)] + REAL(SiKi) :: WavePkShp = 0.0_R4Ki !< 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(ReKi) :: WtrDens !< Water density [(kg/m^3)] - REAL(ReKi) :: WtrDpth !< Water depth [(meters)] - INTEGER(IntKi) :: NWaveElevGrid !< Number of grid points where the incident wave elevations are computed (the XY grid point locations) [-] - INTEGER(IntKi) :: NWaveKinGrid !< Number of grid points where the incident wave kinematics will be computed [-] + INTEGER(IntKi) , DIMENSION(1:2) :: WaveSeed = 0_IntKi !< Random seeds of incident waves [-2147483648 to 2147483647] [-] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< 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 = 0.0_R8Ki !< 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 = 0.0_R4Ki !< Peak spectral period of incident waves [(sec)] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [(kg/m^3)] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(meters)] + INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations are computed (the XY grid point locations) [-] + INTEGER(IntKi) :: NWaveKinGrid = 0_IntKi !< Number of grid points where the incident wave kinematics will be computed [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridxi !< xi-coordinates for grid points where the incident wave kinematics will be computed (grid points); these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridyi !< yi-coordinates for grid points where the incident wave kinematics will be computed (grid points); these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridzi !< zi-coordinates for grid points where the incident wave kinematics will be computed (grid points); 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)] + REAL(SiKi) :: PCurrVxiPz0 = 0.0_R4Ki !< xi-component of the partial derivative of the current velocity at elevation near mean sea level [(m/s)] + REAL(SiKi) :: PCurrVyiPz0 = 0.0_R4Ki !< 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 [-] - INTEGER(IntKi) :: ConstWaveMod !< Mode of the constrained wave [-] - REAL(SiKi) :: CrestHmax !< crest height or double the crest elevation [m] - REAL(SiKi) :: CrestTime !< time of the wave crest [sec] - REAL(SiKi) :: CrestXi !< xi-coordinate for the wave crest [m] - REAL(SiKi) :: CrestYi !< yi-coordinate for the wave crest [m] - REAL(SiKi) :: MCFD !< Diameter of members that will use the MacCamy-Fuchs diffraction model [-] - INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] - REAL(ReKi) :: PtfmLocationX !< Supplied by Driver: X coordinate of platform location in the wave field [m] - REAL(ReKi) :: PtfmLocationY !< Supplied by Driver: Y coordinate of platform location in the wave field [m] + INTEGER(IntKi) :: ConstWaveMod = 0_IntKi !< Mode of the constrained wave [-] + REAL(SiKi) :: CrestHmax = 0.0_R4Ki !< crest height or double the crest elevation [m] + REAL(SiKi) :: CrestTime = 0.0_R4Ki !< time of the wave crest [sec] + REAL(SiKi) :: CrestXi = 0.0_R4Ki !< xi-coordinate for the wave crest [m] + REAL(SiKi) :: CrestYi = 0.0_R4Ki !< yi-coordinate for the wave crest [m] + REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of members that will use the MacCamy-Fuchs diffraction model [-] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + REAL(ReKi) :: PtfmLocationX = 0.0_ReKi !< Supplied by Driver: X coordinate of platform location in the wave field [m] + REAL(ReKi) :: PtfmLocationY = 0.0_ReKi !< Supplied by Driver: Y coordinate of platform location in the wave field [m] END TYPE Waves_InitInputType ! ======================= ! ========= Waves_InitOutputType ======= @@ -88,10 +88,10 @@ MODULE Waves_Types 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 :: 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)] - INTEGER(IntKi) :: WaveNDir !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] - REAL(SiKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] + REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] + REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] + INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] + REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: WaveDynP => NULL() !< Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] @@ -103,1112 +103,943 @@ MODULE Waves_Types REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev => NULL() !< Instantaneous elevation time-series of incident waves at each of the XY grid points [(meters)] 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 [(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)] - 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 [-] + REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< 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) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] + INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] END TYPE Waves_InitOutputType ! ======================= 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) :: 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%Gravity = SrcInitInputData%Gravity - DstInitInputData%nGrid = SrcInitInputData%nGrid - 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%NWaveElevGrid = SrcInitInputData%NWaveElevGrid - DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid -IF (ALLOCATED(SrcInitInputData%WaveKinGridxi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinGridxi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinGridxi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinGridxi)) THEN - ALLOCATE(DstInitInputData%WaveKinGridxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinGridyi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinGridyi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinGridyi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinGridyi)) THEN - ALLOCATE(DstInitInputData%WaveKinGridyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinGridzi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinGridzi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinGridzi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinGridzi)) THEN - ALLOCATE(DstInitInputData%WaveKinGridzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi -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 - DstInitInputData%ConstWaveMod = SrcInitInputData%ConstWaveMod - DstInitInputData%CrestHmax = SrcInitInputData%CrestHmax - DstInitInputData%CrestTime = SrcInitInputData%CrestTime - DstInitInputData%CrestXi = SrcInitInputData%CrestXi - DstInitInputData%CrestYi = SrcInitInputData%CrestYi - DstInitInputData%MCFD = SrcInitInputData%MCFD - DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod - DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX - DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY - 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%WaveKinGridxi)) THEN - DEALLOCATE(InitInputData%WaveKinGridxi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinGridyi)) THEN - DEALLOCATE(InitInputData%WaveKinGridyi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinGridzi)) THEN - DEALLOCATE(InitInputData%WaveKinGridzi) -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 - Re_BufSz = Re_BufSz + 1 ! Gravity - Int_BufSz = Int_BufSz + SIZE(InData%nGrid) ! nGrid - 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 ! NWaveElevGrid - Int_BufSz = Int_BufSz + 1 ! NWaveKinGrid - Int_BufSz = Int_BufSz + 1 ! WaveKinGridxi allocated yes/no - IF ( ALLOCATED(InData%WaveKinGridxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinGridxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinGridxi) ! WaveKinGridxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinGridyi allocated yes/no - IF ( ALLOCATED(InData%WaveKinGridyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinGridyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinGridyi) ! WaveKinGridyi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinGridzi allocated yes/no - IF ( ALLOCATED(InData%WaveKinGridzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinGridzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinGridzi) ! WaveKinGridzi - 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 - Int_BufSz = Int_BufSz + 1 ! ConstWaveMod - Re_BufSz = Re_BufSz + 1 ! CrestHmax - Re_BufSz = Re_BufSz + 1 ! CrestTime - Re_BufSz = Re_BufSz + 1 ! CrestXi - Re_BufSz = Re_BufSz + 1 ! CrestYi - Re_BufSz = Re_BufSz + 1 ! MCFD - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Re_BufSz = Re_BufSz + 1 ! PtfmLocationX - Re_BufSz = Re_BufSz + 1 ! PtfmLocationY - 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 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%nGrid,1), UBOUND(InData%nGrid,1) - IntKiBuf(Int_Xferred) = InData%nGrid(i1) - Int_Xferred = Int_Xferred + 1 - END DO - 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%NWaveElevGrid - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWaveKinGrid - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveKinGridxi) ) 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%WaveKinGridxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinGridxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinGridxi,1), UBOUND(InData%WaveKinGridxi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinGridxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinGridyi) ) 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%WaveKinGridyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinGridyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinGridyi,1), UBOUND(InData%WaveKinGridyi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinGridyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinGridzi) ) 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%WaveKinGridzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinGridzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinGridzi,1), UBOUND(InData%WaveKinGridzi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinGridzi(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 - IntKiBuf(Int_Xferred) = InData%ConstWaveMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CrestHmax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CrestTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CrestXi - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CrestYi - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MCFD - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationY - Re_Xferred = Re_Xferred + 1 - 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) :: 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%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%nGrid,1) - i1_u = UBOUND(OutData%nGrid,1) - DO i1 = LBOUND(OutData%nGrid,1), UBOUND(OutData%nGrid,1) - OutData%nGrid(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - 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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NWaveElevGrid = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveKinGrid = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinGridxi 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%WaveKinGridxi)) DEALLOCATE(OutData%WaveKinGridxi) - ALLOCATE(OutData%WaveKinGridxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinGridxi,1), UBOUND(OutData%WaveKinGridxi,1) - OutData%WaveKinGridxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinGridyi 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%WaveKinGridyi)) DEALLOCATE(OutData%WaveKinGridyi) - ALLOCATE(OutData%WaveKinGridyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinGridyi,1), UBOUND(OutData%WaveKinGridyi,1) - OutData%WaveKinGridyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinGridzi 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%WaveKinGridzi)) DEALLOCATE(OutData%WaveKinGridzi) - ALLOCATE(OutData%WaveKinGridzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinGridzi,1), UBOUND(OutData%WaveKinGridzi,1) - OutData%WaveKinGridzi(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) - OutData%ConstWaveMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CrestHmax = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CrestTime = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CrestXi = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CrestYi = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%MCFD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmLocationX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmLocationY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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) :: 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_CopyInitOutput' -! +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 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Waves_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - 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%WaveDirArr => SrcInitOutputData%WaveDirArr - DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin - DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax - DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir - DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega - DstInitOutputData%WaveDynP => SrcInitOutputData%WaveDynP - DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc - DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF - DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel - 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) - 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%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 ) - 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' + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%DirRoot = SrcInitInputData%DirRoot + DstInitInputData%WvKinFile = SrcInitInputData%WvKinFile + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%nGrid = SrcInitInputData%nGrid + 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%NWaveElevGrid = SrcInitInputData%NWaveElevGrid + DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid + if (allocated(SrcInitInputData%WaveKinGridxi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi) + if (.not. allocated(DstInitInputData%WaveKinGridxi)) then + allocate(DstInitInputData%WaveKinGridxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi + end if + if (allocated(SrcInitInputData%WaveKinGridyi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi) + if (.not. allocated(DstInitInputData%WaveKinGridyi)) then + allocate(DstInitInputData%WaveKinGridyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi + end if + if (allocated(SrcInitInputData%WaveKinGridzi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) + if (.not. allocated(DstInitInputData%WaveKinGridzi)) then + allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi + end if + if (allocated(SrcInitInputData%CurrVxi)) then + LB(1:1) = lbound(SrcInitInputData%CurrVxi) + UB(1:1) = ubound(SrcInitInputData%CurrVxi) + if (.not. allocated(DstInitInputData%CurrVxi)) then + allocate(DstInitInputData%CurrVxi(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitInputData%CurrVyi)) then + LB(1:1) = lbound(SrcInitInputData%CurrVyi) + UB(1:1) = ubound(SrcInitInputData%CurrVyi) + if (.not. allocated(DstInitInputData%CurrVyi)) then + allocate(DstInitInputData%CurrVyi(LB(1):UB(1)), 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 + end if + 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 + DstInitInputData%ConstWaveMod = SrcInitInputData%ConstWaveMod + DstInitInputData%CrestHmax = SrcInitInputData%CrestHmax + DstInitInputData%CrestTime = SrcInitInputData%CrestTime + DstInitInputData%CrestXi = SrcInitInputData%CrestXi + DstInitInputData%CrestYi = SrcInitInputData%CrestYi + DstInitInputData%MCFD = SrcInitInputData%MCFD + DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod + DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX + DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY +end subroutine - ErrStat = ErrID_None - ErrMsg = "" - -NULLIFY(InitOutputData%WaveElevC0) -IF (ALLOCATED(InitOutputData%WaveElevC)) THEN - DEALLOCATE(InitOutputData%WaveElevC) -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 -NULLIFY(InitOutputData%WaveTime) - 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 ! 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 - Int_BufSz = Int_BufSz + 1 ! WaveNDir - 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 - Db_BufSz = Db_BufSz + 1 ! WaveTMax - 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) +subroutine Waves_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Waves_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Waves_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%WaveKinGridxi)) then + deallocate(InitInputData%WaveKinGridxi) + end if + if (allocated(InitInputData%WaveKinGridyi)) then + deallocate(InitInputData%WaveKinGridyi) + end if + if (allocated(InitInputData%WaveKinGridzi)) then + deallocate(InitInputData%WaveKinGridzi) + end if + if (allocated(InitInputData%CurrVxi)) then + deallocate(InitInputData%CurrVxi) + end if + if (allocated(InitInputData%CurrVyi)) then + deallocate(InitInputData%CurrVyi) + end if + call NWTC_Library_DestroyNWTC_RandomNumber_ParameterType(InitInputData%RNG, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 +subroutine Waves_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Waves_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Waves_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%DirRoot) + call RegPack(Buf, InData%WvKinFile) + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%nGrid) + call RegPack(Buf, InData%WvLowCOff) + call RegPack(Buf, InData%WvHiCOff) + call RegPack(Buf, InData%WaveDir) + call RegPack(Buf, InData%WaveNDir) + call RegPack(Buf, InData%WaveMultiDir) + call RegPack(Buf, InData%WaveDirMod) + call RegPack(Buf, InData%WaveDirSpread) + call RegPack(Buf, InData%WaveDirRange) + call RegPack(Buf, InData%WaveDT) + call RegPack(Buf, InData%WaveHs) + call RegPack(Buf, InData%WaveMod) + call RegPack(Buf, InData%WaveModChr) + call RegPack(Buf, InData%WaveNDAmp) + call RegPack(Buf, InData%WavePhase) + call RegPack(Buf, InData%WavePkShp) + call RegPack(Buf, InData%WavePkShpChr) + call RegPack(Buf, InData%WaveSeed) + call RegPack(Buf, InData%WaveStMod) + call RegPack(Buf, InData%WaveTMax) + call RegPack(Buf, InData%WaveTp) + call RegPack(Buf, InData%WtrDens) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%NWaveElevGrid) + call RegPack(Buf, InData%NWaveKinGrid) + call RegPack(Buf, allocated(InData%WaveKinGridxi)) + if (allocated(InData%WaveKinGridxi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridxi), ubound(InData%WaveKinGridxi)) + call RegPack(Buf, InData%WaveKinGridxi) + end if + call RegPack(Buf, allocated(InData%WaveKinGridyi)) + if (allocated(InData%WaveKinGridyi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridyi), ubound(InData%WaveKinGridyi)) + call RegPack(Buf, InData%WaveKinGridyi) + end if + call RegPack(Buf, allocated(InData%WaveKinGridzi)) + if (allocated(InData%WaveKinGridzi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) + call RegPack(Buf, InData%WaveKinGridzi) + end if + call RegPack(Buf, allocated(InData%CurrVxi)) + if (allocated(InData%CurrVxi)) then + call RegPackBounds(Buf, 1, lbound(InData%CurrVxi), ubound(InData%CurrVxi)) + call RegPack(Buf, InData%CurrVxi) + end if + call RegPack(Buf, allocated(InData%CurrVyi)) + if (allocated(InData%CurrVyi)) then + call RegPackBounds(Buf, 1, lbound(InData%CurrVyi), ubound(InData%CurrVyi)) + call RegPack(Buf, InData%CurrVyi) + end if + call RegPack(Buf, InData%PCurrVxiPz0) + call RegPack(Buf, InData%PCurrVyiPz0) + call NWTC_Library_PackNWTC_RandomNumber_ParameterType(Buf, InData%RNG) + call RegPack(Buf, InData%ConstWaveMod) + call RegPack(Buf, InData%CrestHmax) + call RegPack(Buf, InData%CrestTime) + call RegPack(Buf, InData%CrestXi) + call RegPack(Buf, InData%CrestYi) + call RegPack(Buf, InData%MCFD) + call RegPack(Buf, InData%WaveFieldMod) + call RegPack(Buf, InData%PtfmLocationX) + call RegPack(Buf, InData%PtfmLocationY) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine - 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 +subroutine Waves_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Waves_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Waves_UnPackInitInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DirRoot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvKinFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nGrid) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveNDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDirMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDirSpread) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDirRange) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveHs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveModChr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveNDAmp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WavePhase) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WavePkShp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WavePkShpChr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveSeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveTMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveTp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NWaveElevGrid) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NWaveKinGrid) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%WaveKinGridxi)) deallocate(OutData%WaveKinGridxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinGridxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinGridxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveKinGridyi)) deallocate(OutData%WaveKinGridyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinGridyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinGridyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WaveKinGridzi)) deallocate(OutData%WaveKinGridzi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinGridzi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinGridzi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CurrVxi)) deallocate(OutData%CurrVxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CurrVxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CurrVxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CurrVyi)) deallocate(OutData%CurrVyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CurrVyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CurrVyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%PCurrVxiPz0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PCurrVyiPz0) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackNWTC_RandomNumber_ParameterType(Buf, OutData%RNG) ! RNG + call RegUnpack(Buf, OutData%ConstWaveMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CrestHmax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CrestTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CrestXi) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CrestYi) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MCFD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmLocationX) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmLocationY) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine - 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 - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveNDir - 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 +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 + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Waves_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitOutputData%WaveElevC0 => SrcInitOutputData%WaveElevC0 + if (allocated(SrcInitOutputData%WaveElevC)) then + LB(1:3) = lbound(SrcInitOutputData%WaveElevC) + UB(1:3) = ubound(SrcInitOutputData%WaveElevC) + if (.not. allocated(DstInitOutputData%WaveElevC)) then + allocate(DstInitOutputData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), 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 + end if + DstInitOutputData%WaveDirArr => SrcInitOutputData%WaveDirArr + DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin + DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax + DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir + DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega + DstInitOutputData%WaveDynP => SrcInitOutputData%WaveDynP + DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc + DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF + DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel + 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 + LB(1:1) = lbound(SrcInitOutputData%WaveElev0) + UB(1:1) = ubound(SrcInitOutputData%WaveElev0) + if (.not. allocated(DstInitOutputData%WaveElev0)) then + allocate(DstInitOutputData%WaveElev0(LB(1):UB(1)), 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 + end if + DstInitOutputData%WaveTime => SrcInitOutputData%WaveTime + DstInitOutputData%WaveTMax = SrcInitOutputData%WaveTMax + DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg + DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave + DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 +end subroutine - 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 - DbKiBuf(Db_Xferred) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 - 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_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Waves_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Waves_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + nullify(InitOutputData%WaveElevC0) + if (allocated(InitOutputData%WaveElevC)) then + deallocate(InitOutputData%WaveElevC) + end if + 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) + end if + nullify(InitOutputData%WaveTime) +end subroutine - 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) :: 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_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 - 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%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%WaveNDir = IntKiBuf(Int_Xferred) - 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%WaveElev) - 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%WaveTime) - OutData%WaveTMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - 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_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Waves_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Waves_PackInitOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, associated(InData%WaveElevC0)) + if (associated(InData%WaveElevC0)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC0) + end if + end if + call RegPack(Buf, allocated(InData%WaveElevC)) + if (allocated(InData%WaveElevC)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) + call RegPack(Buf, InData%WaveElevC) + end if + call RegPack(Buf, associated(InData%WaveDirArr)) + if (associated(InData%WaveDirArr)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) + call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDirArr) + end if + end if + call RegPack(Buf, InData%WaveDirMin) + call RegPack(Buf, InData%WaveDirMax) + call RegPack(Buf, InData%WaveNDir) + call RegPack(Buf, InData%WaveDOmega) + call RegPack(Buf, associated(InData%WaveDynP)) + if (associated(InData%WaveDynP)) then + call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) + call RegPackPointer(Buf, c_loc(InData%WaveDynP), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDynP) + end if + end if + call RegPack(Buf, associated(InData%WaveAcc)) + if (associated(InData%WaveAcc)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) + call RegPackPointer(Buf, c_loc(InData%WaveAcc), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveAcc) + end if + end if + call RegPack(Buf, associated(InData%WaveAccMCF)) + if (associated(InData%WaveAccMCF)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) + call RegPackPointer(Buf, c_loc(InData%WaveAccMCF), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveAccMCF) + end if + end if + call RegPack(Buf, associated(InData%WaveVel)) + if (associated(InData%WaveVel)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) + call RegPackPointer(Buf, c_loc(InData%WaveVel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveVel) + end if + end if + call RegPack(Buf, associated(InData%PWaveDynP0)) + if (associated(InData%PWaveDynP0)) then + call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) + call RegPackPointer(Buf, c_loc(InData%PWaveDynP0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveDynP0) + end if + end if + call RegPack(Buf, associated(InData%PWaveAcc0)) + if (associated(InData%PWaveAcc0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) + call RegPackPointer(Buf, c_loc(InData%PWaveAcc0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveAcc0) + end if + end if + call RegPack(Buf, associated(InData%PWaveAccMCF0)) + if (associated(InData%PWaveAccMCF0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) + call RegPackPointer(Buf, c_loc(InData%PWaveAccMCF0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveAccMCF0) + end if + end if + call RegPack(Buf, associated(InData%PWaveVel0)) + if (associated(InData%PWaveVel0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) + call RegPackPointer(Buf, c_loc(InData%PWaveVel0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveVel0) + end if + end if + call RegPack(Buf, associated(InData%WaveElev)) + if (associated(InData%WaveElev)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev), ubound(InData%WaveElev)) + call RegPackPointer(Buf, c_loc(InData%WaveElev), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev) + end if + end if + call RegPack(Buf, allocated(InData%WaveElev0)) + if (allocated(InData%WaveElev0)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) + call RegPack(Buf, InData%WaveElev0) + end if + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + call RegPack(Buf, InData%WaveTMax) + call RegPack(Buf, InData%RhoXg) + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, InData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine Waves_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Waves_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Waves_UnPackInitOutput' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) + OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 + else + allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) + call RegUnpack(Buf, OutData%WaveElevC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC0 => null() + end if + if (allocated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) + OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr + else + allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) + call RegUnpack(Buf, OutData%WaveDirArr) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDirArr => null() + end if + call RegUnpack(Buf, OutData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveNDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDynP, UB(1:4)-LB(1:4)) + OutData%WaveDynP(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%WaveDynP + else + allocate(OutData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDynP) + call RegUnpack(Buf, OutData%WaveDynP) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDynP => null() + end if + if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveAcc, UB(1:5)-LB(1:5)) + OutData%WaveAcc(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAcc + else + allocate(OutData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAcc) + call RegUnpack(Buf, OutData%WaveAcc) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveAcc => null() + end if + if (associated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveAccMCF, UB(1:5)-LB(1:5)) + OutData%WaveAccMCF(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAccMCF + else + allocate(OutData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAccMCF) + call RegUnpack(Buf, OutData%WaveAccMCF) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveAccMCF => null() + end if + if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveVel, UB(1:5)-LB(1:5)) + OutData%WaveVel(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveVel + else + allocate(OutData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveVel) + call RegUnpack(Buf, OutData%WaveVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveVel => null() + end if + if (associated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveDynP0, UB(1:3)-LB(1:3)) + OutData%PWaveDynP0(LB(1):,LB(2):,LB(3):) => OutData%PWaveDynP0 + else + allocate(OutData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveDynP0) + call RegUnpack(Buf, OutData%PWaveDynP0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveDynP0 => null() + end if + if (associated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveAcc0, UB(1:4)-LB(1:4)) + OutData%PWaveAcc0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAcc0 + else + allocate(OutData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAcc0) + call RegUnpack(Buf, OutData%PWaveAcc0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveAcc0 => null() + end if + if (associated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveAccMCF0, UB(1:4)-LB(1:4)) + OutData%PWaveAccMCF0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAccMCF0 + else + allocate(OutData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAccMCF0) + call RegUnpack(Buf, OutData%PWaveAccMCF0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveAccMCF0 => null() + end if + if (associated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveVel0, UB(1:4)-LB(1:4)) + OutData%PWaveVel0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveVel0 + else + allocate(OutData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveVel0) + call RegUnpack(Buf, OutData%PWaveVel0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveVel0 => null() + end if + if (associated(OutData%WaveElev)) deallocate(OutData%WaveElev) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev, UB(1:3)-LB(1:3)) + OutData%WaveElev(LB(1):,LB(2):,LB(3):) => OutData%WaveElev + else + allocate(OutData%WaveElev(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev) + call RegUnpack(Buf, OutData%WaveElev) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev => null() + end if + if (allocated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + call RegUnpack(Buf, OutData%WaveTMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RhoXg) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE Waves_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 8c398b1638..59e61da949 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -38,51 +38,51 @@ MODULE ServoDyn_Types TYPE, PUBLIC :: SrvD_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - INTEGER(IntKi) :: NumBl !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades on the turbine [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInit !< Initial blade pitch [-] - REAL(ReKi) , DIMENSION(1:3) :: Gravity !< Gravitational acceleration vector [m/s^2] - REAL(ReKi) , DIMENSION(1:3) :: NacRefPos !< nacelle origin for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3) :: NacTransDisp !< nacelle displacement from origin at init for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacOrient !< nacelle orientation for setting up mesh [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacRefOrient !< nacelle reference orientation for setting up mesh [-] - REAL(ReKi) , DIMENSION(1:3) :: TwrBaseRefPos !< tower base origin for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3) :: TwrBaseTransDisp !< tower base translation from origin at init for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseOrient !< tower base orientation for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseRefOrient !< tower reference orientation for setting up mesh [m] - REAL(ReKi) , DIMENSION(1:3) :: PtfmRefPos !< platform origin for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3) :: PtfmTransDisp !< platform displacement from origin for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: PtfmOrient !< platform orientation for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: PtfmRefOrient !< platform reference orientation for setting up mesh [m] - REAL(DbKi) :: Tmax !< max time from glue code [s] - REAL(ReKi) :: AvgWindSpeed !< average wind speed for the simulation [m/s] - REAL(ReKi) :: AirDens !< air density [kg/m^3] - INTEGER(IntKi) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2Ctrl !< number of turbine specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumCtrl2SC !< number of controller outputs [to supercontroller] [-] - INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] - REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] - REAL(ReKi) :: RotSpeedRef !< Reference rotor speed [rad/s] + REAL(ReKi) , DIMENSION(1:3) :: Gravity = 0.0_ReKi !< Gravitational acceleration vector [m/s^2] + REAL(ReKi) , DIMENSION(1:3) :: NacRefPos = 0.0_ReKi !< nacelle origin for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3) :: NacTransDisp = 0.0_R8Ki !< nacelle displacement from origin at init for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacOrient = 0.0_R8Ki !< nacelle orientation for setting up mesh [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacRefOrient = 0.0_R8Ki !< nacelle reference orientation for setting up mesh [-] + REAL(ReKi) , DIMENSION(1:3) :: TwrBaseRefPos = 0.0_ReKi !< tower base origin for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3) :: TwrBaseTransDisp = 0.0_R8Ki !< tower base translation from origin at init for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseOrient = 0.0_R8Ki !< tower base orientation for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseRefOrient = 0.0_R8Ki !< tower reference orientation for setting up mesh [m] + REAL(ReKi) , DIMENSION(1:3) :: PtfmRefPos = 0.0_ReKi !< platform origin for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3) :: PtfmTransDisp = 0.0_R8Ki !< platform displacement from origin for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: PtfmOrient = 0.0_R8Ki !< platform orientation for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: PtfmRefOrient = 0.0_R8Ki !< platform reference orientation for setting up mesh [m] + REAL(DbKi) :: Tmax = 0.0_R8Ki !< max time from glue code [s] + REAL(ReKi) :: AvgWindSpeed = 0.0_ReKi !< average wind speed for the simulation [m/s] + REAL(ReKi) :: AirDens = 0.0_ReKi !< air density [kg/m^3] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< number of turbine specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< number of controller outputs [to supercontroller] [-] + INTEGER(IntKi) :: TrimCase = 0_IntKi !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain = 0.0_ReKi !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: RotSpeedRef = 0.0_ReKi !< Reference rotor speed [rad/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BladeRootRefPos !< X-Y-Z reference position of each blade root (3 x NumBlades) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: BladeRootTransDisp !< X-Y-Z translation from reference position at init of each blade root (3 x NumBlades) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: BladeRootOrient !< DCM reference orientation of blade roots (3x3 x NumBlades) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: BladeRootRefOrient !< DCM reference orientation of blade roots (3x3 x NumBlades) [-] LOGICAL :: UseInputFile = .TRUE. !< read input from input file [-] TYPE(FileInfoType) :: PassedPrimaryInputData !< Primary input file as FileInfoType (set by driver/glue code) [-] - INTEGER(IntKi) :: NumCableControl !< Number of cable control channels requested [-] + INTEGER(IntKi) :: NumCableControl = 0_IntKi !< Number of cable control channels requested [-] CHARACTER(64) , DIMENSION(:), ALLOCATABLE :: CableControlRequestor !< Array with text info about which module requested the cable control channel (size of NumCableControl). This is just for diagnostics. [-] - INTEGER(IntKi) :: InterpOrder !< Interpolation order from glue code -- required to set m%u_xStC sizes [-] + INTEGER(IntKi) :: InterpOrder = 0_IntKi !< Interpolation order from glue code -- required to set m%u_xStC sizes [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: fromSCGlob !< Initial global inputs to the controller [from the supercontroller] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: fromSC !< Initial turbine specific inputs to the controller [from the supercontroller] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LidSpeed !< Number of Lidar measurement distances [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsX !< Lidar X direction measurement points [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsY !< Lidar Y direction measurement points [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsZ !< Lidar Z direction measurement points [m] - INTEGER(IntKi) :: SensorType !< Lidar sensor type [-] - INTEGER(IntKi) :: NumBeam !< Number of beams [-] - INTEGER(IntKi) :: NumPulseGate !< Number of pulse gates [-] - REAL(ReKi) :: PulseSpacing !< Distance between range gates [-] - REAL(ReKi) :: URefLid !< Reference average wind speed for the lidar [m/s] + INTEGER(IntKi) :: SensorType = 0_IntKi !< Lidar sensor type [-] + INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of beams [-] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< Number of pulse gates [-] + REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [-] + REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] END TYPE SrvD_InitInputType ! ======================= ! ========= SrvD_InitOutputType ======= @@ -90,8 +90,8 @@ MODULE ServoDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - INTEGER(IntKi) :: CouplingScheme !< Switch that indicates if a particular coupling scheme is required [-] - LOGICAL :: UseHSSBrake !< flag to determine if high-speed shaft brake is potentially used (true=yes) [-] + INTEGER(IntKi) :: CouplingScheme = 0_IntKi !< Switch that indicates if a particular coupling scheme is required [-] + LOGICAL :: UseHSSBrake = .false. !< flag to determine if high-speed shaft brake is potentially used (true=yes) [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the states used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] @@ -104,178 +104,178 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_InputFile ======= TYPE, PUBLIC :: SrvD_InputFile - REAL(DbKi) :: DT !< Communication interval for controllers [s] - LOGICAL :: Echo !< Echo the input file out [-] - INTEGER(IntKi) :: PCMode !< Pitch control mode [-] - REAL(DbKi) :: TPCOn !< Time to enable active pitch control [unused when PCMode=0] [s] - REAL(DbKi) , DIMENSION(1:3) :: TPitManS !< Time to start override pitch maneuver for blade (K) and end standard pitch control [s] - REAL(ReKi) , DIMENSION(1:3) :: PitManRat !< Pitch rates at which override pitch maneuvers head toward final pitch angles [rad/s] - REAL(ReKi) , DIMENSION(1:3) :: BlPitchF !< Blade (K) final pitch for pitch maneuvers [radians] - INTEGER(IntKi) :: VSContrl !< Variable-speed control mode [-] - INTEGER(IntKi) :: GenModel !< Generator model [used only when VSContrl=0] [-] - REAL(ReKi) :: GenEff !< Generator efficiency [ignored by the Thevenin and user-defined generator models] [-] - LOGICAL :: GenTiStr !< Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} [-] - LOGICAL :: GenTiStp !< Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} [-] - REAL(ReKi) :: SpdGenOn !< Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False] [rad/s] - REAL(DbKi) :: TimGenOn !< Time to turn on the generator for a startup [used only when GenTiStr=True] [s] - REAL(DbKi) :: TimGenOf !< Time to turn off the generator [used only when GenTiStp=True] [s] - REAL(ReKi) :: VS_RtGnSp !< Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [rad/s] - REAL(ReKi) :: VS_RtTq !< Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [N-m] - REAL(ReKi) :: VS_Rgn2K !< Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [N-m/(rad/s)^2] - REAL(ReKi) :: VS_SlPc !< Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1] [-] - REAL(ReKi) :: SIG_SlPc !< Rated generator slip percentage [used only when VSContrl=0 and GenModel=1] [-] - REAL(ReKi) :: SIG_SySp !< Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1] [rad/s] - REAL(ReKi) :: SIG_RtTq !< Rated torque [used only when VSContrl=0 and GenModel=1] [N-m] - REAL(ReKi) :: SIG_PORt !< Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1] [-] - REAL(ReKi) :: TEC_Freq !< Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2] [Hz] - INTEGER(IntKi) :: TEC_NPol !< Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2] [-] - REAL(ReKi) :: TEC_SRes !< Stator resistance [used only when VSContrl=0 and GenModel=2] [ohms] - REAL(ReKi) :: TEC_RRes !< Rotor resistance [used only when VSContrl=0 and GenModel=2] [ohms] - REAL(ReKi) :: TEC_VLL !< Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2] [volts] - REAL(ReKi) :: TEC_SLR !< Stator leakage reactance [used only when VSContrl=0 and GenModel=2] [ohms] - REAL(ReKi) :: TEC_RLR !< Rotor leakage reactance [used only when VSContrl=0 and GenModel=2] [ohms] - REAL(ReKi) :: TEC_MR !< Magnetizing reactance [used only when VSContrl=0 and GenModel=2] [ohms] - INTEGER(IntKi) :: HSSBrMode !< HSS brake model [-] - REAL(DbKi) :: THSSBrDp !< Time to initiate deployment of the HSS brake [s] - REAL(DbKi) :: HSSBrDT !< Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1] [s] - REAL(ReKi) :: HSSBrTqF !< Fully deployed HSS-brake torque [N-m] - INTEGER(IntKi) :: YCMode !< Yaw control mode [-] - REAL(DbKi) :: TYCOn !< Time to enable active yaw control [unused when YCMode=0] [s] - REAL(ReKi) :: YawNeut !< Neutral yaw position--yaw spring force is zero at this yaw [radians] - REAL(ReKi) :: YawSpr !< Nacelle-yaw spring constant [N-m/rad] - REAL(ReKi) :: YawDamp !< Nacelle-yaw constant [N-m/(rad/s)] - REAL(DbKi) :: TYawManS !< Time to start override yaw maneuver and end standard yaw control [s] - REAL(ReKi) :: YawManRat !< Yaw maneuver rate (in absolute value) [rad/s] - REAL(ReKi) :: NacYawF !< Final yaw angle for override yaw maneuvers [radians] - LOGICAL :: SumPrint !< Print summary data to .sum [-] - INTEGER(IntKi) :: OutFile !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] - LOGICAL :: TabDelim !< Use tab delimiters in text tabular output file? [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Communication interval for controllers [s] + LOGICAL :: Echo = .false. !< Echo the input file out [-] + INTEGER(IntKi) :: PCMode = 0_IntKi !< Pitch control mode [-] + REAL(DbKi) :: TPCOn = 0.0_R8Ki !< Time to enable active pitch control [unused when PCMode=0] [s] + REAL(DbKi) , DIMENSION(1:3) :: TPitManS = 0.0_R8Ki !< Time to start override pitch maneuver for blade (K) and end standard pitch control [s] + REAL(ReKi) , DIMENSION(1:3) :: PitManRat = 0.0_ReKi !< Pitch rates at which override pitch maneuvers head toward final pitch angles [rad/s] + REAL(ReKi) , DIMENSION(1:3) :: BlPitchF = 0.0_ReKi !< Blade (K) final pitch for pitch maneuvers [radians] + INTEGER(IntKi) :: VSContrl = 0_IntKi !< Variable-speed control mode [-] + INTEGER(IntKi) :: GenModel = 0_IntKi !< Generator model [used only when VSContrl=0] [-] + REAL(ReKi) :: GenEff = 0.0_ReKi !< Generator efficiency [ignored by the Thevenin and user-defined generator models] [-] + LOGICAL :: GenTiStr = .false. !< Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} [-] + LOGICAL :: GenTiStp = .false. !< Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} [-] + REAL(ReKi) :: SpdGenOn = 0.0_ReKi !< Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False] [rad/s] + REAL(DbKi) :: TimGenOn = 0.0_R8Ki !< Time to turn on the generator for a startup [used only when GenTiStr=True] [s] + REAL(DbKi) :: TimGenOf = 0.0_R8Ki !< Time to turn off the generator [used only when GenTiStp=True] [s] + REAL(ReKi) :: VS_RtGnSp = 0.0_ReKi !< Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [rad/s] + REAL(ReKi) :: VS_RtTq = 0.0_ReKi !< Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [N-m] + REAL(ReKi) :: VS_Rgn2K = 0.0_ReKi !< Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [N-m/(rad/s)^2] + REAL(ReKi) :: VS_SlPc = 0.0_ReKi !< Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1] [-] + REAL(ReKi) :: SIG_SlPc = 0.0_ReKi !< Rated generator slip percentage [used only when VSContrl=0 and GenModel=1] [-] + REAL(ReKi) :: SIG_SySp = 0.0_ReKi !< Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1] [rad/s] + REAL(ReKi) :: SIG_RtTq = 0.0_ReKi !< Rated torque [used only when VSContrl=0 and GenModel=1] [N-m] + REAL(ReKi) :: SIG_PORt = 0.0_ReKi !< Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1] [-] + REAL(ReKi) :: TEC_Freq = 0.0_ReKi !< Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2] [Hz] + INTEGER(IntKi) :: TEC_NPol = 0_IntKi !< Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2] [-] + REAL(ReKi) :: TEC_SRes = 0.0_ReKi !< Stator resistance [used only when VSContrl=0 and GenModel=2] [ohms] + REAL(ReKi) :: TEC_RRes = 0.0_ReKi !< Rotor resistance [used only when VSContrl=0 and GenModel=2] [ohms] + REAL(ReKi) :: TEC_VLL = 0.0_ReKi !< Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2] [volts] + REAL(ReKi) :: TEC_SLR = 0.0_ReKi !< Stator leakage reactance [used only when VSContrl=0 and GenModel=2] [ohms] + REAL(ReKi) :: TEC_RLR = 0.0_ReKi !< Rotor leakage reactance [used only when VSContrl=0 and GenModel=2] [ohms] + REAL(ReKi) :: TEC_MR = 0.0_ReKi !< Magnetizing reactance [used only when VSContrl=0 and GenModel=2] [ohms] + INTEGER(IntKi) :: HSSBrMode = 0_IntKi !< HSS brake model [-] + REAL(DbKi) :: THSSBrDp = 0.0_R8Ki !< Time to initiate deployment of the HSS brake [s] + REAL(DbKi) :: HSSBrDT = 0.0_R8Ki !< Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1] [s] + REAL(ReKi) :: HSSBrTqF = 0.0_ReKi !< Fully deployed HSS-brake torque [N-m] + INTEGER(IntKi) :: YCMode = 0_IntKi !< Yaw control mode [-] + REAL(DbKi) :: TYCOn = 0.0_R8Ki !< Time to enable active yaw control [unused when YCMode=0] [s] + REAL(ReKi) :: YawNeut = 0.0_ReKi !< Neutral yaw position--yaw spring force is zero at this yaw [radians] + REAL(ReKi) :: YawSpr = 0.0_ReKi !< Nacelle-yaw spring constant [N-m/rad] + REAL(ReKi) :: YawDamp = 0.0_ReKi !< Nacelle-yaw constant [N-m/(rad/s)] + REAL(DbKi) :: TYawManS = 0.0_R8Ki !< Time to start override yaw maneuver and end standard yaw control [s] + REAL(ReKi) :: YawManRat = 0.0_ReKi !< Yaw maneuver rate (in absolute value) [rad/s] + REAL(ReKi) :: NacYawF = 0.0_ReKi !< Final yaw angle for override yaw maneuvers [radians] + LOGICAL :: SumPrint = .false. !< Print summary data to .sum [-] + INTEGER(IntKi) :: OutFile = 0_IntKi !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] + LOGICAL :: TabDelim = .false. !< Use tab delimiters in text tabular output file? [-] CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time) [-] - REAL(DbKi) :: Tstart !< Time to start module's tabular output [s] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [s] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] CHARACTER(1024) :: DLL_FileName !< Name of the DLL file including the full path [-] CHARACTER(1024) :: DLL_ProcName !< Name of the procedure in the DLL that will be called [-] CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] - REAL(DbKi) :: DLL_DT !< interval for calling DLL (must be integer multiple number of DT steps) [s] - LOGICAL :: DLL_Ramp !< whether the DLL pitch should be a ramp (true) or step change (false) when DLL_DT <> DT. If true, introduces a time delay. [-] - REAL(ReKi) :: BPCutoff !< The cutoff frequency for the blade pitch low-pass filter. Large values => no filter. [Hz] - REAL(ReKi) :: NacYaw_North !< Reference yaw angle of the nacelle when the upwind end points due North [used only with DLL Interface] [radians] - INTEGER(IntKi) :: Ptch_Cntrl !< Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface] [-] - REAL(ReKi) :: Ptch_SetPnt !< Record 5: Below-rated pitch angle set-point [used only with DLL Interface] [radians] - REAL(ReKi) :: Ptch_Min !< Record 6: Minimum pitch angle [used only with DLL Interface] [radians] - REAL(ReKi) :: Ptch_Max !< Record 7: Maximum pitch angle [used only with DLL Interface] [radians] - REAL(ReKi) :: PtchRate_Min !< Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface] [rad/s] - REAL(ReKi) :: PtchRate_Max !< Record 9: Maximum pitch rate [used only with DLL Interface] [rad/s] - REAL(ReKi) :: Gain_OM !< Record 16: Optimal mode gain [used only with DLL Interface] [Nm/(rad/s)^2] - REAL(ReKi) :: GenSpd_MinOM !< Record 17: Minimum generator speed [used only with DLL Interface] [rad/s] - REAL(ReKi) :: GenSpd_MaxOM !< Record 18: Optimal mode maximum speed [used only with DLL Interface] [rad/s] - REAL(ReKi) :: GenSpd_Dem !< Record 19: Demanded generator speed above rated [used only with DLL Interface] [rad/s] - REAL(ReKi) :: GenTrq_Dem !< Record 22: Demanded generator torque above rated [used only with DLL Interface] [Nm] - REAL(ReKi) :: GenPwr_Dem !< Record 13: Demanded power [used only with DLL Interface] [W] - INTEGER(IntKi) :: DLL_NumTrq !< Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} [used only with DLL Interface] [-] + REAL(DbKi) :: DLL_DT = 0.0_R8Ki !< interval for calling DLL (must be integer multiple number of DT steps) [s] + LOGICAL :: DLL_Ramp = .false. !< whether the DLL pitch should be a ramp (true) or step change (false) when DLL_DT <> DT. If true, introduces a time delay. [-] + REAL(ReKi) :: BPCutoff = 0.0_ReKi !< The cutoff frequency for the blade pitch low-pass filter. Large values => no filter. [Hz] + REAL(ReKi) :: NacYaw_North = 0.0_ReKi !< Reference yaw angle of the nacelle when the upwind end points due North [used only with DLL Interface] [radians] + INTEGER(IntKi) :: Ptch_Cntrl = 0_IntKi !< Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface] [-] + REAL(ReKi) :: Ptch_SetPnt = 0.0_ReKi !< Record 5: Below-rated pitch angle set-point [used only with DLL Interface] [radians] + REAL(ReKi) :: Ptch_Min = 0.0_ReKi !< Record 6: Minimum pitch angle [used only with DLL Interface] [radians] + REAL(ReKi) :: Ptch_Max = 0.0_ReKi !< Record 7: Maximum pitch angle [used only with DLL Interface] [radians] + REAL(ReKi) :: PtchRate_Min = 0.0_ReKi !< Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface] [rad/s] + REAL(ReKi) :: PtchRate_Max = 0.0_ReKi !< Record 9: Maximum pitch rate [used only with DLL Interface] [rad/s] + REAL(ReKi) :: Gain_OM = 0.0_ReKi !< Record 16: Optimal mode gain [used only with DLL Interface] [Nm/(rad/s)^2] + REAL(ReKi) :: GenSpd_MinOM = 0.0_ReKi !< Record 17: Minimum generator speed [used only with DLL Interface] [rad/s] + REAL(ReKi) :: GenSpd_MaxOM = 0.0_ReKi !< Record 18: Optimal mode maximum speed [used only with DLL Interface] [rad/s] + REAL(ReKi) :: GenSpd_Dem = 0.0_ReKi !< Record 19: Demanded generator speed above rated [used only with DLL Interface] [rad/s] + REAL(ReKi) :: GenTrq_Dem = 0.0_ReKi !< Record 22: Demanded generator torque above rated [used only with DLL Interface] [Nm] + REAL(ReKi) :: GenPwr_Dem = 0.0_ReKi !< Record 13: Demanded power [used only with DLL Interface] [W] + INTEGER(IntKi) :: DLL_NumTrq = 0_IntKi !< Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} [used only with DLL Interface] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Records R:2:R+2*DLL_NumTrq-2: Generator speed values in look-up table [used only with DLL Interface] [rad/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Records R+1:2:R+2*DLL_NumTrq-1: Generator torque values in look-up table [used only with DLL Interface] [Nm] - LOGICAL :: UseLegacyInterface !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] - INTEGER(IntKi) :: NumBStC !< Number of blade structural controllers (integer) [-] + LOGICAL :: UseLegacyInterface = .false. !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] + INTEGER(IntKi) :: NumBStC = 0_IntKi !< Number of blade structural controllers (integer) [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: BStCfiles !< Name of the files for blade structural controllers (quoted strings) [unused when NumBStC==0] [-] - INTEGER(IntKi) :: NumNStC !< Number of nacelle structural controllers (integer) [-] + INTEGER(IntKi) :: NumNStC = 0_IntKi !< Number of nacelle structural controllers (integer) [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: NStCfiles !< Name of the files for nacelle structural controllers (quoted strings) [unused when NumNStC==0] [-] - INTEGER(IntKi) :: NumTStC !< Number of tower structural controllers (integer) [-] + INTEGER(IntKi) :: NumTStC = 0_IntKi !< Number of tower structural controllers (integer) [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: TStCfiles !< Name of the files for tower structural controllers (quoted strings) [unused when NumTStC==0] [-] - INTEGER(IntKi) :: NumSStC !< Number of substructure structural controllers (integer) [-] + INTEGER(IntKi) :: NumSStC = 0_IntKi !< Number of substructure structural controllers (integer) [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: SStCfiles !< Name of the files for subtructure structural controllers (quoted strings) [unused when NumSStC==0] [-] - INTEGER(IntKi) :: AfCmode !< Airfoil control mode {0: none, 1: sine wave cycle, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] - REAL(ReKi) :: AfC_Mean !< Mean level for cosine cycling or steady value [used only with AfCmode==1] [-] - REAL(ReKi) :: AfC_Amp !< Amplitude for for cosine cycling of flap signal (-) [used only with AfCmode==1] [-] - REAL(ReKi) :: AfC_Phase !< Phase relative to the blade azimuth (0 is vertical) for for cosine cycling of flap signal (deg) [used only with AfCmode==1] [deg] - INTEGER(IntKi) :: CCmode !< Cable control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] - LOGICAL :: EXavrSWAP !< Use extendend AVR swap [-] + INTEGER(IntKi) :: AfCmode = 0_IntKi !< Airfoil control mode {0: none, 1: sine wave cycle, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] + REAL(ReKi) :: AfC_Mean = 0.0_ReKi !< Mean level for cosine cycling or steady value [used only with AfCmode==1] [-] + REAL(ReKi) :: AfC_Amp = 0.0_ReKi !< Amplitude for for cosine cycling of flap signal (-) [used only with AfCmode==1] [-] + REAL(ReKi) :: AfC_Phase = 0.0_ReKi !< Phase relative to the blade azimuth (0 is vertical) for for cosine cycling of flap signal (deg) [used only with AfCmode==1] [deg] + INTEGER(IntKi) :: CCmode = 0_IntKi !< Cable control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] + LOGICAL :: EXavrSWAP = .false. !< Use extendend AVR swap [-] END TYPE SrvD_InputFile ! ======================= ! ========= BladedDLLType ======= TYPE, PUBLIC :: BladedDLLType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: avrSWAP !< The swap array: used to pass data to and from the DLL controller [see Bladed DLL documentation] - REAL(ReKi) :: HSSBrTrqDemand !< Demanded braking torque - from Bladed DLL [-] - REAL(ReKi) :: YawRateCom !< Nacelle yaw rate demanded from Bladed DLL [rad/s] - REAL(ReKi) :: GenTrq !< Electrical generator torque from Bladed DLL [N-m] - INTEGER(IntKi) :: GenState !< Generator state from Bladed DLL [-] - REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom !< Commanded blade pitch angles [radians] - REAL(ReKi) , DIMENSION(1:3) :: PrevBlPitch !< Previously commanded blade pitch angles [radians] - REAL(ReKi) , DIMENSION(1:3) :: BlAirfoilCom !< Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] - REAL(ReKi) , DIMENSION(1:3) :: PrevBlAirfoilCom !< Previously commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] - REAL(ReKi) :: ElecPwr_prev !< Electrical power (from previous step), sent to Bladed DLL [W] - REAL(ReKi) :: GenTrq_prev !< Electrical generator torque (from previous step), sent to Bladed DLL [N-m] + REAL(ReKi) :: HSSBrTrqDemand = 0.0_ReKi !< Demanded braking torque - from Bladed DLL [-] + REAL(ReKi) :: YawRateCom = 0.0_ReKi !< Nacelle yaw rate demanded from Bladed DLL [rad/s] + REAL(ReKi) :: GenTrq = 0.0_ReKi !< Electrical generator torque from Bladed DLL [N-m] + INTEGER(IntKi) :: GenState = 0_IntKi !< Generator state from Bladed DLL [-] + REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom = 0.0_ReKi !< Commanded blade pitch angles [radians] + REAL(ReKi) , DIMENSION(1:3) :: PrevBlPitch = 0.0_ReKi !< Previously commanded blade pitch angles [radians] + REAL(ReKi) , DIMENSION(1:3) :: BlAirfoilCom = 0.0_ReKi !< Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] + REAL(ReKi) , DIMENSION(1:3) :: PrevBlAirfoilCom = 0.0_ReKi !< Previously commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] + REAL(ReKi) :: ElecPwr_prev = 0.0_ReKi !< Electrical power (from previous step), sent to Bladed DLL [W] + REAL(ReKi) :: GenTrq_prev = 0.0_ReKi !< Electrical generator torque (from previous step), sent to Bladed DLL [N-m] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: toSC !< controller output to supercontroller [-] - LOGICAL :: initialized !< flag that determines if DLL has been called (for difference between CalcOutput and UpdateStates) [-] - INTEGER(IntKi) :: NumLogChannels !< number of log channels from controller [-] + LOGICAL :: initialized = .false. !< flag that determines if DLL has been called (for difference between CalcOutput and UpdateStates) [-] + INTEGER(IntKi) :: NumLogChannels = 0_IntKi !< number of log channels from controller [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: LogChannels_OutParam !< Names and units (and other characteristics) of logging outputs from DLL [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LogChannels !< logging outputs from controller [-] - INTEGER(IntKi) :: ErrStat !< error message from external controller API [-] + INTEGER(IntKi) :: ErrStat = 0_IntKi !< error message from external controller API [-] CHARACTER(ErrMsgLen) :: ErrMsg !< error message from external controller API [-] - REAL(R8Ki) :: CurrentTime !< Current Simulation Time [s] - INTEGER(IntKi) :: SimStatus !< simulation status (see avrSWAP(1): Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation) [-] - INTEGER(IntKi) :: ShaftBrakeStatusBinaryFlag !< binary flag indicating (on/off) status for shaft brake 1, shaft brake 2, generator brake, shaft brake 3, or brake torque set separately (0, 1, or 16 allowed in FAST) [-] - LOGICAL :: HSSBrDeployed !< Whether the HSS brake has been deployed [-] - REAL(R8Ki) :: TimeHSSBrFullyDeployed !< Time at which the controller high-speed shaft is fully deployed [s] - REAL(R8Ki) :: TimeHSSBrDeployed !< Time at which the controller high-speed shaft is first deployed [s] - LOGICAL :: OverrideYawRateWithTorque !< acts similiar to Yaw_Cntrl [-] - REAL(ReKi) :: YawTorqueDemand !< Demanded yaw actuator torque (override of yaw rate control) [Nm] + REAL(R8Ki) :: CurrentTime = 0.0_R8Ki !< Current Simulation Time [s] + INTEGER(IntKi) :: SimStatus = 0_IntKi !< simulation status (see avrSWAP(1): Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation) [-] + INTEGER(IntKi) :: ShaftBrakeStatusBinaryFlag = 0_IntKi !< binary flag indicating (on/off) status for shaft brake 1, shaft brake 2, generator brake, shaft brake 3, or brake torque set separately (0, 1, or 16 allowed in FAST) [-] + LOGICAL :: HSSBrDeployed = .false. !< Whether the HSS brake has been deployed [-] + REAL(R8Ki) :: TimeHSSBrFullyDeployed = 0.0_R8Ki !< Time at which the controller high-speed shaft is fully deployed [s] + REAL(R8Ki) :: TimeHSSBrDeployed = 0.0_R8Ki !< Time at which the controller high-speed shaft is first deployed [s] + LOGICAL :: OverrideYawRateWithTorque = .false. !< acts similiar to Yaw_Cntrl [-] + REAL(ReKi) :: YawTorqueDemand = 0.0_ReKi !< Demanded yaw actuator torque (override of yaw rate control) [Nm] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInput !< Input blade pitch angles [radians] - REAL(ReKi) :: YawAngleFromNorth !< Yaw angle of the nacelle relative to North (see NacYaw_North) [rad] - REAL(ReKi) :: HorWindV !< Horizontal hub-height wind velocity magnitude [m/s] - REAL(ReKi) :: HSS_Spd !< High-speed shaft (HSS) speed [rad/s] - REAL(ReKi) :: YawErr !< Yaw error [radians] - REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] - REAL(ReKi) :: YawBrTAxp !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: YawBrTAyp !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: LSSTipMys !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMzs !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMya !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMza !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipPxa !< Rotor azimuth angle (position) [radians] - REAL(ReKi) :: Yaw !< Current nacelle yaw [radians] - REAL(ReKi) :: YawRate !< Current nacelle yaw rate [rad/s] - REAL(ReKi) :: YawBrMyn !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] - REAL(ReKi) :: YawBrMzn !< Tower-top / yaw bearing yaw moment [N-m] - REAL(ReKi) :: NcIMURAxs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAys !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAzs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: RotPwr !< Rotor power (this is equivalent to the low-speed shaft power) [W] - REAL(ReKi) :: LSSTipMxa !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) , DIMENSION(1:3) :: RootMyc !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] - REAL(ReKi) , DIMENSION(1:3) :: RootMxc !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] - REAL(ReKi) :: LSShftFxa !< Rotating low-speed shaft force x [N] - REAL(ReKi) :: LSShftFys !< Nonrotating low-speed shaft force y [N] - REAL(ReKi) :: LSShftFzs !< Nonrotating low-speed shaft force z [N] + REAL(ReKi) :: YawAngleFromNorth = 0.0_ReKi !< Yaw angle of the nacelle relative to North (see NacYaw_North) [rad] + REAL(ReKi) :: HorWindV = 0.0_ReKi !< Horizontal hub-height wind velocity magnitude [m/s] + REAL(ReKi) :: HSS_Spd = 0.0_ReKi !< High-speed shaft (HSS) speed [rad/s] + REAL(ReKi) :: YawErr = 0.0_ReKi !< Yaw error [radians] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: YawBrTAxp = 0.0_ReKi !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: YawBrTAyp = 0.0_ReKi !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: LSSTipMys = 0.0_ReKi !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMzs = 0.0_ReKi !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMya = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMza = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipPxa = 0.0_ReKi !< Rotor azimuth angle (position) [radians] + REAL(ReKi) :: Yaw = 0.0_ReKi !< Current nacelle yaw [radians] + REAL(ReKi) :: YawRate = 0.0_ReKi !< Current nacelle yaw rate [rad/s] + REAL(ReKi) :: YawBrMyn = 0.0_ReKi !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] + REAL(ReKi) :: YawBrMzn = 0.0_ReKi !< Tower-top / yaw bearing yaw moment [N-m] + REAL(ReKi) :: NcIMURAxs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAys = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAzs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: RotPwr = 0.0_ReKi !< Rotor power (this is equivalent to the low-speed shaft power) [W] + REAL(ReKi) :: LSSTipMxa = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) , DIMENSION(1:3) :: RootMyc = 0.0_ReKi !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] + REAL(ReKi) , DIMENSION(1:3) :: RootMxc = 0.0_ReKi !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] + REAL(ReKi) :: LSShftFxa = 0.0_ReKi !< Rotating low-speed shaft force x [N] + REAL(ReKi) :: LSShftFys = 0.0_ReKi !< Nonrotating low-speed shaft force y [N] + REAL(ReKi) :: LSShftFzs = 0.0_ReKi !< Nonrotating low-speed shaft force z [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LidSpeed !< Lidar measured wind speed [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsX !< Lidar X direction measurement points [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsY !< Lidar Y direction measurement points [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsZ !< Lidar Z direction measurement points [m] - INTEGER(IntKi) :: SensorType !< Lidar sensor type [-] - INTEGER(IntKi) :: NumBeam !< Number of beams [-] - INTEGER(IntKi) :: NumPulseGate !< Number of pulse gates [-] - INTEGER(IntKi) :: PulseSpacing !< Distance between range gates [-] - INTEGER(IntKi) :: URefLid !< Reference average wind speed for the lidar [m/s] - REAL(DbKi) :: DLL_DT !< interval for calling DLL (integer multiple number of DT) [s] + INTEGER(IntKi) :: SensorType = 0_IntKi !< Lidar sensor type [-] + INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of beams [-] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< Number of pulse gates [-] + INTEGER(IntKi) :: PulseSpacing = 0_IntKi !< Distance between range gates [-] + INTEGER(IntKi) :: URefLid = 0_IntKi !< Reference average wind speed for the lidar [m/s] + REAL(DbKi) :: DLL_DT = 0.0_R8Ki !< interval for calling DLL (integer multiple number of DT) [s] CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) :: GenTrq_Dem !< Demanded generator torque above rated [Nm] - REAL(ReKi) :: GenSpd_Dem !< Demanded generator speed above rated [rad/s] - REAL(ReKi) :: Ptch_Max !< Maximum pitch angle [rad] - REAL(ReKi) :: Ptch_Min !< Minimum pitch angle [rad] - REAL(ReKi) :: Ptch_SetPnt !< Below-rated pitch angle set-point [rad] - REAL(ReKi) :: PtchRate_Max !< Maximum pitch rate [rad/s] - REAL(ReKi) :: PtchRate_Min !< Minimum pitch rate (most negative value allowed) [rad/s] - REAL(ReKi) :: GenPwr_Dem !< Demanded power (This is not valid for variable-speed, pitch-regulated controllers.) [W] - REAL(ReKi) :: Gain_OM !< Optimal mode gain [Nm/(rad/s)^2] - REAL(ReKi) :: GenSpd_MaxOM !< Optimal mode maximum speed [rad/s] - REAL(ReKi) :: GenSpd_MinOM !< Minimum generator speed [rad/s] - INTEGER(IntKi) :: Ptch_Cntrl !< Pitch control: 0 = collective; 1 = individual [-] - INTEGER(IntKi) :: DLL_NumTrq !< No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 [-] + REAL(ReKi) :: GenTrq_Dem = 0.0_ReKi !< Demanded generator torque above rated [Nm] + REAL(ReKi) :: GenSpd_Dem = 0.0_ReKi !< Demanded generator speed above rated [rad/s] + REAL(ReKi) :: Ptch_Max = 0.0_ReKi !< Maximum pitch angle [rad] + REAL(ReKi) :: Ptch_Min = 0.0_ReKi !< Minimum pitch angle [rad] + REAL(ReKi) :: Ptch_SetPnt = 0.0_ReKi !< Below-rated pitch angle set-point [rad] + REAL(ReKi) :: PtchRate_Max = 0.0_ReKi !< Maximum pitch rate [rad/s] + REAL(ReKi) :: PtchRate_Min = 0.0_ReKi !< Minimum pitch rate (most negative value allowed) [rad/s] + REAL(ReKi) :: GenPwr_Dem = 0.0_ReKi !< Demanded power (This is not valid for variable-speed, pitch-regulated controllers.) [W] + REAL(ReKi) :: Gain_OM = 0.0_ReKi !< Optimal mode gain [Nm/(rad/s)^2] + REAL(ReKi) :: GenSpd_MaxOM = 0.0_ReKi !< Optimal mode maximum speed [rad/s] + REAL(ReKi) :: GenSpd_MinOM = 0.0_ReKi !< Minimum generator speed [rad/s] + INTEGER(IntKi) :: Ptch_Cntrl = 0_IntKi !< Pitch control: 0 = collective; 1 = individual [-] + INTEGER(IntKi) :: DLL_NumTrq = 0_IntKi !< No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /) [rad/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /) [Nm] - INTEGER(IntKi) :: Yaw_Cntrl !< Yaw control: 0 = rate; 1 = torque [-] + INTEGER(IntKi) :: Yaw_Cntrl = 0_IntKi !< Yaw control: 0 = rate; 1 = torque [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: PrevCableDeltaL !< Previous value for ramping for cable tensioning DeltaL using extended avrSWAP [see EXavrSWAP documentation in BladededInterface_EX] [m] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: PrevCableDeltaLdot !< Previous value for ramping for cable tensioning DeltaLdot using extended avrSWAP [see EXavrSWAP documentation in BladededInterface_EX] [m/s] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CableDeltaL !< The swap array: used to pass data from the DLL controller for cable tensioning DeltaL using extended avrSWAP [see EXavrSWAP documentation in BladededInterface_EX] [m] @@ -294,7 +294,7 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_ContinuousStateType ======= TYPE, PUBLIC :: SrvD_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: DummyContState = 0.0_ReKi !< Remove this variable if you have continuous states [-] TYPE(StC_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module states - blade [-] TYPE(StC_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module states - nacelle [-] TYPE(StC_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module states - tower [-] @@ -303,7 +303,7 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_DiscreteStateType ======= TYPE, PUBLIC :: SrvD_DiscreteStateType - REAL(ReKi) :: CtrlOffset !< Controller offset parameter [N-m] + REAL(ReKi) :: CtrlOffset = 0.0_ReKi !< Controller offset parameter [N-m] TYPE(StC_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module states - blade [-] TYPE(StC_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module states - nacelle [-] TYPE(StC_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module states - tower [-] @@ -312,7 +312,7 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_ConstraintStateType ======= TYPE, PUBLIC :: SrvD_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] TYPE(StC_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module states - blade [-] TYPE(StC_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module states - nacelle [-] TYPE(StC_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module states - tower [-] @@ -324,15 +324,15 @@ MODULE ServoDyn_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: BegPitMan !< Whether the override pitch maneuver actually began [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchI !< Initial blade pitch angles at the start of the override pitch maneuver [radians] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TPitManE !< Time to end pitch maneuvers for each blade [s] - LOGICAL :: BegYawMan !< Whether the yaw maneuver actually began [-] - REAL(ReKi) :: NacYawI !< Initial yaw angle at the start of the override yaw maneuver [radians] - REAL(DbKi) :: TYawManE !< Time to end override yaw maneuver [s] - REAL(ReKi) :: YawPosComInt !< Internal variable that integrates the commanded yaw rate and passes it to YawPosCom [radians] + LOGICAL :: BegYawMan = .false. !< Whether the yaw maneuver actually began [-] + REAL(ReKi) :: NacYawI = 0.0_ReKi !< Initial yaw angle at the start of the override yaw maneuver [radians] + REAL(DbKi) :: TYawManE = 0.0_R8Ki !< Time to end override yaw maneuver [s] + REAL(ReKi) :: YawPosComInt = 0.0_ReKi !< Internal variable that integrates the commanded yaw rate and passes it to YawPosCom [radians] LOGICAL , DIMENSION(:), ALLOCATABLE :: BegTpBr !< Whether the tip brakes actually deployed [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TTpBrDp !< Times to initiate deployment of tip brakes [s] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TTpBrFl !< Times at which tip brakes are fully deployed [s] - LOGICAL :: Off4Good !< Is the generator offline for rest of simulation? [-] - LOGICAL :: GenOnLine !< Is the generator online? [-] + LOGICAL :: Off4Good = .false. !< Is the generator offline for rest of simulation? [-] + LOGICAL :: GenOnLine = .false. !< Is the generator online? [-] TYPE(StC_OtherStateType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module states - blade [-] TYPE(StC_OtherStateType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module states - nacelle [-] TYPE(StC_OtherStateType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module states - tower [-] @@ -353,10 +353,10 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_MiscVarType ======= TYPE, PUBLIC :: SrvD_MiscVarType - REAL(DbKi) :: LastTimeCalled !< last time the CalcOutput/Bladed DLL was called [s] + REAL(DbKi) :: LastTimeCalled = 0.0_R8Ki !< last time the CalcOutput/Bladed DLL was called [s] TYPE(BladedDLLType) :: dll_data !< data used for Bladed DLL [-] - LOGICAL :: FirstWarn !< Whether or not this is the first warning about the DLL being called without Explicit-Loose coupling. [-] - REAL(DbKi) :: LastTimeFiltered !< last time the CalcOutput/Bladed DLL was filtered [s] + LOGICAL :: FirstWarn = .false. !< Whether or not this is the first warning about the DLL being called without Explicit-Loose coupling. [-] + REAL(DbKi) :: LastTimeFiltered = 0.0_R8Ki !< last time the CalcOutput/Bladed DLL was filtered [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xd_BlPitchFilter !< blade pitch filter [-] TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module misc vars - blade [-] TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module misc vars - nacelle [-] @@ -376,112 +376,112 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_ParameterType ======= TYPE, PUBLIC :: SrvD_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - REAL(DbKi) :: HSSBrDT !< Time it takes for HSS brake to reach full deployment once deployed [seconds] - REAL(ReKi) :: HSSBrTqF !< Fully deployed HSS brake torque [-] - REAL(ReKi) :: SIG_POSl !< Pullout slip [-] - REAL(ReKi) :: SIG_POTq !< Pullout torque [-] - REAL(ReKi) :: SIG_SlPc !< Rated generator slip percentage [-] - REAL(ReKi) :: SIG_Slop !< Torque/Speed slope for simple induction generator [-] - REAL(ReKi) :: SIG_SySp !< Synchronous (zero-torque) generator speed [rad/s] - REAL(ReKi) :: TEC_A0 !< A0 term for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_C0 !< C0 term for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_C1 !< C1 term for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_C2 !< C2 term for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_K2 !< K2 term for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_MR !< Magnetizing reactance for Thevenin-equivalent circuit [ohms] - REAL(ReKi) :: TEC_Re1 !< Thevenin's equivalent stator resistance (ohms) [ohms] - REAL(ReKi) :: TEC_RLR !< Rotor leakage reactance for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_RRes !< Rotor resistance for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_SRes !< Stator resistance for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_SySp !< Synchronous speed for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_V1a !< Source voltage for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_VLL !< Line-to-line RMS voltage for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_Xe1 !< Thevenin's equivalent stator leakage reactance (ohms) [ohms] - REAL(ReKi) :: GenEff !< Generator efficiency [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: HSSBrDT = 0.0_R8Ki !< Time it takes for HSS brake to reach full deployment once deployed [seconds] + REAL(ReKi) :: HSSBrTqF = 0.0_ReKi !< Fully deployed HSS brake torque [-] + REAL(ReKi) :: SIG_POSl = 0.0_ReKi !< Pullout slip [-] + REAL(ReKi) :: SIG_POTq = 0.0_ReKi !< Pullout torque [-] + REAL(ReKi) :: SIG_SlPc = 0.0_ReKi !< Rated generator slip percentage [-] + REAL(ReKi) :: SIG_Slop = 0.0_ReKi !< Torque/Speed slope for simple induction generator [-] + REAL(ReKi) :: SIG_SySp = 0.0_ReKi !< Synchronous (zero-torque) generator speed [rad/s] + REAL(ReKi) :: TEC_A0 = 0.0_ReKi !< A0 term for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_C0 = 0.0_ReKi !< C0 term for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_C1 = 0.0_ReKi !< C1 term for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_C2 = 0.0_ReKi !< C2 term for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_K2 = 0.0_ReKi !< K2 term for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_MR = 0.0_ReKi !< Magnetizing reactance for Thevenin-equivalent circuit [ohms] + REAL(ReKi) :: TEC_Re1 = 0.0_ReKi !< Thevenin's equivalent stator resistance (ohms) [ohms] + REAL(ReKi) :: TEC_RLR = 0.0_ReKi !< Rotor leakage reactance for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_RRes = 0.0_ReKi !< Rotor resistance for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_SRes = 0.0_ReKi !< Stator resistance for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_SySp = 0.0_ReKi !< Synchronous speed for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_V1a = 0.0_ReKi !< Source voltage for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_VLL = 0.0_ReKi !< Line-to-line RMS voltage for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_Xe1 = 0.0_ReKi !< Thevenin's equivalent stator leakage reactance (ohms) [ohms] + REAL(ReKi) :: GenEff = 0.0_ReKi !< Generator efficiency [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInit !< Initial blade pitch angles [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchF !< Final blade pitch [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PitManRat !< Pitch rates at which override pitch maneuvers head toward final pitch angles (does not include sign) [rad/s] - REAL(ReKi) :: YawManRat !< Yaw rate at which override yaw maneuver head toward for final yaw angle (does not include sign) [rad/s] - REAL(ReKi) :: NacYawF !< Final yaw angle after override yaw maneuver [-] - REAL(ReKi) :: SpdGenOn !< Generator speed to turn on the generator for a startup [-] - REAL(DbKi) :: THSSBrDp !< Time to initiate deployment of the shaft brake [s] - REAL(DbKi) :: THSSBrFl !< Time at which shaft brake is fully deployed [s] - REAL(DbKi) :: TimGenOf !< Time to turn off generator for braking or modeling a run-away [s] - REAL(DbKi) :: TimGenOn !< Time to turn on generator for startup [s] - REAL(DbKi) :: TPCOn !< Time to enable active pitch control [s] + REAL(ReKi) :: YawManRat = 0.0_ReKi !< Yaw rate at which override yaw maneuver head toward for final yaw angle (does not include sign) [rad/s] + REAL(ReKi) :: NacYawF = 0.0_ReKi !< Final yaw angle after override yaw maneuver [-] + REAL(ReKi) :: SpdGenOn = 0.0_ReKi !< Generator speed to turn on the generator for a startup [-] + REAL(DbKi) :: THSSBrDp = 0.0_R8Ki !< Time to initiate deployment of the shaft brake [s] + REAL(DbKi) :: THSSBrFl = 0.0_R8Ki !< Time at which shaft brake is fully deployed [s] + REAL(DbKi) :: TimGenOf = 0.0_R8Ki !< Time to turn off generator for braking or modeling a run-away [s] + REAL(DbKi) :: TimGenOn = 0.0_R8Ki !< Time to turn on generator for startup [s] + REAL(DbKi) :: TPCOn = 0.0_R8Ki !< Time to enable active pitch control [s] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TPitManS !< Time to start pitch maneuvers for each blade [s] - REAL(DbKi) :: TYawManS !< Time to start override yaw maneuver [s] - REAL(DbKi) :: TYCOn !< Time to enable active yaw control [s] - REAL(ReKi) :: VS_RtGnSp !< Rated generator speed (HSS side) [rad/s] - REAL(ReKi) :: VS_RtTq !< Rated generator torque/constant generator torque in Region 3 (HSS side) [N-m] - REAL(ReKi) :: VS_Slope !< Torque/speed slope of region 2 1/2 induction generator [-] - REAL(ReKi) :: VS_SlPc !< Rated generator slip percentage in Region 2 1/2 [-] - REAL(ReKi) :: VS_SySp !< Synchronous speed of region 2 1/2 induction generator [-] - REAL(ReKi) :: VS_TrGnSp !< Transitional generator speed between regions 2 and 2 1/2 [-] - REAL(ReKi) :: YawPosCom !< Commanded yaw angle from user-defined routines [rad] - REAL(ReKi) :: YawRateCom !< Commanded yaw rate from user-defined routines [rad/s] - INTEGER(IntKi) :: GenModel !< Generator model [-] - INTEGER(IntKi) :: HSSBrMode !< HSS brake model [-] - INTEGER(IntKi) :: PCMode !< Pitch control mode [-] - INTEGER(IntKi) :: VSContrl !< Variable-speed-generator control switch [-] - INTEGER(IntKi) :: YCMode !< Yaw control mode [-] - LOGICAL :: GenTiStp !< Stop generator based upon T: time or F: generator power = 0 [-] - LOGICAL :: GenTiStr !< Start generator based upon T: time or F: generator speed [-] - REAL(ReKi) :: VS_Rgn2K !< Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [N-m/(rad/s)^2] - REAL(ReKi) :: YawNeut !< Neutral yaw position--yaw spring force is zero at this yaw [radians] - REAL(ReKi) :: YawSpr !< Nacelle-yaw spring constant [N-m/rad] - REAL(ReKi) :: YawDamp !< Nacelle-yaw constant [N-m/(rad/s)] - REAL(DbKi) :: TpBrDT !< Time for tip-brake to reach full deployment once released [s] + REAL(DbKi) :: TYawManS = 0.0_R8Ki !< Time to start override yaw maneuver [s] + REAL(DbKi) :: TYCOn = 0.0_R8Ki !< Time to enable active yaw control [s] + REAL(ReKi) :: VS_RtGnSp = 0.0_ReKi !< Rated generator speed (HSS side) [rad/s] + REAL(ReKi) :: VS_RtTq = 0.0_ReKi !< Rated generator torque/constant generator torque in Region 3 (HSS side) [N-m] + REAL(ReKi) :: VS_Slope = 0.0_ReKi !< Torque/speed slope of region 2 1/2 induction generator [-] + REAL(ReKi) :: VS_SlPc = 0.0_ReKi !< Rated generator slip percentage in Region 2 1/2 [-] + REAL(ReKi) :: VS_SySp = 0.0_ReKi !< Synchronous speed of region 2 1/2 induction generator [-] + REAL(ReKi) :: VS_TrGnSp = 0.0_ReKi !< Transitional generator speed between regions 2 and 2 1/2 [-] + REAL(ReKi) :: YawPosCom = 0.0_ReKi !< Commanded yaw angle from user-defined routines [rad] + REAL(ReKi) :: YawRateCom = 0.0_ReKi !< Commanded yaw rate from user-defined routines [rad/s] + INTEGER(IntKi) :: GenModel = 0_IntKi !< Generator model [-] + INTEGER(IntKi) :: HSSBrMode = 0_IntKi !< HSS brake model [-] + INTEGER(IntKi) :: PCMode = 0_IntKi !< Pitch control mode [-] + INTEGER(IntKi) :: VSContrl = 0_IntKi !< Variable-speed-generator control switch [-] + INTEGER(IntKi) :: YCMode = 0_IntKi !< Yaw control mode [-] + LOGICAL :: GenTiStp = .false. !< Stop generator based upon T: time or F: generator power = 0 [-] + LOGICAL :: GenTiStr = .false. !< Start generator based upon T: time or F: generator speed [-] + REAL(ReKi) :: VS_Rgn2K = 0.0_ReKi !< Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [N-m/(rad/s)^2] + REAL(ReKi) :: YawNeut = 0.0_ReKi !< Neutral yaw position--yaw spring force is zero at this yaw [radians] + REAL(ReKi) :: YawSpr = 0.0_ReKi !< Nacelle-yaw spring constant [N-m/rad] + REAL(ReKi) :: YawDamp = 0.0_ReKi !< Nacelle-yaw constant [N-m/(rad/s)] + REAL(DbKi) :: TpBrDT = 0.0_R8Ki !< Time for tip-brake to reach full deployment once released [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TBDepISp !< Deployment-initiation speed for the tip brakes [rad/s] - REAL(ReKi) :: TBDrConN !< Tip-brake drag constant during normal operation, Cd*Area [-] - REAL(ReKi) :: TBDrConD !< Tip-brake drag constant during fully-deployed operation, Cd*Area [-] - INTEGER(IntKi) :: NumBl !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumBStC !< Number of blade structural controllers (integer) [-] - INTEGER(IntKi) :: NumNStC !< Number of nacelle structural controllers (integer) [-] - INTEGER(IntKi) :: NumTStC !< Number of tower structural controllers (integer) [-] - INTEGER(IntKi) :: NumSStC !< Number of substructure structural controllers (integer) [-] - INTEGER(IntKi) :: AfCmode !< Airfoil control mode {0: none, 1: sine wave cycle, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] - REAL(ReKi) :: AfC_Mean !< Mean level for cosine cycling or steady value [used only with AfCmode==1] [-] - REAL(ReKi) :: AfC_Amp !< Amplitude for for cosine cycling of flap signal (-) [used only with AfCmode==1] [-] - REAL(ReKi) :: AfC_Phase !< Phase relative to the blade azimuth (0 is vertical) for for cosine cycling of flap signal (deg) [used only with AfCmode==1] [deg] - INTEGER(IntKi) :: CCmode !< Cable control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] - INTEGER(IntKi) :: StCCmode !< Structural control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: NumOuts_DLL !< Number of logging channels output from the DLL (set at initialization) [-] + REAL(ReKi) :: TBDrConN = 0.0_ReKi !< Tip-brake drag constant during normal operation, Cd*Area [-] + REAL(ReKi) :: TBDrConD = 0.0_ReKi !< Tip-brake drag constant during fully-deployed operation, Cd*Area [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBStC = 0_IntKi !< Number of blade structural controllers (integer) [-] + INTEGER(IntKi) :: NumNStC = 0_IntKi !< Number of nacelle structural controllers (integer) [-] + INTEGER(IntKi) :: NumTStC = 0_IntKi !< Number of tower structural controllers (integer) [-] + INTEGER(IntKi) :: NumSStC = 0_IntKi !< Number of substructure structural controllers (integer) [-] + INTEGER(IntKi) :: AfCmode = 0_IntKi !< Airfoil control mode {0: none, 1: sine wave cycle, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] + REAL(ReKi) :: AfC_Mean = 0.0_ReKi !< Mean level for cosine cycling or steady value [used only with AfCmode==1] [-] + REAL(ReKi) :: AfC_Amp = 0.0_ReKi !< Amplitude for for cosine cycling of flap signal (-) [used only with AfCmode==1] [-] + REAL(ReKi) :: AfC_Phase = 0.0_ReKi !< Phase relative to the blade azimuth (0 is vertical) for for cosine cycling of flap signal (deg) [used only with AfCmode==1] [deg] + INTEGER(IntKi) :: CCmode = 0_IntKi !< Cable control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] + INTEGER(IntKi) :: StCCmode = 0_IntKi !< Structural control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOuts_DLL = 0_IntKi !< Number of logging channels output from the DLL (set at initialization) [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] CHARACTER(1) :: Delim !< Column delimiter for output text files [-] - LOGICAL :: UseBladedInterface !< Flag that determines if BladedInterface was used [-] - LOGICAL :: UseLegacyInterface !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] + LOGICAL :: UseBladedInterface = .false. !< Flag that determines if BladedInterface was used [-] + LOGICAL :: UseLegacyInterface = .false. !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] TYPE(DLL_Type) :: DLL_Trgt !< The addresses and names of the Bladed DLL and its procedure [-] - LOGICAL :: DLL_Ramp !< determines if there is a DLL_DT-ramp time delay (true only when DLL_DT /= DT) [-] - REAL(ReKi) :: BlAlpha !< parameter for low-pass filter of blade pitch commands from the controller DLL [-] - INTEGER(IntKi) :: DLL_n !< number of steps between the controller being called and SrvD being called [-] - INTEGER(IntKi) :: avcOUTNAME_LEN !< Length of the avcOUTNAME character array passed to/from the DLL [-] - REAL(ReKi) :: NacYaw_North !< Reference yaw angle of the nacelle when the upwind end points due North [rad] - REAL(ReKi) :: AvgWindSpeed !< average wind speed for the simulation [m/s] - REAL(ReKi) :: AirDens !< air density [kg/m^3] - INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] - REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] - REAL(ReKi) :: RotSpeedRef !< Reference rotor speed [rad/s] + LOGICAL :: DLL_Ramp = .false. !< determines if there is a DLL_DT-ramp time delay (true only when DLL_DT /= DT) [-] + REAL(ReKi) :: BlAlpha = 0.0_ReKi !< parameter for low-pass filter of blade pitch commands from the controller DLL [-] + INTEGER(IntKi) :: DLL_n = 0_IntKi !< number of steps between the controller being called and SrvD being called [-] + INTEGER(IntKi) :: avcOUTNAME_LEN = 0_IntKi !< Length of the avcOUTNAME character array passed to/from the DLL [-] + REAL(ReKi) :: NacYaw_North = 0.0_ReKi !< Reference yaw angle of the nacelle when the upwind end points due North [rad] + REAL(ReKi) :: AvgWindSpeed = 0.0_ReKi !< average wind speed for the simulation [m/s] + REAL(ReKi) :: AirDens = 0.0_ReKi !< air density [kg/m^3] + INTEGER(IntKi) :: TrimCase = 0_IntKi !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain = 0.0_ReKi !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: RotSpeedRef = 0.0_ReKi !< Reference rotor speed [rad/s] TYPE(StC_ParameterType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module parameters - blade [-] TYPE(StC_ParameterType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module parameters - nacelle [-] TYPE(StC_ParameterType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module parameters - tower [-] TYPE(StC_ParameterType) , DIMENSION(:), ALLOCATABLE :: SStC !< StC module parameters - substructure [-] - INTEGER(IntKi) :: InterpOrder !< Interpolation order from glue code -- required to set m%u_xStC sizes [-] - LOGICAL :: EXavrSWAP !< Use extendend avr SWAP [-] - INTEGER(IntKi) :: NumCableControl !< Number of cable control channels requested [-] - INTEGER(IntKi) :: NumStC_Control !< Number of cable StC channels requested [-] + INTEGER(IntKi) :: InterpOrder = 0_IntKi !< Interpolation order from glue code -- required to set m%u_xStC sizes [-] + LOGICAL :: EXavrSWAP = .false. !< Use extendend avr SWAP [-] + INTEGER(IntKi) :: NumCableControl = 0_IntKi !< Number of cable control channels requested [-] + INTEGER(IntKi) :: NumStC_Control = 0_IntKi !< Number of cable StC channels requested [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: StCMeasNumPerChan !< Number of cable StC channel to average on each control channel sent to DLL [-] - LOGICAL :: UseSC !< Supercontroller on/off flag [-] + LOGICAL :: UseSC = .false. !< Supercontroller on/off flag [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_x_indx !< matrix to help fill/pack the x vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_nu !< number of inputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_nx !< the number of continuous states in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nu = 0_IntKi !< number of inputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nx = 0_IntKi !< the number of continuous states in jacobian matrix [-] INTEGER(IntKi) , DIMENSION(:,:,:), ALLOCATABLE :: Jac_Idx_BStC_u !< the start and end indices of blade StC u jacobian [ start/end, blade, instance ] [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_Idx_NStC_u !< the start and end indices of nacelle StC u jacobian [ start/end, instance ] [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_Idx_TStC_u !< the start and end indices of tower StC u jacobian [ start/end, instance ] [-] @@ -494,54 +494,54 @@ MODULE ServoDyn_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_Idx_NStC_y !< the start and end indices of nacelle StC y jacobian [ start/end, instance ] [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_Idx_TStC_y !< the start and end indices of tower StC y jacobian [ start/end, instance ] [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_Idx_SStC_y !< the start and end indices of substructure StC y jacobian [ start/end, instance ] [-] - INTEGER(IntKi) :: SensorType !< Lidar sensor type [-] - INTEGER(IntKi) :: NumBeam !< Number of beams [-] - INTEGER(IntKi) :: NumPulseGate !< Number of pulse gates [-] - REAL(ReKi) :: PulseSpacing !< Distance between range gates [m] - REAL(ReKi) :: URefLid !< Reference average wind speed for the lidar [m/s] + INTEGER(IntKi) :: SensorType = 0_IntKi !< Lidar sensor type [-] + INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of beams [-] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< Number of pulse gates [-] + REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [m] + REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] END TYPE SrvD_ParameterType ! ======================= ! ========= SrvD_InputType ======= TYPE, PUBLIC :: SrvD_InputType REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitch !< Current blade pitch angles [radians] - REAL(ReKi) :: Yaw !< Current nacelle yaw [radians] - REAL(ReKi) :: YawRate !< Current nacelle yaw rate [rad/s] - REAL(ReKi) :: LSS_Spd !< Low-speed shaft (LSS) speed at entrance to gearbox [rad/s] - REAL(ReKi) :: HSS_Spd !< High-speed shaft (HSS) speed [rad/s] - REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] - REAL(ReKi) :: ExternalYawPosCom !< Commanded nacelle yaw position from Simulink or Labview [radians] - REAL(ReKi) :: ExternalYawRateCom !< Commanded nacelle yaw rate from Simulink or Labview [rad/s] + REAL(ReKi) :: Yaw = 0.0_ReKi !< Current nacelle yaw [radians] + REAL(ReKi) :: YawRate = 0.0_ReKi !< Current nacelle yaw rate [rad/s] + REAL(ReKi) :: LSS_Spd = 0.0_ReKi !< Low-speed shaft (LSS) speed at entrance to gearbox [rad/s] + REAL(ReKi) :: HSS_Spd = 0.0_ReKi !< High-speed shaft (HSS) speed [rad/s] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: ExternalYawPosCom = 0.0_ReKi !< Commanded nacelle yaw position from Simulink or Labview [radians] + REAL(ReKi) :: ExternalYawRateCom = 0.0_ReKi !< Commanded nacelle yaw rate from Simulink or Labview [rad/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ExternalBlPitchCom !< Commanded blade pitch from Simulink or LabVIEW [radians] - REAL(ReKi) :: ExternalGenTrq !< Electrical generator torque from Simulink or LabVIEW [N-m] - REAL(ReKi) :: ExternalElecPwr !< Electrical power from Simulink or LabVIEW [W] - REAL(ReKi) :: ExternalHSSBrFrac !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW [-] + REAL(ReKi) :: ExternalGenTrq = 0.0_ReKi !< Electrical generator torque from Simulink or LabVIEW [N-m] + REAL(ReKi) :: ExternalElecPwr = 0.0_ReKi !< Electrical power from Simulink or LabVIEW [W] + REAL(ReKi) :: ExternalHSSBrFrac = 0.0_ReKi !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ExternalBlAirfoilCom !< Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ExternalCableDeltaL !< Commanded Cable controlo DeltaL [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ExternalCableDeltaLdot !< Commanded Cable controlo DeltaLdot [m/s] - REAL(ReKi) :: TwrAccel !< Tower acceleration for tower feedback control (user routine only) [m/s^2] - REAL(ReKi) :: YawErr !< Yaw error [radians] - REAL(ReKi) :: WindDir !< Wind direction [radians] - REAL(ReKi) , DIMENSION(1:3) :: RootMyc !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] - REAL(ReKi) :: YawBrTAxp !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: YawBrTAyp !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: LSSTipPxa !< Rotor azimuth angle (position) [radians] - REAL(ReKi) , DIMENSION(1:3) :: RootMxc !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] - REAL(ReKi) :: LSSTipMxa !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMya !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMza !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMys !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMzs !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: YawBrMyn !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] - REAL(ReKi) :: YawBrMzn !< Tower-top / yaw bearing yaw moment [N-m] - REAL(ReKi) :: NcIMURAxs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAys !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAzs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: RotPwr !< Rotor power (this is equivalent to the low-speed shaft power) [W] - REAL(ReKi) :: HorWindV !< Horizontal hub-height wind velocity magnitude [m/s] - REAL(ReKi) :: YawAngle !< Estimate of yaw (nacelle + platform) [radians] - REAL(ReKi) :: LSShftFxa !< Rotating low-speed shaft force x [N] - REAL(ReKi) :: LSShftFys !< Nonrotating low-speed shaft force y [N] - REAL(ReKi) :: LSShftFzs !< Nonrotating low-speed shaft force z [N] + REAL(ReKi) :: TwrAccel = 0.0_ReKi !< Tower acceleration for tower feedback control (user routine only) [m/s^2] + REAL(ReKi) :: YawErr = 0.0_ReKi !< Yaw error [radians] + REAL(ReKi) :: WindDir = 0.0_ReKi !< Wind direction [radians] + REAL(ReKi) , DIMENSION(1:3) :: RootMyc = 0.0_ReKi !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] + REAL(ReKi) :: YawBrTAxp = 0.0_ReKi !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: YawBrTAyp = 0.0_ReKi !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: LSSTipPxa = 0.0_ReKi !< Rotor azimuth angle (position) [radians] + REAL(ReKi) , DIMENSION(1:3) :: RootMxc = 0.0_ReKi !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] + REAL(ReKi) :: LSSTipMxa = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMya = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMza = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMys = 0.0_ReKi !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMzs = 0.0_ReKi !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: YawBrMyn = 0.0_ReKi !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] + REAL(ReKi) :: YawBrMzn = 0.0_ReKi !< Tower-top / yaw bearing yaw moment [N-m] + REAL(ReKi) :: NcIMURAxs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAys = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAzs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: RotPwr = 0.0_ReKi !< Rotor power (this is equivalent to the low-speed shaft power) [W] + REAL(ReKi) :: HorWindV = 0.0_ReKi !< Horizontal hub-height wind velocity magnitude [m/s] + REAL(ReKi) :: YawAngle = 0.0_ReKi !< Estimate of yaw (nacelle + platform) [radians] + REAL(ReKi) :: LSShftFxa = 0.0_ReKi !< Rotating low-speed shaft force x [N] + REAL(ReKi) :: LSShftFys = 0.0_ReKi !< Nonrotating low-speed shaft force y [N] + REAL(ReKi) :: LSShftFzs = 0.0_ReKi !< Nonrotating low-speed shaft force z [N] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSC !< A swap array: used to pass turbine specific input data to the DLL controller from the supercontroller [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSCglob !< A swap array: used to pass global input data to the DLL controller from the supercontroller [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: Lidar !< A swap array: used to pass input data to the DLL controller from the Lidar [-] @@ -561,10 +561,10 @@ MODULE ServoDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchCom !< Commanded blade pitch angles [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlAirfoilCom !< Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] - REAL(ReKi) :: YawMom !< Torque transmitted through the yaw bearing [N-m] - REAL(ReKi) :: GenTrq !< Electrical generator torque [N-m] - REAL(ReKi) :: HSSBrTrqC !< Commanded HSS brake torque [N-m] - REAL(ReKi) :: ElecPwr !< Electrical power [W] + REAL(ReKi) :: YawMom = 0.0_ReKi !< Torque transmitted through the yaw bearing [N-m] + REAL(ReKi) :: GenTrq = 0.0_ReKi !< Electrical generator torque [N-m] + REAL(ReKi) :: HSSBrTrqC = 0.0_ReKi !< Commanded HSS brake torque [N-m] + REAL(ReKi) :: ElecPwr = 0.0_ReKi !< Electrical power [W] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TBDrCon !< Instantaneous tip-brake drag constant, Cd*Area [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: Lidar !< A swap array: used to pass output data from the DLL controller to the Lidar [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CableDeltaL !< Cable control -- Length change request (passed to MD or SD) [m] @@ -577,17608 +577,8026 @@ MODULE ServoDyn_Types END TYPE SrvD_OutputType ! ======================= CONTAINS - SUBROUTINE SrvD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SrvD_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%NumBl = SrcInitInputData%NumBl - DstInitInputData%RootName = SrcInitInputData%RootName -IF (ALLOCATED(SrcInitInputData%BlPitchInit)) THEN - i1_l = LBOUND(SrcInitInputData%BlPitchInit,1) - i1_u = UBOUND(SrcInitInputData%BlPitchInit,1) - IF (.NOT. ALLOCATED(DstInitInputData%BlPitchInit)) THEN - ALLOCATE(DstInitInputData%BlPitchInit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BlPitchInit = SrcInitInputData%BlPitchInit -ENDIF - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%NacRefPos = SrcInitInputData%NacRefPos - DstInitInputData%NacTransDisp = SrcInitInputData%NacTransDisp - DstInitInputData%NacOrient = SrcInitInputData%NacOrient - DstInitInputData%NacRefOrient = SrcInitInputData%NacRefOrient - DstInitInputData%TwrBaseRefPos = SrcInitInputData%TwrBaseRefPos - DstInitInputData%TwrBaseTransDisp = SrcInitInputData%TwrBaseTransDisp - DstInitInputData%TwrBaseOrient = SrcInitInputData%TwrBaseOrient - DstInitInputData%TwrBaseRefOrient = SrcInitInputData%TwrBaseRefOrient - DstInitInputData%PtfmRefPos = SrcInitInputData%PtfmRefPos - DstInitInputData%PtfmTransDisp = SrcInitInputData%PtfmTransDisp - DstInitInputData%PtfmOrient = SrcInitInputData%PtfmOrient - DstInitInputData%PtfmRefOrient = SrcInitInputData%PtfmRefOrient - DstInitInputData%Tmax = SrcInitInputData%Tmax - DstInitInputData%AvgWindSpeed = SrcInitInputData%AvgWindSpeed - DstInitInputData%AirDens = SrcInitInputData%AirDens - DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob - DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl - DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC - DstInitInputData%TrimCase = SrcInitInputData%TrimCase - DstInitInputData%TrimGain = SrcInitInputData%TrimGain - DstInitInputData%RotSpeedRef = SrcInitInputData%RotSpeedRef -IF (ALLOCATED(SrcInitInputData%BladeRootRefPos)) THEN - i1_l = LBOUND(SrcInitInputData%BladeRootRefPos,1) - i1_u = UBOUND(SrcInitInputData%BladeRootRefPos,1) - i2_l = LBOUND(SrcInitInputData%BladeRootRefPos,2) - i2_u = UBOUND(SrcInitInputData%BladeRootRefPos,2) - IF (.NOT. ALLOCATED(DstInitInputData%BladeRootRefPos)) THEN - ALLOCATE(DstInitInputData%BladeRootRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BladeRootRefPos = SrcInitInputData%BladeRootRefPos -ENDIF -IF (ALLOCATED(SrcInitInputData%BladeRootTransDisp)) THEN - i1_l = LBOUND(SrcInitInputData%BladeRootTransDisp,1) - i1_u = UBOUND(SrcInitInputData%BladeRootTransDisp,1) - i2_l = LBOUND(SrcInitInputData%BladeRootTransDisp,2) - i2_u = UBOUND(SrcInitInputData%BladeRootTransDisp,2) - IF (.NOT. ALLOCATED(DstInitInputData%BladeRootTransDisp)) THEN - ALLOCATE(DstInitInputData%BladeRootTransDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootTransDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BladeRootTransDisp = SrcInitInputData%BladeRootTransDisp -ENDIF -IF (ALLOCATED(SrcInitInputData%BladeRootOrient)) THEN - i1_l = LBOUND(SrcInitInputData%BladeRootOrient,1) - i1_u = UBOUND(SrcInitInputData%BladeRootOrient,1) - i2_l = LBOUND(SrcInitInputData%BladeRootOrient,2) - i2_u = UBOUND(SrcInitInputData%BladeRootOrient,2) - i3_l = LBOUND(SrcInitInputData%BladeRootOrient,3) - i3_u = UBOUND(SrcInitInputData%BladeRootOrient,3) - IF (.NOT. ALLOCATED(DstInitInputData%BladeRootOrient)) THEN - ALLOCATE(DstInitInputData%BladeRootOrient(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%BladeRootOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BladeRootOrient = SrcInitInputData%BladeRootOrient -ENDIF -IF (ALLOCATED(SrcInitInputData%BladeRootRefOrient)) THEN - i1_l = LBOUND(SrcInitInputData%BladeRootRefOrient,1) - i1_u = UBOUND(SrcInitInputData%BladeRootRefOrient,1) - i2_l = LBOUND(SrcInitInputData%BladeRootRefOrient,2) - i2_u = UBOUND(SrcInitInputData%BladeRootRefOrient,2) - i3_l = LBOUND(SrcInitInputData%BladeRootRefOrient,3) - i3_u = UBOUND(SrcInitInputData%BladeRootRefOrient,3) - IF (.NOT. ALLOCATED(DstInitInputData%BladeRootRefOrient)) THEN - ALLOCATE(DstInitInputData%BladeRootRefOrient(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%BladeRootRefOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BladeRootRefOrient = SrcInitInputData%BladeRootRefOrient -ENDIF - DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%NumCableControl = SrcInitInputData%NumCableControl -IF (ALLOCATED(SrcInitInputData%CableControlRequestor)) THEN - i1_l = LBOUND(SrcInitInputData%CableControlRequestor,1) - i1_u = UBOUND(SrcInitInputData%CableControlRequestor,1) - IF (.NOT. ALLOCATED(DstInitInputData%CableControlRequestor)) THEN - ALLOCATE(DstInitInputData%CableControlRequestor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CableControlRequestor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%CableControlRequestor = SrcInitInputData%CableControlRequestor -ENDIF - DstInitInputData%InterpOrder = SrcInitInputData%InterpOrder -IF (ALLOCATED(SrcInitInputData%fromSCGlob)) THEN - i1_l = LBOUND(SrcInitInputData%fromSCGlob,1) - i1_u = UBOUND(SrcInitInputData%fromSCGlob,1) - IF (.NOT. ALLOCATED(DstInitInputData%fromSCGlob)) THEN - ALLOCATE(DstInitInputData%fromSCGlob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSCGlob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob -ENDIF -IF (ALLOCATED(SrcInitInputData%fromSC)) THEN - i1_l = LBOUND(SrcInitInputData%fromSC,1) - i1_u = UBOUND(SrcInitInputData%fromSC,1) - IF (.NOT. ALLOCATED(DstInitInputData%fromSC)) THEN - ALLOCATE(DstInitInputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%fromSC = SrcInitInputData%fromSC -ENDIF -IF (ALLOCATED(SrcInitInputData%LidSpeed)) THEN - i1_l = LBOUND(SrcInitInputData%LidSpeed,1) - i1_u = UBOUND(SrcInitInputData%LidSpeed,1) - IF (.NOT. ALLOCATED(DstInitInputData%LidSpeed)) THEN - ALLOCATE(DstInitInputData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%LidSpeed = SrcInitInputData%LidSpeed -ENDIF -IF (ALLOCATED(SrcInitInputData%MsrPositionsX)) THEN - i1_l = LBOUND(SrcInitInputData%MsrPositionsX,1) - i1_u = UBOUND(SrcInitInputData%MsrPositionsX,1) - IF (.NOT. ALLOCATED(DstInitInputData%MsrPositionsX)) THEN - ALLOCATE(DstInitInputData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%MsrPositionsX = SrcInitInputData%MsrPositionsX -ENDIF -IF (ALLOCATED(SrcInitInputData%MsrPositionsY)) THEN - i1_l = LBOUND(SrcInitInputData%MsrPositionsY,1) - i1_u = UBOUND(SrcInitInputData%MsrPositionsY,1) - IF (.NOT. ALLOCATED(DstInitInputData%MsrPositionsY)) THEN - ALLOCATE(DstInitInputData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%MsrPositionsY = SrcInitInputData%MsrPositionsY -ENDIF -IF (ALLOCATED(SrcInitInputData%MsrPositionsZ)) THEN - i1_l = LBOUND(SrcInitInputData%MsrPositionsZ,1) - i1_u = UBOUND(SrcInitInputData%MsrPositionsZ,1) - IF (.NOT. ALLOCATED(DstInitInputData%MsrPositionsZ)) THEN - ALLOCATE(DstInitInputData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%MsrPositionsZ = SrcInitInputData%MsrPositionsZ -ENDIF - DstInitInputData%SensorType = SrcInitInputData%SensorType - DstInitInputData%NumBeam = SrcInitInputData%NumBeam - DstInitInputData%NumPulseGate = SrcInitInputData%NumPulseGate - DstInitInputData%PulseSpacing = SrcInitInputData%PulseSpacing - DstInitInputData%URefLid = SrcInitInputData%URefLid - END SUBROUTINE SrvD_CopyInitInput - - SUBROUTINE SrvD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SrvD_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 = 'SrvD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%BlPitchInit)) THEN - DEALLOCATE(InitInputData%BlPitchInit) -ENDIF -IF (ALLOCATED(InitInputData%BladeRootRefPos)) THEN - DEALLOCATE(InitInputData%BladeRootRefPos) -ENDIF -IF (ALLOCATED(InitInputData%BladeRootTransDisp)) THEN - DEALLOCATE(InitInputData%BladeRootTransDisp) -ENDIF -IF (ALLOCATED(InitInputData%BladeRootOrient)) THEN - DEALLOCATE(InitInputData%BladeRootOrient) -ENDIF -IF (ALLOCATED(InitInputData%BladeRootRefOrient)) THEN - DEALLOCATE(InitInputData%BladeRootRefOrient) -ENDIF - CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitInputData%CableControlRequestor)) THEN - DEALLOCATE(InitInputData%CableControlRequestor) -ENDIF -IF (ALLOCATED(InitInputData%fromSCGlob)) THEN - DEALLOCATE(InitInputData%fromSCGlob) -ENDIF -IF (ALLOCATED(InitInputData%fromSC)) THEN - DEALLOCATE(InitInputData%fromSC) -ENDIF -IF (ALLOCATED(InitInputData%LidSpeed)) THEN - DEALLOCATE(InitInputData%LidSpeed) -ENDIF -IF (ALLOCATED(InitInputData%MsrPositionsX)) THEN - DEALLOCATE(InitInputData%MsrPositionsX) -ENDIF -IF (ALLOCATED(InitInputData%MsrPositionsY)) THEN - DEALLOCATE(InitInputData%MsrPositionsY) -ENDIF -IF (ALLOCATED(InitInputData%MsrPositionsZ)) THEN - DEALLOCATE(InitInputData%MsrPositionsZ) -ENDIF - END SUBROUTINE SrvD_DestroyInitInput - - SUBROUTINE SrvD_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(SrvD_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 = 'SrvD_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 ! Linearize - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! BlPitchInit allocated yes/no - IF ( ALLOCATED(InData%BlPitchInit) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchInit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchInit) ! BlPitchInit - END IF - Re_BufSz = Re_BufSz + SIZE(InData%Gravity) ! Gravity - Re_BufSz = Re_BufSz + SIZE(InData%NacRefPos) ! NacRefPos - Db_BufSz = Db_BufSz + SIZE(InData%NacTransDisp) ! NacTransDisp - Db_BufSz = Db_BufSz + SIZE(InData%NacOrient) ! NacOrient - Db_BufSz = Db_BufSz + SIZE(InData%NacRefOrient) ! NacRefOrient - Re_BufSz = Re_BufSz + SIZE(InData%TwrBaseRefPos) ! TwrBaseRefPos - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseTransDisp) ! TwrBaseTransDisp - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseOrient) ! TwrBaseOrient - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseRefOrient) ! TwrBaseRefOrient - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefPos) ! PtfmRefPos - Db_BufSz = Db_BufSz + SIZE(InData%PtfmTransDisp) ! PtfmTransDisp - Db_BufSz = Db_BufSz + SIZE(InData%PtfmOrient) ! PtfmOrient - Db_BufSz = Db_BufSz + SIZE(InData%PtfmRefOrient) ! PtfmRefOrient - Db_BufSz = Db_BufSz + 1 ! Tmax - Re_BufSz = Re_BufSz + 1 ! AvgWindSpeed - Re_BufSz = Re_BufSz + 1 ! AirDens - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! TrimCase - Re_BufSz = Re_BufSz + 1 ! TrimGain - Re_BufSz = Re_BufSz + 1 ! RotSpeedRef - Int_BufSz = Int_BufSz + 1 ! BladeRootRefPos allocated yes/no - IF ( ALLOCATED(InData%BladeRootRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BladeRootRefPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BladeRootRefPos) ! BladeRootRefPos - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootTransDisp allocated yes/no - IF ( ALLOCATED(InData%BladeRootTransDisp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BladeRootTransDisp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BladeRootTransDisp) ! BladeRootTransDisp - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootOrient allocated yes/no - IF ( ALLOCATED(InData%BladeRootOrient) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BladeRootOrient upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BladeRootOrient) ! BladeRootOrient - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootRefOrient allocated yes/no - IF ( ALLOCATED(InData%BladeRootRefOrient) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BladeRootRefOrient upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BladeRootRefOrient) ! BladeRootRefOrient - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedPrimaryInputData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedPrimaryInputData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedPrimaryInputData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! NumCableControl - Int_BufSz = Int_BufSz + 1 ! CableControlRequestor allocated yes/no - IF ( ALLOCATED(InData%CableControlRequestor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableControlRequestor upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CableControlRequestor)*LEN(InData%CableControlRequestor) ! CableControlRequestor - END IF - Int_BufSz = Int_BufSz + 1 ! InterpOrder - Int_BufSz = Int_BufSz + 1 ! fromSCGlob allocated yes/no - IF ( ALLOCATED(InData%fromSCGlob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCGlob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCGlob) ! fromSCGlob - END IF - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ALLOCATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - END IF - Int_BufSz = Int_BufSz + 1 ! LidSpeed allocated yes/no - IF ( ALLOCATED(InData%LidSpeed) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LidSpeed upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LidSpeed) ! LidSpeed - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsX allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsX) ! MsrPositionsX - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsY allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsY) ! MsrPositionsY - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsZ allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsZ) ! MsrPositionsZ - END IF - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! NumBeam - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Re_BufSz = Re_BufSz + 1 ! PulseSpacing - Re_BufSz = Re_BufSz + 1 ! URefLid - 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%BlPitchInit) ) 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%BlPitchInit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInit,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchInit,1), UBOUND(InData%BlPitchInit,1) - ReKiBuf(Re_Xferred) = InData%BlPitchInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%Gravity,1), UBOUND(InData%Gravity,1) - ReKiBuf(Re_Xferred) = InData%Gravity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%NacRefPos,1), UBOUND(InData%NacRefPos,1) - ReKiBuf(Re_Xferred) = InData%NacRefPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%NacTransDisp,1), UBOUND(InData%NacTransDisp,1) - DbKiBuf(Db_Xferred) = InData%NacTransDisp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%NacOrient,2), UBOUND(InData%NacOrient,2) - DO i1 = LBOUND(InData%NacOrient,1), UBOUND(InData%NacOrient,1) - DbKiBuf(Db_Xferred) = InData%NacOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%NacRefOrient,2), UBOUND(InData%NacRefOrient,2) - DO i1 = LBOUND(InData%NacRefOrient,1), UBOUND(InData%NacRefOrient,1) - DbKiBuf(Db_Xferred) = InData%NacRefOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%TwrBaseRefPos,1), UBOUND(InData%TwrBaseRefPos,1) - ReKiBuf(Re_Xferred) = InData%TwrBaseRefPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TwrBaseTransDisp,1), UBOUND(InData%TwrBaseTransDisp,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseTransDisp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%TwrBaseOrient,2), UBOUND(InData%TwrBaseOrient,2) - DO i1 = LBOUND(InData%TwrBaseOrient,1), UBOUND(InData%TwrBaseOrient,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%TwrBaseRefOrient,2), UBOUND(InData%TwrBaseRefOrient,2) - DO i1 = LBOUND(InData%TwrBaseRefOrient,1), UBOUND(InData%TwrBaseRefOrient,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseRefOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%PtfmRefPos,1), UBOUND(InData%PtfmRefPos,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PtfmTransDisp,1), UBOUND(InData%PtfmTransDisp,1) - DbKiBuf(Db_Xferred) = InData%PtfmTransDisp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%PtfmOrient,2), UBOUND(InData%PtfmOrient,2) - DO i1 = LBOUND(InData%PtfmOrient,1), UBOUND(InData%PtfmOrient,1) - DbKiBuf(Db_Xferred) = InData%PtfmOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%PtfmRefOrient,2), UBOUND(InData%PtfmRefOrient,2) - DO i1 = LBOUND(InData%PtfmRefOrient,1), UBOUND(InData%PtfmRefOrient,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DbKiBuf(Db_Xferred) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AvgWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TrimCase - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TrimGain - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeedRef - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BladeRootRefPos) ) 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%BladeRootRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootRefPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootRefPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootRefPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BladeRootRefPos,2), UBOUND(InData%BladeRootRefPos,2) - DO i1 = LBOUND(InData%BladeRootRefPos,1), UBOUND(InData%BladeRootRefPos,1) - ReKiBuf(Re_Xferred) = InData%BladeRootRefPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeRootTransDisp) ) 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%BladeRootTransDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootTransDisp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootTransDisp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootTransDisp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BladeRootTransDisp,2), UBOUND(InData%BladeRootTransDisp,2) - DO i1 = LBOUND(InData%BladeRootTransDisp,1), UBOUND(InData%BladeRootTransDisp,1) - DbKiBuf(Db_Xferred) = InData%BladeRootTransDisp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeRootOrient) ) 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%BladeRootOrient,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrient,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrient,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrient,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrient,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrient,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%BladeRootOrient,3), UBOUND(InData%BladeRootOrient,3) - DO i2 = LBOUND(InData%BladeRootOrient,2), UBOUND(InData%BladeRootOrient,2) - DO i1 = LBOUND(InData%BladeRootOrient,1), UBOUND(InData%BladeRootOrient,1) - DbKiBuf(Db_Xferred) = InData%BladeRootOrient(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeRootRefOrient) ) 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%BladeRootRefOrient,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootRefOrient,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootRefOrient,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootRefOrient,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootRefOrient,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootRefOrient,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%BladeRootRefOrient,3), UBOUND(InData%BladeRootRefOrient,3) - DO i2 = LBOUND(InData%BladeRootRefOrient,2), UBOUND(InData%BladeRootRefOrient,2) - DO i1 = LBOUND(InData%BladeRootRefOrient,1), UBOUND(InData%BladeRootRefOrient,1) - DbKiBuf(Db_Xferred) = InData%BladeRootRefOrient(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - 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 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%NumCableControl - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CableControlRequestor) ) 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%CableControlRequestor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableControlRequestor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableControlRequestor,1), UBOUND(InData%CableControlRequestor,1) - DO I = 1, LEN(InData%CableControlRequestor) - IntKiBuf(Int_Xferred) = ICHAR(InData%CableControlRequestor(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%InterpOrder - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%fromSCGlob) ) 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%fromSCGlob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCGlob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCGlob,1), UBOUND(InData%fromSCGlob,1) - ReKiBuf(Re_Xferred) = InData%fromSCGlob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fromSC) ) 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%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LidSpeed) ) 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%LidSpeed,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LidSpeed,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LidSpeed,1), UBOUND(InData%LidSpeed,1) - ReKiBuf(Re_Xferred) = InData%LidSpeed(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsX) ) 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%MsrPositionsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsX,1), UBOUND(InData%MsrPositionsX,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsY) ) 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%MsrPositionsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsY,1), UBOUND(InData%MsrPositionsY,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsZ) ) 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%MsrPositionsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsZ,1), UBOUND(InData%MsrPositionsZ,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBeam - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PulseSpacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%URefLid - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SrvD_PackInitInput - - SUBROUTINE SrvD_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(SrvD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_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%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInit 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%BlPitchInit)) DEALLOCATE(OutData%BlPitchInit) - ALLOCATE(OutData%BlPitchInit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchInit,1), UBOUND(OutData%BlPitchInit,1) - OutData%BlPitchInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%Gravity,1) - i1_u = UBOUND(OutData%Gravity,1) - DO i1 = LBOUND(OutData%Gravity,1), UBOUND(OutData%Gravity,1) - OutData%Gravity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NacRefPos,1) - i1_u = UBOUND(OutData%NacRefPos,1) - DO i1 = LBOUND(OutData%NacRefPos,1), UBOUND(OutData%NacRefPos,1) - OutData%NacRefPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NacTransDisp,1) - i1_u = UBOUND(OutData%NacTransDisp,1) - DO i1 = LBOUND(OutData%NacTransDisp,1), UBOUND(OutData%NacTransDisp,1) - OutData%NacTransDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NacOrient,1) - i1_u = UBOUND(OutData%NacOrient,1) - i2_l = LBOUND(OutData%NacOrient,2) - i2_u = UBOUND(OutData%NacOrient,2) - DO i2 = LBOUND(OutData%NacOrient,2), UBOUND(OutData%NacOrient,2) - DO i1 = LBOUND(OutData%NacOrient,1), UBOUND(OutData%NacOrient,1) - OutData%NacOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%NacRefOrient,1) - i1_u = UBOUND(OutData%NacRefOrient,1) - i2_l = LBOUND(OutData%NacRefOrient,2) - i2_u = UBOUND(OutData%NacRefOrient,2) - DO i2 = LBOUND(OutData%NacRefOrient,2), UBOUND(OutData%NacRefOrient,2) - DO i1 = LBOUND(OutData%NacRefOrient,1), UBOUND(OutData%NacRefOrient,1) - OutData%NacRefOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%TwrBaseRefPos,1) - i1_u = UBOUND(OutData%TwrBaseRefPos,1) - DO i1 = LBOUND(OutData%TwrBaseRefPos,1), UBOUND(OutData%TwrBaseRefPos,1) - OutData%TwrBaseRefPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrBaseTransDisp,1) - i1_u = UBOUND(OutData%TwrBaseTransDisp,1) - DO i1 = LBOUND(OutData%TwrBaseTransDisp,1), UBOUND(OutData%TwrBaseTransDisp,1) - OutData%TwrBaseTransDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrBaseOrient,1) - i1_u = UBOUND(OutData%TwrBaseOrient,1) - i2_l = LBOUND(OutData%TwrBaseOrient,2) - i2_u = UBOUND(OutData%TwrBaseOrient,2) - DO i2 = LBOUND(OutData%TwrBaseOrient,2), UBOUND(OutData%TwrBaseOrient,2) - DO i1 = LBOUND(OutData%TwrBaseOrient,1), UBOUND(OutData%TwrBaseOrient,1) - OutData%TwrBaseOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%TwrBaseRefOrient,1) - i1_u = UBOUND(OutData%TwrBaseRefOrient,1) - i2_l = LBOUND(OutData%TwrBaseRefOrient,2) - i2_u = UBOUND(OutData%TwrBaseRefOrient,2) - DO i2 = LBOUND(OutData%TwrBaseRefOrient,2), UBOUND(OutData%TwrBaseRefOrient,2) - DO i1 = LBOUND(OutData%TwrBaseRefOrient,1), UBOUND(OutData%TwrBaseRefOrient,1) - OutData%TwrBaseRefOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%PtfmRefPos,1) - i1_u = UBOUND(OutData%PtfmRefPos,1) - DO i1 = LBOUND(OutData%PtfmRefPos,1), UBOUND(OutData%PtfmRefPos,1) - OutData%PtfmRefPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PtfmTransDisp,1) - i1_u = UBOUND(OutData%PtfmTransDisp,1) - DO i1 = LBOUND(OutData%PtfmTransDisp,1), UBOUND(OutData%PtfmTransDisp,1) - OutData%PtfmTransDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PtfmOrient,1) - i1_u = UBOUND(OutData%PtfmOrient,1) - i2_l = LBOUND(OutData%PtfmOrient,2) - i2_u = UBOUND(OutData%PtfmOrient,2) - DO i2 = LBOUND(OutData%PtfmOrient,2), UBOUND(OutData%PtfmOrient,2) - DO i1 = LBOUND(OutData%PtfmOrient,1), UBOUND(OutData%PtfmOrient,1) - OutData%PtfmOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%PtfmRefOrient,1) - i1_u = UBOUND(OutData%PtfmRefOrient,1) - i2_l = LBOUND(OutData%PtfmRefOrient,2) - i2_u = UBOUND(OutData%PtfmRefOrient,2) - DO i2 = LBOUND(OutData%PtfmRefOrient,2), UBOUND(OutData%PtfmRefOrient,2) - DO i1 = LBOUND(OutData%PtfmRefOrient,1), UBOUND(OutData%PtfmRefOrient,1) - OutData%PtfmRefOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%Tmax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%AvgWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TrimCase = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TrimGain = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeedRef = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootRefPos 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%BladeRootRefPos)) DEALLOCATE(OutData%BladeRootRefPos) - ALLOCATE(OutData%BladeRootRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BladeRootRefPos,2), UBOUND(OutData%BladeRootRefPos,2) - DO i1 = LBOUND(OutData%BladeRootRefPos,1), UBOUND(OutData%BladeRootRefPos,1) - OutData%BladeRootRefPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootTransDisp 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%BladeRootTransDisp)) DEALLOCATE(OutData%BladeRootTransDisp) - ALLOCATE(OutData%BladeRootTransDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootTransDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BladeRootTransDisp,2), UBOUND(OutData%BladeRootTransDisp,2) - DO i1 = LBOUND(OutData%BladeRootTransDisp,1), UBOUND(OutData%BladeRootTransDisp,1) - OutData%BladeRootTransDisp(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootOrient 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%BladeRootOrient)) DEALLOCATE(OutData%BladeRootOrient) - ALLOCATE(OutData%BladeRootOrient(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%BladeRootOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%BladeRootOrient,3), UBOUND(OutData%BladeRootOrient,3) - DO i2 = LBOUND(OutData%BladeRootOrient,2), UBOUND(OutData%BladeRootOrient,2) - DO i1 = LBOUND(OutData%BladeRootOrient,1), UBOUND(OutData%BladeRootOrient,1) - OutData%BladeRootOrient(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootRefOrient 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%BladeRootRefOrient)) DEALLOCATE(OutData%BladeRootRefOrient) - ALLOCATE(OutData%BladeRootRefOrient(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%BladeRootRefOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%BladeRootRefOrient,3), UBOUND(OutData%BladeRootRefOrient,3) - DO i2 = LBOUND(OutData%BladeRootRefOrient,2), UBOUND(OutData%BladeRootRefOrient,2) - DO i1 = LBOUND(OutData%BladeRootRefOrient,1), UBOUND(OutData%BladeRootRefOrient,1) - OutData%BladeRootRefOrient(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - 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%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData - 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%NumCableControl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableControlRequestor 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%CableControlRequestor)) DEALLOCATE(OutData%CableControlRequestor) - ALLOCATE(OutData%CableControlRequestor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableControlRequestor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableControlRequestor,1), UBOUND(OutData%CableControlRequestor,1) - DO I = 1, LEN(OutData%CableControlRequestor) - OutData%CableControlRequestor(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%InterpOrder = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCGlob 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%fromSCGlob)) DEALLOCATE(OutData%fromSCGlob) - ALLOCATE(OutData%fromSCGlob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCGlob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSCGlob,1), UBOUND(OutData%fromSCGlob,1) - OutData%fromSCGlob(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC 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%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LidSpeed 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%LidSpeed)) DEALLOCATE(OutData%LidSpeed) - ALLOCATE(OutData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LidSpeed,1), UBOUND(OutData%LidSpeed,1) - OutData%LidSpeed(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsX 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%MsrPositionsX)) DEALLOCATE(OutData%MsrPositionsX) - ALLOCATE(OutData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsX,1), UBOUND(OutData%MsrPositionsX,1) - OutData%MsrPositionsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsY 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%MsrPositionsY)) DEALLOCATE(OutData%MsrPositionsY) - ALLOCATE(OutData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsY,1), UBOUND(OutData%MsrPositionsY,1) - OutData%MsrPositionsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsZ 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%MsrPositionsZ)) DEALLOCATE(OutData%MsrPositionsZ) - ALLOCATE(OutData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsZ,1), UBOUND(OutData%MsrPositionsZ,1) - OutData%MsrPositionsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBeam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PulseSpacing = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%URefLid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SrvD_UnPackInitInput - - SUBROUTINE SrvD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SrvD_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 = 'SrvD_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 - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%CouplingScheme = SrcInitOutputData%CouplingScheme - DstInitOutputData%UseHSSBrake = SrcInitOutputData%UseHSSBrake -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN - ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF - END SUBROUTINE SrvD_CopyInitOutput - - SUBROUTINE SrvD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SrvD_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 = 'SrvD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN - DEALLOCATE(InitOutputData%RotFrame_x) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF - END SUBROUTINE SrvD_DestroyInitOutput - - SUBROUTINE SrvD_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(SrvD_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 = 'SrvD_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CouplingScheme - Int_BufSz = Int_BufSz + 1 ! UseHSSBrake - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - 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 - 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 - - 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%CouplingScheme - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseHSSBrake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) 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%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) 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%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) 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%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) 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%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) 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%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) 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%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) 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%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) 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%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_PackInitOutput - - SUBROUTINE SrvD_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(SrvD_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 = 'SrvD_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%CouplingScheme = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UseHSSBrake = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseHSSBrake) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y 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%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(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 ! LinNames_x 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%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(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 ! LinNames_u 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%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(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 ! RotFrame_y 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%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x 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%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u 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%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u 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%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x 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%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_UnPackInitOutput - - SUBROUTINE SrvD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(SrvD_InputFile), INTENT(INOUT) :: DstInputFileData - 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 = 'SrvD_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DT = SrcInputFileData%DT - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%PCMode = SrcInputFileData%PCMode - DstInputFileData%TPCOn = SrcInputFileData%TPCOn - DstInputFileData%TPitManS = SrcInputFileData%TPitManS - DstInputFileData%PitManRat = SrcInputFileData%PitManRat - DstInputFileData%BlPitchF = SrcInputFileData%BlPitchF - DstInputFileData%VSContrl = SrcInputFileData%VSContrl - DstInputFileData%GenModel = SrcInputFileData%GenModel - DstInputFileData%GenEff = SrcInputFileData%GenEff - DstInputFileData%GenTiStr = SrcInputFileData%GenTiStr - DstInputFileData%GenTiStp = SrcInputFileData%GenTiStp - DstInputFileData%SpdGenOn = SrcInputFileData%SpdGenOn - DstInputFileData%TimGenOn = SrcInputFileData%TimGenOn - DstInputFileData%TimGenOf = SrcInputFileData%TimGenOf - DstInputFileData%VS_RtGnSp = SrcInputFileData%VS_RtGnSp - DstInputFileData%VS_RtTq = SrcInputFileData%VS_RtTq - DstInputFileData%VS_Rgn2K = SrcInputFileData%VS_Rgn2K - DstInputFileData%VS_SlPc = SrcInputFileData%VS_SlPc - DstInputFileData%SIG_SlPc = SrcInputFileData%SIG_SlPc - DstInputFileData%SIG_SySp = SrcInputFileData%SIG_SySp - DstInputFileData%SIG_RtTq = SrcInputFileData%SIG_RtTq - DstInputFileData%SIG_PORt = SrcInputFileData%SIG_PORt - DstInputFileData%TEC_Freq = SrcInputFileData%TEC_Freq - DstInputFileData%TEC_NPol = SrcInputFileData%TEC_NPol - DstInputFileData%TEC_SRes = SrcInputFileData%TEC_SRes - DstInputFileData%TEC_RRes = SrcInputFileData%TEC_RRes - DstInputFileData%TEC_VLL = SrcInputFileData%TEC_VLL - DstInputFileData%TEC_SLR = SrcInputFileData%TEC_SLR - DstInputFileData%TEC_RLR = SrcInputFileData%TEC_RLR - DstInputFileData%TEC_MR = SrcInputFileData%TEC_MR - DstInputFileData%HSSBrMode = SrcInputFileData%HSSBrMode - DstInputFileData%THSSBrDp = SrcInputFileData%THSSBrDp - DstInputFileData%HSSBrDT = SrcInputFileData%HSSBrDT - DstInputFileData%HSSBrTqF = SrcInputFileData%HSSBrTqF - DstInputFileData%YCMode = SrcInputFileData%YCMode - DstInputFileData%TYCOn = SrcInputFileData%TYCOn - DstInputFileData%YawNeut = SrcInputFileData%YawNeut - DstInputFileData%YawSpr = SrcInputFileData%YawSpr - DstInputFileData%YawDamp = SrcInputFileData%YawDamp - DstInputFileData%TYawManS = SrcInputFileData%TYawManS - DstInputFileData%YawManRat = SrcInputFileData%YawManRat - DstInputFileData%NacYawF = SrcInputFileData%NacYawF - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%OutFile = SrcInputFileData%OutFile - DstInputFileData%TabDelim = SrcInputFileData%TabDelim - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%Tstart = SrcInputFileData%Tstart - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%DLL_FileName = SrcInputFileData%DLL_FileName - DstInputFileData%DLL_ProcName = SrcInputFileData%DLL_ProcName - DstInputFileData%DLL_InFile = SrcInputFileData%DLL_InFile - DstInputFileData%DLL_DT = SrcInputFileData%DLL_DT - DstInputFileData%DLL_Ramp = SrcInputFileData%DLL_Ramp - DstInputFileData%BPCutoff = SrcInputFileData%BPCutoff - DstInputFileData%NacYaw_North = SrcInputFileData%NacYaw_North - DstInputFileData%Ptch_Cntrl = SrcInputFileData%Ptch_Cntrl - DstInputFileData%Ptch_SetPnt = SrcInputFileData%Ptch_SetPnt - DstInputFileData%Ptch_Min = SrcInputFileData%Ptch_Min - DstInputFileData%Ptch_Max = SrcInputFileData%Ptch_Max - DstInputFileData%PtchRate_Min = SrcInputFileData%PtchRate_Min - DstInputFileData%PtchRate_Max = SrcInputFileData%PtchRate_Max - DstInputFileData%Gain_OM = SrcInputFileData%Gain_OM - DstInputFileData%GenSpd_MinOM = SrcInputFileData%GenSpd_MinOM - DstInputFileData%GenSpd_MaxOM = SrcInputFileData%GenSpd_MaxOM - DstInputFileData%GenSpd_Dem = SrcInputFileData%GenSpd_Dem - DstInputFileData%GenTrq_Dem = SrcInputFileData%GenTrq_Dem - DstInputFileData%GenPwr_Dem = SrcInputFileData%GenPwr_Dem - DstInputFileData%DLL_NumTrq = SrcInputFileData%DLL_NumTrq -IF (ALLOCATED(SrcInputFileData%GenSpd_TLU)) THEN - i1_l = LBOUND(SrcInputFileData%GenSpd_TLU,1) - i1_u = UBOUND(SrcInputFileData%GenSpd_TLU,1) - IF (.NOT. ALLOCATED(DstInputFileData%GenSpd_TLU)) THEN - ALLOCATE(DstInputFileData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%GenSpd_TLU = SrcInputFileData%GenSpd_TLU -ENDIF -IF (ALLOCATED(SrcInputFileData%GenTrq_TLU)) THEN - i1_l = LBOUND(SrcInputFileData%GenTrq_TLU,1) - i1_u = UBOUND(SrcInputFileData%GenTrq_TLU,1) - IF (.NOT. ALLOCATED(DstInputFileData%GenTrq_TLU)) THEN - ALLOCATE(DstInputFileData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%GenTrq_TLU = SrcInputFileData%GenTrq_TLU -ENDIF - DstInputFileData%UseLegacyInterface = SrcInputFileData%UseLegacyInterface - DstInputFileData%NumBStC = SrcInputFileData%NumBStC -IF (ALLOCATED(SrcInputFileData%BStCfiles)) THEN - i1_l = LBOUND(SrcInputFileData%BStCfiles,1) - i1_u = UBOUND(SrcInputFileData%BStCfiles,1) - IF (.NOT. ALLOCATED(DstInputFileData%BStCfiles)) THEN - ALLOCATE(DstInputFileData%BStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BStCfiles = SrcInputFileData%BStCfiles -ENDIF - DstInputFileData%NumNStC = SrcInputFileData%NumNStC -IF (ALLOCATED(SrcInputFileData%NStCfiles)) THEN - i1_l = LBOUND(SrcInputFileData%NStCfiles,1) - i1_u = UBOUND(SrcInputFileData%NStCfiles,1) - IF (.NOT. ALLOCATED(DstInputFileData%NStCfiles)) THEN - ALLOCATE(DstInputFileData%NStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%NStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%NStCfiles = SrcInputFileData%NStCfiles -ENDIF - DstInputFileData%NumTStC = SrcInputFileData%NumTStC -IF (ALLOCATED(SrcInputFileData%TStCfiles)) THEN - i1_l = LBOUND(SrcInputFileData%TStCfiles,1) - i1_u = UBOUND(SrcInputFileData%TStCfiles,1) - IF (.NOT. ALLOCATED(DstInputFileData%TStCfiles)) THEN - ALLOCATE(DstInputFileData%TStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TStCfiles = SrcInputFileData%TStCfiles -ENDIF - DstInputFileData%NumSStC = SrcInputFileData%NumSStC -IF (ALLOCATED(SrcInputFileData%SStCfiles)) THEN - i1_l = LBOUND(SrcInputFileData%SStCfiles,1) - i1_u = UBOUND(SrcInputFileData%SStCfiles,1) - IF (.NOT. ALLOCATED(DstInputFileData%SStCfiles)) THEN - ALLOCATE(DstInputFileData%SStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%SStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%SStCfiles = SrcInputFileData%SStCfiles -ENDIF - DstInputFileData%AfCmode = SrcInputFileData%AfCmode - DstInputFileData%AfC_Mean = SrcInputFileData%AfC_Mean - DstInputFileData%AfC_Amp = SrcInputFileData%AfC_Amp - DstInputFileData%AfC_Phase = SrcInputFileData%AfC_Phase - DstInputFileData%CCmode = SrcInputFileData%CCmode - DstInputFileData%EXavrSWAP = SrcInputFileData%EXavrSWAP - END SUBROUTINE SrvD_CopyInputFile - - SUBROUTINE SrvD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData - 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 = 'SrvD_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF -IF (ALLOCATED(InputFileData%GenSpd_TLU)) THEN - DEALLOCATE(InputFileData%GenSpd_TLU) -ENDIF -IF (ALLOCATED(InputFileData%GenTrq_TLU)) THEN - DEALLOCATE(InputFileData%GenTrq_TLU) -ENDIF -IF (ALLOCATED(InputFileData%BStCfiles)) THEN - DEALLOCATE(InputFileData%BStCfiles) -ENDIF -IF (ALLOCATED(InputFileData%NStCfiles)) THEN - DEALLOCATE(InputFileData%NStCfiles) -ENDIF -IF (ALLOCATED(InputFileData%TStCfiles)) THEN - DEALLOCATE(InputFileData%TStCfiles) -ENDIF -IF (ALLOCATED(InputFileData%SStCfiles)) THEN - DEALLOCATE(InputFileData%SStCfiles) -ENDIF - END SUBROUTINE SrvD_DestroyInputFile - - SUBROUTINE SrvD_PackInputFile( 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(SrvD_InputFile), 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 = 'SrvD_PackInputFile' - ! 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 ! Echo - Int_BufSz = Int_BufSz + 1 ! PCMode - Db_BufSz = Db_BufSz + 1 ! TPCOn - Db_BufSz = Db_BufSz + SIZE(InData%TPitManS) ! TPitManS - Re_BufSz = Re_BufSz + SIZE(InData%PitManRat) ! PitManRat - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchF) ! BlPitchF - Int_BufSz = Int_BufSz + 1 ! VSContrl - Int_BufSz = Int_BufSz + 1 ! GenModel - Re_BufSz = Re_BufSz + 1 ! GenEff - Int_BufSz = Int_BufSz + 1 ! GenTiStr - Int_BufSz = Int_BufSz + 1 ! GenTiStp - Re_BufSz = Re_BufSz + 1 ! SpdGenOn - Db_BufSz = Db_BufSz + 1 ! TimGenOn - Db_BufSz = Db_BufSz + 1 ! TimGenOf - Re_BufSz = Re_BufSz + 1 ! VS_RtGnSp - Re_BufSz = Re_BufSz + 1 ! VS_RtTq - Re_BufSz = Re_BufSz + 1 ! VS_Rgn2K - Re_BufSz = Re_BufSz + 1 ! VS_SlPc - Re_BufSz = Re_BufSz + 1 ! SIG_SlPc - Re_BufSz = Re_BufSz + 1 ! SIG_SySp - Re_BufSz = Re_BufSz + 1 ! SIG_RtTq - Re_BufSz = Re_BufSz + 1 ! SIG_PORt - Re_BufSz = Re_BufSz + 1 ! TEC_Freq - Int_BufSz = Int_BufSz + 1 ! TEC_NPol - Re_BufSz = Re_BufSz + 1 ! TEC_SRes - Re_BufSz = Re_BufSz + 1 ! TEC_RRes - Re_BufSz = Re_BufSz + 1 ! TEC_VLL - Re_BufSz = Re_BufSz + 1 ! TEC_SLR - Re_BufSz = Re_BufSz + 1 ! TEC_RLR - Re_BufSz = Re_BufSz + 1 ! TEC_MR - Int_BufSz = Int_BufSz + 1 ! HSSBrMode - Db_BufSz = Db_BufSz + 1 ! THSSBrDp - Db_BufSz = Db_BufSz + 1 ! HSSBrDT - Re_BufSz = Re_BufSz + 1 ! HSSBrTqF - Int_BufSz = Int_BufSz + 1 ! YCMode - Db_BufSz = Db_BufSz + 1 ! TYCOn - Re_BufSz = Re_BufSz + 1 ! YawNeut - Re_BufSz = Re_BufSz + 1 ! YawSpr - Re_BufSz = Re_BufSz + 1 ! YawDamp - Db_BufSz = Db_BufSz + 1 ! TYawManS - Re_BufSz = Re_BufSz + 1 ! YawManRat - Re_BufSz = Re_BufSz + 1 ! NacYawF - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! OutFile - Int_BufSz = Int_BufSz + 1 ! TabDelim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Db_BufSz = Db_BufSz + 1 ! Tstart - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_FileName) ! DLL_FileName - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_ProcName) ! DLL_ProcName - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InFile) ! DLL_InFile - Db_BufSz = Db_BufSz + 1 ! DLL_DT - Int_BufSz = Int_BufSz + 1 ! DLL_Ramp - Re_BufSz = Re_BufSz + 1 ! BPCutoff - Re_BufSz = Re_BufSz + 1 ! NacYaw_North - Int_BufSz = Int_BufSz + 1 ! Ptch_Cntrl - Re_BufSz = Re_BufSz + 1 ! Ptch_SetPnt - Re_BufSz = Re_BufSz + 1 ! Ptch_Min - Re_BufSz = Re_BufSz + 1 ! Ptch_Max - Re_BufSz = Re_BufSz + 1 ! PtchRate_Min - Re_BufSz = Re_BufSz + 1 ! PtchRate_Max - Re_BufSz = Re_BufSz + 1 ! Gain_OM - Re_BufSz = Re_BufSz + 1 ! GenSpd_MinOM - Re_BufSz = Re_BufSz + 1 ! GenSpd_MaxOM - Re_BufSz = Re_BufSz + 1 ! GenSpd_Dem - Re_BufSz = Re_BufSz + 1 ! GenTrq_Dem - Re_BufSz = Re_BufSz + 1 ! GenPwr_Dem - Int_BufSz = Int_BufSz + 1 ! DLL_NumTrq - Int_BufSz = Int_BufSz + 1 ! GenSpd_TLU allocated yes/no - IF ( ALLOCATED(InData%GenSpd_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenSpd_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenSpd_TLU) ! GenSpd_TLU - END IF - Int_BufSz = Int_BufSz + 1 ! GenTrq_TLU allocated yes/no - IF ( ALLOCATED(InData%GenTrq_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenTrq_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU - END IF - Int_BufSz = Int_BufSz + 1 ! UseLegacyInterface - Int_BufSz = Int_BufSz + 1 ! NumBStC - Int_BufSz = Int_BufSz + 1 ! BStCfiles allocated yes/no - IF ( ALLOCATED(InData%BStCfiles) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStCfiles upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BStCfiles)*LEN(InData%BStCfiles) ! BStCfiles - END IF - Int_BufSz = Int_BufSz + 1 ! NumNStC - Int_BufSz = Int_BufSz + 1 ! NStCfiles allocated yes/no - IF ( ALLOCATED(InData%NStCfiles) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStCfiles upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NStCfiles)*LEN(InData%NStCfiles) ! NStCfiles - END IF - Int_BufSz = Int_BufSz + 1 ! NumTStC - Int_BufSz = Int_BufSz + 1 ! TStCfiles allocated yes/no - IF ( ALLOCATED(InData%TStCfiles) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStCfiles upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%TStCfiles)*LEN(InData%TStCfiles) ! TStCfiles - END IF - Int_BufSz = Int_BufSz + 1 ! NumSStC - Int_BufSz = Int_BufSz + 1 ! SStCfiles allocated yes/no - IF ( ALLOCATED(InData%SStCfiles) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStCfiles upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SStCfiles)*LEN(InData%SStCfiles) ! SStCfiles - END IF - Int_BufSz = Int_BufSz + 1 ! AfCmode - Re_BufSz = Re_BufSz + 1 ! AfC_Mean - Re_BufSz = Re_BufSz + 1 ! AfC_Amp - Re_BufSz = Re_BufSz + 1 ! AfC_Phase - Int_BufSz = Int_BufSz + 1 ! CCmode - Int_BufSz = Int_BufSz + 1 ! EXavrSWAP - 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%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PCMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TPCOn - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%TPitManS,1), UBOUND(InData%TPitManS,1) - DbKiBuf(Db_Xferred) = InData%TPitManS(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PitManRat,1), UBOUND(InData%PitManRat,1) - ReKiBuf(Re_Xferred) = InData%PitManRat(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%BlPitchF,1), UBOUND(InData%BlPitchF,1) - ReKiBuf(Re_Xferred) = InData%BlPitchF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%VSContrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%GenModel - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenEff - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStr, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdGenOn - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimGenOn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimGenOf - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_RtGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_Rgn2K - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_PORt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_Freq - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TEC_NPol - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_SRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_RRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_VLL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_SLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_RLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_MR - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%HSSBrMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%THSSBrDp - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%HSSBrDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrTqF - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%YCMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TYCOn - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawNeut - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawDamp - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TYawManS - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawManRat - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYawF - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) - 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 - DbKiBuf(Db_Xferred) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) 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%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - 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 - END IF - DO I = 1, LEN(InData%DLL_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_ProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_ProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_InFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%DLL_DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DLL_Ramp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BPCutoff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYaw_North - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Ptch_Cntrl - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_SetPnt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtchRate_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtchRate_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gain_OM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_MinOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_MaxOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenTrq_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenPwr_Dem - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DLL_NumTrq - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) 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%GenSpd_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GenSpd_TLU,1), UBOUND(InData%GenSpd_TLU,1) - ReKiBuf(Re_Xferred) = InData%GenSpd_TLU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) 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%GenTrq_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GenTrq_TLU,1), UBOUND(InData%GenTrq_TLU,1) - ReKiBuf(Re_Xferred) = InData%GenTrq_TLU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseLegacyInterface, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBStC - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStCfiles) ) 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%BStCfiles,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStCfiles,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStCfiles,1), UBOUND(InData%BStCfiles,1) - DO I = 1, LEN(InData%BStCfiles) - IntKiBuf(Int_Xferred) = ICHAR(InData%BStCfiles(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumNStC - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NStCfiles) ) 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%NStCfiles,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStCfiles,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStCfiles,1), UBOUND(InData%NStCfiles,1) - DO I = 1, LEN(InData%NStCfiles) - IntKiBuf(Int_Xferred) = ICHAR(InData%NStCfiles(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumTStC - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TStCfiles) ) 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%TStCfiles,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStCfiles,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStCfiles,1), UBOUND(InData%TStCfiles,1) - DO I = 1, LEN(InData%TStCfiles) - IntKiBuf(Int_Xferred) = ICHAR(InData%TStCfiles(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumSStC - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SStCfiles) ) 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%SStCfiles,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStCfiles,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStCfiles,1), UBOUND(InData%SStCfiles,1) - DO I = 1, LEN(InData%SStCfiles) - IntKiBuf(Int_Xferred) = ICHAR(InData%SStCfiles(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%AfCmode - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Mean - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Amp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Phase - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CCmode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EXavrSWAP, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SrvD_PackInputFile - - SUBROUTINE SrvD_UnPackInputFile( 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(SrvD_InputFile), 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 = 'SrvD_UnPackInputFile' - ! 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%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%PCMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TPCOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%TPitManS,1) - i1_u = UBOUND(OutData%TPitManS,1) - DO i1 = LBOUND(OutData%TPitManS,1), UBOUND(OutData%TPitManS,1) - OutData%TPitManS(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PitManRat,1) - i1_u = UBOUND(OutData%PitManRat,1) - DO i1 = LBOUND(OutData%PitManRat,1), UBOUND(OutData%PitManRat,1) - OutData%PitManRat(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%BlPitchF,1) - i1_u = UBOUND(OutData%BlPitchF,1) - DO i1 = LBOUND(OutData%BlPitchF,1), UBOUND(OutData%BlPitchF,1) - OutData%BlPitchF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%VSContrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%GenModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%GenEff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTiStr = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStr) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStp = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStp) - Int_Xferred = Int_Xferred + 1 - OutData%SpdGenOn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TimGenOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOf = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%VS_RtGnSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_RtTq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_Rgn2K = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SlPc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SlPc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SySp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_RtTq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_PORt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Freq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_NPol = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TEC_SRes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RRes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_VLL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SLR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RLR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_MR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%THSSBrDp = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrTqF = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YCMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TYCOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%YawNeut = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawDamp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TYawManS = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%YawManRat = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYawF = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) - 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 - OutData%Tstart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 - DO I = 1, LEN(OutData%DLL_FileName) - OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_ProcName) - OutData%DLL_ProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_InFile) - OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%DLL_DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DLL_Ramp = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_Ramp) - Int_Xferred = Int_Xferred + 1 - OutData%BPCutoff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw_North = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Cntrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Ptch_SetPnt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gain_OM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MinOM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MaxOM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenPwr_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DLL_NumTrq = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU 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%GenSpd_TLU)) DEALLOCATE(OutData%GenSpd_TLU) - ALLOCATE(OutData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GenSpd_TLU,1), UBOUND(OutData%GenSpd_TLU,1) - OutData%GenSpd_TLU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU 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%GenTrq_TLU)) DEALLOCATE(OutData%GenTrq_TLU) - ALLOCATE(OutData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GenTrq_TLU,1), UBOUND(OutData%GenTrq_TLU,1) - OutData%GenTrq_TLU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%UseLegacyInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseLegacyInterface) - Int_Xferred = Int_Xferred + 1 - OutData%NumBStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStCfiles 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%BStCfiles)) DEALLOCATE(OutData%BStCfiles) - ALLOCATE(OutData%BStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStCfiles,1), UBOUND(OutData%BStCfiles,1) - DO I = 1, LEN(OutData%BStCfiles) - OutData%BStCfiles(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%NumNStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStCfiles 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%NStCfiles)) DEALLOCATE(OutData%NStCfiles) - ALLOCATE(OutData%NStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStCfiles,1), UBOUND(OutData%NStCfiles,1) - DO I = 1, LEN(OutData%NStCfiles) - OutData%NStCfiles(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%NumTStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStCfiles 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%TStCfiles)) DEALLOCATE(OutData%TStCfiles) - ALLOCATE(OutData%TStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStCfiles,1), UBOUND(OutData%TStCfiles,1) - DO I = 1, LEN(OutData%TStCfiles) - OutData%TStCfiles(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%NumSStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStCfiles 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%SStCfiles)) DEALLOCATE(OutData%SStCfiles) - ALLOCATE(OutData%SStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStCfiles,1), UBOUND(OutData%SStCfiles,1) - DO I = 1, LEN(OutData%SStCfiles) - OutData%SStCfiles(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%AfCmode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AfC_Mean = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AfC_Amp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AfC_Phase = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CCmode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%EXavrSWAP = TRANSFER(IntKiBuf(Int_Xferred), OutData%EXavrSWAP) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SrvD_UnPackInputFile - - SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladedDLLType), INTENT(IN) :: SrcBladedDLLTypeData - TYPE(BladedDLLType), INTENT(INOUT) :: DstBladedDLLTypeData - 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 = 'SrvD_CopyBladedDLLType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBladedDLLTypeData%avrSWAP)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%avrSWAP,1) - i1_u = UBOUND(SrcBladedDLLTypeData%avrSWAP,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%avrSWAP)) THEN - ALLOCATE(DstBladedDLLTypeData%avrSWAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%avrSWAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%avrSWAP = SrcBladedDLLTypeData%avrSWAP -ENDIF - DstBladedDLLTypeData%HSSBrTrqDemand = SrcBladedDLLTypeData%HSSBrTrqDemand - DstBladedDLLTypeData%YawRateCom = SrcBladedDLLTypeData%YawRateCom - DstBladedDLLTypeData%GenTrq = SrcBladedDLLTypeData%GenTrq - DstBladedDLLTypeData%GenState = SrcBladedDLLTypeData%GenState - DstBladedDLLTypeData%BlPitchCom = SrcBladedDLLTypeData%BlPitchCom - DstBladedDLLTypeData%PrevBlPitch = SrcBladedDLLTypeData%PrevBlPitch - DstBladedDLLTypeData%BlAirfoilCom = SrcBladedDLLTypeData%BlAirfoilCom - DstBladedDLLTypeData%PrevBlAirfoilCom = SrcBladedDLLTypeData%PrevBlAirfoilCom - DstBladedDLLTypeData%ElecPwr_prev = SrcBladedDLLTypeData%ElecPwr_prev - DstBladedDLLTypeData%GenTrq_prev = SrcBladedDLLTypeData%GenTrq_prev -IF (ALLOCATED(SrcBladedDLLTypeData%toSC)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%toSC,1) - i1_u = UBOUND(SrcBladedDLLTypeData%toSC,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%toSC)) THEN - ALLOCATE(DstBladedDLLTypeData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%toSC = SrcBladedDLLTypeData%toSC -ENDIF - DstBladedDLLTypeData%initialized = SrcBladedDLLTypeData%initialized - DstBladedDLLTypeData%NumLogChannels = SrcBladedDLLTypeData%NumLogChannels -IF (ALLOCATED(SrcBladedDLLTypeData%LogChannels_OutParam)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) - i1_u = UBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%LogChannels_OutParam)) THEN - ALLOCATE(DstBladedDLLTypeData%LogChannels_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1), UBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcBladedDLLTypeData%LogChannels_OutParam(i1), DstBladedDLLTypeData%LogChannels_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%LogChannels)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%LogChannels,1) - i1_u = UBOUND(SrcBladedDLLTypeData%LogChannels,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%LogChannels)) THEN - ALLOCATE(DstBladedDLLTypeData%LogChannels(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%LogChannels = SrcBladedDLLTypeData%LogChannels -ENDIF - DstBladedDLLTypeData%ErrStat = SrcBladedDLLTypeData%ErrStat - DstBladedDLLTypeData%ErrMsg = SrcBladedDLLTypeData%ErrMsg - DstBladedDLLTypeData%CurrentTime = SrcBladedDLLTypeData%CurrentTime - DstBladedDLLTypeData%SimStatus = SrcBladedDLLTypeData%SimStatus - DstBladedDLLTypeData%ShaftBrakeStatusBinaryFlag = SrcBladedDLLTypeData%ShaftBrakeStatusBinaryFlag - DstBladedDLLTypeData%HSSBrDeployed = SrcBladedDLLTypeData%HSSBrDeployed - DstBladedDLLTypeData%TimeHSSBrFullyDeployed = SrcBladedDLLTypeData%TimeHSSBrFullyDeployed - DstBladedDLLTypeData%TimeHSSBrDeployed = SrcBladedDLLTypeData%TimeHSSBrDeployed - DstBladedDLLTypeData%OverrideYawRateWithTorque = SrcBladedDLLTypeData%OverrideYawRateWithTorque - DstBladedDLLTypeData%YawTorqueDemand = SrcBladedDLLTypeData%YawTorqueDemand -IF (ALLOCATED(SrcBladedDLLTypeData%BlPitchInput)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%BlPitchInput,1) - i1_u = UBOUND(SrcBladedDLLTypeData%BlPitchInput,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%BlPitchInput)) THEN - ALLOCATE(DstBladedDLLTypeData%BlPitchInput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%BlPitchInput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%BlPitchInput = SrcBladedDLLTypeData%BlPitchInput -ENDIF - DstBladedDLLTypeData%YawAngleFromNorth = SrcBladedDLLTypeData%YawAngleFromNorth - DstBladedDLLTypeData%HorWindV = SrcBladedDLLTypeData%HorWindV - DstBladedDLLTypeData%HSS_Spd = SrcBladedDLLTypeData%HSS_Spd - DstBladedDLLTypeData%YawErr = SrcBladedDLLTypeData%YawErr - DstBladedDLLTypeData%RotSpeed = SrcBladedDLLTypeData%RotSpeed - DstBladedDLLTypeData%YawBrTAxp = SrcBladedDLLTypeData%YawBrTAxp - DstBladedDLLTypeData%YawBrTAyp = SrcBladedDLLTypeData%YawBrTAyp - DstBladedDLLTypeData%LSSTipMys = SrcBladedDLLTypeData%LSSTipMys - DstBladedDLLTypeData%LSSTipMzs = SrcBladedDLLTypeData%LSSTipMzs - DstBladedDLLTypeData%LSSTipMya = SrcBladedDLLTypeData%LSSTipMya - DstBladedDLLTypeData%LSSTipMza = SrcBladedDLLTypeData%LSSTipMza - DstBladedDLLTypeData%LSSTipPxa = SrcBladedDLLTypeData%LSSTipPxa - DstBladedDLLTypeData%Yaw = SrcBladedDLLTypeData%Yaw - DstBladedDLLTypeData%YawRate = SrcBladedDLLTypeData%YawRate - DstBladedDLLTypeData%YawBrMyn = SrcBladedDLLTypeData%YawBrMyn - DstBladedDLLTypeData%YawBrMzn = SrcBladedDLLTypeData%YawBrMzn - DstBladedDLLTypeData%NcIMURAxs = SrcBladedDLLTypeData%NcIMURAxs - DstBladedDLLTypeData%NcIMURAys = SrcBladedDLLTypeData%NcIMURAys - DstBladedDLLTypeData%NcIMURAzs = SrcBladedDLLTypeData%NcIMURAzs - DstBladedDLLTypeData%RotPwr = SrcBladedDLLTypeData%RotPwr - DstBladedDLLTypeData%LSSTipMxa = SrcBladedDLLTypeData%LSSTipMxa - DstBladedDLLTypeData%RootMyc = SrcBladedDLLTypeData%RootMyc - DstBladedDLLTypeData%RootMxc = SrcBladedDLLTypeData%RootMxc - DstBladedDLLTypeData%LSShftFxa = SrcBladedDLLTypeData%LSShftFxa - DstBladedDLLTypeData%LSShftFys = SrcBladedDLLTypeData%LSShftFys - DstBladedDLLTypeData%LSShftFzs = SrcBladedDLLTypeData%LSShftFzs -IF (ALLOCATED(SrcBladedDLLTypeData%LidSpeed)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%LidSpeed,1) - i1_u = UBOUND(SrcBladedDLLTypeData%LidSpeed,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%LidSpeed)) THEN - ALLOCATE(DstBladedDLLTypeData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%LidSpeed = SrcBladedDLLTypeData%LidSpeed -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%MsrPositionsX)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%MsrPositionsX,1) - i1_u = UBOUND(SrcBladedDLLTypeData%MsrPositionsX,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%MsrPositionsX)) THEN - ALLOCATE(DstBladedDLLTypeData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%MsrPositionsX = SrcBladedDLLTypeData%MsrPositionsX -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%MsrPositionsY)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%MsrPositionsY,1) - i1_u = UBOUND(SrcBladedDLLTypeData%MsrPositionsY,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%MsrPositionsY)) THEN - ALLOCATE(DstBladedDLLTypeData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%MsrPositionsY = SrcBladedDLLTypeData%MsrPositionsY -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%MsrPositionsZ)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%MsrPositionsZ,1) - i1_u = UBOUND(SrcBladedDLLTypeData%MsrPositionsZ,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%MsrPositionsZ)) THEN - ALLOCATE(DstBladedDLLTypeData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%MsrPositionsZ = SrcBladedDLLTypeData%MsrPositionsZ -ENDIF - DstBladedDLLTypeData%SensorType = SrcBladedDLLTypeData%SensorType - DstBladedDLLTypeData%NumBeam = SrcBladedDLLTypeData%NumBeam - DstBladedDLLTypeData%NumPulseGate = SrcBladedDLLTypeData%NumPulseGate - DstBladedDLLTypeData%PulseSpacing = SrcBladedDLLTypeData%PulseSpacing - DstBladedDLLTypeData%URefLid = SrcBladedDLLTypeData%URefLid - DstBladedDLLTypeData%DLL_DT = SrcBladedDLLTypeData%DLL_DT - DstBladedDLLTypeData%DLL_InFile = SrcBladedDLLTypeData%DLL_InFile - DstBladedDLLTypeData%RootName = SrcBladedDLLTypeData%RootName - DstBladedDLLTypeData%GenTrq_Dem = SrcBladedDLLTypeData%GenTrq_Dem - DstBladedDLLTypeData%GenSpd_Dem = SrcBladedDLLTypeData%GenSpd_Dem - DstBladedDLLTypeData%Ptch_Max = SrcBladedDLLTypeData%Ptch_Max - DstBladedDLLTypeData%Ptch_Min = SrcBladedDLLTypeData%Ptch_Min - DstBladedDLLTypeData%Ptch_SetPnt = SrcBladedDLLTypeData%Ptch_SetPnt - DstBladedDLLTypeData%PtchRate_Max = SrcBladedDLLTypeData%PtchRate_Max - DstBladedDLLTypeData%PtchRate_Min = SrcBladedDLLTypeData%PtchRate_Min - DstBladedDLLTypeData%GenPwr_Dem = SrcBladedDLLTypeData%GenPwr_Dem - DstBladedDLLTypeData%Gain_OM = SrcBladedDLLTypeData%Gain_OM - DstBladedDLLTypeData%GenSpd_MaxOM = SrcBladedDLLTypeData%GenSpd_MaxOM - DstBladedDLLTypeData%GenSpd_MinOM = SrcBladedDLLTypeData%GenSpd_MinOM - DstBladedDLLTypeData%Ptch_Cntrl = SrcBladedDLLTypeData%Ptch_Cntrl - DstBladedDLLTypeData%DLL_NumTrq = SrcBladedDLLTypeData%DLL_NumTrq -IF (ALLOCATED(SrcBladedDLLTypeData%GenSpd_TLU)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%GenSpd_TLU,1) - i1_u = UBOUND(SrcBladedDLLTypeData%GenSpd_TLU,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%GenSpd_TLU)) THEN - ALLOCATE(DstBladedDLLTypeData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%GenSpd_TLU = SrcBladedDLLTypeData%GenSpd_TLU -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%GenTrq_TLU)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%GenTrq_TLU,1) - i1_u = UBOUND(SrcBladedDLLTypeData%GenTrq_TLU,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%GenTrq_TLU)) THEN - ALLOCATE(DstBladedDLLTypeData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%GenTrq_TLU = SrcBladedDLLTypeData%GenTrq_TLU -ENDIF - DstBladedDLLTypeData%Yaw_Cntrl = SrcBladedDLLTypeData%Yaw_Cntrl -IF (ALLOCATED(SrcBladedDLLTypeData%PrevCableDeltaL)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevCableDeltaL,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevCableDeltaL,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevCableDeltaL)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevCableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevCableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevCableDeltaL = SrcBladedDLLTypeData%PrevCableDeltaL -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%PrevCableDeltaLdot)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevCableDeltaLdot,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevCableDeltaLdot,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevCableDeltaLdot)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevCableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevCableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevCableDeltaLdot = SrcBladedDLLTypeData%PrevCableDeltaLdot -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%CableDeltaL)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%CableDeltaL,1) - i1_u = UBOUND(SrcBladedDLLTypeData%CableDeltaL,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%CableDeltaL)) THEN - ALLOCATE(DstBladedDLLTypeData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%CableDeltaL = SrcBladedDLLTypeData%CableDeltaL -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%CableDeltaLdot)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%CableDeltaLdot,1) - i1_u = UBOUND(SrcBladedDLLTypeData%CableDeltaLdot,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%CableDeltaLdot)) THEN - ALLOCATE(DstBladedDLLTypeData%CableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%CableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%CableDeltaLdot = SrcBladedDLLTypeData%CableDeltaLdot -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%PrevStCCmdStiff)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdStiff,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdStiff,1) - i2_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdStiff,2) - i2_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdStiff,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevStCCmdStiff)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevStCCmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevStCCmdStiff = SrcBladedDLLTypeData%PrevStCCmdStiff -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%PrevStCCmdDamp)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdDamp,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdDamp,1) - i2_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdDamp,2) - i2_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdDamp,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevStCCmdDamp)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevStCCmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevStCCmdDamp = SrcBladedDLLTypeData%PrevStCCmdDamp -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%PrevStCCmdBrake)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdBrake,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdBrake,1) - i2_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdBrake,2) - i2_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdBrake,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevStCCmdBrake)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevStCCmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevStCCmdBrake = SrcBladedDLLTypeData%PrevStCCmdBrake -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%PrevStCCmdForce)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdForce,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdForce,1) - i2_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdForce,2) - i2_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdForce,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevStCCmdForce)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevStCCmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevStCCmdForce = SrcBladedDLLTypeData%PrevStCCmdForce -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCCmdStiff)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCCmdStiff,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCCmdStiff,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCCmdStiff,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCCmdStiff,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCCmdStiff)) THEN - ALLOCATE(DstBladedDLLTypeData%StCCmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCCmdStiff = SrcBladedDLLTypeData%StCCmdStiff -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCCmdDamp)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCCmdDamp,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCCmdDamp,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCCmdDamp,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCCmdDamp,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCCmdDamp)) THEN - ALLOCATE(DstBladedDLLTypeData%StCCmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCCmdDamp = SrcBladedDLLTypeData%StCCmdDamp -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCCmdBrake)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCCmdBrake,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCCmdBrake,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCCmdBrake,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCCmdBrake,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCCmdBrake)) THEN - ALLOCATE(DstBladedDLLTypeData%StCCmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCCmdBrake = SrcBladedDLLTypeData%StCCmdBrake -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCCmdForce)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCCmdForce,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCCmdForce,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCCmdForce,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCCmdForce,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCCmdForce)) THEN - ALLOCATE(DstBladedDLLTypeData%StCCmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCCmdForce = SrcBladedDLLTypeData%StCCmdForce -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCMeasDisp)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCMeasDisp,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCMeasDisp,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCMeasDisp,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCMeasDisp,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCMeasDisp)) THEN - ALLOCATE(DstBladedDLLTypeData%StCMeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCMeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCMeasDisp = SrcBladedDLLTypeData%StCMeasDisp -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCMeasVel)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCMeasVel,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCMeasVel,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCMeasVel,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCMeasVel,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCMeasVel)) THEN - ALLOCATE(DstBladedDLLTypeData%StCMeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCMeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCMeasVel = SrcBladedDLLTypeData%StCMeasVel -ENDIF - END SUBROUTINE SrvD_CopyBladedDLLType - - SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg ) - TYPE(BladedDLLType), INTENT(INOUT) :: BladedDLLTypeData - 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 = 'SrvD_DestroyBladedDLLType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladedDLLTypeData%avrSWAP)) THEN - DEALLOCATE(BladedDLLTypeData%avrSWAP) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%toSC)) THEN - DEALLOCATE(BladedDLLTypeData%toSC) -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BladedDLLTypeData%LogChannels_OutParam) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%LogChannels)) THEN - DEALLOCATE(BladedDLLTypeData%LogChannels) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%BlPitchInput)) THEN - DEALLOCATE(BladedDLLTypeData%BlPitchInput) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%LidSpeed)) THEN - DEALLOCATE(BladedDLLTypeData%LidSpeed) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%MsrPositionsX)) THEN - DEALLOCATE(BladedDLLTypeData%MsrPositionsX) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%MsrPositionsY)) THEN - DEALLOCATE(BladedDLLTypeData%MsrPositionsY) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%MsrPositionsZ)) THEN - DEALLOCATE(BladedDLLTypeData%MsrPositionsZ) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%GenSpd_TLU)) THEN - DEALLOCATE(BladedDLLTypeData%GenSpd_TLU) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%GenTrq_TLU)) THEN - DEALLOCATE(BladedDLLTypeData%GenTrq_TLU) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevCableDeltaL)) THEN - DEALLOCATE(BladedDLLTypeData%PrevCableDeltaL) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevCableDeltaLdot)) THEN - DEALLOCATE(BladedDLLTypeData%PrevCableDeltaLdot) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%CableDeltaL)) THEN - DEALLOCATE(BladedDLLTypeData%CableDeltaL) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%CableDeltaLdot)) THEN - DEALLOCATE(BladedDLLTypeData%CableDeltaLdot) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevStCCmdStiff)) THEN - DEALLOCATE(BladedDLLTypeData%PrevStCCmdStiff) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevStCCmdDamp)) THEN - DEALLOCATE(BladedDLLTypeData%PrevStCCmdDamp) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevStCCmdBrake)) THEN - DEALLOCATE(BladedDLLTypeData%PrevStCCmdBrake) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevStCCmdForce)) THEN - DEALLOCATE(BladedDLLTypeData%PrevStCCmdForce) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCCmdStiff)) THEN - DEALLOCATE(BladedDLLTypeData%StCCmdStiff) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCCmdDamp)) THEN - DEALLOCATE(BladedDLLTypeData%StCCmdDamp) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCCmdBrake)) THEN - DEALLOCATE(BladedDLLTypeData%StCCmdBrake) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCCmdForce)) THEN - DEALLOCATE(BladedDLLTypeData%StCCmdForce) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCMeasDisp)) THEN - DEALLOCATE(BladedDLLTypeData%StCMeasDisp) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCMeasVel)) THEN - DEALLOCATE(BladedDLLTypeData%StCMeasVel) -ENDIF - END SUBROUTINE SrvD_DestroyBladedDLLType - - SUBROUTINE SrvD_PackBladedDLLType( 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(BladedDLLType), 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 = 'SrvD_PackBladedDLLType' - ! 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 ! avrSWAP allocated yes/no - IF ( ALLOCATED(InData%avrSWAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! avrSWAP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%avrSWAP) ! avrSWAP - END IF - Re_BufSz = Re_BufSz + 1 ! HSSBrTrqDemand - Re_BufSz = Re_BufSz + 1 ! YawRateCom - Re_BufSz = Re_BufSz + 1 ! GenTrq - Int_BufSz = Int_BufSz + 1 ! GenState - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom - Re_BufSz = Re_BufSz + SIZE(InData%PrevBlPitch) ! PrevBlPitch - Re_BufSz = Re_BufSz + SIZE(InData%BlAirfoilCom) ! BlAirfoilCom - Re_BufSz = Re_BufSz + SIZE(InData%PrevBlAirfoilCom) ! PrevBlAirfoilCom - Re_BufSz = Re_BufSz + 1 ! ElecPwr_prev - Re_BufSz = Re_BufSz + 1 ! GenTrq_prev - Int_BufSz = Int_BufSz + 1 ! toSC allocated yes/no - IF ( ALLOCATED(InData%toSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSC) ! toSC - END IF - Int_BufSz = Int_BufSz + 1 ! initialized - Int_BufSz = Int_BufSz + 1 ! NumLogChannels - Int_BufSz = Int_BufSz + 1 ! LogChannels_OutParam allocated yes/no - IF ( ALLOCATED(InData%LogChannels_OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LogChannels_OutParam upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LogChannels_OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LogChannels_OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LogChannels_OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! LogChannels allocated yes/no - IF ( ALLOCATED(InData%LogChannels) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LogChannels upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LogChannels) ! LogChannels - END IF - Int_BufSz = Int_BufSz + 1 ! ErrStat - Int_BufSz = Int_BufSz + 1*LEN(InData%ErrMsg) ! ErrMsg - Db_BufSz = Db_BufSz + 1 ! CurrentTime - Int_BufSz = Int_BufSz + 1 ! SimStatus - Int_BufSz = Int_BufSz + 1 ! ShaftBrakeStatusBinaryFlag - Int_BufSz = Int_BufSz + 1 ! HSSBrDeployed - Db_BufSz = Db_BufSz + 1 ! TimeHSSBrFullyDeployed - Db_BufSz = Db_BufSz + 1 ! TimeHSSBrDeployed - Int_BufSz = Int_BufSz + 1 ! OverrideYawRateWithTorque - Re_BufSz = Re_BufSz + 1 ! YawTorqueDemand - Int_BufSz = Int_BufSz + 1 ! BlPitchInput allocated yes/no - IF ( ALLOCATED(InData%BlPitchInput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchInput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchInput) ! BlPitchInput - END IF - Re_BufSz = Re_BufSz + 1 ! YawAngleFromNorth - Re_BufSz = Re_BufSz + 1 ! HorWindV - Re_BufSz = Re_BufSz + 1 ! HSS_Spd - Re_BufSz = Re_BufSz + 1 ! YawErr - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! YawBrTAxp - Re_BufSz = Re_BufSz + 1 ! YawBrTAyp - Re_BufSz = Re_BufSz + 1 ! LSSTipMys - Re_BufSz = Re_BufSz + 1 ! LSSTipMzs - Re_BufSz = Re_BufSz + 1 ! LSSTipMya - Re_BufSz = Re_BufSz + 1 ! LSSTipMza - Re_BufSz = Re_BufSz + 1 ! LSSTipPxa - Re_BufSz = Re_BufSz + 1 ! Yaw - Re_BufSz = Re_BufSz + 1 ! YawRate - Re_BufSz = Re_BufSz + 1 ! YawBrMyn - Re_BufSz = Re_BufSz + 1 ! YawBrMzn - Re_BufSz = Re_BufSz + 1 ! NcIMURAxs - Re_BufSz = Re_BufSz + 1 ! NcIMURAys - Re_BufSz = Re_BufSz + 1 ! NcIMURAzs - Re_BufSz = Re_BufSz + 1 ! RotPwr - Re_BufSz = Re_BufSz + 1 ! LSSTipMxa - Re_BufSz = Re_BufSz + SIZE(InData%RootMyc) ! RootMyc - Re_BufSz = Re_BufSz + SIZE(InData%RootMxc) ! RootMxc - Re_BufSz = Re_BufSz + 1 ! LSShftFxa - Re_BufSz = Re_BufSz + 1 ! LSShftFys - Re_BufSz = Re_BufSz + 1 ! LSShftFzs - Int_BufSz = Int_BufSz + 1 ! LidSpeed allocated yes/no - IF ( ALLOCATED(InData%LidSpeed) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LidSpeed upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LidSpeed) ! LidSpeed - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsX allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsX) ! MsrPositionsX - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsY allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsY) ! MsrPositionsY - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsZ allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsZ) ! MsrPositionsZ - END IF - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! NumBeam - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Int_BufSz = Int_BufSz + 1 ! PulseSpacing - Int_BufSz = Int_BufSz + 1 ! URefLid - Db_BufSz = Db_BufSz + 1 ! DLL_DT - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InFile) ! DLL_InFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! GenTrq_Dem - Re_BufSz = Re_BufSz + 1 ! GenSpd_Dem - Re_BufSz = Re_BufSz + 1 ! Ptch_Max - Re_BufSz = Re_BufSz + 1 ! Ptch_Min - Re_BufSz = Re_BufSz + 1 ! Ptch_SetPnt - Re_BufSz = Re_BufSz + 1 ! PtchRate_Max - Re_BufSz = Re_BufSz + 1 ! PtchRate_Min - Re_BufSz = Re_BufSz + 1 ! GenPwr_Dem - Re_BufSz = Re_BufSz + 1 ! Gain_OM - Re_BufSz = Re_BufSz + 1 ! GenSpd_MaxOM - Re_BufSz = Re_BufSz + 1 ! GenSpd_MinOM - Int_BufSz = Int_BufSz + 1 ! Ptch_Cntrl - Int_BufSz = Int_BufSz + 1 ! DLL_NumTrq - Int_BufSz = Int_BufSz + 1 ! GenSpd_TLU allocated yes/no - IF ( ALLOCATED(InData%GenSpd_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenSpd_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenSpd_TLU) ! GenSpd_TLU - END IF - Int_BufSz = Int_BufSz + 1 ! GenTrq_TLU allocated yes/no - IF ( ALLOCATED(InData%GenTrq_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenTrq_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU - END IF - Int_BufSz = Int_BufSz + 1 ! Yaw_Cntrl - Int_BufSz = Int_BufSz + 1 ! PrevCableDeltaL allocated yes/no - IF ( ALLOCATED(InData%PrevCableDeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PrevCableDeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevCableDeltaL) ! PrevCableDeltaL - END IF - Int_BufSz = Int_BufSz + 1 ! PrevCableDeltaLdot allocated yes/no - IF ( ALLOCATED(InData%PrevCableDeltaLdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PrevCableDeltaLdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevCableDeltaLdot) ! PrevCableDeltaLdot - END IF - Int_BufSz = Int_BufSz + 1 ! CableDeltaL allocated yes/no - IF ( ALLOCATED(InData%CableDeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableDeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaL) ! CableDeltaL - END IF - Int_BufSz = Int_BufSz + 1 ! CableDeltaLdot allocated yes/no - IF ( ALLOCATED(InData%CableDeltaLdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableDeltaLdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaLdot) ! CableDeltaLdot - END IF - Int_BufSz = Int_BufSz + 1 ! PrevStCCmdStiff allocated yes/no - IF ( ALLOCATED(InData%PrevStCCmdStiff) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PrevStCCmdStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevStCCmdStiff) ! PrevStCCmdStiff - END IF - Int_BufSz = Int_BufSz + 1 ! PrevStCCmdDamp allocated yes/no - IF ( ALLOCATED(InData%PrevStCCmdDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PrevStCCmdDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevStCCmdDamp) ! PrevStCCmdDamp - END IF - Int_BufSz = Int_BufSz + 1 ! PrevStCCmdBrake allocated yes/no - IF ( ALLOCATED(InData%PrevStCCmdBrake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PrevStCCmdBrake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevStCCmdBrake) ! PrevStCCmdBrake - END IF - Int_BufSz = Int_BufSz + 1 ! PrevStCCmdForce allocated yes/no - IF ( ALLOCATED(InData%PrevStCCmdForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PrevStCCmdForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevStCCmdForce) ! PrevStCCmdForce - END IF - Int_BufSz = Int_BufSz + 1 ! StCCmdStiff allocated yes/no - IF ( ALLOCATED(InData%StCCmdStiff) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCCmdStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCCmdStiff) ! StCCmdStiff - END IF - Int_BufSz = Int_BufSz + 1 ! StCCmdDamp allocated yes/no - IF ( ALLOCATED(InData%StCCmdDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCCmdDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCCmdDamp) ! StCCmdDamp - END IF - Int_BufSz = Int_BufSz + 1 ! StCCmdBrake allocated yes/no - IF ( ALLOCATED(InData%StCCmdBrake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCCmdBrake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCCmdBrake) ! StCCmdBrake - END IF - Int_BufSz = Int_BufSz + 1 ! StCCmdForce allocated yes/no - IF ( ALLOCATED(InData%StCCmdForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCCmdForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCCmdForce) ! StCCmdForce - END IF - Int_BufSz = Int_BufSz + 1 ! StCMeasDisp allocated yes/no - IF ( ALLOCATED(InData%StCMeasDisp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCMeasDisp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCMeasDisp) ! StCMeasDisp - END IF - Int_BufSz = Int_BufSz + 1 ! StCMeasVel allocated yes/no - IF ( ALLOCATED(InData%StCMeasVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCMeasVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCMeasVel) ! StCMeasVel - 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%avrSWAP) ) 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%avrSWAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%avrSWAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%avrSWAP,1), UBOUND(InData%avrSWAP,1) - ReKiBuf(Re_Xferred) = InData%avrSWAP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%HSSBrTrqDemand - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%GenState - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) - ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PrevBlPitch,1), UBOUND(InData%PrevBlPitch,1) - ReKiBuf(Re_Xferred) = InData%PrevBlPitch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%BlAirfoilCom,1), UBOUND(InData%BlAirfoilCom,1) - ReKiBuf(Re_Xferred) = InData%BlAirfoilCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PrevBlAirfoilCom,1), UBOUND(InData%PrevBlAirfoilCom,1) - ReKiBuf(Re_Xferred) = InData%PrevBlAirfoilCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%ElecPwr_prev - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenTrq_prev - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%toSC) ) 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%toSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) - ReKiBuf(Re_Xferred) = InData%toSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%initialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumLogChannels - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LogChannels_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%LogChannels_OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LogChannels_OutParam,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%LogChannels) ) 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%LogChannels,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LogChannels,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LogChannels,1), UBOUND(InData%LogChannels,1) - ReKiBuf(Re_Xferred) = InData%LogChannels(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%ErrStat - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%ErrMsg) - IntKiBuf(Int_Xferred) = ICHAR(InData%ErrMsg(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%CurrentTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SimStatus - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ShaftBrakeStatusBinaryFlag - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HSSBrDeployed, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimeHSSBrFullyDeployed - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimeHSSBrDeployed - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OverrideYawRateWithTorque, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawTorqueDemand - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlPitchInput) ) 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%BlPitchInput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchInput,1), UBOUND(InData%BlPitchInput,1) - ReKiBuf(Re_Xferred) = InData%BlPitchInput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%YawAngleFromNorth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HorWindV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrTAxp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrTAyp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMya - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMza - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipPxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAxs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMxa - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) - ReKiBuf(Re_Xferred) = InData%RootMyc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) - ReKiBuf(Re_Xferred) = InData%RootMxc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%LSShftFxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFzs - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LidSpeed) ) 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%LidSpeed,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LidSpeed,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LidSpeed,1), UBOUND(InData%LidSpeed,1) - ReKiBuf(Re_Xferred) = InData%LidSpeed(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsX) ) 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%MsrPositionsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsX,1), UBOUND(InData%MsrPositionsX,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsY) ) 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%MsrPositionsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsY,1), UBOUND(InData%MsrPositionsY,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsZ) ) 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%MsrPositionsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsZ,1), UBOUND(InData%MsrPositionsZ,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBeam - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PulseSpacing - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%URefLid - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DLL_DT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%DLL_InFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%GenTrq_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_SetPnt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtchRate_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtchRate_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenPwr_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gain_OM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_MaxOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_MinOM - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Ptch_Cntrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DLL_NumTrq - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) 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%GenSpd_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GenSpd_TLU,1), UBOUND(InData%GenSpd_TLU,1) - ReKiBuf(Re_Xferred) = InData%GenSpd_TLU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) 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%GenTrq_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GenTrq_TLU,1), UBOUND(InData%GenTrq_TLU,1) - ReKiBuf(Re_Xferred) = InData%GenTrq_TLU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Yaw_Cntrl - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PrevCableDeltaL) ) 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%PrevCableDeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevCableDeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PrevCableDeltaL,1), UBOUND(InData%PrevCableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%PrevCableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PrevCableDeltaLdot) ) 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%PrevCableDeltaLdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevCableDeltaLdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PrevCableDeltaLdot,1), UBOUND(InData%PrevCableDeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%PrevCableDeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CableDeltaL) ) 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%CableDeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableDeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableDeltaL,1), UBOUND(InData%CableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CableDeltaLdot) ) 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%CableDeltaLdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableDeltaLdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableDeltaLdot,1), UBOUND(InData%CableDeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PrevStCCmdStiff) ) 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%PrevStCCmdStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdStiff,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdStiff,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdStiff,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PrevStCCmdStiff,2), UBOUND(InData%PrevStCCmdStiff,2) - DO i1 = LBOUND(InData%PrevStCCmdStiff,1), UBOUND(InData%PrevStCCmdStiff,1) - ReKiBuf(Re_Xferred) = InData%PrevStCCmdStiff(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PrevStCCmdDamp) ) 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%PrevStCCmdDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PrevStCCmdDamp,2), UBOUND(InData%PrevStCCmdDamp,2) - DO i1 = LBOUND(InData%PrevStCCmdDamp,1), UBOUND(InData%PrevStCCmdDamp,1) - ReKiBuf(Re_Xferred) = InData%PrevStCCmdDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PrevStCCmdBrake) ) 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%PrevStCCmdBrake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdBrake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdBrake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdBrake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PrevStCCmdBrake,2), UBOUND(InData%PrevStCCmdBrake,2) - DO i1 = LBOUND(InData%PrevStCCmdBrake,1), UBOUND(InData%PrevStCCmdBrake,1) - ReKiBuf(Re_Xferred) = InData%PrevStCCmdBrake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PrevStCCmdForce) ) 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%PrevStCCmdForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PrevStCCmdForce,2), UBOUND(InData%PrevStCCmdForce,2) - DO i1 = LBOUND(InData%PrevStCCmdForce,1), UBOUND(InData%PrevStCCmdForce,1) - ReKiBuf(Re_Xferred) = InData%PrevStCCmdForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCCmdStiff) ) 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%StCCmdStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdStiff,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdStiff,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdStiff,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCCmdStiff,2), UBOUND(InData%StCCmdStiff,2) - DO i1 = LBOUND(InData%StCCmdStiff,1), UBOUND(InData%StCCmdStiff,1) - ReKiBuf(Re_Xferred) = InData%StCCmdStiff(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCCmdDamp) ) 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%StCCmdDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCCmdDamp,2), UBOUND(InData%StCCmdDamp,2) - DO i1 = LBOUND(InData%StCCmdDamp,1), UBOUND(InData%StCCmdDamp,1) - ReKiBuf(Re_Xferred) = InData%StCCmdDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCCmdBrake) ) 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%StCCmdBrake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdBrake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdBrake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdBrake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCCmdBrake,2), UBOUND(InData%StCCmdBrake,2) - DO i1 = LBOUND(InData%StCCmdBrake,1), UBOUND(InData%StCCmdBrake,1) - ReKiBuf(Re_Xferred) = InData%StCCmdBrake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCCmdForce) ) 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%StCCmdForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCCmdForce,2), UBOUND(InData%StCCmdForce,2) - DO i1 = LBOUND(InData%StCCmdForce,1), UBOUND(InData%StCCmdForce,1) - ReKiBuf(Re_Xferred) = InData%StCCmdForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCMeasDisp) ) 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%StCMeasDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCMeasDisp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCMeasDisp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCMeasDisp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCMeasDisp,2), UBOUND(InData%StCMeasDisp,2) - DO i1 = LBOUND(InData%StCMeasDisp,1), UBOUND(InData%StCMeasDisp,1) - ReKiBuf(Re_Xferred) = InData%StCMeasDisp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCMeasVel) ) 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%StCMeasVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCMeasVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCMeasVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCMeasVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCMeasVel,2), UBOUND(InData%StCMeasVel,2) - DO i1 = LBOUND(InData%StCMeasVel,1), UBOUND(InData%StCMeasVel,1) - ReKiBuf(Re_Xferred) = InData%StCMeasVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE SrvD_PackBladedDLLType - - SUBROUTINE SrvD_UnPackBladedDLLType( 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(BladedDLLType), 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 = 'SrvD_UnPackBladedDLLType' - ! 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 ! avrSWAP 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%avrSWAP)) DEALLOCATE(OutData%avrSWAP) - ALLOCATE(OutData%avrSWAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%avrSWAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%avrSWAP,1), UBOUND(OutData%avrSWAP,1) - OutData%avrSWAP(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%HSSBrTrqDemand = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenState = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%BlPitchCom,1) - i1_u = UBOUND(OutData%BlPitchCom,1) - DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) - OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PrevBlPitch,1) - i1_u = UBOUND(OutData%PrevBlPitch,1) - DO i1 = LBOUND(OutData%PrevBlPitch,1), UBOUND(OutData%PrevBlPitch,1) - OutData%PrevBlPitch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%BlAirfoilCom,1) - i1_u = UBOUND(OutData%BlAirfoilCom,1) - DO i1 = LBOUND(OutData%BlAirfoilCom,1), UBOUND(OutData%BlAirfoilCom,1) - OutData%BlAirfoilCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PrevBlAirfoilCom,1) - i1_u = UBOUND(OutData%PrevBlAirfoilCom,1) - DO i1 = LBOUND(OutData%PrevBlAirfoilCom,1), UBOUND(OutData%PrevBlAirfoilCom,1) - OutData%PrevBlAirfoilCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%ElecPwr_prev = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq_prev = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toSC 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%toSC)) DEALLOCATE(OutData%toSC) - ALLOCATE(OutData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) - OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%initialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%initialized) - Int_Xferred = Int_Xferred + 1 - OutData%NumLogChannels = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LogChannels_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%LogChannels_OutParam)) DEALLOCATE(OutData%LogChannels_OutParam) - ALLOCATE(OutData%LogChannels_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LogChannels_OutParam,1), UBOUND(OutData%LogChannels_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%LogChannels_OutParam(i1), ErrStat2, ErrMsg2 ) ! LogChannels_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LogChannels 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%LogChannels)) DEALLOCATE(OutData%LogChannels) - ALLOCATE(OutData%LogChannels(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LogChannels,1), UBOUND(OutData%LogChannels,1) - OutData%LogChannels(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%ErrStat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%ErrMsg) - OutData%ErrMsg(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CurrentTime = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SimStatus = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ShaftBrakeStatusBinaryFlag = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HSSBrDeployed = TRANSFER(IntKiBuf(Int_Xferred), OutData%HSSBrDeployed) - Int_Xferred = Int_Xferred + 1 - OutData%TimeHSSBrFullyDeployed = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%TimeHSSBrDeployed = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%OverrideYawRateWithTorque = TRANSFER(IntKiBuf(Int_Xferred), OutData%OverrideYawRateWithTorque) - Int_Xferred = Int_Xferred + 1 - OutData%YawTorqueDemand = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInput 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%BlPitchInput)) DEALLOCATE(OutData%BlPitchInput) - ALLOCATE(OutData%BlPitchInput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchInput,1), UBOUND(OutData%BlPitchInput,1) - OutData%BlPitchInput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%YawAngleFromNorth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HorWindV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSS_Spd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawErr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAxp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAyp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMya = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMza = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipPxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Yaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAxs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RootMyc,1) - i1_u = UBOUND(OutData%RootMyc,1) - DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) - OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RootMxc,1) - i1_u = UBOUND(OutData%RootMxc,1) - DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) - OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%LSShftFxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LidSpeed 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%LidSpeed)) DEALLOCATE(OutData%LidSpeed) - ALLOCATE(OutData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LidSpeed,1), UBOUND(OutData%LidSpeed,1) - OutData%LidSpeed(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsX 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%MsrPositionsX)) DEALLOCATE(OutData%MsrPositionsX) - ALLOCATE(OutData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsX,1), UBOUND(OutData%MsrPositionsX,1) - OutData%MsrPositionsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsY 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%MsrPositionsY)) DEALLOCATE(OutData%MsrPositionsY) - ALLOCATE(OutData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsY,1), UBOUND(OutData%MsrPositionsY,1) - OutData%MsrPositionsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsZ 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%MsrPositionsZ)) DEALLOCATE(OutData%MsrPositionsZ) - ALLOCATE(OutData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsZ,1), UBOUND(OutData%MsrPositionsZ,1) - OutData%MsrPositionsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBeam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PulseSpacing = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%URefLid = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DLL_DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%DLL_InFile) - OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%GenTrq_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_SetPnt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenPwr_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gain_OM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MaxOM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MinOM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Cntrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DLL_NumTrq = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU 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%GenSpd_TLU)) DEALLOCATE(OutData%GenSpd_TLU) - ALLOCATE(OutData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GenSpd_TLU,1), UBOUND(OutData%GenSpd_TLU,1) - OutData%GenSpd_TLU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU 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%GenTrq_TLU)) DEALLOCATE(OutData%GenTrq_TLU) - ALLOCATE(OutData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GenTrq_TLU,1), UBOUND(OutData%GenTrq_TLU,1) - OutData%GenTrq_TLU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Yaw_Cntrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevCableDeltaL 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%PrevCableDeltaL)) DEALLOCATE(OutData%PrevCableDeltaL) - ALLOCATE(OutData%PrevCableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevCableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PrevCableDeltaL,1), UBOUND(OutData%PrevCableDeltaL,1) - OutData%PrevCableDeltaL(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevCableDeltaLdot 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%PrevCableDeltaLdot)) DEALLOCATE(OutData%PrevCableDeltaLdot) - ALLOCATE(OutData%PrevCableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevCableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PrevCableDeltaLdot,1), UBOUND(OutData%PrevCableDeltaLdot,1) - OutData%PrevCableDeltaLdot(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableDeltaL 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%CableDeltaL)) DEALLOCATE(OutData%CableDeltaL) - ALLOCATE(OutData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableDeltaL,1), UBOUND(OutData%CableDeltaL,1) - OutData%CableDeltaL(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableDeltaLdot 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%CableDeltaLdot)) DEALLOCATE(OutData%CableDeltaLdot) - ALLOCATE(OutData%CableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableDeltaLdot,1), UBOUND(OutData%CableDeltaLdot,1) - OutData%CableDeltaLdot(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevStCCmdStiff 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%PrevStCCmdStiff)) DEALLOCATE(OutData%PrevStCCmdStiff) - ALLOCATE(OutData%PrevStCCmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PrevStCCmdStiff,2), UBOUND(OutData%PrevStCCmdStiff,2) - DO i1 = LBOUND(OutData%PrevStCCmdStiff,1), UBOUND(OutData%PrevStCCmdStiff,1) - OutData%PrevStCCmdStiff(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevStCCmdDamp 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%PrevStCCmdDamp)) DEALLOCATE(OutData%PrevStCCmdDamp) - ALLOCATE(OutData%PrevStCCmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PrevStCCmdDamp,2), UBOUND(OutData%PrevStCCmdDamp,2) - DO i1 = LBOUND(OutData%PrevStCCmdDamp,1), UBOUND(OutData%PrevStCCmdDamp,1) - OutData%PrevStCCmdDamp(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevStCCmdBrake 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%PrevStCCmdBrake)) DEALLOCATE(OutData%PrevStCCmdBrake) - ALLOCATE(OutData%PrevStCCmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PrevStCCmdBrake,2), UBOUND(OutData%PrevStCCmdBrake,2) - DO i1 = LBOUND(OutData%PrevStCCmdBrake,1), UBOUND(OutData%PrevStCCmdBrake,1) - OutData%PrevStCCmdBrake(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevStCCmdForce 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%PrevStCCmdForce)) DEALLOCATE(OutData%PrevStCCmdForce) - ALLOCATE(OutData%PrevStCCmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PrevStCCmdForce,2), UBOUND(OutData%PrevStCCmdForce,2) - DO i1 = LBOUND(OutData%PrevStCCmdForce,1), UBOUND(OutData%PrevStCCmdForce,1) - OutData%PrevStCCmdForce(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCCmdStiff 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%StCCmdStiff)) DEALLOCATE(OutData%StCCmdStiff) - ALLOCATE(OutData%StCCmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCCmdStiff,2), UBOUND(OutData%StCCmdStiff,2) - DO i1 = LBOUND(OutData%StCCmdStiff,1), UBOUND(OutData%StCCmdStiff,1) - OutData%StCCmdStiff(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCCmdDamp 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%StCCmdDamp)) DEALLOCATE(OutData%StCCmdDamp) - ALLOCATE(OutData%StCCmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCCmdDamp,2), UBOUND(OutData%StCCmdDamp,2) - DO i1 = LBOUND(OutData%StCCmdDamp,1), UBOUND(OutData%StCCmdDamp,1) - OutData%StCCmdDamp(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCCmdBrake 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%StCCmdBrake)) DEALLOCATE(OutData%StCCmdBrake) - ALLOCATE(OutData%StCCmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCCmdBrake,2), UBOUND(OutData%StCCmdBrake,2) - DO i1 = LBOUND(OutData%StCCmdBrake,1), UBOUND(OutData%StCCmdBrake,1) - OutData%StCCmdBrake(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCCmdForce 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%StCCmdForce)) DEALLOCATE(OutData%StCCmdForce) - ALLOCATE(OutData%StCCmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCCmdForce,2), UBOUND(OutData%StCCmdForce,2) - DO i1 = LBOUND(OutData%StCCmdForce,1), UBOUND(OutData%StCCmdForce,1) - OutData%StCCmdForce(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCMeasDisp 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%StCMeasDisp)) DEALLOCATE(OutData%StCMeasDisp) - ALLOCATE(OutData%StCMeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCMeasDisp,2), UBOUND(OutData%StCMeasDisp,2) - DO i1 = LBOUND(OutData%StCMeasDisp,1), UBOUND(OutData%StCMeasDisp,1) - OutData%StCMeasDisp(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCMeasVel 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%StCMeasVel)) DEALLOCATE(OutData%StCMeasVel) - ALLOCATE(OutData%StCMeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCMeasVel,2), UBOUND(OutData%StCMeasVel,2) - DO i1 = LBOUND(OutData%StCMeasVel,1), UBOUND(OutData%StCMeasVel,1) - OutData%StCMeasVel(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE SrvD_UnPackBladedDLLType - - SUBROUTINE SrvD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SrvD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState -IF (ALLOCATED(SrcContStateData%BStC)) THEN - i1_l = LBOUND(SrcContStateData%BStC,1) - i1_u = UBOUND(SrcContStateData%BStC,1) - IF (.NOT. ALLOCATED(DstContStateData%BStC)) THEN - ALLOCATE(DstContStateData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%BStC,1), UBOUND(SrcContStateData%BStC,1) - CALL StC_CopyContState( SrcContStateData%BStC(i1), DstContStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcContStateData%NStC)) THEN - i1_l = LBOUND(SrcContStateData%NStC,1) - i1_u = UBOUND(SrcContStateData%NStC,1) - IF (.NOT. ALLOCATED(DstContStateData%NStC)) THEN - ALLOCATE(DstContStateData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%NStC,1), UBOUND(SrcContStateData%NStC,1) - CALL StC_CopyContState( SrcContStateData%NStC(i1), DstContStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcContStateData%TStC)) THEN - i1_l = LBOUND(SrcContStateData%TStC,1) - i1_u = UBOUND(SrcContStateData%TStC,1) - IF (.NOT. ALLOCATED(DstContStateData%TStC)) THEN - ALLOCATE(DstContStateData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%TStC,1), UBOUND(SrcContStateData%TStC,1) - CALL StC_CopyContState( SrcContStateData%TStC(i1), DstContStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcContStateData%SStC)) THEN - i1_l = LBOUND(SrcContStateData%SStC,1) - i1_u = UBOUND(SrcContStateData%SStC,1) - IF (.NOT. ALLOCATED(DstContStateData%SStC)) THEN - ALLOCATE(DstContStateData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%SStC,1), UBOUND(SrcContStateData%SStC,1) - CALL StC_CopyContState( SrcContStateData%SStC(i1), DstContStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyContState - - SUBROUTINE SrvD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(SrvD_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 = 'SrvD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%BStC)) THEN -DO i1 = LBOUND(ContStateData%BStC,1), UBOUND(ContStateData%BStC,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%SStC) -ENDIF - END SUBROUTINE SrvD_DestroyContState - - SUBROUTINE SrvD_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(SrvD_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 = 'SrvD_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 - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - - ReKiBuf(Re_Xferred) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) 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%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - 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 - IF ( .NOT. ALLOCATED(InData%NStC) ) 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%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - 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 - IF ( .NOT. ALLOCATED(InData%TStC) ) 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%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - 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 - IF ( .NOT. ALLOCATED(InData%SStC) ) 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%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - 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 - END SUBROUTINE SrvD_PackContState - - SUBROUTINE SrvD_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(SrvD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC 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%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,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 StC_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - 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 ! NStC 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%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,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 StC_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - 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 ! TStC 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%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,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 StC_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - 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 ! SStC 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%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,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 StC_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - 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 - END SUBROUTINE SrvD_UnPackContState - - SUBROUTINE SrvD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SrvD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%CtrlOffset = SrcDiscStateData%CtrlOffset -IF (ALLOCATED(SrcDiscStateData%BStC)) THEN - i1_l = LBOUND(SrcDiscStateData%BStC,1) - i1_u = UBOUND(SrcDiscStateData%BStC,1) - IF (.NOT. ALLOCATED(DstDiscStateData%BStC)) THEN - ALLOCATE(DstDiscStateData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%BStC,1), UBOUND(SrcDiscStateData%BStC,1) - CALL StC_CopyDiscState( SrcDiscStateData%BStC(i1), DstDiscStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDiscStateData%NStC)) THEN - i1_l = LBOUND(SrcDiscStateData%NStC,1) - i1_u = UBOUND(SrcDiscStateData%NStC,1) - IF (.NOT. ALLOCATED(DstDiscStateData%NStC)) THEN - ALLOCATE(DstDiscStateData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%NStC,1), UBOUND(SrcDiscStateData%NStC,1) - CALL StC_CopyDiscState( SrcDiscStateData%NStC(i1), DstDiscStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDiscStateData%TStC)) THEN - i1_l = LBOUND(SrcDiscStateData%TStC,1) - i1_u = UBOUND(SrcDiscStateData%TStC,1) - IF (.NOT. ALLOCATED(DstDiscStateData%TStC)) THEN - ALLOCATE(DstDiscStateData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%TStC,1), UBOUND(SrcDiscStateData%TStC,1) - CALL StC_CopyDiscState( SrcDiscStateData%TStC(i1), DstDiscStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDiscStateData%SStC)) THEN - i1_l = LBOUND(SrcDiscStateData%SStC,1) - i1_u = UBOUND(SrcDiscStateData%SStC,1) - IF (.NOT. ALLOCATED(DstDiscStateData%SStC)) THEN - ALLOCATE(DstDiscStateData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%SStC,1), UBOUND(SrcDiscStateData%SStC,1) - CALL StC_CopyDiscState( SrcDiscStateData%SStC(i1), DstDiscStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyDiscState - - SUBROUTINE SrvD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(SrvD_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 = 'SrvD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%BStC)) THEN -DO i1 = LBOUND(DiscStateData%BStC,1), UBOUND(DiscStateData%BStC,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%SStC) -ENDIF - END SUBROUTINE SrvD_DestroyDiscState - - SUBROUTINE SrvD_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(SrvD_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 = 'SrvD_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 ! CtrlOffset - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - - ReKiBuf(Re_Xferred) = InData%CtrlOffset - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) 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%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - 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 - IF ( .NOT. ALLOCATED(InData%NStC) ) 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%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - 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 - IF ( .NOT. ALLOCATED(InData%TStC) ) 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%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - 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 - IF ( .NOT. ALLOCATED(InData%SStC) ) 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%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - 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 - END SUBROUTINE SrvD_PackDiscState - - SUBROUTINE SrvD_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(SrvD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_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%CtrlOffset = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC 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%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,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 StC_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - 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 ! NStC 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%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,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 StC_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - 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 ! TStC 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%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,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 StC_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - 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 ! SStC 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%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,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 StC_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - 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 - END SUBROUTINE SrvD_UnPackDiscState - - SUBROUTINE SrvD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SrvD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState -IF (ALLOCATED(SrcConstrStateData%BStC)) THEN - i1_l = LBOUND(SrcConstrStateData%BStC,1) - i1_u = UBOUND(SrcConstrStateData%BStC,1) - IF (.NOT. ALLOCATED(DstConstrStateData%BStC)) THEN - ALLOCATE(DstConstrStateData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%BStC,1), UBOUND(SrcConstrStateData%BStC,1) - CALL StC_CopyConstrState( SrcConstrStateData%BStC(i1), DstConstrStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcConstrStateData%NStC)) THEN - i1_l = LBOUND(SrcConstrStateData%NStC,1) - i1_u = UBOUND(SrcConstrStateData%NStC,1) - IF (.NOT. ALLOCATED(DstConstrStateData%NStC)) THEN - ALLOCATE(DstConstrStateData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%NStC,1), UBOUND(SrcConstrStateData%NStC,1) - CALL StC_CopyConstrState( SrcConstrStateData%NStC(i1), DstConstrStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcConstrStateData%TStC)) THEN - i1_l = LBOUND(SrcConstrStateData%TStC,1) - i1_u = UBOUND(SrcConstrStateData%TStC,1) - IF (.NOT. ALLOCATED(DstConstrStateData%TStC)) THEN - ALLOCATE(DstConstrStateData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%TStC,1), UBOUND(SrcConstrStateData%TStC,1) - CALL StC_CopyConstrState( SrcConstrStateData%TStC(i1), DstConstrStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcConstrStateData%SStC)) THEN - i1_l = LBOUND(SrcConstrStateData%SStC,1) - i1_u = UBOUND(SrcConstrStateData%SStC,1) - IF (.NOT. ALLOCATED(DstConstrStateData%SStC)) THEN - ALLOCATE(DstConstrStateData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%SStC,1), UBOUND(SrcConstrStateData%SStC,1) - CALL StC_CopyConstrState( SrcConstrStateData%SStC(i1), DstConstrStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyConstrState - - SUBROUTINE SrvD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(SrvD_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 = 'SrvD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ConstrStateData%BStC)) THEN -DO i1 = LBOUND(ConstrStateData%BStC,1), UBOUND(ConstrStateData%BStC,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ConstrStateData%SStC) -ENDIF - END SUBROUTINE SrvD_DestroyConstrState - - SUBROUTINE SrvD_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(SrvD_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 = 'SrvD_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 - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) 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%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - 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 - IF ( .NOT. ALLOCATED(InData%NStC) ) 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%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - 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 - IF ( .NOT. ALLOCATED(InData%TStC) ) 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%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - 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 - IF ( .NOT. ALLOCATED(InData%SStC) ) 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%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - 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 - END SUBROUTINE SrvD_PackConstrState - - SUBROUTINE SrvD_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(SrvD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC 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%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,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 StC_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - 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 ! NStC 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%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,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 StC_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - 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 ! TStC 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%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,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 StC_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - 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 ! SStC 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%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,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 StC_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - 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 - END SUBROUTINE SrvD_UnPackConstrState - - SUBROUTINE SrvD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SrvD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%BegPitMan)) THEN - i1_l = LBOUND(SrcOtherStateData%BegPitMan,1) - i1_u = UBOUND(SrcOtherStateData%BegPitMan,1) - IF (.NOT. ALLOCATED(DstOtherStateData%BegPitMan)) THEN - ALLOCATE(DstOtherStateData%BegPitMan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BegPitMan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%BegPitMan = SrcOtherStateData%BegPitMan -ENDIF -IF (ALLOCATED(SrcOtherStateData%BlPitchI)) THEN - i1_l = LBOUND(SrcOtherStateData%BlPitchI,1) - i1_u = UBOUND(SrcOtherStateData%BlPitchI,1) - IF (.NOT. ALLOCATED(DstOtherStateData%BlPitchI)) THEN - ALLOCATE(DstOtherStateData%BlPitchI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BlPitchI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%BlPitchI = SrcOtherStateData%BlPitchI -ENDIF -IF (ALLOCATED(SrcOtherStateData%TPitManE)) THEN - i1_l = LBOUND(SrcOtherStateData%TPitManE,1) - i1_u = UBOUND(SrcOtherStateData%TPitManE,1) - IF (.NOT. ALLOCATED(DstOtherStateData%TPitManE)) THEN - ALLOCATE(DstOtherStateData%TPitManE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TPitManE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%TPitManE = SrcOtherStateData%TPitManE -ENDIF - DstOtherStateData%BegYawMan = SrcOtherStateData%BegYawMan - DstOtherStateData%NacYawI = SrcOtherStateData%NacYawI - DstOtherStateData%TYawManE = SrcOtherStateData%TYawManE - DstOtherStateData%YawPosComInt = SrcOtherStateData%YawPosComInt -IF (ALLOCATED(SrcOtherStateData%BegTpBr)) THEN - i1_l = LBOUND(SrcOtherStateData%BegTpBr,1) - i1_u = UBOUND(SrcOtherStateData%BegTpBr,1) - IF (.NOT. ALLOCATED(DstOtherStateData%BegTpBr)) THEN - ALLOCATE(DstOtherStateData%BegTpBr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BegTpBr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%BegTpBr = SrcOtherStateData%BegTpBr -ENDIF -IF (ALLOCATED(SrcOtherStateData%TTpBrDp)) THEN - i1_l = LBOUND(SrcOtherStateData%TTpBrDp,1) - i1_u = UBOUND(SrcOtherStateData%TTpBrDp,1) - IF (.NOT. ALLOCATED(DstOtherStateData%TTpBrDp)) THEN - ALLOCATE(DstOtherStateData%TTpBrDp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TTpBrDp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%TTpBrDp = SrcOtherStateData%TTpBrDp -ENDIF -IF (ALLOCATED(SrcOtherStateData%TTpBrFl)) THEN - i1_l = LBOUND(SrcOtherStateData%TTpBrFl,1) - i1_u = UBOUND(SrcOtherStateData%TTpBrFl,1) - IF (.NOT. ALLOCATED(DstOtherStateData%TTpBrFl)) THEN - ALLOCATE(DstOtherStateData%TTpBrFl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TTpBrFl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%TTpBrFl = SrcOtherStateData%TTpBrFl -ENDIF - DstOtherStateData%Off4Good = SrcOtherStateData%Off4Good - DstOtherStateData%GenOnLine = SrcOtherStateData%GenOnLine -IF (ALLOCATED(SrcOtherStateData%BStC)) THEN - i1_l = LBOUND(SrcOtherStateData%BStC,1) - i1_u = UBOUND(SrcOtherStateData%BStC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%BStC)) THEN - ALLOCATE(DstOtherStateData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%BStC,1), UBOUND(SrcOtherStateData%BStC,1) - CALL StC_CopyOtherState( SrcOtherStateData%BStC(i1), DstOtherStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOtherStateData%NStC)) THEN - i1_l = LBOUND(SrcOtherStateData%NStC,1) - i1_u = UBOUND(SrcOtherStateData%NStC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%NStC)) THEN - ALLOCATE(DstOtherStateData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%NStC,1), UBOUND(SrcOtherStateData%NStC,1) - CALL StC_CopyOtherState( SrcOtherStateData%NStC(i1), DstOtherStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOtherStateData%TStC)) THEN - i1_l = LBOUND(SrcOtherStateData%TStC,1) - i1_u = UBOUND(SrcOtherStateData%TStC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%TStC)) THEN - ALLOCATE(DstOtherStateData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%TStC,1), UBOUND(SrcOtherStateData%TStC,1) - CALL StC_CopyOtherState( SrcOtherStateData%TStC(i1), DstOtherStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOtherStateData%SStC)) THEN - i1_l = LBOUND(SrcOtherStateData%SStC,1) - i1_u = UBOUND(SrcOtherStateData%SStC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%SStC)) THEN - ALLOCATE(DstOtherStateData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%SStC,1), UBOUND(SrcOtherStateData%SStC,1) - CALL StC_CopyOtherState( SrcOtherStateData%SStC(i1), DstOtherStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyOtherState - - SUBROUTINE SrvD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(SrvD_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 = 'SrvD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%BegPitMan)) THEN - DEALLOCATE(OtherStateData%BegPitMan) -ENDIF -IF (ALLOCATED(OtherStateData%BlPitchI)) THEN - DEALLOCATE(OtherStateData%BlPitchI) -ENDIF -IF (ALLOCATED(OtherStateData%TPitManE)) THEN - DEALLOCATE(OtherStateData%TPitManE) -ENDIF -IF (ALLOCATED(OtherStateData%BegTpBr)) THEN - DEALLOCATE(OtherStateData%BegTpBr) -ENDIF -IF (ALLOCATED(OtherStateData%TTpBrDp)) THEN - DEALLOCATE(OtherStateData%TTpBrDp) -ENDIF -IF (ALLOCATED(OtherStateData%TTpBrFl)) THEN - DEALLOCATE(OtherStateData%TTpBrFl) -ENDIF -IF (ALLOCATED(OtherStateData%BStC)) THEN -DO i1 = LBOUND(OtherStateData%BStC,1), UBOUND(OtherStateData%BStC,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%SStC) -ENDIF - END SUBROUTINE SrvD_DestroyOtherState - - SUBROUTINE SrvD_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(SrvD_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 = 'SrvD_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 ! BegPitMan allocated yes/no - IF ( ALLOCATED(InData%BegPitMan) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BegPitMan upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BegPitMan) ! BegPitMan - END IF - Int_BufSz = Int_BufSz + 1 ! BlPitchI allocated yes/no - IF ( ALLOCATED(InData%BlPitchI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchI) ! BlPitchI - END IF - Int_BufSz = Int_BufSz + 1 ! TPitManE allocated yes/no - IF ( ALLOCATED(InData%TPitManE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TPitManE upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TPitManE) ! TPitManE - END IF - Int_BufSz = Int_BufSz + 1 ! BegYawMan - Re_BufSz = Re_BufSz + 1 ! NacYawI - Db_BufSz = Db_BufSz + 1 ! TYawManE - Re_BufSz = Re_BufSz + 1 ! YawPosComInt - Int_BufSz = Int_BufSz + 1 ! BegTpBr allocated yes/no - IF ( ALLOCATED(InData%BegTpBr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BegTpBr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BegTpBr) ! BegTpBr - END IF - Int_BufSz = Int_BufSz + 1 ! TTpBrDp allocated yes/no - IF ( ALLOCATED(InData%TTpBrDp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TTpBrDp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TTpBrDp) ! TTpBrDp - END IF - Int_BufSz = Int_BufSz + 1 ! TTpBrFl allocated yes/no - IF ( ALLOCATED(InData%TTpBrFl) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TTpBrFl upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TTpBrFl) ! TTpBrFl - END IF - Int_BufSz = Int_BufSz + 1 ! Off4Good - Int_BufSz = Int_BufSz + 1 ! GenOnLine - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%BegPitMan) ) 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%BegPitMan,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BegPitMan,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BegPitMan,1), UBOUND(InData%BegPitMan,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%BegPitMan(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlPitchI) ) 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%BlPitchI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchI,1), UBOUND(InData%BlPitchI,1) - ReKiBuf(Re_Xferred) = InData%BlPitchI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TPitManE) ) 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%TPitManE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TPitManE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TPitManE,1), UBOUND(InData%TPitManE,1) - DbKiBuf(Db_Xferred) = InData%TPitManE(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%BegYawMan, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYawI - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TYawManE - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawPosComInt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BegTpBr) ) 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%BegTpBr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BegTpBr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BegTpBr,1), UBOUND(InData%BegTpBr,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%BegTpBr(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TTpBrDp) ) 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%TTpBrDp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TTpBrDp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TTpBrDp,1), UBOUND(InData%TTpBrDp,1) - DbKiBuf(Db_Xferred) = InData%TTpBrDp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TTpBrFl) ) 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%TTpBrFl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TTpBrFl,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TTpBrFl,1), UBOUND(InData%TTpBrFl,1) - DbKiBuf(Db_Xferred) = InData%TTpBrFl(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%Off4Good, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenOnLine, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) 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%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - 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 - IF ( .NOT. ALLOCATED(InData%NStC) ) 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%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - 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 - IF ( .NOT. ALLOCATED(InData%TStC) ) 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%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - 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 - IF ( .NOT. ALLOCATED(InData%SStC) ) 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%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - 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 - END SUBROUTINE SrvD_PackOtherState - - SUBROUTINE SrvD_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(SrvD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BegPitMan 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%BegPitMan)) DEALLOCATE(OutData%BegPitMan) - ALLOCATE(OutData%BegPitMan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegPitMan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BegPitMan,1), UBOUND(OutData%BegPitMan,1) - OutData%BegPitMan(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegPitMan(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchI 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%BlPitchI)) DEALLOCATE(OutData%BlPitchI) - ALLOCATE(OutData%BlPitchI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchI,1), UBOUND(OutData%BlPitchI,1) - OutData%BlPitchI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TPitManE 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%TPitManE)) DEALLOCATE(OutData%TPitManE) - ALLOCATE(OutData%TPitManE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TPitManE,1), UBOUND(OutData%TPitManE,1) - OutData%TPitManE(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%BegYawMan = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegYawMan) - Int_Xferred = Int_Xferred + 1 - OutData%NacYawI = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TYawManE = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%YawPosComInt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BegTpBr 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%BegTpBr)) DEALLOCATE(OutData%BegTpBr) - ALLOCATE(OutData%BegTpBr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegTpBr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BegTpBr,1), UBOUND(OutData%BegTpBr,1) - OutData%BegTpBr(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegTpBr(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TTpBrDp 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%TTpBrDp)) DEALLOCATE(OutData%TTpBrDp) - ALLOCATE(OutData%TTpBrDp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrDp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TTpBrDp,1), UBOUND(OutData%TTpBrDp,1) - OutData%TTpBrDp(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TTpBrFl 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%TTpBrFl)) DEALLOCATE(OutData%TTpBrFl) - ALLOCATE(OutData%TTpBrFl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrFl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TTpBrFl,1), UBOUND(OutData%TTpBrFl,1) - OutData%TTpBrFl(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%Off4Good = TRANSFER(IntKiBuf(Int_Xferred), OutData%Off4Good) - Int_Xferred = Int_Xferred + 1 - OutData%GenOnLine = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenOnLine) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC 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%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,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 StC_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - 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 ! NStC 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%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,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 StC_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - 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 ! TStC 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%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,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 StC_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - 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 ! SStC 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%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,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 StC_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - 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 - END SUBROUTINE SrvD_UnPackOtherState - - SUBROUTINE SrvD_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_ModuleMapType), INTENT(INOUT) :: SrcModuleMapTypeData - TYPE(SrvD_ModuleMapType), INTENT(INOUT) :: DstModuleMapTypeData - 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 = 'SrvD_CopyModuleMapType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcModuleMapTypeData%u_BStC_Mot2_BStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,1) - i2_l = LBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,2) - i2_u = UBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BStC_Mot2_BStC)) THEN - ALLOCATE(DstModuleMapTypeData%u_BStC_Mot2_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BStC_Mot2_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,2), UBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,2) - DO i1 = LBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,1), UBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), DstModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%u_NStC_Mot2_NStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_NStC_Mot2_NStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_NStC_Mot2_NStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_NStC_Mot2_NStC)) THEN - ALLOCATE(DstModuleMapTypeData%u_NStC_Mot2_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_NStC_Mot2_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_NStC_Mot2_NStC,1), UBOUND(SrcModuleMapTypeData%u_NStC_Mot2_NStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%u_NStC_Mot2_NStC(i1), DstModuleMapTypeData%u_NStC_Mot2_NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%u_TStC_Mot2_TStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_TStC_Mot2_TStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_TStC_Mot2_TStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_TStC_Mot2_TStC)) THEN - ALLOCATE(DstModuleMapTypeData%u_TStC_Mot2_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_TStC_Mot2_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_TStC_Mot2_TStC,1), UBOUND(SrcModuleMapTypeData%u_TStC_Mot2_TStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%u_TStC_Mot2_TStC(i1), DstModuleMapTypeData%u_TStC_Mot2_TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%u_SStC_Mot2_SStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_SStC_Mot2_SStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_SStC_Mot2_SStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_SStC_Mot2_SStC)) THEN - ALLOCATE(DstModuleMapTypeData%u_SStC_Mot2_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_SStC_Mot2_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_SStC_Mot2_SStC,1), UBOUND(SrcModuleMapTypeData%u_SStC_Mot2_SStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%u_SStC_Mot2_SStC(i1), DstModuleMapTypeData%u_SStC_Mot2_SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BStC_Frc2_y_BStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,1) - i2_l = LBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,2) - i2_u = UBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BStC_Frc2_y_BStC)) THEN - ALLOCATE(DstModuleMapTypeData%BStC_Frc2_y_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_Frc2_y_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,2), UBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,2) - DO i1 = LBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,1), UBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), DstModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%NStC_Frc2_y_NStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%NStC_Frc2_y_NStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%NStC_Frc2_y_NStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%NStC_Frc2_y_NStC)) THEN - ALLOCATE(DstModuleMapTypeData%NStC_Frc2_y_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%NStC_Frc2_y_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%NStC_Frc2_y_NStC,1), UBOUND(SrcModuleMapTypeData%NStC_Frc2_y_NStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%NStC_Frc2_y_NStC(i1), DstModuleMapTypeData%NStC_Frc2_y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%TStC_Frc2_y_TStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%TStC_Frc2_y_TStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%TStC_Frc2_y_TStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%TStC_Frc2_y_TStC)) THEN - ALLOCATE(DstModuleMapTypeData%TStC_Frc2_y_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%TStC_Frc2_y_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%TStC_Frc2_y_TStC,1), UBOUND(SrcModuleMapTypeData%TStC_Frc2_y_TStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%TStC_Frc2_y_TStC(i1), DstModuleMapTypeData%TStC_Frc2_y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SStC_Frc2_y_SStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SStC_Frc2_y_SStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%SStC_Frc2_y_SStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SStC_Frc2_y_SStC)) THEN - ALLOCATE(DstModuleMapTypeData%SStC_Frc2_y_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SStC_Frc2_y_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SStC_Frc2_y_SStC,1), UBOUND(SrcModuleMapTypeData%SStC_Frc2_y_SStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SStC_Frc2_y_SStC(i1), DstModuleMapTypeData%SStC_Frc2_y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyModuleMapType - - SUBROUTINE SrvD_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) - TYPE(SrvD_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData - 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 = 'SrvD_DestroyModuleMapType' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%u_BStC_Mot2_BStC) -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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_SStC_Mot2_SStC) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%BStC_Frc2_y_BStC) -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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%SStC_Frc2_y_SStC) -ENDIF - END SUBROUTINE SrvD_DestroyModuleMapType - - SUBROUTINE SrvD_PackModuleMapType( 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(SrvD_ModuleMapType), 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 = 'SrvD_PackModuleMapType' - ! 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 ! u_BStC_Mot2_BStC allocated yes/no - IF ( ALLOCATED(InData%u_BStC_Mot2_BStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_BStC_Mot2_BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_BStC_Mot2_BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BStC_Mot2_BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BStC_Mot2_BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_NStC_Mot2_NStC allocated yes/no - IF ( ALLOCATED(InData%u_NStC_Mot2_NStC) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_NStC_Mot2_NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_NStC_Mot2_NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_NStC_Mot2_NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_TStC_Mot2_TStC allocated yes/no - IF ( ALLOCATED(InData%u_TStC_Mot2_TStC) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_TStC_Mot2_TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_TStC_Mot2_TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_TStC_Mot2_TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_SStC_Mot2_SStC allocated yes/no - IF ( ALLOCATED(InData%u_SStC_Mot2_SStC) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SStC_Mot2_SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SStC_Mot2_SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SStC_Mot2_SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BStC_Frc2_y_BStC allocated yes/no - IF ( ALLOCATED(InData%BStC_Frc2_y_BStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BStC_Frc2_y_BStC upper/lower bounds for each dimension - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC_Frc2_y_BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC_Frc2_y_BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC_Frc2_y_BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC_Frc2_y_NStC allocated yes/no - IF ( ALLOCATED(InData%NStC_Frc2_y_NStC) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC_Frc2_y_NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC_Frc2_y_NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC_Frc2_y_NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC_Frc2_y_TStC allocated yes/no - IF ( ALLOCATED(InData%TStC_Frc2_y_TStC) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC_Frc2_y_TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC_Frc2_y_TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC_Frc2_y_TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC_Frc2_y_SStC allocated yes/no - IF ( ALLOCATED(InData%SStC_Frc2_y_SStC) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC_Frc2_y_SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC_Frc2_y_SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC_Frc2_y_SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%u_BStC_Mot2_BStC) ) 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%u_BStC_Mot2_BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BStC_Mot2_BStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BStC_Mot2_BStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BStC_Mot2_BStC,2) - Int_Xferred = Int_Xferred + 2 - - 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 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%u_NStC_Mot2_NStC) ) 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%u_NStC_Mot2_NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_NStC_Mot2_NStC,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%u_TStC_Mot2_TStC) ) 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%u_TStC_Mot2_TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_TStC_Mot2_TStC,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%u_SStC_Mot2_SStC) ) 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%u_SStC_Mot2_SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SStC_Mot2_SStC,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%BStC_Frc2_y_BStC) ) 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%BStC_Frc2_y_BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_Frc2_y_BStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_Frc2_y_BStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_Frc2_y_BStC,2) - Int_Xferred = Int_Xferred + 2 - - 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 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC_Frc2_y_NStC) ) 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%NStC_Frc2_y_NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC_Frc2_y_NStC,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%TStC_Frc2_y_TStC) ) 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%TStC_Frc2_y_TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC_Frc2_y_TStC,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%SStC_Frc2_y_SStC) ) 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%SStC_Frc2_y_SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC_Frc2_y_SStC,1) - 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 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 - END SUBROUTINE SrvD_PackModuleMapType - - SUBROUTINE SrvD_UnPackModuleMapType( 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(SrvD_ModuleMapType), 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 = 'SrvD_UnPackModuleMapType' - ! 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 ! u_BStC_Mot2_BStC 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%u_BStC_Mot2_BStC)) DEALLOCATE(OutData%u_BStC_Mot2_BStC) - ALLOCATE(OutData%u_BStC_Mot2_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC_Mot2_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_BStC_Mot2_BStC,2), UBOUND(OutData%u_BStC_Mot2_BStC,2) - DO i1 = LBOUND(OutData%u_BStC_Mot2_BStC,1), UBOUND(OutData%u_BStC_Mot2_BStC,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_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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_NStC_Mot2_NStC 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%u_NStC_Mot2_NStC)) DEALLOCATE(OutData%u_NStC_Mot2_NStC) - ALLOCATE(OutData%u_NStC_Mot2_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC_Mot2_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_NStC_Mot2_NStC,1), UBOUND(OutData%u_NStC_Mot2_NStC,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_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 - - 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 ! u_TStC_Mot2_TStC 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%u_TStC_Mot2_TStC)) DEALLOCATE(OutData%u_TStC_Mot2_TStC) - ALLOCATE(OutData%u_TStC_Mot2_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC_Mot2_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_TStC_Mot2_TStC,1), UBOUND(OutData%u_TStC_Mot2_TStC,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_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 - - 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 ! u_SStC_Mot2_SStC 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%u_SStC_Mot2_SStC)) DEALLOCATE(OutData%u_SStC_Mot2_SStC) - ALLOCATE(OutData%u_SStC_Mot2_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC_Mot2_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_SStC_Mot2_SStC,1), UBOUND(OutData%u_SStC_Mot2_SStC,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_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 - - 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 ! BStC_Frc2_y_BStC 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%BStC_Frc2_y_BStC)) DEALLOCATE(OutData%BStC_Frc2_y_BStC) - ALLOCATE(OutData%BStC_Frc2_y_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_Frc2_y_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BStC_Frc2_y_BStC,2), UBOUND(OutData%BStC_Frc2_y_BStC,2) - DO i1 = LBOUND(OutData%BStC_Frc2_y_BStC,1), UBOUND(OutData%BStC_Frc2_y_BStC,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_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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC_Frc2_y_NStC 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%NStC_Frc2_y_NStC)) DEALLOCATE(OutData%NStC_Frc2_y_NStC) - ALLOCATE(OutData%NStC_Frc2_y_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_Frc2_y_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC_Frc2_y_NStC,1), UBOUND(OutData%NStC_Frc2_y_NStC,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_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 - - 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 ! TStC_Frc2_y_TStC 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%TStC_Frc2_y_TStC)) DEALLOCATE(OutData%TStC_Frc2_y_TStC) - ALLOCATE(OutData%TStC_Frc2_y_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_Frc2_y_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC_Frc2_y_TStC,1), UBOUND(OutData%TStC_Frc2_y_TStC,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_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 - - 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 ! SStC_Frc2_y_SStC 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%SStC_Frc2_y_SStC)) DEALLOCATE(OutData%SStC_Frc2_y_SStC) - ALLOCATE(OutData%SStC_Frc2_y_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_Frc2_y_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC_Frc2_y_SStC,1), UBOUND(OutData%SStC_Frc2_y_SStC,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_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 - - 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 - END SUBROUTINE SrvD_UnPackModuleMapType - - SUBROUTINE SrvD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(SrvD_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) :: 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 = 'SrvD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%LastTimeCalled = SrcMiscData%LastTimeCalled - CALL SrvD_Copybladeddlltype( SrcMiscData%dll_data, DstMiscData%dll_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%FirstWarn = SrcMiscData%FirstWarn - DstMiscData%LastTimeFiltered = SrcMiscData%LastTimeFiltered -IF (ALLOCATED(SrcMiscData%xd_BlPitchFilter)) THEN - i1_l = LBOUND(SrcMiscData%xd_BlPitchFilter,1) - i1_u = UBOUND(SrcMiscData%xd_BlPitchFilter,1) - IF (.NOT. ALLOCATED(DstMiscData%xd_BlPitchFilter)) THEN - ALLOCATE(DstMiscData%xd_BlPitchFilter(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xd_BlPitchFilter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%xd_BlPitchFilter = SrcMiscData%xd_BlPitchFilter -ENDIF -IF (ALLOCATED(SrcMiscData%BStC)) THEN - i1_l = LBOUND(SrcMiscData%BStC,1) - i1_u = UBOUND(SrcMiscData%BStC,1) - IF (.NOT. ALLOCATED(DstMiscData%BStC)) THEN - ALLOCATE(DstMiscData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%BStC,1), UBOUND(SrcMiscData%BStC,1) - CALL StC_CopyMisc( SrcMiscData%BStC(i1), DstMiscData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%NStC)) THEN - i1_l = LBOUND(SrcMiscData%NStC,1) - i1_u = UBOUND(SrcMiscData%NStC,1) - IF (.NOT. ALLOCATED(DstMiscData%NStC)) THEN - ALLOCATE(DstMiscData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%NStC,1), UBOUND(SrcMiscData%NStC,1) - CALL StC_CopyMisc( SrcMiscData%NStC(i1), DstMiscData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%TStC)) THEN - i1_l = LBOUND(SrcMiscData%TStC,1) - i1_u = UBOUND(SrcMiscData%TStC,1) - IF (.NOT. ALLOCATED(DstMiscData%TStC)) THEN - ALLOCATE(DstMiscData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%TStC,1), UBOUND(SrcMiscData%TStC,1) - CALL StC_CopyMisc( SrcMiscData%TStC(i1), DstMiscData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%SStC)) THEN - i1_l = LBOUND(SrcMiscData%SStC,1) - i1_u = UBOUND(SrcMiscData%SStC,1) - IF (.NOT. ALLOCATED(DstMiscData%SStC)) THEN - ALLOCATE(DstMiscData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%SStC,1), UBOUND(SrcMiscData%SStC,1) - CALL StC_CopyMisc( SrcMiscData%SStC(i1), DstMiscData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%u_BStC)) THEN - i1_l = LBOUND(SrcMiscData%u_BStC,1) - i1_u = UBOUND(SrcMiscData%u_BStC,1) - i2_l = LBOUND(SrcMiscData%u_BStC,2) - i2_u = UBOUND(SrcMiscData%u_BStC,2) - IF (.NOT. ALLOCATED(DstMiscData%u_BStC)) THEN - ALLOCATE(DstMiscData%u_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcMiscData%u_BStC,2), UBOUND(SrcMiscData%u_BStC,2) - DO i1 = LBOUND(SrcMiscData%u_BStC,1), UBOUND(SrcMiscData%u_BStC,1) - CALL StC_CopyInput( SrcMiscData%u_BStC(i1,i2), DstMiscData%u_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%u_NStC)) THEN - i1_l = LBOUND(SrcMiscData%u_NStC,1) - i1_u = UBOUND(SrcMiscData%u_NStC,1) - i2_l = LBOUND(SrcMiscData%u_NStC,2) - i2_u = UBOUND(SrcMiscData%u_NStC,2) - IF (.NOT. ALLOCATED(DstMiscData%u_NStC)) THEN - ALLOCATE(DstMiscData%u_NStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcMiscData%u_NStC,2), UBOUND(SrcMiscData%u_NStC,2) - DO i1 = LBOUND(SrcMiscData%u_NStC,1), UBOUND(SrcMiscData%u_NStC,1) - CALL StC_CopyInput( SrcMiscData%u_NStC(i1,i2), DstMiscData%u_NStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%u_TStC)) THEN - i1_l = LBOUND(SrcMiscData%u_TStC,1) - i1_u = UBOUND(SrcMiscData%u_TStC,1) - i2_l = LBOUND(SrcMiscData%u_TStC,2) - i2_u = UBOUND(SrcMiscData%u_TStC,2) - IF (.NOT. ALLOCATED(DstMiscData%u_TStC)) THEN - ALLOCATE(DstMiscData%u_TStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcMiscData%u_TStC,2), UBOUND(SrcMiscData%u_TStC,2) - DO i1 = LBOUND(SrcMiscData%u_TStC,1), UBOUND(SrcMiscData%u_TStC,1) - CALL StC_CopyInput( SrcMiscData%u_TStC(i1,i2), DstMiscData%u_TStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%u_SStC)) THEN - i1_l = LBOUND(SrcMiscData%u_SStC,1) - i1_u = UBOUND(SrcMiscData%u_SStC,1) - i2_l = LBOUND(SrcMiscData%u_SStC,2) - i2_u = UBOUND(SrcMiscData%u_SStC,2) - IF (.NOT. ALLOCATED(DstMiscData%u_SStC)) THEN - ALLOCATE(DstMiscData%u_SStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcMiscData%u_SStC,2), UBOUND(SrcMiscData%u_SStC,2) - DO i1 = LBOUND(SrcMiscData%u_SStC,1), UBOUND(SrcMiscData%u_SStC,1) - CALL StC_CopyInput( SrcMiscData%u_SStC(i1,i2), DstMiscData%u_SStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%y_BStC)) THEN - i1_l = LBOUND(SrcMiscData%y_BStC,1) - i1_u = UBOUND(SrcMiscData%y_BStC,1) - IF (.NOT. ALLOCATED(DstMiscData%y_BStC)) THEN - ALLOCATE(DstMiscData%y_BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%y_BStC,1), UBOUND(SrcMiscData%y_BStC,1) - CALL StC_CopyOutput( SrcMiscData%y_BStC(i1), DstMiscData%y_BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%y_NStC)) THEN - i1_l = LBOUND(SrcMiscData%y_NStC,1) - i1_u = UBOUND(SrcMiscData%y_NStC,1) - IF (.NOT. ALLOCATED(DstMiscData%y_NStC)) THEN - ALLOCATE(DstMiscData%y_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%y_NStC,1), UBOUND(SrcMiscData%y_NStC,1) - CALL StC_CopyOutput( SrcMiscData%y_NStC(i1), DstMiscData%y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%y_TStC)) THEN - i1_l = LBOUND(SrcMiscData%y_TStC,1) - i1_u = UBOUND(SrcMiscData%y_TStC,1) - IF (.NOT. ALLOCATED(DstMiscData%y_TStC)) THEN - ALLOCATE(DstMiscData%y_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%y_TStC,1), UBOUND(SrcMiscData%y_TStC,1) - CALL StC_CopyOutput( SrcMiscData%y_TStC(i1), DstMiscData%y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%y_SStC)) THEN - i1_l = LBOUND(SrcMiscData%y_SStC,1) - i1_u = UBOUND(SrcMiscData%y_SStC,1) - IF (.NOT. ALLOCATED(DstMiscData%y_SStC)) THEN - ALLOCATE(DstMiscData%y_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%y_SStC,1), UBOUND(SrcMiscData%y_SStC,1) - CALL StC_CopyOutput( SrcMiscData%y_SStC(i1), DstMiscData%y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SrvD_Copymodulemaptype( SrcMiscData%SrvD_MeshMap, DstMiscData%SrvD_MeshMap, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%PrevTstepNcall = SrcMiscData%PrevTstepNcall - END SUBROUTINE SrvD_CopyMisc - - SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SrvD_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 = 'SrvD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - 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 ) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%SStC) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(MiscData%u_BStC) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(MiscData%u_NStC) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(MiscData%u_TStC) -ENDIF -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(MiscData%u_SStC) -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 ) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%y_SStC) -ENDIF - CALL SrvD_DestroyModuleMapType( MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SrvD_DestroyMisc - - SUBROUTINE SrvD_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(SrvD_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 = 'SrvD_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 - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! dll_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! dll_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! dll_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! FirstWarn - Db_BufSz = Db_BufSz + 1 ! LastTimeFiltered - Int_BufSz = Int_BufSz + 1 ! xd_BlPitchFilter allocated yes/no - IF ( ALLOCATED(InData%xd_BlPitchFilter) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_BlPitchFilter upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xd_BlPitchFilter) ! xd_BlPitchFilter - END IF - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_BStC allocated yes/no - IF ( ALLOCATED(InData%u_BStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_BStC upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_BStC,2), UBOUND(InData%u_BStC,2) - DO i1 = LBOUND(InData%u_BStC,1), UBOUND(InData%u_BStC,1) - Int_BufSz = Int_BufSz + 3 ! u_BStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_NStC allocated yes/no - IF ( ALLOCATED(InData%u_NStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_NStC upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_NStC,2), UBOUND(InData%u_NStC,2) - DO i1 = LBOUND(InData%u_NStC,1), UBOUND(InData%u_NStC,1) - Int_BufSz = Int_BufSz + 3 ! u_NStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_NStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_TStC allocated yes/no - IF ( ALLOCATED(InData%u_TStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_TStC upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_TStC,2), UBOUND(InData%u_TStC,2) - DO i1 = LBOUND(InData%u_TStC,1), UBOUND(InData%u_TStC,1) - Int_BufSz = Int_BufSz + 3 ! u_TStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_TStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_SStC allocated yes/no - IF ( ALLOCATED(InData%u_SStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_SStC upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_SStC,2), UBOUND(InData%u_SStC,2) - DO i1 = LBOUND(InData%u_SStC,1), UBOUND(InData%u_SStC,1) - Int_BufSz = Int_BufSz + 3 ! u_SStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_BStC allocated yes/no - IF ( ALLOCATED(InData%y_BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_BStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_BStC,1), UBOUND(InData%y_BStC,1) - Int_BufSz = Int_BufSz + 3 ! y_BStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_NStC allocated yes/no - IF ( ALLOCATED(InData%y_NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_NStC,1), UBOUND(InData%y_NStC,1) - Int_BufSz = Int_BufSz + 3 ! y_NStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_TStC allocated yes/no - IF ( ALLOCATED(InData%y_TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_TStC,1), UBOUND(InData%y_TStC,1) - Int_BufSz = Int_BufSz + 3 ! y_TStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_SStC allocated yes/no - IF ( ALLOCATED(InData%y_SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_SStC,1), UBOUND(InData%y_SStC,1) - Int_BufSz = Int_BufSz + 3 ! y_SStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SrvD_MeshMap - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SrvD_MeshMap - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SrvD_MeshMap - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! PrevTstepNcall - 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%LastTimeCalled - Db_Xferred = Db_Xferred + 1 - 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 - - 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) = TRANSFER(InData%FirstWarn, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%LastTimeFiltered - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%xd_BlPitchFilter) ) 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%xd_BlPitchFilter,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BlPitchFilter,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_BlPitchFilter,1), UBOUND(InData%xd_BlPitchFilter,1) - ReKiBuf(Re_Xferred) = InData%xd_BlPitchFilter(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BStC) ) 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%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - 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 - IF ( .NOT. ALLOCATED(InData%NStC) ) 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%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - 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 - IF ( .NOT. ALLOCATED(InData%TStC) ) 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%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - 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 - IF ( .NOT. ALLOCATED(InData%SStC) ) 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%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - 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 - IF ( .NOT. ALLOCATED(InData%u_BStC) ) 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%u_BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_BStC,2), UBOUND(InData%u_BStC,2) - DO i1 = LBOUND(InData%u_BStC,1), UBOUND(InData%u_BStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_BStC - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%u_NStC) ) 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%u_NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_NStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_NStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_NStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_NStC,2), UBOUND(InData%u_NStC,2) - DO i1 = LBOUND(InData%u_NStC,1), UBOUND(InData%u_NStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_NStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_NStC - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%u_TStC) ) 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%u_TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_TStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_TStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_TStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_TStC,2), UBOUND(InData%u_TStC,2) - DO i1 = LBOUND(InData%u_TStC,1), UBOUND(InData%u_TStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_TStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_TStC - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%u_SStC) ) 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%u_SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_SStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_SStC,2), UBOUND(InData%u_SStC,2) - DO i1 = LBOUND(InData%u_SStC,1), UBOUND(InData%u_SStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_SStC - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%y_BStC) ) 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%y_BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_BStC,1), UBOUND(InData%y_BStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_BStC - 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 - IF ( .NOT. ALLOCATED(InData%y_NStC) ) 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%y_NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_NStC,1), UBOUND(InData%y_NStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_NStC - 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 - IF ( .NOT. ALLOCATED(InData%y_TStC) ) 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%y_TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_TStC,1), UBOUND(InData%y_TStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_TStC - 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 - IF ( .NOT. ALLOCATED(InData%y_SStC) ) 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%y_SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_SStC,1), UBOUND(InData%y_SStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_SStC - 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 - 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 - - 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%PrevTstepNcall - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SrvD_PackMisc - - SUBROUTINE SrvD_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(SrvD_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) :: 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 = 'SrvD_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%LastTimeCalled = DbKiBuf(Db_Xferred) - Db_Xferred = Db_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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%FirstWarn = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn) - Int_Xferred = Int_Xferred + 1 - OutData%LastTimeFiltered = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_BlPitchFilter 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%xd_BlPitchFilter)) DEALLOCATE(OutData%xd_BlPitchFilter) - ALLOCATE(OutData%xd_BlPitchFilter(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BlPitchFilter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_BlPitchFilter,1), UBOUND(OutData%xd_BlPitchFilter,1) - OutData%xd_BlPitchFilter(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC 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%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,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 StC_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - 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 ! NStC 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%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,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 StC_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - 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 ! TStC 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%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,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 StC_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - 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 ! SStC 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%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,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 StC_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - 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 ! u_BStC 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%u_BStC)) DEALLOCATE(OutData%u_BStC) - ALLOCATE(OutData%u_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_BStC,2), UBOUND(OutData%u_BStC,2) - DO i1 = LBOUND(OutData%u_BStC,1), UBOUND(OutData%u_BStC,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 StC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_BStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_BStC - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_NStC 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%u_NStC)) DEALLOCATE(OutData%u_NStC) - ALLOCATE(OutData%u_NStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_NStC,2), UBOUND(OutData%u_NStC,2) - DO i1 = LBOUND(OutData%u_NStC,1), UBOUND(OutData%u_NStC,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 StC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_NStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_NStC - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_TStC 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%u_TStC)) DEALLOCATE(OutData%u_TStC) - ALLOCATE(OutData%u_TStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_TStC,2), UBOUND(OutData%u_TStC,2) - DO i1 = LBOUND(OutData%u_TStC,1), UBOUND(OutData%u_TStC,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 StC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_TStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_TStC - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_SStC 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%u_SStC)) DEALLOCATE(OutData%u_SStC) - ALLOCATE(OutData%u_SStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_SStC,2), UBOUND(OutData%u_SStC,2) - DO i1 = LBOUND(OutData%u_SStC,1), UBOUND(OutData%u_SStC,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 StC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_SStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_SStC - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_BStC 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%y_BStC)) DEALLOCATE(OutData%y_BStC) - ALLOCATE(OutData%y_BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_BStC,1), UBOUND(OutData%y_BStC,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 StC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_BStC(i1), ErrStat2, ErrMsg2 ) ! y_BStC - 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 ! y_NStC 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%y_NStC)) DEALLOCATE(OutData%y_NStC) - ALLOCATE(OutData%y_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_NStC,1), UBOUND(OutData%y_NStC,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 StC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_NStC(i1), ErrStat2, ErrMsg2 ) ! y_NStC - 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 ! y_TStC 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%y_TStC)) DEALLOCATE(OutData%y_TStC) - ALLOCATE(OutData%y_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_TStC,1), UBOUND(OutData%y_TStC,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 StC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_TStC(i1), ErrStat2, ErrMsg2 ) ! y_TStC - 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 ! y_SStC 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%y_SStC)) DEALLOCATE(OutData%y_SStC) - ALLOCATE(OutData%y_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_SStC,1), UBOUND(OutData%y_SStC,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 StC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_SStC(i1), ErrStat2, ErrMsg2 ) ! y_SStC - 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 - 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 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 - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%PrevTstepNcall = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SrvD_UnPackMisc - - SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SrvD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%HSSBrDT = SrcParamData%HSSBrDT - DstParamData%HSSBrTqF = SrcParamData%HSSBrTqF - DstParamData%SIG_POSl = SrcParamData%SIG_POSl - DstParamData%SIG_POTq = SrcParamData%SIG_POTq - DstParamData%SIG_SlPc = SrcParamData%SIG_SlPc - DstParamData%SIG_Slop = SrcParamData%SIG_Slop - DstParamData%SIG_SySp = SrcParamData%SIG_SySp - DstParamData%TEC_A0 = SrcParamData%TEC_A0 - DstParamData%TEC_C0 = SrcParamData%TEC_C0 - DstParamData%TEC_C1 = SrcParamData%TEC_C1 - DstParamData%TEC_C2 = SrcParamData%TEC_C2 - DstParamData%TEC_K2 = SrcParamData%TEC_K2 - DstParamData%TEC_MR = SrcParamData%TEC_MR - DstParamData%TEC_Re1 = SrcParamData%TEC_Re1 - DstParamData%TEC_RLR = SrcParamData%TEC_RLR - DstParamData%TEC_RRes = SrcParamData%TEC_RRes - DstParamData%TEC_SRes = SrcParamData%TEC_SRes - DstParamData%TEC_SySp = SrcParamData%TEC_SySp - DstParamData%TEC_V1a = SrcParamData%TEC_V1a - DstParamData%TEC_VLL = SrcParamData%TEC_VLL - DstParamData%TEC_Xe1 = SrcParamData%TEC_Xe1 - DstParamData%GenEff = SrcParamData%GenEff -IF (ALLOCATED(SrcParamData%BlPitchInit)) THEN - i1_l = LBOUND(SrcParamData%BlPitchInit,1) - i1_u = UBOUND(SrcParamData%BlPitchInit,1) - IF (.NOT. ALLOCATED(DstParamData%BlPitchInit)) THEN - ALLOCATE(DstParamData%BlPitchInit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlPitchInit = SrcParamData%BlPitchInit -ENDIF -IF (ALLOCATED(SrcParamData%BlPitchF)) THEN - i1_l = LBOUND(SrcParamData%BlPitchF,1) - i1_u = UBOUND(SrcParamData%BlPitchF,1) - IF (.NOT. ALLOCATED(DstParamData%BlPitchF)) THEN - ALLOCATE(DstParamData%BlPitchF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlPitchF = SrcParamData%BlPitchF -ENDIF -IF (ALLOCATED(SrcParamData%PitManRat)) THEN - i1_l = LBOUND(SrcParamData%PitManRat,1) - i1_u = UBOUND(SrcParamData%PitManRat,1) - IF (.NOT. ALLOCATED(DstParamData%PitManRat)) THEN - ALLOCATE(DstParamData%PitManRat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitManRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PitManRat = SrcParamData%PitManRat -ENDIF - DstParamData%YawManRat = SrcParamData%YawManRat - DstParamData%NacYawF = SrcParamData%NacYawF - DstParamData%SpdGenOn = SrcParamData%SpdGenOn - DstParamData%THSSBrDp = SrcParamData%THSSBrDp - DstParamData%THSSBrFl = SrcParamData%THSSBrFl - DstParamData%TimGenOf = SrcParamData%TimGenOf - DstParamData%TimGenOn = SrcParamData%TimGenOn - DstParamData%TPCOn = SrcParamData%TPCOn -IF (ALLOCATED(SrcParamData%TPitManS)) THEN - i1_l = LBOUND(SrcParamData%TPitManS,1) - i1_u = UBOUND(SrcParamData%TPitManS,1) - IF (.NOT. ALLOCATED(DstParamData%TPitManS)) THEN - ALLOCATE(DstParamData%TPitManS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TPitManS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TPitManS = SrcParamData%TPitManS -ENDIF - DstParamData%TYawManS = SrcParamData%TYawManS - DstParamData%TYCOn = SrcParamData%TYCOn - DstParamData%VS_RtGnSp = SrcParamData%VS_RtGnSp - DstParamData%VS_RtTq = SrcParamData%VS_RtTq - DstParamData%VS_Slope = SrcParamData%VS_Slope - DstParamData%VS_SlPc = SrcParamData%VS_SlPc - DstParamData%VS_SySp = SrcParamData%VS_SySp - DstParamData%VS_TrGnSp = SrcParamData%VS_TrGnSp - DstParamData%YawPosCom = SrcParamData%YawPosCom - DstParamData%YawRateCom = SrcParamData%YawRateCom - DstParamData%GenModel = SrcParamData%GenModel - DstParamData%HSSBrMode = SrcParamData%HSSBrMode - DstParamData%PCMode = SrcParamData%PCMode - DstParamData%VSContrl = SrcParamData%VSContrl - DstParamData%YCMode = SrcParamData%YCMode - DstParamData%GenTiStp = SrcParamData%GenTiStp - DstParamData%GenTiStr = SrcParamData%GenTiStr - DstParamData%VS_Rgn2K = SrcParamData%VS_Rgn2K - DstParamData%YawNeut = SrcParamData%YawNeut - DstParamData%YawSpr = SrcParamData%YawSpr - DstParamData%YawDamp = SrcParamData%YawDamp - DstParamData%TpBrDT = SrcParamData%TpBrDT -IF (ALLOCATED(SrcParamData%TBDepISp)) THEN - i1_l = LBOUND(SrcParamData%TBDepISp,1) - i1_u = UBOUND(SrcParamData%TBDepISp,1) - IF (.NOT. ALLOCATED(DstParamData%TBDepISp)) THEN - ALLOCATE(DstParamData%TBDepISp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TBDepISp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TBDepISp = SrcParamData%TBDepISp -ENDIF - DstParamData%TBDrConN = SrcParamData%TBDrConN - DstParamData%TBDrConD = SrcParamData%TBDrConD - DstParamData%NumBl = SrcParamData%NumBl - DstParamData%NumBStC = SrcParamData%NumBStC - DstParamData%NumNStC = SrcParamData%NumNStC - DstParamData%NumTStC = SrcParamData%NumTStC - DstParamData%NumSStC = SrcParamData%NumSStC - DstParamData%AfCmode = SrcParamData%AfCmode - DstParamData%AfC_Mean = SrcParamData%AfC_Mean - DstParamData%AfC_Amp = SrcParamData%AfC_Amp - DstParamData%AfC_Phase = SrcParamData%AfC_Phase - DstParamData%CCmode = SrcParamData%CCmode - DstParamData%StCCmode = SrcParamData%StCCmode - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL - DstParamData%RootName = SrcParamData%RootName -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%Delim = SrcParamData%Delim - DstParamData%UseBladedInterface = SrcParamData%UseBladedInterface - DstParamData%UseLegacyInterface = SrcParamData%UseLegacyInterface - DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt - DstParamData%DLL_Ramp = SrcParamData%DLL_Ramp - DstParamData%BlAlpha = SrcParamData%BlAlpha - DstParamData%DLL_n = SrcParamData%DLL_n - DstParamData%avcOUTNAME_LEN = SrcParamData%avcOUTNAME_LEN - DstParamData%NacYaw_North = SrcParamData%NacYaw_North - DstParamData%AvgWindSpeed = SrcParamData%AvgWindSpeed - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%TrimCase = SrcParamData%TrimCase - DstParamData%TrimGain = SrcParamData%TrimGain - DstParamData%RotSpeedRef = SrcParamData%RotSpeedRef -IF (ALLOCATED(SrcParamData%BStC)) THEN - i1_l = LBOUND(SrcParamData%BStC,1) - i1_u = UBOUND(SrcParamData%BStC,1) - IF (.NOT. ALLOCATED(DstParamData%BStC)) THEN - ALLOCATE(DstParamData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%BStC,1), UBOUND(SrcParamData%BStC,1) - CALL StC_CopyParam( SrcParamData%BStC(i1), DstParamData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%NStC)) THEN - i1_l = LBOUND(SrcParamData%NStC,1) - i1_u = UBOUND(SrcParamData%NStC,1) - IF (.NOT. ALLOCATED(DstParamData%NStC)) THEN - ALLOCATE(DstParamData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%NStC,1), UBOUND(SrcParamData%NStC,1) - CALL StC_CopyParam( SrcParamData%NStC(i1), DstParamData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%TStC)) THEN - i1_l = LBOUND(SrcParamData%TStC,1) - i1_u = UBOUND(SrcParamData%TStC,1) - IF (.NOT. ALLOCATED(DstParamData%TStC)) THEN - ALLOCATE(DstParamData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%TStC,1), UBOUND(SrcParamData%TStC,1) - CALL StC_CopyParam( SrcParamData%TStC(i1), DstParamData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%SStC)) THEN - i1_l = LBOUND(SrcParamData%SStC,1) - i1_u = UBOUND(SrcParamData%SStC,1) - IF (.NOT. ALLOCATED(DstParamData%SStC)) THEN - ALLOCATE(DstParamData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%SStC,1), UBOUND(SrcParamData%SStC,1) - CALL StC_CopyParam( SrcParamData%SStC(i1), DstParamData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%InterpOrder = SrcParamData%InterpOrder - DstParamData%EXavrSWAP = SrcParamData%EXavrSWAP - DstParamData%NumCableControl = SrcParamData%NumCableControl - DstParamData%NumStC_Control = SrcParamData%NumStC_Control -IF (ALLOCATED(SrcParamData%StCMeasNumPerChan)) THEN - i1_l = LBOUND(SrcParamData%StCMeasNumPerChan,1) - i1_u = UBOUND(SrcParamData%StCMeasNumPerChan,1) - IF (.NOT. ALLOCATED(DstParamData%StCMeasNumPerChan)) THEN - ALLOCATE(DstParamData%StCMeasNumPerChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StCMeasNumPerChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StCMeasNumPerChan = SrcParamData%StCMeasNumPerChan -ENDIF - DstParamData%UseSC = SrcParamData%UseSC -IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_u_indx,1) - i1_u = UBOUND(SrcParamData%Jac_u_indx,1) - i2_l = LBOUND(SrcParamData%Jac_u_indx,2) - i2_u = UBOUND(SrcParamData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN - ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcParamData%Jac_x_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_x_indx,1) - i1_u = UBOUND(SrcParamData%Jac_x_indx,1) - i2_l = LBOUND(SrcParamData%Jac_x_indx,2) - i2_u = UBOUND(SrcParamData%Jac_x_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_x_indx)) THEN - ALLOCATE(DstParamData%Jac_x_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_x_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_x_indx = SrcParamData%Jac_x_indx -ENDIF -IF (ALLOCATED(SrcParamData%du)) THEN - i1_l = LBOUND(SrcParamData%du,1) - i1_u = UBOUND(SrcParamData%du,1) - IF (.NOT. ALLOCATED(DstParamData%du)) THEN - ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%du = SrcParamData%du -ENDIF -IF (ALLOCATED(SrcParamData%dx)) THEN - i1_l = LBOUND(SrcParamData%dx,1) - i1_u = UBOUND(SrcParamData%dx,1) - IF (.NOT. ALLOCATED(DstParamData%dx)) THEN - ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dx = SrcParamData%dx -ENDIF - DstParamData%Jac_nu = SrcParamData%Jac_nu - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx -IF (ALLOCATED(SrcParamData%Jac_Idx_BStC_u)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_BStC_u,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_BStC_u,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_BStC_u,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_BStC_u,2) - i3_l = LBOUND(SrcParamData%Jac_Idx_BStC_u,3) - i3_u = UBOUND(SrcParamData%Jac_Idx_BStC_u,3) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_BStC_u)) THEN - ALLOCATE(DstParamData%Jac_Idx_BStC_u(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%Jac_Idx_BStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_BStC_u = SrcParamData%Jac_Idx_BStC_u -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_NStC_u)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_NStC_u,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_NStC_u,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_NStC_u,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_NStC_u,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_NStC_u)) THEN - ALLOCATE(DstParamData%Jac_Idx_NStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_NStC_u = SrcParamData%Jac_Idx_NStC_u -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_TStC_u)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_TStC_u,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_TStC_u,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_TStC_u,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_TStC_u,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_TStC_u)) THEN - ALLOCATE(DstParamData%Jac_Idx_TStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_TStC_u = SrcParamData%Jac_Idx_TStC_u -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_SStC_u)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_SStC_u,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_SStC_u,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_SStC_u,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_SStC_u,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_SStC_u)) THEN - ALLOCATE(DstParamData%Jac_Idx_SStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_SStC_u = SrcParamData%Jac_Idx_SStC_u -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_BStC_x)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_BStC_x,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_BStC_x,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_BStC_x,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_BStC_x,2) - i3_l = LBOUND(SrcParamData%Jac_Idx_BStC_x,3) - i3_u = UBOUND(SrcParamData%Jac_Idx_BStC_x,3) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_BStC_x)) THEN - ALLOCATE(DstParamData%Jac_Idx_BStC_x(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%Jac_Idx_BStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_BStC_x = SrcParamData%Jac_Idx_BStC_x -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_NStC_x)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_NStC_x,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_NStC_x,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_NStC_x,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_NStC_x,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_NStC_x)) THEN - ALLOCATE(DstParamData%Jac_Idx_NStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_NStC_x = SrcParamData%Jac_Idx_NStC_x -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_TStC_x)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_TStC_x,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_TStC_x,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_TStC_x,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_TStC_x,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_TStC_x)) THEN - ALLOCATE(DstParamData%Jac_Idx_TStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_TStC_x = SrcParamData%Jac_Idx_TStC_x -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_SStC_x)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_SStC_x,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_SStC_x,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_SStC_x,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_SStC_x,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_SStC_x)) THEN - ALLOCATE(DstParamData%Jac_Idx_SStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_SStC_x = SrcParamData%Jac_Idx_SStC_x -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_BStC_y)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_BStC_y,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_BStC_y,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_BStC_y,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_BStC_y,2) - i3_l = LBOUND(SrcParamData%Jac_Idx_BStC_y,3) - i3_u = UBOUND(SrcParamData%Jac_Idx_BStC_y,3) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_BStC_y)) THEN - ALLOCATE(DstParamData%Jac_Idx_BStC_y(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%Jac_Idx_BStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_BStC_y = SrcParamData%Jac_Idx_BStC_y -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_NStC_y)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_NStC_y,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_NStC_y,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_NStC_y,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_NStC_y,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_NStC_y)) THEN - ALLOCATE(DstParamData%Jac_Idx_NStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_NStC_y = SrcParamData%Jac_Idx_NStC_y -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_TStC_y)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_TStC_y,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_TStC_y,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_TStC_y,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_TStC_y,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_TStC_y)) THEN - ALLOCATE(DstParamData%Jac_Idx_TStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_TStC_y = SrcParamData%Jac_Idx_TStC_y -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_SStC_y)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_SStC_y,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_SStC_y,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_SStC_y,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_SStC_y,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_SStC_y)) THEN - ALLOCATE(DstParamData%Jac_Idx_SStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_SStC_y = SrcParamData%Jac_Idx_SStC_y -ENDIF - DstParamData%SensorType = SrcParamData%SensorType - DstParamData%NumBeam = SrcParamData%NumBeam - DstParamData%NumPulseGate = SrcParamData%NumPulseGate - DstParamData%PulseSpacing = SrcParamData%PulseSpacing - DstParamData%URefLid = SrcParamData%URefLid - END SUBROUTINE SrvD_CopyParam - - SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SrvD_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 = 'SrvD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%BlPitchInit)) THEN - DEALLOCATE(ParamData%BlPitchInit) -ENDIF -IF (ALLOCATED(ParamData%BlPitchF)) THEN - DEALLOCATE(ParamData%BlPitchF) -ENDIF -IF (ALLOCATED(ParamData%PitManRat)) THEN - DEALLOCATE(ParamData%PitManRat) -ENDIF -IF (ALLOCATED(ParamData%TPitManS)) THEN - DEALLOCATE(ParamData%TPitManS) -ENDIF -IF (ALLOCATED(ParamData%TBDepISp)) THEN - DEALLOCATE(ParamData%TBDepISp) -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 - CALL FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2 ) - 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 ) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%SStC) -ENDIF -IF (ALLOCATED(ParamData%StCMeasNumPerChan)) THEN - DEALLOCATE(ParamData%StCMeasNumPerChan) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%Jac_x_indx)) THEN - DEALLOCATE(ParamData%Jac_x_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF -IF (ALLOCATED(ParamData%dx)) THEN - DEALLOCATE(ParamData%dx) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_BStC_u)) THEN - DEALLOCATE(ParamData%Jac_Idx_BStC_u) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_NStC_u)) THEN - DEALLOCATE(ParamData%Jac_Idx_NStC_u) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_TStC_u)) THEN - DEALLOCATE(ParamData%Jac_Idx_TStC_u) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_SStC_u)) THEN - DEALLOCATE(ParamData%Jac_Idx_SStC_u) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_BStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_BStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_NStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_NStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_TStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_TStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_SStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_SStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_BStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_BStC_y) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_NStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_NStC_y) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_TStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_TStC_y) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_SStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_SStC_y) -ENDIF - END SUBROUTINE SrvD_DestroyParam - - SUBROUTINE SrvD_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(SrvD_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 = 'SrvD_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 ! HSSBrDT - Re_BufSz = Re_BufSz + 1 ! HSSBrTqF - Re_BufSz = Re_BufSz + 1 ! SIG_POSl - Re_BufSz = Re_BufSz + 1 ! SIG_POTq - Re_BufSz = Re_BufSz + 1 ! SIG_SlPc - Re_BufSz = Re_BufSz + 1 ! SIG_Slop - Re_BufSz = Re_BufSz + 1 ! SIG_SySp - Re_BufSz = Re_BufSz + 1 ! TEC_A0 - Re_BufSz = Re_BufSz + 1 ! TEC_C0 - Re_BufSz = Re_BufSz + 1 ! TEC_C1 - Re_BufSz = Re_BufSz + 1 ! TEC_C2 - Re_BufSz = Re_BufSz + 1 ! TEC_K2 - Re_BufSz = Re_BufSz + 1 ! TEC_MR - Re_BufSz = Re_BufSz + 1 ! TEC_Re1 - Re_BufSz = Re_BufSz + 1 ! TEC_RLR - Re_BufSz = Re_BufSz + 1 ! TEC_RRes - Re_BufSz = Re_BufSz + 1 ! TEC_SRes - Re_BufSz = Re_BufSz + 1 ! TEC_SySp - Re_BufSz = Re_BufSz + 1 ! TEC_V1a - Re_BufSz = Re_BufSz + 1 ! TEC_VLL - Re_BufSz = Re_BufSz + 1 ! TEC_Xe1 - Re_BufSz = Re_BufSz + 1 ! GenEff - Int_BufSz = Int_BufSz + 1 ! BlPitchInit allocated yes/no - IF ( ALLOCATED(InData%BlPitchInit) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchInit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchInit) ! BlPitchInit - END IF - Int_BufSz = Int_BufSz + 1 ! BlPitchF allocated yes/no - IF ( ALLOCATED(InData%BlPitchF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchF) ! BlPitchF - END IF - Int_BufSz = Int_BufSz + 1 ! PitManRat allocated yes/no - IF ( ALLOCATED(InData%PitManRat) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PitManRat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PitManRat) ! PitManRat - END IF - Re_BufSz = Re_BufSz + 1 ! YawManRat - Re_BufSz = Re_BufSz + 1 ! NacYawF - Re_BufSz = Re_BufSz + 1 ! SpdGenOn - Db_BufSz = Db_BufSz + 1 ! THSSBrDp - Db_BufSz = Db_BufSz + 1 ! THSSBrFl - Db_BufSz = Db_BufSz + 1 ! TimGenOf - Db_BufSz = Db_BufSz + 1 ! TimGenOn - Db_BufSz = Db_BufSz + 1 ! TPCOn - Int_BufSz = Int_BufSz + 1 ! TPitManS allocated yes/no - IF ( ALLOCATED(InData%TPitManS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TPitManS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TPitManS) ! TPitManS - END IF - Db_BufSz = Db_BufSz + 1 ! TYawManS - Db_BufSz = Db_BufSz + 1 ! TYCOn - Re_BufSz = Re_BufSz + 1 ! VS_RtGnSp - Re_BufSz = Re_BufSz + 1 ! VS_RtTq - Re_BufSz = Re_BufSz + 1 ! VS_Slope - Re_BufSz = Re_BufSz + 1 ! VS_SlPc - Re_BufSz = Re_BufSz + 1 ! VS_SySp - Re_BufSz = Re_BufSz + 1 ! VS_TrGnSp - Re_BufSz = Re_BufSz + 1 ! YawPosCom - Re_BufSz = Re_BufSz + 1 ! YawRateCom - Int_BufSz = Int_BufSz + 1 ! GenModel - Int_BufSz = Int_BufSz + 1 ! HSSBrMode - Int_BufSz = Int_BufSz + 1 ! PCMode - Int_BufSz = Int_BufSz + 1 ! VSContrl - Int_BufSz = Int_BufSz + 1 ! YCMode - Int_BufSz = Int_BufSz + 1 ! GenTiStp - Int_BufSz = Int_BufSz + 1 ! GenTiStr - Re_BufSz = Re_BufSz + 1 ! VS_Rgn2K - Re_BufSz = Re_BufSz + 1 ! YawNeut - Re_BufSz = Re_BufSz + 1 ! YawSpr - Re_BufSz = Re_BufSz + 1 ! YawDamp - Db_BufSz = Db_BufSz + 1 ! TpBrDT - Int_BufSz = Int_BufSz + 1 ! TBDepISp allocated yes/no - IF ( ALLOCATED(InData%TBDepISp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TBDepISp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TBDepISp) ! TBDepISp - END IF - Re_BufSz = Re_BufSz + 1 ! TBDrConN - Re_BufSz = Re_BufSz + 1 ! TBDrConD - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1 ! NumBStC - Int_BufSz = Int_BufSz + 1 ! NumNStC - Int_BufSz = Int_BufSz + 1 ! NumTStC - Int_BufSz = Int_BufSz + 1 ! NumSStC - Int_BufSz = Int_BufSz + 1 ! AfCmode - Re_BufSz = Re_BufSz + 1 ! AfC_Mean - Re_BufSz = Re_BufSz + 1 ! AfC_Amp - Re_BufSz = Re_BufSz + 1 ! AfC_Phase - Int_BufSz = Int_BufSz + 1 ! CCmode - Int_BufSz = Int_BufSz + 1 ! StCCmode - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NumOuts_DLL - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - 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*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! UseBladedInterface - Int_BufSz = Int_BufSz + 1 ! UseLegacyInterface - Int_BufSz = Int_BufSz + 3 ! DLL_Trgt: size of buffers for each call to pack subtype - CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DLL_Trgt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DLL_Trgt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DLL_Trgt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DLL_Trgt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! DLL_Ramp - Re_BufSz = Re_BufSz + 1 ! BlAlpha - Int_BufSz = Int_BufSz + 1 ! DLL_n - Int_BufSz = Int_BufSz + 1 ! avcOUTNAME_LEN - Re_BufSz = Re_BufSz + 1 ! NacYaw_North - Re_BufSz = Re_BufSz + 1 ! AvgWindSpeed - Re_BufSz = Re_BufSz + 1 ! AirDens - Int_BufSz = Int_BufSz + 1 ! TrimCase - Re_BufSz = Re_BufSz + 1 ! TrimGain - Re_BufSz = Re_BufSz + 1 ! RotSpeedRef - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InterpOrder - Int_BufSz = Int_BufSz + 1 ! EXavrSWAP - Int_BufSz = Int_BufSz + 1 ! NumCableControl - Int_BufSz = Int_BufSz + 1 ! NumStC_Control - Int_BufSz = Int_BufSz + 1 ! StCMeasNumPerChan allocated yes/no - IF ( ALLOCATED(InData%StCMeasNumPerChan) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StCMeasNumPerChan upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%StCMeasNumPerChan) ! StCMeasNumPerChan - END IF - Int_BufSz = Int_BufSz + 1 ! UseSC - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_x_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_x_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_x_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_x_indx) ! Jac_x_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%du) ! du - END IF - Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no - IF ( ALLOCATED(InData%dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dx) ! dx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_nu - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! Jac_nx - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_BStC_u allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_BStC_u) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Jac_Idx_BStC_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_BStC_u) ! Jac_Idx_BStC_u - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_NStC_u allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_NStC_u) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_NStC_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_NStC_u) ! Jac_Idx_NStC_u - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_TStC_u allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_TStC_u) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_TStC_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_TStC_u) ! Jac_Idx_TStC_u - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_SStC_u allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_SStC_u) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_SStC_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_SStC_u) ! Jac_Idx_SStC_u - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_BStC_x allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_BStC_x) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Jac_Idx_BStC_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_BStC_x) ! Jac_Idx_BStC_x - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_NStC_x allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_NStC_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_NStC_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_NStC_x) ! Jac_Idx_NStC_x - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_TStC_x allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_TStC_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_TStC_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_TStC_x) ! Jac_Idx_TStC_x - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_SStC_x allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_SStC_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_SStC_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_SStC_x) ! Jac_Idx_SStC_x - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_BStC_y allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_BStC_y) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Jac_Idx_BStC_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_BStC_y) ! Jac_Idx_BStC_y - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_NStC_y allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_NStC_y) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_NStC_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_NStC_y) ! Jac_Idx_NStC_y - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_TStC_y allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_TStC_y) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_TStC_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_TStC_y) ! Jac_Idx_TStC_y - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_SStC_y allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_SStC_y) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_SStC_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_SStC_y) ! Jac_Idx_SStC_y - END IF - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! NumBeam - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Re_BufSz = Re_BufSz + 1 ! PulseSpacing - Re_BufSz = Re_BufSz + 1 ! URefLid - 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%HSSBrDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrTqF - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_POSl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_POTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_Slop - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_A0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_C0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_C1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_C2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_K2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_MR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_Re1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_RLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_RRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_SRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_V1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_VLL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_Xe1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenEff - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlPitchInit) ) 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%BlPitchInit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInit,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchInit,1), UBOUND(InData%BlPitchInit,1) - ReKiBuf(Re_Xferred) = InData%BlPitchInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlPitchF) ) 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%BlPitchF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchF,1), UBOUND(InData%BlPitchF,1) - ReKiBuf(Re_Xferred) = InData%BlPitchF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PitManRat) ) 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%PitManRat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitManRat,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PitManRat,1), UBOUND(InData%PitManRat,1) - ReKiBuf(Re_Xferred) = InData%PitManRat(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%YawManRat - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYawF - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdGenOn - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%THSSBrDp - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%THSSBrFl - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimGenOf - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimGenOn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TPCOn - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TPitManS) ) 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%TPitManS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TPitManS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TPitManS,1), UBOUND(InData%TPitManS,1) - DbKiBuf(Db_Xferred) = InData%TPitManS(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%TYawManS - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TYCOn - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_RtGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_Slope - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_TrGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%GenModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%HSSBrMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PCMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VSContrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%YCMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStr, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_Rgn2K - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawNeut - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawDamp - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TpBrDT - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TBDepISp) ) 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%TBDepISp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TBDepISp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TBDepISp,1), UBOUND(InData%TBDepISp,1) - ReKiBuf(Re_Xferred) = InData%TBDepISp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TBDrConN - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TBDrConD - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBStC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumNStC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTStC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSStC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AfCmode - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Mean - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Amp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Phase - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CCmode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%StCCmode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts_DLL - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - 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) = TRANSFER(InData%UseBladedInterface, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseLegacyInterface, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Trgt - 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) = TRANSFER(InData%DLL_Ramp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BlAlpha - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DLL_n - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%avcOUTNAME_LEN - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYaw_North - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AvgWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TrimCase - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TrimGain - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeedRef - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) 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%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - 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 - IF ( .NOT. ALLOCATED(InData%NStC) ) 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%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - 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 - IF ( .NOT. ALLOCATED(InData%TStC) ) 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%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - 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 - IF ( .NOT. ALLOCATED(InData%SStC) ) 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%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - 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%InterpOrder - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EXavrSWAP, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCableControl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumStC_Control - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%StCMeasNumPerChan) ) 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%StCMeasNumPerChan,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCMeasNumPerChan,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StCMeasNumPerChan,1), UBOUND(InData%StCMeasNumPerChan,1) - IntKiBuf(Int_Xferred) = InData%StCMeasNumPerChan(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseSC, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) 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%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_x_indx) ) 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%Jac_x_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_x_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_x_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_x_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_x_indx,2), UBOUND(InData%Jac_x_indx,2) - DO i1 = LBOUND(InData%Jac_x_indx,1), UBOUND(InData%Jac_x_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_x_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%du) ) 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%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - DbKiBuf(Db_Xferred) = InData%du(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dx) ) 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%dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - ReKiBuf(Re_Xferred) = InData%dx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Jac_nu - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_nx - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Jac_Idx_BStC_u) ) 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%Jac_Idx_BStC_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_u,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_u,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_u,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_u,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_u,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Jac_Idx_BStC_u,3), UBOUND(InData%Jac_Idx_BStC_u,3) - DO i2 = LBOUND(InData%Jac_Idx_BStC_u,2), UBOUND(InData%Jac_Idx_BStC_u,2) - DO i1 = LBOUND(InData%Jac_Idx_BStC_u,1), UBOUND(InData%Jac_Idx_BStC_u,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_BStC_u(i1,i2,i3) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_NStC_u) ) 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%Jac_Idx_NStC_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_u,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_NStC_u,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_u,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_NStC_u,2), UBOUND(InData%Jac_Idx_NStC_u,2) - DO i1 = LBOUND(InData%Jac_Idx_NStC_u,1), UBOUND(InData%Jac_Idx_NStC_u,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_NStC_u(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_TStC_u) ) 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%Jac_Idx_TStC_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_u,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_TStC_u,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_u,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_TStC_u,2), UBOUND(InData%Jac_Idx_TStC_u,2) - DO i1 = LBOUND(InData%Jac_Idx_TStC_u,1), UBOUND(InData%Jac_Idx_TStC_u,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_TStC_u(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_SStC_u) ) 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%Jac_Idx_SStC_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_u,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_SStC_u,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_u,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_SStC_u,2), UBOUND(InData%Jac_Idx_SStC_u,2) - DO i1 = LBOUND(InData%Jac_Idx_SStC_u,1), UBOUND(InData%Jac_Idx_SStC_u,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_SStC_u(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_BStC_x) ) 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%Jac_Idx_BStC_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_x,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_x,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_x,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Jac_Idx_BStC_x,3), UBOUND(InData%Jac_Idx_BStC_x,3) - DO i2 = LBOUND(InData%Jac_Idx_BStC_x,2), UBOUND(InData%Jac_Idx_BStC_x,2) - DO i1 = LBOUND(InData%Jac_Idx_BStC_x,1), UBOUND(InData%Jac_Idx_BStC_x,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_BStC_x(i1,i2,i3) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_NStC_x) ) 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%Jac_Idx_NStC_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_NStC_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_NStC_x,2), UBOUND(InData%Jac_Idx_NStC_x,2) - DO i1 = LBOUND(InData%Jac_Idx_NStC_x,1), UBOUND(InData%Jac_Idx_NStC_x,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_NStC_x(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_TStC_x) ) 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%Jac_Idx_TStC_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_TStC_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_TStC_x,2), UBOUND(InData%Jac_Idx_TStC_x,2) - DO i1 = LBOUND(InData%Jac_Idx_TStC_x,1), UBOUND(InData%Jac_Idx_TStC_x,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_TStC_x(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_SStC_x) ) 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%Jac_Idx_SStC_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_SStC_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_SStC_x,2), UBOUND(InData%Jac_Idx_SStC_x,2) - DO i1 = LBOUND(InData%Jac_Idx_SStC_x,1), UBOUND(InData%Jac_Idx_SStC_x,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_SStC_x(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_BStC_y) ) 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%Jac_Idx_BStC_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_y,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_y,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_y,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_y,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_y,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Jac_Idx_BStC_y,3), UBOUND(InData%Jac_Idx_BStC_y,3) - DO i2 = LBOUND(InData%Jac_Idx_BStC_y,2), UBOUND(InData%Jac_Idx_BStC_y,2) - DO i1 = LBOUND(InData%Jac_Idx_BStC_y,1), UBOUND(InData%Jac_Idx_BStC_y,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_BStC_y(i1,i2,i3) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_NStC_y) ) 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%Jac_Idx_NStC_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_y,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_NStC_y,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_y,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_NStC_y,2), UBOUND(InData%Jac_Idx_NStC_y,2) - DO i1 = LBOUND(InData%Jac_Idx_NStC_y,1), UBOUND(InData%Jac_Idx_NStC_y,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_NStC_y(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_TStC_y) ) 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%Jac_Idx_TStC_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_y,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_TStC_y,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_y,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_TStC_y,2), UBOUND(InData%Jac_Idx_TStC_y,2) - DO i1 = LBOUND(InData%Jac_Idx_TStC_y,1), UBOUND(InData%Jac_Idx_TStC_y,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_TStC_y(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_SStC_y) ) 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%Jac_Idx_SStC_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_y,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_SStC_y,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_y,2) - Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%Jac_Idx_SStC_y,2), UBOUND(InData%Jac_Idx_SStC_y,2) - DO i1 = LBOUND(InData%Jac_Idx_SStC_y,1), UBOUND(InData%Jac_Idx_SStC_y,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_SStC_y(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBeam - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PulseSpacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%URefLid - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SrvD_PackParam - - SUBROUTINE SrvD_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(SrvD_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_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%HSSBrDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrTqF = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_POSl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_POTq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SlPc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_Slop = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SySp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_A0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_K2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_MR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Re1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RLR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RRes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SRes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SySp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_V1a = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_VLL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Xe1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenEff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInit 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%BlPitchInit)) DEALLOCATE(OutData%BlPitchInit) - ALLOCATE(OutData%BlPitchInit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchInit,1), UBOUND(OutData%BlPitchInit,1) - OutData%BlPitchInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchF 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%BlPitchF)) DEALLOCATE(OutData%BlPitchF) - ALLOCATE(OutData%BlPitchF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchF,1), UBOUND(OutData%BlPitchF,1) - OutData%BlPitchF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitManRat 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%PitManRat)) DEALLOCATE(OutData%PitManRat) - ALLOCATE(OutData%PitManRat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitManRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PitManRat,1), UBOUND(OutData%PitManRat,1) - OutData%PitManRat(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%YawManRat = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYawF = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdGenOn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%THSSBrDp = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%THSSBrFl = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOf = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TPCOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TPitManS 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%TPitManS)) DEALLOCATE(OutData%TPitManS) - ALLOCATE(OutData%TPitManS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TPitManS,1), UBOUND(OutData%TPitManS,1) - OutData%TPitManS(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%TYawManS = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TYCOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%VS_RtGnSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_RtTq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_Slope = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SlPc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SySp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_TrGnSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawPosCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HSSBrMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PCMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VSContrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%YCMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStp = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStp) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStr = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStr) - Int_Xferred = Int_Xferred + 1 - OutData%VS_Rgn2K = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawNeut = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawDamp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TpBrDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TBDepISp 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%TBDepISp)) DEALLOCATE(OutData%TBDepISp) - ALLOCATE(OutData%TBDepISp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDepISp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TBDepISp,1), UBOUND(OutData%TBDepISp,1) - OutData%TBDepISp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%TBDrConN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TBDrConD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumNStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumTStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumSStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AfCmode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AfC_Mean = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AfC_Amp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AfC_Phase = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CCmode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StCCmode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts_DLL = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UseBladedInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseBladedInterface) - Int_Xferred = Int_Xferred + 1 - OutData%UseLegacyInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseLegacyInterface) - 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 DLLTypeUnpack( OutData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! DLL_Trgt - 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%DLL_Ramp = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_Ramp) - Int_Xferred = Int_Xferred + 1 - OutData%BlAlpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DLL_n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%avcOUTNAME_LEN = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NacYaw_North = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AvgWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TrimCase = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TrimGain = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeedRef = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC 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%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,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 StC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - 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 ! NStC 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%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,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 StC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - 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 ! TStC 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%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,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 StC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - 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 ! SStC 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%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,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 StC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - 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%InterpOrder = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%EXavrSWAP = TRANSFER(IntKiBuf(Int_Xferred), OutData%EXavrSWAP) - Int_Xferred = Int_Xferred + 1 - OutData%NumCableControl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumStC_Control = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCMeasNumPerChan 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%StCMeasNumPerChan)) DEALLOCATE(OutData%StCMeasNumPerChan) - ALLOCATE(OutData%StCMeasNumPerChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasNumPerChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StCMeasNumPerChan,1), UBOUND(OutData%StCMeasNumPerChan,1) - OutData%StCMeasNumPerChan(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%UseSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseSC) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx 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%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_x_indx 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%Jac_x_indx)) DEALLOCATE(OutData%Jac_x_indx) - ALLOCATE(OutData%Jac_x_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_x_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_x_indx,2), UBOUND(OutData%Jac_x_indx,2) - DO i1 = LBOUND(OutData%Jac_x_indx,1), UBOUND(OutData%Jac_x_indx,1) - OutData%Jac_x_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du 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%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx 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%dx)) DEALLOCATE(OutData%dx) - ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Jac_nu = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_BStC_u 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%Jac_Idx_BStC_u)) DEALLOCATE(OutData%Jac_Idx_BStC_u) - ALLOCATE(OutData%Jac_Idx_BStC_u(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%Jac_Idx_BStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Jac_Idx_BStC_u,3), UBOUND(OutData%Jac_Idx_BStC_u,3) - DO i2 = LBOUND(OutData%Jac_Idx_BStC_u,2), UBOUND(OutData%Jac_Idx_BStC_u,2) - DO i1 = LBOUND(OutData%Jac_Idx_BStC_u,1), UBOUND(OutData%Jac_Idx_BStC_u,1) - OutData%Jac_Idx_BStC_u(i1,i2,i3) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_NStC_u 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%Jac_Idx_NStC_u)) DEALLOCATE(OutData%Jac_Idx_NStC_u) - ALLOCATE(OutData%Jac_Idx_NStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_NStC_u,2), UBOUND(OutData%Jac_Idx_NStC_u,2) - DO i1 = LBOUND(OutData%Jac_Idx_NStC_u,1), UBOUND(OutData%Jac_Idx_NStC_u,1) - OutData%Jac_Idx_NStC_u(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_TStC_u 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%Jac_Idx_TStC_u)) DEALLOCATE(OutData%Jac_Idx_TStC_u) - ALLOCATE(OutData%Jac_Idx_TStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_TStC_u,2), UBOUND(OutData%Jac_Idx_TStC_u,2) - DO i1 = LBOUND(OutData%Jac_Idx_TStC_u,1), UBOUND(OutData%Jac_Idx_TStC_u,1) - OutData%Jac_Idx_TStC_u(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_SStC_u 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%Jac_Idx_SStC_u)) DEALLOCATE(OutData%Jac_Idx_SStC_u) - ALLOCATE(OutData%Jac_Idx_SStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_SStC_u,2), UBOUND(OutData%Jac_Idx_SStC_u,2) - DO i1 = LBOUND(OutData%Jac_Idx_SStC_u,1), UBOUND(OutData%Jac_Idx_SStC_u,1) - OutData%Jac_Idx_SStC_u(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_BStC_x 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%Jac_Idx_BStC_x)) DEALLOCATE(OutData%Jac_Idx_BStC_x) - ALLOCATE(OutData%Jac_Idx_BStC_x(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%Jac_Idx_BStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Jac_Idx_BStC_x,3), UBOUND(OutData%Jac_Idx_BStC_x,3) - DO i2 = LBOUND(OutData%Jac_Idx_BStC_x,2), UBOUND(OutData%Jac_Idx_BStC_x,2) - DO i1 = LBOUND(OutData%Jac_Idx_BStC_x,1), UBOUND(OutData%Jac_Idx_BStC_x,1) - OutData%Jac_Idx_BStC_x(i1,i2,i3) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_NStC_x 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%Jac_Idx_NStC_x)) DEALLOCATE(OutData%Jac_Idx_NStC_x) - ALLOCATE(OutData%Jac_Idx_NStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_NStC_x,2), UBOUND(OutData%Jac_Idx_NStC_x,2) - DO i1 = LBOUND(OutData%Jac_Idx_NStC_x,1), UBOUND(OutData%Jac_Idx_NStC_x,1) - OutData%Jac_Idx_NStC_x(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_TStC_x 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%Jac_Idx_TStC_x)) DEALLOCATE(OutData%Jac_Idx_TStC_x) - ALLOCATE(OutData%Jac_Idx_TStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_TStC_x,2), UBOUND(OutData%Jac_Idx_TStC_x,2) - DO i1 = LBOUND(OutData%Jac_Idx_TStC_x,1), UBOUND(OutData%Jac_Idx_TStC_x,1) - OutData%Jac_Idx_TStC_x(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_SStC_x 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%Jac_Idx_SStC_x)) DEALLOCATE(OutData%Jac_Idx_SStC_x) - ALLOCATE(OutData%Jac_Idx_SStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_SStC_x,2), UBOUND(OutData%Jac_Idx_SStC_x,2) - DO i1 = LBOUND(OutData%Jac_Idx_SStC_x,1), UBOUND(OutData%Jac_Idx_SStC_x,1) - OutData%Jac_Idx_SStC_x(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_BStC_y 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%Jac_Idx_BStC_y)) DEALLOCATE(OutData%Jac_Idx_BStC_y) - ALLOCATE(OutData%Jac_Idx_BStC_y(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%Jac_Idx_BStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Jac_Idx_BStC_y,3), UBOUND(OutData%Jac_Idx_BStC_y,3) - DO i2 = LBOUND(OutData%Jac_Idx_BStC_y,2), UBOUND(OutData%Jac_Idx_BStC_y,2) - DO i1 = LBOUND(OutData%Jac_Idx_BStC_y,1), UBOUND(OutData%Jac_Idx_BStC_y,1) - OutData%Jac_Idx_BStC_y(i1,i2,i3) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_NStC_y 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%Jac_Idx_NStC_y)) DEALLOCATE(OutData%Jac_Idx_NStC_y) - ALLOCATE(OutData%Jac_Idx_NStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_NStC_y,2), UBOUND(OutData%Jac_Idx_NStC_y,2) - DO i1 = LBOUND(OutData%Jac_Idx_NStC_y,1), UBOUND(OutData%Jac_Idx_NStC_y,1) - OutData%Jac_Idx_NStC_y(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_TStC_y 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%Jac_Idx_TStC_y)) DEALLOCATE(OutData%Jac_Idx_TStC_y) - ALLOCATE(OutData%Jac_Idx_TStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_TStC_y,2), UBOUND(OutData%Jac_Idx_TStC_y,2) - DO i1 = LBOUND(OutData%Jac_Idx_TStC_y,1), UBOUND(OutData%Jac_Idx_TStC_y,1) - OutData%Jac_Idx_TStC_y(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_SStC_y 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%Jac_Idx_SStC_y)) DEALLOCATE(OutData%Jac_Idx_SStC_y) - ALLOCATE(OutData%Jac_Idx_SStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_SStC_y,2), UBOUND(OutData%Jac_Idx_SStC_y,2) - DO i1 = LBOUND(OutData%Jac_Idx_SStC_y,1), UBOUND(OutData%Jac_Idx_SStC_y,1) - OutData%Jac_Idx_SStC_y(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBeam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PulseSpacing = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%URefLid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SrvD_UnPackParam - - SUBROUTINE SrvD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(SrvD_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) :: 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 = 'SrvD_CopyInput' -! +subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_InitInputType), intent(in) :: SrcInitInputData + type(SrvD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%BlPitch)) THEN - i1_l = LBOUND(SrcInputData%BlPitch,1) - i1_u = UBOUND(SrcInputData%BlPitch,1) - IF (.NOT. ALLOCATED(DstInputData%BlPitch)) THEN - ALLOCATE(DstInputData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%BlPitch = SrcInputData%BlPitch -ENDIF - DstInputData%Yaw = SrcInputData%Yaw - DstInputData%YawRate = SrcInputData%YawRate - DstInputData%LSS_Spd = SrcInputData%LSS_Spd - DstInputData%HSS_Spd = SrcInputData%HSS_Spd - DstInputData%RotSpeed = SrcInputData%RotSpeed - DstInputData%ExternalYawPosCom = SrcInputData%ExternalYawPosCom - DstInputData%ExternalYawRateCom = SrcInputData%ExternalYawRateCom -IF (ALLOCATED(SrcInputData%ExternalBlPitchCom)) THEN - i1_l = LBOUND(SrcInputData%ExternalBlPitchCom,1) - i1_u = UBOUND(SrcInputData%ExternalBlPitchCom,1) - IF (.NOT. ALLOCATED(DstInputData%ExternalBlPitchCom)) THEN - ALLOCATE(DstInputData%ExternalBlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%ExternalBlPitchCom = SrcInputData%ExternalBlPitchCom -ENDIF - DstInputData%ExternalGenTrq = SrcInputData%ExternalGenTrq - DstInputData%ExternalElecPwr = SrcInputData%ExternalElecPwr - DstInputData%ExternalHSSBrFrac = SrcInputData%ExternalHSSBrFrac -IF (ALLOCATED(SrcInputData%ExternalBlAirfoilCom)) THEN - i1_l = LBOUND(SrcInputData%ExternalBlAirfoilCom,1) - i1_u = UBOUND(SrcInputData%ExternalBlAirfoilCom,1) - IF (.NOT. ALLOCATED(DstInputData%ExternalBlAirfoilCom)) THEN - ALLOCATE(DstInputData%ExternalBlAirfoilCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlAirfoilCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%ExternalBlAirfoilCom = SrcInputData%ExternalBlAirfoilCom -ENDIF -IF (ALLOCATED(SrcInputData%ExternalCableDeltaL)) THEN - i1_l = LBOUND(SrcInputData%ExternalCableDeltaL,1) - i1_u = UBOUND(SrcInputData%ExternalCableDeltaL,1) - IF (.NOT. ALLOCATED(DstInputData%ExternalCableDeltaL)) THEN - ALLOCATE(DstInputData%ExternalCableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%ExternalCableDeltaL = SrcInputData%ExternalCableDeltaL -ENDIF -IF (ALLOCATED(SrcInputData%ExternalCableDeltaLdot)) THEN - i1_l = LBOUND(SrcInputData%ExternalCableDeltaLdot,1) - i1_u = UBOUND(SrcInputData%ExternalCableDeltaLdot,1) - IF (.NOT. ALLOCATED(DstInputData%ExternalCableDeltaLdot)) THEN - ALLOCATE(DstInputData%ExternalCableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%ExternalCableDeltaLdot = SrcInputData%ExternalCableDeltaLdot -ENDIF - DstInputData%TwrAccel = SrcInputData%TwrAccel - DstInputData%YawErr = SrcInputData%YawErr - DstInputData%WindDir = SrcInputData%WindDir - DstInputData%RootMyc = SrcInputData%RootMyc - DstInputData%YawBrTAxp = SrcInputData%YawBrTAxp - DstInputData%YawBrTAyp = SrcInputData%YawBrTAyp - DstInputData%LSSTipPxa = SrcInputData%LSSTipPxa - DstInputData%RootMxc = SrcInputData%RootMxc - DstInputData%LSSTipMxa = SrcInputData%LSSTipMxa - DstInputData%LSSTipMya = SrcInputData%LSSTipMya - DstInputData%LSSTipMza = SrcInputData%LSSTipMza - DstInputData%LSSTipMys = SrcInputData%LSSTipMys - DstInputData%LSSTipMzs = SrcInputData%LSSTipMzs - DstInputData%YawBrMyn = SrcInputData%YawBrMyn - DstInputData%YawBrMzn = SrcInputData%YawBrMzn - DstInputData%NcIMURAxs = SrcInputData%NcIMURAxs - DstInputData%NcIMURAys = SrcInputData%NcIMURAys - DstInputData%NcIMURAzs = SrcInputData%NcIMURAzs - DstInputData%RotPwr = SrcInputData%RotPwr - DstInputData%HorWindV = SrcInputData%HorWindV - DstInputData%YawAngle = SrcInputData%YawAngle - DstInputData%LSShftFxa = SrcInputData%LSShftFxa - DstInputData%LSShftFys = SrcInputData%LSShftFys - DstInputData%LSShftFzs = SrcInputData%LSShftFzs -IF (ALLOCATED(SrcInputData%fromSC)) THEN - i1_l = LBOUND(SrcInputData%fromSC,1) - i1_u = UBOUND(SrcInputData%fromSC,1) - IF (.NOT. ALLOCATED(DstInputData%fromSC)) THEN - ALLOCATE(DstInputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%fromSC = SrcInputData%fromSC -ENDIF -IF (ALLOCATED(SrcInputData%fromSCglob)) THEN - i1_l = LBOUND(SrcInputData%fromSCglob,1) - i1_u = UBOUND(SrcInputData%fromSCglob,1) - IF (.NOT. ALLOCATED(DstInputData%fromSCglob)) THEN - ALLOCATE(DstInputData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%fromSCglob = SrcInputData%fromSCglob -ENDIF -IF (ALLOCATED(SrcInputData%Lidar)) THEN - i1_l = LBOUND(SrcInputData%Lidar,1) - i1_u = UBOUND(SrcInputData%Lidar,1) - IF (.NOT. ALLOCATED(DstInputData%Lidar)) THEN - ALLOCATE(DstInputData%Lidar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Lidar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Lidar = SrcInputData%Lidar -ENDIF - CALL MeshCopy( SrcInputData%PtfmMotionMesh, DstInputData%PtfmMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputData%BStCMotionMesh)) THEN - i1_l = LBOUND(SrcInputData%BStCMotionMesh,1) - i1_u = UBOUND(SrcInputData%BStCMotionMesh,1) - i2_l = LBOUND(SrcInputData%BStCMotionMesh,2) - i2_u = UBOUND(SrcInputData%BStCMotionMesh,2) - IF (.NOT. ALLOCATED(DstInputData%BStCMotionMesh)) THEN - ALLOCATE(DstInputData%BStCMotionMesh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcInputData%BStCMotionMesh,2), UBOUND(SrcInputData%BStCMotionMesh,2) - DO i1 = LBOUND(SrcInputData%BStCMotionMesh,1), UBOUND(SrcInputData%BStCMotionMesh,1) - CALL MeshCopy( SrcInputData%BStCMotionMesh(i1,i2), DstInputData%BStCMotionMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%NStCMotionMesh)) THEN - i1_l = LBOUND(SrcInputData%NStCMotionMesh,1) - i1_u = UBOUND(SrcInputData%NStCMotionMesh,1) - IF (.NOT. ALLOCATED(DstInputData%NStCMotionMesh)) THEN - ALLOCATE(DstInputData%NStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%NStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%NStCMotionMesh,1), UBOUND(SrcInputData%NStCMotionMesh,1) - CALL MeshCopy( SrcInputData%NStCMotionMesh(i1), DstInputData%NStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%TStCMotionMesh)) THEN - i1_l = LBOUND(SrcInputData%TStCMotionMesh,1) - i1_u = UBOUND(SrcInputData%TStCMotionMesh,1) - IF (.NOT. ALLOCATED(DstInputData%TStCMotionMesh)) THEN - ALLOCATE(DstInputData%TStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%TStCMotionMesh,1), UBOUND(SrcInputData%TStCMotionMesh,1) - CALL MeshCopy( SrcInputData%TStCMotionMesh(i1), DstInputData%TStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%SStCMotionMesh)) THEN - i1_l = LBOUND(SrcInputData%SStCMotionMesh,1) - i1_u = UBOUND(SrcInputData%SStCMotionMesh,1) - IF (.NOT. ALLOCATED(DstInputData%SStCMotionMesh)) THEN - ALLOCATE(DstInputData%SStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%SStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%SStCMotionMesh,1), UBOUND(SrcInputData%SStCMotionMesh,1) - CALL MeshCopy( SrcInputData%SStCMotionMesh(i1), DstInputData%SStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%LidSpeed)) THEN - i1_l = LBOUND(SrcInputData%LidSpeed,1) - i1_u = UBOUND(SrcInputData%LidSpeed,1) - IF (.NOT. ALLOCATED(DstInputData%LidSpeed)) THEN - ALLOCATE(DstInputData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%LidSpeed = SrcInputData%LidSpeed -ENDIF -IF (ALLOCATED(SrcInputData%MsrPositionsX)) THEN - i1_l = LBOUND(SrcInputData%MsrPositionsX,1) - i1_u = UBOUND(SrcInputData%MsrPositionsX,1) - IF (.NOT. ALLOCATED(DstInputData%MsrPositionsX)) THEN - ALLOCATE(DstInputData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%MsrPositionsX = SrcInputData%MsrPositionsX -ENDIF -IF (ALLOCATED(SrcInputData%MsrPositionsY)) THEN - i1_l = LBOUND(SrcInputData%MsrPositionsY,1) - i1_u = UBOUND(SrcInputData%MsrPositionsY,1) - IF (.NOT. ALLOCATED(DstInputData%MsrPositionsY)) THEN - ALLOCATE(DstInputData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%MsrPositionsY = SrcInputData%MsrPositionsY -ENDIF -IF (ALLOCATED(SrcInputData%MsrPositionsZ)) THEN - i1_l = LBOUND(SrcInputData%MsrPositionsZ,1) - i1_u = UBOUND(SrcInputData%MsrPositionsZ,1) - IF (.NOT. ALLOCATED(DstInputData%MsrPositionsZ)) THEN - ALLOCATE(DstInputData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%MsrPositionsZ = SrcInputData%MsrPositionsZ -ENDIF - END SUBROUTINE SrvD_CopyInput - - SUBROUTINE SrvD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SrvD_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 = 'SrvD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%BlPitch)) THEN - DEALLOCATE(InputData%BlPitch) -ENDIF -IF (ALLOCATED(InputData%ExternalBlPitchCom)) THEN - DEALLOCATE(InputData%ExternalBlPitchCom) -ENDIF -IF (ALLOCATED(InputData%ExternalBlAirfoilCom)) THEN - DEALLOCATE(InputData%ExternalBlAirfoilCom) -ENDIF -IF (ALLOCATED(InputData%ExternalCableDeltaL)) THEN - DEALLOCATE(InputData%ExternalCableDeltaL) -ENDIF -IF (ALLOCATED(InputData%ExternalCableDeltaLdot)) THEN - DEALLOCATE(InputData%ExternalCableDeltaLdot) -ENDIF -IF (ALLOCATED(InputData%fromSC)) THEN - DEALLOCATE(InputData%fromSC) -ENDIF -IF (ALLOCATED(InputData%fromSCglob)) THEN - DEALLOCATE(InputData%fromSCglob) -ENDIF -IF (ALLOCATED(InputData%Lidar)) THEN - DEALLOCATE(InputData%Lidar) -ENDIF - CALL MeshDestroy( InputData%PtfmMotionMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputData%BStCMotionMesh)) THEN -DO i2 = LBOUND(InputData%BStCMotionMesh,2), UBOUND(InputData%BStCMotionMesh,2) -DO i1 = LBOUND(InputData%BStCMotionMesh,1), UBOUND(InputData%BStCMotionMesh,1) - CALL MeshDestroy( InputData%BStCMotionMesh(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(InputData%BStCMotionMesh) -ENDIF -IF (ALLOCATED(InputData%NStCMotionMesh)) THEN -DO i1 = LBOUND(InputData%NStCMotionMesh,1), UBOUND(InputData%NStCMotionMesh,1) - CALL MeshDestroy( InputData%NStCMotionMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%NStCMotionMesh) -ENDIF -IF (ALLOCATED(InputData%TStCMotionMesh)) THEN -DO i1 = LBOUND(InputData%TStCMotionMesh,1), UBOUND(InputData%TStCMotionMesh,1) - CALL MeshDestroy( InputData%TStCMotionMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%TStCMotionMesh) -ENDIF -IF (ALLOCATED(InputData%SStCMotionMesh)) THEN -DO i1 = LBOUND(InputData%SStCMotionMesh,1), UBOUND(InputData%SStCMotionMesh,1) - CALL MeshDestroy( InputData%SStCMotionMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%SStCMotionMesh) -ENDIF -IF (ALLOCATED(InputData%LidSpeed)) THEN - DEALLOCATE(InputData%LidSpeed) -ENDIF -IF (ALLOCATED(InputData%MsrPositionsX)) THEN - DEALLOCATE(InputData%MsrPositionsX) -ENDIF -IF (ALLOCATED(InputData%MsrPositionsY)) THEN - DEALLOCATE(InputData%MsrPositionsY) -ENDIF -IF (ALLOCATED(InputData%MsrPositionsZ)) THEN - DEALLOCATE(InputData%MsrPositionsZ) -ENDIF - END SUBROUTINE SrvD_DestroyInput - - SUBROUTINE SrvD_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(SrvD_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 = 'SrvD_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 - Int_BufSz = Int_BufSz + 1 ! BlPitch allocated yes/no - IF ( ALLOCATED(InData%BlPitch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitch) ! BlPitch - END IF - Re_BufSz = Re_BufSz + 1 ! Yaw - Re_BufSz = Re_BufSz + 1 ! YawRate - Re_BufSz = Re_BufSz + 1 ! LSS_Spd - Re_BufSz = Re_BufSz + 1 ! HSS_Spd - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! ExternalYawPosCom - Re_BufSz = Re_BufSz + 1 ! ExternalYawRateCom - Int_BufSz = Int_BufSz + 1 ! ExternalBlPitchCom allocated yes/no - IF ( ALLOCATED(InData%ExternalBlPitchCom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ExternalBlPitchCom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ExternalBlPitchCom) ! ExternalBlPitchCom - END IF - Re_BufSz = Re_BufSz + 1 ! ExternalGenTrq - Re_BufSz = Re_BufSz + 1 ! ExternalElecPwr - Re_BufSz = Re_BufSz + 1 ! ExternalHSSBrFrac - Int_BufSz = Int_BufSz + 1 ! ExternalBlAirfoilCom allocated yes/no - IF ( ALLOCATED(InData%ExternalBlAirfoilCom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ExternalBlAirfoilCom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ExternalBlAirfoilCom) ! ExternalBlAirfoilCom - END IF - Int_BufSz = Int_BufSz + 1 ! ExternalCableDeltaL allocated yes/no - IF ( ALLOCATED(InData%ExternalCableDeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ExternalCableDeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ExternalCableDeltaL) ! ExternalCableDeltaL - END IF - Int_BufSz = Int_BufSz + 1 ! ExternalCableDeltaLdot allocated yes/no - IF ( ALLOCATED(InData%ExternalCableDeltaLdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ExternalCableDeltaLdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ExternalCableDeltaLdot) ! ExternalCableDeltaLdot - END IF - Re_BufSz = Re_BufSz + 1 ! TwrAccel - Re_BufSz = Re_BufSz + 1 ! YawErr - Re_BufSz = Re_BufSz + 1 ! WindDir - Re_BufSz = Re_BufSz + SIZE(InData%RootMyc) ! RootMyc - Re_BufSz = Re_BufSz + 1 ! YawBrTAxp - Re_BufSz = Re_BufSz + 1 ! YawBrTAyp - Re_BufSz = Re_BufSz + 1 ! LSSTipPxa - Re_BufSz = Re_BufSz + SIZE(InData%RootMxc) ! RootMxc - Re_BufSz = Re_BufSz + 1 ! LSSTipMxa - Re_BufSz = Re_BufSz + 1 ! LSSTipMya - Re_BufSz = Re_BufSz + 1 ! LSSTipMza - Re_BufSz = Re_BufSz + 1 ! LSSTipMys - Re_BufSz = Re_BufSz + 1 ! LSSTipMzs - Re_BufSz = Re_BufSz + 1 ! YawBrMyn - Re_BufSz = Re_BufSz + 1 ! YawBrMzn - Re_BufSz = Re_BufSz + 1 ! NcIMURAxs - Re_BufSz = Re_BufSz + 1 ! NcIMURAys - Re_BufSz = Re_BufSz + 1 ! NcIMURAzs - Re_BufSz = Re_BufSz + 1 ! RotPwr - Re_BufSz = Re_BufSz + 1 ! HorWindV - Re_BufSz = Re_BufSz + 1 ! YawAngle - Re_BufSz = Re_BufSz + 1 ! LSShftFxa - Re_BufSz = Re_BufSz + 1 ! LSShftFys - Re_BufSz = Re_BufSz + 1 ! LSShftFzs - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ALLOCATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - END IF - Int_BufSz = Int_BufSz + 1 ! fromSCglob allocated yes/no - IF ( ALLOCATED(InData%fromSCglob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCglob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCglob) ! fromSCglob - END IF - Int_BufSz = Int_BufSz + 1 ! Lidar allocated yes/no - IF ( ALLOCATED(InData%Lidar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Lidar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Lidar) ! Lidar - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtfmMotionMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtfmMotionMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtfmMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtfmMotionMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtfmMotionMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtfmMotionMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BStCMotionMesh allocated yes/no - IF ( ALLOCATED(InData%BStCMotionMesh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BStCMotionMesh upper/lower bounds for each dimension - DO i2 = LBOUND(InData%BStCMotionMesh,2), UBOUND(InData%BStCMotionMesh,2) - DO i1 = LBOUND(InData%BStCMotionMesh,1), UBOUND(InData%BStCMotionMesh,1) - Int_BufSz = Int_BufSz + 3 ! BStCMotionMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%BStCMotionMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStCMotionMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStCMotionMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStCMotionMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStCMotionMesh allocated yes/no - IF ( ALLOCATED(InData%NStCMotionMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStCMotionMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStCMotionMesh,1), UBOUND(InData%NStCMotionMesh,1) - Int_BufSz = Int_BufSz + 3 ! NStCMotionMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%NStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStCMotionMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStCMotionMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStCMotionMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStCMotionMesh allocated yes/no - IF ( ALLOCATED(InData%TStCMotionMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStCMotionMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStCMotionMesh,1), UBOUND(InData%TStCMotionMesh,1) - Int_BufSz = Int_BufSz + 3 ! TStCMotionMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%TStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStCMotionMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStCMotionMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStCMotionMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStCMotionMesh allocated yes/no - IF ( ALLOCATED(InData%SStCMotionMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStCMotionMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStCMotionMesh,1), UBOUND(InData%SStCMotionMesh,1) - Int_BufSz = Int_BufSz + 3 ! SStCMotionMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%SStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStCMotionMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStCMotionMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStCMotionMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! LidSpeed allocated yes/no - IF ( ALLOCATED(InData%LidSpeed) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LidSpeed upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LidSpeed) ! LidSpeed - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsX allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsX) ! MsrPositionsX - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsY allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsY) ! MsrPositionsY - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsZ allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsZ) ! MsrPositionsZ - 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%BlPitch) ) 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%BlPitch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) - ReKiBuf(Re_Xferred) = InData%BlPitch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExternalYawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExternalYawRateCom - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ExternalBlPitchCom) ) 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%ExternalBlPitchCom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExternalBlPitchCom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ExternalBlPitchCom,1), UBOUND(InData%ExternalBlPitchCom,1) - ReKiBuf(Re_Xferred) = InData%ExternalBlPitchCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%ExternalGenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExternalElecPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExternalHSSBrFrac - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ExternalBlAirfoilCom) ) 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%ExternalBlAirfoilCom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExternalBlAirfoilCom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ExternalBlAirfoilCom,1), UBOUND(InData%ExternalBlAirfoilCom,1) - ReKiBuf(Re_Xferred) = InData%ExternalBlAirfoilCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ExternalCableDeltaL) ) 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%ExternalCableDeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExternalCableDeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ExternalCableDeltaL,1), UBOUND(InData%ExternalCableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%ExternalCableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ExternalCableDeltaLdot) ) 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%ExternalCableDeltaLdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExternalCableDeltaLdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ExternalCableDeltaLdot,1), UBOUND(InData%ExternalCableDeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%ExternalCableDeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TwrAccel - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WindDir - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) - ReKiBuf(Re_Xferred) = InData%RootMyc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%YawBrTAxp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrTAyp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipPxa - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) - ReKiBuf(Re_Xferred) = InData%RootMxc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%LSSTipMxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMya - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMza - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAxs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HorWindV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawAngle - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFzs - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%fromSC) ) 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%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fromSCglob) ) 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%fromSCglob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCglob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCglob,1), UBOUND(InData%fromSCglob,1) - ReKiBuf(Re_Xferred) = InData%fromSCglob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Lidar) ) 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%Lidar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Lidar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Lidar,1), UBOUND(InData%Lidar,1) - ReKiBuf(Re_Xferred) = InData%Lidar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL MeshPack( InData%PtfmMotionMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtfmMotionMesh - 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 - IF ( .NOT. ALLOCATED(InData%BStCMotionMesh) ) 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%BStCMotionMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStCMotionMesh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStCMotionMesh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStCMotionMesh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BStCMotionMesh,2), UBOUND(InData%BStCMotionMesh,2) - DO i1 = LBOUND(InData%BStCMotionMesh,1), UBOUND(InData%BStCMotionMesh,1) - CALL MeshPack( InData%BStCMotionMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BStCMotionMesh - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%NStCMotionMesh) ) 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%NStCMotionMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStCMotionMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStCMotionMesh,1), UBOUND(InData%NStCMotionMesh,1) - CALL MeshPack( InData%NStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NStCMotionMesh - 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 - IF ( .NOT. ALLOCATED(InData%TStCMotionMesh) ) 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%TStCMotionMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStCMotionMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStCMotionMesh,1), UBOUND(InData%TStCMotionMesh,1) - CALL MeshPack( InData%TStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TStCMotionMesh - 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 - IF ( .NOT. ALLOCATED(InData%SStCMotionMesh) ) 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%SStCMotionMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStCMotionMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStCMotionMesh,1), UBOUND(InData%SStCMotionMesh,1) - CALL MeshPack( InData%SStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SStCMotionMesh - 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 - IF ( .NOT. ALLOCATED(InData%LidSpeed) ) 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%LidSpeed,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LidSpeed,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LidSpeed,1), UBOUND(InData%LidSpeed,1) - ReKiBuf(Re_Xferred) = InData%LidSpeed(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsX) ) 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%MsrPositionsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsX,1), UBOUND(InData%MsrPositionsX,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsY) ) 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%MsrPositionsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsY,1), UBOUND(InData%MsrPositionsY,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsZ) ) 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%MsrPositionsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsZ,1), UBOUND(InData%MsrPositionsZ,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_PackInput - - SUBROUTINE SrvD_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(SrvD_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) :: 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 = 'SrvD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch 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%BlPitch)) DEALLOCATE(OutData%BlPitch) - ALLOCATE(OutData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) - OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Yaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSS_Spd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSS_Spd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalYawPosCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalYawRateCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExternalBlPitchCom 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%ExternalBlPitchCom)) DEALLOCATE(OutData%ExternalBlPitchCom) - ALLOCATE(OutData%ExternalBlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalBlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ExternalBlPitchCom,1), UBOUND(OutData%ExternalBlPitchCom,1) - OutData%ExternalBlPitchCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%ExternalGenTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalElecPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalHSSBrFrac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExternalBlAirfoilCom 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%ExternalBlAirfoilCom)) DEALLOCATE(OutData%ExternalBlAirfoilCom) - ALLOCATE(OutData%ExternalBlAirfoilCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalBlAirfoilCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ExternalBlAirfoilCom,1), UBOUND(OutData%ExternalBlAirfoilCom,1) - OutData%ExternalBlAirfoilCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExternalCableDeltaL 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%ExternalCableDeltaL)) DEALLOCATE(OutData%ExternalCableDeltaL) - ALLOCATE(OutData%ExternalCableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalCableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ExternalCableDeltaL,1), UBOUND(OutData%ExternalCableDeltaL,1) - OutData%ExternalCableDeltaL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExternalCableDeltaLdot 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%ExternalCableDeltaLdot)) DEALLOCATE(OutData%ExternalCableDeltaLdot) - ALLOCATE(OutData%ExternalCableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalCableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ExternalCableDeltaLdot,1), UBOUND(OutData%ExternalCableDeltaLdot,1) - OutData%ExternalCableDeltaLdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%TwrAccel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawErr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WindDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RootMyc,1) - i1_u = UBOUND(OutData%RootMyc,1) - DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) - OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%YawBrTAxp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAyp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipPxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RootMxc,1) - i1_u = UBOUND(OutData%RootMxc,1) - DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) - OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%LSSTipMxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMya = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMza = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAxs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HorWindV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC 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%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCglob 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%fromSCglob)) DEALLOCATE(OutData%fromSCglob) - ALLOCATE(OutData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSCglob,1), UBOUND(OutData%fromSCglob,1) - OutData%fromSCglob(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Lidar 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%Lidar)) DEALLOCATE(OutData%Lidar) - ALLOCATE(OutData%Lidar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lidar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Lidar,1), UBOUND(OutData%Lidar,1) - OutData%Lidar(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - 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 MeshUnpack( OutData%PtfmMotionMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtfmMotionMesh - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStCMotionMesh 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%BStCMotionMesh)) DEALLOCATE(OutData%BStCMotionMesh) - ALLOCATE(OutData%BStCMotionMesh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BStCMotionMesh,2), UBOUND(OutData%BStCMotionMesh,2) - DO i1 = LBOUND(OutData%BStCMotionMesh,1), UBOUND(OutData%BStCMotionMesh,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 MeshUnpack( OutData%BStCMotionMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BStCMotionMesh - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStCMotionMesh 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%NStCMotionMesh)) DEALLOCATE(OutData%NStCMotionMesh) - ALLOCATE(OutData%NStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStCMotionMesh,1), UBOUND(OutData%NStCMotionMesh,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 MeshUnpack( OutData%NStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NStCMotionMesh - 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 ! TStCMotionMesh 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%TStCMotionMesh)) DEALLOCATE(OutData%TStCMotionMesh) - ALLOCATE(OutData%TStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStCMotionMesh,1), UBOUND(OutData%TStCMotionMesh,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 MeshUnpack( OutData%TStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TStCMotionMesh - 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 ! SStCMotionMesh 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%SStCMotionMesh)) DEALLOCATE(OutData%SStCMotionMesh) - ALLOCATE(OutData%SStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStCMotionMesh,1), UBOUND(OutData%SStCMotionMesh,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 MeshUnpack( OutData%SStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SStCMotionMesh - 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 ! LidSpeed 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%LidSpeed)) DEALLOCATE(OutData%LidSpeed) - ALLOCATE(OutData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LidSpeed,1), UBOUND(OutData%LidSpeed,1) - OutData%LidSpeed(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsX 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%MsrPositionsX)) DEALLOCATE(OutData%MsrPositionsX) - ALLOCATE(OutData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsX,1), UBOUND(OutData%MsrPositionsX,1) - OutData%MsrPositionsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsY 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%MsrPositionsY)) DEALLOCATE(OutData%MsrPositionsY) - ALLOCATE(OutData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsY,1), UBOUND(OutData%MsrPositionsY,1) - OutData%MsrPositionsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsZ 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%MsrPositionsZ)) DEALLOCATE(OutData%MsrPositionsZ) - ALLOCATE(OutData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsZ,1), UBOUND(OutData%MsrPositionsZ,1) - OutData%MsrPositionsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_UnPackInput - - SUBROUTINE SrvD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(SrvD_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyOutput' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%NumBl = SrcInitInputData%NumBl + DstInitInputData%RootName = SrcInitInputData%RootName + if (allocated(SrcInitInputData%BlPitchInit)) then + LB(1:1) = lbound(SrcInitInputData%BlPitchInit) + UB(1:1) = ubound(SrcInitInputData%BlPitchInit) + if (.not. allocated(DstInitInputData%BlPitchInit)) then + allocate(DstInitInputData%BlPitchInit(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlPitchInit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BlPitchInit = SrcInitInputData%BlPitchInit + end if + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%NacRefPos = SrcInitInputData%NacRefPos + DstInitInputData%NacTransDisp = SrcInitInputData%NacTransDisp + DstInitInputData%NacOrient = SrcInitInputData%NacOrient + DstInitInputData%NacRefOrient = SrcInitInputData%NacRefOrient + DstInitInputData%TwrBaseRefPos = SrcInitInputData%TwrBaseRefPos + DstInitInputData%TwrBaseTransDisp = SrcInitInputData%TwrBaseTransDisp + DstInitInputData%TwrBaseOrient = SrcInitInputData%TwrBaseOrient + DstInitInputData%TwrBaseRefOrient = SrcInitInputData%TwrBaseRefOrient + DstInitInputData%PtfmRefPos = SrcInitInputData%PtfmRefPos + DstInitInputData%PtfmTransDisp = SrcInitInputData%PtfmTransDisp + DstInitInputData%PtfmOrient = SrcInitInputData%PtfmOrient + DstInitInputData%PtfmRefOrient = SrcInitInputData%PtfmRefOrient + DstInitInputData%Tmax = SrcInitInputData%Tmax + DstInitInputData%AvgWindSpeed = SrcInitInputData%AvgWindSpeed + DstInitInputData%AirDens = SrcInitInputData%AirDens + DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob + DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl + DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC + DstInitInputData%TrimCase = SrcInitInputData%TrimCase + DstInitInputData%TrimGain = SrcInitInputData%TrimGain + DstInitInputData%RotSpeedRef = SrcInitInputData%RotSpeedRef + if (allocated(SrcInitInputData%BladeRootRefPos)) then + LB(1:2) = lbound(SrcInitInputData%BladeRootRefPos) + UB(1:2) = ubound(SrcInitInputData%BladeRootRefPos) + if (.not. allocated(DstInitInputData%BladeRootRefPos)) then + allocate(DstInitInputData%BladeRootRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BladeRootRefPos = SrcInitInputData%BladeRootRefPos + end if + if (allocated(SrcInitInputData%BladeRootTransDisp)) then + LB(1:2) = lbound(SrcInitInputData%BladeRootTransDisp) + UB(1:2) = ubound(SrcInitInputData%BladeRootTransDisp) + if (.not. allocated(DstInitInputData%BladeRootTransDisp)) then + allocate(DstInitInputData%BladeRootTransDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootTransDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BladeRootTransDisp = SrcInitInputData%BladeRootTransDisp + end if + if (allocated(SrcInitInputData%BladeRootOrient)) then + LB(1:3) = lbound(SrcInitInputData%BladeRootOrient) + UB(1:3) = ubound(SrcInitInputData%BladeRootOrient) + if (.not. allocated(DstInitInputData%BladeRootOrient)) then + allocate(DstInitInputData%BladeRootOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BladeRootOrient = SrcInitInputData%BladeRootOrient + end if + if (allocated(SrcInitInputData%BladeRootRefOrient)) then + LB(1:3) = lbound(SrcInitInputData%BladeRootRefOrient) + UB(1:3) = ubound(SrcInitInputData%BladeRootRefOrient) + if (.not. allocated(DstInitInputData%BladeRootRefOrient)) then + allocate(DstInitInputData%BladeRootRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootRefOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BladeRootRefOrient = SrcInitInputData%BladeRootRefOrient + end if + DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%NumCableControl = SrcInitInputData%NumCableControl + if (allocated(SrcInitInputData%CableControlRequestor)) then + LB(1:1) = lbound(SrcInitInputData%CableControlRequestor) + UB(1:1) = ubound(SrcInitInputData%CableControlRequestor) + if (.not. allocated(DstInitInputData%CableControlRequestor)) then + allocate(DstInitInputData%CableControlRequestor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CableControlRequestor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%CableControlRequestor = SrcInitInputData%CableControlRequestor + end if + DstInitInputData%InterpOrder = SrcInitInputData%InterpOrder + if (allocated(SrcInitInputData%fromSCGlob)) then + LB(1:1) = lbound(SrcInitInputData%fromSCGlob) + UB(1:1) = ubound(SrcInitInputData%fromSCGlob) + if (.not. allocated(DstInitInputData%fromSCGlob)) then + allocate(DstInitInputData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSCGlob.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob + end if + if (allocated(SrcInitInputData%fromSC)) then + LB(1:1) = lbound(SrcInitInputData%fromSC) + UB(1:1) = ubound(SrcInitInputData%fromSC) + if (.not. allocated(DstInitInputData%fromSC)) then + allocate(DstInitInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%fromSC = SrcInitInputData%fromSC + end if + if (allocated(SrcInitInputData%LidSpeed)) then + LB(1:1) = lbound(SrcInitInputData%LidSpeed) + UB(1:1) = ubound(SrcInitInputData%LidSpeed) + if (.not. allocated(DstInitInputData%LidSpeed)) then + allocate(DstInitInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%LidSpeed.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%LidSpeed = SrcInitInputData%LidSpeed + end if + if (allocated(SrcInitInputData%MsrPositionsX)) then + LB(1:1) = lbound(SrcInitInputData%MsrPositionsX) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsX) + if (.not. allocated(DstInitInputData%MsrPositionsX)) then + allocate(DstInitInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%MsrPositionsX = SrcInitInputData%MsrPositionsX + end if + if (allocated(SrcInitInputData%MsrPositionsY)) then + LB(1:1) = lbound(SrcInitInputData%MsrPositionsY) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsY) + if (.not. allocated(DstInitInputData%MsrPositionsY)) then + allocate(DstInitInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%MsrPositionsY = SrcInitInputData%MsrPositionsY + end if + if (allocated(SrcInitInputData%MsrPositionsZ)) then + LB(1:1) = lbound(SrcInitInputData%MsrPositionsZ) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsZ) + if (.not. allocated(DstInitInputData%MsrPositionsZ)) then + allocate(DstInitInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%MsrPositionsZ = SrcInitInputData%MsrPositionsZ + end if + DstInitInputData%SensorType = SrcInitInputData%SensorType + DstInitInputData%NumBeam = SrcInitInputData%NumBeam + DstInitInputData%NumPulseGate = SrcInitInputData%NumPulseGate + DstInitInputData%PulseSpacing = SrcInitInputData%PulseSpacing + DstInitInputData%URefLid = SrcInitInputData%URefLid +end subroutine + +subroutine SrvD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SrvD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyInitInput' 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 -IF (ALLOCATED(SrcOutputData%BlPitchCom)) THEN - i1_l = LBOUND(SrcOutputData%BlPitchCom,1) - i1_u = UBOUND(SrcOutputData%BlPitchCom,1) - IF (.NOT. ALLOCATED(DstOutputData%BlPitchCom)) THEN - ALLOCATE(DstOutputData%BlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%BlPitchCom = SrcOutputData%BlPitchCom -ENDIF -IF (ALLOCATED(SrcOutputData%BlAirfoilCom)) THEN - i1_l = LBOUND(SrcOutputData%BlAirfoilCom,1) - i1_u = UBOUND(SrcOutputData%BlAirfoilCom,1) - IF (.NOT. ALLOCATED(DstOutputData%BlAirfoilCom)) THEN - ALLOCATE(DstOutputData%BlAirfoilCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlAirfoilCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%BlAirfoilCom = SrcOutputData%BlAirfoilCom -ENDIF - DstOutputData%YawMom = SrcOutputData%YawMom - DstOutputData%GenTrq = SrcOutputData%GenTrq - DstOutputData%HSSBrTrqC = SrcOutputData%HSSBrTrqC - DstOutputData%ElecPwr = SrcOutputData%ElecPwr -IF (ALLOCATED(SrcOutputData%TBDrCon)) THEN - i1_l = LBOUND(SrcOutputData%TBDrCon,1) - i1_u = UBOUND(SrcOutputData%TBDrCon,1) - IF (.NOT. ALLOCATED(DstOutputData%TBDrCon)) THEN - ALLOCATE(DstOutputData%TBDrCon(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TBDrCon.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%TBDrCon = SrcOutputData%TBDrCon -ENDIF -IF (ALLOCATED(SrcOutputData%Lidar)) THEN - i1_l = LBOUND(SrcOutputData%Lidar,1) - i1_u = UBOUND(SrcOutputData%Lidar,1) - IF (.NOT. ALLOCATED(DstOutputData%Lidar)) THEN - ALLOCATE(DstOutputData%Lidar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Lidar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Lidar = SrcOutputData%Lidar -ENDIF -IF (ALLOCATED(SrcOutputData%CableDeltaL)) THEN - i1_l = LBOUND(SrcOutputData%CableDeltaL,1) - i1_u = UBOUND(SrcOutputData%CableDeltaL,1) - IF (.NOT. ALLOCATED(DstOutputData%CableDeltaL)) THEN - ALLOCATE(DstOutputData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%CableDeltaL = SrcOutputData%CableDeltaL -ENDIF -IF (ALLOCATED(SrcOutputData%CableDeltaLdot)) THEN - i1_l = LBOUND(SrcOutputData%CableDeltaLdot,1) - i1_u = UBOUND(SrcOutputData%CableDeltaLdot,1) - IF (.NOT. ALLOCATED(DstOutputData%CableDeltaLdot)) THEN - ALLOCATE(DstOutputData%CableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%CableDeltaLdot = SrcOutputData%CableDeltaLdot -ENDIF -IF (ALLOCATED(SrcOutputData%BStCLoadMesh)) THEN - i1_l = LBOUND(SrcOutputData%BStCLoadMesh,1) - i1_u = UBOUND(SrcOutputData%BStCLoadMesh,1) - i2_l = LBOUND(SrcOutputData%BStCLoadMesh,2) - i2_u = UBOUND(SrcOutputData%BStCLoadMesh,2) - IF (.NOT. ALLOCATED(DstOutputData%BStCLoadMesh)) THEN - ALLOCATE(DstOutputData%BStCLoadMesh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcOutputData%BStCLoadMesh,2), UBOUND(SrcOutputData%BStCLoadMesh,2) - DO i1 = LBOUND(SrcOutputData%BStCLoadMesh,1), UBOUND(SrcOutputData%BStCLoadMesh,1) - CALL MeshCopy( SrcOutputData%BStCLoadMesh(i1,i2), DstOutputData%BStCLoadMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%NStCLoadMesh)) THEN - i1_l = LBOUND(SrcOutputData%NStCLoadMesh,1) - i1_u = UBOUND(SrcOutputData%NStCLoadMesh,1) - IF (.NOT. ALLOCATED(DstOutputData%NStCLoadMesh)) THEN - ALLOCATE(DstOutputData%NStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%NStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%NStCLoadMesh,1), UBOUND(SrcOutputData%NStCLoadMesh,1) - CALL MeshCopy( SrcOutputData%NStCLoadMesh(i1), DstOutputData%NStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%TStCLoadMesh)) THEN - i1_l = LBOUND(SrcOutputData%TStCLoadMesh,1) - i1_u = UBOUND(SrcOutputData%TStCLoadMesh,1) - IF (.NOT. ALLOCATED(DstOutputData%TStCLoadMesh)) THEN - ALLOCATE(DstOutputData%TStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%TStCLoadMesh,1), UBOUND(SrcOutputData%TStCLoadMesh,1) - CALL MeshCopy( SrcOutputData%TStCLoadMesh(i1), DstOutputData%TStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%SStCLoadMesh)) THEN - i1_l = LBOUND(SrcOutputData%SStCLoadMesh,1) - i1_u = UBOUND(SrcOutputData%SStCLoadMesh,1) - IF (.NOT. ALLOCATED(DstOutputData%SStCLoadMesh)) THEN - ALLOCATE(DstOutputData%SStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%SStCLoadMesh,1), UBOUND(SrcOutputData%SStCLoadMesh,1) - CALL MeshCopy( SrcOutputData%SStCLoadMesh(i1), DstOutputData%SStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%toSC)) THEN - i1_l = LBOUND(SrcOutputData%toSC,1) - i1_u = UBOUND(SrcOutputData%toSC,1) - IF (.NOT. ALLOCATED(DstOutputData%toSC)) THEN - ALLOCATE(DstOutputData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%toSC = SrcOutputData%toSC -ENDIF - END SUBROUTINE SrvD_CopyOutput - - SUBROUTINE SrvD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SrvD_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 = 'SrvD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF -IF (ALLOCATED(OutputData%BlPitchCom)) THEN - DEALLOCATE(OutputData%BlPitchCom) -ENDIF -IF (ALLOCATED(OutputData%BlAirfoilCom)) THEN - DEALLOCATE(OutputData%BlAirfoilCom) -ENDIF -IF (ALLOCATED(OutputData%TBDrCon)) THEN - DEALLOCATE(OutputData%TBDrCon) -ENDIF -IF (ALLOCATED(OutputData%Lidar)) THEN - DEALLOCATE(OutputData%Lidar) -ENDIF -IF (ALLOCATED(OutputData%CableDeltaL)) THEN - DEALLOCATE(OutputData%CableDeltaL) -ENDIF -IF (ALLOCATED(OutputData%CableDeltaLdot)) THEN - DEALLOCATE(OutputData%CableDeltaLdot) -ENDIF -IF (ALLOCATED(OutputData%BStCLoadMesh)) THEN -DO i2 = LBOUND(OutputData%BStCLoadMesh,2), UBOUND(OutputData%BStCLoadMesh,2) -DO i1 = LBOUND(OutputData%BStCLoadMesh,1), UBOUND(OutputData%BStCLoadMesh,1) - CALL MeshDestroy( OutputData%BStCLoadMesh(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(OutputData%BStCLoadMesh) -ENDIF -IF (ALLOCATED(OutputData%NStCLoadMesh)) THEN -DO i1 = LBOUND(OutputData%NStCLoadMesh,1), UBOUND(OutputData%NStCLoadMesh,1) - CALL MeshDestroy( OutputData%NStCLoadMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%NStCLoadMesh) -ENDIF -IF (ALLOCATED(OutputData%TStCLoadMesh)) THEN -DO i1 = LBOUND(OutputData%TStCLoadMesh,1), UBOUND(OutputData%TStCLoadMesh,1) - CALL MeshDestroy( OutputData%TStCLoadMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%TStCLoadMesh) -ENDIF -IF (ALLOCATED(OutputData%SStCLoadMesh)) THEN -DO i1 = LBOUND(OutputData%SStCLoadMesh,1), UBOUND(OutputData%SStCLoadMesh,1) - CALL MeshDestroy( OutputData%SStCLoadMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%SStCLoadMesh) -ENDIF -IF (ALLOCATED(OutputData%toSC)) THEN - DEALLOCATE(OutputData%toSC) -ENDIF - END SUBROUTINE SrvD_DestroyOutput - - SUBROUTINE SrvD_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(SrvD_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 = 'SrvD_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 - Int_BufSz = Int_BufSz + 1 ! BlPitchCom allocated yes/no - IF ( ALLOCATED(InData%BlPitchCom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchCom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom - END IF - Int_BufSz = Int_BufSz + 1 ! BlAirfoilCom allocated yes/no - IF ( ALLOCATED(InData%BlAirfoilCom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlAirfoilCom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlAirfoilCom) ! BlAirfoilCom - END IF - Re_BufSz = Re_BufSz + 1 ! YawMom - Re_BufSz = Re_BufSz + 1 ! GenTrq - Re_BufSz = Re_BufSz + 1 ! HSSBrTrqC - Re_BufSz = Re_BufSz + 1 ! ElecPwr - Int_BufSz = Int_BufSz + 1 ! TBDrCon allocated yes/no - IF ( ALLOCATED(InData%TBDrCon) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TBDrCon upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TBDrCon) ! TBDrCon - END IF - Int_BufSz = Int_BufSz + 1 ! Lidar allocated yes/no - IF ( ALLOCATED(InData%Lidar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Lidar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Lidar) ! Lidar - END IF - Int_BufSz = Int_BufSz + 1 ! CableDeltaL allocated yes/no - IF ( ALLOCATED(InData%CableDeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableDeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaL) ! CableDeltaL - END IF - Int_BufSz = Int_BufSz + 1 ! CableDeltaLdot allocated yes/no - IF ( ALLOCATED(InData%CableDeltaLdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableDeltaLdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaLdot) ! CableDeltaLdot - END IF - Int_BufSz = Int_BufSz + 1 ! BStCLoadMesh allocated yes/no - IF ( ALLOCATED(InData%BStCLoadMesh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BStCLoadMesh upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%BStCLoadMesh,2), UBOUND(InData%BStCLoadMesh,2) - DO i1 = LBOUND(InData%BStCLoadMesh,1), UBOUND(InData%BStCLoadMesh,1) - Int_BufSz = Int_BufSz + 3 ! BStCLoadMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%BStCLoadMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStCLoadMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStCLoadMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStCLoadMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStCLoadMesh allocated yes/no - IF ( ALLOCATED(InData%NStCLoadMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStCLoadMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStCLoadMesh,1), UBOUND(InData%NStCLoadMesh,1) - Int_BufSz = Int_BufSz + 3 ! NStCLoadMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%NStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStCLoadMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStCLoadMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStCLoadMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStCLoadMesh allocated yes/no - IF ( ALLOCATED(InData%TStCLoadMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStCLoadMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStCLoadMesh,1), UBOUND(InData%TStCLoadMesh,1) - Int_BufSz = Int_BufSz + 3 ! TStCLoadMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%TStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStCLoadMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStCLoadMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStCLoadMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStCLoadMesh allocated yes/no - IF ( ALLOCATED(InData%SStCLoadMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStCLoadMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStCLoadMesh,1), UBOUND(InData%SStCLoadMesh,1) - Int_BufSz = Int_BufSz + 3 ! SStCLoadMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%SStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStCLoadMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStCLoadMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStCLoadMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! toSC allocated yes/no - IF ( ALLOCATED(InData%toSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSC) ! toSC - 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 - IF ( .NOT. ALLOCATED(InData%BlPitchCom) ) 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%BlPitchCom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchCom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) - ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlAirfoilCom) ) 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%BlAirfoilCom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAirfoilCom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlAirfoilCom,1), UBOUND(InData%BlAirfoilCom,1) - ReKiBuf(Re_Xferred) = InData%BlAirfoilCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%YawMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ElecPwr - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TBDrCon) ) 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%TBDrCon,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TBDrCon,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TBDrCon,1), UBOUND(InData%TBDrCon,1) - ReKiBuf(Re_Xferred) = InData%TBDrCon(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Lidar) ) 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%Lidar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Lidar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Lidar,1), UBOUND(InData%Lidar,1) - ReKiBuf(Re_Xferred) = InData%Lidar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CableDeltaL) ) 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%CableDeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableDeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableDeltaL,1), UBOUND(InData%CableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CableDeltaLdot) ) 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%CableDeltaLdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableDeltaLdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableDeltaLdot,1), UBOUND(InData%CableDeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BStCLoadMesh) ) 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%BStCLoadMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStCLoadMesh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStCLoadMesh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStCLoadMesh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BStCLoadMesh,2), UBOUND(InData%BStCLoadMesh,2) - DO i1 = LBOUND(InData%BStCLoadMesh,1), UBOUND(InData%BStCLoadMesh,1) - CALL MeshPack( InData%BStCLoadMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BStCLoadMesh - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%NStCLoadMesh) ) 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%NStCLoadMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStCLoadMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStCLoadMesh,1), UBOUND(InData%NStCLoadMesh,1) - CALL MeshPack( InData%NStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NStCLoadMesh - 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 - IF ( .NOT. ALLOCATED(InData%TStCLoadMesh) ) 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%TStCLoadMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStCLoadMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStCLoadMesh,1), UBOUND(InData%TStCLoadMesh,1) - CALL MeshPack( InData%TStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TStCLoadMesh - 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 - IF ( .NOT. ALLOCATED(InData%SStCLoadMesh) ) 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%SStCLoadMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStCLoadMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStCLoadMesh,1), UBOUND(InData%SStCLoadMesh,1) - CALL MeshPack( InData%SStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SStCLoadMesh - 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 - IF ( .NOT. ALLOCATED(InData%toSC) ) 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%toSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) - ReKiBuf(Re_Xferred) = InData%toSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_PackOutput - - SUBROUTINE SrvD_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(SrvD_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchCom 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%BlPitchCom)) DEALLOCATE(OutData%BlPitchCom) - ALLOCATE(OutData%BlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) - OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAirfoilCom 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%BlAirfoilCom)) DEALLOCATE(OutData%BlAirfoilCom) - ALLOCATE(OutData%BlAirfoilCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAirfoilCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlAirfoilCom,1), UBOUND(OutData%BlAirfoilCom,1) - OutData%BlAirfoilCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%YawMom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TBDrCon 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%TBDrCon)) DEALLOCATE(OutData%TBDrCon) - ALLOCATE(OutData%TBDrCon(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDrCon.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TBDrCon,1), UBOUND(OutData%TBDrCon,1) - OutData%TBDrCon(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Lidar 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%Lidar)) DEALLOCATE(OutData%Lidar) - ALLOCATE(OutData%Lidar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lidar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Lidar,1), UBOUND(OutData%Lidar,1) - OutData%Lidar(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableDeltaL 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%CableDeltaL)) DEALLOCATE(OutData%CableDeltaL) - ALLOCATE(OutData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableDeltaL,1), UBOUND(OutData%CableDeltaL,1) - OutData%CableDeltaL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableDeltaLdot 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%CableDeltaLdot)) DEALLOCATE(OutData%CableDeltaLdot) - ALLOCATE(OutData%CableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableDeltaLdot,1), UBOUND(OutData%CableDeltaLdot,1) - OutData%CableDeltaLdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStCLoadMesh 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%BStCLoadMesh)) DEALLOCATE(OutData%BStCLoadMesh) - ALLOCATE(OutData%BStCLoadMesh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BStCLoadMesh,2), UBOUND(OutData%BStCLoadMesh,2) - DO i1 = LBOUND(OutData%BStCLoadMesh,1), UBOUND(OutData%BStCLoadMesh,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 MeshUnpack( OutData%BStCLoadMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BStCLoadMesh - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStCLoadMesh 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%NStCLoadMesh)) DEALLOCATE(OutData%NStCLoadMesh) - ALLOCATE(OutData%NStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStCLoadMesh,1), UBOUND(OutData%NStCLoadMesh,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 MeshUnpack( OutData%NStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NStCLoadMesh - 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 ! TStCLoadMesh 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%TStCLoadMesh)) DEALLOCATE(OutData%TStCLoadMesh) - ALLOCATE(OutData%TStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStCLoadMesh,1), UBOUND(OutData%TStCLoadMesh,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 MeshUnpack( OutData%TStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TStCLoadMesh - 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 ! SStCLoadMesh 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%SStCLoadMesh)) DEALLOCATE(OutData%SStCLoadMesh) - ALLOCATE(OutData%SStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStCLoadMesh,1), UBOUND(OutData%SStCLoadMesh,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 MeshUnpack( OutData%SStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SStCLoadMesh - 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 ! toSC 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%toSC)) DEALLOCATE(OutData%toSC) - ALLOCATE(OutData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) - OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_UnPackOutput - - - SUBROUTINE SrvD_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(SrvD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SrvD_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 + ErrMsg = '' + if (allocated(InitInputData%BlPitchInit)) then + deallocate(InitInputData%BlPitchInit) + end if + if (allocated(InitInputData%BladeRootRefPos)) then + deallocate(InitInputData%BladeRootRefPos) + end if + if (allocated(InitInputData%BladeRootTransDisp)) then + deallocate(InitInputData%BladeRootTransDisp) + end if + if (allocated(InitInputData%BladeRootOrient)) then + deallocate(InitInputData%BladeRootOrient) + end if + if (allocated(InitInputData%BladeRootRefOrient)) then + deallocate(InitInputData%BladeRootRefOrient) + end if + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitInputData%CableControlRequestor)) then + deallocate(InitInputData%CableControlRequestor) + end if + if (allocated(InitInputData%fromSCGlob)) then + deallocate(InitInputData%fromSCGlob) + end if + if (allocated(InitInputData%fromSC)) then + deallocate(InitInputData%fromSC) + end if + if (allocated(InitInputData%LidSpeed)) then + deallocate(InitInputData%LidSpeed) + end if + if (allocated(InitInputData%MsrPositionsX)) then + deallocate(InitInputData%MsrPositionsX) + end if + if (allocated(InitInputData%MsrPositionsY)) then + deallocate(InitInputData%MsrPositionsY) + end if + if (allocated(InitInputData%MsrPositionsZ)) then + deallocate(InitInputData%MsrPositionsZ) + end if +end subroutine + +subroutine SrvD_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%Linearize) + call RegPack(Buf, InData%NumBl) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, allocated(InData%BlPitchInit)) + if (allocated(InData%BlPitchInit)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitchInit), ubound(InData%BlPitchInit)) + call RegPack(Buf, InData%BlPitchInit) + end if + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%NacRefPos) + call RegPack(Buf, InData%NacTransDisp) + call RegPack(Buf, InData%NacOrient) + call RegPack(Buf, InData%NacRefOrient) + call RegPack(Buf, InData%TwrBaseRefPos) + call RegPack(Buf, InData%TwrBaseTransDisp) + call RegPack(Buf, InData%TwrBaseOrient) + call RegPack(Buf, InData%TwrBaseRefOrient) + call RegPack(Buf, InData%PtfmRefPos) + call RegPack(Buf, InData%PtfmTransDisp) + call RegPack(Buf, InData%PtfmOrient) + call RegPack(Buf, InData%PtfmRefOrient) + call RegPack(Buf, InData%Tmax) + call RegPack(Buf, InData%AvgWindSpeed) + call RegPack(Buf, InData%AirDens) + call RegPack(Buf, InData%NumSC2CtrlGlob) + call RegPack(Buf, InData%NumSC2Ctrl) + call RegPack(Buf, InData%NumCtrl2SC) + call RegPack(Buf, InData%TrimCase) + call RegPack(Buf, InData%TrimGain) + call RegPack(Buf, InData%RotSpeedRef) + call RegPack(Buf, allocated(InData%BladeRootRefPos)) + if (allocated(InData%BladeRootRefPos)) then + call RegPackBounds(Buf, 2, lbound(InData%BladeRootRefPos), ubound(InData%BladeRootRefPos)) + call RegPack(Buf, InData%BladeRootRefPos) + end if + call RegPack(Buf, allocated(InData%BladeRootTransDisp)) + if (allocated(InData%BladeRootTransDisp)) then + call RegPackBounds(Buf, 2, lbound(InData%BladeRootTransDisp), ubound(InData%BladeRootTransDisp)) + call RegPack(Buf, InData%BladeRootTransDisp) + end if + call RegPack(Buf, allocated(InData%BladeRootOrient)) + if (allocated(InData%BladeRootOrient)) then + call RegPackBounds(Buf, 3, lbound(InData%BladeRootOrient), ubound(InData%BladeRootOrient)) + call RegPack(Buf, InData%BladeRootOrient) + end if + call RegPack(Buf, allocated(InData%BladeRootRefOrient)) + if (allocated(InData%BladeRootRefOrient)) then + call RegPackBounds(Buf, 3, lbound(InData%BladeRootRefOrient), ubound(InData%BladeRootRefOrient)) + call RegPack(Buf, InData%BladeRootRefOrient) + end if + call RegPack(Buf, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) + call RegPack(Buf, InData%NumCableControl) + call RegPack(Buf, allocated(InData%CableControlRequestor)) + if (allocated(InData%CableControlRequestor)) then + call RegPackBounds(Buf, 1, lbound(InData%CableControlRequestor), ubound(InData%CableControlRequestor)) + call RegPack(Buf, InData%CableControlRequestor) + end if + call RegPack(Buf, InData%InterpOrder) + call RegPack(Buf, allocated(InData%fromSCGlob)) + if (allocated(InData%fromSCGlob)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob), ubound(InData%fromSCGlob)) + call RegPack(Buf, InData%fromSCGlob) + end if + call RegPack(Buf, allocated(InData%fromSC)) + if (allocated(InData%fromSC)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPack(Buf, InData%fromSC) + end if + call RegPack(Buf, allocated(InData%LidSpeed)) + if (allocated(InData%LidSpeed)) then + call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) + call RegPack(Buf, InData%LidSpeed) + end if + call RegPack(Buf, allocated(InData%MsrPositionsX)) + if (allocated(InData%MsrPositionsX)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) + call RegPack(Buf, InData%MsrPositionsX) + end if + call RegPack(Buf, allocated(InData%MsrPositionsY)) + if (allocated(InData%MsrPositionsY)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) + call RegPack(Buf, InData%MsrPositionsY) + end if + call RegPack(Buf, allocated(InData%MsrPositionsZ)) + if (allocated(InData%MsrPositionsZ)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) + call RegPack(Buf, InData%MsrPositionsZ) + end if + call RegPack(Buf, InData%SensorType) + call RegPack(Buf, InData%NumBeam) + call RegPack(Buf, InData%NumPulseGate) + call RegPack(Buf, InData%PulseSpacing) + call RegPack(Buf, InData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BlPitchInit)) deallocate(OutData%BlPitchInit) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitchInit(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitchInit) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacRefPos) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacOrient) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrBaseRefPos) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrBaseTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrBaseOrient) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TwrBaseRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmRefPos) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmOrient) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtfmRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AvgWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TrimCase) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TrimGain) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotSpeedRef) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BladeRootRefPos)) deallocate(OutData%BladeRootRefPos) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootRefPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootRefPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BladeRootRefPos) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BladeRootTransDisp)) deallocate(OutData%BladeRootTransDisp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootTransDisp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootTransDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BladeRootTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BladeRootOrient)) deallocate(OutData%BladeRootOrient) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootOrient.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BladeRootOrient) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BladeRootRefOrient)) deallocate(OutData%BladeRootRefOrient) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootRefOrient.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BladeRootRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + call RegUnpack(Buf, OutData%NumCableControl) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%CableControlRequestor)) deallocate(OutData%CableControlRequestor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableControlRequestor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableControlRequestor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableControlRequestor) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%InterpOrder) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%fromSCGlob)) deallocate(OutData%fromSCGlob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSCGlob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCGlob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSCGlob) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LidSpeed(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LidSpeed) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsY) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBeam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PulseSpacing) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_InitOutputType), intent(in) :: SrcInitOutputData + type(SrvD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%CouplingScheme = SrcInitOutputData%CouplingScheme + DstInitOutputData%UseHSSBrake = SrcInitOutputData%UseHSSBrake + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x + end if +end subroutine + +subroutine SrvD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SrvD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + 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) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if +end subroutine + +subroutine SrvD_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, InData%CouplingScheme) + call RegPack(Buf, InData%UseHSSBrake) + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + call RegUnpack(Buf, OutData%CouplingScheme) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UseHSSBrake) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_InputFile), intent(in) :: SrcInputFileData + type(SrvD_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SrvD_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%DT = SrcInputFileData%DT + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%PCMode = SrcInputFileData%PCMode + DstInputFileData%TPCOn = SrcInputFileData%TPCOn + DstInputFileData%TPitManS = SrcInputFileData%TPitManS + DstInputFileData%PitManRat = SrcInputFileData%PitManRat + DstInputFileData%BlPitchF = SrcInputFileData%BlPitchF + DstInputFileData%VSContrl = SrcInputFileData%VSContrl + DstInputFileData%GenModel = SrcInputFileData%GenModel + DstInputFileData%GenEff = SrcInputFileData%GenEff + DstInputFileData%GenTiStr = SrcInputFileData%GenTiStr + DstInputFileData%GenTiStp = SrcInputFileData%GenTiStp + DstInputFileData%SpdGenOn = SrcInputFileData%SpdGenOn + DstInputFileData%TimGenOn = SrcInputFileData%TimGenOn + DstInputFileData%TimGenOf = SrcInputFileData%TimGenOf + DstInputFileData%VS_RtGnSp = SrcInputFileData%VS_RtGnSp + DstInputFileData%VS_RtTq = SrcInputFileData%VS_RtTq + DstInputFileData%VS_Rgn2K = SrcInputFileData%VS_Rgn2K + DstInputFileData%VS_SlPc = SrcInputFileData%VS_SlPc + DstInputFileData%SIG_SlPc = SrcInputFileData%SIG_SlPc + DstInputFileData%SIG_SySp = SrcInputFileData%SIG_SySp + DstInputFileData%SIG_RtTq = SrcInputFileData%SIG_RtTq + DstInputFileData%SIG_PORt = SrcInputFileData%SIG_PORt + DstInputFileData%TEC_Freq = SrcInputFileData%TEC_Freq + DstInputFileData%TEC_NPol = SrcInputFileData%TEC_NPol + DstInputFileData%TEC_SRes = SrcInputFileData%TEC_SRes + DstInputFileData%TEC_RRes = SrcInputFileData%TEC_RRes + DstInputFileData%TEC_VLL = SrcInputFileData%TEC_VLL + DstInputFileData%TEC_SLR = SrcInputFileData%TEC_SLR + DstInputFileData%TEC_RLR = SrcInputFileData%TEC_RLR + DstInputFileData%TEC_MR = SrcInputFileData%TEC_MR + DstInputFileData%HSSBrMode = SrcInputFileData%HSSBrMode + DstInputFileData%THSSBrDp = SrcInputFileData%THSSBrDp + DstInputFileData%HSSBrDT = SrcInputFileData%HSSBrDT + DstInputFileData%HSSBrTqF = SrcInputFileData%HSSBrTqF + DstInputFileData%YCMode = SrcInputFileData%YCMode + DstInputFileData%TYCOn = SrcInputFileData%TYCOn + DstInputFileData%YawNeut = SrcInputFileData%YawNeut + DstInputFileData%YawSpr = SrcInputFileData%YawSpr + DstInputFileData%YawDamp = SrcInputFileData%YawDamp + DstInputFileData%TYawManS = SrcInputFileData%TYawManS + DstInputFileData%YawManRat = SrcInputFileData%YawManRat + DstInputFileData%NacYawF = SrcInputFileData%NacYawF + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%OutFile = SrcInputFileData%OutFile + DstInputFileData%TabDelim = SrcInputFileData%TabDelim + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%Tstart = SrcInputFileData%Tstart + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + end if + DstInputFileData%DLL_FileName = SrcInputFileData%DLL_FileName + DstInputFileData%DLL_ProcName = SrcInputFileData%DLL_ProcName + DstInputFileData%DLL_InFile = SrcInputFileData%DLL_InFile + DstInputFileData%DLL_DT = SrcInputFileData%DLL_DT + DstInputFileData%DLL_Ramp = SrcInputFileData%DLL_Ramp + DstInputFileData%BPCutoff = SrcInputFileData%BPCutoff + DstInputFileData%NacYaw_North = SrcInputFileData%NacYaw_North + DstInputFileData%Ptch_Cntrl = SrcInputFileData%Ptch_Cntrl + DstInputFileData%Ptch_SetPnt = SrcInputFileData%Ptch_SetPnt + DstInputFileData%Ptch_Min = SrcInputFileData%Ptch_Min + DstInputFileData%Ptch_Max = SrcInputFileData%Ptch_Max + DstInputFileData%PtchRate_Min = SrcInputFileData%PtchRate_Min + DstInputFileData%PtchRate_Max = SrcInputFileData%PtchRate_Max + DstInputFileData%Gain_OM = SrcInputFileData%Gain_OM + DstInputFileData%GenSpd_MinOM = SrcInputFileData%GenSpd_MinOM + DstInputFileData%GenSpd_MaxOM = SrcInputFileData%GenSpd_MaxOM + DstInputFileData%GenSpd_Dem = SrcInputFileData%GenSpd_Dem + DstInputFileData%GenTrq_Dem = SrcInputFileData%GenTrq_Dem + DstInputFileData%GenPwr_Dem = SrcInputFileData%GenPwr_Dem + DstInputFileData%DLL_NumTrq = SrcInputFileData%DLL_NumTrq + if (allocated(SrcInputFileData%GenSpd_TLU)) then + LB(1:1) = lbound(SrcInputFileData%GenSpd_TLU) + UB(1:1) = ubound(SrcInputFileData%GenSpd_TLU) + if (.not. allocated(DstInputFileData%GenSpd_TLU)) then + allocate(DstInputFileData%GenSpd_TLU(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GenSpd_TLU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%GenSpd_TLU = SrcInputFileData%GenSpd_TLU + end if + if (allocated(SrcInputFileData%GenTrq_TLU)) then + LB(1:1) = lbound(SrcInputFileData%GenTrq_TLU) + UB(1:1) = ubound(SrcInputFileData%GenTrq_TLU) + if (.not. allocated(DstInputFileData%GenTrq_TLU)) then + allocate(DstInputFileData%GenTrq_TLU(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GenTrq_TLU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%GenTrq_TLU = SrcInputFileData%GenTrq_TLU + end if + DstInputFileData%UseLegacyInterface = SrcInputFileData%UseLegacyInterface + DstInputFileData%NumBStC = SrcInputFileData%NumBStC + if (allocated(SrcInputFileData%BStCfiles)) then + LB(1:1) = lbound(SrcInputFileData%BStCfiles) + UB(1:1) = ubound(SrcInputFileData%BStCfiles) + if (.not. allocated(DstInputFileData%BStCfiles)) then + allocate(DstInputFileData%BStCfiles(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BStCfiles.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BStCfiles = SrcInputFileData%BStCfiles + end if + DstInputFileData%NumNStC = SrcInputFileData%NumNStC + if (allocated(SrcInputFileData%NStCfiles)) then + LB(1:1) = lbound(SrcInputFileData%NStCfiles) + UB(1:1) = ubound(SrcInputFileData%NStCfiles) + if (.not. allocated(DstInputFileData%NStCfiles)) then + allocate(DstInputFileData%NStCfiles(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%NStCfiles.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%NStCfiles = SrcInputFileData%NStCfiles + end if + DstInputFileData%NumTStC = SrcInputFileData%NumTStC + if (allocated(SrcInputFileData%TStCfiles)) then + LB(1:1) = lbound(SrcInputFileData%TStCfiles) + UB(1:1) = ubound(SrcInputFileData%TStCfiles) + if (.not. allocated(DstInputFileData%TStCfiles)) then + allocate(DstInputFileData%TStCfiles(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TStCfiles.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TStCfiles = SrcInputFileData%TStCfiles + end if + DstInputFileData%NumSStC = SrcInputFileData%NumSStC + if (allocated(SrcInputFileData%SStCfiles)) then + LB(1:1) = lbound(SrcInputFileData%SStCfiles) + UB(1:1) = ubound(SrcInputFileData%SStCfiles) + if (.not. allocated(DstInputFileData%SStCfiles)) then + allocate(DstInputFileData%SStCfiles(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%SStCfiles.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%SStCfiles = SrcInputFileData%SStCfiles + end if + DstInputFileData%AfCmode = SrcInputFileData%AfCmode + DstInputFileData%AfC_Mean = SrcInputFileData%AfC_Mean + DstInputFileData%AfC_Amp = SrcInputFileData%AfC_Amp + DstInputFileData%AfC_Phase = SrcInputFileData%AfC_Phase + DstInputFileData%CCmode = SrcInputFileData%CCmode + DstInputFileData%EXavrSWAP = SrcInputFileData%EXavrSWAP +end subroutine + +subroutine SrvD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(SrvD_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SrvD_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%GenSpd_TLU)) then + deallocate(InputFileData%GenSpd_TLU) + end if + if (allocated(InputFileData%GenTrq_TLU)) then + deallocate(InputFileData%GenTrq_TLU) + end if + if (allocated(InputFileData%BStCfiles)) then + deallocate(InputFileData%BStCfiles) + end if + if (allocated(InputFileData%NStCfiles)) then + deallocate(InputFileData%NStCfiles) + end if + if (allocated(InputFileData%TStCfiles)) then + deallocate(InputFileData%TStCfiles) + end if + if (allocated(InputFileData%SStCfiles)) then + deallocate(InputFileData%SStCfiles) + end if +end subroutine + +subroutine SrvD_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%Echo) + call RegPack(Buf, InData%PCMode) + call RegPack(Buf, InData%TPCOn) + call RegPack(Buf, InData%TPitManS) + call RegPack(Buf, InData%PitManRat) + call RegPack(Buf, InData%BlPitchF) + call RegPack(Buf, InData%VSContrl) + call RegPack(Buf, InData%GenModel) + call RegPack(Buf, InData%GenEff) + call RegPack(Buf, InData%GenTiStr) + call RegPack(Buf, InData%GenTiStp) + call RegPack(Buf, InData%SpdGenOn) + call RegPack(Buf, InData%TimGenOn) + call RegPack(Buf, InData%TimGenOf) + call RegPack(Buf, InData%VS_RtGnSp) + call RegPack(Buf, InData%VS_RtTq) + call RegPack(Buf, InData%VS_Rgn2K) + call RegPack(Buf, InData%VS_SlPc) + call RegPack(Buf, InData%SIG_SlPc) + call RegPack(Buf, InData%SIG_SySp) + call RegPack(Buf, InData%SIG_RtTq) + call RegPack(Buf, InData%SIG_PORt) + call RegPack(Buf, InData%TEC_Freq) + call RegPack(Buf, InData%TEC_NPol) + call RegPack(Buf, InData%TEC_SRes) + call RegPack(Buf, InData%TEC_RRes) + call RegPack(Buf, InData%TEC_VLL) + call RegPack(Buf, InData%TEC_SLR) + call RegPack(Buf, InData%TEC_RLR) + call RegPack(Buf, InData%TEC_MR) + call RegPack(Buf, InData%HSSBrMode) + call RegPack(Buf, InData%THSSBrDp) + call RegPack(Buf, InData%HSSBrDT) + call RegPack(Buf, InData%HSSBrTqF) + call RegPack(Buf, InData%YCMode) + call RegPack(Buf, InData%TYCOn) + call RegPack(Buf, InData%YawNeut) + call RegPack(Buf, InData%YawSpr) + call RegPack(Buf, InData%YawDamp) + call RegPack(Buf, InData%TYawManS) + call RegPack(Buf, InData%YawManRat) + call RegPack(Buf, InData%NacYawF) + call RegPack(Buf, InData%SumPrint) + call RegPack(Buf, InData%OutFile) + call RegPack(Buf, InData%TabDelim) + call RegPack(Buf, InData%OutFmt) + call RegPack(Buf, InData%Tstart) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + call RegPack(Buf, InData%DLL_FileName) + call RegPack(Buf, InData%DLL_ProcName) + call RegPack(Buf, InData%DLL_InFile) + call RegPack(Buf, InData%DLL_DT) + call RegPack(Buf, InData%DLL_Ramp) + call RegPack(Buf, InData%BPCutoff) + call RegPack(Buf, InData%NacYaw_North) + call RegPack(Buf, InData%Ptch_Cntrl) + call RegPack(Buf, InData%Ptch_SetPnt) + call RegPack(Buf, InData%Ptch_Min) + call RegPack(Buf, InData%Ptch_Max) + call RegPack(Buf, InData%PtchRate_Min) + call RegPack(Buf, InData%PtchRate_Max) + call RegPack(Buf, InData%Gain_OM) + call RegPack(Buf, InData%GenSpd_MinOM) + call RegPack(Buf, InData%GenSpd_MaxOM) + call RegPack(Buf, InData%GenSpd_Dem) + call RegPack(Buf, InData%GenTrq_Dem) + call RegPack(Buf, InData%GenPwr_Dem) + call RegPack(Buf, InData%DLL_NumTrq) + call RegPack(Buf, allocated(InData%GenSpd_TLU)) + if (allocated(InData%GenSpd_TLU)) then + call RegPackBounds(Buf, 1, lbound(InData%GenSpd_TLU), ubound(InData%GenSpd_TLU)) + call RegPack(Buf, InData%GenSpd_TLU) + end if + call RegPack(Buf, allocated(InData%GenTrq_TLU)) + if (allocated(InData%GenTrq_TLU)) then + call RegPackBounds(Buf, 1, lbound(InData%GenTrq_TLU), ubound(InData%GenTrq_TLU)) + call RegPack(Buf, InData%GenTrq_TLU) + end if + call RegPack(Buf, InData%UseLegacyInterface) + call RegPack(Buf, InData%NumBStC) + call RegPack(Buf, allocated(InData%BStCfiles)) + if (allocated(InData%BStCfiles)) then + call RegPackBounds(Buf, 1, lbound(InData%BStCfiles), ubound(InData%BStCfiles)) + call RegPack(Buf, InData%BStCfiles) + end if + call RegPack(Buf, InData%NumNStC) + call RegPack(Buf, allocated(InData%NStCfiles)) + if (allocated(InData%NStCfiles)) then + call RegPackBounds(Buf, 1, lbound(InData%NStCfiles), ubound(InData%NStCfiles)) + call RegPack(Buf, InData%NStCfiles) + end if + call RegPack(Buf, InData%NumTStC) + call RegPack(Buf, allocated(InData%TStCfiles)) + if (allocated(InData%TStCfiles)) then + call RegPackBounds(Buf, 1, lbound(InData%TStCfiles), ubound(InData%TStCfiles)) + call RegPack(Buf, InData%TStCfiles) + end if + call RegPack(Buf, InData%NumSStC) + call RegPack(Buf, allocated(InData%SStCfiles)) + if (allocated(InData%SStCfiles)) then + call RegPackBounds(Buf, 1, lbound(InData%SStCfiles), ubound(InData%SStCfiles)) + call RegPack(Buf, InData%SStCfiles) + end if + call RegPack(Buf, InData%AfCmode) + call RegPack(Buf, InData%AfC_Mean) + call RegPack(Buf, InData%AfC_Amp) + call RegPack(Buf, InData%AfC_Phase) + call RegPack(Buf, InData%CCmode) + call RegPack(Buf, InData%EXavrSWAP) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackInputFile' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PCMode) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TPCOn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TPitManS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PitManRat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BlPitchF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VSContrl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenModel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenEff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenTiStr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenTiStp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SpdGenOn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TimGenOn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TimGenOf) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VS_RtGnSp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VS_RtTq) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VS_Rgn2K) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VS_SlPc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SIG_SlPc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SIG_SySp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SIG_RtTq) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SIG_PORt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_Freq) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_NPol) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_SRes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_RRes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_VLL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_SLR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_RLR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_MR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HSSBrMode) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%THSSBrDp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HSSBrDT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HSSBrTqF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YCMode) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TYCOn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawNeut) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawDamp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TYawManS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawManRat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacYawF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TabDelim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Tstart) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%DLL_FileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DLL_ProcName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DLL_InFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DLL_DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DLL_Ramp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BPCutoff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacYaw_North) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ptch_Cntrl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ptch_SetPnt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ptch_Min) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ptch_Max) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtchRate_Min) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtchRate_Max) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gain_OM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenSpd_MinOM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenSpd_MaxOM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenSpd_Dem) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenTrq_Dem) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenPwr_Dem) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DLL_NumTrq) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%GenSpd_TLU)) deallocate(OutData%GenSpd_TLU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GenSpd_TLU(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GenSpd_TLU) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%GenTrq_TLU)) deallocate(OutData%GenTrq_TLU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GenTrq_TLU(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GenTrq_TLU) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%UseLegacyInterface) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBStC) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BStCfiles)) deallocate(OutData%BStCfiles) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStCfiles(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCfiles.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BStCfiles) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NumNStC) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%NStCfiles)) deallocate(OutData%NStCfiles) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStCfiles(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCfiles.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NStCfiles) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NumTStC) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TStCfiles)) deallocate(OutData%TStCfiles) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStCfiles(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCfiles.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TStCfiles) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NumSStC) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%SStCfiles)) deallocate(OutData%SStCfiles) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStCfiles(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCfiles.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SStCfiles) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%AfCmode) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AfC_Mean) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AfC_Amp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AfC_Phase) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CCmode) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EXavrSWAP) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, CtrlCode, ErrStat, ErrMsg) + type(BladedDLLType), intent(in) :: SrcBladedDLLTypeData + type(BladedDLLType), intent(inout) :: DstBladedDLLTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyBladedDLLType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcBladedDLLTypeData%avrSWAP)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%avrSWAP) + UB(1:1) = ubound(SrcBladedDLLTypeData%avrSWAP) + if (.not. allocated(DstBladedDLLTypeData%avrSWAP)) then + allocate(DstBladedDLLTypeData%avrSWAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%avrSWAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%avrSWAP = SrcBladedDLLTypeData%avrSWAP + end if + DstBladedDLLTypeData%HSSBrTrqDemand = SrcBladedDLLTypeData%HSSBrTrqDemand + DstBladedDLLTypeData%YawRateCom = SrcBladedDLLTypeData%YawRateCom + DstBladedDLLTypeData%GenTrq = SrcBladedDLLTypeData%GenTrq + DstBladedDLLTypeData%GenState = SrcBladedDLLTypeData%GenState + DstBladedDLLTypeData%BlPitchCom = SrcBladedDLLTypeData%BlPitchCom + DstBladedDLLTypeData%PrevBlPitch = SrcBladedDLLTypeData%PrevBlPitch + DstBladedDLLTypeData%BlAirfoilCom = SrcBladedDLLTypeData%BlAirfoilCom + DstBladedDLLTypeData%PrevBlAirfoilCom = SrcBladedDLLTypeData%PrevBlAirfoilCom + DstBladedDLLTypeData%ElecPwr_prev = SrcBladedDLLTypeData%ElecPwr_prev + DstBladedDLLTypeData%GenTrq_prev = SrcBladedDLLTypeData%GenTrq_prev + if (allocated(SrcBladedDLLTypeData%toSC)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%toSC) + UB(1:1) = ubound(SrcBladedDLLTypeData%toSC) + if (.not. allocated(DstBladedDLLTypeData%toSC)) then + allocate(DstBladedDLLTypeData%toSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%toSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%toSC = SrcBladedDLLTypeData%toSC + end if + DstBladedDLLTypeData%initialized = SrcBladedDLLTypeData%initialized + DstBladedDLLTypeData%NumLogChannels = SrcBladedDLLTypeData%NumLogChannels + if (allocated(SrcBladedDLLTypeData%LogChannels_OutParam)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels_OutParam) + UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels_OutParam) + if (.not. allocated(DstBladedDLLTypeData%LogChannels_OutParam)) then + allocate(DstBladedDLLTypeData%LogChannels_OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels_OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcBladedDLLTypeData%LogChannels_OutParam(i1), DstBladedDLLTypeData%LogChannels_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcBladedDLLTypeData%LogChannels)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels) + UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels) + if (.not. allocated(DstBladedDLLTypeData%LogChannels)) then + allocate(DstBladedDLLTypeData%LogChannels(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%LogChannels = SrcBladedDLLTypeData%LogChannels + end if + DstBladedDLLTypeData%ErrStat = SrcBladedDLLTypeData%ErrStat + DstBladedDLLTypeData%ErrMsg = SrcBladedDLLTypeData%ErrMsg + DstBladedDLLTypeData%CurrentTime = SrcBladedDLLTypeData%CurrentTime + DstBladedDLLTypeData%SimStatus = SrcBladedDLLTypeData%SimStatus + DstBladedDLLTypeData%ShaftBrakeStatusBinaryFlag = SrcBladedDLLTypeData%ShaftBrakeStatusBinaryFlag + DstBladedDLLTypeData%HSSBrDeployed = SrcBladedDLLTypeData%HSSBrDeployed + DstBladedDLLTypeData%TimeHSSBrFullyDeployed = SrcBladedDLLTypeData%TimeHSSBrFullyDeployed + DstBladedDLLTypeData%TimeHSSBrDeployed = SrcBladedDLLTypeData%TimeHSSBrDeployed + DstBladedDLLTypeData%OverrideYawRateWithTorque = SrcBladedDLLTypeData%OverrideYawRateWithTorque + DstBladedDLLTypeData%YawTorqueDemand = SrcBladedDLLTypeData%YawTorqueDemand + if (allocated(SrcBladedDLLTypeData%BlPitchInput)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%BlPitchInput) + UB(1:1) = ubound(SrcBladedDLLTypeData%BlPitchInput) + if (.not. allocated(DstBladedDLLTypeData%BlPitchInput)) then + allocate(DstBladedDLLTypeData%BlPitchInput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%BlPitchInput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%BlPitchInput = SrcBladedDLLTypeData%BlPitchInput + end if + DstBladedDLLTypeData%YawAngleFromNorth = SrcBladedDLLTypeData%YawAngleFromNorth + DstBladedDLLTypeData%HorWindV = SrcBladedDLLTypeData%HorWindV + DstBladedDLLTypeData%HSS_Spd = SrcBladedDLLTypeData%HSS_Spd + DstBladedDLLTypeData%YawErr = SrcBladedDLLTypeData%YawErr + DstBladedDLLTypeData%RotSpeed = SrcBladedDLLTypeData%RotSpeed + DstBladedDLLTypeData%YawBrTAxp = SrcBladedDLLTypeData%YawBrTAxp + DstBladedDLLTypeData%YawBrTAyp = SrcBladedDLLTypeData%YawBrTAyp + DstBladedDLLTypeData%LSSTipMys = SrcBladedDLLTypeData%LSSTipMys + DstBladedDLLTypeData%LSSTipMzs = SrcBladedDLLTypeData%LSSTipMzs + DstBladedDLLTypeData%LSSTipMya = SrcBladedDLLTypeData%LSSTipMya + DstBladedDLLTypeData%LSSTipMza = SrcBladedDLLTypeData%LSSTipMza + DstBladedDLLTypeData%LSSTipPxa = SrcBladedDLLTypeData%LSSTipPxa + DstBladedDLLTypeData%Yaw = SrcBladedDLLTypeData%Yaw + DstBladedDLLTypeData%YawRate = SrcBladedDLLTypeData%YawRate + DstBladedDLLTypeData%YawBrMyn = SrcBladedDLLTypeData%YawBrMyn + DstBladedDLLTypeData%YawBrMzn = SrcBladedDLLTypeData%YawBrMzn + DstBladedDLLTypeData%NcIMURAxs = SrcBladedDLLTypeData%NcIMURAxs + DstBladedDLLTypeData%NcIMURAys = SrcBladedDLLTypeData%NcIMURAys + DstBladedDLLTypeData%NcIMURAzs = SrcBladedDLLTypeData%NcIMURAzs + DstBladedDLLTypeData%RotPwr = SrcBladedDLLTypeData%RotPwr + DstBladedDLLTypeData%LSSTipMxa = SrcBladedDLLTypeData%LSSTipMxa + DstBladedDLLTypeData%RootMyc = SrcBladedDLLTypeData%RootMyc + DstBladedDLLTypeData%RootMxc = SrcBladedDLLTypeData%RootMxc + DstBladedDLLTypeData%LSShftFxa = SrcBladedDLLTypeData%LSShftFxa + DstBladedDLLTypeData%LSShftFys = SrcBladedDLLTypeData%LSShftFys + DstBladedDLLTypeData%LSShftFzs = SrcBladedDLLTypeData%LSShftFzs + if (allocated(SrcBladedDLLTypeData%LidSpeed)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%LidSpeed) + UB(1:1) = ubound(SrcBladedDLLTypeData%LidSpeed) + if (.not. allocated(DstBladedDLLTypeData%LidSpeed)) then + allocate(DstBladedDLLTypeData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LidSpeed.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%LidSpeed = SrcBladedDLLTypeData%LidSpeed + end if + if (allocated(SrcBladedDLLTypeData%MsrPositionsX)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsX) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsX) + if (.not. allocated(DstBladedDLLTypeData%MsrPositionsX)) then + allocate(DstBladedDLLTypeData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%MsrPositionsX = SrcBladedDLLTypeData%MsrPositionsX + end if + if (allocated(SrcBladedDLLTypeData%MsrPositionsY)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsY) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsY) + if (.not. allocated(DstBladedDLLTypeData%MsrPositionsY)) then + allocate(DstBladedDLLTypeData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%MsrPositionsY = SrcBladedDLLTypeData%MsrPositionsY + end if + if (allocated(SrcBladedDLLTypeData%MsrPositionsZ)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsZ) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsZ) + if (.not. allocated(DstBladedDLLTypeData%MsrPositionsZ)) then + allocate(DstBladedDLLTypeData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%MsrPositionsZ = SrcBladedDLLTypeData%MsrPositionsZ + end if + DstBladedDLLTypeData%SensorType = SrcBladedDLLTypeData%SensorType + DstBladedDLLTypeData%NumBeam = SrcBladedDLLTypeData%NumBeam + DstBladedDLLTypeData%NumPulseGate = SrcBladedDLLTypeData%NumPulseGate + DstBladedDLLTypeData%PulseSpacing = SrcBladedDLLTypeData%PulseSpacing + DstBladedDLLTypeData%URefLid = SrcBladedDLLTypeData%URefLid + DstBladedDLLTypeData%DLL_DT = SrcBladedDLLTypeData%DLL_DT + DstBladedDLLTypeData%DLL_InFile = SrcBladedDLLTypeData%DLL_InFile + DstBladedDLLTypeData%RootName = SrcBladedDLLTypeData%RootName + DstBladedDLLTypeData%GenTrq_Dem = SrcBladedDLLTypeData%GenTrq_Dem + DstBladedDLLTypeData%GenSpd_Dem = SrcBladedDLLTypeData%GenSpd_Dem + DstBladedDLLTypeData%Ptch_Max = SrcBladedDLLTypeData%Ptch_Max + DstBladedDLLTypeData%Ptch_Min = SrcBladedDLLTypeData%Ptch_Min + DstBladedDLLTypeData%Ptch_SetPnt = SrcBladedDLLTypeData%Ptch_SetPnt + DstBladedDLLTypeData%PtchRate_Max = SrcBladedDLLTypeData%PtchRate_Max + DstBladedDLLTypeData%PtchRate_Min = SrcBladedDLLTypeData%PtchRate_Min + DstBladedDLLTypeData%GenPwr_Dem = SrcBladedDLLTypeData%GenPwr_Dem + DstBladedDLLTypeData%Gain_OM = SrcBladedDLLTypeData%Gain_OM + DstBladedDLLTypeData%GenSpd_MaxOM = SrcBladedDLLTypeData%GenSpd_MaxOM + DstBladedDLLTypeData%GenSpd_MinOM = SrcBladedDLLTypeData%GenSpd_MinOM + DstBladedDLLTypeData%Ptch_Cntrl = SrcBladedDLLTypeData%Ptch_Cntrl + DstBladedDLLTypeData%DLL_NumTrq = SrcBladedDLLTypeData%DLL_NumTrq + if (allocated(SrcBladedDLLTypeData%GenSpd_TLU)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%GenSpd_TLU) + UB(1:1) = ubound(SrcBladedDLLTypeData%GenSpd_TLU) + if (.not. allocated(DstBladedDLLTypeData%GenSpd_TLU)) then + allocate(DstBladedDLLTypeData%GenSpd_TLU(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenSpd_TLU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%GenSpd_TLU = SrcBladedDLLTypeData%GenSpd_TLU + end if + if (allocated(SrcBladedDLLTypeData%GenTrq_TLU)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%GenTrq_TLU) + UB(1:1) = ubound(SrcBladedDLLTypeData%GenTrq_TLU) + if (.not. allocated(DstBladedDLLTypeData%GenTrq_TLU)) then + allocate(DstBladedDLLTypeData%GenTrq_TLU(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenTrq_TLU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%GenTrq_TLU = SrcBladedDLLTypeData%GenTrq_TLU + end if + DstBladedDLLTypeData%Yaw_Cntrl = SrcBladedDLLTypeData%Yaw_Cntrl + if (allocated(SrcBladedDLLTypeData%PrevCableDeltaL)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaL) + UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaL) + if (.not. allocated(DstBladedDLLTypeData%PrevCableDeltaL)) then + allocate(DstBladedDLLTypeData%PrevCableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevCableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevCableDeltaL = SrcBladedDLLTypeData%PrevCableDeltaL + end if + if (allocated(SrcBladedDLLTypeData%PrevCableDeltaLdot)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaLdot) + UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaLdot) + if (.not. allocated(DstBladedDLLTypeData%PrevCableDeltaLdot)) then + allocate(DstBladedDLLTypeData%PrevCableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevCableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevCableDeltaLdot = SrcBladedDLLTypeData%PrevCableDeltaLdot + end if + if (allocated(SrcBladedDLLTypeData%CableDeltaL)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaL) + UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaL) + if (.not. allocated(DstBladedDLLTypeData%CableDeltaL)) then + allocate(DstBladedDLLTypeData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%CableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%CableDeltaL = SrcBladedDLLTypeData%CableDeltaL + end if + if (allocated(SrcBladedDLLTypeData%CableDeltaLdot)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaLdot) + UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaLdot) + if (.not. allocated(DstBladedDLLTypeData%CableDeltaLdot)) then + allocate(DstBladedDLLTypeData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%CableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%CableDeltaLdot = SrcBladedDLLTypeData%CableDeltaLdot + end if + if (allocated(SrcBladedDLLTypeData%PrevStCCmdStiff)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdStiff) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdStiff) + if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdStiff)) then + allocate(DstBladedDLLTypeData%PrevStCCmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevStCCmdStiff = SrcBladedDLLTypeData%PrevStCCmdStiff + end if + if (allocated(SrcBladedDLLTypeData%PrevStCCmdDamp)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdDamp) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdDamp) + if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdDamp)) then + allocate(DstBladedDLLTypeData%PrevStCCmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevStCCmdDamp = SrcBladedDLLTypeData%PrevStCCmdDamp + end if + if (allocated(SrcBladedDLLTypeData%PrevStCCmdBrake)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdBrake) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdBrake) + if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdBrake)) then + allocate(DstBladedDLLTypeData%PrevStCCmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdBrake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevStCCmdBrake = SrcBladedDLLTypeData%PrevStCCmdBrake + end if + if (allocated(SrcBladedDLLTypeData%PrevStCCmdForce)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdForce) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdForce) + if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdForce)) then + allocate(DstBladedDLLTypeData%PrevStCCmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevStCCmdForce = SrcBladedDLLTypeData%PrevStCCmdForce + end if + if (allocated(SrcBladedDLLTypeData%StCCmdStiff)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdStiff) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdStiff) + if (.not. allocated(DstBladedDLLTypeData%StCCmdStiff)) then + allocate(DstBladedDLLTypeData%StCCmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCCmdStiff = SrcBladedDLLTypeData%StCCmdStiff + end if + if (allocated(SrcBladedDLLTypeData%StCCmdDamp)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdDamp) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdDamp) + if (.not. allocated(DstBladedDLLTypeData%StCCmdDamp)) then + allocate(DstBladedDLLTypeData%StCCmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCCmdDamp = SrcBladedDLLTypeData%StCCmdDamp + end if + if (allocated(SrcBladedDLLTypeData%StCCmdBrake)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdBrake) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdBrake) + if (.not. allocated(DstBladedDLLTypeData%StCCmdBrake)) then + allocate(DstBladedDLLTypeData%StCCmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdBrake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCCmdBrake = SrcBladedDLLTypeData%StCCmdBrake + end if + if (allocated(SrcBladedDLLTypeData%StCCmdForce)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdForce) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdForce) + if (.not. allocated(DstBladedDLLTypeData%StCCmdForce)) then + allocate(DstBladedDLLTypeData%StCCmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCCmdForce = SrcBladedDLLTypeData%StCCmdForce + end if + if (allocated(SrcBladedDLLTypeData%StCMeasDisp)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasDisp) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasDisp) + if (.not. allocated(DstBladedDLLTypeData%StCMeasDisp)) then + allocate(DstBladedDLLTypeData%StCMeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCMeasDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCMeasDisp = SrcBladedDLLTypeData%StCMeasDisp + end if + if (allocated(SrcBladedDLLTypeData%StCMeasVel)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasVel) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasVel) + if (.not. allocated(DstBladedDLLTypeData%StCMeasVel)) then + allocate(DstBladedDLLTypeData%StCMeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCMeasVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCMeasVel = SrcBladedDLLTypeData%StCMeasVel + end if +end subroutine + +subroutine SrvD_DestroyBladedDLLType(BladedDLLTypeData, ErrStat, ErrMsg) + type(BladedDLLType), intent(inout) :: BladedDLLTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyBladedDLLType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladedDLLTypeData%avrSWAP)) then + deallocate(BladedDLLTypeData%avrSWAP) + end if + if (allocated(BladedDLLTypeData%toSC)) then + deallocate(BladedDLLTypeData%toSC) + end if + if (allocated(BladedDLLTypeData%LogChannels_OutParam)) then + LB(1:1) = lbound(BladedDLLTypeData%LogChannels_OutParam) + UB(1:1) = ubound(BladedDLLTypeData%LogChannels_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(BladedDLLTypeData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BladedDLLTypeData%LogChannels_OutParam) + end if + if (allocated(BladedDLLTypeData%LogChannels)) then + deallocate(BladedDLLTypeData%LogChannels) + end if + if (allocated(BladedDLLTypeData%BlPitchInput)) then + deallocate(BladedDLLTypeData%BlPitchInput) + end if + if (allocated(BladedDLLTypeData%LidSpeed)) then + deallocate(BladedDLLTypeData%LidSpeed) + end if + if (allocated(BladedDLLTypeData%MsrPositionsX)) then + deallocate(BladedDLLTypeData%MsrPositionsX) + end if + if (allocated(BladedDLLTypeData%MsrPositionsY)) then + deallocate(BladedDLLTypeData%MsrPositionsY) + end if + if (allocated(BladedDLLTypeData%MsrPositionsZ)) then + deallocate(BladedDLLTypeData%MsrPositionsZ) + end if + if (allocated(BladedDLLTypeData%GenSpd_TLU)) then + deallocate(BladedDLLTypeData%GenSpd_TLU) + end if + if (allocated(BladedDLLTypeData%GenTrq_TLU)) then + deallocate(BladedDLLTypeData%GenTrq_TLU) + end if + if (allocated(BladedDLLTypeData%PrevCableDeltaL)) then + deallocate(BladedDLLTypeData%PrevCableDeltaL) + end if + if (allocated(BladedDLLTypeData%PrevCableDeltaLdot)) then + deallocate(BladedDLLTypeData%PrevCableDeltaLdot) + end if + if (allocated(BladedDLLTypeData%CableDeltaL)) then + deallocate(BladedDLLTypeData%CableDeltaL) + end if + if (allocated(BladedDLLTypeData%CableDeltaLdot)) then + deallocate(BladedDLLTypeData%CableDeltaLdot) + end if + if (allocated(BladedDLLTypeData%PrevStCCmdStiff)) then + deallocate(BladedDLLTypeData%PrevStCCmdStiff) + end if + if (allocated(BladedDLLTypeData%PrevStCCmdDamp)) then + deallocate(BladedDLLTypeData%PrevStCCmdDamp) + end if + if (allocated(BladedDLLTypeData%PrevStCCmdBrake)) then + deallocate(BladedDLLTypeData%PrevStCCmdBrake) + end if + if (allocated(BladedDLLTypeData%PrevStCCmdForce)) then + deallocate(BladedDLLTypeData%PrevStCCmdForce) + end if + if (allocated(BladedDLLTypeData%StCCmdStiff)) then + deallocate(BladedDLLTypeData%StCCmdStiff) + end if + if (allocated(BladedDLLTypeData%StCCmdDamp)) then + deallocate(BladedDLLTypeData%StCCmdDamp) + end if + if (allocated(BladedDLLTypeData%StCCmdBrake)) then + deallocate(BladedDLLTypeData%StCCmdBrake) + end if + if (allocated(BladedDLLTypeData%StCCmdForce)) then + deallocate(BladedDLLTypeData%StCCmdForce) + end if + if (allocated(BladedDLLTypeData%StCMeasDisp)) then + deallocate(BladedDLLTypeData%StCMeasDisp) + end if + if (allocated(BladedDLLTypeData%StCMeasVel)) then + deallocate(BladedDLLTypeData%StCMeasVel) + end if +end subroutine + +subroutine SrvD_PackBladedDLLType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BladedDLLType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackBladedDLLType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%avrSWAP)) + if (allocated(InData%avrSWAP)) then + call RegPackBounds(Buf, 1, lbound(InData%avrSWAP), ubound(InData%avrSWAP)) + call RegPack(Buf, InData%avrSWAP) + end if + call RegPack(Buf, InData%HSSBrTrqDemand) + call RegPack(Buf, InData%YawRateCom) + call RegPack(Buf, InData%GenTrq) + call RegPack(Buf, InData%GenState) + call RegPack(Buf, InData%BlPitchCom) + call RegPack(Buf, InData%PrevBlPitch) + call RegPack(Buf, InData%BlAirfoilCom) + call RegPack(Buf, InData%PrevBlAirfoilCom) + call RegPack(Buf, InData%ElecPwr_prev) + call RegPack(Buf, InData%GenTrq_prev) + call RegPack(Buf, allocated(InData%toSC)) + if (allocated(InData%toSC)) then + call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) + call RegPack(Buf, InData%toSC) + end if + call RegPack(Buf, InData%initialized) + call RegPack(Buf, InData%NumLogChannels) + call RegPack(Buf, allocated(InData%LogChannels_OutParam)) + if (allocated(InData%LogChannels_OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%LogChannels_OutParam), ubound(InData%LogChannels_OutParam)) + LB(1:1) = lbound(InData%LogChannels_OutParam) + UB(1:1) = ubound(InData%LogChannels_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%LogChannels_OutParam(i1)) + end do + end if + call RegPack(Buf, allocated(InData%LogChannels)) + if (allocated(InData%LogChannels)) then + call RegPackBounds(Buf, 1, lbound(InData%LogChannels), ubound(InData%LogChannels)) + call RegPack(Buf, InData%LogChannels) + end if + call RegPack(Buf, InData%ErrStat) + call RegPack(Buf, InData%ErrMsg) + call RegPack(Buf, InData%CurrentTime) + call RegPack(Buf, InData%SimStatus) + call RegPack(Buf, InData%ShaftBrakeStatusBinaryFlag) + call RegPack(Buf, InData%HSSBrDeployed) + call RegPack(Buf, InData%TimeHSSBrFullyDeployed) + call RegPack(Buf, InData%TimeHSSBrDeployed) + call RegPack(Buf, InData%OverrideYawRateWithTorque) + call RegPack(Buf, InData%YawTorqueDemand) + call RegPack(Buf, allocated(InData%BlPitchInput)) + if (allocated(InData%BlPitchInput)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitchInput), ubound(InData%BlPitchInput)) + call RegPack(Buf, InData%BlPitchInput) + end if + call RegPack(Buf, InData%YawAngleFromNorth) + call RegPack(Buf, InData%HorWindV) + call RegPack(Buf, InData%HSS_Spd) + call RegPack(Buf, InData%YawErr) + call RegPack(Buf, InData%RotSpeed) + call RegPack(Buf, InData%YawBrTAxp) + call RegPack(Buf, InData%YawBrTAyp) + call RegPack(Buf, InData%LSSTipMys) + call RegPack(Buf, InData%LSSTipMzs) + call RegPack(Buf, InData%LSSTipMya) + call RegPack(Buf, InData%LSSTipMza) + call RegPack(Buf, InData%LSSTipPxa) + call RegPack(Buf, InData%Yaw) + call RegPack(Buf, InData%YawRate) + call RegPack(Buf, InData%YawBrMyn) + call RegPack(Buf, InData%YawBrMzn) + call RegPack(Buf, InData%NcIMURAxs) + call RegPack(Buf, InData%NcIMURAys) + call RegPack(Buf, InData%NcIMURAzs) + call RegPack(Buf, InData%RotPwr) + call RegPack(Buf, InData%LSSTipMxa) + call RegPack(Buf, InData%RootMyc) + call RegPack(Buf, InData%RootMxc) + call RegPack(Buf, InData%LSShftFxa) + call RegPack(Buf, InData%LSShftFys) + call RegPack(Buf, InData%LSShftFzs) + call RegPack(Buf, allocated(InData%LidSpeed)) + if (allocated(InData%LidSpeed)) then + call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) + call RegPack(Buf, InData%LidSpeed) + end if + call RegPack(Buf, allocated(InData%MsrPositionsX)) + if (allocated(InData%MsrPositionsX)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) + call RegPack(Buf, InData%MsrPositionsX) + end if + call RegPack(Buf, allocated(InData%MsrPositionsY)) + if (allocated(InData%MsrPositionsY)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) + call RegPack(Buf, InData%MsrPositionsY) + end if + call RegPack(Buf, allocated(InData%MsrPositionsZ)) + if (allocated(InData%MsrPositionsZ)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) + call RegPack(Buf, InData%MsrPositionsZ) + end if + call RegPack(Buf, InData%SensorType) + call RegPack(Buf, InData%NumBeam) + call RegPack(Buf, InData%NumPulseGate) + call RegPack(Buf, InData%PulseSpacing) + call RegPack(Buf, InData%URefLid) + call RegPack(Buf, InData%DLL_DT) + call RegPack(Buf, InData%DLL_InFile) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%GenTrq_Dem) + call RegPack(Buf, InData%GenSpd_Dem) + call RegPack(Buf, InData%Ptch_Max) + call RegPack(Buf, InData%Ptch_Min) + call RegPack(Buf, InData%Ptch_SetPnt) + call RegPack(Buf, InData%PtchRate_Max) + call RegPack(Buf, InData%PtchRate_Min) + call RegPack(Buf, InData%GenPwr_Dem) + call RegPack(Buf, InData%Gain_OM) + call RegPack(Buf, InData%GenSpd_MaxOM) + call RegPack(Buf, InData%GenSpd_MinOM) + call RegPack(Buf, InData%Ptch_Cntrl) + call RegPack(Buf, InData%DLL_NumTrq) + call RegPack(Buf, allocated(InData%GenSpd_TLU)) + if (allocated(InData%GenSpd_TLU)) then + call RegPackBounds(Buf, 1, lbound(InData%GenSpd_TLU), ubound(InData%GenSpd_TLU)) + call RegPack(Buf, InData%GenSpd_TLU) + end if + call RegPack(Buf, allocated(InData%GenTrq_TLU)) + if (allocated(InData%GenTrq_TLU)) then + call RegPackBounds(Buf, 1, lbound(InData%GenTrq_TLU), ubound(InData%GenTrq_TLU)) + call RegPack(Buf, InData%GenTrq_TLU) + end if + call RegPack(Buf, InData%Yaw_Cntrl) + call RegPack(Buf, allocated(InData%PrevCableDeltaL)) + if (allocated(InData%PrevCableDeltaL)) then + call RegPackBounds(Buf, 1, lbound(InData%PrevCableDeltaL), ubound(InData%PrevCableDeltaL)) + call RegPack(Buf, InData%PrevCableDeltaL) + end if + call RegPack(Buf, allocated(InData%PrevCableDeltaLdot)) + if (allocated(InData%PrevCableDeltaLdot)) then + call RegPackBounds(Buf, 1, lbound(InData%PrevCableDeltaLdot), ubound(InData%PrevCableDeltaLdot)) + call RegPack(Buf, InData%PrevCableDeltaLdot) + end if + call RegPack(Buf, allocated(InData%CableDeltaL)) + if (allocated(InData%CableDeltaL)) then + call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL), ubound(InData%CableDeltaL)) + call RegPack(Buf, InData%CableDeltaL) + end if + call RegPack(Buf, allocated(InData%CableDeltaLdot)) + if (allocated(InData%CableDeltaLdot)) then + call RegPackBounds(Buf, 1, lbound(InData%CableDeltaLdot), ubound(InData%CableDeltaLdot)) + call RegPack(Buf, InData%CableDeltaLdot) + end if + call RegPack(Buf, allocated(InData%PrevStCCmdStiff)) + if (allocated(InData%PrevStCCmdStiff)) then + call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdStiff), ubound(InData%PrevStCCmdStiff)) + call RegPack(Buf, InData%PrevStCCmdStiff) + end if + call RegPack(Buf, allocated(InData%PrevStCCmdDamp)) + if (allocated(InData%PrevStCCmdDamp)) then + call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdDamp), ubound(InData%PrevStCCmdDamp)) + call RegPack(Buf, InData%PrevStCCmdDamp) + end if + call RegPack(Buf, allocated(InData%PrevStCCmdBrake)) + if (allocated(InData%PrevStCCmdBrake)) then + call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdBrake), ubound(InData%PrevStCCmdBrake)) + call RegPack(Buf, InData%PrevStCCmdBrake) + end if + call RegPack(Buf, allocated(InData%PrevStCCmdForce)) + if (allocated(InData%PrevStCCmdForce)) then + call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdForce), ubound(InData%PrevStCCmdForce)) + call RegPack(Buf, InData%PrevStCCmdForce) + end if + call RegPack(Buf, allocated(InData%StCCmdStiff)) + if (allocated(InData%StCCmdStiff)) then + call RegPackBounds(Buf, 2, lbound(InData%StCCmdStiff), ubound(InData%StCCmdStiff)) + call RegPack(Buf, InData%StCCmdStiff) + end if + call RegPack(Buf, allocated(InData%StCCmdDamp)) + if (allocated(InData%StCCmdDamp)) then + call RegPackBounds(Buf, 2, lbound(InData%StCCmdDamp), ubound(InData%StCCmdDamp)) + call RegPack(Buf, InData%StCCmdDamp) + end if + call RegPack(Buf, allocated(InData%StCCmdBrake)) + if (allocated(InData%StCCmdBrake)) then + call RegPackBounds(Buf, 2, lbound(InData%StCCmdBrake), ubound(InData%StCCmdBrake)) + call RegPack(Buf, InData%StCCmdBrake) + end if + call RegPack(Buf, allocated(InData%StCCmdForce)) + if (allocated(InData%StCCmdForce)) then + call RegPackBounds(Buf, 2, lbound(InData%StCCmdForce), ubound(InData%StCCmdForce)) + call RegPack(Buf, InData%StCCmdForce) + end if + call RegPack(Buf, allocated(InData%StCMeasDisp)) + if (allocated(InData%StCMeasDisp)) then + call RegPackBounds(Buf, 2, lbound(InData%StCMeasDisp), ubound(InData%StCMeasDisp)) + call RegPack(Buf, InData%StCMeasDisp) + end if + call RegPack(Buf, allocated(InData%StCMeasVel)) + if (allocated(InData%StCMeasVel)) then + call RegPackBounds(Buf, 2, lbound(InData%StCMeasVel), ubound(InData%StCMeasVel)) + call RegPack(Buf, InData%StCMeasVel) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackBladedDLLType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BladedDLLType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackBladedDLLType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%avrSWAP)) deallocate(OutData%avrSWAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%avrSWAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%avrSWAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%avrSWAP) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%HSSBrTrqDemand) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawRateCom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenTrq) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenState) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BlPitchCom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PrevBlPitch) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BlAirfoilCom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PrevBlAirfoilCom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ElecPwr_prev) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenTrq_prev) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%toSC)) deallocate(OutData%toSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%toSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%toSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%initialized) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumLogChannels) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%LogChannels_OutParam)) deallocate(OutData%LogChannels_OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LogChannels_OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels_OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%LogChannels_OutParam(i1)) ! LogChannels_OutParam + end do + end if + if (allocated(OutData%LogChannels)) deallocate(OutData%LogChannels) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LogChannels(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LogChannels) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%ErrStat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ErrMsg) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CurrentTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SimStatus) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ShaftBrakeStatusBinaryFlag) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HSSBrDeployed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TimeHSSBrFullyDeployed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TimeHSSBrDeployed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OverrideYawRateWithTorque) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawTorqueDemand) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BlPitchInput)) deallocate(OutData%BlPitchInput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitchInput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitchInput) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%YawAngleFromNorth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HorWindV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HSS_Spd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawErr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawBrTAxp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawBrTAyp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipMys) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipMzs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipMya) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipMza) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipPxa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Yaw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawRate) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawBrMyn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawBrMzn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NcIMURAxs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NcIMURAys) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NcIMURAzs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotPwr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipMxa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootMyc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootMxc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSShftFxa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSShftFys) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSShftFzs) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LidSpeed(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LidSpeed) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsY) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBeam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PulseSpacing) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DLL_DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DLL_InFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenTrq_Dem) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenSpd_Dem) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ptch_Max) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ptch_Min) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ptch_SetPnt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtchRate_Max) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PtchRate_Min) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenPwr_Dem) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gain_OM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenSpd_MaxOM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenSpd_MinOM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ptch_Cntrl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DLL_NumTrq) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%GenSpd_TLU)) deallocate(OutData%GenSpd_TLU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GenSpd_TLU(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GenSpd_TLU) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%GenTrq_TLU)) deallocate(OutData%GenTrq_TLU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GenTrq_TLU(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GenTrq_TLU) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Yaw_Cntrl) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%PrevCableDeltaL)) deallocate(OutData%PrevCableDeltaL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PrevCableDeltaL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevCableDeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PrevCableDeltaL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PrevCableDeltaLdot)) deallocate(OutData%PrevCableDeltaLdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PrevCableDeltaLdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevCableDeltaLdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PrevCableDeltaLdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CableDeltaL)) deallocate(OutData%CableDeltaL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableDeltaL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableDeltaL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CableDeltaLdot)) deallocate(OutData%CableDeltaLdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableDeltaLdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaLdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableDeltaLdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PrevStCCmdStiff)) deallocate(OutData%PrevStCCmdStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PrevStCCmdStiff(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PrevStCCmdStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PrevStCCmdDamp)) deallocate(OutData%PrevStCCmdDamp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PrevStCCmdDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PrevStCCmdDamp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PrevStCCmdBrake)) deallocate(OutData%PrevStCCmdBrake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PrevStCCmdBrake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdBrake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PrevStCCmdBrake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PrevStCCmdForce)) deallocate(OutData%PrevStCCmdForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PrevStCCmdForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PrevStCCmdForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StCCmdStiff)) deallocate(OutData%StCCmdStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StCCmdStiff(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StCCmdStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StCCmdDamp)) deallocate(OutData%StCCmdDamp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StCCmdDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StCCmdDamp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StCCmdBrake)) deallocate(OutData%StCCmdBrake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StCCmdBrake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdBrake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StCCmdBrake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StCCmdForce)) deallocate(OutData%StCCmdForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StCCmdForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StCCmdForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StCMeasDisp)) deallocate(OutData%StCMeasDisp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StCMeasDisp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StCMeasDisp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StCMeasVel)) deallocate(OutData%StCMeasVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StCMeasVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StCMeasVel) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_ContinuousStateType), intent(in) :: SrcContStateData + type(SrvD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState + if (allocated(SrcContStateData%BStC)) then + LB(1:1) = lbound(SrcContStateData%BStC) + UB(1:1) = ubound(SrcContStateData%BStC) + if (.not. allocated(DstContStateData%BStC)) then + allocate(DstContStateData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyContState(SrcContStateData%BStC(i1), DstContStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcContStateData%NStC)) then + LB(1:1) = lbound(SrcContStateData%NStC) + UB(1:1) = ubound(SrcContStateData%NStC) + if (.not. allocated(DstContStateData%NStC)) then + allocate(DstContStateData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyContState(SrcContStateData%NStC(i1), DstContStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcContStateData%TStC)) then + LB(1:1) = lbound(SrcContStateData%TStC) + UB(1:1) = ubound(SrcContStateData%TStC) + if (.not. allocated(DstContStateData%TStC)) then + allocate(DstContStateData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyContState(SrcContStateData%TStC(i1), DstContStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcContStateData%SStC)) then + LB(1:1) = lbound(SrcContStateData%SStC) + UB(1:1) = ubound(SrcContStateData%SStC) + if (.not. allocated(DstContStateData%SStC)) then + allocate(DstContStateData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyContState(SrcContStateData%SStC(i1), DstContStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SrvD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%BStC)) then + LB(1:1) = lbound(ContStateData%BStC) + UB(1:1) = ubound(ContStateData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyContState(ContStateData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%BStC) + end if + if (allocated(ContStateData%NStC)) then + LB(1:1) = lbound(ContStateData%NStC) + UB(1:1) = ubound(ContStateData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyContState(ContStateData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%NStC) + end if + if (allocated(ContStateData%TStC)) then + LB(1:1) = lbound(ContStateData%TStC) + UB(1:1) = ubound(ContStateData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyContState(ContStateData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%TStC) + end if + if (allocated(ContStateData%SStC)) then + LB(1:1) = lbound(ContStateData%SStC) + UB(1:1) = ubound(ContStateData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyContState(ContStateData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%SStC) + end if +end subroutine + +subroutine SrvD_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyContState) + call RegPack(Buf, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackContState(Buf, InData%BStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackContState(Buf, InData%NStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackContState(Buf, InData%TStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackContState(Buf, InData%SStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackContState(Buf, OutData%BStC(i1)) ! BStC + end do + end if + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackContState(Buf, OutData%NStC(i1)) ! NStC + end do + end if + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackContState(Buf, OutData%TStC(i1)) ! TStC + end do + end if + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackContState(Buf, OutData%SStC(i1)) ! SStC + end do + end if +end subroutine + +subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SrvD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%CtrlOffset = SrcDiscStateData%CtrlOffset + if (allocated(SrcDiscStateData%BStC)) then + LB(1:1) = lbound(SrcDiscStateData%BStC) + UB(1:1) = ubound(SrcDiscStateData%BStC) + if (.not. allocated(DstDiscStateData%BStC)) then + allocate(DstDiscStateData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyDiscState(SrcDiscStateData%BStC(i1), DstDiscStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcDiscStateData%NStC)) then + LB(1:1) = lbound(SrcDiscStateData%NStC) + UB(1:1) = ubound(SrcDiscStateData%NStC) + if (.not. allocated(DstDiscStateData%NStC)) then + allocate(DstDiscStateData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyDiscState(SrcDiscStateData%NStC(i1), DstDiscStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcDiscStateData%TStC)) then + LB(1:1) = lbound(SrcDiscStateData%TStC) + UB(1:1) = ubound(SrcDiscStateData%TStC) + if (.not. allocated(DstDiscStateData%TStC)) then + allocate(DstDiscStateData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyDiscState(SrcDiscStateData%TStC(i1), DstDiscStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcDiscStateData%SStC)) then + LB(1:1) = lbound(SrcDiscStateData%SStC) + UB(1:1) = ubound(SrcDiscStateData%SStC) + if (.not. allocated(DstDiscStateData%SStC)) then + allocate(DstDiscStateData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyDiscState(SrcDiscStateData%SStC(i1), DstDiscStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SrvD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%BStC)) then + LB(1:1) = lbound(DiscStateData%BStC) + UB(1:1) = ubound(DiscStateData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyDiscState(DiscStateData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%BStC) + end if + if (allocated(DiscStateData%NStC)) then + LB(1:1) = lbound(DiscStateData%NStC) + UB(1:1) = ubound(DiscStateData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyDiscState(DiscStateData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%NStC) + end if + if (allocated(DiscStateData%TStC)) then + LB(1:1) = lbound(DiscStateData%TStC) + UB(1:1) = ubound(DiscStateData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyDiscState(DiscStateData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%TStC) + end if + if (allocated(DiscStateData%SStC)) then + LB(1:1) = lbound(DiscStateData%SStC) + UB(1:1) = ubound(DiscStateData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyDiscState(DiscStateData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%SStC) + end if +end subroutine + +subroutine SrvD_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%CtrlOffset) + call RegPack(Buf, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackDiscState(Buf, InData%BStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackDiscState(Buf, InData%NStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackDiscState(Buf, InData%TStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackDiscState(Buf, InData%SStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%CtrlOffset) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackDiscState(Buf, OutData%BStC(i1)) ! BStC + end do + end if + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackDiscState(Buf, OutData%NStC(i1)) ! NStC + end do + end if + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackDiscState(Buf, OutData%TStC(i1)) ! TStC + end do + end if + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackDiscState(Buf, OutData%SStC(i1)) ! SStC + end do + end if +end subroutine + +subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SrvD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState + if (allocated(SrcConstrStateData%BStC)) then + LB(1:1) = lbound(SrcConstrStateData%BStC) + UB(1:1) = ubound(SrcConstrStateData%BStC) + if (.not. allocated(DstConstrStateData%BStC)) then + allocate(DstConstrStateData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyConstrState(SrcConstrStateData%BStC(i1), DstConstrStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcConstrStateData%NStC)) then + LB(1:1) = lbound(SrcConstrStateData%NStC) + UB(1:1) = ubound(SrcConstrStateData%NStC) + if (.not. allocated(DstConstrStateData%NStC)) then + allocate(DstConstrStateData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyConstrState(SrcConstrStateData%NStC(i1), DstConstrStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcConstrStateData%TStC)) then + LB(1:1) = lbound(SrcConstrStateData%TStC) + UB(1:1) = ubound(SrcConstrStateData%TStC) + if (.not. allocated(DstConstrStateData%TStC)) then + allocate(DstConstrStateData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyConstrState(SrcConstrStateData%TStC(i1), DstConstrStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcConstrStateData%SStC)) then + LB(1:1) = lbound(SrcConstrStateData%SStC) + UB(1:1) = ubound(SrcConstrStateData%SStC) + if (.not. allocated(DstConstrStateData%SStC)) then + allocate(DstConstrStateData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyConstrState(SrcConstrStateData%SStC(i1), DstConstrStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SrvD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConstrStateData%BStC)) then + LB(1:1) = lbound(ConstrStateData%BStC) + UB(1:1) = ubound(ConstrStateData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyConstrState(ConstrStateData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%BStC) + end if + if (allocated(ConstrStateData%NStC)) then + LB(1:1) = lbound(ConstrStateData%NStC) + UB(1:1) = ubound(ConstrStateData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyConstrState(ConstrStateData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%NStC) + end if + if (allocated(ConstrStateData%TStC)) then + LB(1:1) = lbound(ConstrStateData%TStC) + UB(1:1) = ubound(ConstrStateData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyConstrState(ConstrStateData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%TStC) + end if + if (allocated(ConstrStateData%SStC)) then + LB(1:1) = lbound(ConstrStateData%SStC) + UB(1:1) = ubound(ConstrStateData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyConstrState(ConstrStateData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%SStC) + end if +end subroutine + +subroutine SrvD_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + call RegPack(Buf, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackConstrState(Buf, InData%BStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackConstrState(Buf, InData%NStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackConstrState(Buf, InData%TStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackConstrState(Buf, InData%SStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackConstrState(Buf, OutData%BStC(i1)) ! BStC + end do + end if + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackConstrState(Buf, OutData%NStC(i1)) ! NStC + end do + end if + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackConstrState(Buf, OutData%TStC(i1)) ! TStC + end do + end if + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackConstrState(Buf, OutData%SStC(i1)) ! SStC + end do + end if +end subroutine + +subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_OtherStateType), intent(in) :: SrcOtherStateData + type(SrvD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%BegPitMan)) then + LB(1:1) = lbound(SrcOtherStateData%BegPitMan) + UB(1:1) = ubound(SrcOtherStateData%BegPitMan) + if (.not. allocated(DstOtherStateData%BegPitMan)) then + allocate(DstOtherStateData%BegPitMan(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BegPitMan.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%BegPitMan = SrcOtherStateData%BegPitMan + end if + if (allocated(SrcOtherStateData%BlPitchI)) then + LB(1:1) = lbound(SrcOtherStateData%BlPitchI) + UB(1:1) = ubound(SrcOtherStateData%BlPitchI) + if (.not. allocated(DstOtherStateData%BlPitchI)) then + allocate(DstOtherStateData%BlPitchI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BlPitchI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%BlPitchI = SrcOtherStateData%BlPitchI + end if + if (allocated(SrcOtherStateData%TPitManE)) then + LB(1:1) = lbound(SrcOtherStateData%TPitManE) + UB(1:1) = ubound(SrcOtherStateData%TPitManE) + if (.not. allocated(DstOtherStateData%TPitManE)) then + allocate(DstOtherStateData%TPitManE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TPitManE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%TPitManE = SrcOtherStateData%TPitManE + end if + DstOtherStateData%BegYawMan = SrcOtherStateData%BegYawMan + DstOtherStateData%NacYawI = SrcOtherStateData%NacYawI + DstOtherStateData%TYawManE = SrcOtherStateData%TYawManE + DstOtherStateData%YawPosComInt = SrcOtherStateData%YawPosComInt + if (allocated(SrcOtherStateData%BegTpBr)) then + LB(1:1) = lbound(SrcOtherStateData%BegTpBr) + UB(1:1) = ubound(SrcOtherStateData%BegTpBr) + if (.not. allocated(DstOtherStateData%BegTpBr)) then + allocate(DstOtherStateData%BegTpBr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BegTpBr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%BegTpBr = SrcOtherStateData%BegTpBr + end if + if (allocated(SrcOtherStateData%TTpBrDp)) then + LB(1:1) = lbound(SrcOtherStateData%TTpBrDp) + UB(1:1) = ubound(SrcOtherStateData%TTpBrDp) + if (.not. allocated(DstOtherStateData%TTpBrDp)) then + allocate(DstOtherStateData%TTpBrDp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TTpBrDp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%TTpBrDp = SrcOtherStateData%TTpBrDp + end if + if (allocated(SrcOtherStateData%TTpBrFl)) then + LB(1:1) = lbound(SrcOtherStateData%TTpBrFl) + UB(1:1) = ubound(SrcOtherStateData%TTpBrFl) + if (.not. allocated(DstOtherStateData%TTpBrFl)) then + allocate(DstOtherStateData%TTpBrFl(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TTpBrFl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%TTpBrFl = SrcOtherStateData%TTpBrFl + end if + DstOtherStateData%Off4Good = SrcOtherStateData%Off4Good + DstOtherStateData%GenOnLine = SrcOtherStateData%GenOnLine + if (allocated(SrcOtherStateData%BStC)) then + LB(1:1) = lbound(SrcOtherStateData%BStC) + UB(1:1) = ubound(SrcOtherStateData%BStC) + if (.not. allocated(DstOtherStateData%BStC)) then + allocate(DstOtherStateData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOtherState(SrcOtherStateData%BStC(i1), DstOtherStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOtherStateData%NStC)) then + LB(1:1) = lbound(SrcOtherStateData%NStC) + UB(1:1) = ubound(SrcOtherStateData%NStC) + if (.not. allocated(DstOtherStateData%NStC)) then + allocate(DstOtherStateData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOtherState(SrcOtherStateData%NStC(i1), DstOtherStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOtherStateData%TStC)) then + LB(1:1) = lbound(SrcOtherStateData%TStC) + UB(1:1) = ubound(SrcOtherStateData%TStC) + if (.not. allocated(DstOtherStateData%TStC)) then + allocate(DstOtherStateData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOtherState(SrcOtherStateData%TStC(i1), DstOtherStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOtherStateData%SStC)) then + LB(1:1) = lbound(SrcOtherStateData%SStC) + UB(1:1) = ubound(SrcOtherStateData%SStC) + if (.not. allocated(DstOtherStateData%SStC)) then + allocate(DstOtherStateData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOtherState(SrcOtherStateData%SStC(i1), DstOtherStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SrvD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%BegPitMan)) then + deallocate(OtherStateData%BegPitMan) + end if + if (allocated(OtherStateData%BlPitchI)) then + deallocate(OtherStateData%BlPitchI) + end if + if (allocated(OtherStateData%TPitManE)) then + deallocate(OtherStateData%TPitManE) + end if + if (allocated(OtherStateData%BegTpBr)) then + deallocate(OtherStateData%BegTpBr) + end if + if (allocated(OtherStateData%TTpBrDp)) then + deallocate(OtherStateData%TTpBrDp) + end if + if (allocated(OtherStateData%TTpBrFl)) then + deallocate(OtherStateData%TTpBrFl) + end if + if (allocated(OtherStateData%BStC)) then + LB(1:1) = lbound(OtherStateData%BStC) + UB(1:1) = ubound(OtherStateData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyOtherState(OtherStateData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%BStC) + end if + if (allocated(OtherStateData%NStC)) then + LB(1:1) = lbound(OtherStateData%NStC) + UB(1:1) = ubound(OtherStateData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyOtherState(OtherStateData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%NStC) + end if + if (allocated(OtherStateData%TStC)) then + LB(1:1) = lbound(OtherStateData%TStC) + UB(1:1) = ubound(OtherStateData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyOtherState(OtherStateData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%TStC) + end if + if (allocated(OtherStateData%SStC)) then + LB(1:1) = lbound(OtherStateData%SStC) + UB(1:1) = ubound(OtherStateData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyOtherState(OtherStateData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%SStC) + end if +end subroutine + +subroutine SrvD_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%BegPitMan)) + if (allocated(InData%BegPitMan)) then + call RegPackBounds(Buf, 1, lbound(InData%BegPitMan), ubound(InData%BegPitMan)) + call RegPack(Buf, InData%BegPitMan) + end if + call RegPack(Buf, allocated(InData%BlPitchI)) + if (allocated(InData%BlPitchI)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitchI), ubound(InData%BlPitchI)) + call RegPack(Buf, InData%BlPitchI) + end if + call RegPack(Buf, allocated(InData%TPitManE)) + if (allocated(InData%TPitManE)) then + call RegPackBounds(Buf, 1, lbound(InData%TPitManE), ubound(InData%TPitManE)) + call RegPack(Buf, InData%TPitManE) + end if + call RegPack(Buf, InData%BegYawMan) + call RegPack(Buf, InData%NacYawI) + call RegPack(Buf, InData%TYawManE) + call RegPack(Buf, InData%YawPosComInt) + call RegPack(Buf, allocated(InData%BegTpBr)) + if (allocated(InData%BegTpBr)) then + call RegPackBounds(Buf, 1, lbound(InData%BegTpBr), ubound(InData%BegTpBr)) + call RegPack(Buf, InData%BegTpBr) + end if + call RegPack(Buf, allocated(InData%TTpBrDp)) + if (allocated(InData%TTpBrDp)) then + call RegPackBounds(Buf, 1, lbound(InData%TTpBrDp), ubound(InData%TTpBrDp)) + call RegPack(Buf, InData%TTpBrDp) + end if + call RegPack(Buf, allocated(InData%TTpBrFl)) + if (allocated(InData%TTpBrFl)) then + call RegPackBounds(Buf, 1, lbound(InData%TTpBrFl), ubound(InData%TTpBrFl)) + call RegPack(Buf, InData%TTpBrFl) + end if + call RegPack(Buf, InData%Off4Good) + call RegPack(Buf, InData%GenOnLine) + call RegPack(Buf, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackOtherState(Buf, InData%BStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackOtherState(Buf, InData%NStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackOtherState(Buf, InData%TStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackOtherState(Buf, InData%SStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%BegPitMan)) deallocate(OutData%BegPitMan) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BegPitMan(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegPitMan.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BegPitMan) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlPitchI)) deallocate(OutData%BlPitchI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitchI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitchI) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TPitManE)) deallocate(OutData%TPitManE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TPitManE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TPitManE) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%BegYawMan) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacYawI) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TYawManE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawPosComInt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BegTpBr)) deallocate(OutData%BegTpBr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BegTpBr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegTpBr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BegTpBr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TTpBrDp)) deallocate(OutData%TTpBrDp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TTpBrDp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrDp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TTpBrDp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TTpBrFl)) deallocate(OutData%TTpBrFl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TTpBrFl(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrFl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TTpBrFl) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Off4Good) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenOnLine) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOtherState(Buf, OutData%BStC(i1)) ! BStC + end do + end if + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOtherState(Buf, OutData%NStC(i1)) ! NStC + end do + end if + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOtherState(Buf, OutData%TStC(i1)) ! TStC + end do + end if + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOtherState(Buf, OutData%SStC(i1)) ! SStC + end do + end if +end subroutine + +subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_ModuleMapType), intent(inout) :: SrcModuleMapTypeData + type(SrvD_ModuleMapType), intent(inout) :: DstModuleMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyModuleMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcModuleMapTypeData%u_BStC_Mot2_BStC)) then + LB(1:2) = lbound(SrcModuleMapTypeData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(SrcModuleMapTypeData%u_BStC_Mot2_BStC) + if (.not. allocated(DstModuleMapTypeData%u_BStC_Mot2_BStC)) then + allocate(DstModuleMapTypeData%u_BStC_Mot2_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BStC_Mot2_BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), DstModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcModuleMapTypeData%u_NStC_Mot2_NStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_NStC_Mot2_NStC) + UB(1:1) = ubound(SrcModuleMapTypeData%u_NStC_Mot2_NStC) + if (.not. allocated(DstModuleMapTypeData%u_NStC_Mot2_NStC)) then + allocate(DstModuleMapTypeData%u_NStC_Mot2_NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_NStC_Mot2_NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%u_NStC_Mot2_NStC(i1), DstModuleMapTypeData%u_NStC_Mot2_NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%u_TStC_Mot2_TStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_TStC_Mot2_TStC) + UB(1:1) = ubound(SrcModuleMapTypeData%u_TStC_Mot2_TStC) + if (.not. allocated(DstModuleMapTypeData%u_TStC_Mot2_TStC)) then + allocate(DstModuleMapTypeData%u_TStC_Mot2_TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_TStC_Mot2_TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%u_TStC_Mot2_TStC(i1), DstModuleMapTypeData%u_TStC_Mot2_TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%u_SStC_Mot2_SStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_SStC_Mot2_SStC) + UB(1:1) = ubound(SrcModuleMapTypeData%u_SStC_Mot2_SStC) + if (.not. allocated(DstModuleMapTypeData%u_SStC_Mot2_SStC)) then + allocate(DstModuleMapTypeData%u_SStC_Mot2_SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_SStC_Mot2_SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%u_SStC_Mot2_SStC(i1), DstModuleMapTypeData%u_SStC_Mot2_SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%BStC_Frc2_y_BStC)) then + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_Frc2_y_BStC) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_Frc2_y_BStC) + if (.not. allocated(DstModuleMapTypeData%BStC_Frc2_y_BStC)) then + allocate(DstModuleMapTypeData%BStC_Frc2_y_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_Frc2_y_BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), DstModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcModuleMapTypeData%NStC_Frc2_y_NStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%NStC_Frc2_y_NStC) + UB(1:1) = ubound(SrcModuleMapTypeData%NStC_Frc2_y_NStC) + if (.not. allocated(DstModuleMapTypeData%NStC_Frc2_y_NStC)) then + allocate(DstModuleMapTypeData%NStC_Frc2_y_NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%NStC_Frc2_y_NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%NStC_Frc2_y_NStC(i1), DstModuleMapTypeData%NStC_Frc2_y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%TStC_Frc2_y_TStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%TStC_Frc2_y_TStC) + UB(1:1) = ubound(SrcModuleMapTypeData%TStC_Frc2_y_TStC) + if (.not. allocated(DstModuleMapTypeData%TStC_Frc2_y_TStC)) then + allocate(DstModuleMapTypeData%TStC_Frc2_y_TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%TStC_Frc2_y_TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%TStC_Frc2_y_TStC(i1), DstModuleMapTypeData%TStC_Frc2_y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%SStC_Frc2_y_SStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%SStC_Frc2_y_SStC) + UB(1:1) = ubound(SrcModuleMapTypeData%SStC_Frc2_y_SStC) + if (.not. allocated(DstModuleMapTypeData%SStC_Frc2_y_SStC)) then + allocate(DstModuleMapTypeData%SStC_Frc2_y_SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SStC_Frc2_y_SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SStC_Frc2_y_SStC(i1), DstModuleMapTypeData%SStC_Frc2_y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) + type(SrvD_ModuleMapType), intent(inout) :: ModuleMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyModuleMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModuleMapTypeData%u_BStC_Mot2_BStC)) then + LB(1:2) = lbound(ModuleMapTypeData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(ModuleMapTypeData%u_BStC_Mot2_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%u_BStC_Mot2_BStC) + end if + if (allocated(ModuleMapTypeData%u_NStC_Mot2_NStC)) then + LB(1:1) = lbound(ModuleMapTypeData%u_NStC_Mot2_NStC) + UB(1:1) = ubound(ModuleMapTypeData%u_NStC_Mot2_NStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_NStC_Mot2_NStC) + end if + if (allocated(ModuleMapTypeData%u_TStC_Mot2_TStC)) then + LB(1:1) = lbound(ModuleMapTypeData%u_TStC_Mot2_TStC) + UB(1:1) = ubound(ModuleMapTypeData%u_TStC_Mot2_TStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_TStC_Mot2_TStC) + end if + if (allocated(ModuleMapTypeData%u_SStC_Mot2_SStC)) then + LB(1:1) = lbound(ModuleMapTypeData%u_SStC_Mot2_SStC) + UB(1:1) = ubound(ModuleMapTypeData%u_SStC_Mot2_SStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_SStC_Mot2_SStC) + end if + if (allocated(ModuleMapTypeData%BStC_Frc2_y_BStC)) then + LB(1:2) = lbound(ModuleMapTypeData%BStC_Frc2_y_BStC) + UB(1:2) = ubound(ModuleMapTypeData%BStC_Frc2_y_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%BStC_Frc2_y_BStC) + end if + if (allocated(ModuleMapTypeData%NStC_Frc2_y_NStC)) then + LB(1:1) = lbound(ModuleMapTypeData%NStC_Frc2_y_NStC) + UB(1:1) = ubound(ModuleMapTypeData%NStC_Frc2_y_NStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%NStC_Frc2_y_NStC) + end if + if (allocated(ModuleMapTypeData%TStC_Frc2_y_TStC)) then + LB(1:1) = lbound(ModuleMapTypeData%TStC_Frc2_y_TStC) + UB(1:1) = ubound(ModuleMapTypeData%TStC_Frc2_y_TStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%TStC_Frc2_y_TStC) + end if + if (allocated(ModuleMapTypeData%SStC_Frc2_y_SStC)) then + LB(1:1) = lbound(ModuleMapTypeData%SStC_Frc2_y_SStC) + UB(1:1) = ubound(ModuleMapTypeData%SStC_Frc2_y_SStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%SStC_Frc2_y_SStC) + end if +end subroutine + +subroutine SrvD_PackModuleMapType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ModuleMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackModuleMapType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%u_BStC_Mot2_BStC)) + if (allocated(InData%u_BStC_Mot2_BStC)) then + call RegPackBounds(Buf, 2, lbound(InData%u_BStC_Mot2_BStC), ubound(InData%u_BStC_Mot2_BStC)) + LB(1:2) = lbound(InData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(InData%u_BStC_Mot2_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%u_BStC_Mot2_BStC(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%u_NStC_Mot2_NStC)) + if (allocated(InData%u_NStC_Mot2_NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%u_NStC_Mot2_NStC), ubound(InData%u_NStC_Mot2_NStC)) + LB(1:1) = lbound(InData%u_NStC_Mot2_NStC) + UB(1:1) = ubound(InData%u_NStC_Mot2_NStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%u_NStC_Mot2_NStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u_TStC_Mot2_TStC)) + if (allocated(InData%u_TStC_Mot2_TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%u_TStC_Mot2_TStC), ubound(InData%u_TStC_Mot2_TStC)) + LB(1:1) = lbound(InData%u_TStC_Mot2_TStC) + UB(1:1) = ubound(InData%u_TStC_Mot2_TStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%u_TStC_Mot2_TStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u_SStC_Mot2_SStC)) + if (allocated(InData%u_SStC_Mot2_SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%u_SStC_Mot2_SStC), ubound(InData%u_SStC_Mot2_SStC)) + LB(1:1) = lbound(InData%u_SStC_Mot2_SStC) + UB(1:1) = ubound(InData%u_SStC_Mot2_SStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%u_SStC_Mot2_SStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%BStC_Frc2_y_BStC)) + if (allocated(InData%BStC_Frc2_y_BStC)) then + call RegPackBounds(Buf, 2, lbound(InData%BStC_Frc2_y_BStC), ubound(InData%BStC_Frc2_y_BStC)) + LB(1:2) = lbound(InData%BStC_Frc2_y_BStC) + UB(1:2) = ubound(InData%BStC_Frc2_y_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%BStC_Frc2_y_BStC(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%NStC_Frc2_y_NStC)) + if (allocated(InData%NStC_Frc2_y_NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC_Frc2_y_NStC), ubound(InData%NStC_Frc2_y_NStC)) + LB(1:1) = lbound(InData%NStC_Frc2_y_NStC) + UB(1:1) = ubound(InData%NStC_Frc2_y_NStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%NStC_Frc2_y_NStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%TStC_Frc2_y_TStC)) + if (allocated(InData%TStC_Frc2_y_TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC_Frc2_y_TStC), ubound(InData%TStC_Frc2_y_TStC)) + LB(1:1) = lbound(InData%TStC_Frc2_y_TStC) + UB(1:1) = ubound(InData%TStC_Frc2_y_TStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%TStC_Frc2_y_TStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%SStC_Frc2_y_SStC)) + if (allocated(InData%SStC_Frc2_y_SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC_Frc2_y_SStC), ubound(InData%SStC_Frc2_y_SStC)) + LB(1:1) = lbound(InData%SStC_Frc2_y_SStC) + UB(1:1) = ubound(InData%SStC_Frc2_y_SStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%SStC_Frc2_y_SStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackModuleMapType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ModuleMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackModuleMapType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%u_BStC_Mot2_BStC)) deallocate(OutData%u_BStC_Mot2_BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_BStC_Mot2_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC_Mot2_BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%u_BStC_Mot2_BStC(i1,i2)) ! u_BStC_Mot2_BStC + end do + end do + end if + if (allocated(OutData%u_NStC_Mot2_NStC)) deallocate(OutData%u_NStC_Mot2_NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_NStC_Mot2_NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC_Mot2_NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%u_NStC_Mot2_NStC(i1)) ! u_NStC_Mot2_NStC + end do + end if + if (allocated(OutData%u_TStC_Mot2_TStC)) deallocate(OutData%u_TStC_Mot2_TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_TStC_Mot2_TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC_Mot2_TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%u_TStC_Mot2_TStC(i1)) ! u_TStC_Mot2_TStC + end do + end if + if (allocated(OutData%u_SStC_Mot2_SStC)) deallocate(OutData%u_SStC_Mot2_SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_SStC_Mot2_SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC_Mot2_SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%u_SStC_Mot2_SStC(i1)) ! u_SStC_Mot2_SStC + end do + end if + if (allocated(OutData%BStC_Frc2_y_BStC)) deallocate(OutData%BStC_Frc2_y_BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC_Frc2_y_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_Frc2_y_BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%BStC_Frc2_y_BStC(i1,i2)) ! BStC_Frc2_y_BStC + end do + end do + end if + if (allocated(OutData%NStC_Frc2_y_NStC)) deallocate(OutData%NStC_Frc2_y_NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC_Frc2_y_NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_Frc2_y_NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%NStC_Frc2_y_NStC(i1)) ! NStC_Frc2_y_NStC + end do + end if + if (allocated(OutData%TStC_Frc2_y_TStC)) deallocate(OutData%TStC_Frc2_y_TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC_Frc2_y_TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_Frc2_y_TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%TStC_Frc2_y_TStC(i1)) ! TStC_Frc2_y_TStC + end do + end if + if (allocated(OutData%SStC_Frc2_y_SStC)) deallocate(OutData%SStC_Frc2_y_SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC_Frc2_y_SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_Frc2_y_SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SStC_Frc2_y_SStC(i1)) ! SStC_Frc2_y_SStC + end do + end if +end subroutine + +subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_MiscVarType), intent(inout) :: SrcMiscData + type(SrvD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%LastTimeCalled = SrcMiscData%LastTimeCalled + call SrvD_CopyBladedDLLType(SrcMiscData%dll_data, DstMiscData%dll_data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%FirstWarn = SrcMiscData%FirstWarn + DstMiscData%LastTimeFiltered = SrcMiscData%LastTimeFiltered + if (allocated(SrcMiscData%xd_BlPitchFilter)) then + LB(1:1) = lbound(SrcMiscData%xd_BlPitchFilter) + UB(1:1) = ubound(SrcMiscData%xd_BlPitchFilter) + if (.not. allocated(DstMiscData%xd_BlPitchFilter)) then + allocate(DstMiscData%xd_BlPitchFilter(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xd_BlPitchFilter.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%xd_BlPitchFilter = SrcMiscData%xd_BlPitchFilter + end if + if (allocated(SrcMiscData%BStC)) then + LB(1:1) = lbound(SrcMiscData%BStC) + UB(1:1) = ubound(SrcMiscData%BStC) + if (.not. allocated(DstMiscData%BStC)) then + allocate(DstMiscData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%BStC(i1), DstMiscData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%NStC)) then + LB(1:1) = lbound(SrcMiscData%NStC) + UB(1:1) = ubound(SrcMiscData%NStC) + if (.not. allocated(DstMiscData%NStC)) then + allocate(DstMiscData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%NStC(i1), DstMiscData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%TStC)) then + LB(1:1) = lbound(SrcMiscData%TStC) + UB(1:1) = ubound(SrcMiscData%TStC) + if (.not. allocated(DstMiscData%TStC)) then + allocate(DstMiscData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%TStC(i1), DstMiscData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%SStC)) then + LB(1:1) = lbound(SrcMiscData%SStC) + UB(1:1) = ubound(SrcMiscData%SStC) + if (.not. allocated(DstMiscData%SStC)) then + allocate(DstMiscData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%SStC(i1), DstMiscData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%u_BStC)) then + LB(1:2) = lbound(SrcMiscData%u_BStC) + UB(1:2) = ubound(SrcMiscData%u_BStC) + if (.not. allocated(DstMiscData%u_BStC)) then + allocate(DstMiscData%u_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_BStC(i1,i2), DstMiscData%u_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcMiscData%u_NStC)) then + LB(1:2) = lbound(SrcMiscData%u_NStC) + UB(1:2) = ubound(SrcMiscData%u_NStC) + if (.not. allocated(DstMiscData%u_NStC)) then + allocate(DstMiscData%u_NStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_NStC(i1,i2), DstMiscData%u_NStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcMiscData%u_TStC)) then + LB(1:2) = lbound(SrcMiscData%u_TStC) + UB(1:2) = ubound(SrcMiscData%u_TStC) + if (.not. allocated(DstMiscData%u_TStC)) then + allocate(DstMiscData%u_TStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_TStC(i1,i2), DstMiscData%u_TStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcMiscData%u_SStC)) then + LB(1:2) = lbound(SrcMiscData%u_SStC) + UB(1:2) = ubound(SrcMiscData%u_SStC) + if (.not. allocated(DstMiscData%u_SStC)) then + allocate(DstMiscData%u_SStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_SStC(i1,i2), DstMiscData%u_SStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcMiscData%y_BStC)) then + LB(1:1) = lbound(SrcMiscData%y_BStC) + UB(1:1) = ubound(SrcMiscData%y_BStC) + if (.not. allocated(DstMiscData%y_BStC)) then + allocate(DstMiscData%y_BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_BStC(i1), DstMiscData%y_BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%y_NStC)) then + LB(1:1) = lbound(SrcMiscData%y_NStC) + UB(1:1) = ubound(SrcMiscData%y_NStC) + if (.not. allocated(DstMiscData%y_NStC)) then + allocate(DstMiscData%y_NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_NStC(i1), DstMiscData%y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%y_TStC)) then + LB(1:1) = lbound(SrcMiscData%y_TStC) + UB(1:1) = ubound(SrcMiscData%y_TStC) + if (.not. allocated(DstMiscData%y_TStC)) then + allocate(DstMiscData%y_TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_TStC(i1), DstMiscData%y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%y_SStC)) then + LB(1:1) = lbound(SrcMiscData%y_SStC) + UB(1:1) = ubound(SrcMiscData%y_SStC) + if (.not. allocated(DstMiscData%y_SStC)) then + allocate(DstMiscData%y_SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_SStC(i1), DstMiscData%y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call SrvD_CopyModuleMapType(SrcMiscData%SrvD_MeshMap, DstMiscData%SrvD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%PrevTstepNcall = SrcMiscData%PrevTstepNcall +end subroutine + +subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SrvD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + 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) + end if + if (allocated(MiscData%BStC)) then + LB(1:1) = lbound(MiscData%BStC) + UB(1:1) = ubound(MiscData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%BStC) + end if + if (allocated(MiscData%NStC)) then + LB(1:1) = lbound(MiscData%NStC) + UB(1:1) = ubound(MiscData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%NStC) + end if + if (allocated(MiscData%TStC)) then + LB(1:1) = lbound(MiscData%TStC) + UB(1:1) = ubound(MiscData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%TStC) + end if + if (allocated(MiscData%SStC)) then + LB(1:1) = lbound(MiscData%SStC) + UB(1:1) = ubound(MiscData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%SStC) + end if + if (allocated(MiscData%u_BStC)) then + LB(1:2) = lbound(MiscData%u_BStC) + UB(1:2) = ubound(MiscData%u_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_BStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_BStC) + end if + if (allocated(MiscData%u_NStC)) then + LB(1:2) = lbound(MiscData%u_NStC) + UB(1:2) = ubound(MiscData%u_NStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_NStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_NStC) + end if + if (allocated(MiscData%u_TStC)) then + LB(1:2) = lbound(MiscData%u_TStC) + UB(1:2) = ubound(MiscData%u_TStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_TStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_TStC) + end if + if (allocated(MiscData%u_SStC)) then + LB(1:2) = lbound(MiscData%u_SStC) + UB(1:2) = ubound(MiscData%u_SStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_SStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_SStC) + end if + if (allocated(MiscData%y_BStC)) then + LB(1:1) = lbound(MiscData%y_BStC) + UB(1:1) = ubound(MiscData%y_BStC) + do i1 = LB(1), UB(1) + call StC_DestroyOutput(MiscData%y_BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%y_BStC) + end if + if (allocated(MiscData%y_NStC)) then + LB(1:1) = lbound(MiscData%y_NStC) + UB(1:1) = ubound(MiscData%y_NStC) + do i1 = LB(1), UB(1) + call StC_DestroyOutput(MiscData%y_NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%y_NStC) + end if + if (allocated(MiscData%y_TStC)) then + LB(1:1) = lbound(MiscData%y_TStC) + UB(1:1) = ubound(MiscData%y_TStC) + do i1 = LB(1), UB(1) + call StC_DestroyOutput(MiscData%y_TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%y_TStC) + end if + if (allocated(MiscData%y_SStC)) then + LB(1:1) = lbound(MiscData%y_SStC) + UB(1:1) = ubound(MiscData%y_SStC) + do i1 = LB(1), UB(1) + call StC_DestroyOutput(MiscData%y_SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%y_SStC) + end if + call SrvD_DestroyModuleMapType(MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SrvD_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%LastTimeCalled) + call SrvD_PackBladedDLLType(Buf, InData%dll_data) + call RegPack(Buf, InData%FirstWarn) + call RegPack(Buf, InData%LastTimeFiltered) + call RegPack(Buf, allocated(InData%xd_BlPitchFilter)) + if (allocated(InData%xd_BlPitchFilter)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_BlPitchFilter), ubound(InData%xd_BlPitchFilter)) + call RegPack(Buf, InData%xd_BlPitchFilter) + end if + call RegPack(Buf, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(Buf, InData%BStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(Buf, InData%NStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(Buf, InData%TStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(Buf, InData%SStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%u_BStC)) + if (allocated(InData%u_BStC)) then + call RegPackBounds(Buf, 2, lbound(InData%u_BStC), ubound(InData%u_BStC)) + LB(1:2) = lbound(InData%u_BStC) + UB(1:2) = ubound(InData%u_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(Buf, InData%u_BStC(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%u_NStC)) + if (allocated(InData%u_NStC)) then + call RegPackBounds(Buf, 2, lbound(InData%u_NStC), ubound(InData%u_NStC)) + LB(1:2) = lbound(InData%u_NStC) + UB(1:2) = ubound(InData%u_NStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(Buf, InData%u_NStC(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%u_TStC)) + if (allocated(InData%u_TStC)) then + call RegPackBounds(Buf, 2, lbound(InData%u_TStC), ubound(InData%u_TStC)) + LB(1:2) = lbound(InData%u_TStC) + UB(1:2) = ubound(InData%u_TStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(Buf, InData%u_TStC(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%u_SStC)) + if (allocated(InData%u_SStC)) then + call RegPackBounds(Buf, 2, lbound(InData%u_SStC), ubound(InData%u_SStC)) + LB(1:2) = lbound(InData%u_SStC) + UB(1:2) = ubound(InData%u_SStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(Buf, InData%u_SStC(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%y_BStC)) + if (allocated(InData%y_BStC)) then + call RegPackBounds(Buf, 1, lbound(InData%y_BStC), ubound(InData%y_BStC)) + LB(1:1) = lbound(InData%y_BStC) + UB(1:1) = ubound(InData%y_BStC) + do i1 = LB(1), UB(1) + call StC_PackOutput(Buf, InData%y_BStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%y_NStC)) + if (allocated(InData%y_NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%y_NStC), ubound(InData%y_NStC)) + LB(1:1) = lbound(InData%y_NStC) + UB(1:1) = ubound(InData%y_NStC) + do i1 = LB(1), UB(1) + call StC_PackOutput(Buf, InData%y_NStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%y_TStC)) + if (allocated(InData%y_TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%y_TStC), ubound(InData%y_TStC)) + LB(1:1) = lbound(InData%y_TStC) + UB(1:1) = ubound(InData%y_TStC) + do i1 = LB(1), UB(1) + call StC_PackOutput(Buf, InData%y_TStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%y_SStC)) + if (allocated(InData%y_SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%y_SStC), ubound(InData%y_SStC)) + LB(1:1) = lbound(InData%y_SStC) + UB(1:1) = ubound(InData%y_SStC) + do i1 = LB(1), UB(1) + call StC_PackOutput(Buf, InData%y_SStC(i1)) + end do + end if + call SrvD_PackModuleMapType(Buf, InData%SrvD_MeshMap) + call RegPack(Buf, InData%PrevTstepNcall) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%LastTimeCalled) + if (RegCheckErr(Buf, RoutineName)) return + call SrvD_UnpackBladedDLLType(Buf, OutData%dll_data) ! dll_data + call RegUnpack(Buf, OutData%FirstWarn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LastTimeFiltered) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%xd_BlPitchFilter)) deallocate(OutData%xd_BlPitchFilter) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_BlPitchFilter(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BlPitchFilter.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xd_BlPitchFilter) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(Buf, OutData%BStC(i1)) ! BStC + end do + end if + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(Buf, OutData%NStC(i1)) ! NStC + end do + end if + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(Buf, OutData%TStC(i1)) ! TStC + end do + end if + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(Buf, OutData%SStC(i1)) ! SStC + end do + end if + if (allocated(OutData%u_BStC)) deallocate(OutData%u_BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(Buf, OutData%u_BStC(i1,i2)) ! u_BStC + end do + end do + end if + if (allocated(OutData%u_NStC)) deallocate(OutData%u_NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_NStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(Buf, OutData%u_NStC(i1,i2)) ! u_NStC + end do + end do + end if + if (allocated(OutData%u_TStC)) deallocate(OutData%u_TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_TStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(Buf, OutData%u_TStC(i1,i2)) ! u_TStC + end do + end do + end if + if (allocated(OutData%u_SStC)) deallocate(OutData%u_SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_SStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(Buf, OutData%u_SStC(i1,i2)) ! u_SStC + end do + end do + end if + if (allocated(OutData%y_BStC)) deallocate(OutData%y_BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOutput(Buf, OutData%y_BStC(i1)) ! y_BStC + end do + end if + if (allocated(OutData%y_NStC)) deallocate(OutData%y_NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOutput(Buf, OutData%y_NStC(i1)) ! y_NStC + end do + end if + if (allocated(OutData%y_TStC)) deallocate(OutData%y_TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOutput(Buf, OutData%y_TStC(i1)) ! y_TStC + end do + end if + if (allocated(OutData%y_SStC)) deallocate(OutData%y_SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOutput(Buf, OutData%y_SStC(i1)) ! y_SStC + end do + end if + call SrvD_UnpackModuleMapType(Buf, OutData%SrvD_MeshMap) ! SrvD_MeshMap + call RegUnpack(Buf, OutData%PrevTstepNcall) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_ParameterType), intent(in) :: SrcParamData + type(SrvD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%HSSBrDT = SrcParamData%HSSBrDT + DstParamData%HSSBrTqF = SrcParamData%HSSBrTqF + DstParamData%SIG_POSl = SrcParamData%SIG_POSl + DstParamData%SIG_POTq = SrcParamData%SIG_POTq + DstParamData%SIG_SlPc = SrcParamData%SIG_SlPc + DstParamData%SIG_Slop = SrcParamData%SIG_Slop + DstParamData%SIG_SySp = SrcParamData%SIG_SySp + DstParamData%TEC_A0 = SrcParamData%TEC_A0 + DstParamData%TEC_C0 = SrcParamData%TEC_C0 + DstParamData%TEC_C1 = SrcParamData%TEC_C1 + DstParamData%TEC_C2 = SrcParamData%TEC_C2 + DstParamData%TEC_K2 = SrcParamData%TEC_K2 + DstParamData%TEC_MR = SrcParamData%TEC_MR + DstParamData%TEC_Re1 = SrcParamData%TEC_Re1 + DstParamData%TEC_RLR = SrcParamData%TEC_RLR + DstParamData%TEC_RRes = SrcParamData%TEC_RRes + DstParamData%TEC_SRes = SrcParamData%TEC_SRes + DstParamData%TEC_SySp = SrcParamData%TEC_SySp + DstParamData%TEC_V1a = SrcParamData%TEC_V1a + DstParamData%TEC_VLL = SrcParamData%TEC_VLL + DstParamData%TEC_Xe1 = SrcParamData%TEC_Xe1 + DstParamData%GenEff = SrcParamData%GenEff + if (allocated(SrcParamData%BlPitchInit)) then + LB(1:1) = lbound(SrcParamData%BlPitchInit) + UB(1:1) = ubound(SrcParamData%BlPitchInit) + if (.not. allocated(DstParamData%BlPitchInit)) then + allocate(DstParamData%BlPitchInit(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchInit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BlPitchInit = SrcParamData%BlPitchInit + end if + if (allocated(SrcParamData%BlPitchF)) then + LB(1:1) = lbound(SrcParamData%BlPitchF) + UB(1:1) = ubound(SrcParamData%BlPitchF) + if (.not. allocated(DstParamData%BlPitchF)) then + allocate(DstParamData%BlPitchF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BlPitchF = SrcParamData%BlPitchF + end if + if (allocated(SrcParamData%PitManRat)) then + LB(1:1) = lbound(SrcParamData%PitManRat) + UB(1:1) = ubound(SrcParamData%PitManRat) + if (.not. allocated(DstParamData%PitManRat)) then + allocate(DstParamData%PitManRat(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitManRat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PitManRat = SrcParamData%PitManRat + end if + DstParamData%YawManRat = SrcParamData%YawManRat + DstParamData%NacYawF = SrcParamData%NacYawF + DstParamData%SpdGenOn = SrcParamData%SpdGenOn + DstParamData%THSSBrDp = SrcParamData%THSSBrDp + DstParamData%THSSBrFl = SrcParamData%THSSBrFl + DstParamData%TimGenOf = SrcParamData%TimGenOf + DstParamData%TimGenOn = SrcParamData%TimGenOn + DstParamData%TPCOn = SrcParamData%TPCOn + if (allocated(SrcParamData%TPitManS)) then + LB(1:1) = lbound(SrcParamData%TPitManS) + UB(1:1) = ubound(SrcParamData%TPitManS) + if (.not. allocated(DstParamData%TPitManS)) then + allocate(DstParamData%TPitManS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TPitManS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TPitManS = SrcParamData%TPitManS + end if + DstParamData%TYawManS = SrcParamData%TYawManS + DstParamData%TYCOn = SrcParamData%TYCOn + DstParamData%VS_RtGnSp = SrcParamData%VS_RtGnSp + DstParamData%VS_RtTq = SrcParamData%VS_RtTq + DstParamData%VS_Slope = SrcParamData%VS_Slope + DstParamData%VS_SlPc = SrcParamData%VS_SlPc + DstParamData%VS_SySp = SrcParamData%VS_SySp + DstParamData%VS_TrGnSp = SrcParamData%VS_TrGnSp + DstParamData%YawPosCom = SrcParamData%YawPosCom + DstParamData%YawRateCom = SrcParamData%YawRateCom + DstParamData%GenModel = SrcParamData%GenModel + DstParamData%HSSBrMode = SrcParamData%HSSBrMode + DstParamData%PCMode = SrcParamData%PCMode + DstParamData%VSContrl = SrcParamData%VSContrl + DstParamData%YCMode = SrcParamData%YCMode + DstParamData%GenTiStp = SrcParamData%GenTiStp + DstParamData%GenTiStr = SrcParamData%GenTiStr + DstParamData%VS_Rgn2K = SrcParamData%VS_Rgn2K + DstParamData%YawNeut = SrcParamData%YawNeut + DstParamData%YawSpr = SrcParamData%YawSpr + DstParamData%YawDamp = SrcParamData%YawDamp + DstParamData%TpBrDT = SrcParamData%TpBrDT + if (allocated(SrcParamData%TBDepISp)) then + LB(1:1) = lbound(SrcParamData%TBDepISp) + UB(1:1) = ubound(SrcParamData%TBDepISp) + if (.not. allocated(DstParamData%TBDepISp)) then + allocate(DstParamData%TBDepISp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TBDepISp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TBDepISp = SrcParamData%TBDepISp + end if + DstParamData%TBDrConN = SrcParamData%TBDrConN + DstParamData%TBDrConD = SrcParamData%TBDrConD + DstParamData%NumBl = SrcParamData%NumBl + DstParamData%NumBStC = SrcParamData%NumBStC + DstParamData%NumNStC = SrcParamData%NumNStC + DstParamData%NumTStC = SrcParamData%NumTStC + DstParamData%NumSStC = SrcParamData%NumSStC + DstParamData%AfCmode = SrcParamData%AfCmode + DstParamData%AfC_Mean = SrcParamData%AfC_Mean + DstParamData%AfC_Amp = SrcParamData%AfC_Amp + DstParamData%AfC_Phase = SrcParamData%AfC_Phase + DstParamData%CCmode = SrcParamData%CCmode + DstParamData%StCCmode = SrcParamData%StCCmode + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + DstParamData%Delim = SrcParamData%Delim + DstParamData%UseBladedInterface = SrcParamData%UseBladedInterface + DstParamData%UseLegacyInterface = SrcParamData%UseLegacyInterface + DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt + DstParamData%DLL_Ramp = SrcParamData%DLL_Ramp + DstParamData%BlAlpha = SrcParamData%BlAlpha + DstParamData%DLL_n = SrcParamData%DLL_n + DstParamData%avcOUTNAME_LEN = SrcParamData%avcOUTNAME_LEN + DstParamData%NacYaw_North = SrcParamData%NacYaw_North + DstParamData%AvgWindSpeed = SrcParamData%AvgWindSpeed + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%TrimCase = SrcParamData%TrimCase + DstParamData%TrimGain = SrcParamData%TrimGain + DstParamData%RotSpeedRef = SrcParamData%RotSpeedRef + if (allocated(SrcParamData%BStC)) then + LB(1:1) = lbound(SrcParamData%BStC) + UB(1:1) = ubound(SrcParamData%BStC) + if (.not. allocated(DstParamData%BStC)) then + allocate(DstParamData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%BStC(i1), DstParamData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%NStC)) then + LB(1:1) = lbound(SrcParamData%NStC) + UB(1:1) = ubound(SrcParamData%NStC) + if (.not. allocated(DstParamData%NStC)) then + allocate(DstParamData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%NStC(i1), DstParamData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%TStC)) then + LB(1:1) = lbound(SrcParamData%TStC) + UB(1:1) = ubound(SrcParamData%TStC) + if (.not. allocated(DstParamData%TStC)) then + allocate(DstParamData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%TStC(i1), DstParamData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%SStC)) then + LB(1:1) = lbound(SrcParamData%SStC) + UB(1:1) = ubound(SrcParamData%SStC) + if (.not. allocated(DstParamData%SStC)) then + allocate(DstParamData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%SStC(i1), DstParamData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%InterpOrder = SrcParamData%InterpOrder + DstParamData%EXavrSWAP = SrcParamData%EXavrSWAP + DstParamData%NumCableControl = SrcParamData%NumCableControl + DstParamData%NumStC_Control = SrcParamData%NumStC_Control + if (allocated(SrcParamData%StCMeasNumPerChan)) then + LB(1:1) = lbound(SrcParamData%StCMeasNumPerChan) + UB(1:1) = ubound(SrcParamData%StCMeasNumPerChan) + if (.not. allocated(DstParamData%StCMeasNumPerChan)) then + allocate(DstParamData%StCMeasNumPerChan(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StCMeasNumPerChan.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StCMeasNumPerChan = SrcParamData%StCMeasNumPerChan + end if + DstParamData%UseSC = SrcParamData%UseSC + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + end if + if (allocated(SrcParamData%Jac_x_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_x_indx) + UB(1:2) = ubound(SrcParamData%Jac_x_indx) + if (.not. allocated(DstParamData%Jac_x_indx)) then + allocate(DstParamData%Jac_x_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_x_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_x_indx = SrcParamData%Jac_x_indx + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du + end if + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx + end if + DstParamData%Jac_nu = SrcParamData%Jac_nu + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + if (allocated(SrcParamData%Jac_Idx_BStC_u)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_u) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_u) + if (.not. allocated(DstParamData%Jac_Idx_BStC_u)) then + allocate(DstParamData%Jac_Idx_BStC_u(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_u = SrcParamData%Jac_Idx_BStC_u + end if + if (allocated(SrcParamData%Jac_Idx_NStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_u) + if (.not. allocated(DstParamData%Jac_Idx_NStC_u)) then + allocate(DstParamData%Jac_Idx_NStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_u = SrcParamData%Jac_Idx_NStC_u + end if + if (allocated(SrcParamData%Jac_Idx_TStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_u) + if (.not. allocated(DstParamData%Jac_Idx_TStC_u)) then + allocate(DstParamData%Jac_Idx_TStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_u = SrcParamData%Jac_Idx_TStC_u + end if + if (allocated(SrcParamData%Jac_Idx_SStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_u) + if (.not. allocated(DstParamData%Jac_Idx_SStC_u)) then + allocate(DstParamData%Jac_Idx_SStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_u = SrcParamData%Jac_Idx_SStC_u + end if + if (allocated(SrcParamData%Jac_Idx_BStC_x)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_x) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_x) + if (.not. allocated(DstParamData%Jac_Idx_BStC_x)) then + allocate(DstParamData%Jac_Idx_BStC_x(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_x = SrcParamData%Jac_Idx_BStC_x + end if + if (allocated(SrcParamData%Jac_Idx_NStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_x) + if (.not. allocated(DstParamData%Jac_Idx_NStC_x)) then + allocate(DstParamData%Jac_Idx_NStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_x = SrcParamData%Jac_Idx_NStC_x + end if + if (allocated(SrcParamData%Jac_Idx_TStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_x) + if (.not. allocated(DstParamData%Jac_Idx_TStC_x)) then + allocate(DstParamData%Jac_Idx_TStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_x = SrcParamData%Jac_Idx_TStC_x + end if + if (allocated(SrcParamData%Jac_Idx_SStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_x) + if (.not. allocated(DstParamData%Jac_Idx_SStC_x)) then + allocate(DstParamData%Jac_Idx_SStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_x = SrcParamData%Jac_Idx_SStC_x + end if + if (allocated(SrcParamData%Jac_Idx_BStC_y)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_y) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_y) + if (.not. allocated(DstParamData%Jac_Idx_BStC_y)) then + allocate(DstParamData%Jac_Idx_BStC_y(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_y = SrcParamData%Jac_Idx_BStC_y + end if + if (allocated(SrcParamData%Jac_Idx_NStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_y) + if (.not. allocated(DstParamData%Jac_Idx_NStC_y)) then + allocate(DstParamData%Jac_Idx_NStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_y = SrcParamData%Jac_Idx_NStC_y + end if + if (allocated(SrcParamData%Jac_Idx_TStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_y) + if (.not. allocated(DstParamData%Jac_Idx_TStC_y)) then + allocate(DstParamData%Jac_Idx_TStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_y = SrcParamData%Jac_Idx_TStC_y + end if + if (allocated(SrcParamData%Jac_Idx_SStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_y) + if (.not. allocated(DstParamData%Jac_Idx_SStC_y)) then + allocate(DstParamData%Jac_Idx_SStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_y = SrcParamData%Jac_Idx_SStC_y + end if + DstParamData%SensorType = SrcParamData%SensorType + DstParamData%NumBeam = SrcParamData%NumBeam + DstParamData%NumPulseGate = SrcParamData%NumPulseGate + DstParamData%PulseSpacing = SrcParamData%PulseSpacing + DstParamData%URefLid = SrcParamData%URefLid +end subroutine + +subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SrvD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%BlPitchInit)) then + deallocate(ParamData%BlPitchInit) + end if + if (allocated(ParamData%BlPitchF)) then + deallocate(ParamData%BlPitchF) + end if + if (allocated(ParamData%PitManRat)) then + deallocate(ParamData%PitManRat) + end if + if (allocated(ParamData%TPitManS)) then + deallocate(ParamData%TPitManS) + end if + if (allocated(ParamData%TBDepISp)) then + deallocate(ParamData%TBDepISp) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + call FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%BStC)) then + LB(1:1) = lbound(ParamData%BStC) + UB(1:1) = ubound(ParamData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyParam(ParamData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%BStC) + end if + if (allocated(ParamData%NStC)) then + LB(1:1) = lbound(ParamData%NStC) + UB(1:1) = ubound(ParamData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyParam(ParamData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%NStC) + end if + if (allocated(ParamData%TStC)) then + LB(1:1) = lbound(ParamData%TStC) + UB(1:1) = ubound(ParamData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyParam(ParamData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%TStC) + end if + if (allocated(ParamData%SStC)) then + LB(1:1) = lbound(ParamData%SStC) + UB(1:1) = ubound(ParamData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyParam(ParamData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%SStC) + end if + if (allocated(ParamData%StCMeasNumPerChan)) then + deallocate(ParamData%StCMeasNumPerChan) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%Jac_x_indx)) then + deallocate(ParamData%Jac_x_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) + end if + if (allocated(ParamData%Jac_Idx_BStC_u)) then + deallocate(ParamData%Jac_Idx_BStC_u) + end if + if (allocated(ParamData%Jac_Idx_NStC_u)) then + deallocate(ParamData%Jac_Idx_NStC_u) + end if + if (allocated(ParamData%Jac_Idx_TStC_u)) then + deallocate(ParamData%Jac_Idx_TStC_u) + end if + if (allocated(ParamData%Jac_Idx_SStC_u)) then + deallocate(ParamData%Jac_Idx_SStC_u) + end if + if (allocated(ParamData%Jac_Idx_BStC_x)) then + deallocate(ParamData%Jac_Idx_BStC_x) + end if + if (allocated(ParamData%Jac_Idx_NStC_x)) then + deallocate(ParamData%Jac_Idx_NStC_x) + end if + if (allocated(ParamData%Jac_Idx_TStC_x)) then + deallocate(ParamData%Jac_Idx_TStC_x) + end if + if (allocated(ParamData%Jac_Idx_SStC_x)) then + deallocate(ParamData%Jac_Idx_SStC_x) + end if + if (allocated(ParamData%Jac_Idx_BStC_y)) then + deallocate(ParamData%Jac_Idx_BStC_y) + end if + if (allocated(ParamData%Jac_Idx_NStC_y)) then + deallocate(ParamData%Jac_Idx_NStC_y) + end if + if (allocated(ParamData%Jac_Idx_TStC_y)) then + deallocate(ParamData%Jac_Idx_TStC_y) + end if + if (allocated(ParamData%Jac_Idx_SStC_y)) then + deallocate(ParamData%Jac_Idx_SStC_y) + end if +end subroutine + +subroutine SrvD_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%HSSBrDT) + call RegPack(Buf, InData%HSSBrTqF) + call RegPack(Buf, InData%SIG_POSl) + call RegPack(Buf, InData%SIG_POTq) + call RegPack(Buf, InData%SIG_SlPc) + call RegPack(Buf, InData%SIG_Slop) + call RegPack(Buf, InData%SIG_SySp) + call RegPack(Buf, InData%TEC_A0) + call RegPack(Buf, InData%TEC_C0) + call RegPack(Buf, InData%TEC_C1) + call RegPack(Buf, InData%TEC_C2) + call RegPack(Buf, InData%TEC_K2) + call RegPack(Buf, InData%TEC_MR) + call RegPack(Buf, InData%TEC_Re1) + call RegPack(Buf, InData%TEC_RLR) + call RegPack(Buf, InData%TEC_RRes) + call RegPack(Buf, InData%TEC_SRes) + call RegPack(Buf, InData%TEC_SySp) + call RegPack(Buf, InData%TEC_V1a) + call RegPack(Buf, InData%TEC_VLL) + call RegPack(Buf, InData%TEC_Xe1) + call RegPack(Buf, InData%GenEff) + call RegPack(Buf, allocated(InData%BlPitchInit)) + if (allocated(InData%BlPitchInit)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitchInit), ubound(InData%BlPitchInit)) + call RegPack(Buf, InData%BlPitchInit) + end if + call RegPack(Buf, allocated(InData%BlPitchF)) + if (allocated(InData%BlPitchF)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitchF), ubound(InData%BlPitchF)) + call RegPack(Buf, InData%BlPitchF) + end if + call RegPack(Buf, allocated(InData%PitManRat)) + if (allocated(InData%PitManRat)) then + call RegPackBounds(Buf, 1, lbound(InData%PitManRat), ubound(InData%PitManRat)) + call RegPack(Buf, InData%PitManRat) + end if + call RegPack(Buf, InData%YawManRat) + call RegPack(Buf, InData%NacYawF) + call RegPack(Buf, InData%SpdGenOn) + call RegPack(Buf, InData%THSSBrDp) + call RegPack(Buf, InData%THSSBrFl) + call RegPack(Buf, InData%TimGenOf) + call RegPack(Buf, InData%TimGenOn) + call RegPack(Buf, InData%TPCOn) + call RegPack(Buf, allocated(InData%TPitManS)) + if (allocated(InData%TPitManS)) then + call RegPackBounds(Buf, 1, lbound(InData%TPitManS), ubound(InData%TPitManS)) + call RegPack(Buf, InData%TPitManS) + end if + call RegPack(Buf, InData%TYawManS) + call RegPack(Buf, InData%TYCOn) + call RegPack(Buf, InData%VS_RtGnSp) + call RegPack(Buf, InData%VS_RtTq) + call RegPack(Buf, InData%VS_Slope) + call RegPack(Buf, InData%VS_SlPc) + call RegPack(Buf, InData%VS_SySp) + call RegPack(Buf, InData%VS_TrGnSp) + call RegPack(Buf, InData%YawPosCom) + call RegPack(Buf, InData%YawRateCom) + call RegPack(Buf, InData%GenModel) + call RegPack(Buf, InData%HSSBrMode) + call RegPack(Buf, InData%PCMode) + call RegPack(Buf, InData%VSContrl) + call RegPack(Buf, InData%YCMode) + call RegPack(Buf, InData%GenTiStp) + call RegPack(Buf, InData%GenTiStr) + call RegPack(Buf, InData%VS_Rgn2K) + call RegPack(Buf, InData%YawNeut) + call RegPack(Buf, InData%YawSpr) + call RegPack(Buf, InData%YawDamp) + call RegPack(Buf, InData%TpBrDT) + call RegPack(Buf, allocated(InData%TBDepISp)) + if (allocated(InData%TBDepISp)) then + call RegPackBounds(Buf, 1, lbound(InData%TBDepISp), ubound(InData%TBDepISp)) + call RegPack(Buf, InData%TBDepISp) + end if + call RegPack(Buf, InData%TBDrConN) + call RegPack(Buf, InData%TBDrConD) + call RegPack(Buf, InData%NumBl) + call RegPack(Buf, InData%NumBStC) + call RegPack(Buf, InData%NumNStC) + call RegPack(Buf, InData%NumTStC) + call RegPack(Buf, InData%NumSStC) + call RegPack(Buf, InData%AfCmode) + call RegPack(Buf, InData%AfC_Mean) + call RegPack(Buf, InData%AfC_Amp) + call RegPack(Buf, InData%AfC_Phase) + call RegPack(Buf, InData%CCmode) + call RegPack(Buf, InData%StCCmode) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%NumOuts_DLL) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + call RegPack(Buf, InData%Delim) + call RegPack(Buf, InData%UseBladedInterface) + call RegPack(Buf, InData%UseLegacyInterface) + call DLLTypePack(Buf, InData%DLL_Trgt) + call RegPack(Buf, InData%DLL_Ramp) + call RegPack(Buf, InData%BlAlpha) + call RegPack(Buf, InData%DLL_n) + call RegPack(Buf, InData%avcOUTNAME_LEN) + call RegPack(Buf, InData%NacYaw_North) + call RegPack(Buf, InData%AvgWindSpeed) + call RegPack(Buf, InData%AirDens) + call RegPack(Buf, InData%TrimCase) + call RegPack(Buf, InData%TrimGain) + call RegPack(Buf, InData%RotSpeedRef) + call RegPack(Buf, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackParam(Buf, InData%BStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackParam(Buf, InData%NStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackParam(Buf, InData%TStC(i1)) + end do + end if + call RegPack(Buf, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackParam(Buf, InData%SStC(i1)) + end do + end if + call RegPack(Buf, InData%InterpOrder) + call RegPack(Buf, InData%EXavrSWAP) + call RegPack(Buf, InData%NumCableControl) + call RegPack(Buf, InData%NumStC_Control) + call RegPack(Buf, allocated(InData%StCMeasNumPerChan)) + if (allocated(InData%StCMeasNumPerChan)) then + call RegPackBounds(Buf, 1, lbound(InData%StCMeasNumPerChan), ubound(InData%StCMeasNumPerChan)) + call RegPack(Buf, InData%StCMeasNumPerChan) + end if + call RegPack(Buf, InData%UseSC) + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + call RegPack(Buf, allocated(InData%Jac_x_indx)) + if (allocated(InData%Jac_x_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_x_indx), ubound(InData%Jac_x_indx)) + call RegPack(Buf, InData%Jac_x_indx) + end if + call RegPack(Buf, allocated(InData%du)) + if (allocated(InData%du)) then + call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPack(Buf, InData%du) + end if + call RegPack(Buf, allocated(InData%dx)) + if (allocated(InData%dx)) then + call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) + call RegPack(Buf, InData%dx) + end if + call RegPack(Buf, InData%Jac_nu) + call RegPack(Buf, InData%Jac_ny) + call RegPack(Buf, InData%Jac_nx) + call RegPack(Buf, allocated(InData%Jac_Idx_BStC_u)) + if (allocated(InData%Jac_Idx_BStC_u)) then + call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_u), ubound(InData%Jac_Idx_BStC_u)) + call RegPack(Buf, InData%Jac_Idx_BStC_u) + end if + call RegPack(Buf, allocated(InData%Jac_Idx_NStC_u)) + if (allocated(InData%Jac_Idx_NStC_u)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_u), ubound(InData%Jac_Idx_NStC_u)) + call RegPack(Buf, InData%Jac_Idx_NStC_u) + end if + call RegPack(Buf, allocated(InData%Jac_Idx_TStC_u)) + if (allocated(InData%Jac_Idx_TStC_u)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_u), ubound(InData%Jac_Idx_TStC_u)) + call RegPack(Buf, InData%Jac_Idx_TStC_u) + end if + call RegPack(Buf, allocated(InData%Jac_Idx_SStC_u)) + if (allocated(InData%Jac_Idx_SStC_u)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_u), ubound(InData%Jac_Idx_SStC_u)) + call RegPack(Buf, InData%Jac_Idx_SStC_u) + end if + call RegPack(Buf, allocated(InData%Jac_Idx_BStC_x)) + if (allocated(InData%Jac_Idx_BStC_x)) then + call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_x), ubound(InData%Jac_Idx_BStC_x)) + call RegPack(Buf, InData%Jac_Idx_BStC_x) + end if + call RegPack(Buf, allocated(InData%Jac_Idx_NStC_x)) + if (allocated(InData%Jac_Idx_NStC_x)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_x), ubound(InData%Jac_Idx_NStC_x)) + call RegPack(Buf, InData%Jac_Idx_NStC_x) + end if + call RegPack(Buf, allocated(InData%Jac_Idx_TStC_x)) + if (allocated(InData%Jac_Idx_TStC_x)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_x), ubound(InData%Jac_Idx_TStC_x)) + call RegPack(Buf, InData%Jac_Idx_TStC_x) + end if + call RegPack(Buf, allocated(InData%Jac_Idx_SStC_x)) + if (allocated(InData%Jac_Idx_SStC_x)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_x), ubound(InData%Jac_Idx_SStC_x)) + call RegPack(Buf, InData%Jac_Idx_SStC_x) + end if + call RegPack(Buf, allocated(InData%Jac_Idx_BStC_y)) + if (allocated(InData%Jac_Idx_BStC_y)) then + call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_y), ubound(InData%Jac_Idx_BStC_y)) + call RegPack(Buf, InData%Jac_Idx_BStC_y) + end if + call RegPack(Buf, allocated(InData%Jac_Idx_NStC_y)) + if (allocated(InData%Jac_Idx_NStC_y)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_y), ubound(InData%Jac_Idx_NStC_y)) + call RegPack(Buf, InData%Jac_Idx_NStC_y) + end if + call RegPack(Buf, allocated(InData%Jac_Idx_TStC_y)) + if (allocated(InData%Jac_Idx_TStC_y)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_y), ubound(InData%Jac_Idx_TStC_y)) + call RegPack(Buf, InData%Jac_Idx_TStC_y) + end if + call RegPack(Buf, allocated(InData%Jac_Idx_SStC_y)) + if (allocated(InData%Jac_Idx_SStC_y)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_y), ubound(InData%Jac_Idx_SStC_y)) + call RegPack(Buf, InData%Jac_Idx_SStC_y) + end if + call RegPack(Buf, InData%SensorType) + call RegPack(Buf, InData%NumBeam) + call RegPack(Buf, InData%NumPulseGate) + call RegPack(Buf, InData%PulseSpacing) + call RegPack(Buf, InData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HSSBrDT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HSSBrTqF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SIG_POSl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SIG_POTq) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SIG_SlPc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SIG_Slop) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SIG_SySp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_A0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_C0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_C1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_C2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_K2) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_MR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_Re1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_RLR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_RRes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_SRes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_SySp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_V1a) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_VLL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TEC_Xe1) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenEff) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BlPitchInit)) deallocate(OutData%BlPitchInit) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitchInit(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitchInit) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlPitchF)) deallocate(OutData%BlPitchF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitchF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitchF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PitManRat)) deallocate(OutData%PitManRat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PitManRat(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitManRat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PitManRat) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%YawManRat) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacYawF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SpdGenOn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%THSSBrDp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%THSSBrFl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TimGenOf) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TimGenOn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TPCOn) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TPitManS)) deallocate(OutData%TPitManS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TPitManS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TPitManS) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%TYawManS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TYCOn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VS_RtGnSp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VS_RtTq) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VS_Slope) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VS_SlPc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VS_SySp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VS_TrGnSp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawPosCom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawRateCom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenModel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HSSBrMode) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PCMode) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VSContrl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YCMode) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenTiStp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenTiStr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VS_Rgn2K) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawNeut) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawSpr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawDamp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TpBrDT) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TBDepISp)) deallocate(OutData%TBDepISp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TBDepISp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDepISp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TBDepISp) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%TBDrConN) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TBDrConD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBStC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumNStC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumTStC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumSStC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AfCmode) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AfC_Mean) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AfC_Amp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AfC_Phase) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CCmode) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StCCmode) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts_DLL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UseBladedInterface) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UseLegacyInterface) + if (RegCheckErr(Buf, RoutineName)) return + call DLLTypeUnpack(Buf, OutData%DLL_Trgt) ! DLL_Trgt + call RegUnpack(Buf, OutData%DLL_Ramp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%BlAlpha) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DLL_n) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%avcOUTNAME_LEN) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NacYaw_North) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AvgWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TrimCase) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TrimGain) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotSpeedRef) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackParam(Buf, OutData%BStC(i1)) ! BStC + end do + end if + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackParam(Buf, OutData%NStC(i1)) ! NStC + end do + end if + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackParam(Buf, OutData%TStC(i1)) ! TStC + end do + end if + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackParam(Buf, OutData%SStC(i1)) ! SStC + end do + end if + call RegUnpack(Buf, OutData%InterpOrder) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%EXavrSWAP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumCableControl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumStC_Control) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%StCMeasNumPerChan)) deallocate(OutData%StCMeasNumPerChan) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StCMeasNumPerChan(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasNumPerChan.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StCMeasNumPerChan) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%UseSC) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jac_x_indx)) deallocate(OutData%Jac_x_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_x_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_x_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_x_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%du)) deallocate(OutData%du) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%du(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dx)) deallocate(OutData%dx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Jac_nu) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Jac_nx) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Jac_Idx_BStC_u)) deallocate(OutData%Jac_Idx_BStC_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_BStC_u(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_BStC_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_BStC_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jac_Idx_NStC_u)) deallocate(OutData%Jac_Idx_NStC_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_NStC_u(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_NStC_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jac_Idx_TStC_u)) deallocate(OutData%Jac_Idx_TStC_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_TStC_u(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_TStC_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jac_Idx_SStC_u)) deallocate(OutData%Jac_Idx_SStC_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_SStC_u(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_SStC_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jac_Idx_BStC_x)) deallocate(OutData%Jac_Idx_BStC_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_BStC_x(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_BStC_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_BStC_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jac_Idx_NStC_x)) deallocate(OutData%Jac_Idx_NStC_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_NStC_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_NStC_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jac_Idx_TStC_x)) deallocate(OutData%Jac_Idx_TStC_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_TStC_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_TStC_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jac_Idx_SStC_x)) deallocate(OutData%Jac_Idx_SStC_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_SStC_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_SStC_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jac_Idx_BStC_y)) deallocate(OutData%Jac_Idx_BStC_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_BStC_y(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_BStC_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_BStC_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jac_Idx_NStC_y)) deallocate(OutData%Jac_Idx_NStC_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_NStC_y(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_NStC_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jac_Idx_TStC_y)) deallocate(OutData%Jac_Idx_TStC_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_TStC_y(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_TStC_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Jac_Idx_SStC_y)) deallocate(OutData%Jac_Idx_SStC_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_SStC_y(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_SStC_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumBeam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PulseSpacing) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_InputType), intent(inout) :: SrcInputData + type(SrvD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%BlPitch)) then + LB(1:1) = lbound(SrcInputData%BlPitch) + UB(1:1) = ubound(SrcInputData%BlPitch) + if (.not. allocated(DstInputData%BlPitch)) then + allocate(DstInputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%BlPitch = SrcInputData%BlPitch + end if + DstInputData%Yaw = SrcInputData%Yaw + DstInputData%YawRate = SrcInputData%YawRate + DstInputData%LSS_Spd = SrcInputData%LSS_Spd + DstInputData%HSS_Spd = SrcInputData%HSS_Spd + DstInputData%RotSpeed = SrcInputData%RotSpeed + DstInputData%ExternalYawPosCom = SrcInputData%ExternalYawPosCom + DstInputData%ExternalYawRateCom = SrcInputData%ExternalYawRateCom + if (allocated(SrcInputData%ExternalBlPitchCom)) then + LB(1:1) = lbound(SrcInputData%ExternalBlPitchCom) + UB(1:1) = ubound(SrcInputData%ExternalBlPitchCom) + if (.not. allocated(DstInputData%ExternalBlPitchCom)) then + allocate(DstInputData%ExternalBlPitchCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlPitchCom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%ExternalBlPitchCom = SrcInputData%ExternalBlPitchCom + end if + DstInputData%ExternalGenTrq = SrcInputData%ExternalGenTrq + DstInputData%ExternalElecPwr = SrcInputData%ExternalElecPwr + DstInputData%ExternalHSSBrFrac = SrcInputData%ExternalHSSBrFrac + if (allocated(SrcInputData%ExternalBlAirfoilCom)) then + LB(1:1) = lbound(SrcInputData%ExternalBlAirfoilCom) + UB(1:1) = ubound(SrcInputData%ExternalBlAirfoilCom) + if (.not. allocated(DstInputData%ExternalBlAirfoilCom)) then + allocate(DstInputData%ExternalBlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlAirfoilCom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%ExternalBlAirfoilCom = SrcInputData%ExternalBlAirfoilCom + end if + if (allocated(SrcInputData%ExternalCableDeltaL)) then + LB(1:1) = lbound(SrcInputData%ExternalCableDeltaL) + UB(1:1) = ubound(SrcInputData%ExternalCableDeltaL) + if (.not. allocated(DstInputData%ExternalCableDeltaL)) then + allocate(DstInputData%ExternalCableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%ExternalCableDeltaL = SrcInputData%ExternalCableDeltaL + end if + if (allocated(SrcInputData%ExternalCableDeltaLdot)) then + LB(1:1) = lbound(SrcInputData%ExternalCableDeltaLdot) + UB(1:1) = ubound(SrcInputData%ExternalCableDeltaLdot) + if (.not. allocated(DstInputData%ExternalCableDeltaLdot)) then + allocate(DstInputData%ExternalCableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%ExternalCableDeltaLdot = SrcInputData%ExternalCableDeltaLdot + end if + DstInputData%TwrAccel = SrcInputData%TwrAccel + DstInputData%YawErr = SrcInputData%YawErr + DstInputData%WindDir = SrcInputData%WindDir + DstInputData%RootMyc = SrcInputData%RootMyc + DstInputData%YawBrTAxp = SrcInputData%YawBrTAxp + DstInputData%YawBrTAyp = SrcInputData%YawBrTAyp + DstInputData%LSSTipPxa = SrcInputData%LSSTipPxa + DstInputData%RootMxc = SrcInputData%RootMxc + DstInputData%LSSTipMxa = SrcInputData%LSSTipMxa + DstInputData%LSSTipMya = SrcInputData%LSSTipMya + DstInputData%LSSTipMza = SrcInputData%LSSTipMza + DstInputData%LSSTipMys = SrcInputData%LSSTipMys + DstInputData%LSSTipMzs = SrcInputData%LSSTipMzs + DstInputData%YawBrMyn = SrcInputData%YawBrMyn + DstInputData%YawBrMzn = SrcInputData%YawBrMzn + DstInputData%NcIMURAxs = SrcInputData%NcIMURAxs + DstInputData%NcIMURAys = SrcInputData%NcIMURAys + DstInputData%NcIMURAzs = SrcInputData%NcIMURAzs + DstInputData%RotPwr = SrcInputData%RotPwr + DstInputData%HorWindV = SrcInputData%HorWindV + DstInputData%YawAngle = SrcInputData%YawAngle + DstInputData%LSShftFxa = SrcInputData%LSShftFxa + DstInputData%LSShftFys = SrcInputData%LSShftFys + DstInputData%LSShftFzs = SrcInputData%LSShftFzs + if (allocated(SrcInputData%fromSC)) then + LB(1:1) = lbound(SrcInputData%fromSC) + UB(1:1) = ubound(SrcInputData%fromSC) + if (.not. allocated(DstInputData%fromSC)) then + allocate(DstInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%fromSC = SrcInputData%fromSC + end if + if (allocated(SrcInputData%fromSCglob)) then + LB(1:1) = lbound(SrcInputData%fromSCglob) + UB(1:1) = ubound(SrcInputData%fromSCglob) + if (.not. allocated(DstInputData%fromSCglob)) then + allocate(DstInputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSCglob.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%fromSCglob = SrcInputData%fromSCglob + end if + if (allocated(SrcInputData%Lidar)) then + LB(1:1) = lbound(SrcInputData%Lidar) + UB(1:1) = ubound(SrcInputData%Lidar) + if (.not. allocated(DstInputData%Lidar)) then + allocate(DstInputData%Lidar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Lidar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Lidar = SrcInputData%Lidar + end if + call MeshCopy(SrcInputData%PtfmMotionMesh, DstInputData%PtfmMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%BStCMotionMesh)) then + LB(1:2) = lbound(SrcInputData%BStCMotionMesh) + UB(1:2) = ubound(SrcInputData%BStCMotionMesh) + if (.not. allocated(DstInputData%BStCMotionMesh)) then + allocate(DstInputData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%BStCMotionMesh(i1,i2), DstInputData%BStCMotionMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcInputData%NStCMotionMesh)) then + LB(1:1) = lbound(SrcInputData%NStCMotionMesh) + UB(1:1) = ubound(SrcInputData%NStCMotionMesh) + if (.not. allocated(DstInputData%NStCMotionMesh)) then + allocate(DstInputData%NStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%NStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%NStCMotionMesh(i1), DstInputData%NStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%TStCMotionMesh)) then + LB(1:1) = lbound(SrcInputData%TStCMotionMesh) + UB(1:1) = ubound(SrcInputData%TStCMotionMesh) + if (.not. allocated(DstInputData%TStCMotionMesh)) then + allocate(DstInputData%TStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%TStCMotionMesh(i1), DstInputData%TStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%SStCMotionMesh)) then + LB(1:1) = lbound(SrcInputData%SStCMotionMesh) + UB(1:1) = ubound(SrcInputData%SStCMotionMesh) + if (.not. allocated(DstInputData%SStCMotionMesh)) then + allocate(DstInputData%SStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%SStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%SStCMotionMesh(i1), DstInputData%SStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%LidSpeed)) then + LB(1:1) = lbound(SrcInputData%LidSpeed) + UB(1:1) = ubound(SrcInputData%LidSpeed) + if (.not. allocated(DstInputData%LidSpeed)) then + allocate(DstInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%LidSpeed.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%LidSpeed = SrcInputData%LidSpeed + end if + if (allocated(SrcInputData%MsrPositionsX)) then + LB(1:1) = lbound(SrcInputData%MsrPositionsX) + UB(1:1) = ubound(SrcInputData%MsrPositionsX) + if (.not. allocated(DstInputData%MsrPositionsX)) then + allocate(DstInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%MsrPositionsX = SrcInputData%MsrPositionsX + end if + if (allocated(SrcInputData%MsrPositionsY)) then + LB(1:1) = lbound(SrcInputData%MsrPositionsY) + UB(1:1) = ubound(SrcInputData%MsrPositionsY) + if (.not. allocated(DstInputData%MsrPositionsY)) then + allocate(DstInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%MsrPositionsY = SrcInputData%MsrPositionsY + end if + if (allocated(SrcInputData%MsrPositionsZ)) then + LB(1:1) = lbound(SrcInputData%MsrPositionsZ) + UB(1:1) = ubound(SrcInputData%MsrPositionsZ) + if (.not. allocated(DstInputData%MsrPositionsZ)) then + allocate(DstInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%MsrPositionsZ = SrcInputData%MsrPositionsZ + end if +end subroutine + +subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) + type(SrvD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%BlPitch)) then + deallocate(InputData%BlPitch) + end if + if (allocated(InputData%ExternalBlPitchCom)) then + deallocate(InputData%ExternalBlPitchCom) + end if + if (allocated(InputData%ExternalBlAirfoilCom)) then + deallocate(InputData%ExternalBlAirfoilCom) + end if + if (allocated(InputData%ExternalCableDeltaL)) then + deallocate(InputData%ExternalCableDeltaL) + end if + if (allocated(InputData%ExternalCableDeltaLdot)) then + deallocate(InputData%ExternalCableDeltaLdot) + end if + if (allocated(InputData%fromSC)) then + deallocate(InputData%fromSC) + end if + if (allocated(InputData%fromSCglob)) then + deallocate(InputData%fromSCglob) + end if + if (allocated(InputData%Lidar)) then + deallocate(InputData%Lidar) + end if + call MeshDestroy( InputData%PtfmMotionMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputData%BStCMotionMesh)) then + LB(1:2) = lbound(InputData%BStCMotionMesh) + UB(1:2) = ubound(InputData%BStCMotionMesh) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%BStCMotionMesh(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(InputData%BStCMotionMesh) + end if + if (allocated(InputData%NStCMotionMesh)) then + LB(1:1) = lbound(InputData%NStCMotionMesh) + UB(1:1) = ubound(InputData%NStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%NStCMotionMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%NStCMotionMesh) + end if + if (allocated(InputData%TStCMotionMesh)) then + LB(1:1) = lbound(InputData%TStCMotionMesh) + UB(1:1) = ubound(InputData%TStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%TStCMotionMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%TStCMotionMesh) + end if + if (allocated(InputData%SStCMotionMesh)) then + LB(1:1) = lbound(InputData%SStCMotionMesh) + UB(1:1) = ubound(InputData%SStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%SStCMotionMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%SStCMotionMesh) + end if + if (allocated(InputData%LidSpeed)) then + deallocate(InputData%LidSpeed) + end if + if (allocated(InputData%MsrPositionsX)) then + deallocate(InputData%MsrPositionsX) + end if + if (allocated(InputData%MsrPositionsY)) then + deallocate(InputData%MsrPositionsY) + end if + if (allocated(InputData%MsrPositionsZ)) then + deallocate(InputData%MsrPositionsZ) + end if +end subroutine + +subroutine SrvD_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%BlPitch)) + if (allocated(InData%BlPitch)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) + call RegPack(Buf, InData%BlPitch) + end if + call RegPack(Buf, InData%Yaw) + call RegPack(Buf, InData%YawRate) + call RegPack(Buf, InData%LSS_Spd) + call RegPack(Buf, InData%HSS_Spd) + call RegPack(Buf, InData%RotSpeed) + call RegPack(Buf, InData%ExternalYawPosCom) + call RegPack(Buf, InData%ExternalYawRateCom) + call RegPack(Buf, allocated(InData%ExternalBlPitchCom)) + if (allocated(InData%ExternalBlPitchCom)) then + call RegPackBounds(Buf, 1, lbound(InData%ExternalBlPitchCom), ubound(InData%ExternalBlPitchCom)) + call RegPack(Buf, InData%ExternalBlPitchCom) + end if + call RegPack(Buf, InData%ExternalGenTrq) + call RegPack(Buf, InData%ExternalElecPwr) + call RegPack(Buf, InData%ExternalHSSBrFrac) + call RegPack(Buf, allocated(InData%ExternalBlAirfoilCom)) + if (allocated(InData%ExternalBlAirfoilCom)) then + call RegPackBounds(Buf, 1, lbound(InData%ExternalBlAirfoilCom), ubound(InData%ExternalBlAirfoilCom)) + call RegPack(Buf, InData%ExternalBlAirfoilCom) + end if + call RegPack(Buf, allocated(InData%ExternalCableDeltaL)) + if (allocated(InData%ExternalCableDeltaL)) then + call RegPackBounds(Buf, 1, lbound(InData%ExternalCableDeltaL), ubound(InData%ExternalCableDeltaL)) + call RegPack(Buf, InData%ExternalCableDeltaL) + end if + call RegPack(Buf, allocated(InData%ExternalCableDeltaLdot)) + if (allocated(InData%ExternalCableDeltaLdot)) then + call RegPackBounds(Buf, 1, lbound(InData%ExternalCableDeltaLdot), ubound(InData%ExternalCableDeltaLdot)) + call RegPack(Buf, InData%ExternalCableDeltaLdot) + end if + call RegPack(Buf, InData%TwrAccel) + call RegPack(Buf, InData%YawErr) + call RegPack(Buf, InData%WindDir) + call RegPack(Buf, InData%RootMyc) + call RegPack(Buf, InData%YawBrTAxp) + call RegPack(Buf, InData%YawBrTAyp) + call RegPack(Buf, InData%LSSTipPxa) + call RegPack(Buf, InData%RootMxc) + call RegPack(Buf, InData%LSSTipMxa) + call RegPack(Buf, InData%LSSTipMya) + call RegPack(Buf, InData%LSSTipMza) + call RegPack(Buf, InData%LSSTipMys) + call RegPack(Buf, InData%LSSTipMzs) + call RegPack(Buf, InData%YawBrMyn) + call RegPack(Buf, InData%YawBrMzn) + call RegPack(Buf, InData%NcIMURAxs) + call RegPack(Buf, InData%NcIMURAys) + call RegPack(Buf, InData%NcIMURAzs) + call RegPack(Buf, InData%RotPwr) + call RegPack(Buf, InData%HorWindV) + call RegPack(Buf, InData%YawAngle) + call RegPack(Buf, InData%LSShftFxa) + call RegPack(Buf, InData%LSShftFys) + call RegPack(Buf, InData%LSShftFzs) + call RegPack(Buf, allocated(InData%fromSC)) + if (allocated(InData%fromSC)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPack(Buf, InData%fromSC) + end if + call RegPack(Buf, allocated(InData%fromSCglob)) + if (allocated(InData%fromSCglob)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) + call RegPack(Buf, InData%fromSCglob) + end if + call RegPack(Buf, allocated(InData%Lidar)) + if (allocated(InData%Lidar)) then + call RegPackBounds(Buf, 1, lbound(InData%Lidar), ubound(InData%Lidar)) + call RegPack(Buf, InData%Lidar) + end if + call MeshPack(Buf, InData%PtfmMotionMesh) + call RegPack(Buf, allocated(InData%BStCMotionMesh)) + if (allocated(InData%BStCMotionMesh)) then + call RegPackBounds(Buf, 2, lbound(InData%BStCMotionMesh), ubound(InData%BStCMotionMesh)) + LB(1:2) = lbound(InData%BStCMotionMesh) + UB(1:2) = ubound(InData%BStCMotionMesh) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BStCMotionMesh(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%NStCMotionMesh)) + if (allocated(InData%NStCMotionMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%NStCMotionMesh), ubound(InData%NStCMotionMesh)) + LB(1:1) = lbound(InData%NStCMotionMesh) + UB(1:1) = ubound(InData%NStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%NStCMotionMesh(i1)) + end do + end if + call RegPack(Buf, allocated(InData%TStCMotionMesh)) + if (allocated(InData%TStCMotionMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%TStCMotionMesh), ubound(InData%TStCMotionMesh)) + LB(1:1) = lbound(InData%TStCMotionMesh) + UB(1:1) = ubound(InData%TStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%TStCMotionMesh(i1)) + end do + end if + call RegPack(Buf, allocated(InData%SStCMotionMesh)) + if (allocated(InData%SStCMotionMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%SStCMotionMesh), ubound(InData%SStCMotionMesh)) + LB(1:1) = lbound(InData%SStCMotionMesh) + UB(1:1) = ubound(InData%SStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%SStCMotionMesh(i1)) + end do + end if + call RegPack(Buf, allocated(InData%LidSpeed)) + if (allocated(InData%LidSpeed)) then + call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) + call RegPack(Buf, InData%LidSpeed) + end if + call RegPack(Buf, allocated(InData%MsrPositionsX)) + if (allocated(InData%MsrPositionsX)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) + call RegPack(Buf, InData%MsrPositionsX) + end if + call RegPack(Buf, allocated(InData%MsrPositionsY)) + if (allocated(InData%MsrPositionsY)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) + call RegPack(Buf, InData%MsrPositionsY) + end if + call RegPack(Buf, allocated(InData%MsrPositionsZ)) + if (allocated(InData%MsrPositionsZ)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) + call RegPack(Buf, InData%MsrPositionsZ) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitch(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitch) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Yaw) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawRate) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSS_Spd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HSS_Spd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ExternalYawPosCom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ExternalYawRateCom) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ExternalBlPitchCom)) deallocate(OutData%ExternalBlPitchCom) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ExternalBlPitchCom(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalBlPitchCom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ExternalBlPitchCom) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%ExternalGenTrq) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ExternalElecPwr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ExternalHSSBrFrac) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ExternalBlAirfoilCom)) deallocate(OutData%ExternalBlAirfoilCom) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ExternalBlAirfoilCom(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalBlAirfoilCom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ExternalBlAirfoilCom) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ExternalCableDeltaL)) deallocate(OutData%ExternalCableDeltaL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ExternalCableDeltaL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalCableDeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ExternalCableDeltaL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ExternalCableDeltaLdot)) deallocate(OutData%ExternalCableDeltaLdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ExternalCableDeltaLdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalCableDeltaLdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ExternalCableDeltaLdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%TwrAccel) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawErr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WindDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootMyc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawBrTAxp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawBrTAyp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipPxa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootMxc) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipMxa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipMya) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipMza) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipMys) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSSTipMzs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawBrMyn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawBrMzn) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NcIMURAxs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NcIMURAys) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NcIMURAzs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotPwr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HorWindV) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawAngle) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSShftFxa) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSShftFys) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LSShftFzs) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSCglob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSCglob) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Lidar)) deallocate(OutData%Lidar) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Lidar(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lidar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Lidar) + if (RegCheckErr(Buf, RoutineName)) return + end if + call MeshUnpack(Buf, OutData%PtfmMotionMesh) ! PtfmMotionMesh + if (allocated(OutData%BStCMotionMesh)) deallocate(OutData%BStCMotionMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCMotionMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BStCMotionMesh(i1,i2)) ! BStCMotionMesh + end do + end do + end if + if (allocated(OutData%NStCMotionMesh)) deallocate(OutData%NStCMotionMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStCMotionMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCMotionMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%NStCMotionMesh(i1)) ! NStCMotionMesh + end do + end if + if (allocated(OutData%TStCMotionMesh)) deallocate(OutData%TStCMotionMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStCMotionMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCMotionMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%TStCMotionMesh(i1)) ! TStCMotionMesh + end do + end if + if (allocated(OutData%SStCMotionMesh)) deallocate(OutData%SStCMotionMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStCMotionMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCMotionMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%SStCMotionMesh(i1)) ! SStCMotionMesh + end do + end if + if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LidSpeed(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LidSpeed) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsY) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsZ) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_OutputType), intent(inout) :: SrcOutputData + type(SrvD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if + if (allocated(SrcOutputData%BlPitchCom)) then + LB(1:1) = lbound(SrcOutputData%BlPitchCom) + UB(1:1) = ubound(SrcOutputData%BlPitchCom) + if (.not. allocated(DstOutputData%BlPitchCom)) then + allocate(DstOutputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitchCom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%BlPitchCom = SrcOutputData%BlPitchCom + end if + if (allocated(SrcOutputData%BlAirfoilCom)) then + LB(1:1) = lbound(SrcOutputData%BlAirfoilCom) + UB(1:1) = ubound(SrcOutputData%BlAirfoilCom) + if (.not. allocated(DstOutputData%BlAirfoilCom)) then + allocate(DstOutputData%BlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlAirfoilCom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%BlAirfoilCom = SrcOutputData%BlAirfoilCom + end if + DstOutputData%YawMom = SrcOutputData%YawMom + DstOutputData%GenTrq = SrcOutputData%GenTrq + DstOutputData%HSSBrTrqC = SrcOutputData%HSSBrTrqC + DstOutputData%ElecPwr = SrcOutputData%ElecPwr + if (allocated(SrcOutputData%TBDrCon)) then + LB(1:1) = lbound(SrcOutputData%TBDrCon) + UB(1:1) = ubound(SrcOutputData%TBDrCon) + if (.not. allocated(DstOutputData%TBDrCon)) then + allocate(DstOutputData%TBDrCon(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TBDrCon.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%TBDrCon = SrcOutputData%TBDrCon + end if + if (allocated(SrcOutputData%Lidar)) then + LB(1:1) = lbound(SrcOutputData%Lidar) + UB(1:1) = ubound(SrcOutputData%Lidar) + if (.not. allocated(DstOutputData%Lidar)) then + allocate(DstOutputData%Lidar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Lidar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Lidar = SrcOutputData%Lidar + end if + if (allocated(SrcOutputData%CableDeltaL)) then + LB(1:1) = lbound(SrcOutputData%CableDeltaL) + UB(1:1) = ubound(SrcOutputData%CableDeltaL) + if (.not. allocated(DstOutputData%CableDeltaL)) then + allocate(DstOutputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%CableDeltaL = SrcOutputData%CableDeltaL + end if + if (allocated(SrcOutputData%CableDeltaLdot)) then + LB(1:1) = lbound(SrcOutputData%CableDeltaLdot) + UB(1:1) = ubound(SrcOutputData%CableDeltaLdot) + if (.not. allocated(DstOutputData%CableDeltaLdot)) then + allocate(DstOutputData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%CableDeltaLdot = SrcOutputData%CableDeltaLdot + end if + if (allocated(SrcOutputData%BStCLoadMesh)) then + LB(1:2) = lbound(SrcOutputData%BStCLoadMesh) + UB(1:2) = ubound(SrcOutputData%BStCLoadMesh) + if (.not. allocated(DstOutputData%BStCLoadMesh)) then + allocate(DstOutputData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%BStCLoadMesh(i1,i2), DstOutputData%BStCLoadMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcOutputData%NStCLoadMesh)) then + LB(1:1) = lbound(SrcOutputData%NStCLoadMesh) + UB(1:1) = ubound(SrcOutputData%NStCLoadMesh) + if (.not. allocated(DstOutputData%NStCLoadMesh)) then + allocate(DstOutputData%NStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%NStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%NStCLoadMesh(i1), DstOutputData%NStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%TStCLoadMesh)) then + LB(1:1) = lbound(SrcOutputData%TStCLoadMesh) + UB(1:1) = ubound(SrcOutputData%TStCLoadMesh) + if (.not. allocated(DstOutputData%TStCLoadMesh)) then + allocate(DstOutputData%TStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%TStCLoadMesh(i1), DstOutputData%TStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%SStCLoadMesh)) then + LB(1:1) = lbound(SrcOutputData%SStCLoadMesh) + UB(1:1) = ubound(SrcOutputData%SStCLoadMesh) + if (.not. allocated(DstOutputData%SStCLoadMesh)) then + allocate(DstOutputData%SStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%SStCLoadMesh(i1), DstOutputData%SStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%toSC)) then + LB(1:1) = lbound(SrcOutputData%toSC) + UB(1:1) = ubound(SrcOutputData%toSC) + if (.not. allocated(DstOutputData%toSC)) then + allocate(DstOutputData%toSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%toSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%toSC = SrcOutputData%toSC + end if +end subroutine + +subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SrvD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + if (allocated(OutputData%BlPitchCom)) then + deallocate(OutputData%BlPitchCom) + end if + if (allocated(OutputData%BlAirfoilCom)) then + deallocate(OutputData%BlAirfoilCom) + end if + if (allocated(OutputData%TBDrCon)) then + deallocate(OutputData%TBDrCon) + end if + if (allocated(OutputData%Lidar)) then + deallocate(OutputData%Lidar) + end if + if (allocated(OutputData%CableDeltaL)) then + deallocate(OutputData%CableDeltaL) + end if + if (allocated(OutputData%CableDeltaLdot)) then + deallocate(OutputData%CableDeltaLdot) + end if + if (allocated(OutputData%BStCLoadMesh)) then + LB(1:2) = lbound(OutputData%BStCLoadMesh) + UB(1:2) = ubound(OutputData%BStCLoadMesh) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%BStCLoadMesh(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(OutputData%BStCLoadMesh) + end if + if (allocated(OutputData%NStCLoadMesh)) then + LB(1:1) = lbound(OutputData%NStCLoadMesh) + UB(1:1) = ubound(OutputData%NStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%NStCLoadMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%NStCLoadMesh) + end if + if (allocated(OutputData%TStCLoadMesh)) then + LB(1:1) = lbound(OutputData%TStCLoadMesh) + UB(1:1) = ubound(OutputData%TStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%TStCLoadMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%TStCLoadMesh) + end if + if (allocated(OutputData%SStCLoadMesh)) then + LB(1:1) = lbound(OutputData%SStCLoadMesh) + UB(1:1) = ubound(OutputData%SStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%SStCLoadMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%SStCLoadMesh) + end if + if (allocated(OutputData%toSC)) then + deallocate(OutputData%toSC) + end if +end subroutine + +subroutine SrvD_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackOutput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + call RegPack(Buf, allocated(InData%BlPitchCom)) + if (allocated(InData%BlPitchCom)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitchCom), ubound(InData%BlPitchCom)) + call RegPack(Buf, InData%BlPitchCom) + end if + call RegPack(Buf, allocated(InData%BlAirfoilCom)) + if (allocated(InData%BlAirfoilCom)) then + call RegPackBounds(Buf, 1, lbound(InData%BlAirfoilCom), ubound(InData%BlAirfoilCom)) + call RegPack(Buf, InData%BlAirfoilCom) + end if + call RegPack(Buf, InData%YawMom) + call RegPack(Buf, InData%GenTrq) + call RegPack(Buf, InData%HSSBrTrqC) + call RegPack(Buf, InData%ElecPwr) + call RegPack(Buf, allocated(InData%TBDrCon)) + if (allocated(InData%TBDrCon)) then + call RegPackBounds(Buf, 1, lbound(InData%TBDrCon), ubound(InData%TBDrCon)) + call RegPack(Buf, InData%TBDrCon) + end if + call RegPack(Buf, allocated(InData%Lidar)) + if (allocated(InData%Lidar)) then + call RegPackBounds(Buf, 1, lbound(InData%Lidar), ubound(InData%Lidar)) + call RegPack(Buf, InData%Lidar) + end if + call RegPack(Buf, allocated(InData%CableDeltaL)) + if (allocated(InData%CableDeltaL)) then + call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL), ubound(InData%CableDeltaL)) + call RegPack(Buf, InData%CableDeltaL) + end if + call RegPack(Buf, allocated(InData%CableDeltaLdot)) + if (allocated(InData%CableDeltaLdot)) then + call RegPackBounds(Buf, 1, lbound(InData%CableDeltaLdot), ubound(InData%CableDeltaLdot)) + call RegPack(Buf, InData%CableDeltaLdot) + end if + call RegPack(Buf, allocated(InData%BStCLoadMesh)) + if (allocated(InData%BStCLoadMesh)) then + call RegPackBounds(Buf, 2, lbound(InData%BStCLoadMesh), ubound(InData%BStCLoadMesh)) + LB(1:2) = lbound(InData%BStCLoadMesh) + UB(1:2) = ubound(InData%BStCLoadMesh) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BStCLoadMesh(i1,i2)) + end do + end do + end if + call RegPack(Buf, allocated(InData%NStCLoadMesh)) + if (allocated(InData%NStCLoadMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%NStCLoadMesh), ubound(InData%NStCLoadMesh)) + LB(1:1) = lbound(InData%NStCLoadMesh) + UB(1:1) = ubound(InData%NStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%NStCLoadMesh(i1)) + end do + end if + call RegPack(Buf, allocated(InData%TStCLoadMesh)) + if (allocated(InData%TStCLoadMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%TStCLoadMesh), ubound(InData%TStCLoadMesh)) + LB(1:1) = lbound(InData%TStCLoadMesh) + UB(1:1) = ubound(InData%TStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%TStCLoadMesh(i1)) + end do + end if + call RegPack(Buf, allocated(InData%SStCLoadMesh)) + if (allocated(InData%SStCLoadMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%SStCLoadMesh), ubound(InData%SStCLoadMesh)) + LB(1:1) = lbound(InData%SStCLoadMesh) + UB(1:1) = ubound(InData%SStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%SStCLoadMesh(i1)) + end do + end if + call RegPack(Buf, allocated(InData%toSC)) + if (allocated(InData%toSC)) then + call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) + call RegPack(Buf, InData%toSC) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackOutput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlPitchCom)) deallocate(OutData%BlPitchCom) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitchCom(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitchCom) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BlAirfoilCom)) deallocate(OutData%BlAirfoilCom) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlAirfoilCom(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAirfoilCom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlAirfoilCom) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%YawMom) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GenTrq) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%HSSBrTrqC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ElecPwr) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%TBDrCon)) deallocate(OutData%TBDrCon) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TBDrCon(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDrCon.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TBDrCon) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Lidar)) deallocate(OutData%Lidar) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Lidar(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lidar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Lidar) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CableDeltaL)) deallocate(OutData%CableDeltaL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableDeltaL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableDeltaL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CableDeltaLdot)) deallocate(OutData%CableDeltaLdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableDeltaLdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaLdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableDeltaLdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%BStCLoadMesh)) deallocate(OutData%BStCLoadMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCLoadMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BStCLoadMesh(i1,i2)) ! BStCLoadMesh + end do + end do + end if + if (allocated(OutData%NStCLoadMesh)) deallocate(OutData%NStCLoadMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStCLoadMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCLoadMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%NStCLoadMesh(i1)) ! NStCLoadMesh + end do + end if + if (allocated(OutData%TStCLoadMesh)) deallocate(OutData%TStCLoadMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStCLoadMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCLoadMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%TStCLoadMesh(i1)) ! TStCLoadMesh + end do + end if + if (allocated(OutData%SStCLoadMesh)) deallocate(OutData%SStCLoadMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStCLoadMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCLoadMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%SStCLoadMesh(i1)) ! SStCLoadMesh + end do + end if + if (allocated(OutData%toSC)) deallocate(OutData%toSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%toSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%toSC) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SrvD_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(SrvD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(SrvD_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 = 'SrvD_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 SrvD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SrvD_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 SrvD_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 SrvD_Input_ExtrapInterp - - - SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SrvD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SrvD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SrvD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SrvD_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. @@ -18190,208 +8608,146 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(SrvD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(SrvD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SrvD_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 + TYPE(SrvD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(SrvD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SrvD_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 = 'SrvD_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 - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) - CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) - END DO -END IF ! check if allocated - CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, tin, u_out%Yaw, tin_out ) - b = -(u1%YawRate - u2%YawRate) - u_out%YawRate = u1%YawRate + b * ScaleFactor - b = -(u1%LSS_Spd - u2%LSS_Spd) - u_out%LSS_Spd = u1%LSS_Spd + b * ScaleFactor - b = -(u1%HSS_Spd - u2%HSS_Spd) - u_out%HSS_Spd = u1%HSS_Spd + b * ScaleFactor - b = -(u1%RotSpeed - u2%RotSpeed) - u_out%RotSpeed = u1%RotSpeed + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) - b = -(u1%ExternalYawRateCom - u2%ExternalYawRateCom) - u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b * ScaleFactor -IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) - CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated - b = -(u1%ExternalGenTrq - u2%ExternalGenTrq) - u_out%ExternalGenTrq = u1%ExternalGenTrq + b * ScaleFactor - b = -(u1%ExternalElecPwr - u2%ExternalElecPwr) - u_out%ExternalElecPwr = u1%ExternalElecPwr + b * ScaleFactor - b = -(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac) - u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b * ScaleFactor -IF (ALLOCATED(u_out%ExternalBlAirfoilCom) .AND. ALLOCATED(u1%ExternalBlAirfoilCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlAirfoilCom,1),UBOUND(u_out%ExternalBlAirfoilCom,1) - b = -(u1%ExternalBlAirfoilCom(i1) - u2%ExternalBlAirfoilCom(i1)) - u_out%ExternalBlAirfoilCom(i1) = u1%ExternalBlAirfoilCom(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%ExternalCableDeltaL) .AND. ALLOCATED(u1%ExternalCableDeltaL)) THEN - DO i1 = LBOUND(u_out%ExternalCableDeltaL,1),UBOUND(u_out%ExternalCableDeltaL,1) - b = -(u1%ExternalCableDeltaL(i1) - u2%ExternalCableDeltaL(i1)) - u_out%ExternalCableDeltaL(i1) = u1%ExternalCableDeltaL(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%ExternalCableDeltaLdot) .AND. ALLOCATED(u1%ExternalCableDeltaLdot)) THEN - DO i1 = LBOUND(u_out%ExternalCableDeltaLdot,1),UBOUND(u_out%ExternalCableDeltaLdot,1) - b = -(u1%ExternalCableDeltaLdot(i1) - u2%ExternalCableDeltaLdot(i1)) - u_out%ExternalCableDeltaLdot(i1) = u1%ExternalCableDeltaLdot(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - b = -(u1%TwrAccel - u2%TwrAccel) - u_out%TwrAccel = u1%TwrAccel + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, tin, u_out%YawErr, tin_out ) - CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, tin, u_out%WindDir, tin_out ) - DO i1 = LBOUND(u_out%RootMyc,1),UBOUND(u_out%RootMyc,1) - b = -(u1%RootMyc(i1) - u2%RootMyc(i1)) - u_out%RootMyc(i1) = u1%RootMyc(i1) + b * ScaleFactor - END DO - b = -(u1%YawBrTAxp - u2%YawBrTAxp) - u_out%YawBrTAxp = u1%YawBrTAxp + b * ScaleFactor - b = -(u1%YawBrTAyp - u2%YawBrTAyp) - u_out%YawBrTAyp = u1%YawBrTAyp + b * ScaleFactor - b = -(u1%LSSTipPxa - u2%LSSTipPxa) - u_out%LSSTipPxa = u1%LSSTipPxa + b * ScaleFactor - DO i1 = LBOUND(u_out%RootMxc,1),UBOUND(u_out%RootMxc,1) - b = -(u1%RootMxc(i1) - u2%RootMxc(i1)) - u_out%RootMxc(i1) = u1%RootMxc(i1) + b * ScaleFactor - END DO - b = -(u1%LSSTipMxa - u2%LSSTipMxa) - u_out%LSSTipMxa = u1%LSSTipMxa + b * ScaleFactor - b = -(u1%LSSTipMya - u2%LSSTipMya) - u_out%LSSTipMya = u1%LSSTipMya + b * ScaleFactor - b = -(u1%LSSTipMza - u2%LSSTipMza) - u_out%LSSTipMza = u1%LSSTipMza + b * ScaleFactor - b = -(u1%LSSTipMys - u2%LSSTipMys) - u_out%LSSTipMys = u1%LSSTipMys + b * ScaleFactor - b = -(u1%LSSTipMzs - u2%LSSTipMzs) - u_out%LSSTipMzs = u1%LSSTipMzs + b * ScaleFactor - b = -(u1%YawBrMyn - u2%YawBrMyn) - u_out%YawBrMyn = u1%YawBrMyn + b * ScaleFactor - b = -(u1%YawBrMzn - u2%YawBrMzn) - u_out%YawBrMzn = u1%YawBrMzn + b * ScaleFactor - b = -(u1%NcIMURAxs - u2%NcIMURAxs) - u_out%NcIMURAxs = u1%NcIMURAxs + b * ScaleFactor - b = -(u1%NcIMURAys - u2%NcIMURAys) - u_out%NcIMURAys = u1%NcIMURAys + b * ScaleFactor - b = -(u1%NcIMURAzs - u2%NcIMURAzs) - u_out%NcIMURAzs = u1%NcIMURAzs + b * ScaleFactor - b = -(u1%RotPwr - u2%RotPwr) - u_out%RotPwr = u1%RotPwr + b * ScaleFactor - b = -(u1%HorWindV - u2%HorWindV) - u_out%HorWindV = u1%HorWindV + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, tin, u_out%YawAngle, tin_out ) - b = -(u1%LSShftFxa - u2%LSShftFxa) - u_out%LSShftFxa = u1%LSShftFxa + b * ScaleFactor - b = -(u1%LSShftFys - u2%LSShftFys) - u_out%LSShftFys = u1%LSShftFys + b * ScaleFactor - b = -(u1%LSShftFzs - u2%LSShftFzs) - u_out%LSShftFzs = u1%LSShftFzs + b * ScaleFactor -IF (ALLOCATED(u_out%fromSC) .AND. ALLOCATED(u1%fromSC)) THEN - DO i1 = LBOUND(u_out%fromSC,1),UBOUND(u_out%fromSC,1) - b = -(u1%fromSC(i1) - u2%fromSC(i1)) - u_out%fromSC(i1) = u1%fromSC(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%fromSCglob) .AND. ALLOCATED(u1%fromSCglob)) THEN - DO i1 = LBOUND(u_out%fromSCglob,1),UBOUND(u_out%fromSCglob,1) - b = -(u1%fromSCglob(i1) - u2%fromSCglob(i1)) - u_out%fromSCglob(i1) = u1%fromSCglob(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Lidar) .AND. ALLOCATED(u1%Lidar)) THEN - DO i1 = LBOUND(u_out%Lidar,1),UBOUND(u_out%Lidar,1) - b = -(u1%Lidar(i1) - u2%Lidar(i1)) - u_out%Lidar(i1) = u1%Lidar(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - CALL MeshExtrapInterp1(u1%PtfmMotionMesh, u2%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN - DO i2 = LBOUND(u_out%BStCMotionMesh,2),UBOUND(u_out%BStCMotionMesh,2) - DO i1 = LBOUND(u_out%BStCMotionMesh,1),UBOUND(u_out%BStCMotionMesh,1) - CALL MeshExtrapInterp1(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%NStCMotionMesh,1),UBOUND(u_out%NStCMotionMesh,1) - CALL MeshExtrapInterp1(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%TStCMotionMesh,1),UBOUND(u_out%TStCMotionMesh,1) - CALL MeshExtrapInterp1(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%SStCMotionMesh,1),UBOUND(u_out%SStCMotionMesh,1) - CALL MeshExtrapInterp1(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%LidSpeed) .AND. ALLOCATED(u1%LidSpeed)) THEN - DO i1 = LBOUND(u_out%LidSpeed,1),UBOUND(u_out%LidSpeed,1) - b = -(u1%LidSpeed(i1) - u2%LidSpeed(i1)) - u_out%LidSpeed(i1) = u1%LidSpeed(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsX) .AND. ALLOCATED(u1%MsrPositionsX)) THEN - DO i1 = LBOUND(u_out%MsrPositionsX,1),UBOUND(u_out%MsrPositionsX,1) - b = -(u1%MsrPositionsX(i1) - u2%MsrPositionsX(i1)) - u_out%MsrPositionsX(i1) = u1%MsrPositionsX(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsY) .AND. ALLOCATED(u1%MsrPositionsY)) THEN - DO i1 = LBOUND(u_out%MsrPositionsY,1),UBOUND(u_out%MsrPositionsY,1) - b = -(u1%MsrPositionsY(i1) - u2%MsrPositionsY(i1)) - u_out%MsrPositionsY(i1) = u1%MsrPositionsY(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsZ) .AND. ALLOCATED(u1%MsrPositionsZ)) THEN - DO i1 = LBOUND(u_out%MsrPositionsZ,1),UBOUND(u_out%MsrPositionsZ,1) - b = -(u1%MsrPositionsZ(i1) - u2%MsrPositionsZ(i1)) - u_out%MsrPositionsZ(i1) = u1%MsrPositionsZ(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SrvD_Input_ExtrapInterp1 - - - SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN + DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) + CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) + END DO + END IF ! check if allocated + CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, tin, u_out%Yaw, tin_out ) + u_out%YawRate = a1*u1%YawRate + a2*u2%YawRate + u_out%LSS_Spd = a1*u1%LSS_Spd + a2*u2%LSS_Spd + u_out%HSS_Spd = a1*u1%HSS_Spd + a2*u2%HSS_Spd + u_out%RotSpeed = a1*u1%RotSpeed + a2*u2%RotSpeed + CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) + u_out%ExternalYawRateCom = a1*u1%ExternalYawRateCom + a2*u2%ExternalYawRateCom + IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN + DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) + CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + u_out%ExternalGenTrq = a1*u1%ExternalGenTrq + a2*u2%ExternalGenTrq + u_out%ExternalElecPwr = a1*u1%ExternalElecPwr + a2*u2%ExternalElecPwr + u_out%ExternalHSSBrFrac = a1*u1%ExternalHSSBrFrac + a2*u2%ExternalHSSBrFrac + IF (ALLOCATED(u_out%ExternalBlAirfoilCom) .AND. ALLOCATED(u1%ExternalBlAirfoilCom)) THEN + u_out%ExternalBlAirfoilCom = a1*u1%ExternalBlAirfoilCom + a2*u2%ExternalBlAirfoilCom + END IF ! check if allocated + IF (ALLOCATED(u_out%ExternalCableDeltaL) .AND. ALLOCATED(u1%ExternalCableDeltaL)) THEN + u_out%ExternalCableDeltaL = a1*u1%ExternalCableDeltaL + a2*u2%ExternalCableDeltaL + END IF ! check if allocated + IF (ALLOCATED(u_out%ExternalCableDeltaLdot) .AND. ALLOCATED(u1%ExternalCableDeltaLdot)) THEN + u_out%ExternalCableDeltaLdot = a1*u1%ExternalCableDeltaLdot + a2*u2%ExternalCableDeltaLdot + END IF ! check if allocated + u_out%TwrAccel = a1*u1%TwrAccel + a2*u2%TwrAccel + CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, tin, u_out%YawErr, tin_out ) + CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, tin, u_out%WindDir, tin_out ) + u_out%RootMyc = a1*u1%RootMyc + a2*u2%RootMyc + u_out%YawBrTAxp = a1*u1%YawBrTAxp + a2*u2%YawBrTAxp + u_out%YawBrTAyp = a1*u1%YawBrTAyp + a2*u2%YawBrTAyp + u_out%LSSTipPxa = a1*u1%LSSTipPxa + a2*u2%LSSTipPxa + u_out%RootMxc = a1*u1%RootMxc + a2*u2%RootMxc + u_out%LSSTipMxa = a1*u1%LSSTipMxa + a2*u2%LSSTipMxa + u_out%LSSTipMya = a1*u1%LSSTipMya + a2*u2%LSSTipMya + u_out%LSSTipMza = a1*u1%LSSTipMza + a2*u2%LSSTipMza + u_out%LSSTipMys = a1*u1%LSSTipMys + a2*u2%LSSTipMys + u_out%LSSTipMzs = a1*u1%LSSTipMzs + a2*u2%LSSTipMzs + u_out%YawBrMyn = a1*u1%YawBrMyn + a2*u2%YawBrMyn + u_out%YawBrMzn = a1*u1%YawBrMzn + a2*u2%YawBrMzn + u_out%NcIMURAxs = a1*u1%NcIMURAxs + a2*u2%NcIMURAxs + u_out%NcIMURAys = a1*u1%NcIMURAys + a2*u2%NcIMURAys + u_out%NcIMURAzs = a1*u1%NcIMURAzs + a2*u2%NcIMURAzs + u_out%RotPwr = a1*u1%RotPwr + a2*u2%RotPwr + u_out%HorWindV = a1*u1%HorWindV + a2*u2%HorWindV + CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, tin, u_out%YawAngle, tin_out ) + u_out%LSShftFxa = a1*u1%LSShftFxa + a2*u2%LSShftFxa + u_out%LSShftFys = a1*u1%LSShftFys + a2*u2%LSShftFys + u_out%LSShftFzs = a1*u1%LSShftFzs + a2*u2%LSShftFzs + IF (ALLOCATED(u_out%fromSC) .AND. ALLOCATED(u1%fromSC)) THEN + u_out%fromSC = a1*u1%fromSC + a2*u2%fromSC + END IF ! check if allocated + IF (ALLOCATED(u_out%fromSCglob) .AND. ALLOCATED(u1%fromSCglob)) THEN + u_out%fromSCglob = a1*u1%fromSCglob + a2*u2%fromSCglob + END IF ! check if allocated + IF (ALLOCATED(u_out%Lidar) .AND. ALLOCATED(u1%Lidar)) THEN + u_out%Lidar = a1*u1%Lidar + a2*u2%Lidar + END IF ! check if allocated + CALL MeshExtrapInterp1(u1%PtfmMotionMesh, u2%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN + DO i2 = LBOUND(u_out%BStCMotionMesh,2),UBOUND(u_out%BStCMotionMesh,2) + DO i1 = LBOUND(u_out%BStCMotionMesh,1),UBOUND(u_out%BStCMotionMesh,1) + CALL MeshExtrapInterp1(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN + DO i1 = LBOUND(u_out%NStCMotionMesh,1),UBOUND(u_out%NStCMotionMesh,1) + CALL MeshExtrapInterp1(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN + DO i1 = LBOUND(u_out%TStCMotionMesh,1),UBOUND(u_out%TStCMotionMesh,1) + CALL MeshExtrapInterp1(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN + DO i1 = LBOUND(u_out%SStCMotionMesh,1),UBOUND(u_out%SStCMotionMesh,1) + CALL MeshExtrapInterp1(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%LidSpeed) .AND. ALLOCATED(u1%LidSpeed)) THEN + u_out%LidSpeed = a1*u1%LidSpeed + a2*u2%LidSpeed + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsX) .AND. ALLOCATED(u1%MsrPositionsX)) THEN + u_out%MsrPositionsX = a1*u1%MsrPositionsX + a2*u2%MsrPositionsX + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsY) .AND. ALLOCATED(u1%MsrPositionsY)) THEN + u_out%MsrPositionsY = a1*u1%MsrPositionsY + a2*u2%MsrPositionsY + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsZ) .AND. ALLOCATED(u1%MsrPositionsZ)) THEN + u_out%MsrPositionsZ = a1*u1%MsrPositionsZ + a2*u2%MsrPositionsZ + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SrvD_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. @@ -18405,307 +8761,206 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(SrvD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(SrvD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(SrvD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SrvD_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 + TYPE(SrvD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(SrvD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(SrvD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SrvD_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 = 'SrvD_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) - CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), u3%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) - END DO -END IF ! check if allocated - CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, u3%Yaw, tin, u_out%Yaw, tin_out ) - b = (t(3)**2*(u1%YawRate - u2%YawRate) + t(2)**2*(-u1%YawRate + u3%YawRate))* scaleFactor - c = ( (t(2)-t(3))*u1%YawRate + t(3)*u2%YawRate - t(2)*u3%YawRate ) * scaleFactor - u_out%YawRate = u1%YawRate + b + c * t_out - b = (t(3)**2*(u1%LSS_Spd - u2%LSS_Spd) + t(2)**2*(-u1%LSS_Spd + u3%LSS_Spd))* scaleFactor - c = ( (t(2)-t(3))*u1%LSS_Spd + t(3)*u2%LSS_Spd - t(2)*u3%LSS_Spd ) * scaleFactor - u_out%LSS_Spd = u1%LSS_Spd + b + c * t_out - b = (t(3)**2*(u1%HSS_Spd - u2%HSS_Spd) + t(2)**2*(-u1%HSS_Spd + u3%HSS_Spd))* scaleFactor - c = ( (t(2)-t(3))*u1%HSS_Spd + t(3)*u2%HSS_Spd - t(2)*u3%HSS_Spd ) * scaleFactor - u_out%HSS_Spd = u1%HSS_Spd + b + c * t_out - b = (t(3)**2*(u1%RotSpeed - u2%RotSpeed) + t(2)**2*(-u1%RotSpeed + u3%RotSpeed))* scaleFactor - c = ( (t(2)-t(3))*u1%RotSpeed + t(3)*u2%RotSpeed - t(2)*u3%RotSpeed ) * scaleFactor - u_out%RotSpeed = u1%RotSpeed + b + c * t_out - CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, u3%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) - b = (t(3)**2*(u1%ExternalYawRateCom - u2%ExternalYawRateCom) + t(2)**2*(-u1%ExternalYawRateCom + u3%ExternalYawRateCom))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalYawRateCom + t(3)*u2%ExternalYawRateCom - t(2)*u3%ExternalYawRateCom ) * scaleFactor - u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b + c * t_out -IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) - CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), u3%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%ExternalGenTrq - u2%ExternalGenTrq) + t(2)**2*(-u1%ExternalGenTrq + u3%ExternalGenTrq))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalGenTrq + t(3)*u2%ExternalGenTrq - t(2)*u3%ExternalGenTrq ) * scaleFactor - u_out%ExternalGenTrq = u1%ExternalGenTrq + b + c * t_out - b = (t(3)**2*(u1%ExternalElecPwr - u2%ExternalElecPwr) + t(2)**2*(-u1%ExternalElecPwr + u3%ExternalElecPwr))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalElecPwr + t(3)*u2%ExternalElecPwr - t(2)*u3%ExternalElecPwr ) * scaleFactor - u_out%ExternalElecPwr = u1%ExternalElecPwr + b + c * t_out - b = (t(3)**2*(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac) + t(2)**2*(-u1%ExternalHSSBrFrac + u3%ExternalHSSBrFrac))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalHSSBrFrac + t(3)*u2%ExternalHSSBrFrac - t(2)*u3%ExternalHSSBrFrac ) * scaleFactor - u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b + c * t_out -IF (ALLOCATED(u_out%ExternalBlAirfoilCom) .AND. ALLOCATED(u1%ExternalBlAirfoilCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlAirfoilCom,1),UBOUND(u_out%ExternalBlAirfoilCom,1) - b = (t(3)**2*(u1%ExternalBlAirfoilCom(i1) - u2%ExternalBlAirfoilCom(i1)) + t(2)**2*(-u1%ExternalBlAirfoilCom(i1) + u3%ExternalBlAirfoilCom(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalBlAirfoilCom(i1) + t(3)*u2%ExternalBlAirfoilCom(i1) - t(2)*u3%ExternalBlAirfoilCom(i1) ) * scaleFactor - u_out%ExternalBlAirfoilCom(i1) = u1%ExternalBlAirfoilCom(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%ExternalCableDeltaL) .AND. ALLOCATED(u1%ExternalCableDeltaL)) THEN - DO i1 = LBOUND(u_out%ExternalCableDeltaL,1),UBOUND(u_out%ExternalCableDeltaL,1) - b = (t(3)**2*(u1%ExternalCableDeltaL(i1) - u2%ExternalCableDeltaL(i1)) + t(2)**2*(-u1%ExternalCableDeltaL(i1) + u3%ExternalCableDeltaL(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalCableDeltaL(i1) + t(3)*u2%ExternalCableDeltaL(i1) - t(2)*u3%ExternalCableDeltaL(i1) ) * scaleFactor - u_out%ExternalCableDeltaL(i1) = u1%ExternalCableDeltaL(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%ExternalCableDeltaLdot) .AND. ALLOCATED(u1%ExternalCableDeltaLdot)) THEN - DO i1 = LBOUND(u_out%ExternalCableDeltaLdot,1),UBOUND(u_out%ExternalCableDeltaLdot,1) - b = (t(3)**2*(u1%ExternalCableDeltaLdot(i1) - u2%ExternalCableDeltaLdot(i1)) + t(2)**2*(-u1%ExternalCableDeltaLdot(i1) + u3%ExternalCableDeltaLdot(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalCableDeltaLdot(i1) + t(3)*u2%ExternalCableDeltaLdot(i1) - t(2)*u3%ExternalCableDeltaLdot(i1) ) * scaleFactor - u_out%ExternalCableDeltaLdot(i1) = u1%ExternalCableDeltaLdot(i1) + b + c * t_out - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%TwrAccel - u2%TwrAccel) + t(2)**2*(-u1%TwrAccel + u3%TwrAccel))* scaleFactor - c = ( (t(2)-t(3))*u1%TwrAccel + t(3)*u2%TwrAccel - t(2)*u3%TwrAccel ) * scaleFactor - u_out%TwrAccel = u1%TwrAccel + b + c * t_out - CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, u3%YawErr, tin, u_out%YawErr, tin_out ) - CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, u3%WindDir, tin, u_out%WindDir, tin_out ) - DO i1 = LBOUND(u_out%RootMyc,1),UBOUND(u_out%RootMyc,1) - b = (t(3)**2*(u1%RootMyc(i1) - u2%RootMyc(i1)) + t(2)**2*(-u1%RootMyc(i1) + u3%RootMyc(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%RootMyc(i1) + t(3)*u2%RootMyc(i1) - t(2)*u3%RootMyc(i1) ) * scaleFactor - u_out%RootMyc(i1) = u1%RootMyc(i1) + b + c * t_out - END DO - b = (t(3)**2*(u1%YawBrTAxp - u2%YawBrTAxp) + t(2)**2*(-u1%YawBrTAxp + u3%YawBrTAxp))* scaleFactor - c = ( (t(2)-t(3))*u1%YawBrTAxp + t(3)*u2%YawBrTAxp - t(2)*u3%YawBrTAxp ) * scaleFactor - u_out%YawBrTAxp = u1%YawBrTAxp + b + c * t_out - b = (t(3)**2*(u1%YawBrTAyp - u2%YawBrTAyp) + t(2)**2*(-u1%YawBrTAyp + u3%YawBrTAyp))* scaleFactor - c = ( (t(2)-t(3))*u1%YawBrTAyp + t(3)*u2%YawBrTAyp - t(2)*u3%YawBrTAyp ) * scaleFactor - u_out%YawBrTAyp = u1%YawBrTAyp + b + c * t_out - b = (t(3)**2*(u1%LSSTipPxa - u2%LSSTipPxa) + t(2)**2*(-u1%LSSTipPxa + u3%LSSTipPxa))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipPxa + t(3)*u2%LSSTipPxa - t(2)*u3%LSSTipPxa ) * scaleFactor - u_out%LSSTipPxa = u1%LSSTipPxa + b + c * t_out - DO i1 = LBOUND(u_out%RootMxc,1),UBOUND(u_out%RootMxc,1) - b = (t(3)**2*(u1%RootMxc(i1) - u2%RootMxc(i1)) + t(2)**2*(-u1%RootMxc(i1) + u3%RootMxc(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%RootMxc(i1) + t(3)*u2%RootMxc(i1) - t(2)*u3%RootMxc(i1) ) * scaleFactor - u_out%RootMxc(i1) = u1%RootMxc(i1) + b + c * t_out - END DO - b = (t(3)**2*(u1%LSSTipMxa - u2%LSSTipMxa) + t(2)**2*(-u1%LSSTipMxa + u3%LSSTipMxa))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipMxa + t(3)*u2%LSSTipMxa - t(2)*u3%LSSTipMxa ) * scaleFactor - u_out%LSSTipMxa = u1%LSSTipMxa + b + c * t_out - b = (t(3)**2*(u1%LSSTipMya - u2%LSSTipMya) + t(2)**2*(-u1%LSSTipMya + u3%LSSTipMya))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipMya + t(3)*u2%LSSTipMya - t(2)*u3%LSSTipMya ) * scaleFactor - u_out%LSSTipMya = u1%LSSTipMya + b + c * t_out - b = (t(3)**2*(u1%LSSTipMza - u2%LSSTipMza) + t(2)**2*(-u1%LSSTipMza + u3%LSSTipMza))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipMza + t(3)*u2%LSSTipMza - t(2)*u3%LSSTipMza ) * scaleFactor - u_out%LSSTipMza = u1%LSSTipMza + b + c * t_out - b = (t(3)**2*(u1%LSSTipMys - u2%LSSTipMys) + t(2)**2*(-u1%LSSTipMys + u3%LSSTipMys))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipMys + t(3)*u2%LSSTipMys - t(2)*u3%LSSTipMys ) * scaleFactor - u_out%LSSTipMys = u1%LSSTipMys + b + c * t_out - b = (t(3)**2*(u1%LSSTipMzs - u2%LSSTipMzs) + t(2)**2*(-u1%LSSTipMzs + u3%LSSTipMzs))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipMzs + t(3)*u2%LSSTipMzs - t(2)*u3%LSSTipMzs ) * scaleFactor - u_out%LSSTipMzs = u1%LSSTipMzs + b + c * t_out - b = (t(3)**2*(u1%YawBrMyn - u2%YawBrMyn) + t(2)**2*(-u1%YawBrMyn + u3%YawBrMyn))* scaleFactor - c = ( (t(2)-t(3))*u1%YawBrMyn + t(3)*u2%YawBrMyn - t(2)*u3%YawBrMyn ) * scaleFactor - u_out%YawBrMyn = u1%YawBrMyn + b + c * t_out - b = (t(3)**2*(u1%YawBrMzn - u2%YawBrMzn) + t(2)**2*(-u1%YawBrMzn + u3%YawBrMzn))* scaleFactor - c = ( (t(2)-t(3))*u1%YawBrMzn + t(3)*u2%YawBrMzn - t(2)*u3%YawBrMzn ) * scaleFactor - u_out%YawBrMzn = u1%YawBrMzn + b + c * t_out - b = (t(3)**2*(u1%NcIMURAxs - u2%NcIMURAxs) + t(2)**2*(-u1%NcIMURAxs + u3%NcIMURAxs))* scaleFactor - c = ( (t(2)-t(3))*u1%NcIMURAxs + t(3)*u2%NcIMURAxs - t(2)*u3%NcIMURAxs ) * scaleFactor - u_out%NcIMURAxs = u1%NcIMURAxs + b + c * t_out - b = (t(3)**2*(u1%NcIMURAys - u2%NcIMURAys) + t(2)**2*(-u1%NcIMURAys + u3%NcIMURAys))* scaleFactor - c = ( (t(2)-t(3))*u1%NcIMURAys + t(3)*u2%NcIMURAys - t(2)*u3%NcIMURAys ) * scaleFactor - u_out%NcIMURAys = u1%NcIMURAys + b + c * t_out - b = (t(3)**2*(u1%NcIMURAzs - u2%NcIMURAzs) + t(2)**2*(-u1%NcIMURAzs + u3%NcIMURAzs))* scaleFactor - c = ( (t(2)-t(3))*u1%NcIMURAzs + t(3)*u2%NcIMURAzs - t(2)*u3%NcIMURAzs ) * scaleFactor - u_out%NcIMURAzs = u1%NcIMURAzs + b + c * t_out - b = (t(3)**2*(u1%RotPwr - u2%RotPwr) + t(2)**2*(-u1%RotPwr + u3%RotPwr))* scaleFactor - c = ( (t(2)-t(3))*u1%RotPwr + t(3)*u2%RotPwr - t(2)*u3%RotPwr ) * scaleFactor - u_out%RotPwr = u1%RotPwr + b + c * t_out - b = (t(3)**2*(u1%HorWindV - u2%HorWindV) + t(2)**2*(-u1%HorWindV + u3%HorWindV))* scaleFactor - c = ( (t(2)-t(3))*u1%HorWindV + t(3)*u2%HorWindV - t(2)*u3%HorWindV ) * scaleFactor - u_out%HorWindV = u1%HorWindV + b + c * t_out - CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, u3%YawAngle, tin, u_out%YawAngle, tin_out ) - b = (t(3)**2*(u1%LSShftFxa - u2%LSShftFxa) + t(2)**2*(-u1%LSShftFxa + u3%LSShftFxa))* scaleFactor - c = ( (t(2)-t(3))*u1%LSShftFxa + t(3)*u2%LSShftFxa - t(2)*u3%LSShftFxa ) * scaleFactor - u_out%LSShftFxa = u1%LSShftFxa + b + c * t_out - b = (t(3)**2*(u1%LSShftFys - u2%LSShftFys) + t(2)**2*(-u1%LSShftFys + u3%LSShftFys))* scaleFactor - c = ( (t(2)-t(3))*u1%LSShftFys + t(3)*u2%LSShftFys - t(2)*u3%LSShftFys ) * scaleFactor - u_out%LSShftFys = u1%LSShftFys + b + c * t_out - b = (t(3)**2*(u1%LSShftFzs - u2%LSShftFzs) + t(2)**2*(-u1%LSShftFzs + u3%LSShftFzs))* scaleFactor - c = ( (t(2)-t(3))*u1%LSShftFzs + t(3)*u2%LSShftFzs - t(2)*u3%LSShftFzs ) * scaleFactor - u_out%LSShftFzs = u1%LSShftFzs + b + c * t_out -IF (ALLOCATED(u_out%fromSC) .AND. ALLOCATED(u1%fromSC)) THEN - DO i1 = LBOUND(u_out%fromSC,1),UBOUND(u_out%fromSC,1) - b = (t(3)**2*(u1%fromSC(i1) - u2%fromSC(i1)) + t(2)**2*(-u1%fromSC(i1) + u3%fromSC(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%fromSC(i1) + t(3)*u2%fromSC(i1) - t(2)*u3%fromSC(i1) ) * scaleFactor - u_out%fromSC(i1) = u1%fromSC(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%fromSCglob) .AND. ALLOCATED(u1%fromSCglob)) THEN - DO i1 = LBOUND(u_out%fromSCglob,1),UBOUND(u_out%fromSCglob,1) - b = (t(3)**2*(u1%fromSCglob(i1) - u2%fromSCglob(i1)) + t(2)**2*(-u1%fromSCglob(i1) + u3%fromSCglob(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%fromSCglob(i1) + t(3)*u2%fromSCglob(i1) - t(2)*u3%fromSCglob(i1) ) * scaleFactor - u_out%fromSCglob(i1) = u1%fromSCglob(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Lidar) .AND. ALLOCATED(u1%Lidar)) THEN - DO i1 = LBOUND(u_out%Lidar,1),UBOUND(u_out%Lidar,1) - b = (t(3)**2*(u1%Lidar(i1) - u2%Lidar(i1)) + t(2)**2*(-u1%Lidar(i1) + u3%Lidar(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Lidar(i1) + t(3)*u2%Lidar(i1) - t(2)*u3%Lidar(i1) ) * scaleFactor - u_out%Lidar(i1) = u1%Lidar(i1) + b + c * t_out - END DO -END IF ! check if allocated - CALL MeshExtrapInterp2(u1%PtfmMotionMesh, u2%PtfmMotionMesh, u3%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN - DO i2 = LBOUND(u_out%BStCMotionMesh,2),UBOUND(u_out%BStCMotionMesh,2) - DO i1 = LBOUND(u_out%BStCMotionMesh,1),UBOUND(u_out%BStCMotionMesh,1) - CALL MeshExtrapInterp2(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), u3%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%NStCMotionMesh,1),UBOUND(u_out%NStCMotionMesh,1) - CALL MeshExtrapInterp2(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), u3%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%TStCMotionMesh,1),UBOUND(u_out%TStCMotionMesh,1) - CALL MeshExtrapInterp2(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), u3%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%SStCMotionMesh,1),UBOUND(u_out%SStCMotionMesh,1) - CALL MeshExtrapInterp2(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), u3%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%LidSpeed) .AND. ALLOCATED(u1%LidSpeed)) THEN - DO i1 = LBOUND(u_out%LidSpeed,1),UBOUND(u_out%LidSpeed,1) - b = (t(3)**2*(u1%LidSpeed(i1) - u2%LidSpeed(i1)) + t(2)**2*(-u1%LidSpeed(i1) + u3%LidSpeed(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%LidSpeed(i1) + t(3)*u2%LidSpeed(i1) - t(2)*u3%LidSpeed(i1) ) * scaleFactor - u_out%LidSpeed(i1) = u1%LidSpeed(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsX) .AND. ALLOCATED(u1%MsrPositionsX)) THEN - DO i1 = LBOUND(u_out%MsrPositionsX,1),UBOUND(u_out%MsrPositionsX,1) - b = (t(3)**2*(u1%MsrPositionsX(i1) - u2%MsrPositionsX(i1)) + t(2)**2*(-u1%MsrPositionsX(i1) + u3%MsrPositionsX(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%MsrPositionsX(i1) + t(3)*u2%MsrPositionsX(i1) - t(2)*u3%MsrPositionsX(i1) ) * scaleFactor - u_out%MsrPositionsX(i1) = u1%MsrPositionsX(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsY) .AND. ALLOCATED(u1%MsrPositionsY)) THEN - DO i1 = LBOUND(u_out%MsrPositionsY,1),UBOUND(u_out%MsrPositionsY,1) - b = (t(3)**2*(u1%MsrPositionsY(i1) - u2%MsrPositionsY(i1)) + t(2)**2*(-u1%MsrPositionsY(i1) + u3%MsrPositionsY(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%MsrPositionsY(i1) + t(3)*u2%MsrPositionsY(i1) - t(2)*u3%MsrPositionsY(i1) ) * scaleFactor - u_out%MsrPositionsY(i1) = u1%MsrPositionsY(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsZ) .AND. ALLOCATED(u1%MsrPositionsZ)) THEN - DO i1 = LBOUND(u_out%MsrPositionsZ,1),UBOUND(u_out%MsrPositionsZ,1) - b = (t(3)**2*(u1%MsrPositionsZ(i1) - u2%MsrPositionsZ(i1)) + t(2)**2*(-u1%MsrPositionsZ(i1) + u3%MsrPositionsZ(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%MsrPositionsZ(i1) + t(3)*u2%MsrPositionsZ(i1) - t(2)*u3%MsrPositionsZ(i1) ) * scaleFactor - u_out%MsrPositionsZ(i1) = u1%MsrPositionsZ(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SrvD_Input_ExtrapInterp2 - - - SUBROUTINE SrvD_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(SrvD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SrvD_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN + DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) + CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), u3%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) + END DO + END IF ! check if allocated + CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, u3%Yaw, tin, u_out%Yaw, tin_out ) + u_out%YawRate = a1*u1%YawRate + a2*u2%YawRate + a3*u3%YawRate + u_out%LSS_Spd = a1*u1%LSS_Spd + a2*u2%LSS_Spd + a3*u3%LSS_Spd + u_out%HSS_Spd = a1*u1%HSS_Spd + a2*u2%HSS_Spd + a3*u3%HSS_Spd + u_out%RotSpeed = a1*u1%RotSpeed + a2*u2%RotSpeed + a3*u3%RotSpeed + CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, u3%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) + u_out%ExternalYawRateCom = a1*u1%ExternalYawRateCom + a2*u2%ExternalYawRateCom + a3*u3%ExternalYawRateCom + IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN + DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) + CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), u3%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + u_out%ExternalGenTrq = a1*u1%ExternalGenTrq + a2*u2%ExternalGenTrq + a3*u3%ExternalGenTrq + u_out%ExternalElecPwr = a1*u1%ExternalElecPwr + a2*u2%ExternalElecPwr + a3*u3%ExternalElecPwr + u_out%ExternalHSSBrFrac = a1*u1%ExternalHSSBrFrac + a2*u2%ExternalHSSBrFrac + a3*u3%ExternalHSSBrFrac + IF (ALLOCATED(u_out%ExternalBlAirfoilCom) .AND. ALLOCATED(u1%ExternalBlAirfoilCom)) THEN + u_out%ExternalBlAirfoilCom = a1*u1%ExternalBlAirfoilCom + a2*u2%ExternalBlAirfoilCom + a3*u3%ExternalBlAirfoilCom + END IF ! check if allocated + IF (ALLOCATED(u_out%ExternalCableDeltaL) .AND. ALLOCATED(u1%ExternalCableDeltaL)) THEN + u_out%ExternalCableDeltaL = a1*u1%ExternalCableDeltaL + a2*u2%ExternalCableDeltaL + a3*u3%ExternalCableDeltaL + END IF ! check if allocated + IF (ALLOCATED(u_out%ExternalCableDeltaLdot) .AND. ALLOCATED(u1%ExternalCableDeltaLdot)) THEN + u_out%ExternalCableDeltaLdot = a1*u1%ExternalCableDeltaLdot + a2*u2%ExternalCableDeltaLdot + a3*u3%ExternalCableDeltaLdot + END IF ! check if allocated + u_out%TwrAccel = a1*u1%TwrAccel + a2*u2%TwrAccel + a3*u3%TwrAccel + CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, u3%YawErr, tin, u_out%YawErr, tin_out ) + CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, u3%WindDir, tin, u_out%WindDir, tin_out ) + u_out%RootMyc = a1*u1%RootMyc + a2*u2%RootMyc + a3*u3%RootMyc + u_out%YawBrTAxp = a1*u1%YawBrTAxp + a2*u2%YawBrTAxp + a3*u3%YawBrTAxp + u_out%YawBrTAyp = a1*u1%YawBrTAyp + a2*u2%YawBrTAyp + a3*u3%YawBrTAyp + u_out%LSSTipPxa = a1*u1%LSSTipPxa + a2*u2%LSSTipPxa + a3*u3%LSSTipPxa + u_out%RootMxc = a1*u1%RootMxc + a2*u2%RootMxc + a3*u3%RootMxc + u_out%LSSTipMxa = a1*u1%LSSTipMxa + a2*u2%LSSTipMxa + a3*u3%LSSTipMxa + u_out%LSSTipMya = a1*u1%LSSTipMya + a2*u2%LSSTipMya + a3*u3%LSSTipMya + u_out%LSSTipMza = a1*u1%LSSTipMza + a2*u2%LSSTipMza + a3*u3%LSSTipMza + u_out%LSSTipMys = a1*u1%LSSTipMys + a2*u2%LSSTipMys + a3*u3%LSSTipMys + u_out%LSSTipMzs = a1*u1%LSSTipMzs + a2*u2%LSSTipMzs + a3*u3%LSSTipMzs + u_out%YawBrMyn = a1*u1%YawBrMyn + a2*u2%YawBrMyn + a3*u3%YawBrMyn + u_out%YawBrMzn = a1*u1%YawBrMzn + a2*u2%YawBrMzn + a3*u3%YawBrMzn + u_out%NcIMURAxs = a1*u1%NcIMURAxs + a2*u2%NcIMURAxs + a3*u3%NcIMURAxs + u_out%NcIMURAys = a1*u1%NcIMURAys + a2*u2%NcIMURAys + a3*u3%NcIMURAys + u_out%NcIMURAzs = a1*u1%NcIMURAzs + a2*u2%NcIMURAzs + a3*u3%NcIMURAzs + u_out%RotPwr = a1*u1%RotPwr + a2*u2%RotPwr + a3*u3%RotPwr + u_out%HorWindV = a1*u1%HorWindV + a2*u2%HorWindV + a3*u3%HorWindV + CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, u3%YawAngle, tin, u_out%YawAngle, tin_out ) + u_out%LSShftFxa = a1*u1%LSShftFxa + a2*u2%LSShftFxa + a3*u3%LSShftFxa + u_out%LSShftFys = a1*u1%LSShftFys + a2*u2%LSShftFys + a3*u3%LSShftFys + u_out%LSShftFzs = a1*u1%LSShftFzs + a2*u2%LSShftFzs + a3*u3%LSShftFzs + IF (ALLOCATED(u_out%fromSC) .AND. ALLOCATED(u1%fromSC)) THEN + u_out%fromSC = a1*u1%fromSC + a2*u2%fromSC + a3*u3%fromSC + END IF ! check if allocated + IF (ALLOCATED(u_out%fromSCglob) .AND. ALLOCATED(u1%fromSCglob)) THEN + u_out%fromSCglob = a1*u1%fromSCglob + a2*u2%fromSCglob + a3*u3%fromSCglob + END IF ! check if allocated + IF (ALLOCATED(u_out%Lidar) .AND. ALLOCATED(u1%Lidar)) THEN + u_out%Lidar = a1*u1%Lidar + a2*u2%Lidar + a3*u3%Lidar + END IF ! check if allocated + CALL MeshExtrapInterp2(u1%PtfmMotionMesh, u2%PtfmMotionMesh, u3%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN + DO i2 = LBOUND(u_out%BStCMotionMesh,2),UBOUND(u_out%BStCMotionMesh,2) + DO i1 = LBOUND(u_out%BStCMotionMesh,1),UBOUND(u_out%BStCMotionMesh,1) + CALL MeshExtrapInterp2(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), u3%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN + DO i1 = LBOUND(u_out%NStCMotionMesh,1),UBOUND(u_out%NStCMotionMesh,1) + CALL MeshExtrapInterp2(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), u3%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN + DO i1 = LBOUND(u_out%TStCMotionMesh,1),UBOUND(u_out%TStCMotionMesh,1) + CALL MeshExtrapInterp2(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), u3%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN + DO i1 = LBOUND(u_out%SStCMotionMesh,1),UBOUND(u_out%SStCMotionMesh,1) + CALL MeshExtrapInterp2(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), u3%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%LidSpeed) .AND. ALLOCATED(u1%LidSpeed)) THEN + u_out%LidSpeed = a1*u1%LidSpeed + a2*u2%LidSpeed + a3*u3%LidSpeed + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsX) .AND. ALLOCATED(u1%MsrPositionsX)) THEN + u_out%MsrPositionsX = a1*u1%MsrPositionsX + a2*u2%MsrPositionsX + a3*u3%MsrPositionsX + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsY) .AND. ALLOCATED(u1%MsrPositionsY)) THEN + u_out%MsrPositionsY = a1*u1%MsrPositionsY + a2*u2%MsrPositionsY + a3*u3%MsrPositionsY + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsZ) .AND. ALLOCATED(u1%MsrPositionsZ)) THEN + u_out%MsrPositionsZ = a1*u1%MsrPositionsZ + a2*u2%MsrPositionsZ + a3*u3%MsrPositionsZ + END IF ! check if allocated +END SUBROUTINE + +subroutine SrvD_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(SrvD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(SrvD_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 = 'SrvD_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 SrvD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SrvD_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 SrvD_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 SrvD_Output_ExtrapInterp - - - SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SrvD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SrvD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SrvD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SrvD_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. @@ -18717,124 +8972,100 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(SrvD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(SrvD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SrvD_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 + TYPE(SrvD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(SrvD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SrvD_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 = 'SrvD_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 -IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) - CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BlAirfoilCom) .AND. ALLOCATED(y1%BlAirfoilCom)) THEN - DO i1 = LBOUND(y_out%BlAirfoilCom,1),UBOUND(y_out%BlAirfoilCom,1) - b = -(y1%BlAirfoilCom(i1) - y2%BlAirfoilCom(i1)) - y_out%BlAirfoilCom(i1) = y1%BlAirfoilCom(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - b = -(y1%YawMom - y2%YawMom) - y_out%YawMom = y1%YawMom + b * ScaleFactor - b = -(y1%GenTrq - y2%GenTrq) - y_out%GenTrq = y1%GenTrq + b * ScaleFactor - b = -(y1%HSSBrTrqC - y2%HSSBrTrqC) - y_out%HSSBrTrqC = y1%HSSBrTrqC + b * ScaleFactor - b = -(y1%ElecPwr - y2%ElecPwr) - y_out%ElecPwr = y1%ElecPwr + b * ScaleFactor -IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN - DO i1 = LBOUND(y_out%TBDrCon,1),UBOUND(y_out%TBDrCon,1) - b = -(y1%TBDrCon(i1) - y2%TBDrCon(i1)) - y_out%TBDrCon(i1) = y1%TBDrCon(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Lidar) .AND. ALLOCATED(y1%Lidar)) THEN - DO i1 = LBOUND(y_out%Lidar,1),UBOUND(y_out%Lidar,1) - b = -(y1%Lidar(i1) - y2%Lidar(i1)) - y_out%Lidar(i1) = y1%Lidar(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%CableDeltaL) .AND. ALLOCATED(y1%CableDeltaL)) THEN - DO i1 = LBOUND(y_out%CableDeltaL,1),UBOUND(y_out%CableDeltaL,1) - b = -(y1%CableDeltaL(i1) - y2%CableDeltaL(i1)) - y_out%CableDeltaL(i1) = y1%CableDeltaL(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%CableDeltaLdot) .AND. ALLOCATED(y1%CableDeltaLdot)) THEN - DO i1 = LBOUND(y_out%CableDeltaLdot,1),UBOUND(y_out%CableDeltaLdot,1) - b = -(y1%CableDeltaLdot(i1) - y2%CableDeltaLdot(i1)) - y_out%CableDeltaLdot(i1) = y1%CableDeltaLdot(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN - DO i2 = LBOUND(y_out%BStCLoadMesh,2),UBOUND(y_out%BStCLoadMesh,2) - DO i1 = LBOUND(y_out%BStCLoadMesh,1),UBOUND(y_out%BStCLoadMesh,1) - CALL MeshExtrapInterp1(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%NStCLoadMesh,1),UBOUND(y_out%NStCLoadMesh,1) - CALL MeshExtrapInterp1(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%TStCLoadMesh,1),UBOUND(y_out%TStCLoadMesh,1) - CALL MeshExtrapInterp1(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%SStCLoadMesh,1),UBOUND(y_out%SStCLoadMesh,1) - CALL MeshExtrapInterp1(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%toSC) .AND. ALLOCATED(y1%toSC)) THEN - DO i1 = LBOUND(y_out%toSC,1),UBOUND(y_out%toSC,1) - b = -(y1%toSC(i1) - y2%toSC(i1)) - y_out%toSC(i1) = y1%toSC(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SrvD_Output_ExtrapInterp1 - - - SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated + IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN + DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%BlAirfoilCom) .AND. ALLOCATED(y1%BlAirfoilCom)) THEN + y_out%BlAirfoilCom = a1*y1%BlAirfoilCom + a2*y2%BlAirfoilCom + END IF ! check if allocated + y_out%YawMom = a1*y1%YawMom + a2*y2%YawMom + y_out%GenTrq = a1*y1%GenTrq + a2*y2%GenTrq + y_out%HSSBrTrqC = a1*y1%HSSBrTrqC + a2*y2%HSSBrTrqC + y_out%ElecPwr = a1*y1%ElecPwr + a2*y2%ElecPwr + IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN + y_out%TBDrCon = a1*y1%TBDrCon + a2*y2%TBDrCon + END IF ! check if allocated + IF (ALLOCATED(y_out%Lidar) .AND. ALLOCATED(y1%Lidar)) THEN + y_out%Lidar = a1*y1%Lidar + a2*y2%Lidar + END IF ! check if allocated + IF (ALLOCATED(y_out%CableDeltaL) .AND. ALLOCATED(y1%CableDeltaL)) THEN + y_out%CableDeltaL = a1*y1%CableDeltaL + a2*y2%CableDeltaL + END IF ! check if allocated + IF (ALLOCATED(y_out%CableDeltaLdot) .AND. ALLOCATED(y1%CableDeltaLdot)) THEN + y_out%CableDeltaLdot = a1*y1%CableDeltaLdot + a2*y2%CableDeltaLdot + END IF ! check if allocated + IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN + DO i2 = LBOUND(y_out%BStCLoadMesh,2),UBOUND(y_out%BStCLoadMesh,2) + DO i1 = LBOUND(y_out%BStCLoadMesh,1),UBOUND(y_out%BStCLoadMesh,1) + CALL MeshExtrapInterp1(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN + DO i1 = LBOUND(y_out%NStCLoadMesh,1),UBOUND(y_out%NStCLoadMesh,1) + CALL MeshExtrapInterp1(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN + DO i1 = LBOUND(y_out%TStCLoadMesh,1),UBOUND(y_out%TStCLoadMesh,1) + CALL MeshExtrapInterp1(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN + DO i1 = LBOUND(y_out%SStCLoadMesh,1),UBOUND(y_out%SStCLoadMesh,1) + CALL MeshExtrapInterp1(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%toSC) .AND. ALLOCATED(y1%toSC)) THEN + y_out%toSC = a1*y1%toSC + a2*y2%toSC + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SrvD_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. @@ -18848,141 +9079,105 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(SrvD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(SrvD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(SrvD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SrvD_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 + TYPE(SrvD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(SrvD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(SrvD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SrvD_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 = 'SrvD_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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 -IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) - CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), y3%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BlAirfoilCom) .AND. ALLOCATED(y1%BlAirfoilCom)) THEN - DO i1 = LBOUND(y_out%BlAirfoilCom,1),UBOUND(y_out%BlAirfoilCom,1) - b = (t(3)**2*(y1%BlAirfoilCom(i1) - y2%BlAirfoilCom(i1)) + t(2)**2*(-y1%BlAirfoilCom(i1) + y3%BlAirfoilCom(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%BlAirfoilCom(i1) + t(3)*y2%BlAirfoilCom(i1) - t(2)*y3%BlAirfoilCom(i1) ) * scaleFactor - y_out%BlAirfoilCom(i1) = y1%BlAirfoilCom(i1) + b + c * t_out - END DO -END IF ! check if allocated - b = (t(3)**2*(y1%YawMom - y2%YawMom) + t(2)**2*(-y1%YawMom + y3%YawMom))* scaleFactor - c = ( (t(2)-t(3))*y1%YawMom + t(3)*y2%YawMom - t(2)*y3%YawMom ) * scaleFactor - y_out%YawMom = y1%YawMom + b + c * t_out - b = (t(3)**2*(y1%GenTrq - y2%GenTrq) + t(2)**2*(-y1%GenTrq + y3%GenTrq))* scaleFactor - c = ( (t(2)-t(3))*y1%GenTrq + t(3)*y2%GenTrq - t(2)*y3%GenTrq ) * scaleFactor - y_out%GenTrq = y1%GenTrq + b + c * t_out - b = (t(3)**2*(y1%HSSBrTrqC - y2%HSSBrTrqC) + t(2)**2*(-y1%HSSBrTrqC + y3%HSSBrTrqC))* scaleFactor - c = ( (t(2)-t(3))*y1%HSSBrTrqC + t(3)*y2%HSSBrTrqC - t(2)*y3%HSSBrTrqC ) * scaleFactor - y_out%HSSBrTrqC = y1%HSSBrTrqC + b + c * t_out - b = (t(3)**2*(y1%ElecPwr - y2%ElecPwr) + t(2)**2*(-y1%ElecPwr + y3%ElecPwr))* scaleFactor - c = ( (t(2)-t(3))*y1%ElecPwr + t(3)*y2%ElecPwr - t(2)*y3%ElecPwr ) * scaleFactor - y_out%ElecPwr = y1%ElecPwr + b + c * t_out -IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN - DO i1 = LBOUND(y_out%TBDrCon,1),UBOUND(y_out%TBDrCon,1) - b = (t(3)**2*(y1%TBDrCon(i1) - y2%TBDrCon(i1)) + t(2)**2*(-y1%TBDrCon(i1) + y3%TBDrCon(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%TBDrCon(i1) + t(3)*y2%TBDrCon(i1) - t(2)*y3%TBDrCon(i1) ) * scaleFactor - y_out%TBDrCon(i1) = y1%TBDrCon(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Lidar) .AND. ALLOCATED(y1%Lidar)) THEN - DO i1 = LBOUND(y_out%Lidar,1),UBOUND(y_out%Lidar,1) - b = (t(3)**2*(y1%Lidar(i1) - y2%Lidar(i1)) + t(2)**2*(-y1%Lidar(i1) + y3%Lidar(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%Lidar(i1) + t(3)*y2%Lidar(i1) - t(2)*y3%Lidar(i1) ) * scaleFactor - y_out%Lidar(i1) = y1%Lidar(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%CableDeltaL) .AND. ALLOCATED(y1%CableDeltaL)) THEN - DO i1 = LBOUND(y_out%CableDeltaL,1),UBOUND(y_out%CableDeltaL,1) - b = (t(3)**2*(y1%CableDeltaL(i1) - y2%CableDeltaL(i1)) + t(2)**2*(-y1%CableDeltaL(i1) + y3%CableDeltaL(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%CableDeltaL(i1) + t(3)*y2%CableDeltaL(i1) - t(2)*y3%CableDeltaL(i1) ) * scaleFactor - y_out%CableDeltaL(i1) = y1%CableDeltaL(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%CableDeltaLdot) .AND. ALLOCATED(y1%CableDeltaLdot)) THEN - DO i1 = LBOUND(y_out%CableDeltaLdot,1),UBOUND(y_out%CableDeltaLdot,1) - b = (t(3)**2*(y1%CableDeltaLdot(i1) - y2%CableDeltaLdot(i1)) + t(2)**2*(-y1%CableDeltaLdot(i1) + y3%CableDeltaLdot(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%CableDeltaLdot(i1) + t(3)*y2%CableDeltaLdot(i1) - t(2)*y3%CableDeltaLdot(i1) ) * scaleFactor - y_out%CableDeltaLdot(i1) = y1%CableDeltaLdot(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN - DO i2 = LBOUND(y_out%BStCLoadMesh,2),UBOUND(y_out%BStCLoadMesh,2) - DO i1 = LBOUND(y_out%BStCLoadMesh,1),UBOUND(y_out%BStCLoadMesh,1) - CALL MeshExtrapInterp2(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), y3%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%NStCLoadMesh,1),UBOUND(y_out%NStCLoadMesh,1) - CALL MeshExtrapInterp2(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), y3%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%TStCLoadMesh,1),UBOUND(y_out%TStCLoadMesh,1) - CALL MeshExtrapInterp2(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), y3%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%SStCLoadMesh,1),UBOUND(y_out%SStCLoadMesh,1) - CALL MeshExtrapInterp2(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), y3%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%toSC) .AND. ALLOCATED(y1%toSC)) THEN - DO i1 = LBOUND(y_out%toSC,1),UBOUND(y_out%toSC,1) - b = (t(3)**2*(y1%toSC(i1) - y2%toSC(i1)) + t(2)**2*(-y1%toSC(i1) + y3%toSC(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%toSC(i1) + t(3)*y2%toSC(i1) - t(2)*y3%toSC(i1) ) * scaleFactor - y_out%toSC(i1) = y1%toSC(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SrvD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated + IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN + DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), y3%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%BlAirfoilCom) .AND. ALLOCATED(y1%BlAirfoilCom)) THEN + y_out%BlAirfoilCom = a1*y1%BlAirfoilCom + a2*y2%BlAirfoilCom + a3*y3%BlAirfoilCom + END IF ! check if allocated + y_out%YawMom = a1*y1%YawMom + a2*y2%YawMom + a3*y3%YawMom + y_out%GenTrq = a1*y1%GenTrq + a2*y2%GenTrq + a3*y3%GenTrq + y_out%HSSBrTrqC = a1*y1%HSSBrTrqC + a2*y2%HSSBrTrqC + a3*y3%HSSBrTrqC + y_out%ElecPwr = a1*y1%ElecPwr + a2*y2%ElecPwr + a3*y3%ElecPwr + IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN + y_out%TBDrCon = a1*y1%TBDrCon + a2*y2%TBDrCon + a3*y3%TBDrCon + END IF ! check if allocated + IF (ALLOCATED(y_out%Lidar) .AND. ALLOCATED(y1%Lidar)) THEN + y_out%Lidar = a1*y1%Lidar + a2*y2%Lidar + a3*y3%Lidar + END IF ! check if allocated + IF (ALLOCATED(y_out%CableDeltaL) .AND. ALLOCATED(y1%CableDeltaL)) THEN + y_out%CableDeltaL = a1*y1%CableDeltaL + a2*y2%CableDeltaL + a3*y3%CableDeltaL + END IF ! check if allocated + IF (ALLOCATED(y_out%CableDeltaLdot) .AND. ALLOCATED(y1%CableDeltaLdot)) THEN + y_out%CableDeltaLdot = a1*y1%CableDeltaLdot + a2*y2%CableDeltaLdot + a3*y3%CableDeltaLdot + END IF ! check if allocated + IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN + DO i2 = LBOUND(y_out%BStCLoadMesh,2),UBOUND(y_out%BStCLoadMesh,2) + DO i1 = LBOUND(y_out%BStCLoadMesh,1),UBOUND(y_out%BStCLoadMesh,1) + CALL MeshExtrapInterp2(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), y3%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN + DO i1 = LBOUND(y_out%NStCLoadMesh,1),UBOUND(y_out%NStCLoadMesh,1) + CALL MeshExtrapInterp2(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), y3%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN + DO i1 = LBOUND(y_out%TStCLoadMesh,1),UBOUND(y_out%TStCLoadMesh,1) + CALL MeshExtrapInterp2(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), y3%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN + DO i1 = LBOUND(y_out%SStCLoadMesh,1),UBOUND(y_out%SStCLoadMesh,1) + CALL MeshExtrapInterp2(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), y3%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%toSC) .AND. ALLOCATED(y1%toSC)) THEN + y_out%toSC = a1*y1%toSC + a2*y2%toSC + a3*y3%toSC + END IF ! check if allocated +END SUBROUTINE END MODULE ServoDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index 5eb8655303..ccff3fa523 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -36,68 +36,68 @@ MODULE StrucCtrl_Types ! ========= StC_InputFile ======= TYPE, PUBLIC :: StC_InputFile CHARACTER(1024) :: StCFileName !< Name of the input file; remove if there is no file [-] - LOGICAL :: Echo !< Echo input file to echo file [-] - INTEGER(IntKi) :: StC_CMODE !< control mode {0:none; 1: Semi-Active Control Mode; 2: Active Control Mode;} [-] - INTEGER(IntKi) :: StC_SA_MODE !< Semi-Active control mode {1: velocity-based ground hook control; 2: Inverse velocity-based ground hook control; 3: displacement-based ground hook control 4: Phase difference Algorithm with Friction Force 5: Phase difference Algorithm with Damping Force} [-] - INTEGER(IntKi) :: StC_DOF_MODE !< DOF mode {0: NO StC_DOF; 1: StC_X_DOF and StC_Y_DOF; 2: StC_XY_DOF; 3: TLCD; 4: Prescribed force/moment time series} [-] - LOGICAL :: StC_X_DOF !< DOF on or off [-] - LOGICAL :: StC_Y_DOF !< DOF on or off [-] - LOGICAL :: StC_Z_DOF !< DOF on or off [-] - REAL(ReKi) :: StC_X_DSP !< StC_X initial displacement [m] - REAL(ReKi) :: StC_Y_DSP !< StC_Y initial displacement [m] - REAL(ReKi) :: StC_Z_DSP !< StC_Z initial displacement [m] + LOGICAL :: Echo = .false. !< Echo input file to echo file [-] + INTEGER(IntKi) :: StC_CMODE = 0_IntKi !< control mode {0:none; 1: Semi-Active Control Mode; 2: Active Control Mode;} [-] + INTEGER(IntKi) :: StC_SA_MODE = 0_IntKi !< Semi-Active control mode {1: velocity-based ground hook control; 2: Inverse velocity-based ground hook control; 3: displacement-based ground hook control 4: Phase difference Algorithm with Friction Force 5: Phase difference Algorithm with Damping Force} [-] + INTEGER(IntKi) :: StC_DOF_MODE = 0_IntKi !< DOF mode {0: NO StC_DOF; 1: StC_X_DOF and StC_Y_DOF; 2: StC_XY_DOF; 3: TLCD; 4: Prescribed force/moment time series} [-] + LOGICAL :: StC_X_DOF = .false. !< DOF on or off [-] + LOGICAL :: StC_Y_DOF = .false. !< DOF on or off [-] + LOGICAL :: StC_Z_DOF = .false. !< DOF on or off [-] + REAL(ReKi) :: StC_X_DSP = 0.0_ReKi !< StC_X initial displacement [m] + REAL(ReKi) :: StC_Y_DSP = 0.0_ReKi !< StC_Y initial displacement [m] + REAL(ReKi) :: StC_Z_DSP = 0.0_ReKi !< StC_Z initial displacement [m] Character(10) :: StC_Z_PreLdC !< StC_Z spring preload [N] - REAL(ReKi) :: StC_X_M !< StC X mass [kg] - REAL(ReKi) :: StC_Y_M !< StC Y mass [kg] - REAL(ReKi) :: StC_Z_M !< StC Z mass [kg] - REAL(ReKi) :: StC_XY_M !< StC XY mass [kg] - REAL(ReKi) :: StC_X_K !< StC X stiffness [N/m] - REAL(ReKi) :: StC_Y_K !< StC Y stiffness [N/m] - REAL(ReKi) :: StC_Z_K !< StC Y stiffness [N/m] - REAL(ReKi) :: StC_X_C !< StC X damping [N/(m/s)] - REAL(ReKi) :: StC_Y_C !< StC Y damping [N/(m/s)] - REAL(ReKi) :: StC_Z_C !< StC Z damping [N/(m/s)] - REAL(ReKi) :: StC_X_PSP !< Positive stop position (maximum X mass displacement) [m] - REAL(ReKi) :: StC_X_NSP !< Negative stop position (minimum X mass displacement) [m] - REAL(ReKi) :: StC_Y_PSP !< Positive stop position (maximum Y mass displacement) [m] - REAL(ReKi) :: StC_Y_NSP !< Negative stop position (minimum Y mass displacement) [m] - REAL(ReKi) :: StC_Z_PSP !< Positive stop position (maximum Z mass displacement) [m] - REAL(ReKi) :: StC_Z_NSP !< Negative stop position (minimum Z mass displacement) [m] - REAL(ReKi) :: StC_X_KS !< Stop spring X stiffness [N/m] - REAL(ReKi) :: StC_X_CS !< Stop spring X damping [N/(m/s)] - REAL(ReKi) :: StC_Y_KS !< Stop spring Y stiffness [N/m] - REAL(ReKi) :: StC_Y_CS !< Stop spring Y damping [N/(m/s)] - REAL(ReKi) :: StC_Z_KS !< Stop spring Z stiffness [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [N/m] - REAL(ReKi) :: StC_Z_CS !< Stop spring Z damping [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [N/(m/s)] - REAL(ReKi) :: StC_P_X !< StC X initial displacement (m) [relative to at rest position] [m] - REAL(ReKi) :: StC_P_Y !< StC Y initial displacement (m) [relative to at rest position] [m] - REAL(ReKi) :: StC_P_Z !< StC Z initial displacement (m) [relative to at rest position; used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [m] - REAL(ReKi) :: StC_X_C_HIGH !< StC X high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_X_C_LOW !< StC X low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Y_C_HIGH !< StC Y high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Y_C_LOW !< StC Y low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Z_C_HIGH !< StC Z high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Z_C_LOW !< StC Z low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_X_C_BRAKE !< StC X high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: StC_Y_C_BRAKE !< StC Y high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: StC_Z_C_BRAKE !< StC Z high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: L_X !< X TLCD total length [m] - REAL(ReKi) :: B_X !< X TLCD horizontal length [m] - REAL(ReKi) :: area_X !< X TLCD cross-sectional area of vertical column [m^2] - REAL(ReKi) :: area_ratio_X !< X TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] - REAL(ReKi) :: headLossCoeff_X !< X TLCD head loss coeff [-] - REAL(ReKi) :: rho_X !< X TLCD liquid density [kg/m^3] - REAL(ReKi) :: L_Y !< Y TLCD total length [m] - REAL(ReKi) :: B_Y !< Y TLCD horizontal length [m] - REAL(ReKi) :: area_Y !< Side-Side TLCD cross-sectional area of vertical column [m] - REAL(ReKi) :: area_ratio_Y !< Side-Side TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] - REAL(ReKi) :: headLossCoeff_Y !< Side-Side TLCD head loss coeff [-] - REAL(ReKi) :: rho_Y !< Side-Side TLCD liquid density [kg/m^3] - LOGICAL :: USE_F_TBL !< use spring force from user-defined table (flag) [-] - INTEGER(IntKi) :: NKInpSt !< Number of input spring force rows in table [-] + REAL(ReKi) :: StC_X_M = 0.0_ReKi !< StC X mass [kg] + REAL(ReKi) :: StC_Y_M = 0.0_ReKi !< StC Y mass [kg] + REAL(ReKi) :: StC_Z_M = 0.0_ReKi !< StC Z mass [kg] + REAL(ReKi) :: StC_XY_M = 0.0_ReKi !< StC XY mass [kg] + REAL(ReKi) :: StC_X_K = 0.0_ReKi !< StC X stiffness [N/m] + REAL(ReKi) :: StC_Y_K = 0.0_ReKi !< StC Y stiffness [N/m] + REAL(ReKi) :: StC_Z_K = 0.0_ReKi !< StC Y stiffness [N/m] + REAL(ReKi) :: StC_X_C = 0.0_ReKi !< StC X damping [N/(m/s)] + REAL(ReKi) :: StC_Y_C = 0.0_ReKi !< StC Y damping [N/(m/s)] + REAL(ReKi) :: StC_Z_C = 0.0_ReKi !< StC Z damping [N/(m/s)] + REAL(ReKi) :: StC_X_PSP = 0.0_ReKi !< Positive stop position (maximum X mass displacement) [m] + REAL(ReKi) :: StC_X_NSP = 0.0_ReKi !< Negative stop position (minimum X mass displacement) [m] + REAL(ReKi) :: StC_Y_PSP = 0.0_ReKi !< Positive stop position (maximum Y mass displacement) [m] + REAL(ReKi) :: StC_Y_NSP = 0.0_ReKi !< Negative stop position (minimum Y mass displacement) [m] + REAL(ReKi) :: StC_Z_PSP = 0.0_ReKi !< Positive stop position (maximum Z mass displacement) [m] + REAL(ReKi) :: StC_Z_NSP = 0.0_ReKi !< Negative stop position (minimum Z mass displacement) [m] + REAL(ReKi) :: StC_X_KS = 0.0_ReKi !< Stop spring X stiffness [N/m] + REAL(ReKi) :: StC_X_CS = 0.0_ReKi !< Stop spring X damping [N/(m/s)] + REAL(ReKi) :: StC_Y_KS = 0.0_ReKi !< Stop spring Y stiffness [N/m] + REAL(ReKi) :: StC_Y_CS = 0.0_ReKi !< Stop spring Y damping [N/(m/s)] + REAL(ReKi) :: StC_Z_KS = 0.0_ReKi !< Stop spring Z stiffness [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [N/m] + REAL(ReKi) :: StC_Z_CS = 0.0_ReKi !< Stop spring Z damping [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [N/(m/s)] + REAL(ReKi) :: StC_P_X = 0.0_ReKi !< StC X initial displacement (m) [relative to at rest position] [m] + REAL(ReKi) :: StC_P_Y = 0.0_ReKi !< StC Y initial displacement (m) [relative to at rest position] [m] + REAL(ReKi) :: StC_P_Z = 0.0_ReKi !< StC Z initial displacement (m) [relative to at rest position; used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [m] + REAL(ReKi) :: StC_X_C_HIGH = 0.0_ReKi !< StC X high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_X_C_LOW = 0.0_ReKi !< StC X low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Y_C_HIGH = 0.0_ReKi !< StC Y high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Y_C_LOW = 0.0_ReKi !< StC Y low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Z_C_HIGH = 0.0_ReKi !< StC Z high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Z_C_LOW = 0.0_ReKi !< StC Z low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_X_C_BRAKE = 0.0_ReKi !< StC X high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: StC_Y_C_BRAKE = 0.0_ReKi !< StC Y high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: StC_Z_C_BRAKE = 0.0_ReKi !< StC Z high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: L_X = 0.0_ReKi !< X TLCD total length [m] + REAL(ReKi) :: B_X = 0.0_ReKi !< X TLCD horizontal length [m] + REAL(ReKi) :: area_X = 0.0_ReKi !< X TLCD cross-sectional area of vertical column [m^2] + REAL(ReKi) :: area_ratio_X = 0.0_ReKi !< X TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] + REAL(ReKi) :: headLossCoeff_X = 0.0_ReKi !< X TLCD head loss coeff [-] + REAL(ReKi) :: rho_X = 0.0_ReKi !< X TLCD liquid density [kg/m^3] + REAL(ReKi) :: L_Y = 0.0_ReKi !< Y TLCD total length [m] + REAL(ReKi) :: B_Y = 0.0_ReKi !< Y TLCD horizontal length [m] + REAL(ReKi) :: area_Y = 0.0_ReKi !< Side-Side TLCD cross-sectional area of vertical column [m] + REAL(ReKi) :: area_ratio_Y = 0.0_ReKi !< Side-Side TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] + REAL(ReKi) :: headLossCoeff_Y = 0.0_ReKi !< Side-Side TLCD head loss coeff [-] + REAL(ReKi) :: rho_Y = 0.0_ReKi !< Side-Side TLCD liquid density [kg/m^3] + LOGICAL :: USE_F_TBL = .false. !< use spring force from user-defined table (flag) [-] + INTEGER(IntKi) :: NKInpSt = 0_IntKi !< Number of input spring force rows in table [-] CHARACTER(1024) :: StC_F_TBL_FILE !< user-defined spring table filename [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_TBL !< user-defined spring force [N] - INTEGER(IntKi) :: PrescribedForcesCoordSys !< Prescribed forces coordinate system {0: global; 1: local} [-] + INTEGER(IntKi) :: PrescribedForcesCoordSys = 0_IntKi !< Prescribed forces coordinate system {0: global; 1: local} [-] CHARACTER(1024) :: PrescribedForcesFile !< Prescribed force time-series filename [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StC_PrescribedForce !< StC prescribed force time-series info [(s,N,N-m)] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: StC_CChan !< StC control chan to use -- one per instance [-] @@ -107,8 +107,8 @@ MODULE StrucCtrl_Types TYPE, PUBLIC :: StC_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) , DIMENSION(1:3) :: Gravity !< Gravitational acceleration vector [m/s^2] - INTEGER(IntKi) :: NumMeshPts !< Number of mesh points [-] + REAL(ReKi) , DIMENSION(1:3) :: Gravity = 0.0_ReKi !< Gravitational acceleration vector [m/s^2] + INTEGER(IntKi) :: NumMeshPts = 0_IntKi !< Number of mesh points [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InitRefPos !< X-Y-Z reference position of point: i.e. each blade root (3 x NumBlades) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: InitTransDisp !< X-Y-Z displacement from position of point at init: i.e. each blade root (3 x NumBlades) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: InitOrient !< DCM orientation of point at init: i.e. each blade root (3x3 x NumBlades) [-] @@ -142,17 +142,17 @@ MODULE StrucCtrl_Types ! ======================= ! ========= StC_DiscreteStateType ======= TYPE, PUBLIC :: StC_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE StC_DiscreteStateType ! ======================= ! ========= StC_ConstraintStateType ======= TYPE, PUBLIC :: StC_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE StC_ConstraintStateType ! ======================= ! ========= StC_OtherStateType ======= TYPE, PUBLIC :: StC_OtherStateType - REAL(ReKi) :: DummyOtherState !< Remove this variable if you have other/logical states [-] + REAL(ReKi) :: DummyOtherState = 0.0_ReKi !< Remove this variable if you have other/logical states [-] END TYPE StC_OtherStateType ! ======================= ! ========= StC_MiscVarType ======= @@ -174,60 +174,60 @@ MODULE StrucCtrl_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_P !< StC force vector, local coordinates for point [N] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M_P !< StC moment vector, local coordinates for point [N-m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Acc !< StC aggregated acceleration in X,Y local coordinates for point [m/s^2] - INTEGER(IntKi) :: PrescribedInterpIdx !< Index for interpolation of Prescribed force array [-] + INTEGER(IntKi) :: PrescribedInterpIdx = 0_IntKi !< Index for interpolation of Prescribed force array [-] END TYPE StC_MiscVarType ! ======================= ! ========= StC_ParameterType ======= TYPE, PUBLIC :: StC_ParameterType - REAL(DbKi) :: DT !< Time step for cont. state integration & disc. state update [seconds] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for cont. state integration & disc. state update [seconds] CHARACTER(1024) :: RootName !< RootName for writing output files [-] - INTEGER(IntKi) :: StC_DOF_MODE !< DOF mode {0: NO StC_DOF; 1: StC_X_DOF and StC_Y_DOF; 2: StC_XY_DOF; 3: TLCD; 4: Prescribed force/moment time series} [-] - LOGICAL :: StC_X_DOF !< DOF on or off [-] - LOGICAL :: StC_Y_DOF !< DOF on or off [-] - LOGICAL :: StC_Z_DOF !< DOF on or off [-] - REAL(ReKi) :: StC_Z_PreLd !< StC_Z spring preload [N] - REAL(ReKi) :: M_X !< StC mass [kg] - REAL(ReKi) :: M_Y !< StC mass [kg] - REAL(ReKi) :: M_Z !< StC mass [kg] - REAL(ReKi) :: M_XY !< StCXY mass [kg] - REAL(ReKi) :: K_X !< StC stiffness [N/m] - REAL(ReKi) :: K_Y !< StC stiffness [N/m] - REAL(ReKi) :: K_Z !< StC stiffness [N/m] - REAL(ReKi) :: C_X !< StC damping [N/(m/s)] - REAL(ReKi) :: C_Y !< StC damping [N/(m/s)] - REAL(ReKi) :: C_Z !< StC damping [N/(m/s)] - REAL(ReKi) , DIMENSION(1:3) :: K_S !< StC stop stiffness [N/m] - REAL(ReKi) , DIMENSION(1:3) :: C_S !< StC stop damping [N/(m/s)] - REAL(ReKi) , DIMENSION(1:3) :: P_SP !< Positive stop position (maximum mass displacement) [m] - REAL(ReKi) , DIMENSION(1:3) :: N_SP !< Negative stop position (minimum X mass displacement) [m] - REAL(ReKi) , DIMENSION(1:3) :: Gravity !< Gravitational acceleration vector [m/s^2] - INTEGER(IntKi) :: StC_CMODE !< control mode {0:none; 1: Semi-Active Control Mode; 4: Active Control Mode through Simulink (not available); 5: Active Control Mode through Bladed interface} [-] - INTEGER(IntKi) :: StC_SA_MODE !< Semi-Active control mode {1: velocity-based ground hook control; 2: Inverse velocity-based ground hook control; 3: displacement-based ground hook control 4: Phase difference Algorithm with Friction Force 5: Phase difference Algorithm with Damping Force} [-] - REAL(ReKi) :: StC_X_C_HIGH !< StC X high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_X_C_LOW !< StC X low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Y_C_HIGH !< StC Y high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Y_C_LOW !< StC Y low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Z_C_HIGH !< StC Z high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Z_C_LOW !< StC Z low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_X_C_BRAKE !< StC X high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: StC_Y_C_BRAKE !< StC Y high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: StC_Z_C_BRAKE !< StC Y high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: L_X !< X TLCD total length [m] - REAL(ReKi) :: B_X !< X TLCD horizontal length [m] - REAL(ReKi) :: area_X !< X TLCD cross-sectional area of vertical column [m^2] - REAL(ReKi) :: area_ratio_X !< X TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] - REAL(ReKi) :: headLossCoeff_X !< X TLCD head loss coeff [-] - REAL(ReKi) :: rho_X !< X TLCD liquid density [kg/m^3] - REAL(ReKi) :: L_Y !< Y TLCD total length [m] - REAL(ReKi) :: B_Y !< Y TLCD horizontal length [m] - REAL(ReKi) :: area_Y !< Side-Side TLCD cross-sectional area of vertical column [m] - REAL(ReKi) :: area_ratio_Y !< Side-Side TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] - REAL(ReKi) :: headLossCoeff_Y !< Side-Side TLCD head loss coeff [-] - REAL(ReKi) :: rho_Y !< Side-Side TLCD liquid density [kg/m^3] - LOGICAL :: Use_F_TBL !< use spring force from user-defined table (flag) [-] + INTEGER(IntKi) :: StC_DOF_MODE = 0_IntKi !< DOF mode {0: NO StC_DOF; 1: StC_X_DOF and StC_Y_DOF; 2: StC_XY_DOF; 3: TLCD; 4: Prescribed force/moment time series} [-] + LOGICAL :: StC_X_DOF = .false. !< DOF on or off [-] + LOGICAL :: StC_Y_DOF = .false. !< DOF on or off [-] + LOGICAL :: StC_Z_DOF = .false. !< DOF on or off [-] + REAL(ReKi) :: StC_Z_PreLd = 0.0_ReKi !< StC_Z spring preload [N] + REAL(ReKi) :: M_X = 0.0_ReKi !< StC mass [kg] + REAL(ReKi) :: M_Y = 0.0_ReKi !< StC mass [kg] + REAL(ReKi) :: M_Z = 0.0_ReKi !< StC mass [kg] + REAL(ReKi) :: M_XY = 0.0_ReKi !< StCXY mass [kg] + REAL(ReKi) :: K_X = 0.0_ReKi !< StC stiffness [N/m] + REAL(ReKi) :: K_Y = 0.0_ReKi !< StC stiffness [N/m] + REAL(ReKi) :: K_Z = 0.0_ReKi !< StC stiffness [N/m] + REAL(ReKi) :: C_X = 0.0_ReKi !< StC damping [N/(m/s)] + REAL(ReKi) :: C_Y = 0.0_ReKi !< StC damping [N/(m/s)] + REAL(ReKi) :: C_Z = 0.0_ReKi !< StC damping [N/(m/s)] + REAL(ReKi) , DIMENSION(1:3) :: K_S = 0.0_ReKi !< StC stop stiffness [N/m] + REAL(ReKi) , DIMENSION(1:3) :: C_S = 0.0_ReKi !< StC stop damping [N/(m/s)] + REAL(ReKi) , DIMENSION(1:3) :: P_SP = 0.0_ReKi !< Positive stop position (maximum mass displacement) [m] + REAL(ReKi) , DIMENSION(1:3) :: N_SP = 0.0_ReKi !< Negative stop position (minimum X mass displacement) [m] + REAL(ReKi) , DIMENSION(1:3) :: Gravity = 0.0_ReKi !< Gravitational acceleration vector [m/s^2] + INTEGER(IntKi) :: StC_CMODE = 0_IntKi !< control mode {0:none; 1: Semi-Active Control Mode; 4: Active Control Mode through Simulink (not available); 5: Active Control Mode through Bladed interface} [-] + INTEGER(IntKi) :: StC_SA_MODE = 0_IntKi !< Semi-Active control mode {1: velocity-based ground hook control; 2: Inverse velocity-based ground hook control; 3: displacement-based ground hook control 4: Phase difference Algorithm with Friction Force 5: Phase difference Algorithm with Damping Force} [-] + REAL(ReKi) :: StC_X_C_HIGH = 0.0_ReKi !< StC X high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_X_C_LOW = 0.0_ReKi !< StC X low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Y_C_HIGH = 0.0_ReKi !< StC Y high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Y_C_LOW = 0.0_ReKi !< StC Y low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Z_C_HIGH = 0.0_ReKi !< StC Z high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Z_C_LOW = 0.0_ReKi !< StC Z low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_X_C_BRAKE = 0.0_ReKi !< StC X high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: StC_Y_C_BRAKE = 0.0_ReKi !< StC Y high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: StC_Z_C_BRAKE = 0.0_ReKi !< StC Y high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: L_X = 0.0_ReKi !< X TLCD total length [m] + REAL(ReKi) :: B_X = 0.0_ReKi !< X TLCD horizontal length [m] + REAL(ReKi) :: area_X = 0.0_ReKi !< X TLCD cross-sectional area of vertical column [m^2] + REAL(ReKi) :: area_ratio_X = 0.0_ReKi !< X TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] + REAL(ReKi) :: headLossCoeff_X = 0.0_ReKi !< X TLCD head loss coeff [-] + REAL(ReKi) :: rho_X = 0.0_ReKi !< X TLCD liquid density [kg/m^3] + REAL(ReKi) :: L_Y = 0.0_ReKi !< Y TLCD total length [m] + REAL(ReKi) :: B_Y = 0.0_ReKi !< Y TLCD horizontal length [m] + REAL(ReKi) :: area_Y = 0.0_ReKi !< Side-Side TLCD cross-sectional area of vertical column [m] + REAL(ReKi) :: area_ratio_Y = 0.0_ReKi !< Side-Side TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] + REAL(ReKi) :: headLossCoeff_Y = 0.0_ReKi !< Side-Side TLCD head loss coeff [-] + REAL(ReKi) :: rho_Y = 0.0_ReKi !< Side-Side TLCD liquid density [kg/m^3] + LOGICAL :: Use_F_TBL = .false. !< use spring force from user-defined table (flag) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_TBL !< user-defined spring force [N] - INTEGER(IntKi) :: NumMeshPts !< Number of mesh points [-] - INTEGER(IntKi) :: PrescribedForcesCoordSys !< Prescribed forces coordinate system {0: global; 1: local} [-] + INTEGER(IntKi) :: NumMeshPts = 0_IntKi !< Number of mesh points [-] + INTEGER(IntKi) :: PrescribedForcesCoordSys = 0_IntKi !< Prescribed forces coordinate system {0: global; 1: local} [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StC_PrescribedForce !< StC prescribed force time-series info [(s,N,N-m)] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: StC_CChan !< StC control chan to use [-] END TYPE StC_ParameterType @@ -249,5554 +249,2570 @@ MODULE StrucCtrl_Types END TYPE StC_OutputType ! ======================= CONTAINS - SUBROUTINE StC_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(StC_InputFile), INTENT(INOUT) :: DstInputFileData - 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 = 'StC_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%StCFileName = SrcInputFileData%StCFileName - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%StC_CMODE = SrcInputFileData%StC_CMODE - DstInputFileData%StC_SA_MODE = SrcInputFileData%StC_SA_MODE - DstInputFileData%StC_DOF_MODE = SrcInputFileData%StC_DOF_MODE - DstInputFileData%StC_X_DOF = SrcInputFileData%StC_X_DOF - DstInputFileData%StC_Y_DOF = SrcInputFileData%StC_Y_DOF - DstInputFileData%StC_Z_DOF = SrcInputFileData%StC_Z_DOF - DstInputFileData%StC_X_DSP = SrcInputFileData%StC_X_DSP - DstInputFileData%StC_Y_DSP = SrcInputFileData%StC_Y_DSP - DstInputFileData%StC_Z_DSP = SrcInputFileData%StC_Z_DSP - DstInputFileData%StC_Z_PreLdC = SrcInputFileData%StC_Z_PreLdC - DstInputFileData%StC_X_M = SrcInputFileData%StC_X_M - DstInputFileData%StC_Y_M = SrcInputFileData%StC_Y_M - DstInputFileData%StC_Z_M = SrcInputFileData%StC_Z_M - DstInputFileData%StC_XY_M = SrcInputFileData%StC_XY_M - DstInputFileData%StC_X_K = SrcInputFileData%StC_X_K - DstInputFileData%StC_Y_K = SrcInputFileData%StC_Y_K - DstInputFileData%StC_Z_K = SrcInputFileData%StC_Z_K - DstInputFileData%StC_X_C = SrcInputFileData%StC_X_C - DstInputFileData%StC_Y_C = SrcInputFileData%StC_Y_C - DstInputFileData%StC_Z_C = SrcInputFileData%StC_Z_C - DstInputFileData%StC_X_PSP = SrcInputFileData%StC_X_PSP - DstInputFileData%StC_X_NSP = SrcInputFileData%StC_X_NSP - DstInputFileData%StC_Y_PSP = SrcInputFileData%StC_Y_PSP - DstInputFileData%StC_Y_NSP = SrcInputFileData%StC_Y_NSP - DstInputFileData%StC_Z_PSP = SrcInputFileData%StC_Z_PSP - DstInputFileData%StC_Z_NSP = SrcInputFileData%StC_Z_NSP - DstInputFileData%StC_X_KS = SrcInputFileData%StC_X_KS - DstInputFileData%StC_X_CS = SrcInputFileData%StC_X_CS - DstInputFileData%StC_Y_KS = SrcInputFileData%StC_Y_KS - DstInputFileData%StC_Y_CS = SrcInputFileData%StC_Y_CS - DstInputFileData%StC_Z_KS = SrcInputFileData%StC_Z_KS - DstInputFileData%StC_Z_CS = SrcInputFileData%StC_Z_CS - DstInputFileData%StC_P_X = SrcInputFileData%StC_P_X - DstInputFileData%StC_P_Y = SrcInputFileData%StC_P_Y - DstInputFileData%StC_P_Z = SrcInputFileData%StC_P_Z - DstInputFileData%StC_X_C_HIGH = SrcInputFileData%StC_X_C_HIGH - DstInputFileData%StC_X_C_LOW = SrcInputFileData%StC_X_C_LOW - DstInputFileData%StC_Y_C_HIGH = SrcInputFileData%StC_Y_C_HIGH - DstInputFileData%StC_Y_C_LOW = SrcInputFileData%StC_Y_C_LOW - DstInputFileData%StC_Z_C_HIGH = SrcInputFileData%StC_Z_C_HIGH - DstInputFileData%StC_Z_C_LOW = SrcInputFileData%StC_Z_C_LOW - DstInputFileData%StC_X_C_BRAKE = SrcInputFileData%StC_X_C_BRAKE - DstInputFileData%StC_Y_C_BRAKE = SrcInputFileData%StC_Y_C_BRAKE - DstInputFileData%StC_Z_C_BRAKE = SrcInputFileData%StC_Z_C_BRAKE - DstInputFileData%L_X = SrcInputFileData%L_X - DstInputFileData%B_X = SrcInputFileData%B_X - DstInputFileData%area_X = SrcInputFileData%area_X - DstInputFileData%area_ratio_X = SrcInputFileData%area_ratio_X - DstInputFileData%headLossCoeff_X = SrcInputFileData%headLossCoeff_X - DstInputFileData%rho_X = SrcInputFileData%rho_X - DstInputFileData%L_Y = SrcInputFileData%L_Y - DstInputFileData%B_Y = SrcInputFileData%B_Y - DstInputFileData%area_Y = SrcInputFileData%area_Y - DstInputFileData%area_ratio_Y = SrcInputFileData%area_ratio_Y - DstInputFileData%headLossCoeff_Y = SrcInputFileData%headLossCoeff_Y - DstInputFileData%rho_Y = SrcInputFileData%rho_Y - DstInputFileData%USE_F_TBL = SrcInputFileData%USE_F_TBL - DstInputFileData%NKInpSt = SrcInputFileData%NKInpSt - DstInputFileData%StC_F_TBL_FILE = SrcInputFileData%StC_F_TBL_FILE -IF (ALLOCATED(SrcInputFileData%F_TBL)) THEN - i1_l = LBOUND(SrcInputFileData%F_TBL,1) - i1_u = UBOUND(SrcInputFileData%F_TBL,1) - i2_l = LBOUND(SrcInputFileData%F_TBL,2) - i2_u = UBOUND(SrcInputFileData%F_TBL,2) - IF (.NOT. ALLOCATED(DstInputFileData%F_TBL)) THEN - ALLOCATE(DstInputFileData%F_TBL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%F_TBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%F_TBL = SrcInputFileData%F_TBL -ENDIF - DstInputFileData%PrescribedForcesCoordSys = SrcInputFileData%PrescribedForcesCoordSys - DstInputFileData%PrescribedForcesFile = SrcInputFileData%PrescribedForcesFile -IF (ALLOCATED(SrcInputFileData%StC_PrescribedForce)) THEN - i1_l = LBOUND(SrcInputFileData%StC_PrescribedForce,1) - i1_u = UBOUND(SrcInputFileData%StC_PrescribedForce,1) - i2_l = LBOUND(SrcInputFileData%StC_PrescribedForce,2) - i2_u = UBOUND(SrcInputFileData%StC_PrescribedForce,2) - IF (.NOT. ALLOCATED(DstInputFileData%StC_PrescribedForce)) THEN - ALLOCATE(DstInputFileData%StC_PrescribedForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StC_PrescribedForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%StC_PrescribedForce = SrcInputFileData%StC_PrescribedForce -ENDIF -IF (ALLOCATED(SrcInputFileData%StC_CChan)) THEN - i1_l = LBOUND(SrcInputFileData%StC_CChan,1) - i1_u = UBOUND(SrcInputFileData%StC_CChan,1) - IF (.NOT. ALLOCATED(DstInputFileData%StC_CChan)) THEN - ALLOCATE(DstInputFileData%StC_CChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StC_CChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%StC_CChan = SrcInputFileData%StC_CChan -ENDIF - END SUBROUTINE StC_CopyInputFile - - SUBROUTINE StC_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(StC_InputFile), INTENT(INOUT) :: InputFileData - 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 = 'StC_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputFileData%F_TBL)) THEN - DEALLOCATE(InputFileData%F_TBL) -ENDIF -IF (ALLOCATED(InputFileData%StC_PrescribedForce)) THEN - DEALLOCATE(InputFileData%StC_PrescribedForce) -ENDIF -IF (ALLOCATED(InputFileData%StC_CChan)) THEN - DEALLOCATE(InputFileData%StC_CChan) -ENDIF - END SUBROUTINE StC_DestroyInputFile - - SUBROUTINE StC_PackInputFile( 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(StC_InputFile), 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 = 'StC_PackInputFile' - ! 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%StCFileName) ! StCFileName - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! StC_CMODE - Int_BufSz = Int_BufSz + 1 ! StC_SA_MODE - Int_BufSz = Int_BufSz + 1 ! StC_DOF_MODE - Int_BufSz = Int_BufSz + 1 ! StC_X_DOF - Int_BufSz = Int_BufSz + 1 ! StC_Y_DOF - Int_BufSz = Int_BufSz + 1 ! StC_Z_DOF - Re_BufSz = Re_BufSz + 1 ! StC_X_DSP - Re_BufSz = Re_BufSz + 1 ! StC_Y_DSP - Re_BufSz = Re_BufSz + 1 ! StC_Z_DSP - Int_BufSz = Int_BufSz + 1*LEN(InData%StC_Z_PreLdC) ! StC_Z_PreLdC - Re_BufSz = Re_BufSz + 1 ! StC_X_M - Re_BufSz = Re_BufSz + 1 ! StC_Y_M - Re_BufSz = Re_BufSz + 1 ! StC_Z_M - Re_BufSz = Re_BufSz + 1 ! StC_XY_M - Re_BufSz = Re_BufSz + 1 ! StC_X_K - Re_BufSz = Re_BufSz + 1 ! StC_Y_K - Re_BufSz = Re_BufSz + 1 ! StC_Z_K - Re_BufSz = Re_BufSz + 1 ! StC_X_C - Re_BufSz = Re_BufSz + 1 ! StC_Y_C - Re_BufSz = Re_BufSz + 1 ! StC_Z_C - Re_BufSz = Re_BufSz + 1 ! StC_X_PSP - Re_BufSz = Re_BufSz + 1 ! StC_X_NSP - Re_BufSz = Re_BufSz + 1 ! StC_Y_PSP - Re_BufSz = Re_BufSz + 1 ! StC_Y_NSP - Re_BufSz = Re_BufSz + 1 ! StC_Z_PSP - Re_BufSz = Re_BufSz + 1 ! StC_Z_NSP - Re_BufSz = Re_BufSz + 1 ! StC_X_KS - Re_BufSz = Re_BufSz + 1 ! StC_X_CS - Re_BufSz = Re_BufSz + 1 ! StC_Y_KS - Re_BufSz = Re_BufSz + 1 ! StC_Y_CS - Re_BufSz = Re_BufSz + 1 ! StC_Z_KS - Re_BufSz = Re_BufSz + 1 ! StC_Z_CS - Re_BufSz = Re_BufSz + 1 ! StC_P_X - Re_BufSz = Re_BufSz + 1 ! StC_P_Y - Re_BufSz = Re_BufSz + 1 ! StC_P_Z - Re_BufSz = Re_BufSz + 1 ! StC_X_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_X_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_X_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! L_X - Re_BufSz = Re_BufSz + 1 ! B_X - Re_BufSz = Re_BufSz + 1 ! area_X - Re_BufSz = Re_BufSz + 1 ! area_ratio_X - Re_BufSz = Re_BufSz + 1 ! headLossCoeff_X - Re_BufSz = Re_BufSz + 1 ! rho_X - Re_BufSz = Re_BufSz + 1 ! L_Y - Re_BufSz = Re_BufSz + 1 ! B_Y - Re_BufSz = Re_BufSz + 1 ! area_Y - Re_BufSz = Re_BufSz + 1 ! area_ratio_Y - Re_BufSz = Re_BufSz + 1 ! headLossCoeff_Y - Re_BufSz = Re_BufSz + 1 ! rho_Y - Int_BufSz = Int_BufSz + 1 ! USE_F_TBL - Int_BufSz = Int_BufSz + 1 ! NKInpSt - Int_BufSz = Int_BufSz + 1*LEN(InData%StC_F_TBL_FILE) ! StC_F_TBL_FILE - Int_BufSz = Int_BufSz + 1 ! F_TBL allocated yes/no - IF ( ALLOCATED(InData%F_TBL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_TBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_TBL) ! F_TBL - END IF - Int_BufSz = Int_BufSz + 1 ! PrescribedForcesCoordSys - Int_BufSz = Int_BufSz + 1*LEN(InData%PrescribedForcesFile) ! PrescribedForcesFile - Int_BufSz = Int_BufSz + 1 ! StC_PrescribedForce allocated yes/no - IF ( ALLOCATED(InData%StC_PrescribedForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StC_PrescribedForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StC_PrescribedForce) ! StC_PrescribedForce - END IF - Int_BufSz = Int_BufSz + 1 ! StC_CChan allocated yes/no - IF ( ALLOCATED(InData%StC_CChan) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StC_CChan upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%StC_CChan) ! StC_CChan - 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%StCFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%StCFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%StC_CMODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%StC_SA_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%StC_DOF_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_X_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_Y_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_Z_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_DSP - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%StC_Z_PreLdC) - IntKiBuf(Int_Xferred) = ICHAR(InData%StC_Z_PreLdC(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%StC_X_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_XY_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_K - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_K - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_K - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_PSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_NSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_PSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_NSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_PSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_NSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_KS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_CS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_KS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_CS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_KS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_CS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_P_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_P_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_P_Z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%L_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%B_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_ratio_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%headLossCoeff_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rho_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%L_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%B_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_ratio_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%headLossCoeff_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rho_Y - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%USE_F_TBL, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NKInpSt - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%StC_F_TBL_FILE) - IntKiBuf(Int_Xferred) = ICHAR(InData%StC_F_TBL_FILE(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%F_TBL) ) 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%F_TBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_TBL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_TBL,2), UBOUND(InData%F_TBL,2) - DO i1 = LBOUND(InData%F_TBL,1), UBOUND(InData%F_TBL,1) - ReKiBuf(Re_Xferred) = InData%F_TBL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%PrescribedForcesCoordSys - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PrescribedForcesFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%PrescribedForcesFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%StC_PrescribedForce) ) 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%StC_PrescribedForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_PrescribedForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_PrescribedForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_PrescribedForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StC_PrescribedForce,2), UBOUND(InData%StC_PrescribedForce,2) - DO i1 = LBOUND(InData%StC_PrescribedForce,1), UBOUND(InData%StC_PrescribedForce,1) - ReKiBuf(Re_Xferred) = InData%StC_PrescribedForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StC_CChan) ) 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%StC_CChan,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_CChan,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StC_CChan,1), UBOUND(InData%StC_CChan,1) - IntKiBuf(Int_Xferred) = InData%StC_CChan(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE StC_PackInputFile - - SUBROUTINE StC_UnPackInputFile( 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(StC_InputFile), 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 = 'StC_UnPackInputFile' - ! 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%StCFileName) - OutData%StCFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%StC_CMODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_SA_MODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_DOF_MODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_X_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_X_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_Y_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_Y_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_Z_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_Z_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_X_DSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_DSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_DSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%StC_Z_PreLdC) - OutData%StC_Z_PreLdC(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%StC_X_M = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_M = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_M = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_XY_M = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_K = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_K = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_K = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_PSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_NSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_PSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_NSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_PSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_NSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_KS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_CS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_KS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_CS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_KS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_CS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_P_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_P_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_P_Z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%L_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%B_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_ratio_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%headLossCoeff_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rho_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%L_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%B_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_ratio_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%headLossCoeff_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rho_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%USE_F_TBL = TRANSFER(IntKiBuf(Int_Xferred), OutData%USE_F_TBL) - Int_Xferred = Int_Xferred + 1 - OutData%NKInpSt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%StC_F_TBL_FILE) - OutData%StC_F_TBL_FILE(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_TBL 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%F_TBL)) DEALLOCATE(OutData%F_TBL) - ALLOCATE(OutData%F_TBL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_TBL,2), UBOUND(OutData%F_TBL,2) - DO i1 = LBOUND(OutData%F_TBL,1), UBOUND(OutData%F_TBL,1) - OutData%F_TBL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%PrescribedForcesCoordSys = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PrescribedForcesFile) - OutData%PrescribedForcesFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_PrescribedForce 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%StC_PrescribedForce)) DEALLOCATE(OutData%StC_PrescribedForce) - ALLOCATE(OutData%StC_PrescribedForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_PrescribedForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StC_PrescribedForce,2), UBOUND(OutData%StC_PrescribedForce,2) - DO i1 = LBOUND(OutData%StC_PrescribedForce,1), UBOUND(OutData%StC_PrescribedForce,1) - OutData%StC_PrescribedForce(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_CChan 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%StC_CChan)) DEALLOCATE(OutData%StC_CChan) - ALLOCATE(OutData%StC_CChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_CChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StC_CChan,1), UBOUND(OutData%StC_CChan,1) - OutData%StC_CChan(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE StC_UnPackInputFile - - SUBROUTINE StC_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(StC_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyInitInput' -! +subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(StC_InputFile), intent(in) :: SrcInputFileData + type(StC_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%NumMeshPts = SrcInitInputData%NumMeshPts -IF (ALLOCATED(SrcInitInputData%InitRefPos)) THEN - i1_l = LBOUND(SrcInitInputData%InitRefPos,1) - i1_u = UBOUND(SrcInitInputData%InitRefPos,1) - i2_l = LBOUND(SrcInitInputData%InitRefPos,2) - i2_u = UBOUND(SrcInitInputData%InitRefPos,2) - IF (.NOT. ALLOCATED(DstInitInputData%InitRefPos)) THEN - ALLOCATE(DstInitInputData%InitRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%InitRefPos = SrcInitInputData%InitRefPos -ENDIF -IF (ALLOCATED(SrcInitInputData%InitTransDisp)) THEN - i1_l = LBOUND(SrcInitInputData%InitTransDisp,1) - i1_u = UBOUND(SrcInitInputData%InitTransDisp,1) - i2_l = LBOUND(SrcInitInputData%InitTransDisp,2) - i2_u = UBOUND(SrcInitInputData%InitTransDisp,2) - IF (.NOT. ALLOCATED(DstInitInputData%InitTransDisp)) THEN - ALLOCATE(DstInitInputData%InitTransDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitTransDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%InitTransDisp = SrcInitInputData%InitTransDisp -ENDIF -IF (ALLOCATED(SrcInitInputData%InitOrient)) THEN - i1_l = LBOUND(SrcInitInputData%InitOrient,1) - i1_u = UBOUND(SrcInitInputData%InitOrient,1) - i2_l = LBOUND(SrcInitInputData%InitOrient,2) - i2_u = UBOUND(SrcInitInputData%InitOrient,2) - i3_l = LBOUND(SrcInitInputData%InitOrient,3) - i3_u = UBOUND(SrcInitInputData%InitOrient,3) - IF (.NOT. ALLOCATED(DstInitInputData%InitOrient)) THEN - ALLOCATE(DstInitInputData%InitOrient(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%InitOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%InitOrient = SrcInitInputData%InitOrient -ENDIF -IF (ALLOCATED(SrcInitInputData%InitRefOrient)) THEN - i1_l = LBOUND(SrcInitInputData%InitRefOrient,1) - i1_u = UBOUND(SrcInitInputData%InitRefOrient,1) - i2_l = LBOUND(SrcInitInputData%InitRefOrient,2) - i2_u = UBOUND(SrcInitInputData%InitRefOrient,2) - i3_l = LBOUND(SrcInitInputData%InitRefOrient,3) - i3_u = UBOUND(SrcInitInputData%InitRefOrient,3) - IF (.NOT. ALLOCATED(DstInitInputData%InitRefOrient)) THEN - ALLOCATE(DstInitInputData%InitRefOrient(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%InitRefOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%InitRefOrient = SrcInitInputData%InitRefOrient -ENDIF - DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%UseInputFile_PrescribeFrc = SrcInitInputData%UseInputFile_PrescribeFrc - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrescribeFrcData, DstInitInputData%PassedPrescribeFrcData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE StC_CopyInitInput - - SUBROUTINE StC_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(StC_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 = 'StC_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%InitRefPos)) THEN - DEALLOCATE(InitInputData%InitRefPos) -ENDIF -IF (ALLOCATED(InitInputData%InitTransDisp)) THEN - DEALLOCATE(InitInputData%InitTransDisp) -ENDIF -IF (ALLOCATED(InitInputData%InitOrient)) THEN - DEALLOCATE(InitInputData%InitOrient) -ENDIF -IF (ALLOCATED(InitInputData%InitRefOrient)) THEN - DEALLOCATE(InitInputData%InitRefOrient) -ENDIF - CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedPrescribeFrcData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE StC_DestroyInitInput - - SUBROUTINE StC_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(StC_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 = 'StC_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%RootName) ! RootName - Re_BufSz = Re_BufSz + SIZE(InData%Gravity) ! Gravity - Int_BufSz = Int_BufSz + 1 ! NumMeshPts - Int_BufSz = Int_BufSz + 1 ! InitRefPos allocated yes/no - IF ( ALLOCATED(InData%InitRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitRefPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitRefPos) ! InitRefPos - END IF - Int_BufSz = Int_BufSz + 1 ! InitTransDisp allocated yes/no - IF ( ALLOCATED(InData%InitTransDisp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitTransDisp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InitTransDisp) ! InitTransDisp - END IF - Int_BufSz = Int_BufSz + 1 ! InitOrient allocated yes/no - IF ( ALLOCATED(InData%InitOrient) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! InitOrient upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InitOrient) ! InitOrient - END IF - Int_BufSz = Int_BufSz + 1 ! InitRefOrient allocated yes/no - IF ( ALLOCATED(InData%InitRefOrient) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! InitRefOrient upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InitRefOrient) ! InitRefOrient - END IF - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedPrimaryInputData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedPrimaryInputData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedPrimaryInputData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedPrescribeFrcData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedPrescribeFrcData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedPrescribeFrcData - 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%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%Gravity,1), UBOUND(InData%Gravity,1) - ReKiBuf(Re_Xferred) = InData%Gravity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NumMeshPts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%InitRefPos) ) 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%InitRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitRefPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitRefPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitRefPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitRefPos,2), UBOUND(InData%InitRefPos,2) - DO i1 = LBOUND(InData%InitRefPos,1), UBOUND(InData%InitRefPos,1) - ReKiBuf(Re_Xferred) = InData%InitRefPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitTransDisp) ) 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%InitTransDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitTransDisp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitTransDisp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitTransDisp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitTransDisp,2), UBOUND(InData%InitTransDisp,2) - DO i1 = LBOUND(InData%InitTransDisp,1), UBOUND(InData%InitTransDisp,1) - DbKiBuf(Db_Xferred) = InData%InitTransDisp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitOrient) ) 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%InitOrient,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitOrient,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitOrient,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitOrient,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitOrient,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitOrient,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%InitOrient,3), UBOUND(InData%InitOrient,3) - DO i2 = LBOUND(InData%InitOrient,2), UBOUND(InData%InitOrient,2) - DO i1 = LBOUND(InData%InitOrient,1), UBOUND(InData%InitOrient,1) - DbKiBuf(Db_Xferred) = InData%InitOrient(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitRefOrient) ) 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%InitRefOrient,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitRefOrient,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitRefOrient,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitRefOrient,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitRefOrient,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitRefOrient,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%InitRefOrient,3), UBOUND(InData%InitRefOrient,3) - DO i2 = LBOUND(InData%InitRefOrient,2), UBOUND(InData%InitRefOrient,2) - DO i1 = LBOUND(InData%InitRefOrient,1), UBOUND(InData%InitRefOrient,1) - DbKiBuf(Db_Xferred) = InData%InitRefOrient(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - 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 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) = 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 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 StC_PackInitInput - - SUBROUTINE StC_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(StC_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_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%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%Gravity,1) - i1_u = UBOUND(OutData%Gravity,1) - DO i1 = LBOUND(OutData%Gravity,1), UBOUND(OutData%Gravity,1) - OutData%Gravity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%NumMeshPts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitRefPos 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%InitRefPos)) DEALLOCATE(OutData%InitRefPos) - ALLOCATE(OutData%InitRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitRefPos,2), UBOUND(OutData%InitRefPos,2) - DO i1 = LBOUND(OutData%InitRefPos,1), UBOUND(OutData%InitRefPos,1) - OutData%InitRefPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitTransDisp 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%InitTransDisp)) DEALLOCATE(OutData%InitTransDisp) - ALLOCATE(OutData%InitTransDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitTransDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitTransDisp,2), UBOUND(OutData%InitTransDisp,2) - DO i1 = LBOUND(OutData%InitTransDisp,1), UBOUND(OutData%InitTransDisp,1) - OutData%InitTransDisp(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitOrient 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%InitOrient)) DEALLOCATE(OutData%InitOrient) - ALLOCATE(OutData%InitOrient(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%InitOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%InitOrient,3), UBOUND(OutData%InitOrient,3) - DO i2 = LBOUND(OutData%InitOrient,2), UBOUND(OutData%InitOrient,2) - DO i1 = LBOUND(OutData%InitOrient,1), UBOUND(OutData%InitOrient,1) - OutData%InitOrient(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitRefOrient 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%InitRefOrient)) DEALLOCATE(OutData%InitRefOrient) - ALLOCATE(OutData%InitRefOrient(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%InitRefOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%InitRefOrient,3), UBOUND(OutData%InitRefOrient,3) - DO i2 = LBOUND(OutData%InitRefOrient,2), UBOUND(OutData%InitRefOrient,2) - DO i1 = LBOUND(OutData%InitRefOrient,1), UBOUND(OutData%InitRefOrient,1) - OutData%InitRefOrient(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - 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%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData - 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%UseInputFile_PrescribeFrc = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile_PrescribeFrc) - 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%PassedPrescribeFrcData, ErrStat2, ErrMsg2 ) ! PassedPrescribeFrcData - 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 StC_UnPackInitInput - - SUBROUTINE StC_CopyCtrlChanInitInfoType( SrcCtrlChanInitInfoTypeData, DstCtrlChanInitInfoTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_CtrlChanInitInfoType), INTENT(IN) :: SrcCtrlChanInitInfoTypeData - TYPE(StC_CtrlChanInitInfoType), INTENT(INOUT) :: DstCtrlChanInitInfoTypeData - 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 = 'StC_CopyCtrlChanInitInfoType' -! + ErrMsg = '' + DstInputFileData%StCFileName = SrcInputFileData%StCFileName + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%StC_CMODE = SrcInputFileData%StC_CMODE + DstInputFileData%StC_SA_MODE = SrcInputFileData%StC_SA_MODE + DstInputFileData%StC_DOF_MODE = SrcInputFileData%StC_DOF_MODE + DstInputFileData%StC_X_DOF = SrcInputFileData%StC_X_DOF + DstInputFileData%StC_Y_DOF = SrcInputFileData%StC_Y_DOF + DstInputFileData%StC_Z_DOF = SrcInputFileData%StC_Z_DOF + DstInputFileData%StC_X_DSP = SrcInputFileData%StC_X_DSP + DstInputFileData%StC_Y_DSP = SrcInputFileData%StC_Y_DSP + DstInputFileData%StC_Z_DSP = SrcInputFileData%StC_Z_DSP + DstInputFileData%StC_Z_PreLdC = SrcInputFileData%StC_Z_PreLdC + DstInputFileData%StC_X_M = SrcInputFileData%StC_X_M + DstInputFileData%StC_Y_M = SrcInputFileData%StC_Y_M + DstInputFileData%StC_Z_M = SrcInputFileData%StC_Z_M + DstInputFileData%StC_XY_M = SrcInputFileData%StC_XY_M + DstInputFileData%StC_X_K = SrcInputFileData%StC_X_K + DstInputFileData%StC_Y_K = SrcInputFileData%StC_Y_K + DstInputFileData%StC_Z_K = SrcInputFileData%StC_Z_K + DstInputFileData%StC_X_C = SrcInputFileData%StC_X_C + DstInputFileData%StC_Y_C = SrcInputFileData%StC_Y_C + DstInputFileData%StC_Z_C = SrcInputFileData%StC_Z_C + DstInputFileData%StC_X_PSP = SrcInputFileData%StC_X_PSP + DstInputFileData%StC_X_NSP = SrcInputFileData%StC_X_NSP + DstInputFileData%StC_Y_PSP = SrcInputFileData%StC_Y_PSP + DstInputFileData%StC_Y_NSP = SrcInputFileData%StC_Y_NSP + DstInputFileData%StC_Z_PSP = SrcInputFileData%StC_Z_PSP + DstInputFileData%StC_Z_NSP = SrcInputFileData%StC_Z_NSP + DstInputFileData%StC_X_KS = SrcInputFileData%StC_X_KS + DstInputFileData%StC_X_CS = SrcInputFileData%StC_X_CS + DstInputFileData%StC_Y_KS = SrcInputFileData%StC_Y_KS + DstInputFileData%StC_Y_CS = SrcInputFileData%StC_Y_CS + DstInputFileData%StC_Z_KS = SrcInputFileData%StC_Z_KS + DstInputFileData%StC_Z_CS = SrcInputFileData%StC_Z_CS + DstInputFileData%StC_P_X = SrcInputFileData%StC_P_X + DstInputFileData%StC_P_Y = SrcInputFileData%StC_P_Y + DstInputFileData%StC_P_Z = SrcInputFileData%StC_P_Z + DstInputFileData%StC_X_C_HIGH = SrcInputFileData%StC_X_C_HIGH + DstInputFileData%StC_X_C_LOW = SrcInputFileData%StC_X_C_LOW + DstInputFileData%StC_Y_C_HIGH = SrcInputFileData%StC_Y_C_HIGH + DstInputFileData%StC_Y_C_LOW = SrcInputFileData%StC_Y_C_LOW + DstInputFileData%StC_Z_C_HIGH = SrcInputFileData%StC_Z_C_HIGH + DstInputFileData%StC_Z_C_LOW = SrcInputFileData%StC_Z_C_LOW + DstInputFileData%StC_X_C_BRAKE = SrcInputFileData%StC_X_C_BRAKE + DstInputFileData%StC_Y_C_BRAKE = SrcInputFileData%StC_Y_C_BRAKE + DstInputFileData%StC_Z_C_BRAKE = SrcInputFileData%StC_Z_C_BRAKE + DstInputFileData%L_X = SrcInputFileData%L_X + DstInputFileData%B_X = SrcInputFileData%B_X + DstInputFileData%area_X = SrcInputFileData%area_X + DstInputFileData%area_ratio_X = SrcInputFileData%area_ratio_X + DstInputFileData%headLossCoeff_X = SrcInputFileData%headLossCoeff_X + DstInputFileData%rho_X = SrcInputFileData%rho_X + DstInputFileData%L_Y = SrcInputFileData%L_Y + DstInputFileData%B_Y = SrcInputFileData%B_Y + DstInputFileData%area_Y = SrcInputFileData%area_Y + DstInputFileData%area_ratio_Y = SrcInputFileData%area_ratio_Y + DstInputFileData%headLossCoeff_Y = SrcInputFileData%headLossCoeff_Y + DstInputFileData%rho_Y = SrcInputFileData%rho_Y + DstInputFileData%USE_F_TBL = SrcInputFileData%USE_F_TBL + DstInputFileData%NKInpSt = SrcInputFileData%NKInpSt + DstInputFileData%StC_F_TBL_FILE = SrcInputFileData%StC_F_TBL_FILE + if (allocated(SrcInputFileData%F_TBL)) then + LB(1:2) = lbound(SrcInputFileData%F_TBL) + UB(1:2) = ubound(SrcInputFileData%F_TBL) + if (.not. allocated(DstInputFileData%F_TBL)) then + allocate(DstInputFileData%F_TBL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%F_TBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%F_TBL = SrcInputFileData%F_TBL + end if + DstInputFileData%PrescribedForcesCoordSys = SrcInputFileData%PrescribedForcesCoordSys + DstInputFileData%PrescribedForcesFile = SrcInputFileData%PrescribedForcesFile + if (allocated(SrcInputFileData%StC_PrescribedForce)) then + LB(1:2) = lbound(SrcInputFileData%StC_PrescribedForce) + UB(1:2) = ubound(SrcInputFileData%StC_PrescribedForce) + if (.not. allocated(DstInputFileData%StC_PrescribedForce)) then + allocate(DstInputFileData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StC_PrescribedForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%StC_PrescribedForce = SrcInputFileData%StC_PrescribedForce + end if + if (allocated(SrcInputFileData%StC_CChan)) then + LB(1:1) = lbound(SrcInputFileData%StC_CChan) + UB(1:1) = ubound(SrcInputFileData%StC_CChan) + if (.not. allocated(DstInputFileData%StC_CChan)) then + allocate(DstInputFileData%StC_CChan(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StC_CChan.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%StC_CChan = SrcInputFileData%StC_CChan + end if +end subroutine + +subroutine StC_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(StC_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyInputFile' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%Requestor)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%Requestor,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%Requestor,1) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%Requestor)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%Requestor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%Requestor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%Requestor = SrcCtrlChanInitInfoTypeData%Requestor -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitStiff)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitStiff,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitStiff,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitStiff,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitStiff,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitStiff)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitStiff = SrcCtrlChanInitInfoTypeData%InitStiff -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitDamp)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitDamp,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitDamp,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitDamp,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitDamp,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitDamp)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitDamp = SrcCtrlChanInitInfoTypeData%InitDamp -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitBrake)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitBrake,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitBrake,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitBrake,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitBrake,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitBrake)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitBrake = SrcCtrlChanInitInfoTypeData%InitBrake -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitForce)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitForce,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitForce,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitForce,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitForce,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitForce)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitForce = SrcCtrlChanInitInfoTypeData%InitForce -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitMeasDisp)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitMeasDisp,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitMeasDisp,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitMeasDisp,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitMeasDisp,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitMeasDisp)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitMeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitMeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitMeasDisp = SrcCtrlChanInitInfoTypeData%InitMeasDisp -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitMeasVel)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitMeasVel,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitMeasVel,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitMeasVel,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitMeasVel,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitMeasVel)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitMeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitMeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitMeasVel = SrcCtrlChanInitInfoTypeData%InitMeasVel -ENDIF - END SUBROUTINE StC_CopyCtrlChanInitInfoType - - SUBROUTINE StC_DestroyCtrlChanInitInfoType( CtrlChanInitInfoTypeData, ErrStat, ErrMsg ) - TYPE(StC_CtrlChanInitInfoType), INTENT(INOUT) :: CtrlChanInitInfoTypeData - 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 = 'StC_DestroyCtrlChanInitInfoType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(CtrlChanInitInfoTypeData%Requestor)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%Requestor) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitStiff)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitStiff) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitDamp)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitDamp) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitBrake)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitBrake) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitForce)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitForce) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitMeasDisp)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitMeasDisp) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitMeasVel)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitMeasVel) -ENDIF - END SUBROUTINE StC_DestroyCtrlChanInitInfoType - - SUBROUTINE StC_PackCtrlChanInitInfoType( 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(StC_CtrlChanInitInfoType), 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 = 'StC_PackCtrlChanInitInfoType' - ! 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 ! Requestor allocated yes/no - IF ( ALLOCATED(InData%Requestor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Requestor upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Requestor)*LEN(InData%Requestor) ! Requestor - END IF - Int_BufSz = Int_BufSz + 1 ! InitStiff allocated yes/no - IF ( ALLOCATED(InData%InitStiff) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitStiff) ! InitStiff - END IF - Int_BufSz = Int_BufSz + 1 ! InitDamp allocated yes/no - IF ( ALLOCATED(InData%InitDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitDamp) ! InitDamp - END IF - Int_BufSz = Int_BufSz + 1 ! InitBrake allocated yes/no - IF ( ALLOCATED(InData%InitBrake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitBrake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitBrake) ! InitBrake - END IF - Int_BufSz = Int_BufSz + 1 ! InitForce allocated yes/no - IF ( ALLOCATED(InData%InitForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitForce) ! InitForce - END IF - Int_BufSz = Int_BufSz + 1 ! InitMeasDisp allocated yes/no - IF ( ALLOCATED(InData%InitMeasDisp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitMeasDisp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitMeasDisp) ! InitMeasDisp - END IF - Int_BufSz = Int_BufSz + 1 ! InitMeasVel allocated yes/no - IF ( ALLOCATED(InData%InitMeasVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitMeasVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitMeasVel) ! InitMeasVel - 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%Requestor) ) 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%Requestor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Requestor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Requestor,1), UBOUND(InData%Requestor,1) - DO I = 1, LEN(InData%Requestor) - IntKiBuf(Int_Xferred) = ICHAR(InData%Requestor(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitStiff) ) 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%InitStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitStiff,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitStiff,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitStiff,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitStiff,2), UBOUND(InData%InitStiff,2) - DO i1 = LBOUND(InData%InitStiff,1), UBOUND(InData%InitStiff,1) - ReKiBuf(Re_Xferred) = InData%InitStiff(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitDamp) ) 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%InitDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitDamp,2), UBOUND(InData%InitDamp,2) - DO i1 = LBOUND(InData%InitDamp,1), UBOUND(InData%InitDamp,1) - ReKiBuf(Re_Xferred) = InData%InitDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitBrake) ) 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%InitBrake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitBrake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitBrake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitBrake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitBrake,2), UBOUND(InData%InitBrake,2) - DO i1 = LBOUND(InData%InitBrake,1), UBOUND(InData%InitBrake,1) - ReKiBuf(Re_Xferred) = InData%InitBrake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitForce) ) 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%InitForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitForce,2), UBOUND(InData%InitForce,2) - DO i1 = LBOUND(InData%InitForce,1), UBOUND(InData%InitForce,1) - ReKiBuf(Re_Xferred) = InData%InitForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitMeasDisp) ) 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%InitMeasDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitMeasDisp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitMeasDisp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitMeasDisp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitMeasDisp,2), UBOUND(InData%InitMeasDisp,2) - DO i1 = LBOUND(InData%InitMeasDisp,1), UBOUND(InData%InitMeasDisp,1) - ReKiBuf(Re_Xferred) = InData%InitMeasDisp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitMeasVel) ) 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%InitMeasVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitMeasVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitMeasVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitMeasVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitMeasVel,2), UBOUND(InData%InitMeasVel,2) - DO i1 = LBOUND(InData%InitMeasVel,1), UBOUND(InData%InitMeasVel,1) - ReKiBuf(Re_Xferred) = InData%InitMeasVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_PackCtrlChanInitInfoType - - SUBROUTINE StC_UnPackCtrlChanInitInfoType( 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(StC_CtrlChanInitInfoType), 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 = 'StC_UnPackCtrlChanInitInfoType' - ! 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 ! Requestor 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%Requestor)) DEALLOCATE(OutData%Requestor) - ALLOCATE(OutData%Requestor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Requestor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Requestor,1), UBOUND(OutData%Requestor,1) - DO I = 1, LEN(OutData%Requestor) - OutData%Requestor(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 ! InitStiff 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%InitStiff)) DEALLOCATE(OutData%InitStiff) - ALLOCATE(OutData%InitStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitStiff,2), UBOUND(OutData%InitStiff,2) - DO i1 = LBOUND(OutData%InitStiff,1), UBOUND(OutData%InitStiff,1) - OutData%InitStiff(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitDamp 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%InitDamp)) DEALLOCATE(OutData%InitDamp) - ALLOCATE(OutData%InitDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitDamp,2), UBOUND(OutData%InitDamp,2) - DO i1 = LBOUND(OutData%InitDamp,1), UBOUND(OutData%InitDamp,1) - OutData%InitDamp(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitBrake 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%InitBrake)) DEALLOCATE(OutData%InitBrake) - ALLOCATE(OutData%InitBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitBrake,2), UBOUND(OutData%InitBrake,2) - DO i1 = LBOUND(OutData%InitBrake,1), UBOUND(OutData%InitBrake,1) - OutData%InitBrake(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitForce 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%InitForce)) DEALLOCATE(OutData%InitForce) - ALLOCATE(OutData%InitForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitForce,2), UBOUND(OutData%InitForce,2) - DO i1 = LBOUND(OutData%InitForce,1), UBOUND(OutData%InitForce,1) - OutData%InitForce(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitMeasDisp 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%InitMeasDisp)) DEALLOCATE(OutData%InitMeasDisp) - ALLOCATE(OutData%InitMeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitMeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitMeasDisp,2), UBOUND(OutData%InitMeasDisp,2) - DO i1 = LBOUND(OutData%InitMeasDisp,1), UBOUND(OutData%InitMeasDisp,1) - OutData%InitMeasDisp(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitMeasVel 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%InitMeasVel)) DEALLOCATE(OutData%InitMeasVel) - ALLOCATE(OutData%InitMeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitMeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitMeasVel,2), UBOUND(OutData%InitMeasVel,2) - DO i1 = LBOUND(OutData%InitMeasVel,1), UBOUND(OutData%InitMeasVel,1) - OutData%InitMeasVel(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_UnPackCtrlChanInitInfoType - - SUBROUTINE StC_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(StC_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyInitOutput' -! + ErrMsg = '' + if (allocated(InputFileData%F_TBL)) then + deallocate(InputFileData%F_TBL) + end if + if (allocated(InputFileData%StC_PrescribedForce)) then + deallocate(InputFileData%StC_PrescribedForce) + end if + if (allocated(InputFileData%StC_CChan)) then + deallocate(InputFileData%StC_CChan) + end if +end subroutine + +subroutine StC_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%StCFileName) + call RegPack(Buf, InData%Echo) + call RegPack(Buf, InData%StC_CMODE) + call RegPack(Buf, InData%StC_SA_MODE) + call RegPack(Buf, InData%StC_DOF_MODE) + call RegPack(Buf, InData%StC_X_DOF) + call RegPack(Buf, InData%StC_Y_DOF) + call RegPack(Buf, InData%StC_Z_DOF) + call RegPack(Buf, InData%StC_X_DSP) + call RegPack(Buf, InData%StC_Y_DSP) + call RegPack(Buf, InData%StC_Z_DSP) + call RegPack(Buf, InData%StC_Z_PreLdC) + call RegPack(Buf, InData%StC_X_M) + call RegPack(Buf, InData%StC_Y_M) + call RegPack(Buf, InData%StC_Z_M) + call RegPack(Buf, InData%StC_XY_M) + call RegPack(Buf, InData%StC_X_K) + call RegPack(Buf, InData%StC_Y_K) + call RegPack(Buf, InData%StC_Z_K) + call RegPack(Buf, InData%StC_X_C) + call RegPack(Buf, InData%StC_Y_C) + call RegPack(Buf, InData%StC_Z_C) + call RegPack(Buf, InData%StC_X_PSP) + call RegPack(Buf, InData%StC_X_NSP) + call RegPack(Buf, InData%StC_Y_PSP) + call RegPack(Buf, InData%StC_Y_NSP) + call RegPack(Buf, InData%StC_Z_PSP) + call RegPack(Buf, InData%StC_Z_NSP) + call RegPack(Buf, InData%StC_X_KS) + call RegPack(Buf, InData%StC_X_CS) + call RegPack(Buf, InData%StC_Y_KS) + call RegPack(Buf, InData%StC_Y_CS) + call RegPack(Buf, InData%StC_Z_KS) + call RegPack(Buf, InData%StC_Z_CS) + call RegPack(Buf, InData%StC_P_X) + call RegPack(Buf, InData%StC_P_Y) + call RegPack(Buf, InData%StC_P_Z) + call RegPack(Buf, InData%StC_X_C_HIGH) + call RegPack(Buf, InData%StC_X_C_LOW) + call RegPack(Buf, InData%StC_Y_C_HIGH) + call RegPack(Buf, InData%StC_Y_C_LOW) + call RegPack(Buf, InData%StC_Z_C_HIGH) + call RegPack(Buf, InData%StC_Z_C_LOW) + call RegPack(Buf, InData%StC_X_C_BRAKE) + call RegPack(Buf, InData%StC_Y_C_BRAKE) + call RegPack(Buf, InData%StC_Z_C_BRAKE) + call RegPack(Buf, InData%L_X) + call RegPack(Buf, InData%B_X) + call RegPack(Buf, InData%area_X) + call RegPack(Buf, InData%area_ratio_X) + call RegPack(Buf, InData%headLossCoeff_X) + call RegPack(Buf, InData%rho_X) + call RegPack(Buf, InData%L_Y) + call RegPack(Buf, InData%B_Y) + call RegPack(Buf, InData%area_Y) + call RegPack(Buf, InData%area_ratio_Y) + call RegPack(Buf, InData%headLossCoeff_Y) + call RegPack(Buf, InData%rho_Y) + call RegPack(Buf, InData%USE_F_TBL) + call RegPack(Buf, InData%NKInpSt) + call RegPack(Buf, InData%StC_F_TBL_FILE) + call RegPack(Buf, allocated(InData%F_TBL)) + if (allocated(InData%F_TBL)) then + call RegPackBounds(Buf, 2, lbound(InData%F_TBL), ubound(InData%F_TBL)) + call RegPack(Buf, InData%F_TBL) + end if + call RegPack(Buf, InData%PrescribedForcesCoordSys) + call RegPack(Buf, InData%PrescribedForcesFile) + call RegPack(Buf, allocated(InData%StC_PrescribedForce)) + if (allocated(InData%StC_PrescribedForce)) then + call RegPackBounds(Buf, 2, lbound(InData%StC_PrescribedForce), ubound(InData%StC_PrescribedForce)) + call RegPack(Buf, InData%StC_PrescribedForce) + end if + call RegPack(Buf, allocated(InData%StC_CChan)) + if (allocated(InData%StC_CChan)) then + call RegPackBounds(Buf, 1, lbound(InData%StC_CChan), ubound(InData%StC_CChan)) + call RegPack(Buf, InData%StC_CChan) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackInputFile' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%StCFileName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_CMODE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_SA_MODE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_DOF_MODE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_DOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_DOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_DOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_DSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_DSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_DSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_PreLdC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_M) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_M) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_M) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_XY_M) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_K) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_K) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_K) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_C) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_C) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_C) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_PSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_NSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_PSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_NSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_PSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_NSP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_KS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_CS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_KS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_CS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_KS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_CS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_P_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_P_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_P_Z) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%L_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%B_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%area_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%area_ratio_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%headLossCoeff_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rho_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%L_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%B_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%area_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%area_ratio_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%headLossCoeff_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rho_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%USE_F_TBL) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NKInpSt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_F_TBL_FILE) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%F_TBL)) deallocate(OutData%F_TBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_TBL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_TBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%PrescribedForcesCoordSys) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PrescribedForcesFile) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%StC_PrescribedForce)) deallocate(OutData%StC_PrescribedForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_PrescribedForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StC_PrescribedForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StC_CChan)) deallocate(OutData%StC_CChan) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StC_CChan(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_CChan.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StC_CChan) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(StC_InitInputType), intent(in) :: SrcInitInputData + type(StC_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%RelPosition)) THEN - i1_l = LBOUND(SrcInitOutputData%RelPosition,1) - i1_u = UBOUND(SrcInitOutputData%RelPosition,1) - i2_l = LBOUND(SrcInitOutputData%RelPosition,2) - i2_u = UBOUND(SrcInitOutputData%RelPosition,2) - IF (.NOT. ALLOCATED(DstInitOutputData%RelPosition)) THEN - ALLOCATE(DstInitOutputData%RelPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RelPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RelPosition = SrcInitOutputData%RelPosition -ENDIF - END SUBROUTINE StC_CopyInitOutput - - SUBROUTINE StC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(StC_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 = 'StC_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%RelPosition)) THEN - DEALLOCATE(InitOutputData%RelPosition) -ENDIF - END SUBROUTINE StC_DestroyInitOutput - - SUBROUTINE StC_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(StC_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 = 'StC_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 ! RelPosition allocated yes/no - IF ( ALLOCATED(InData%RelPosition) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! RelPosition upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RelPosition) ! RelPosition - 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%RelPosition) ) 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%RelPosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RelPosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RelPosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RelPosition,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%RelPosition,2), UBOUND(InData%RelPosition,2) - DO i1 = LBOUND(InData%RelPosition,1), UBOUND(InData%RelPosition,1) - ReKiBuf(Re_Xferred) = InData%RelPosition(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_PackInitOutput - - SUBROUTINE StC_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(StC_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_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 ! RelPosition 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%RelPosition)) DEALLOCATE(OutData%RelPosition) - ALLOCATE(OutData%RelPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RelPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%RelPosition,2), UBOUND(OutData%RelPosition,2) - DO i1 = LBOUND(OutData%RelPosition,1), UBOUND(OutData%RelPosition,1) - OutData%RelPosition(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_UnPackInitOutput - - SUBROUTINE StC_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(StC_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) :: 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 = 'StC_CopyContState' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%NumMeshPts = SrcInitInputData%NumMeshPts + if (allocated(SrcInitInputData%InitRefPos)) then + LB(1:2) = lbound(SrcInitInputData%InitRefPos) + UB(1:2) = ubound(SrcInitInputData%InitRefPos) + if (.not. allocated(DstInitInputData%InitRefPos)) then + allocate(DstInitInputData%InitRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%InitRefPos = SrcInitInputData%InitRefPos + end if + if (allocated(SrcInitInputData%InitTransDisp)) then + LB(1:2) = lbound(SrcInitInputData%InitTransDisp) + UB(1:2) = ubound(SrcInitInputData%InitTransDisp) + if (.not. allocated(DstInitInputData%InitTransDisp)) then + allocate(DstInitInputData%InitTransDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitTransDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%InitTransDisp = SrcInitInputData%InitTransDisp + end if + if (allocated(SrcInitInputData%InitOrient)) then + LB(1:3) = lbound(SrcInitInputData%InitOrient) + UB(1:3) = ubound(SrcInitInputData%InitOrient) + if (.not. allocated(DstInitInputData%InitOrient)) then + allocate(DstInitInputData%InitOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%InitOrient = SrcInitInputData%InitOrient + end if + if (allocated(SrcInitInputData%InitRefOrient)) then + LB(1:3) = lbound(SrcInitInputData%InitRefOrient) + UB(1:3) = ubound(SrcInitInputData%InitRefOrient) + if (.not. allocated(DstInitInputData%InitRefOrient)) then + allocate(DstInitInputData%InitRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitRefOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%InitRefOrient = SrcInitInputData%InitRefOrient + end if + DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%UseInputFile_PrescribeFrc = SrcInitInputData%UseInputFile_PrescribeFrc + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedPrescribeFrcData, DstInitInputData%PassedPrescribeFrcData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine StC_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(StC_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%StC_x)) THEN - i1_l = LBOUND(SrcContStateData%StC_x,1) - i1_u = UBOUND(SrcContStateData%StC_x,1) - i2_l = LBOUND(SrcContStateData%StC_x,2) - i2_u = UBOUND(SrcContStateData%StC_x,2) - IF (.NOT. ALLOCATED(DstContStateData%StC_x)) THEN - ALLOCATE(DstContStateData%StC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%StC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%StC_x = SrcContStateData%StC_x -ENDIF - END SUBROUTINE StC_CopyContState - - SUBROUTINE StC_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(StC_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 = 'StC_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%StC_x)) THEN - DEALLOCATE(ContStateData%StC_x) -ENDIF - END SUBROUTINE StC_DestroyContState - - SUBROUTINE StC_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(StC_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 = 'StC_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 - Int_BufSz = Int_BufSz + 1 ! StC_x allocated yes/no - IF ( ALLOCATED(InData%StC_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StC_x upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StC_x) ! StC_x - 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%StC_x) ) 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%StC_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StC_x,2), UBOUND(InData%StC_x,2) - DO i1 = LBOUND(InData%StC_x,1), UBOUND(InData%StC_x,1) - ReKiBuf(Re_Xferred) = InData%StC_x(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_PackContState - - SUBROUTINE StC_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(StC_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) :: 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 = 'StC_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_x 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%StC_x)) DEALLOCATE(OutData%StC_x) - ALLOCATE(OutData%StC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StC_x,2), UBOUND(OutData%StC_x,2) - DO i1 = LBOUND(OutData%StC_x,1), UBOUND(OutData%StC_x,1) - OutData%StC_x(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_UnPackContState - - SUBROUTINE StC_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(StC_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 = 'StC_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitInputData%InitRefPos)) then + deallocate(InitInputData%InitRefPos) + end if + if (allocated(InitInputData%InitTransDisp)) then + deallocate(InitInputData%InitTransDisp) + end if + if (allocated(InitInputData%InitOrient)) then + deallocate(InitInputData%InitOrient) + end if + if (allocated(InitInputData%InitRefOrient)) then + deallocate(InitInputData%InitRefOrient) + end if + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrescribeFrcData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine StC_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%InputFile) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%NumMeshPts) + call RegPack(Buf, allocated(InData%InitRefPos)) + if (allocated(InData%InitRefPos)) then + call RegPackBounds(Buf, 2, lbound(InData%InitRefPos), ubound(InData%InitRefPos)) + call RegPack(Buf, InData%InitRefPos) + end if + call RegPack(Buf, allocated(InData%InitTransDisp)) + if (allocated(InData%InitTransDisp)) then + call RegPackBounds(Buf, 2, lbound(InData%InitTransDisp), ubound(InData%InitTransDisp)) + call RegPack(Buf, InData%InitTransDisp) + end if + call RegPack(Buf, allocated(InData%InitOrient)) + if (allocated(InData%InitOrient)) then + call RegPackBounds(Buf, 3, lbound(InData%InitOrient), ubound(InData%InitOrient)) + call RegPack(Buf, InData%InitOrient) + end if + call RegPack(Buf, allocated(InData%InitRefOrient)) + if (allocated(InData%InitRefOrient)) then + call RegPackBounds(Buf, 3, lbound(InData%InitRefOrient), ubound(InData%InitRefOrient)) + call RegPack(Buf, InData%InitRefOrient) + end if + call RegPack(Buf, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) + call RegPack(Buf, InData%UseInputFile_PrescribeFrc) + call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrescribeFrcData) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumMeshPts) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%InitRefPos)) deallocate(OutData%InitRefPos) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitRefPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitRefPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitRefPos) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%InitTransDisp)) deallocate(OutData%InitTransDisp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitTransDisp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitTransDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%InitOrient)) deallocate(OutData%InitOrient) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitOrient.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitOrient) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%InitRefOrient)) deallocate(OutData%InitRefOrient) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitRefOrient.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + call RegUnpack(Buf, OutData%UseInputFile_PrescribeFrc) + if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrescribeFrcData) ! PassedPrescribeFrcData +end subroutine + +subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChanInitInfoTypeData, CtrlCode, ErrStat, ErrMsg) + type(StC_CtrlChanInitInfoType), intent(in) :: SrcCtrlChanInitInfoTypeData + type(StC_CtrlChanInitInfoType), intent(inout) :: DstCtrlChanInitInfoTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyCtrlChanInitInfoType' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE StC_CopyDiscState - - SUBROUTINE StC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(StC_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 = 'StC_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE StC_DestroyDiscState - - SUBROUTINE StC_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(StC_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 = 'StC_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 StC_PackDiscState - - SUBROUTINE StC_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(StC_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 = 'StC_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_UnPackDiscState - - SUBROUTINE StC_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(StC_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 = 'StC_CopyConstrState' -! + ErrMsg = '' + if (allocated(SrcCtrlChanInitInfoTypeData%Requestor)) then + LB(1:1) = lbound(SrcCtrlChanInitInfoTypeData%Requestor) + UB(1:1) = ubound(SrcCtrlChanInitInfoTypeData%Requestor) + if (.not. allocated(DstCtrlChanInitInfoTypeData%Requestor)) then + allocate(DstCtrlChanInitInfoTypeData%Requestor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%Requestor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%Requestor = SrcCtrlChanInitInfoTypeData%Requestor + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitStiff)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitStiff) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitStiff) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitStiff)) then + allocate(DstCtrlChanInitInfoTypeData%InitStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitStiff = SrcCtrlChanInitInfoTypeData%InitStiff + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitDamp)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitDamp) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitDamp) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitDamp)) then + allocate(DstCtrlChanInitInfoTypeData%InitDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitDamp = SrcCtrlChanInitInfoTypeData%InitDamp + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitBrake)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitBrake) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitBrake) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitBrake)) then + allocate(DstCtrlChanInitInfoTypeData%InitBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitBrake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitBrake = SrcCtrlChanInitInfoTypeData%InitBrake + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitForce)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitForce) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitForce) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitForce)) then + allocate(DstCtrlChanInitInfoTypeData%InitForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitForce = SrcCtrlChanInitInfoTypeData%InitForce + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasDisp)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitMeasDisp)) then + allocate(DstCtrlChanInitInfoTypeData%InitMeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitMeasDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitMeasDisp = SrcCtrlChanInitInfoTypeData%InitMeasDisp + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasVel)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasVel) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasVel) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitMeasVel)) then + allocate(DstCtrlChanInitInfoTypeData%InitMeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitMeasVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitMeasVel = SrcCtrlChanInitInfoTypeData%InitMeasVel + end if +end subroutine + +subroutine StC_DestroyCtrlChanInitInfoType(CtrlChanInitInfoTypeData, ErrStat, ErrMsg) + type(StC_CtrlChanInitInfoType), intent(inout) :: CtrlChanInitInfoTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyCtrlChanInitInfoType' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE StC_CopyConstrState - - SUBROUTINE StC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(StC_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 = 'StC_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE StC_DestroyConstrState - - SUBROUTINE StC_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(StC_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 = 'StC_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 StC_PackConstrState - - SUBROUTINE StC_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(StC_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 = 'StC_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_UnPackConstrState - - SUBROUTINE StC_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(StC_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 = 'StC_CopyOtherState' -! + ErrMsg = '' + if (allocated(CtrlChanInitInfoTypeData%Requestor)) then + deallocate(CtrlChanInitInfoTypeData%Requestor) + end if + if (allocated(CtrlChanInitInfoTypeData%InitStiff)) then + deallocate(CtrlChanInitInfoTypeData%InitStiff) + end if + if (allocated(CtrlChanInitInfoTypeData%InitDamp)) then + deallocate(CtrlChanInitInfoTypeData%InitDamp) + end if + if (allocated(CtrlChanInitInfoTypeData%InitBrake)) then + deallocate(CtrlChanInitInfoTypeData%InitBrake) + end if + if (allocated(CtrlChanInitInfoTypeData%InitForce)) then + deallocate(CtrlChanInitInfoTypeData%InitForce) + end if + if (allocated(CtrlChanInitInfoTypeData%InitMeasDisp)) then + deallocate(CtrlChanInitInfoTypeData%InitMeasDisp) + end if + if (allocated(CtrlChanInitInfoTypeData%InitMeasVel)) then + deallocate(CtrlChanInitInfoTypeData%InitMeasVel) + end if +end subroutine + +subroutine StC_PackCtrlChanInitInfoType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_CtrlChanInitInfoType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackCtrlChanInitInfoType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Requestor)) + if (allocated(InData%Requestor)) then + call RegPackBounds(Buf, 1, lbound(InData%Requestor), ubound(InData%Requestor)) + call RegPack(Buf, InData%Requestor) + end if + call RegPack(Buf, allocated(InData%InitStiff)) + if (allocated(InData%InitStiff)) then + call RegPackBounds(Buf, 2, lbound(InData%InitStiff), ubound(InData%InitStiff)) + call RegPack(Buf, InData%InitStiff) + end if + call RegPack(Buf, allocated(InData%InitDamp)) + if (allocated(InData%InitDamp)) then + call RegPackBounds(Buf, 2, lbound(InData%InitDamp), ubound(InData%InitDamp)) + call RegPack(Buf, InData%InitDamp) + end if + call RegPack(Buf, allocated(InData%InitBrake)) + if (allocated(InData%InitBrake)) then + call RegPackBounds(Buf, 2, lbound(InData%InitBrake), ubound(InData%InitBrake)) + call RegPack(Buf, InData%InitBrake) + end if + call RegPack(Buf, allocated(InData%InitForce)) + if (allocated(InData%InitForce)) then + call RegPackBounds(Buf, 2, lbound(InData%InitForce), ubound(InData%InitForce)) + call RegPack(Buf, InData%InitForce) + end if + call RegPack(Buf, allocated(InData%InitMeasDisp)) + if (allocated(InData%InitMeasDisp)) then + call RegPackBounds(Buf, 2, lbound(InData%InitMeasDisp), ubound(InData%InitMeasDisp)) + call RegPack(Buf, InData%InitMeasDisp) + end if + call RegPack(Buf, allocated(InData%InitMeasVel)) + if (allocated(InData%InitMeasVel)) then + call RegPackBounds(Buf, 2, lbound(InData%InitMeasVel), ubound(InData%InitMeasVel)) + call RegPack(Buf, InData%InitMeasVel) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackCtrlChanInitInfoType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_CtrlChanInitInfoType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackCtrlChanInitInfoType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Requestor)) deallocate(OutData%Requestor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Requestor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Requestor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Requestor) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%InitStiff)) deallocate(OutData%InitStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitStiff(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%InitDamp)) deallocate(OutData%InitDamp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitDamp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%InitBrake)) deallocate(OutData%InitBrake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitBrake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitBrake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitBrake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%InitForce)) deallocate(OutData%InitForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%InitMeasDisp)) deallocate(OutData%InitMeasDisp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitMeasDisp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitMeasDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitMeasDisp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%InitMeasVel)) deallocate(OutData%InitMeasVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitMeasVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitMeasVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitMeasVel) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine StC_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(StC_InitOutputType), intent(in) :: SrcInitOutputData + type(StC_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE StC_CopyOtherState - - SUBROUTINE StC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(StC_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 = 'StC_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE StC_DestroyOtherState - - SUBROUTINE StC_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(StC_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 = 'StC_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 - Re_BufSz = Re_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 - - ReKiBuf(Re_Xferred) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_PackOtherState - - SUBROUTINE StC_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(StC_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 = 'StC_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_UnPackOtherState - - SUBROUTINE StC_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(StC_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) :: 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 = 'StC_CopyMisc' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%RelPosition)) then + LB(1:2) = lbound(SrcInitOutputData%RelPosition) + UB(1:2) = ubound(SrcInitOutputData%RelPosition) + if (.not. allocated(DstInitOutputData%RelPosition)) then + allocate(DstInitOutputData%RelPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RelPosition.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RelPosition = SrcInitOutputData%RelPosition + end if +end subroutine + +subroutine StC_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(StC_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%F_stop)) THEN - i1_l = LBOUND(SrcMiscData%F_stop,1) - i1_u = UBOUND(SrcMiscData%F_stop,1) - i2_l = LBOUND(SrcMiscData%F_stop,2) - i2_u = UBOUND(SrcMiscData%F_stop,2) - IF (.NOT. ALLOCATED(DstMiscData%F_stop)) THEN - ALLOCATE(DstMiscData%F_stop(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_stop.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_stop = SrcMiscData%F_stop -ENDIF -IF (ALLOCATED(SrcMiscData%F_ext)) THEN - i1_l = LBOUND(SrcMiscData%F_ext,1) - i1_u = UBOUND(SrcMiscData%F_ext,1) - i2_l = LBOUND(SrcMiscData%F_ext,2) - i2_u = UBOUND(SrcMiscData%F_ext,2) - IF (.NOT. ALLOCATED(DstMiscData%F_ext)) THEN - ALLOCATE(DstMiscData%F_ext(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_ext.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_ext = SrcMiscData%F_ext -ENDIF -IF (ALLOCATED(SrcMiscData%F_fr)) THEN - i1_l = LBOUND(SrcMiscData%F_fr,1) - i1_u = UBOUND(SrcMiscData%F_fr,1) - i2_l = LBOUND(SrcMiscData%F_fr,2) - i2_u = UBOUND(SrcMiscData%F_fr,2) - IF (.NOT. ALLOCATED(DstMiscData%F_fr)) THEN - ALLOCATE(DstMiscData%F_fr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_fr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_fr = SrcMiscData%F_fr -ENDIF -IF (ALLOCATED(SrcMiscData%K)) THEN - i1_l = LBOUND(SrcMiscData%K,1) - i1_u = UBOUND(SrcMiscData%K,1) - i2_l = LBOUND(SrcMiscData%K,2) - i2_u = UBOUND(SrcMiscData%K,2) - IF (.NOT. ALLOCATED(DstMiscData%K)) THEN - ALLOCATE(DstMiscData%K(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%K = SrcMiscData%K -ENDIF -IF (ALLOCATED(SrcMiscData%C_ctrl)) THEN - i1_l = LBOUND(SrcMiscData%C_ctrl,1) - i1_u = UBOUND(SrcMiscData%C_ctrl,1) - i2_l = LBOUND(SrcMiscData%C_ctrl,2) - i2_u = UBOUND(SrcMiscData%C_ctrl,2) - IF (.NOT. ALLOCATED(DstMiscData%C_ctrl)) THEN - ALLOCATE(DstMiscData%C_ctrl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%C_ctrl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%C_ctrl = SrcMiscData%C_ctrl -ENDIF -IF (ALLOCATED(SrcMiscData%C_Brake)) THEN - i1_l = LBOUND(SrcMiscData%C_Brake,1) - i1_u = UBOUND(SrcMiscData%C_Brake,1) - i2_l = LBOUND(SrcMiscData%C_Brake,2) - i2_u = UBOUND(SrcMiscData%C_Brake,2) - IF (.NOT. ALLOCATED(DstMiscData%C_Brake)) THEN - ALLOCATE(DstMiscData%C_Brake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%C_Brake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%C_Brake = SrcMiscData%C_Brake -ENDIF -IF (ALLOCATED(SrcMiscData%F_table)) THEN - i1_l = LBOUND(SrcMiscData%F_table,1) - i1_u = UBOUND(SrcMiscData%F_table,1) - i2_l = LBOUND(SrcMiscData%F_table,2) - i2_u = UBOUND(SrcMiscData%F_table,2) - IF (.NOT. ALLOCATED(DstMiscData%F_table)) THEN - ALLOCATE(DstMiscData%F_table(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_table.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_table = SrcMiscData%F_table -ENDIF -IF (ALLOCATED(SrcMiscData%F_k)) THEN - i1_l = LBOUND(SrcMiscData%F_k,1) - i1_u = UBOUND(SrcMiscData%F_k,1) - i2_l = LBOUND(SrcMiscData%F_k,2) - i2_u = UBOUND(SrcMiscData%F_k,2) - IF (.NOT. ALLOCATED(DstMiscData%F_k)) THEN - ALLOCATE(DstMiscData%F_k(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_k = SrcMiscData%F_k -ENDIF -IF (ALLOCATED(SrcMiscData%a_G)) THEN - i1_l = LBOUND(SrcMiscData%a_G,1) - i1_u = UBOUND(SrcMiscData%a_G,1) - i2_l = LBOUND(SrcMiscData%a_G,2) - i2_u = UBOUND(SrcMiscData%a_G,2) - IF (.NOT. ALLOCATED(DstMiscData%a_G)) THEN - ALLOCATE(DstMiscData%a_G(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%a_G.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%a_G = SrcMiscData%a_G -ENDIF -IF (ALLOCATED(SrcMiscData%rdisp_P)) THEN - i1_l = LBOUND(SrcMiscData%rdisp_P,1) - i1_u = UBOUND(SrcMiscData%rdisp_P,1) - i2_l = LBOUND(SrcMiscData%rdisp_P,2) - i2_u = UBOUND(SrcMiscData%rdisp_P,2) - IF (.NOT. ALLOCATED(DstMiscData%rdisp_P)) THEN - ALLOCATE(DstMiscData%rdisp_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rdisp_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rdisp_P = SrcMiscData%rdisp_P -ENDIF -IF (ALLOCATED(SrcMiscData%rdot_P)) THEN - i1_l = LBOUND(SrcMiscData%rdot_P,1) - i1_u = UBOUND(SrcMiscData%rdot_P,1) - i2_l = LBOUND(SrcMiscData%rdot_P,2) - i2_u = UBOUND(SrcMiscData%rdot_P,2) - IF (.NOT. ALLOCATED(DstMiscData%rdot_P)) THEN - ALLOCATE(DstMiscData%rdot_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rdot_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rdot_P = SrcMiscData%rdot_P -ENDIF -IF (ALLOCATED(SrcMiscData%rddot_P)) THEN - i1_l = LBOUND(SrcMiscData%rddot_P,1) - i1_u = UBOUND(SrcMiscData%rddot_P,1) - i2_l = LBOUND(SrcMiscData%rddot_P,2) - i2_u = UBOUND(SrcMiscData%rddot_P,2) - IF (.NOT. ALLOCATED(DstMiscData%rddot_P)) THEN - ALLOCATE(DstMiscData%rddot_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rddot_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rddot_P = SrcMiscData%rddot_P -ENDIF -IF (ALLOCATED(SrcMiscData%omega_P)) THEN - i1_l = LBOUND(SrcMiscData%omega_P,1) - i1_u = UBOUND(SrcMiscData%omega_P,1) - i2_l = LBOUND(SrcMiscData%omega_P,2) - i2_u = UBOUND(SrcMiscData%omega_P,2) - IF (.NOT. ALLOCATED(DstMiscData%omega_P)) THEN - ALLOCATE(DstMiscData%omega_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%omega_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%omega_P = SrcMiscData%omega_P -ENDIF -IF (ALLOCATED(SrcMiscData%alpha_P)) THEN - i1_l = LBOUND(SrcMiscData%alpha_P,1) - i1_u = UBOUND(SrcMiscData%alpha_P,1) - i2_l = LBOUND(SrcMiscData%alpha_P,2) - i2_u = UBOUND(SrcMiscData%alpha_P,2) - IF (.NOT. ALLOCATED(DstMiscData%alpha_P)) THEN - ALLOCATE(DstMiscData%alpha_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%alpha_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%alpha_P = SrcMiscData%alpha_P -ENDIF -IF (ALLOCATED(SrcMiscData%F_P)) THEN - i1_l = LBOUND(SrcMiscData%F_P,1) - i1_u = UBOUND(SrcMiscData%F_P,1) - i2_l = LBOUND(SrcMiscData%F_P,2) - i2_u = UBOUND(SrcMiscData%F_P,2) - IF (.NOT. ALLOCATED(DstMiscData%F_P)) THEN - ALLOCATE(DstMiscData%F_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_P = SrcMiscData%F_P -ENDIF -IF (ALLOCATED(SrcMiscData%M_P)) THEN - i1_l = LBOUND(SrcMiscData%M_P,1) - i1_u = UBOUND(SrcMiscData%M_P,1) - i2_l = LBOUND(SrcMiscData%M_P,2) - i2_u = UBOUND(SrcMiscData%M_P,2) - IF (.NOT. ALLOCATED(DstMiscData%M_P)) THEN - ALLOCATE(DstMiscData%M_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%M_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%M_P = SrcMiscData%M_P -ENDIF -IF (ALLOCATED(SrcMiscData%Acc)) THEN - i1_l = LBOUND(SrcMiscData%Acc,1) - i1_u = UBOUND(SrcMiscData%Acc,1) - i2_l = LBOUND(SrcMiscData%Acc,2) - i2_u = UBOUND(SrcMiscData%Acc,2) - IF (.NOT. ALLOCATED(DstMiscData%Acc)) THEN - ALLOCATE(DstMiscData%Acc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Acc = SrcMiscData%Acc -ENDIF - DstMiscData%PrescribedInterpIdx = SrcMiscData%PrescribedInterpIdx - END SUBROUTINE StC_CopyMisc - - SUBROUTINE StC_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(StC_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 = 'StC_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%F_stop)) THEN - DEALLOCATE(MiscData%F_stop) -ENDIF -IF (ALLOCATED(MiscData%F_ext)) THEN - DEALLOCATE(MiscData%F_ext) -ENDIF -IF (ALLOCATED(MiscData%F_fr)) THEN - DEALLOCATE(MiscData%F_fr) -ENDIF -IF (ALLOCATED(MiscData%K)) THEN - DEALLOCATE(MiscData%K) -ENDIF -IF (ALLOCATED(MiscData%C_ctrl)) THEN - DEALLOCATE(MiscData%C_ctrl) -ENDIF -IF (ALLOCATED(MiscData%C_Brake)) THEN - DEALLOCATE(MiscData%C_Brake) -ENDIF -IF (ALLOCATED(MiscData%F_table)) THEN - DEALLOCATE(MiscData%F_table) -ENDIF -IF (ALLOCATED(MiscData%F_k)) THEN - DEALLOCATE(MiscData%F_k) -ENDIF -IF (ALLOCATED(MiscData%a_G)) THEN - DEALLOCATE(MiscData%a_G) -ENDIF -IF (ALLOCATED(MiscData%rdisp_P)) THEN - DEALLOCATE(MiscData%rdisp_P) -ENDIF -IF (ALLOCATED(MiscData%rdot_P)) THEN - DEALLOCATE(MiscData%rdot_P) -ENDIF -IF (ALLOCATED(MiscData%rddot_P)) THEN - DEALLOCATE(MiscData%rddot_P) -ENDIF -IF (ALLOCATED(MiscData%omega_P)) THEN - DEALLOCATE(MiscData%omega_P) -ENDIF -IF (ALLOCATED(MiscData%alpha_P)) THEN - DEALLOCATE(MiscData%alpha_P) -ENDIF -IF (ALLOCATED(MiscData%F_P)) THEN - DEALLOCATE(MiscData%F_P) -ENDIF -IF (ALLOCATED(MiscData%M_P)) THEN - DEALLOCATE(MiscData%M_P) -ENDIF -IF (ALLOCATED(MiscData%Acc)) THEN - DEALLOCATE(MiscData%Acc) -ENDIF - END SUBROUTINE StC_DestroyMisc - - SUBROUTINE StC_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(StC_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 = 'StC_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 ! F_stop allocated yes/no - IF ( ALLOCATED(InData%F_stop) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_stop upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_stop) ! F_stop - END IF - Int_BufSz = Int_BufSz + 1 ! F_ext allocated yes/no - IF ( ALLOCATED(InData%F_ext) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_ext upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_ext) ! F_ext - END IF - Int_BufSz = Int_BufSz + 1 ! F_fr allocated yes/no - IF ( ALLOCATED(InData%F_fr) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_fr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_fr) ! F_fr - END IF - Int_BufSz = Int_BufSz + 1 ! K allocated yes/no - IF ( ALLOCATED(InData%K) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%K) ! K - END IF - Int_BufSz = Int_BufSz + 1 ! C_ctrl allocated yes/no - IF ( ALLOCATED(InData%C_ctrl) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C_ctrl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C_ctrl) ! C_ctrl - END IF - Int_BufSz = Int_BufSz + 1 ! C_Brake allocated yes/no - IF ( ALLOCATED(InData%C_Brake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C_Brake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C_Brake) ! C_Brake - END IF - Int_BufSz = Int_BufSz + 1 ! F_table allocated yes/no - IF ( ALLOCATED(InData%F_table) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_table upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_table) ! F_table - END IF - Int_BufSz = Int_BufSz + 1 ! F_k allocated yes/no - IF ( ALLOCATED(InData%F_k) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_k upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_k) ! F_k - END IF - Int_BufSz = Int_BufSz + 1 ! a_G allocated yes/no - IF ( ALLOCATED(InData%a_G) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! a_G upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%a_G) ! a_G - END IF - Int_BufSz = Int_BufSz + 1 ! rdisp_P allocated yes/no - IF ( ALLOCATED(InData%rdisp_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rdisp_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdisp_P) ! rdisp_P - END IF - Int_BufSz = Int_BufSz + 1 ! rdot_P allocated yes/no - IF ( ALLOCATED(InData%rdot_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rdot_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdot_P) ! rdot_P - END IF - Int_BufSz = Int_BufSz + 1 ! rddot_P allocated yes/no - IF ( ALLOCATED(InData%rddot_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rddot_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rddot_P) ! rddot_P - END IF - Int_BufSz = Int_BufSz + 1 ! omega_P allocated yes/no - IF ( ALLOCATED(InData%omega_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! omega_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%omega_P) ! omega_P - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_P allocated yes/no - IF ( ALLOCATED(InData%alpha_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_P) ! alpha_P - END IF - Int_BufSz = Int_BufSz + 1 ! F_P allocated yes/no - IF ( ALLOCATED(InData%F_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_P) ! F_P - END IF - Int_BufSz = Int_BufSz + 1 ! M_P allocated yes/no - IF ( ALLOCATED(InData%M_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M_P) ! M_P - END IF - Int_BufSz = Int_BufSz + 1 ! Acc allocated yes/no - IF ( ALLOCATED(InData%Acc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Acc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Acc) ! Acc - END IF - Int_BufSz = Int_BufSz + 1 ! PrescribedInterpIdx - 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%F_stop) ) 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%F_stop,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_stop,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_stop,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_stop,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_stop,2), UBOUND(InData%F_stop,2) - DO i1 = LBOUND(InData%F_stop,1), UBOUND(InData%F_stop,1) - ReKiBuf(Re_Xferred) = InData%F_stop(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_ext) ) 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%F_ext,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_ext,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_ext,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_ext,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_ext,2), UBOUND(InData%F_ext,2) - DO i1 = LBOUND(InData%F_ext,1), UBOUND(InData%F_ext,1) - ReKiBuf(Re_Xferred) = InData%F_ext(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_fr) ) 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%F_fr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_fr,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_fr,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_fr,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_fr,2), UBOUND(InData%F_fr,2) - DO i1 = LBOUND(InData%F_fr,1), UBOUND(InData%F_fr,1) - ReKiBuf(Re_Xferred) = InData%F_fr(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%K) ) 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%K,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%K,2), UBOUND(InData%K,2) - DO i1 = LBOUND(InData%K,1), UBOUND(InData%K,1) - ReKiBuf(Re_Xferred) = InData%K(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C_ctrl) ) 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%C_ctrl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_ctrl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C_ctrl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_ctrl,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C_ctrl,2), UBOUND(InData%C_ctrl,2) - DO i1 = LBOUND(InData%C_ctrl,1), UBOUND(InData%C_ctrl,1) - ReKiBuf(Re_Xferred) = InData%C_ctrl(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C_Brake) ) 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%C_Brake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_Brake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C_Brake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_Brake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C_Brake,2), UBOUND(InData%C_Brake,2) - DO i1 = LBOUND(InData%C_Brake,1), UBOUND(InData%C_Brake,1) - ReKiBuf(Re_Xferred) = InData%C_Brake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_table) ) 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%F_table,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_table,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_table,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_table,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_table,2), UBOUND(InData%F_table,2) - DO i1 = LBOUND(InData%F_table,1), UBOUND(InData%F_table,1) - ReKiBuf(Re_Xferred) = InData%F_table(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_k) ) 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%F_k,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_k,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_k,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_k,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_k,2), UBOUND(InData%F_k,2) - DO i1 = LBOUND(InData%F_k,1), UBOUND(InData%F_k,1) - ReKiBuf(Re_Xferred) = InData%F_k(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%a_G) ) 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%a_G,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%a_G,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%a_G,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%a_G,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%a_G,2), UBOUND(InData%a_G,2) - DO i1 = LBOUND(InData%a_G,1), UBOUND(InData%a_G,1) - ReKiBuf(Re_Xferred) = InData%a_G(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdisp_P) ) 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%rdisp_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdisp_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdisp_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdisp_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rdisp_P,2), UBOUND(InData%rdisp_P,2) - DO i1 = LBOUND(InData%rdisp_P,1), UBOUND(InData%rdisp_P,1) - ReKiBuf(Re_Xferred) = InData%rdisp_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdot_P) ) 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%rdot_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdot_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdot_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdot_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rdot_P,2), UBOUND(InData%rdot_P,2) - DO i1 = LBOUND(InData%rdot_P,1), UBOUND(InData%rdot_P,1) - ReKiBuf(Re_Xferred) = InData%rdot_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rddot_P) ) 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%rddot_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rddot_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rddot_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rddot_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rddot_P,2), UBOUND(InData%rddot_P,2) - DO i1 = LBOUND(InData%rddot_P,1), UBOUND(InData%rddot_P,1) - ReKiBuf(Re_Xferred) = InData%rddot_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%omega_P) ) 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%omega_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%omega_P,2), UBOUND(InData%omega_P,2) - DO i1 = LBOUND(InData%omega_P,1), UBOUND(InData%omega_P,1) - ReKiBuf(Re_Xferred) = InData%omega_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_P) ) 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%alpha_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alpha_P,2), UBOUND(InData%alpha_P,2) - DO i1 = LBOUND(InData%alpha_P,1), UBOUND(InData%alpha_P,1) - ReKiBuf(Re_Xferred) = InData%alpha_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_P) ) 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%F_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_P,2), UBOUND(InData%F_P,2) - DO i1 = LBOUND(InData%F_P,1), UBOUND(InData%F_P,1) - ReKiBuf(Re_Xferred) = InData%F_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M_P) ) 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%M_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M_P,2), UBOUND(InData%M_P,2) - DO i1 = LBOUND(InData%M_P,1), UBOUND(InData%M_P,1) - ReKiBuf(Re_Xferred) = InData%M_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Acc) ) 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%Acc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Acc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Acc,2), UBOUND(InData%Acc,2) - DO i1 = LBOUND(InData%Acc,1), UBOUND(InData%Acc,1) - ReKiBuf(Re_Xferred) = InData%Acc(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%PrescribedInterpIdx - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE StC_PackMisc - - SUBROUTINE StC_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(StC_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) :: 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 = 'StC_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_stop 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%F_stop)) DEALLOCATE(OutData%F_stop) - ALLOCATE(OutData%F_stop(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_stop.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_stop,2), UBOUND(OutData%F_stop,2) - DO i1 = LBOUND(OutData%F_stop,1), UBOUND(OutData%F_stop,1) - OutData%F_stop(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_ext 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%F_ext)) DEALLOCATE(OutData%F_ext) - ALLOCATE(OutData%F_ext(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_ext.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_ext,2), UBOUND(OutData%F_ext,2) - DO i1 = LBOUND(OutData%F_ext,1), UBOUND(OutData%F_ext,1) - OutData%F_ext(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_fr 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%F_fr)) DEALLOCATE(OutData%F_fr) - ALLOCATE(OutData%F_fr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_fr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_fr,2), UBOUND(OutData%F_fr,2) - DO i1 = LBOUND(OutData%F_fr,1), UBOUND(OutData%F_fr,1) - OutData%F_fr(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K 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%K)) DEALLOCATE(OutData%K) - ALLOCATE(OutData%K(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%K,2), UBOUND(OutData%K,2) - DO i1 = LBOUND(OutData%K,1), UBOUND(OutData%K,1) - OutData%K(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C_ctrl 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%C_ctrl)) DEALLOCATE(OutData%C_ctrl) - ALLOCATE(OutData%C_ctrl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_ctrl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C_ctrl,2), UBOUND(OutData%C_ctrl,2) - DO i1 = LBOUND(OutData%C_ctrl,1), UBOUND(OutData%C_ctrl,1) - OutData%C_ctrl(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C_Brake 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%C_Brake)) DEALLOCATE(OutData%C_Brake) - ALLOCATE(OutData%C_Brake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_Brake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C_Brake,2), UBOUND(OutData%C_Brake,2) - DO i1 = LBOUND(OutData%C_Brake,1), UBOUND(OutData%C_Brake,1) - OutData%C_Brake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_table 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%F_table)) DEALLOCATE(OutData%F_table) - ALLOCATE(OutData%F_table(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_table.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_table,2), UBOUND(OutData%F_table,2) - DO i1 = LBOUND(OutData%F_table,1), UBOUND(OutData%F_table,1) - OutData%F_table(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_k 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%F_k)) DEALLOCATE(OutData%F_k) - ALLOCATE(OutData%F_k(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_k,2), UBOUND(OutData%F_k,2) - DO i1 = LBOUND(OutData%F_k,1), UBOUND(OutData%F_k,1) - OutData%F_k(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! a_G 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%a_G)) DEALLOCATE(OutData%a_G) - ALLOCATE(OutData%a_G(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%a_G.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%a_G,2), UBOUND(OutData%a_G,2) - DO i1 = LBOUND(OutData%a_G,1), UBOUND(OutData%a_G,1) - OutData%a_G(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdisp_P 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%rdisp_P)) DEALLOCATE(OutData%rdisp_P) - ALLOCATE(OutData%rdisp_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdisp_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rdisp_P,2), UBOUND(OutData%rdisp_P,2) - DO i1 = LBOUND(OutData%rdisp_P,1), UBOUND(OutData%rdisp_P,1) - OutData%rdisp_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdot_P 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%rdot_P)) DEALLOCATE(OutData%rdot_P) - ALLOCATE(OutData%rdot_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdot_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rdot_P,2), UBOUND(OutData%rdot_P,2) - DO i1 = LBOUND(OutData%rdot_P,1), UBOUND(OutData%rdot_P,1) - OutData%rdot_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rddot_P 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%rddot_P)) DEALLOCATE(OutData%rddot_P) - ALLOCATE(OutData%rddot_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rddot_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rddot_P,2), UBOUND(OutData%rddot_P,2) - DO i1 = LBOUND(OutData%rddot_P,1), UBOUND(OutData%rddot_P,1) - OutData%rddot_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omega_P 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%omega_P)) DEALLOCATE(OutData%omega_P) - ALLOCATE(OutData%omega_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%omega_P,2), UBOUND(OutData%omega_P,2) - DO i1 = LBOUND(OutData%omega_P,1), UBOUND(OutData%omega_P,1) - OutData%omega_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_P 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%alpha_P)) DEALLOCATE(OutData%alpha_P) - ALLOCATE(OutData%alpha_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alpha_P,2), UBOUND(OutData%alpha_P,2) - DO i1 = LBOUND(OutData%alpha_P,1), UBOUND(OutData%alpha_P,1) - OutData%alpha_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_P 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%F_P)) DEALLOCATE(OutData%F_P) - ALLOCATE(OutData%F_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_P,2), UBOUND(OutData%F_P,2) - DO i1 = LBOUND(OutData%F_P,1), UBOUND(OutData%F_P,1) - OutData%F_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_P 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%M_P)) DEALLOCATE(OutData%M_P) - ALLOCATE(OutData%M_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M_P,2), UBOUND(OutData%M_P,2) - DO i1 = LBOUND(OutData%M_P,1), UBOUND(OutData%M_P,1) - OutData%M_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Acc 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%Acc)) DEALLOCATE(OutData%Acc) - ALLOCATE(OutData%Acc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Acc,2), UBOUND(OutData%Acc,2) - DO i1 = LBOUND(OutData%Acc,1), UBOUND(OutData%Acc,1) - OutData%Acc(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%PrescribedInterpIdx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE StC_UnPackMisc - - SUBROUTINE StC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_ParameterType), INTENT(IN) :: SrcParamData - TYPE(StC_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 = 'StC_CopyParam' -! + ErrMsg = '' + if (allocated(InitOutputData%RelPosition)) then + deallocate(InitOutputData%RelPosition) + end if +end subroutine + +subroutine StC_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%RelPosition)) + if (allocated(InData%RelPosition)) then + call RegPackBounds(Buf, 2, lbound(InData%RelPosition), ubound(InData%RelPosition)) + call RegPack(Buf, InData%RelPosition) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackInitOutput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%RelPosition)) deallocate(OutData%RelPosition) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RelPosition(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RelPosition.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RelPosition) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine StC_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(StC_ContinuousStateType), intent(in) :: SrcContStateData + type(StC_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%RootName = SrcParamData%RootName - DstParamData%StC_DOF_MODE = SrcParamData%StC_DOF_MODE - DstParamData%StC_X_DOF = SrcParamData%StC_X_DOF - DstParamData%StC_Y_DOF = SrcParamData%StC_Y_DOF - DstParamData%StC_Z_DOF = SrcParamData%StC_Z_DOF - DstParamData%StC_Z_PreLd = SrcParamData%StC_Z_PreLd - DstParamData%M_X = SrcParamData%M_X - DstParamData%M_Y = SrcParamData%M_Y - DstParamData%M_Z = SrcParamData%M_Z - DstParamData%M_XY = SrcParamData%M_XY - DstParamData%K_X = SrcParamData%K_X - DstParamData%K_Y = SrcParamData%K_Y - DstParamData%K_Z = SrcParamData%K_Z - DstParamData%C_X = SrcParamData%C_X - DstParamData%C_Y = SrcParamData%C_Y - DstParamData%C_Z = SrcParamData%C_Z - DstParamData%K_S = SrcParamData%K_S - DstParamData%C_S = SrcParamData%C_S - DstParamData%P_SP = SrcParamData%P_SP - DstParamData%N_SP = SrcParamData%N_SP - DstParamData%Gravity = SrcParamData%Gravity - DstParamData%StC_CMODE = SrcParamData%StC_CMODE - DstParamData%StC_SA_MODE = SrcParamData%StC_SA_MODE - DstParamData%StC_X_C_HIGH = SrcParamData%StC_X_C_HIGH - DstParamData%StC_X_C_LOW = SrcParamData%StC_X_C_LOW - DstParamData%StC_Y_C_HIGH = SrcParamData%StC_Y_C_HIGH - DstParamData%StC_Y_C_LOW = SrcParamData%StC_Y_C_LOW - DstParamData%StC_Z_C_HIGH = SrcParamData%StC_Z_C_HIGH - DstParamData%StC_Z_C_LOW = SrcParamData%StC_Z_C_LOW - DstParamData%StC_X_C_BRAKE = SrcParamData%StC_X_C_BRAKE - DstParamData%StC_Y_C_BRAKE = SrcParamData%StC_Y_C_BRAKE - DstParamData%StC_Z_C_BRAKE = SrcParamData%StC_Z_C_BRAKE - DstParamData%L_X = SrcParamData%L_X - DstParamData%B_X = SrcParamData%B_X - DstParamData%area_X = SrcParamData%area_X - DstParamData%area_ratio_X = SrcParamData%area_ratio_X - DstParamData%headLossCoeff_X = SrcParamData%headLossCoeff_X - DstParamData%rho_X = SrcParamData%rho_X - DstParamData%L_Y = SrcParamData%L_Y - DstParamData%B_Y = SrcParamData%B_Y - DstParamData%area_Y = SrcParamData%area_Y - DstParamData%area_ratio_Y = SrcParamData%area_ratio_Y - DstParamData%headLossCoeff_Y = SrcParamData%headLossCoeff_Y - DstParamData%rho_Y = SrcParamData%rho_Y - DstParamData%Use_F_TBL = SrcParamData%Use_F_TBL -IF (ALLOCATED(SrcParamData%F_TBL)) THEN - i1_l = LBOUND(SrcParamData%F_TBL,1) - i1_u = UBOUND(SrcParamData%F_TBL,1) - i2_l = LBOUND(SrcParamData%F_TBL,2) - i2_u = UBOUND(SrcParamData%F_TBL,2) - IF (.NOT. ALLOCATED(DstParamData%F_TBL)) THEN - ALLOCATE(DstParamData%F_TBL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_TBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%F_TBL = SrcParamData%F_TBL -ENDIF - DstParamData%NumMeshPts = SrcParamData%NumMeshPts - DstParamData%PrescribedForcesCoordSys = SrcParamData%PrescribedForcesCoordSys -IF (ALLOCATED(SrcParamData%StC_PrescribedForce)) THEN - i1_l = LBOUND(SrcParamData%StC_PrescribedForce,1) - i1_u = UBOUND(SrcParamData%StC_PrescribedForce,1) - i2_l = LBOUND(SrcParamData%StC_PrescribedForce,2) - i2_u = UBOUND(SrcParamData%StC_PrescribedForce,2) - IF (.NOT. ALLOCATED(DstParamData%StC_PrescribedForce)) THEN - ALLOCATE(DstParamData%StC_PrescribedForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StC_PrescribedForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StC_PrescribedForce = SrcParamData%StC_PrescribedForce -ENDIF -IF (ALLOCATED(SrcParamData%StC_CChan)) THEN - i1_l = LBOUND(SrcParamData%StC_CChan,1) - i1_u = UBOUND(SrcParamData%StC_CChan,1) - IF (.NOT. ALLOCATED(DstParamData%StC_CChan)) THEN - ALLOCATE(DstParamData%StC_CChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StC_CChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StC_CChan = SrcParamData%StC_CChan -ENDIF - END SUBROUTINE StC_CopyParam - - SUBROUTINE StC_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(StC_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 = 'StC_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%F_TBL)) THEN - DEALLOCATE(ParamData%F_TBL) -ENDIF -IF (ALLOCATED(ParamData%StC_PrescribedForce)) THEN - DEALLOCATE(ParamData%StC_PrescribedForce) -ENDIF -IF (ALLOCATED(ParamData%StC_CChan)) THEN - DEALLOCATE(ParamData%StC_CChan) -ENDIF - END SUBROUTINE StC_DestroyParam - - SUBROUTINE StC_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(StC_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 = 'StC_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*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! StC_DOF_MODE - Int_BufSz = Int_BufSz + 1 ! StC_X_DOF - Int_BufSz = Int_BufSz + 1 ! StC_Y_DOF - Int_BufSz = Int_BufSz + 1 ! StC_Z_DOF - Re_BufSz = Re_BufSz + 1 ! StC_Z_PreLd - Re_BufSz = Re_BufSz + 1 ! M_X - Re_BufSz = Re_BufSz + 1 ! M_Y - Re_BufSz = Re_BufSz + 1 ! M_Z - Re_BufSz = Re_BufSz + 1 ! M_XY - Re_BufSz = Re_BufSz + 1 ! K_X - Re_BufSz = Re_BufSz + 1 ! K_Y - Re_BufSz = Re_BufSz + 1 ! K_Z - Re_BufSz = Re_BufSz + 1 ! C_X - Re_BufSz = Re_BufSz + 1 ! C_Y - Re_BufSz = Re_BufSz + 1 ! C_Z - Re_BufSz = Re_BufSz + SIZE(InData%K_S) ! K_S - Re_BufSz = Re_BufSz + SIZE(InData%C_S) ! C_S - Re_BufSz = Re_BufSz + SIZE(InData%P_SP) ! P_SP - Re_BufSz = Re_BufSz + SIZE(InData%N_SP) ! N_SP - Re_BufSz = Re_BufSz + SIZE(InData%Gravity) ! Gravity - Int_BufSz = Int_BufSz + 1 ! StC_CMODE - Int_BufSz = Int_BufSz + 1 ! StC_SA_MODE - Re_BufSz = Re_BufSz + 1 ! StC_X_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_X_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_X_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! L_X - Re_BufSz = Re_BufSz + 1 ! B_X - Re_BufSz = Re_BufSz + 1 ! area_X - Re_BufSz = Re_BufSz + 1 ! area_ratio_X - Re_BufSz = Re_BufSz + 1 ! headLossCoeff_X - Re_BufSz = Re_BufSz + 1 ! rho_X - Re_BufSz = Re_BufSz + 1 ! L_Y - Re_BufSz = Re_BufSz + 1 ! B_Y - Re_BufSz = Re_BufSz + 1 ! area_Y - Re_BufSz = Re_BufSz + 1 ! area_ratio_Y - Re_BufSz = Re_BufSz + 1 ! headLossCoeff_Y - Re_BufSz = Re_BufSz + 1 ! rho_Y - Int_BufSz = Int_BufSz + 1 ! Use_F_TBL - Int_BufSz = Int_BufSz + 1 ! F_TBL allocated yes/no - IF ( ALLOCATED(InData%F_TBL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_TBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_TBL) ! F_TBL - END IF - Int_BufSz = Int_BufSz + 1 ! NumMeshPts - Int_BufSz = Int_BufSz + 1 ! PrescribedForcesCoordSys - Int_BufSz = Int_BufSz + 1 ! StC_PrescribedForce allocated yes/no - IF ( ALLOCATED(InData%StC_PrescribedForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StC_PrescribedForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StC_PrescribedForce) ! StC_PrescribedForce - END IF - Int_BufSz = Int_BufSz + 1 ! StC_CChan allocated yes/no - IF ( ALLOCATED(InData%StC_CChan) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StC_CChan upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%StC_CChan) ! StC_CChan - 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 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%StC_DOF_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_X_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_Y_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_Z_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_PreLd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%M_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%M_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%M_Z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%M_XY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%K_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%K_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%K_Z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_Z - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%K_S,1), UBOUND(InData%K_S,1) - ReKiBuf(Re_Xferred) = InData%K_S(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%C_S,1), UBOUND(InData%C_S,1) - ReKiBuf(Re_Xferred) = InData%C_S(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%P_SP,1), UBOUND(InData%P_SP,1) - ReKiBuf(Re_Xferred) = InData%P_SP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%N_SP,1), UBOUND(InData%N_SP,1) - ReKiBuf(Re_Xferred) = InData%N_SP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Gravity,1), UBOUND(InData%Gravity,1) - ReKiBuf(Re_Xferred) = InData%Gravity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%StC_CMODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%StC_SA_MODE - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%L_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%B_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_ratio_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%headLossCoeff_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rho_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%L_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%B_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_ratio_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%headLossCoeff_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rho_Y - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_F_TBL, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%F_TBL) ) 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%F_TBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_TBL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_TBL,2), UBOUND(InData%F_TBL,2) - DO i1 = LBOUND(InData%F_TBL,1), UBOUND(InData%F_TBL,1) - ReKiBuf(Re_Xferred) = InData%F_TBL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumMeshPts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PrescribedForcesCoordSys - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%StC_PrescribedForce) ) 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%StC_PrescribedForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_PrescribedForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_PrescribedForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_PrescribedForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StC_PrescribedForce,2), UBOUND(InData%StC_PrescribedForce,2) - DO i1 = LBOUND(InData%StC_PrescribedForce,1), UBOUND(InData%StC_PrescribedForce,1) - ReKiBuf(Re_Xferred) = InData%StC_PrescribedForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StC_CChan) ) 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%StC_CChan,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_CChan,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StC_CChan,1), UBOUND(InData%StC_CChan,1) - IntKiBuf(Int_Xferred) = InData%StC_CChan(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE StC_PackParam - - SUBROUTINE StC_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(StC_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 = 'StC_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 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%StC_DOF_MODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_X_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_X_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_Y_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_Y_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_Z_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_Z_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_Z_PreLd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%M_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%M_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%M_Z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%M_XY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%K_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%K_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%K_Z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_Z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%K_S,1) - i1_u = UBOUND(OutData%K_S,1) - DO i1 = LBOUND(OutData%K_S,1), UBOUND(OutData%K_S,1) - OutData%K_S(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%C_S,1) - i1_u = UBOUND(OutData%C_S,1) - DO i1 = LBOUND(OutData%C_S,1), UBOUND(OutData%C_S,1) - OutData%C_S(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%P_SP,1) - i1_u = UBOUND(OutData%P_SP,1) - DO i1 = LBOUND(OutData%P_SP,1), UBOUND(OutData%P_SP,1) - OutData%P_SP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%N_SP,1) - i1_u = UBOUND(OutData%N_SP,1) - DO i1 = LBOUND(OutData%N_SP,1), UBOUND(OutData%N_SP,1) - OutData%N_SP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Gravity,1) - i1_u = UBOUND(OutData%Gravity,1) - DO i1 = LBOUND(OutData%Gravity,1), UBOUND(OutData%Gravity,1) - OutData%Gravity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%StC_CMODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_SA_MODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_X_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%L_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%B_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_ratio_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%headLossCoeff_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rho_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%L_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%B_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_ratio_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%headLossCoeff_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rho_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Use_F_TBL = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_F_TBL) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_TBL 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%F_TBL)) DEALLOCATE(OutData%F_TBL) - ALLOCATE(OutData%F_TBL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_TBL,2), UBOUND(OutData%F_TBL,2) - DO i1 = LBOUND(OutData%F_TBL,1), UBOUND(OutData%F_TBL,1) - OutData%F_TBL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%NumMeshPts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PrescribedForcesCoordSys = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_PrescribedForce 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%StC_PrescribedForce)) DEALLOCATE(OutData%StC_PrescribedForce) - ALLOCATE(OutData%StC_PrescribedForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_PrescribedForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StC_PrescribedForce,2), UBOUND(OutData%StC_PrescribedForce,2) - DO i1 = LBOUND(OutData%StC_PrescribedForce,1), UBOUND(OutData%StC_PrescribedForce,1) - OutData%StC_PrescribedForce(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_CChan 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%StC_CChan)) DEALLOCATE(OutData%StC_CChan) - ALLOCATE(OutData%StC_CChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_CChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StC_CChan,1), UBOUND(OutData%StC_CChan,1) - OutData%StC_CChan(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE StC_UnPackParam - - SUBROUTINE StC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_InputType), INTENT(INOUT) :: SrcInputData - TYPE(StC_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) :: 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 = 'StC_CopyInput' -! + ErrMsg = '' + if (allocated(SrcContStateData%StC_x)) then + LB(1:2) = lbound(SrcContStateData%StC_x) + UB(1:2) = ubound(SrcContStateData%StC_x) + if (.not. allocated(DstContStateData%StC_x)) then + allocate(DstContStateData%StC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%StC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%StC_x = SrcContStateData%StC_x + end if +end subroutine + +subroutine StC_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(StC_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%Mesh)) THEN - i1_l = LBOUND(SrcInputData%Mesh,1) - i1_u = UBOUND(SrcInputData%Mesh,1) - IF (.NOT. ALLOCATED(DstInputData%Mesh)) THEN - ALLOCATE(DstInputData%Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%Mesh,1), UBOUND(SrcInputData%Mesh,1) - CALL MeshCopy( SrcInputData%Mesh(i1), DstInputData%Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%CmdStiff)) THEN - i1_l = LBOUND(SrcInputData%CmdStiff,1) - i1_u = UBOUND(SrcInputData%CmdStiff,1) - i2_l = LBOUND(SrcInputData%CmdStiff,2) - i2_u = UBOUND(SrcInputData%CmdStiff,2) - IF (.NOT. ALLOCATED(DstInputData%CmdStiff)) THEN - ALLOCATE(DstInputData%CmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CmdStiff = SrcInputData%CmdStiff -ENDIF -IF (ALLOCATED(SrcInputData%CmdDamp)) THEN - i1_l = LBOUND(SrcInputData%CmdDamp,1) - i1_u = UBOUND(SrcInputData%CmdDamp,1) - i2_l = LBOUND(SrcInputData%CmdDamp,2) - i2_u = UBOUND(SrcInputData%CmdDamp,2) - IF (.NOT. ALLOCATED(DstInputData%CmdDamp)) THEN - ALLOCATE(DstInputData%CmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CmdDamp = SrcInputData%CmdDamp -ENDIF -IF (ALLOCATED(SrcInputData%CmdBrake)) THEN - i1_l = LBOUND(SrcInputData%CmdBrake,1) - i1_u = UBOUND(SrcInputData%CmdBrake,1) - i2_l = LBOUND(SrcInputData%CmdBrake,2) - i2_u = UBOUND(SrcInputData%CmdBrake,2) - IF (.NOT. ALLOCATED(DstInputData%CmdBrake)) THEN - ALLOCATE(DstInputData%CmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CmdBrake = SrcInputData%CmdBrake -ENDIF -IF (ALLOCATED(SrcInputData%CmdForce)) THEN - i1_l = LBOUND(SrcInputData%CmdForce,1) - i1_u = UBOUND(SrcInputData%CmdForce,1) - i2_l = LBOUND(SrcInputData%CmdForce,2) - i2_u = UBOUND(SrcInputData%CmdForce,2) - IF (.NOT. ALLOCATED(DstInputData%CmdForce)) THEN - ALLOCATE(DstInputData%CmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CmdForce = SrcInputData%CmdForce -ENDIF - END SUBROUTINE StC_CopyInput - - SUBROUTINE StC_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(StC_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 = 'StC_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%Mesh)) THEN -DO i1 = LBOUND(InputData%Mesh,1), UBOUND(InputData%Mesh,1) - CALL MeshDestroy( InputData%Mesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%Mesh) -ENDIF -IF (ALLOCATED(InputData%CmdStiff)) THEN - DEALLOCATE(InputData%CmdStiff) -ENDIF -IF (ALLOCATED(InputData%CmdDamp)) THEN - DEALLOCATE(InputData%CmdDamp) -ENDIF -IF (ALLOCATED(InputData%CmdBrake)) THEN - DEALLOCATE(InputData%CmdBrake) -ENDIF -IF (ALLOCATED(InputData%CmdForce)) THEN - DEALLOCATE(InputData%CmdForce) -ENDIF - END SUBROUTINE StC_DestroyInput - - SUBROUTINE StC_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(StC_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 = 'StC_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 - Int_BufSz = Int_BufSz + 1 ! Mesh allocated yes/no - IF ( ALLOCATED(InData%Mesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Mesh upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Mesh,1), UBOUND(InData%Mesh,1) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! CmdStiff allocated yes/no - IF ( ALLOCATED(InData%CmdStiff) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CmdStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CmdStiff) ! CmdStiff - END IF - Int_BufSz = Int_BufSz + 1 ! CmdDamp allocated yes/no - IF ( ALLOCATED(InData%CmdDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CmdDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CmdDamp) ! CmdDamp - END IF - Int_BufSz = Int_BufSz + 1 ! CmdBrake allocated yes/no - IF ( ALLOCATED(InData%CmdBrake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CmdBrake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CmdBrake) ! CmdBrake - END IF - Int_BufSz = Int_BufSz + 1 ! CmdForce allocated yes/no - IF ( ALLOCATED(InData%CmdForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CmdForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CmdForce) ! CmdForce - 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%Mesh) ) 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%Mesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Mesh,1), UBOUND(InData%Mesh,1) - CALL MeshPack( InData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - 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 - IF ( .NOT. ALLOCATED(InData%CmdStiff) ) 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%CmdStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdStiff,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdStiff,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdStiff,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CmdStiff,2), UBOUND(InData%CmdStiff,2) - DO i1 = LBOUND(InData%CmdStiff,1), UBOUND(InData%CmdStiff,1) - ReKiBuf(Re_Xferred) = InData%CmdStiff(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CmdDamp) ) 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%CmdDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CmdDamp,2), UBOUND(InData%CmdDamp,2) - DO i1 = LBOUND(InData%CmdDamp,1), UBOUND(InData%CmdDamp,1) - ReKiBuf(Re_Xferred) = InData%CmdDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CmdBrake) ) 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%CmdBrake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdBrake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdBrake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdBrake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CmdBrake,2), UBOUND(InData%CmdBrake,2) - DO i1 = LBOUND(InData%CmdBrake,1), UBOUND(InData%CmdBrake,1) - ReKiBuf(Re_Xferred) = InData%CmdBrake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CmdForce) ) 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%CmdForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CmdForce,2), UBOUND(InData%CmdForce,2) - DO i1 = LBOUND(InData%CmdForce,1), UBOUND(InData%CmdForce,1) - ReKiBuf(Re_Xferred) = InData%CmdForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_PackInput - - SUBROUTINE StC_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(StC_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) :: 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 = 'StC_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mesh 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%Mesh)) DEALLOCATE(OutData%Mesh) - ALLOCATE(OutData%Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Mesh,1), UBOUND(OutData%Mesh,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 MeshUnpack( OutData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - 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 ! CmdStiff 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%CmdStiff)) DEALLOCATE(OutData%CmdStiff) - ALLOCATE(OutData%CmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CmdStiff,2), UBOUND(OutData%CmdStiff,2) - DO i1 = LBOUND(OutData%CmdStiff,1), UBOUND(OutData%CmdStiff,1) - OutData%CmdStiff(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CmdDamp 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%CmdDamp)) DEALLOCATE(OutData%CmdDamp) - ALLOCATE(OutData%CmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CmdDamp,2), UBOUND(OutData%CmdDamp,2) - DO i1 = LBOUND(OutData%CmdDamp,1), UBOUND(OutData%CmdDamp,1) - OutData%CmdDamp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CmdBrake 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%CmdBrake)) DEALLOCATE(OutData%CmdBrake) - ALLOCATE(OutData%CmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CmdBrake,2), UBOUND(OutData%CmdBrake,2) - DO i1 = LBOUND(OutData%CmdBrake,1), UBOUND(OutData%CmdBrake,1) - OutData%CmdBrake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CmdForce 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%CmdForce)) DEALLOCATE(OutData%CmdForce) - ALLOCATE(OutData%CmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CmdForce,2), UBOUND(OutData%CmdForce,2) - DO i1 = LBOUND(OutData%CmdForce,1), UBOUND(OutData%CmdForce,1) - OutData%CmdForce(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_UnPackInput - - SUBROUTINE StC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(StC_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyOutput' -! + ErrMsg = '' + if (allocated(ContStateData%StC_x)) then + deallocate(ContStateData%StC_x) + end if +end subroutine + +subroutine StC_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%StC_x)) + if (allocated(InData%StC_x)) then + call RegPackBounds(Buf, 2, lbound(InData%StC_x), ubound(InData%StC_x)) + call RegPack(Buf, InData%StC_x) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackContState' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%StC_x)) deallocate(OutData%StC_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StC_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StC_x) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine StC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(StC_DiscreteStateType), intent(in) :: SrcDiscStateData + type(StC_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%Mesh)) THEN - i1_l = LBOUND(SrcOutputData%Mesh,1) - i1_u = UBOUND(SrcOutputData%Mesh,1) - IF (.NOT. ALLOCATED(DstOutputData%Mesh)) THEN - ALLOCATE(DstOutputData%Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%Mesh,1), UBOUND(SrcOutputData%Mesh,1) - CALL MeshCopy( SrcOutputData%Mesh(i1), DstOutputData%Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%MeasDisp)) THEN - i1_l = LBOUND(SrcOutputData%MeasDisp,1) - i1_u = UBOUND(SrcOutputData%MeasDisp,1) - i2_l = LBOUND(SrcOutputData%MeasDisp,2) - i2_u = UBOUND(SrcOutputData%MeasDisp,2) - IF (.NOT. ALLOCATED(DstOutputData%MeasDisp)) THEN - ALLOCATE(DstOutputData%MeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%MeasDisp = SrcOutputData%MeasDisp -ENDIF -IF (ALLOCATED(SrcOutputData%MeasVel)) THEN - i1_l = LBOUND(SrcOutputData%MeasVel,1) - i1_u = UBOUND(SrcOutputData%MeasVel,1) - i2_l = LBOUND(SrcOutputData%MeasVel,2) - i2_u = UBOUND(SrcOutputData%MeasVel,2) - IF (.NOT. ALLOCATED(DstOutputData%MeasVel)) THEN - ALLOCATE(DstOutputData%MeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%MeasVel = SrcOutputData%MeasVel -ENDIF - END SUBROUTINE StC_CopyOutput - - SUBROUTINE StC_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(StC_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 = 'StC_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%Mesh)) THEN -DO i1 = LBOUND(OutputData%Mesh,1), UBOUND(OutputData%Mesh,1) - CALL MeshDestroy( OutputData%Mesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%Mesh) -ENDIF -IF (ALLOCATED(OutputData%MeasDisp)) THEN - DEALLOCATE(OutputData%MeasDisp) -ENDIF -IF (ALLOCATED(OutputData%MeasVel)) THEN - DEALLOCATE(OutputData%MeasVel) -ENDIF - END SUBROUTINE StC_DestroyOutput - - SUBROUTINE StC_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(StC_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 = 'StC_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 ! Mesh allocated yes/no - IF ( ALLOCATED(InData%Mesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Mesh upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Mesh,1), UBOUND(InData%Mesh,1) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MeasDisp allocated yes/no - IF ( ALLOCATED(InData%MeasDisp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MeasDisp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MeasDisp) ! MeasDisp - END IF - Int_BufSz = Int_BufSz + 1 ! MeasVel allocated yes/no - IF ( ALLOCATED(InData%MeasVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MeasVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MeasVel) ! MeasVel - 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%Mesh) ) 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%Mesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Mesh,1), UBOUND(InData%Mesh,1) - CALL MeshPack( InData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - 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 - IF ( .NOT. ALLOCATED(InData%MeasDisp) ) 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%MeasDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeasDisp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeasDisp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeasDisp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MeasDisp,2), UBOUND(InData%MeasDisp,2) - DO i1 = LBOUND(InData%MeasDisp,1), UBOUND(InData%MeasDisp,1) - ReKiBuf(Re_Xferred) = InData%MeasDisp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MeasVel) ) 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%MeasVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeasVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeasVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeasVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MeasVel,2), UBOUND(InData%MeasVel,2) - DO i1 = LBOUND(InData%MeasVel,1), UBOUND(InData%MeasVel,1) - ReKiBuf(Re_Xferred) = InData%MeasVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_PackOutput - - SUBROUTINE StC_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(StC_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_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 ! Mesh 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%Mesh)) DEALLOCATE(OutData%Mesh) - ALLOCATE(OutData%Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Mesh,1), UBOUND(OutData%Mesh,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 MeshUnpack( OutData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - 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 ! MeasDisp 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%MeasDisp)) DEALLOCATE(OutData%MeasDisp) - ALLOCATE(OutData%MeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MeasDisp,2), UBOUND(OutData%MeasDisp,2) - DO i1 = LBOUND(OutData%MeasDisp,1), UBOUND(OutData%MeasDisp,1) - OutData%MeasDisp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeasVel 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%MeasVel)) DEALLOCATE(OutData%MeasVel) - ALLOCATE(OutData%MeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MeasVel,2), UBOUND(OutData%MeasVel,2) - DO i1 = LBOUND(OutData%MeasVel,1), UBOUND(OutData%MeasVel,1) - OutData%MeasVel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_UnPackOutput - - - SUBROUTINE StC_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(StC_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(StC_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 + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine StC_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(StC_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine StC_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(StC_ConstraintStateType), intent(in) :: SrcConstrStateData + type(StC_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine StC_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(StC_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine StC_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(StC_OtherStateType), intent(in) :: SrcOtherStateData + type(StC_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +subroutine StC_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(StC_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine StC_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(StC_MiscVarType), intent(in) :: SrcMiscData + type(StC_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%F_stop)) then + LB(1:2) = lbound(SrcMiscData%F_stop) + UB(1:2) = ubound(SrcMiscData%F_stop) + if (.not. allocated(DstMiscData%F_stop)) then + allocate(DstMiscData%F_stop(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_stop.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_stop = SrcMiscData%F_stop + end if + if (allocated(SrcMiscData%F_ext)) then + LB(1:2) = lbound(SrcMiscData%F_ext) + UB(1:2) = ubound(SrcMiscData%F_ext) + if (.not. allocated(DstMiscData%F_ext)) then + allocate(DstMiscData%F_ext(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_ext.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_ext = SrcMiscData%F_ext + end if + if (allocated(SrcMiscData%F_fr)) then + LB(1:2) = lbound(SrcMiscData%F_fr) + UB(1:2) = ubound(SrcMiscData%F_fr) + if (.not. allocated(DstMiscData%F_fr)) then + allocate(DstMiscData%F_fr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_fr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_fr = SrcMiscData%F_fr + end if + if (allocated(SrcMiscData%K)) then + LB(1:2) = lbound(SrcMiscData%K) + UB(1:2) = ubound(SrcMiscData%K) + if (.not. allocated(DstMiscData%K)) then + allocate(DstMiscData%K(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%K.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%K = SrcMiscData%K + end if + if (allocated(SrcMiscData%C_ctrl)) then + LB(1:2) = lbound(SrcMiscData%C_ctrl) + UB(1:2) = ubound(SrcMiscData%C_ctrl) + if (.not. allocated(DstMiscData%C_ctrl)) then + allocate(DstMiscData%C_ctrl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%C_ctrl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%C_ctrl = SrcMiscData%C_ctrl + end if + if (allocated(SrcMiscData%C_Brake)) then + LB(1:2) = lbound(SrcMiscData%C_Brake) + UB(1:2) = ubound(SrcMiscData%C_Brake) + if (.not. allocated(DstMiscData%C_Brake)) then + allocate(DstMiscData%C_Brake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%C_Brake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%C_Brake = SrcMiscData%C_Brake + end if + if (allocated(SrcMiscData%F_table)) then + LB(1:2) = lbound(SrcMiscData%F_table) + UB(1:2) = ubound(SrcMiscData%F_table) + if (.not. allocated(DstMiscData%F_table)) then + allocate(DstMiscData%F_table(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_table.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_table = SrcMiscData%F_table + end if + if (allocated(SrcMiscData%F_k)) then + LB(1:2) = lbound(SrcMiscData%F_k) + UB(1:2) = ubound(SrcMiscData%F_k) + if (.not. allocated(DstMiscData%F_k)) then + allocate(DstMiscData%F_k(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_k.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_k = SrcMiscData%F_k + end if + if (allocated(SrcMiscData%a_G)) then + LB(1:2) = lbound(SrcMiscData%a_G) + UB(1:2) = ubound(SrcMiscData%a_G) + if (.not. allocated(DstMiscData%a_G)) then + allocate(DstMiscData%a_G(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%a_G.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%a_G = SrcMiscData%a_G + end if + if (allocated(SrcMiscData%rdisp_P)) then + LB(1:2) = lbound(SrcMiscData%rdisp_P) + UB(1:2) = ubound(SrcMiscData%rdisp_P) + if (.not. allocated(DstMiscData%rdisp_P)) then + allocate(DstMiscData%rdisp_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rdisp_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rdisp_P = SrcMiscData%rdisp_P + end if + if (allocated(SrcMiscData%rdot_P)) then + LB(1:2) = lbound(SrcMiscData%rdot_P) + UB(1:2) = ubound(SrcMiscData%rdot_P) + if (.not. allocated(DstMiscData%rdot_P)) then + allocate(DstMiscData%rdot_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rdot_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rdot_P = SrcMiscData%rdot_P + end if + if (allocated(SrcMiscData%rddot_P)) then + LB(1:2) = lbound(SrcMiscData%rddot_P) + UB(1:2) = ubound(SrcMiscData%rddot_P) + if (.not. allocated(DstMiscData%rddot_P)) then + allocate(DstMiscData%rddot_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rddot_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rddot_P = SrcMiscData%rddot_P + end if + if (allocated(SrcMiscData%omega_P)) then + LB(1:2) = lbound(SrcMiscData%omega_P) + UB(1:2) = ubound(SrcMiscData%omega_P) + if (.not. allocated(DstMiscData%omega_P)) then + allocate(DstMiscData%omega_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%omega_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%omega_P = SrcMiscData%omega_P + end if + if (allocated(SrcMiscData%alpha_P)) then + LB(1:2) = lbound(SrcMiscData%alpha_P) + UB(1:2) = ubound(SrcMiscData%alpha_P) + if (.not. allocated(DstMiscData%alpha_P)) then + allocate(DstMiscData%alpha_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%alpha_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%alpha_P = SrcMiscData%alpha_P + end if + if (allocated(SrcMiscData%F_P)) then + LB(1:2) = lbound(SrcMiscData%F_P) + UB(1:2) = ubound(SrcMiscData%F_P) + if (.not. allocated(DstMiscData%F_P)) then + allocate(DstMiscData%F_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_P = SrcMiscData%F_P + end if + if (allocated(SrcMiscData%M_P)) then + LB(1:2) = lbound(SrcMiscData%M_P) + UB(1:2) = ubound(SrcMiscData%M_P) + if (.not. allocated(DstMiscData%M_P)) then + allocate(DstMiscData%M_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%M_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%M_P = SrcMiscData%M_P + end if + if (allocated(SrcMiscData%Acc)) then + LB(1:2) = lbound(SrcMiscData%Acc) + UB(1:2) = ubound(SrcMiscData%Acc) + if (.not. allocated(DstMiscData%Acc)) then + allocate(DstMiscData%Acc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Acc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Acc = SrcMiscData%Acc + end if + DstMiscData%PrescribedInterpIdx = SrcMiscData%PrescribedInterpIdx +end subroutine + +subroutine StC_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(StC_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%F_stop)) then + deallocate(MiscData%F_stop) + end if + if (allocated(MiscData%F_ext)) then + deallocate(MiscData%F_ext) + end if + if (allocated(MiscData%F_fr)) then + deallocate(MiscData%F_fr) + end if + if (allocated(MiscData%K)) then + deallocate(MiscData%K) + end if + if (allocated(MiscData%C_ctrl)) then + deallocate(MiscData%C_ctrl) + end if + if (allocated(MiscData%C_Brake)) then + deallocate(MiscData%C_Brake) + end if + if (allocated(MiscData%F_table)) then + deallocate(MiscData%F_table) + end if + if (allocated(MiscData%F_k)) then + deallocate(MiscData%F_k) + end if + if (allocated(MiscData%a_G)) then + deallocate(MiscData%a_G) + end if + if (allocated(MiscData%rdisp_P)) then + deallocate(MiscData%rdisp_P) + end if + if (allocated(MiscData%rdot_P)) then + deallocate(MiscData%rdot_P) + end if + if (allocated(MiscData%rddot_P)) then + deallocate(MiscData%rddot_P) + end if + if (allocated(MiscData%omega_P)) then + deallocate(MiscData%omega_P) + end if + if (allocated(MiscData%alpha_P)) then + deallocate(MiscData%alpha_P) + end if + if (allocated(MiscData%F_P)) then + deallocate(MiscData%F_P) + end if + if (allocated(MiscData%M_P)) then + deallocate(MiscData%M_P) + end if + if (allocated(MiscData%Acc)) then + deallocate(MiscData%Acc) + end if +end subroutine + +subroutine StC_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%F_stop)) + if (allocated(InData%F_stop)) then + call RegPackBounds(Buf, 2, lbound(InData%F_stop), ubound(InData%F_stop)) + call RegPack(Buf, InData%F_stop) + end if + call RegPack(Buf, allocated(InData%F_ext)) + if (allocated(InData%F_ext)) then + call RegPackBounds(Buf, 2, lbound(InData%F_ext), ubound(InData%F_ext)) + call RegPack(Buf, InData%F_ext) + end if + call RegPack(Buf, allocated(InData%F_fr)) + if (allocated(InData%F_fr)) then + call RegPackBounds(Buf, 2, lbound(InData%F_fr), ubound(InData%F_fr)) + call RegPack(Buf, InData%F_fr) + end if + call RegPack(Buf, allocated(InData%K)) + if (allocated(InData%K)) then + call RegPackBounds(Buf, 2, lbound(InData%K), ubound(InData%K)) + call RegPack(Buf, InData%K) + end if + call RegPack(Buf, allocated(InData%C_ctrl)) + if (allocated(InData%C_ctrl)) then + call RegPackBounds(Buf, 2, lbound(InData%C_ctrl), ubound(InData%C_ctrl)) + call RegPack(Buf, InData%C_ctrl) + end if + call RegPack(Buf, allocated(InData%C_Brake)) + if (allocated(InData%C_Brake)) then + call RegPackBounds(Buf, 2, lbound(InData%C_Brake), ubound(InData%C_Brake)) + call RegPack(Buf, InData%C_Brake) + end if + call RegPack(Buf, allocated(InData%F_table)) + if (allocated(InData%F_table)) then + call RegPackBounds(Buf, 2, lbound(InData%F_table), ubound(InData%F_table)) + call RegPack(Buf, InData%F_table) + end if + call RegPack(Buf, allocated(InData%F_k)) + if (allocated(InData%F_k)) then + call RegPackBounds(Buf, 2, lbound(InData%F_k), ubound(InData%F_k)) + call RegPack(Buf, InData%F_k) + end if + call RegPack(Buf, allocated(InData%a_G)) + if (allocated(InData%a_G)) then + call RegPackBounds(Buf, 2, lbound(InData%a_G), ubound(InData%a_G)) + call RegPack(Buf, InData%a_G) + end if + call RegPack(Buf, allocated(InData%rdisp_P)) + if (allocated(InData%rdisp_P)) then + call RegPackBounds(Buf, 2, lbound(InData%rdisp_P), ubound(InData%rdisp_P)) + call RegPack(Buf, InData%rdisp_P) + end if + call RegPack(Buf, allocated(InData%rdot_P)) + if (allocated(InData%rdot_P)) then + call RegPackBounds(Buf, 2, lbound(InData%rdot_P), ubound(InData%rdot_P)) + call RegPack(Buf, InData%rdot_P) + end if + call RegPack(Buf, allocated(InData%rddot_P)) + if (allocated(InData%rddot_P)) then + call RegPackBounds(Buf, 2, lbound(InData%rddot_P), ubound(InData%rddot_P)) + call RegPack(Buf, InData%rddot_P) + end if + call RegPack(Buf, allocated(InData%omega_P)) + if (allocated(InData%omega_P)) then + call RegPackBounds(Buf, 2, lbound(InData%omega_P), ubound(InData%omega_P)) + call RegPack(Buf, InData%omega_P) + end if + call RegPack(Buf, allocated(InData%alpha_P)) + if (allocated(InData%alpha_P)) then + call RegPackBounds(Buf, 2, lbound(InData%alpha_P), ubound(InData%alpha_P)) + call RegPack(Buf, InData%alpha_P) + end if + call RegPack(Buf, allocated(InData%F_P)) + if (allocated(InData%F_P)) then + call RegPackBounds(Buf, 2, lbound(InData%F_P), ubound(InData%F_P)) + call RegPack(Buf, InData%F_P) + end if + call RegPack(Buf, allocated(InData%M_P)) + if (allocated(InData%M_P)) then + call RegPackBounds(Buf, 2, lbound(InData%M_P), ubound(InData%M_P)) + call RegPack(Buf, InData%M_P) + end if + call RegPack(Buf, allocated(InData%Acc)) + if (allocated(InData%Acc)) then + call RegPackBounds(Buf, 2, lbound(InData%Acc), ubound(InData%Acc)) + call RegPack(Buf, InData%Acc) + end if + call RegPack(Buf, InData%PrescribedInterpIdx) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackMisc' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%F_stop)) deallocate(OutData%F_stop) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_stop(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_stop.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_stop) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_ext)) deallocate(OutData%F_ext) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_ext(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_ext.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_ext) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_fr)) deallocate(OutData%F_fr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_fr(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_fr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_fr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%K)) deallocate(OutData%K) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%K(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%K) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%C_ctrl)) deallocate(OutData%C_ctrl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C_ctrl(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_ctrl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C_ctrl) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%C_Brake)) deallocate(OutData%C_Brake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C_Brake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_Brake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C_Brake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_table)) deallocate(OutData%F_table) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_table(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_table.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_table) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_k)) deallocate(OutData%F_k) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_k(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_k.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_k) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%a_G)) deallocate(OutData%a_G) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%a_G(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%a_G.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%a_G) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rdisp_P)) deallocate(OutData%rdisp_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdisp_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdisp_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdisp_P) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rdot_P)) deallocate(OutData%rdot_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdot_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdot_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdot_P) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%rddot_P)) deallocate(OutData%rddot_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rddot_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rddot_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rddot_P) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%omega_P)) deallocate(OutData%omega_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%omega_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%omega_P) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%alpha_P)) deallocate(OutData%alpha_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_P) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_P)) deallocate(OutData%F_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_P) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%M_P)) deallocate(OutData%M_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M_P) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Acc)) deallocate(OutData%Acc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Acc(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Acc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Acc) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%PrescribedInterpIdx) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(StC_ParameterType), intent(in) :: SrcParamData + type(StC_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%RootName = SrcParamData%RootName + DstParamData%StC_DOF_MODE = SrcParamData%StC_DOF_MODE + DstParamData%StC_X_DOF = SrcParamData%StC_X_DOF + DstParamData%StC_Y_DOF = SrcParamData%StC_Y_DOF + DstParamData%StC_Z_DOF = SrcParamData%StC_Z_DOF + DstParamData%StC_Z_PreLd = SrcParamData%StC_Z_PreLd + DstParamData%M_X = SrcParamData%M_X + DstParamData%M_Y = SrcParamData%M_Y + DstParamData%M_Z = SrcParamData%M_Z + DstParamData%M_XY = SrcParamData%M_XY + DstParamData%K_X = SrcParamData%K_X + DstParamData%K_Y = SrcParamData%K_Y + DstParamData%K_Z = SrcParamData%K_Z + DstParamData%C_X = SrcParamData%C_X + DstParamData%C_Y = SrcParamData%C_Y + DstParamData%C_Z = SrcParamData%C_Z + DstParamData%K_S = SrcParamData%K_S + DstParamData%C_S = SrcParamData%C_S + DstParamData%P_SP = SrcParamData%P_SP + DstParamData%N_SP = SrcParamData%N_SP + DstParamData%Gravity = SrcParamData%Gravity + DstParamData%StC_CMODE = SrcParamData%StC_CMODE + DstParamData%StC_SA_MODE = SrcParamData%StC_SA_MODE + DstParamData%StC_X_C_HIGH = SrcParamData%StC_X_C_HIGH + DstParamData%StC_X_C_LOW = SrcParamData%StC_X_C_LOW + DstParamData%StC_Y_C_HIGH = SrcParamData%StC_Y_C_HIGH + DstParamData%StC_Y_C_LOW = SrcParamData%StC_Y_C_LOW + DstParamData%StC_Z_C_HIGH = SrcParamData%StC_Z_C_HIGH + DstParamData%StC_Z_C_LOW = SrcParamData%StC_Z_C_LOW + DstParamData%StC_X_C_BRAKE = SrcParamData%StC_X_C_BRAKE + DstParamData%StC_Y_C_BRAKE = SrcParamData%StC_Y_C_BRAKE + DstParamData%StC_Z_C_BRAKE = SrcParamData%StC_Z_C_BRAKE + DstParamData%L_X = SrcParamData%L_X + DstParamData%B_X = SrcParamData%B_X + DstParamData%area_X = SrcParamData%area_X + DstParamData%area_ratio_X = SrcParamData%area_ratio_X + DstParamData%headLossCoeff_X = SrcParamData%headLossCoeff_X + DstParamData%rho_X = SrcParamData%rho_X + DstParamData%L_Y = SrcParamData%L_Y + DstParamData%B_Y = SrcParamData%B_Y + DstParamData%area_Y = SrcParamData%area_Y + DstParamData%area_ratio_Y = SrcParamData%area_ratio_Y + DstParamData%headLossCoeff_Y = SrcParamData%headLossCoeff_Y + DstParamData%rho_Y = SrcParamData%rho_Y + DstParamData%Use_F_TBL = SrcParamData%Use_F_TBL + if (allocated(SrcParamData%F_TBL)) then + LB(1:2) = lbound(SrcParamData%F_TBL) + UB(1:2) = ubound(SrcParamData%F_TBL) + if (.not. allocated(DstParamData%F_TBL)) then + allocate(DstParamData%F_TBL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_TBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%F_TBL = SrcParamData%F_TBL + end if + DstParamData%NumMeshPts = SrcParamData%NumMeshPts + DstParamData%PrescribedForcesCoordSys = SrcParamData%PrescribedForcesCoordSys + if (allocated(SrcParamData%StC_PrescribedForce)) then + LB(1:2) = lbound(SrcParamData%StC_PrescribedForce) + UB(1:2) = ubound(SrcParamData%StC_PrescribedForce) + if (.not. allocated(DstParamData%StC_PrescribedForce)) then + allocate(DstParamData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StC_PrescribedForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StC_PrescribedForce = SrcParamData%StC_PrescribedForce + end if + if (allocated(SrcParamData%StC_CChan)) then + LB(1:1) = lbound(SrcParamData%StC_CChan) + UB(1:1) = ubound(SrcParamData%StC_CChan) + if (.not. allocated(DstParamData%StC_CChan)) then + allocate(DstParamData%StC_CChan(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StC_CChan.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StC_CChan = SrcParamData%StC_CChan + end if +end subroutine + +subroutine StC_DestroyParam(ParamData, ErrStat, ErrMsg) + type(StC_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%F_TBL)) then + deallocate(ParamData%F_TBL) + end if + if (allocated(ParamData%StC_PrescribedForce)) then + deallocate(ParamData%StC_PrescribedForce) + end if + if (allocated(ParamData%StC_CChan)) then + deallocate(ParamData%StC_CChan) + end if +end subroutine + +subroutine StC_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%StC_DOF_MODE) + call RegPack(Buf, InData%StC_X_DOF) + call RegPack(Buf, InData%StC_Y_DOF) + call RegPack(Buf, InData%StC_Z_DOF) + call RegPack(Buf, InData%StC_Z_PreLd) + call RegPack(Buf, InData%M_X) + call RegPack(Buf, InData%M_Y) + call RegPack(Buf, InData%M_Z) + call RegPack(Buf, InData%M_XY) + call RegPack(Buf, InData%K_X) + call RegPack(Buf, InData%K_Y) + call RegPack(Buf, InData%K_Z) + call RegPack(Buf, InData%C_X) + call RegPack(Buf, InData%C_Y) + call RegPack(Buf, InData%C_Z) + call RegPack(Buf, InData%K_S) + call RegPack(Buf, InData%C_S) + call RegPack(Buf, InData%P_SP) + call RegPack(Buf, InData%N_SP) + call RegPack(Buf, InData%Gravity) + call RegPack(Buf, InData%StC_CMODE) + call RegPack(Buf, InData%StC_SA_MODE) + call RegPack(Buf, InData%StC_X_C_HIGH) + call RegPack(Buf, InData%StC_X_C_LOW) + call RegPack(Buf, InData%StC_Y_C_HIGH) + call RegPack(Buf, InData%StC_Y_C_LOW) + call RegPack(Buf, InData%StC_Z_C_HIGH) + call RegPack(Buf, InData%StC_Z_C_LOW) + call RegPack(Buf, InData%StC_X_C_BRAKE) + call RegPack(Buf, InData%StC_Y_C_BRAKE) + call RegPack(Buf, InData%StC_Z_C_BRAKE) + call RegPack(Buf, InData%L_X) + call RegPack(Buf, InData%B_X) + call RegPack(Buf, InData%area_X) + call RegPack(Buf, InData%area_ratio_X) + call RegPack(Buf, InData%headLossCoeff_X) + call RegPack(Buf, InData%rho_X) + call RegPack(Buf, InData%L_Y) + call RegPack(Buf, InData%B_Y) + call RegPack(Buf, InData%area_Y) + call RegPack(Buf, InData%area_ratio_Y) + call RegPack(Buf, InData%headLossCoeff_Y) + call RegPack(Buf, InData%rho_Y) + call RegPack(Buf, InData%Use_F_TBL) + call RegPack(Buf, allocated(InData%F_TBL)) + if (allocated(InData%F_TBL)) then + call RegPackBounds(Buf, 2, lbound(InData%F_TBL), ubound(InData%F_TBL)) + call RegPack(Buf, InData%F_TBL) + end if + call RegPack(Buf, InData%NumMeshPts) + call RegPack(Buf, InData%PrescribedForcesCoordSys) + call RegPack(Buf, allocated(InData%StC_PrescribedForce)) + if (allocated(InData%StC_PrescribedForce)) then + call RegPackBounds(Buf, 2, lbound(InData%StC_PrescribedForce), ubound(InData%StC_PrescribedForce)) + call RegPack(Buf, InData%StC_PrescribedForce) + end if + call RegPack(Buf, allocated(InData%StC_CChan)) + if (allocated(InData%StC_CChan)) then + call RegPackBounds(Buf, 1, lbound(InData%StC_CChan), ubound(InData%StC_CChan)) + call RegPack(Buf, InData%StC_CChan) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_DOF_MODE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_DOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_DOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_DOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_PreLd) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%M_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%M_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%M_Z) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%M_XY) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%K_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%K_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%K_Z) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_Z) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%K_S) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_S) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%P_SP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%N_SP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_CMODE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_SA_MODE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_X_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Y_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%StC_Z_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%L_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%B_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%area_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%area_ratio_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%headLossCoeff_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rho_X) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%L_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%B_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%area_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%area_ratio_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%headLossCoeff_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%rho_Y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Use_F_TBL) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%F_TBL)) deallocate(OutData%F_TBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_TBL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_TBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NumMeshPts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%PrescribedForcesCoordSys) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%StC_PrescribedForce)) deallocate(OutData%StC_PrescribedForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_PrescribedForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StC_PrescribedForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StC_CChan)) deallocate(OutData%StC_CChan) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StC_CChan(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_CChan.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StC_CChan) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(StC_InputType), intent(inout) :: SrcInputData + type(StC_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%Mesh)) then + LB(1:1) = lbound(SrcInputData%Mesh) + UB(1:1) = ubound(SrcInputData%Mesh) + if (.not. allocated(DstInputData%Mesh)) then + allocate(DstInputData%Mesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Mesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%Mesh(i1), DstInputData%Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%CmdStiff)) then + LB(1:2) = lbound(SrcInputData%CmdStiff) + UB(1:2) = ubound(SrcInputData%CmdStiff) + if (.not. allocated(DstInputData%CmdStiff)) then + allocate(DstInputData%CmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CmdStiff = SrcInputData%CmdStiff + end if + if (allocated(SrcInputData%CmdDamp)) then + LB(1:2) = lbound(SrcInputData%CmdDamp) + UB(1:2) = ubound(SrcInputData%CmdDamp) + if (.not. allocated(DstInputData%CmdDamp)) then + allocate(DstInputData%CmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CmdDamp = SrcInputData%CmdDamp + end if + if (allocated(SrcInputData%CmdBrake)) then + LB(1:2) = lbound(SrcInputData%CmdBrake) + UB(1:2) = ubound(SrcInputData%CmdBrake) + if (.not. allocated(DstInputData%CmdBrake)) then + allocate(DstInputData%CmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdBrake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CmdBrake = SrcInputData%CmdBrake + end if + if (allocated(SrcInputData%CmdForce)) then + LB(1:2) = lbound(SrcInputData%CmdForce) + UB(1:2) = ubound(SrcInputData%CmdForce) + if (.not. allocated(DstInputData%CmdForce)) then + allocate(DstInputData%CmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CmdForce = SrcInputData%CmdForce + end if +end subroutine + +subroutine StC_DestroyInput(InputData, ErrStat, ErrMsg) + type(StC_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%Mesh)) then + LB(1:1) = lbound(InputData%Mesh) + UB(1:1) = ubound(InputData%Mesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%Mesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%Mesh) + end if + if (allocated(InputData%CmdStiff)) then + deallocate(InputData%CmdStiff) + end if + if (allocated(InputData%CmdDamp)) then + deallocate(InputData%CmdDamp) + end if + if (allocated(InputData%CmdBrake)) then + deallocate(InputData%CmdBrake) + end if + if (allocated(InputData%CmdForce)) then + deallocate(InputData%CmdForce) + end if +end subroutine + +subroutine StC_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Mesh)) + if (allocated(InData%Mesh)) then + call RegPackBounds(Buf, 1, lbound(InData%Mesh), ubound(InData%Mesh)) + LB(1:1) = lbound(InData%Mesh) + UB(1:1) = ubound(InData%Mesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%Mesh(i1)) + end do + end if + call RegPack(Buf, allocated(InData%CmdStiff)) + if (allocated(InData%CmdStiff)) then + call RegPackBounds(Buf, 2, lbound(InData%CmdStiff), ubound(InData%CmdStiff)) + call RegPack(Buf, InData%CmdStiff) + end if + call RegPack(Buf, allocated(InData%CmdDamp)) + if (allocated(InData%CmdDamp)) then + call RegPackBounds(Buf, 2, lbound(InData%CmdDamp), ubound(InData%CmdDamp)) + call RegPack(Buf, InData%CmdDamp) + end if + call RegPack(Buf, allocated(InData%CmdBrake)) + if (allocated(InData%CmdBrake)) then + call RegPackBounds(Buf, 2, lbound(InData%CmdBrake), ubound(InData%CmdBrake)) + call RegPack(Buf, InData%CmdBrake) + end if + call RegPack(Buf, allocated(InData%CmdForce)) + if (allocated(InData%CmdForce)) then + call RegPackBounds(Buf, 2, lbound(InData%CmdForce), ubound(InData%CmdForce)) + call RegPack(Buf, InData%CmdForce) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Mesh)) deallocate(OutData%Mesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%Mesh(i1)) ! Mesh + end do + end if + if (allocated(OutData%CmdStiff)) deallocate(OutData%CmdStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CmdStiff(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CmdStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CmdDamp)) deallocate(OutData%CmdDamp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CmdDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CmdDamp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CmdBrake)) deallocate(OutData%CmdBrake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CmdBrake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdBrake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CmdBrake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CmdForce)) deallocate(OutData%CmdForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CmdForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CmdForce) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(StC_OutputType), intent(inout) :: SrcOutputData + type(StC_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%Mesh)) then + LB(1:1) = lbound(SrcOutputData%Mesh) + UB(1:1) = ubound(SrcOutputData%Mesh) + if (.not. allocated(DstOutputData%Mesh)) then + allocate(DstOutputData%Mesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Mesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%Mesh(i1), DstOutputData%Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%MeasDisp)) then + LB(1:2) = lbound(SrcOutputData%MeasDisp) + UB(1:2) = ubound(SrcOutputData%MeasDisp) + if (.not. allocated(DstOutputData%MeasDisp)) then + allocate(DstOutputData%MeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MeasDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%MeasDisp = SrcOutputData%MeasDisp + end if + if (allocated(SrcOutputData%MeasVel)) then + LB(1:2) = lbound(SrcOutputData%MeasVel) + UB(1:2) = ubound(SrcOutputData%MeasVel) + if (.not. allocated(DstOutputData%MeasVel)) then + allocate(DstOutputData%MeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MeasVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%MeasVel = SrcOutputData%MeasVel + end if +end subroutine + +subroutine StC_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(StC_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%Mesh)) then + LB(1:1) = lbound(OutputData%Mesh) + UB(1:1) = ubound(OutputData%Mesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%Mesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%Mesh) + end if + if (allocated(OutputData%MeasDisp)) then + deallocate(OutputData%MeasDisp) + end if + if (allocated(OutputData%MeasVel)) then + deallocate(OutputData%MeasVel) + end if +end subroutine + +subroutine StC_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackOutput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Mesh)) + if (allocated(InData%Mesh)) then + call RegPackBounds(Buf, 1, lbound(InData%Mesh), ubound(InData%Mesh)) + LB(1:1) = lbound(InData%Mesh) + UB(1:1) = ubound(InData%Mesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%Mesh(i1)) + end do + end if + call RegPack(Buf, allocated(InData%MeasDisp)) + if (allocated(InData%MeasDisp)) then + call RegPackBounds(Buf, 2, lbound(InData%MeasDisp), ubound(InData%MeasDisp)) + call RegPack(Buf, InData%MeasDisp) + end if + call RegPack(Buf, allocated(InData%MeasVel)) + if (allocated(InData%MeasVel)) then + call RegPackBounds(Buf, 2, lbound(InData%MeasVel), ubound(InData%MeasVel)) + call RegPack(Buf, InData%MeasVel) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackOutput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Mesh)) deallocate(OutData%Mesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%Mesh(i1)) ! Mesh + end do + end if + if (allocated(OutData%MeasDisp)) deallocate(OutData%MeasDisp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MeasDisp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeasDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MeasDisp) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MeasVel)) deallocate(OutData%MeasVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MeasVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeasVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MeasVel) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine StC_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(StC_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(StC_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 = 'StC_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 StC_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL StC_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 StC_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 StC_Input_ExtrapInterp - - - SUBROUTINE StC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'StC_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call StC_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call StC_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call StC_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE StC_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. @@ -5808,81 +2824,62 @@ SUBROUTINE StC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(StC_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(StC_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(StC_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 + TYPE(StC_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(StC_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(StC_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 = 'StC_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 - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'StC_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN - DO i1 = LBOUND(u_out%Mesh,1),UBOUND(u_out%Mesh,1) - CALL MeshExtrapInterp1(u1%Mesh(i1), u2%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdStiff) .AND. ALLOCATED(u1%CmdStiff)) THEN - DO i2 = LBOUND(u_out%CmdStiff,2),UBOUND(u_out%CmdStiff,2) - DO i1 = LBOUND(u_out%CmdStiff,1),UBOUND(u_out%CmdStiff,1) - b = -(u1%CmdStiff(i1,i2) - u2%CmdStiff(i1,i2)) - u_out%CmdStiff(i1,i2) = u1%CmdStiff(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdDamp) .AND. ALLOCATED(u1%CmdDamp)) THEN - DO i2 = LBOUND(u_out%CmdDamp,2),UBOUND(u_out%CmdDamp,2) - DO i1 = LBOUND(u_out%CmdDamp,1),UBOUND(u_out%CmdDamp,1) - b = -(u1%CmdDamp(i1,i2) - u2%CmdDamp(i1,i2)) - u_out%CmdDamp(i1,i2) = u1%CmdDamp(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdBrake) .AND. ALLOCATED(u1%CmdBrake)) THEN - DO i2 = LBOUND(u_out%CmdBrake,2),UBOUND(u_out%CmdBrake,2) - DO i1 = LBOUND(u_out%CmdBrake,1),UBOUND(u_out%CmdBrake,1) - b = -(u1%CmdBrake(i1,i2) - u2%CmdBrake(i1,i2)) - u_out%CmdBrake(i1,i2) = u1%CmdBrake(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN - DO i2 = LBOUND(u_out%CmdForce,2),UBOUND(u_out%CmdForce,2) - DO i1 = LBOUND(u_out%CmdForce,1),UBOUND(u_out%CmdForce,1) - b = -(u1%CmdForce(i1,i2) - u2%CmdForce(i1,i2)) - u_out%CmdForce(i1,i2) = u1%CmdForce(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE StC_Input_ExtrapInterp1 - - - SUBROUTINE StC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN + DO i1 = LBOUND(u_out%Mesh,1),UBOUND(u_out%Mesh,1) + CALL MeshExtrapInterp1(u1%Mesh(i1), u2%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdStiff) .AND. ALLOCATED(u1%CmdStiff)) THEN + u_out%CmdStiff = a1*u1%CmdStiff + a2*u2%CmdStiff + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdDamp) .AND. ALLOCATED(u1%CmdDamp)) THEN + u_out%CmdDamp = a1*u1%CmdDamp + a2*u2%CmdDamp + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdBrake) .AND. ALLOCATED(u1%CmdBrake)) THEN + u_out%CmdBrake = a1*u1%CmdBrake + a2*u2%CmdBrake + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN + u_out%CmdForce = a1*u1%CmdForce + a2*u2%CmdForce + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE StC_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. @@ -5896,145 +2893,122 @@ SUBROUTINE StC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(StC_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(StC_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(StC_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(StC_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 + TYPE(StC_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(StC_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(StC_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(StC_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 = 'StC_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'StC_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN - DO i1 = LBOUND(u_out%Mesh,1),UBOUND(u_out%Mesh,1) - CALL MeshExtrapInterp2(u1%Mesh(i1), u2%Mesh(i1), u3%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdStiff) .AND. ALLOCATED(u1%CmdStiff)) THEN - DO i2 = LBOUND(u_out%CmdStiff,2),UBOUND(u_out%CmdStiff,2) - DO i1 = LBOUND(u_out%CmdStiff,1),UBOUND(u_out%CmdStiff,1) - b = (t(3)**2*(u1%CmdStiff(i1,i2) - u2%CmdStiff(i1,i2)) + t(2)**2*(-u1%CmdStiff(i1,i2) + u3%CmdStiff(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%CmdStiff(i1,i2) + t(3)*u2%CmdStiff(i1,i2) - t(2)*u3%CmdStiff(i1,i2) ) * scaleFactor - u_out%CmdStiff(i1,i2) = u1%CmdStiff(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdDamp) .AND. ALLOCATED(u1%CmdDamp)) THEN - DO i2 = LBOUND(u_out%CmdDamp,2),UBOUND(u_out%CmdDamp,2) - DO i1 = LBOUND(u_out%CmdDamp,1),UBOUND(u_out%CmdDamp,1) - b = (t(3)**2*(u1%CmdDamp(i1,i2) - u2%CmdDamp(i1,i2)) + t(2)**2*(-u1%CmdDamp(i1,i2) + u3%CmdDamp(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%CmdDamp(i1,i2) + t(3)*u2%CmdDamp(i1,i2) - t(2)*u3%CmdDamp(i1,i2) ) * scaleFactor - u_out%CmdDamp(i1,i2) = u1%CmdDamp(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdBrake) .AND. ALLOCATED(u1%CmdBrake)) THEN - DO i2 = LBOUND(u_out%CmdBrake,2),UBOUND(u_out%CmdBrake,2) - DO i1 = LBOUND(u_out%CmdBrake,1),UBOUND(u_out%CmdBrake,1) - b = (t(3)**2*(u1%CmdBrake(i1,i2) - u2%CmdBrake(i1,i2)) + t(2)**2*(-u1%CmdBrake(i1,i2) + u3%CmdBrake(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%CmdBrake(i1,i2) + t(3)*u2%CmdBrake(i1,i2) - t(2)*u3%CmdBrake(i1,i2) ) * scaleFactor - u_out%CmdBrake(i1,i2) = u1%CmdBrake(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN - DO i2 = LBOUND(u_out%CmdForce,2),UBOUND(u_out%CmdForce,2) - DO i1 = LBOUND(u_out%CmdForce,1),UBOUND(u_out%CmdForce,1) - b = (t(3)**2*(u1%CmdForce(i1,i2) - u2%CmdForce(i1,i2)) + t(2)**2*(-u1%CmdForce(i1,i2) + u3%CmdForce(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%CmdForce(i1,i2) + t(3)*u2%CmdForce(i1,i2) - t(2)*u3%CmdForce(i1,i2) ) * scaleFactor - u_out%CmdForce(i1,i2) = u1%CmdForce(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE StC_Input_ExtrapInterp2 - - - SUBROUTINE StC_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(StC_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(StC_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN + DO i1 = LBOUND(u_out%Mesh,1),UBOUND(u_out%Mesh,1) + CALL MeshExtrapInterp2(u1%Mesh(i1), u2%Mesh(i1), u3%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdStiff) .AND. ALLOCATED(u1%CmdStiff)) THEN + u_out%CmdStiff = a1*u1%CmdStiff + a2*u2%CmdStiff + a3*u3%CmdStiff + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdDamp) .AND. ALLOCATED(u1%CmdDamp)) THEN + u_out%CmdDamp = a1*u1%CmdDamp + a2*u2%CmdDamp + a3*u3%CmdDamp + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdBrake) .AND. ALLOCATED(u1%CmdBrake)) THEN + u_out%CmdBrake = a1*u1%CmdBrake + a2*u2%CmdBrake + a3*u3%CmdBrake + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN + u_out%CmdForce = a1*u1%CmdForce + a2*u2%CmdForce + a3*u3%CmdForce + END IF ! check if allocated +END SUBROUTINE + +subroutine StC_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(StC_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(StC_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 = 'StC_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 StC_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL StC_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 StC_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 StC_Output_ExtrapInterp - - - SUBROUTINE StC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'StC_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call StC_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call StC_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call StC_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE StC_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. @@ -6046,65 +3020,56 @@ SUBROUTINE StC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(StC_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(StC_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(StC_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 + TYPE(StC_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(StC_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(StC_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 = 'StC_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'StC_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN - DO i1 = LBOUND(y_out%Mesh,1),UBOUND(y_out%Mesh,1) - CALL MeshExtrapInterp1(y1%Mesh(i1), y2%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%MeasDisp) .AND. ALLOCATED(y1%MeasDisp)) THEN - DO i2 = LBOUND(y_out%MeasDisp,2),UBOUND(y_out%MeasDisp,2) - DO i1 = LBOUND(y_out%MeasDisp,1),UBOUND(y_out%MeasDisp,1) - b = -(y1%MeasDisp(i1,i2) - y2%MeasDisp(i1,i2)) - y_out%MeasDisp(i1,i2) = y1%MeasDisp(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MeasVel) .AND. ALLOCATED(y1%MeasVel)) THEN - DO i2 = LBOUND(y_out%MeasVel,2),UBOUND(y_out%MeasVel,2) - DO i1 = LBOUND(y_out%MeasVel,1),UBOUND(y_out%MeasVel,1) - b = -(y1%MeasVel(i1,i2) - y2%MeasVel(i1,i2)) - y_out%MeasVel(i1,i2) = y1%MeasVel(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE StC_Output_ExtrapInterp1 - - - SUBROUTINE StC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN + DO i1 = LBOUND(y_out%Mesh,1),UBOUND(y_out%Mesh,1) + CALL MeshExtrapInterp1(y1%Mesh(i1), y2%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%MeasDisp) .AND. ALLOCATED(y1%MeasDisp)) THEN + y_out%MeasDisp = a1*y1%MeasDisp + a2*y2%MeasDisp + END IF ! check if allocated + IF (ALLOCATED(y_out%MeasVel) .AND. ALLOCATED(y1%MeasVel)) THEN + y_out%MeasVel = a1*y1%MeasVel + a2*y2%MeasVel + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE StC_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. @@ -6118,73 +3083,61 @@ SUBROUTINE StC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(StC_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(StC_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(StC_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(StC_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 + TYPE(StC_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(StC_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(StC_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(StC_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 = 'StC_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'StC_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN - DO i1 = LBOUND(y_out%Mesh,1),UBOUND(y_out%Mesh,1) - CALL MeshExtrapInterp2(y1%Mesh(i1), y2%Mesh(i1), y3%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%MeasDisp) .AND. ALLOCATED(y1%MeasDisp)) THEN - DO i2 = LBOUND(y_out%MeasDisp,2),UBOUND(y_out%MeasDisp,2) - DO i1 = LBOUND(y_out%MeasDisp,1),UBOUND(y_out%MeasDisp,1) - b = (t(3)**2*(y1%MeasDisp(i1,i2) - y2%MeasDisp(i1,i2)) + t(2)**2*(-y1%MeasDisp(i1,i2) + y3%MeasDisp(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%MeasDisp(i1,i2) + t(3)*y2%MeasDisp(i1,i2) - t(2)*y3%MeasDisp(i1,i2) ) * scaleFactor - y_out%MeasDisp(i1,i2) = y1%MeasDisp(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MeasVel) .AND. ALLOCATED(y1%MeasVel)) THEN - DO i2 = LBOUND(y_out%MeasVel,2),UBOUND(y_out%MeasVel,2) - DO i1 = LBOUND(y_out%MeasVel,1),UBOUND(y_out%MeasVel,1) - b = (t(3)**2*(y1%MeasVel(i1,i2) - y2%MeasVel(i1,i2)) + t(2)**2*(-y1%MeasVel(i1,i2) + y3%MeasVel(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%MeasVel(i1,i2) + t(3)*y2%MeasVel(i1,i2) - t(2)*y3%MeasVel(i1,i2) ) * scaleFactor - y_out%MeasVel(i1,i2) = y1%MeasVel(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE StC_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN + DO i1 = LBOUND(y_out%Mesh,1),UBOUND(y_out%Mesh,1) + CALL MeshExtrapInterp2(y1%Mesh(i1), y2%Mesh(i1), y3%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%MeasDisp) .AND. ALLOCATED(y1%MeasDisp)) THEN + y_out%MeasDisp = a1*y1%MeasDisp + a2*y2%MeasDisp + a3*y3%MeasDisp + END IF ! check if allocated + IF (ALLOCATED(y_out%MeasVel) .AND. ALLOCATED(y1%MeasVel)) THEN + y_out%MeasVel = a1*y1%MeasVel + a2*y2%MeasVel + a3*y3%MeasVel + END IF ! check if allocated +END SUBROUTINE END MODULE StrucCtrl_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index c57f414fd8..96a79aae0c 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -40,8 +40,8 @@ MODULE SubDyn_Types ! ======================= ! ========= MeshAuxDataType ======= TYPE, PUBLIC :: MeshAuxDataType - INTEGER(IntKi) :: MemberID !< Member ID for Output [-] - INTEGER(IntKi) :: NOutCnt !< Number of Nodes for the output member [-] + INTEGER(IntKi) :: MemberID = 0_IntKi !< Member ID for Output [-] + INTEGER(IntKi) :: NOutCnt = 0_IntKi !< Number of Nodes for the output member [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeCnt !< Node ordinal numbers for the output member [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeIDs !< Node IDs associated with ordinal numbers for the output member [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ElmIDs !< Element IDs connected to each NodeIDs; max 10 elements [-] @@ -63,31 +63,31 @@ MODULE SubDyn_Types ! ======================= ! ========= ElemPropType ======= TYPE, PUBLIC :: ElemPropType - INTEGER(IntKi) :: eType !< Element Type [-] - REAL(ReKi) :: Length !< Length of an element [-] - REAL(ReKi) :: Ixx !< Moment of inertia of an element [-] - REAL(ReKi) :: Iyy !< Moment of inertia of an element [-] - REAL(ReKi) :: Jzz !< Moment of inertia of an element [-] - LOGICAL :: Shear !< Use timoshenko (true) E-B (false) [-] - REAL(ReKi) :: Kappa_x !< Shear coefficient [-] - REAL(ReKi) :: Kappa_y !< Shear coefficient [-] - REAL(ReKi) :: YoungE !< Young's modulus [-] - REAL(ReKi) :: ShearG !< Shear modulus [N/m^2] - REAL(ReKi) , DIMENSION(1:2) :: D !< Diameter at node 1 and 2, for visualization only [m] - REAL(ReKi) :: Area !< Area of an element [m^2] - REAL(ReKi) :: Rho !< Density [kg/m^3] - REAL(ReKi) :: T0 !< Pretension [N] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: DirCos !< Element direction cosine matrix [-] + INTEGER(IntKi) :: eType = 0_IntKi !< Element Type [-] + REAL(ReKi) :: Length = 0.0_ReKi !< Length of an element [-] + REAL(ReKi) :: Ixx = 0.0_ReKi !< Moment of inertia of an element [-] + REAL(ReKi) :: Iyy = 0.0_ReKi !< Moment of inertia of an element [-] + REAL(ReKi) :: Jzz = 0.0_ReKi !< Moment of inertia of an element [-] + LOGICAL :: Shear = .false. !< Use timoshenko (true) E-B (false) [-] + REAL(ReKi) :: Kappa_x = 0.0_ReKi !< Shear coefficient [-] + REAL(ReKi) :: Kappa_y = 0.0_ReKi !< Shear coefficient [-] + REAL(ReKi) :: YoungE = 0.0_ReKi !< Young's modulus [-] + REAL(ReKi) :: ShearG = 0.0_ReKi !< Shear modulus [N/m^2] + REAL(ReKi) , DIMENSION(1:2) :: D = 0.0_ReKi !< Diameter at node 1 and 2, for visualization only [m] + REAL(ReKi) :: Area = 0.0_ReKi !< Area of an element [m^2] + REAL(ReKi) :: Rho = 0.0_ReKi !< Density [kg/m^3] + REAL(ReKi) :: T0 = 0.0_ReKi !< Pretension [N] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: DirCos = 0.0_R8Ki !< Element direction cosine matrix [-] END TYPE ElemPropType ! ======================= ! ========= SD_InitInputType ======= TYPE, PUBLIC :: SD_InitInputType CHARACTER(1024) :: SDInputFile !< Name of the input file [-] CHARACTER(1024) :: RootName !< SubDyn rootname [-] - REAL(ReKi) :: g !< Gravity acceleration [-] - REAL(ReKi) :: WtrDpth !< Water Depth (positive valued) [-] - REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] - REAL(ReKi) :: SubRotateZ !< Rotation angle in degrees about global Z [-] + REAL(ReKi) :: g = 0.0_ReKi !< Gravity acceleration [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water Depth (positive valued) [-] + REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint = 0.0_ReKi !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] + REAL(ReKi) :: SubRotateZ = 0.0_ReKi !< Rotation angle in degrees about global Z [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SoilStiffness !< Soil stiffness matrices from SoilDyn ['(N/m,] TYPE(MeshType) :: SoilMesh !< Mesh for soil stiffness locations [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] @@ -112,20 +112,20 @@ MODULE SubDyn_Types ! ========= SD_InitType ======= TYPE, PUBLIC :: SD_InitType CHARACTER(1024) :: RootName !< SubDyn rootname [-] - REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] - REAL(ReKi) :: SubRotateZ !< Rotation angle in degrees about global Z [-] - REAL(ReKi) :: g !< Gravity acceleration [-] - REAL(DbKi) :: DT !< Time step from Glue Code [seconds] - INTEGER(IntKi) :: NJoints !< Number of joints of the sub structure [-] - INTEGER(IntKi) :: NPropSetsX !< Number of extended property sets [-] - INTEGER(IntKi) :: NPropSetsB !< Number of property sets for beams [-] - INTEGER(IntKi) :: NPropSetsC !< Number of property sets for cables [-] - INTEGER(IntKi) :: NPropSetsR !< Number of property sets for rigid links [-] - INTEGER(IntKi) :: NCMass !< Number of joints with concentrated mass [-] - INTEGER(IntKi) :: NCOSMs !< Number of independent cosine matrices [-] - INTEGER(IntKi) :: FEMMod !< FEM switch element model in the FEM [-] - INTEGER(IntKi) :: NDiv !< Number of divisions for each member [-] - LOGICAL :: CBMod !< Perform C-B flag [-] + REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint = 0.0_ReKi !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] + REAL(ReKi) :: SubRotateZ = 0.0_ReKi !< Rotation angle in degrees about global Z [-] + REAL(ReKi) :: g = 0.0_ReKi !< Gravity acceleration [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step from Glue Code [seconds] + INTEGER(IntKi) :: NJoints = 0_IntKi !< Number of joints of the sub structure [-] + INTEGER(IntKi) :: NPropSetsX = 0_IntKi !< Number of extended property sets [-] + INTEGER(IntKi) :: NPropSetsB = 0_IntKi !< Number of property sets for beams [-] + INTEGER(IntKi) :: NPropSetsC = 0_IntKi !< Number of property sets for cables [-] + INTEGER(IntKi) :: NPropSetsR = 0_IntKi !< Number of property sets for rigid links [-] + INTEGER(IntKi) :: NCMass = 0_IntKi !< Number of joints with concentrated mass [-] + INTEGER(IntKi) :: NCOSMs = 0_IntKi !< Number of independent cosine matrices [-] + INTEGER(IntKi) :: FEMMod = 0_IntKi !< FEM switch element model in the FEM [-] + INTEGER(IntKi) :: NDiv = 0_IntKi !< Number of divisions for each member [-] + LOGICAL :: CBMod = .false. !< Perform C-B flag [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Joints !< Joints number and coordinate values [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsB !< Property sets number and values [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsC !< Property ID and values for cables [-] @@ -134,23 +134,23 @@ MODULE SubDyn_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: COSMs !< Independent direction cosine matrices [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CMass !< Concentrated mass information [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: JDampings !< Damping coefficients for internal modes [-] - INTEGER(IntKi) :: GuyanDampMod !< Guyan damping [0=none, 1=Rayleigh Damping, 2= user specified 6x6 matrix] [-] - REAL(ReKi) , DIMENSION(1:2) :: RayleighDamp !< Mass and stiffness proportional damping coefficients (Rayleigh Damping) [only if GuyanDampMod=1] [-] - REAL(ReKi) , DIMENSION(1:6,1:6) :: GuyanDampMat !< Guyan Damping Matrix, see also CBB [-] + INTEGER(IntKi) :: GuyanDampMod = 0_IntKi !< Guyan damping [0=none, 1=Rayleigh Damping, 2= user specified 6x6 matrix] [-] + REAL(ReKi) , DIMENSION(1:2) :: RayleighDamp = 0.0_ReKi !< Mass and stiffness proportional damping coefficients (Rayleigh Damping) [only if GuyanDampMod=1] [-] + REAL(ReKi) , DIMENSION(1:6,1:6) :: GuyanDampMat = 0.0_ReKi !< Guyan Damping Matrix, see also CBB [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Members !< Member joints connection [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: SSOutList !< List of Output Channels [-] - LOGICAL :: OutCOSM !< Output Cos-matrices Flag [-] - LOGICAL :: TabDelim !< Generate a tab-delimited output file in OutJckF-Flag [-] + LOGICAL :: OutCOSM = .false. !< Output Cos-matrices Flag [-] + LOGICAL :: TabDelim = .false. !< Generate a tab-delimited output file in OutJckF-Flag [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: SSIK !< SSI stiffness packed matrix elements (21 of them), for each reaction joint [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: SSIM !< SSI mass packed matrix elements (21 of them), for each reaction joint [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: SSIfile !< Soil Structure Interaction (SSI) files to associate with each reaction node [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Soil_K !< Soil stiffness (at passed at Init, not in input file) 6x6xn [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Soil_Points !< Node positions where soil stiffness will be added [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: Soil_Nodes !< Node indices where soil stiffness will be added [-] - INTEGER(IntKi) :: NElem !< Total number of elements [-] - INTEGER(IntKi) :: NPropB !< Total number of property sets for Beams [-] - INTEGER(IntKi) :: NPropC !< Total number of property sets for Cable [-] - INTEGER(IntKi) :: NPropR !< Total number of property sets for Rigid [-] + INTEGER(IntKi) :: NElem = 0_IntKi !< Total number of elements [-] + INTEGER(IntKi) :: NPropB = 0_IntKi !< Total number of property sets for Beams [-] + INTEGER(IntKi) :: NPropC = 0_IntKi !< Total number of property sets for Cable [-] + INTEGER(IntKi) :: NPropR = 0_IntKi !< Total number of property sets for Rigid [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes !< Nodes number and coordinates [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsB !< Property sets and values for Beams [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsC !< Property sets and values for Cable [-] @@ -161,7 +161,7 @@ MODULE SubDyn_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: MemberNodes !< Member number and list of nodes making up a member (>2 if subdivided) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: NodesConnN !< Nodes that connect to a common node [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: NodesConnE !< Elements that connect to a common node [-] - LOGICAL :: SSSum !< SubDyn Summary File Flag [-] + LOGICAL :: SSSum = .false. !< SubDyn Summary File Flag [-] END TYPE SD_InitType ! ======================= ! ========= SD_ContinuousStateType ======= @@ -172,26 +172,26 @@ MODULE SubDyn_Types ! ======================= ! ========= SD_DiscreteStateType ======= TYPE, PUBLIC :: SD_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE SD_DiscreteStateType ! ======================= ! ========= SD_ConstraintStateType ======= TYPE, PUBLIC :: SD_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE SD_ConstraintStateType ! ======================= ! ========= SD_OtherStateType ======= TYPE, PUBLIC :: SD_OtherStateType TYPE(SD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: xdot !< previous state derivs for m-step time integrator [-] - INTEGER(IntKi) :: n !< tracks time step for which OtherState was updated last [-] + INTEGER(IntKi) :: n = 0_IntKi !< tracks time step for which OtherState was updated last [-] END TYPE SD_OtherStateType ! ======================= ! ========= SD_MiscVarType ======= TYPE, PUBLIC :: SD_MiscVarType REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: qmdotdot !< 2nd Derivative of states, used only for output-file purposes [-] - REAL(ReKi) , DIMENSION(1:6) :: u_TP - REAL(ReKi) , DIMENSION(1:6) :: udot_TP - REAL(ReKi) , DIMENSION(1:6) :: udotdot_TP + REAL(ReKi) , DIMENSION(1:6) :: u_TP = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: udot_TP = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: udotdot_TP = 0.0_ReKi REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L !< Loads on internal DOF, size nL [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L2 !< Loads on internal DOF, size nL, used for SIM and ADM4 [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar @@ -211,8 +211,8 @@ MODULE SubDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FC_unit !< Cable Force vector (for varying cable load, of unit cable load) [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SDWrOutput !< Data from previous step to be written to a SubDyn output file [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< Data for output file [-] - REAL(DbKi) :: LastOutTime !< The time of the most recent stored output data [s] - INTEGER(IntKi) :: Decimat !< Current output decimation counter [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< The time of the most recent stored output data [s] + INTEGER(IntKi) :: Decimat = 0_IntKi !< Current output decimation counter [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext !< External loads on unconstrained DOFs [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext_red !< External loads on constrained DOFs, Fext_red= T^t Fext [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_SIM !< UL for SIM = PhiL qL0- PhiM qm0, size nL [-] @@ -221,17 +221,17 @@ MODULE SubDyn_Types ! ======================= ! ========= SD_ParameterType ======= TYPE, PUBLIC :: SD_ParameterType - REAL(DbKi) :: SDDeltaT !< Time step (for integration of continuous states) [seconds] - INTEGER(IntKi) :: IntMethod !< Integration Method (1/2/3)Length of y2 array [-] - INTEGER(IntKi) :: nDOF !< Total degree of freedom [-] - INTEGER(IntKi) :: nDOF_red !< Total degree of freedom after constraint reduction [-] - INTEGER(IntKi) :: Nmembers !< Number of members of the sub structure [-] + REAL(DbKi) :: SDDeltaT = 0.0_R8Ki !< Time step (for integration of continuous states) [seconds] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1/2/3)Length of y2 array [-] + INTEGER(IntKi) :: nDOF = 0_IntKi !< Total degree of freedom [-] + INTEGER(IntKi) :: nDOF_red = 0_IntKi !< Total degree of freedom after constraint reduction [-] + INTEGER(IntKi) :: Nmembers = 0_IntKi !< Number of members of the sub structure [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Elems !< Element nodes connections [-] TYPE(ElemPropType) , DIMENSION(:), ALLOCATABLE :: ElemProps !< List of element properties [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector (with initial cable force T0), not reduced [N] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DP0 !< Vector from TP to a Node at t=0, used for Floating Rigid Body motion [m] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeID2JointID !< Store Joint ID for each NodeID since SubDyn re-label nodes (and add more nodes) [-] - LOGICAL :: reduced !< True if system has been reduced to account for constraints [-] + LOGICAL :: reduced = .false. !< True if system has been reduced to account for constraints [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T_red !< Transformation matrix performing the constraint reduction x = T. xtilde [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T_red_T !< Transpose of T_red [-] TYPE(IList) , DIMENSION(:), ALLOCATABLE :: NodesDOF !< DOF indices of each nodes in unconstrained assembled system [-] @@ -239,10 +239,10 @@ MODULE SubDyn_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ElemsDOF !< 12 DOF indices of node 1 and 2 of a given member in unconstrained assembled system [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: DOFred2Nodes !< nDOFRed x 3, for each constrained DOF, col1 node index, col2 number of DOF, col3 DOF starting from 1 [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CtrlElem2Channel !< nCtrlCable x 2, for each CtrlCable, Elem index, and Channel Index [-] - INTEGER(IntKi) :: nDOFM !< retained degrees of freedom (modes) [-] - INTEGER(IntKi) :: SttcSolve !< Solve dynamics about static equilibrium point (flag) [-] - LOGICAL :: GuyanLoadCorrection !< Add Extra lever arm contribution to interface reaction outputs [-] - LOGICAL :: Floating !< True if floating bottom (the 6 DOF are free at all reaction nodes) [-] + INTEGER(IntKi) :: nDOFM = 0_IntKi !< retained degrees of freedom (modes) [-] + INTEGER(IntKi) :: SttcSolve = 0_IntKi !< Solve dynamics about static equilibrium point (flag) [-] + LOGICAL :: GuyanLoadCorrection = .false. !< Add Extra lever arm contribution to interface reaction outputs [-] + LOGICAL :: Floating = .false. !< True if floating bottom (the 6 DOF are free at all reaction nodes) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: KMMDiag !< Diagonal coefficients of Kmm (OmegaM squared) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CMMDiag !< Diagonal coefficients of Cmm (~2 Zeta OmegaM)) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MMB !< Matrix after C-B reduction (transpose of MBM [-] @@ -269,25 +269,25 @@ MODULE SubDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AM2JacPiv !< Pivot array for Jacobian factorization (for Adams-Boulton 2nd order Integration) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI !< Matrix to calculate TP reference point reaction at top of structure [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TIreact !< Matrix to calculate single point reaction at base of structure [-] - INTEGER(IntKi) :: nNodes !< Total number of nodes [-] - INTEGER(IntKi) :: nNodes_I !< Number of Interface nodes [-] - INTEGER(IntKi) :: nNodes_L !< Number of Internal nodes [-] - INTEGER(IntKi) :: nNodes_C !< Number of joints with reactions [-] + INTEGER(IntKi) :: nNodes = 0_IntKi !< Total number of nodes [-] + INTEGER(IntKi) :: nNodes_I = 0_IntKi !< Number of Interface nodes [-] + INTEGER(IntKi) :: nNodes_L = 0_IntKi !< Number of Internal nodes [-] + INTEGER(IntKi) :: nNodes_C = 0_IntKi !< Number of joints with reactions [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes_I !< Interface degree of freedoms [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes_L !< Internal nodes (not interface nor reaction) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes_C !< React degree of freedoms [-] - INTEGER(IntKi) :: nDOFI__ !< Size of IDI__ [-] - INTEGER(IntKi) :: nDOFI_Rb !< Size of IDI_Rb [-] - INTEGER(IntKi) :: nDOFI_F !< Size of IDI_F [-] - INTEGER(IntKi) :: nDOFL_L !< Size of IDL_L [-] - INTEGER(IntKi) :: nDOFC__ !< Size of IDC__ [-] - INTEGER(IntKi) :: nDOFC_Rb !< Size of IDC_Rb [-] - INTEGER(IntKi) :: nDOFC_L !< Size of IDC_L [-] - INTEGER(IntKi) :: nDOFC_F !< Size of IDC_F [-] - INTEGER(IntKi) :: nDOFR__ !< Size of IDR__ [-] - INTEGER(IntKi) :: nDOF__Rb !< Size of ID__Rb [-] - INTEGER(IntKi) :: nDOF__L !< Size of ID__L [-] - INTEGER(IntKi) :: nDOF__F !< Size of ID__F [-] + INTEGER(IntKi) :: nDOFI__ = 0_IntKi !< Size of IDI__ [-] + INTEGER(IntKi) :: nDOFI_Rb = 0_IntKi !< Size of IDI_Rb [-] + INTEGER(IntKi) :: nDOFI_F = 0_IntKi !< Size of IDI_F [-] + INTEGER(IntKi) :: nDOFL_L = 0_IntKi !< Size of IDL_L [-] + INTEGER(IntKi) :: nDOFC__ = 0_IntKi !< Size of IDC__ [-] + INTEGER(IntKi) :: nDOFC_Rb = 0_IntKi !< Size of IDC_Rb [-] + INTEGER(IntKi) :: nDOFC_L = 0_IntKi !< Size of IDC_L [-] + INTEGER(IntKi) :: nDOFC_F = 0_IntKi !< Size of IDC_F [-] + INTEGER(IntKi) :: nDOFR__ = 0_IntKi !< Size of IDR__ [-] + INTEGER(IntKi) :: nDOF__Rb = 0_IntKi !< Size of ID__Rb [-] + INTEGER(IntKi) :: nDOF__L = 0_IntKi !< Size of ID__L [-] + INTEGER(IntKi) :: nDOF__F = 0_IntKi !< Size of ID__F [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDI__ !< Index of all Interface DOFs [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDI_Rb !< Index array of the interface (nodes connect to TP) dofs that are retained/master/follower DOFs [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDI_F !< Index array of the interface (nodes connect to TP) dofs that are fixed DOF [-] @@ -300,10 +300,10 @@ MODULE SubDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ID__Rb !< Index array of all the retained/leader/master dofs (from any nodes of the structure) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ID__L !< Index array of all the follower/internal dofs (from any nodes of the structure) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ID__F !< Index array of the DOF that are fixed (from any nodes of the structure) [-] - INTEGER(IntKi) :: NMOutputs !< Number of members whose output is written [-] - INTEGER(IntKi) :: NumOuts !< Number of output channels read from input file [-] - INTEGER(IntKi) :: OutSwtch !< Output Requested Channels to local or global output file [1/2/3] [-] - INTEGER(IntKi) :: UnJckF !< Unit of SD ouput file [-] + INTEGER(IntKi) :: NMOutputs = 0_IntKi !< Number of members whose output is written [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of output channels read from input file [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output Requested Channels to local or global output file [1/2/3] [-] + INTEGER(IntKi) :: UnJckF = 0_IntKi !< Unit of SD ouput file [-] CHARACTER(1) :: Delim !< Column delimiter for output text files [-] CHARACTER(20) :: OutFmt !< Format for Output [-] CHARACTER(20) :: OutSFmt !< Format for Output Headers [-] @@ -311,19 +311,19 @@ MODULE SubDyn_Types 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 [-] - 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 [-] - LOGICAL :: OutReact !< Flag to check whether reactions are requested [-] - INTEGER(IntKi) :: OutAllInt !< Integer version of OutAll [-] - INTEGER(IntKi) :: OutAllDims !< Integer version of OutAll [-] - INTEGER(IntKi) :: OutDec !< Output Decimation for Requested Channels [-] + LOGICAL :: OutAll = .false. !< Flag to output or not all joint forces [-] + INTEGER(IntKi) :: OutCBModes = 0_IntKi !< Flag to output CB and Guyan modes to a given format [-] + INTEGER(IntKi) :: OutFEMModes = 0_IntKi !< Flag to output FEM modes to a given format [-] + LOGICAL :: OutReact = .false. !< Flag to check whether reactions are requested [-] + INTEGER(IntKi) :: OutAllInt = 0_IntKi !< Integer version of OutAll [-] + INTEGER(IntKi) :: OutAllDims = 0_IntKi !< Integer version of OutAll [-] + INTEGER(IntKi) :: OutDec = 0_IntKi !< Output Decimation for Requested Channels [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] - REAL(R8Ki) , DIMENSION(1:2) :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_nx !< half the number of continuous states in jacobian matrix [-] - LOGICAL :: RotStates !< Orient states in rotating frame during linearization? (flag) [-] + REAL(R8Ki) , DIMENSION(1:2) :: dx = 0.0_R8Ki !< vector that determines size of perturbation for x (continuous states) [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nx = 0_IntKi !< half the number of continuous states in jacobian matrix [-] + LOGICAL :: RotStates = .false. !< Orient states in rotating frame during linearization? (flag) [-] END TYPE SD_ParameterType ! ======================= ! ========= SD_InputType ======= @@ -342,12344 +342,6008 @@ MODULE SubDyn_Types END TYPE SD_OutputType ! ======================= CONTAINS - SUBROUTINE SD_CopyIList( SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IList), INTENT(IN) :: SrcIListData - TYPE(IList), INTENT(INOUT) :: DstIListData - 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 = 'SD_CopyIList' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcIListData%List)) THEN - i1_l = LBOUND(SrcIListData%List,1) - i1_u = UBOUND(SrcIListData%List,1) - IF (.NOT. ALLOCATED(DstIListData%List)) THEN - ALLOCATE(DstIListData%List(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIListData%List.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstIListData%List = SrcIListData%List -ENDIF - END SUBROUTINE SD_CopyIList - - SUBROUTINE SD_DestroyIList( IListData, ErrStat, ErrMsg ) - TYPE(IList), INTENT(INOUT) :: IListData - 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 = 'SD_DestroyIList' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(IListData%List)) THEN - DEALLOCATE(IListData%List) -ENDIF - END SUBROUTINE SD_DestroyIList - - SUBROUTINE SD_PackIList( 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(IList), 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 = 'SD_PackIList' - ! 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 ! List allocated yes/no - IF ( ALLOCATED(InData%List) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! List upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%List) ! List - 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%List) ) 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%List,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%List,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%List,1), UBOUND(InData%List,1) - IntKiBuf(Int_Xferred) = InData%List(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackIList - - SUBROUTINE SD_UnPackIList( 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(IList), 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 = 'SD_UnPackIList' - ! 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 ! List 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%List)) DEALLOCATE(OutData%List) - ALLOCATE(OutData%List(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%List.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%List,1), UBOUND(OutData%List,1) - OutData%List(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackIList - - SUBROUTINE SD_CopyMeshAuxDataType( SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MeshAuxDataType), INTENT(IN) :: SrcMeshAuxDataTypeData - TYPE(MeshAuxDataType), INTENT(INOUT) :: DstMeshAuxDataTypeData - 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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyMeshAuxDataType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMeshAuxDataTypeData%MemberID = SrcMeshAuxDataTypeData%MemberID - DstMeshAuxDataTypeData%NOutCnt = SrcMeshAuxDataTypeData%NOutCnt -IF (ALLOCATED(SrcMeshAuxDataTypeData%NodeCnt)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%NodeCnt,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%NodeCnt,1) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%NodeCnt)) THEN - ALLOCATE(DstMeshAuxDataTypeData%NodeCnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%NodeCnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%NodeCnt = SrcMeshAuxDataTypeData%NodeCnt -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%NodeIDs)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%NodeIDs,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%NodeIDs,1) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%NodeIDs)) THEN - ALLOCATE(DstMeshAuxDataTypeData%NodeIDs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%NodeIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%NodeIDs = SrcMeshAuxDataTypeData%NodeIDs -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%ElmIDs)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%ElmIDs,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%ElmIDs,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%ElmIDs,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%ElmIDs,2) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%ElmIDs)) THEN - ALLOCATE(DstMeshAuxDataTypeData%ElmIDs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%ElmIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%ElmIDs = SrcMeshAuxDataTypeData%ElmIDs -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%ElmNds)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%ElmNds,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%ElmNds,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%ElmNds,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%ElmNds,2) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%ElmNds)) THEN - ALLOCATE(DstMeshAuxDataTypeData%ElmNds(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%ElmNds.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%ElmNds = SrcMeshAuxDataTypeData%ElmNds -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%Me)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%Me,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%Me,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%Me,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%Me,2) - i3_l = LBOUND(SrcMeshAuxDataTypeData%Me,3) - i3_u = UBOUND(SrcMeshAuxDataTypeData%Me,3) - i4_l = LBOUND(SrcMeshAuxDataTypeData%Me,4) - i4_u = UBOUND(SrcMeshAuxDataTypeData%Me,4) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%Me)) THEN - ALLOCATE(DstMeshAuxDataTypeData%Me(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 DstMeshAuxDataTypeData%Me.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%Me = SrcMeshAuxDataTypeData%Me -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%Ke)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%Ke,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%Ke,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%Ke,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%Ke,2) - i3_l = LBOUND(SrcMeshAuxDataTypeData%Ke,3) - i3_u = UBOUND(SrcMeshAuxDataTypeData%Ke,3) - i4_l = LBOUND(SrcMeshAuxDataTypeData%Ke,4) - i4_u = UBOUND(SrcMeshAuxDataTypeData%Ke,4) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%Ke)) THEN - ALLOCATE(DstMeshAuxDataTypeData%Ke(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 DstMeshAuxDataTypeData%Ke.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%Ke = SrcMeshAuxDataTypeData%Ke -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%Fg)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%Fg,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%Fg,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%Fg,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%Fg,2) - i3_l = LBOUND(SrcMeshAuxDataTypeData%Fg,3) - i3_u = UBOUND(SrcMeshAuxDataTypeData%Fg,3) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%Fg)) THEN - ALLOCATE(DstMeshAuxDataTypeData%Fg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Fg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%Fg = SrcMeshAuxDataTypeData%Fg -ENDIF - END SUBROUTINE SD_CopyMeshAuxDataType - - SUBROUTINE SD_DestroyMeshAuxDataType( MeshAuxDataTypeData, ErrStat, ErrMsg ) - TYPE(MeshAuxDataType), INTENT(INOUT) :: MeshAuxDataTypeData - 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 = 'SD_DestroyMeshAuxDataType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MeshAuxDataTypeData%NodeCnt)) THEN - DEALLOCATE(MeshAuxDataTypeData%NodeCnt) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%NodeIDs)) THEN - DEALLOCATE(MeshAuxDataTypeData%NodeIDs) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%ElmIDs)) THEN - DEALLOCATE(MeshAuxDataTypeData%ElmIDs) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%ElmNds)) THEN - DEALLOCATE(MeshAuxDataTypeData%ElmNds) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%Me)) THEN - DEALLOCATE(MeshAuxDataTypeData%Me) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%Ke)) THEN - DEALLOCATE(MeshAuxDataTypeData%Ke) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%Fg)) THEN - DEALLOCATE(MeshAuxDataTypeData%Fg) -ENDIF - END SUBROUTINE SD_DestroyMeshAuxDataType - - SUBROUTINE SD_PackMeshAuxDataType( 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(MeshAuxDataType), 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 = 'SD_PackMeshAuxDataType' - ! 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 ! MemberID - Int_BufSz = Int_BufSz + 1 ! NOutCnt - Int_BufSz = Int_BufSz + 1 ! NodeCnt allocated yes/no - IF ( ALLOCATED(InData%NodeCnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeCnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeCnt) ! NodeCnt - END IF - Int_BufSz = Int_BufSz + 1 ! NodeIDs allocated yes/no - IF ( ALLOCATED(InData%NodeIDs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeIDs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeIDs) ! NodeIDs - END IF - Int_BufSz = Int_BufSz + 1 ! ElmIDs allocated yes/no - IF ( ALLOCATED(InData%ElmIDs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElmIDs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElmIDs) ! ElmIDs - END IF - Int_BufSz = Int_BufSz + 1 ! ElmNds allocated yes/no - IF ( ALLOCATED(InData%ElmNds) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElmNds upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElmNds) ! ElmNds - END IF - Int_BufSz = Int_BufSz + 1 ! Me allocated yes/no - IF ( ALLOCATED(InData%Me) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Me upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Me) ! Me - END IF - Int_BufSz = Int_BufSz + 1 ! Ke allocated yes/no - IF ( ALLOCATED(InData%Ke) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Ke upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ke) ! Ke - END IF - Int_BufSz = Int_BufSz + 1 ! Fg allocated yes/no - IF ( ALLOCATED(InData%Fg) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fg upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fg) ! Fg - 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 - - IntKiBuf(Int_Xferred) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutCnt - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NodeCnt) ) 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%NodeCnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeCnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeCnt,1), UBOUND(InData%NodeCnt,1) - IntKiBuf(Int_Xferred) = InData%NodeCnt(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodeIDs) ) 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%NodeIDs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeIDs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeIDs,1), UBOUND(InData%NodeIDs,1) - IntKiBuf(Int_Xferred) = InData%NodeIDs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElmIDs) ) 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%ElmIDs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmIDs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmIDs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmIDs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElmIDs,2), UBOUND(InData%ElmIDs,2) - DO i1 = LBOUND(InData%ElmIDs,1), UBOUND(InData%ElmIDs,1) - IntKiBuf(Int_Xferred) = InData%ElmIDs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElmNds) ) 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%ElmNds,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmNds,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmNds,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmNds,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElmNds,2), UBOUND(InData%ElmNds,2) - DO i1 = LBOUND(InData%ElmNds,1), UBOUND(InData%ElmNds,1) - IntKiBuf(Int_Xferred) = InData%ElmNds(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Me) ) 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%Me,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Me,4), UBOUND(InData%Me,4) - DO i3 = LBOUND(InData%Me,3), UBOUND(InData%Me,3) - DO i2 = LBOUND(InData%Me,2), UBOUND(InData%Me,2) - DO i1 = LBOUND(InData%Me,1), UBOUND(InData%Me,1) - DbKiBuf(Db_Xferred) = InData%Me(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ke) ) 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%Ke,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Ke,4), UBOUND(InData%Ke,4) - DO i3 = LBOUND(InData%Ke,3), UBOUND(InData%Ke,3) - DO i2 = LBOUND(InData%Ke,2), UBOUND(InData%Ke,2) - DO i1 = LBOUND(InData%Ke,1), UBOUND(InData%Ke,1) - DbKiBuf(Db_Xferred) = InData%Ke(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fg) ) 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%Fg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fg,3), UBOUND(InData%Fg,3) - DO i2 = LBOUND(InData%Fg,2), UBOUND(InData%Fg,2) - DO i1 = LBOUND(InData%Fg,1), UBOUND(InData%Fg,1) - DbKiBuf(Db_Xferred) = InData%Fg(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE SD_PackMeshAuxDataType - - SUBROUTINE SD_UnPackMeshAuxDataType( 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(MeshAuxDataType), 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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackMeshAuxDataType' - ! 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%MemberID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutCnt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeCnt 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%NodeCnt)) DEALLOCATE(OutData%NodeCnt) - ALLOCATE(OutData%NodeCnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeCnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeCnt,1), UBOUND(OutData%NodeCnt,1) - OutData%NodeCnt(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeIDs 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%NodeIDs)) DEALLOCATE(OutData%NodeIDs) - ALLOCATE(OutData%NodeIDs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeIDs,1), UBOUND(OutData%NodeIDs,1) - OutData%NodeIDs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElmIDs 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%ElmIDs)) DEALLOCATE(OutData%ElmIDs) - ALLOCATE(OutData%ElmIDs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElmIDs,2), UBOUND(OutData%ElmIDs,2) - DO i1 = LBOUND(OutData%ElmIDs,1), UBOUND(OutData%ElmIDs,1) - OutData%ElmIDs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElmNds 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%ElmNds)) DEALLOCATE(OutData%ElmNds) - ALLOCATE(OutData%ElmNds(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmNds.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElmNds,2), UBOUND(OutData%ElmNds,2) - DO i1 = LBOUND(OutData%ElmNds,1), UBOUND(OutData%ElmNds,1) - OutData%ElmNds(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Me 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%Me)) DEALLOCATE(OutData%Me) - ALLOCATE(OutData%Me(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%Me.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Me,4), UBOUND(OutData%Me,4) - DO i3 = LBOUND(OutData%Me,3), UBOUND(OutData%Me,3) - DO i2 = LBOUND(OutData%Me,2), UBOUND(OutData%Me,2) - DO i1 = LBOUND(OutData%Me,1), UBOUND(OutData%Me,1) - OutData%Me(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ke 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%Ke)) DEALLOCATE(OutData%Ke) - ALLOCATE(OutData%Ke(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%Ke.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Ke,4), UBOUND(OutData%Ke,4) - DO i3 = LBOUND(OutData%Ke,3), UBOUND(OutData%Ke,3) - DO i2 = LBOUND(OutData%Ke,2), UBOUND(OutData%Ke,2) - DO i1 = LBOUND(OutData%Ke,1), UBOUND(OutData%Ke,1) - OutData%Ke(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fg 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%Fg)) DEALLOCATE(OutData%Fg) - ALLOCATE(OutData%Fg(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%Fg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fg,3), UBOUND(OutData%Fg,3) - DO i2 = LBOUND(OutData%Fg,2), UBOUND(OutData%Fg,2) - DO i1 = LBOUND(OutData%Fg,1), UBOUND(OutData%Fg,1) - OutData%Fg(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE SD_UnPackMeshAuxDataType - - SUBROUTINE SD_CopyCB_MatArrays( SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCode, ErrStat, ErrMsg ) - TYPE(CB_MatArrays), INTENT(IN) :: SrcCB_MatArraysData - TYPE(CB_MatArrays), INTENT(INOUT) :: DstCB_MatArraysData - 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 = 'SD_CopyCB_MatArrays' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcCB_MatArraysData%MBB)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%MBB,1) - i1_u = UBOUND(SrcCB_MatArraysData%MBB,1) - i2_l = LBOUND(SrcCB_MatArraysData%MBB,2) - i2_u = UBOUND(SrcCB_MatArraysData%MBB,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%MBB)) THEN - ALLOCATE(DstCB_MatArraysData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%MBB = SrcCB_MatArraysData%MBB -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%MBM)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%MBM,1) - i1_u = UBOUND(SrcCB_MatArraysData%MBM,1) - i2_l = LBOUND(SrcCB_MatArraysData%MBM,2) - i2_u = UBOUND(SrcCB_MatArraysData%MBM,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%MBM)) THEN - ALLOCATE(DstCB_MatArraysData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%MBM = SrcCB_MatArraysData%MBM -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%KBB)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%KBB,1) - i1_u = UBOUND(SrcCB_MatArraysData%KBB,1) - i2_l = LBOUND(SrcCB_MatArraysData%KBB,2) - i2_u = UBOUND(SrcCB_MatArraysData%KBB,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%KBB)) THEN - ALLOCATE(DstCB_MatArraysData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%KBB = SrcCB_MatArraysData%KBB -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%PhiL)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%PhiL,1) - i1_u = UBOUND(SrcCB_MatArraysData%PhiL,1) - i2_l = LBOUND(SrcCB_MatArraysData%PhiL,2) - i2_u = UBOUND(SrcCB_MatArraysData%PhiL,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%PhiL)) THEN - ALLOCATE(DstCB_MatArraysData%PhiL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%PhiL = SrcCB_MatArraysData%PhiL -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%PhiR)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%PhiR,1) - i1_u = UBOUND(SrcCB_MatArraysData%PhiR,1) - i2_l = LBOUND(SrcCB_MatArraysData%PhiR,2) - i2_u = UBOUND(SrcCB_MatArraysData%PhiR,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%PhiR)) THEN - ALLOCATE(DstCB_MatArraysData%PhiR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%PhiR = SrcCB_MatArraysData%PhiR -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%OmegaL)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%OmegaL,1) - i1_u = UBOUND(SrcCB_MatArraysData%OmegaL,1) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%OmegaL)) THEN - ALLOCATE(DstCB_MatArraysData%OmegaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%OmegaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%OmegaL = SrcCB_MatArraysData%OmegaL -ENDIF - END SUBROUTINE SD_CopyCB_MatArrays - - SUBROUTINE SD_DestroyCB_MatArrays( CB_MatArraysData, ErrStat, ErrMsg ) - TYPE(CB_MatArrays), INTENT(INOUT) :: CB_MatArraysData - 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 = 'SD_DestroyCB_MatArrays' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(CB_MatArraysData%MBB)) THEN - DEALLOCATE(CB_MatArraysData%MBB) -ENDIF -IF (ALLOCATED(CB_MatArraysData%MBM)) THEN - DEALLOCATE(CB_MatArraysData%MBM) -ENDIF -IF (ALLOCATED(CB_MatArraysData%KBB)) THEN - DEALLOCATE(CB_MatArraysData%KBB) -ENDIF -IF (ALLOCATED(CB_MatArraysData%PhiL)) THEN - DEALLOCATE(CB_MatArraysData%PhiL) -ENDIF -IF (ALLOCATED(CB_MatArraysData%PhiR)) THEN - DEALLOCATE(CB_MatArraysData%PhiR) -ENDIF -IF (ALLOCATED(CB_MatArraysData%OmegaL)) THEN - DEALLOCATE(CB_MatArraysData%OmegaL) -ENDIF - END SUBROUTINE SD_DestroyCB_MatArrays - - SUBROUTINE SD_PackCB_MatArrays( 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(CB_MatArrays), 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 = 'SD_PackCB_MatArrays' - ! 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 ! MBB allocated yes/no - IF ( ALLOCATED(InData%MBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBB upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MBB) ! MBB - END IF - Int_BufSz = Int_BufSz + 1 ! MBM allocated yes/no - IF ( ALLOCATED(InData%MBM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBM upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MBM) ! MBM - END IF - Int_BufSz = Int_BufSz + 1 ! KBB allocated yes/no - IF ( ALLOCATED(InData%KBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! KBB upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%KBB) ! KBB - END IF - Int_BufSz = Int_BufSz + 1 ! PhiL allocated yes/no - IF ( ALLOCATED(InData%PhiL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiL upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PhiL) ! PhiL - END IF - Int_BufSz = Int_BufSz + 1 ! PhiR allocated yes/no - IF ( ALLOCATED(InData%PhiR) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiR upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PhiR) ! PhiR - END IF - Int_BufSz = Int_BufSz + 1 ! OmegaL allocated yes/no - IF ( ALLOCATED(InData%OmegaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OmegaL upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%OmegaL) ! OmegaL - 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%MBB) ) 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%MBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) - DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) - DbKiBuf(Db_Xferred) = InData%MBB(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBM) ) 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%MBM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) - DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) - DbKiBuf(Db_Xferred) = InData%MBM(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KBB) ) 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%KBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) - DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) - DbKiBuf(Db_Xferred) = InData%KBB(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiL) ) 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%PhiL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiL,2), UBOUND(InData%PhiL,2) - DO i1 = LBOUND(InData%PhiL,1), UBOUND(InData%PhiL,1) - DbKiBuf(Db_Xferred) = InData%PhiL(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiR) ) 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%PhiR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiR,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiR,2), UBOUND(InData%PhiR,2) - DO i1 = LBOUND(InData%PhiR,1), UBOUND(InData%PhiR,1) - DbKiBuf(Db_Xferred) = InData%PhiR(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OmegaL) ) 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%OmegaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OmegaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OmegaL,1), UBOUND(InData%OmegaL,1) - DbKiBuf(Db_Xferred) = InData%OmegaL(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackCB_MatArrays - - SUBROUTINE SD_UnPackCB_MatArrays( 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(CB_MatArrays), 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 = 'SD_UnPackCB_MatArrays' - ! 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 ! MBB 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%MBB)) DEALLOCATE(OutData%MBB) - ALLOCATE(OutData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) - DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) - OutData%MBB(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM 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%MBM)) DEALLOCATE(OutData%MBM) - ALLOCATE(OutData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) - DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) - OutData%MBM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB 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%KBB)) DEALLOCATE(OutData%KBB) - ALLOCATE(OutData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) - DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) - OutData%KBB(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL 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%PhiL)) DEALLOCATE(OutData%PhiL) - ALLOCATE(OutData%PhiL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiL,2), UBOUND(OutData%PhiL,2) - DO i1 = LBOUND(OutData%PhiL,1), UBOUND(OutData%PhiL,1) - OutData%PhiL(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiR 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%PhiR)) DEALLOCATE(OutData%PhiR) - ALLOCATE(OutData%PhiR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiR,2), UBOUND(OutData%PhiR,2) - DO i1 = LBOUND(OutData%PhiR,1), UBOUND(OutData%PhiR,1) - OutData%PhiR(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OmegaL 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%OmegaL)) DEALLOCATE(OutData%OmegaL) - ALLOCATE(OutData%OmegaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OmegaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OmegaL,1), UBOUND(OutData%OmegaL,1) - OutData%OmegaL(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackCB_MatArrays - - SUBROUTINE SD_CopyElemPropType( SrcElemPropTypeData, DstElemPropTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElemPropType), INTENT(IN) :: SrcElemPropTypeData - TYPE(ElemPropType), INTENT(INOUT) :: DstElemPropTypeData - 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 = 'SD_CopyElemPropType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstElemPropTypeData%eType = SrcElemPropTypeData%eType - DstElemPropTypeData%Length = SrcElemPropTypeData%Length - DstElemPropTypeData%Ixx = SrcElemPropTypeData%Ixx - DstElemPropTypeData%Iyy = SrcElemPropTypeData%Iyy - DstElemPropTypeData%Jzz = SrcElemPropTypeData%Jzz - DstElemPropTypeData%Shear = SrcElemPropTypeData%Shear - DstElemPropTypeData%Kappa_x = SrcElemPropTypeData%Kappa_x - DstElemPropTypeData%Kappa_y = SrcElemPropTypeData%Kappa_y - DstElemPropTypeData%YoungE = SrcElemPropTypeData%YoungE - DstElemPropTypeData%ShearG = SrcElemPropTypeData%ShearG - DstElemPropTypeData%D = SrcElemPropTypeData%D - DstElemPropTypeData%Area = SrcElemPropTypeData%Area - DstElemPropTypeData%Rho = SrcElemPropTypeData%Rho - DstElemPropTypeData%T0 = SrcElemPropTypeData%T0 - DstElemPropTypeData%DirCos = SrcElemPropTypeData%DirCos - END SUBROUTINE SD_CopyElemPropType - - SUBROUTINE SD_DestroyElemPropType( ElemPropTypeData, ErrStat, ErrMsg ) - TYPE(ElemPropType), INTENT(INOUT) :: ElemPropTypeData - 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 = 'SD_DestroyElemPropType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SD_DestroyElemPropType - - SUBROUTINE SD_PackElemPropType( 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(ElemPropType), 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 = 'SD_PackElemPropType' - ! 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 ! eType - Re_BufSz = Re_BufSz + 1 ! Length - Re_BufSz = Re_BufSz + 1 ! Ixx - Re_BufSz = Re_BufSz + 1 ! Iyy - Re_BufSz = Re_BufSz + 1 ! Jzz - Int_BufSz = Int_BufSz + 1 ! Shear - Re_BufSz = Re_BufSz + 1 ! Kappa_x - Re_BufSz = Re_BufSz + 1 ! Kappa_y - Re_BufSz = Re_BufSz + 1 ! YoungE - Re_BufSz = Re_BufSz + 1 ! ShearG - Re_BufSz = Re_BufSz + SIZE(InData%D) ! D - Re_BufSz = Re_BufSz + 1 ! Area - Re_BufSz = Re_BufSz + 1 ! Rho - Re_BufSz = Re_BufSz + 1 ! T0 - Db_BufSz = Db_BufSz + SIZE(InData%DirCos) ! DirCos - 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%eType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Length - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ixx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Iyy - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Jzz - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Shear, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kappa_x - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kappa_y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YoungE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShearG - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%D,1), UBOUND(InData%D,1) - ReKiBuf(Re_Xferred) = InData%D(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Area - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Rho - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T0 - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%DirCos,2), UBOUND(InData%DirCos,2) - DO i1 = LBOUND(InData%DirCos,1), UBOUND(InData%DirCos,1) - DbKiBuf(Db_Xferred) = InData%DirCos(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END SUBROUTINE SD_PackElemPropType - - SUBROUTINE SD_UnPackElemPropType( 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(ElemPropType), 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 = 'SD_UnPackElemPropType' - ! 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%eType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Length = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ixx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Iyy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Jzz = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Shear = TRANSFER(IntKiBuf(Int_Xferred), OutData%Shear) - Int_Xferred = Int_Xferred + 1 - OutData%Kappa_x = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kappa_y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YoungE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShearG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%D,1) - i1_u = UBOUND(OutData%D,1) - DO i1 = LBOUND(OutData%D,1), UBOUND(OutData%D,1) - OutData%D(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Area = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Rho = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%DirCos,1) - i1_u = UBOUND(OutData%DirCos,1) - i2_l = LBOUND(OutData%DirCos,2) - i2_u = UBOUND(OutData%DirCos,2) - DO i2 = LBOUND(OutData%DirCos,2), UBOUND(OutData%DirCos,2) - DO i1 = LBOUND(OutData%DirCos,1), UBOUND(OutData%DirCos,1) - OutData%DirCos(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END SUBROUTINE SD_UnPackElemPropType - - SUBROUTINE SD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InitInputType), INTENT(INOUT) :: SrcInitInputData - TYPE(SD_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%SDInputFile = SrcInitInputData%SDInputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%g = SrcInitInputData%g - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%TP_RefPoint = SrcInitInputData%TP_RefPoint - DstInitInputData%SubRotateZ = SrcInitInputData%SubRotateZ -IF (ALLOCATED(SrcInitInputData%SoilStiffness)) THEN - i1_l = LBOUND(SrcInitInputData%SoilStiffness,1) - i1_u = UBOUND(SrcInitInputData%SoilStiffness,1) - i2_l = LBOUND(SrcInitInputData%SoilStiffness,2) - i2_u = UBOUND(SrcInitInputData%SoilStiffness,2) - i3_l = LBOUND(SrcInitInputData%SoilStiffness,3) - i3_u = UBOUND(SrcInitInputData%SoilStiffness,3) - IF (.NOT. ALLOCATED(DstInitInputData%SoilStiffness)) THEN - ALLOCATE(DstInitInputData%SoilStiffness(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%SoilStiffness.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%SoilStiffness = SrcInitInputData%SoilStiffness -ENDIF - CALL MeshCopy( SrcInitInputData%SoilMesh, DstInitInputData%SoilMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%Linearize = SrcInitInputData%Linearize - END SUBROUTINE SD_CopyInitInput - - SUBROUTINE SD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SD_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 = 'SD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%SoilStiffness)) THEN - DEALLOCATE(InitInputData%SoilStiffness) -ENDIF - CALL MeshDestroy( InitInputData%SoilMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SD_DestroyInitInput - - SUBROUTINE SD_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(SD_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 = 'SD_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%SDInputFile) ! SDInputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! g - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + SIZE(InData%TP_RefPoint) ! TP_RefPoint - Re_BufSz = Re_BufSz + 1 ! SubRotateZ - Int_BufSz = Int_BufSz + 1 ! SoilStiffness allocated yes/no - IF ( ALLOCATED(InData%SoilStiffness) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SoilStiffness upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SoilStiffness) ! SoilStiffness - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SoilMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SoilMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SoilMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SoilMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SoilMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Linearize - 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%SDInputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SDInputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%TP_RefPoint,1), UBOUND(InData%TP_RefPoint,1) - ReKiBuf(Re_Xferred) = InData%TP_RefPoint(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%SubRotateZ - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SoilStiffness) ) 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%SoilStiffness,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SoilStiffness,3), UBOUND(InData%SoilStiffness,3) - DO i2 = LBOUND(InData%SoilStiffness,2), UBOUND(InData%SoilStiffness,2) - DO i1 = LBOUND(InData%SoilStiffness,1), UBOUND(InData%SoilStiffness,1) - ReKiBuf(Re_Xferred) = InData%SoilStiffness(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - CALL MeshPack( InData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SoilMesh - 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) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackInitInput - - SUBROUTINE SD_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(SD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_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%SDInputFile) - OutData%SDInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%g = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%TP_RefPoint,1) - i1_u = UBOUND(OutData%TP_RefPoint,1) - DO i1 = LBOUND(OutData%TP_RefPoint,1), UBOUND(OutData%TP_RefPoint,1) - OutData%TP_RefPoint(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%SubRotateZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SoilStiffness 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%SoilStiffness)) DEALLOCATE(OutData%SoilStiffness) - ALLOCATE(OutData%SoilStiffness(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%SoilStiffness.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SoilStiffness,3), UBOUND(OutData%SoilStiffness,3) - DO i2 = LBOUND(OutData%SoilStiffness,2), UBOUND(OutData%SoilStiffness,2) - DO i1 = LBOUND(OutData%SoilStiffness,1), UBOUND(OutData%SoilStiffness,1) - OutData%SoilStiffness(i1,i2,i3) = ReKiBuf(Re_Xferred) - 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 MeshUnpack( OutData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SoilMesh - 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%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackInitInput - - SUBROUTINE SD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SD_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 = 'SD_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 - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN - ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%CableCChanRqst)) THEN - i1_l = LBOUND(SrcInitOutputData%CableCChanRqst,1) - i1_u = UBOUND(SrcInitOutputData%CableCChanRqst,1) - IF (.NOT. ALLOCATED(DstInitOutputData%CableCChanRqst)) THEN - ALLOCATE(DstInitOutputData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst -ENDIF - END SUBROUTINE SD_CopyInitOutput - - SUBROUTINE SD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SD_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 = 'SD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN - DEALLOCATE(InitOutputData%RotFrame_x) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF -IF (ALLOCATED(InitOutputData%CableCChanRqst)) THEN - DEALLOCATE(InitOutputData%CableCChanRqst) -ENDIF - END SUBROUTINE SD_DestroyInitOutput - - SUBROUTINE SD_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(SD_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 = 'SD_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - Int_BufSz = Int_BufSz + 1 ! CableCChanRqst allocated yes/no - IF ( ALLOCATED(InData%CableCChanRqst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableCChanRqst upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CableCChanRqst) ! CableCChanRqst - 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 - 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 - - 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 - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) 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%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) 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%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) 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%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) 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%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) 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%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) 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%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) 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%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) 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%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CableCChanRqst) ) 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%CableCChanRqst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableCChanRqst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableCChanRqst,1), UBOUND(InData%CableCChanRqst,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%CableCChanRqst(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackInitOutput - - SUBROUTINE SD_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(SD_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 = 'SD_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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y 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%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(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 ! LinNames_x 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%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(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 ! LinNames_u 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%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(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 ! RotFrame_y 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%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x 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%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u 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%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u 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%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x 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%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableCChanRqst 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%CableCChanRqst)) DEALLOCATE(OutData%CableCChanRqst) - ALLOCATE(OutData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableCChanRqst,1), UBOUND(OutData%CableCChanRqst,1) - OutData%CableCChanRqst(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CableCChanRqst(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackInitOutput - - SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InitType), INTENT(IN) :: SrcInitTypeData - TYPE(SD_InitType), INTENT(INOUT) :: DstInitTypeData - 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 = 'SD_CopyInitType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitTypeData%RootName = SrcInitTypeData%RootName - DstInitTypeData%TP_RefPoint = SrcInitTypeData%TP_RefPoint - DstInitTypeData%SubRotateZ = SrcInitTypeData%SubRotateZ - DstInitTypeData%g = SrcInitTypeData%g - DstInitTypeData%DT = SrcInitTypeData%DT - DstInitTypeData%NJoints = SrcInitTypeData%NJoints - DstInitTypeData%NPropSetsX = SrcInitTypeData%NPropSetsX - DstInitTypeData%NPropSetsB = SrcInitTypeData%NPropSetsB - DstInitTypeData%NPropSetsC = SrcInitTypeData%NPropSetsC - DstInitTypeData%NPropSetsR = SrcInitTypeData%NPropSetsR - DstInitTypeData%NCMass = SrcInitTypeData%NCMass - DstInitTypeData%NCOSMs = SrcInitTypeData%NCOSMs - DstInitTypeData%FEMMod = SrcInitTypeData%FEMMod - DstInitTypeData%NDiv = SrcInitTypeData%NDiv - DstInitTypeData%CBMod = SrcInitTypeData%CBMod -IF (ALLOCATED(SrcInitTypeData%Joints)) THEN - i1_l = LBOUND(SrcInitTypeData%Joints,1) - i1_u = UBOUND(SrcInitTypeData%Joints,1) - i2_l = LBOUND(SrcInitTypeData%Joints,2) - i2_u = UBOUND(SrcInitTypeData%Joints,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Joints)) THEN - ALLOCATE(DstInitTypeData%Joints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Joints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Joints = SrcInitTypeData%Joints -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsB)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsB,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsB,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsB,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsB,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsB)) THEN - ALLOCATE(DstInitTypeData%PropSetsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsB = SrcInitTypeData%PropSetsB -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsC)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsC,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsC,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsC,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsC,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsC)) THEN - ALLOCATE(DstInitTypeData%PropSetsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsC = SrcInitTypeData%PropSetsC -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsR)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsR,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsR,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsR,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsR,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsR)) THEN - ALLOCATE(DstInitTypeData%PropSetsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsR = SrcInitTypeData%PropSetsR -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsX)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsX,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsX,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsX,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsX,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsX)) THEN - ALLOCATE(DstInitTypeData%PropSetsX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsX = SrcInitTypeData%PropSetsX -ENDIF -IF (ALLOCATED(SrcInitTypeData%COSMs)) THEN - i1_l = LBOUND(SrcInitTypeData%COSMs,1) - i1_u = UBOUND(SrcInitTypeData%COSMs,1) - i2_l = LBOUND(SrcInitTypeData%COSMs,2) - i2_u = UBOUND(SrcInitTypeData%COSMs,2) - IF (.NOT. ALLOCATED(DstInitTypeData%COSMs)) THEN - ALLOCATE(DstInitTypeData%COSMs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%COSMs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%COSMs = SrcInitTypeData%COSMs -ENDIF -IF (ALLOCATED(SrcInitTypeData%CMass)) THEN - i1_l = LBOUND(SrcInitTypeData%CMass,1) - i1_u = UBOUND(SrcInitTypeData%CMass,1) - i2_l = LBOUND(SrcInitTypeData%CMass,2) - i2_u = UBOUND(SrcInitTypeData%CMass,2) - IF (.NOT. ALLOCATED(DstInitTypeData%CMass)) THEN - ALLOCATE(DstInitTypeData%CMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%CMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%CMass = SrcInitTypeData%CMass -ENDIF -IF (ALLOCATED(SrcInitTypeData%JDampings)) THEN - i1_l = LBOUND(SrcInitTypeData%JDampings,1) - i1_u = UBOUND(SrcInitTypeData%JDampings,1) - IF (.NOT. ALLOCATED(DstInitTypeData%JDampings)) THEN - ALLOCATE(DstInitTypeData%JDampings(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%JDampings.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%JDampings = SrcInitTypeData%JDampings -ENDIF - DstInitTypeData%GuyanDampMod = SrcInitTypeData%GuyanDampMod - DstInitTypeData%RayleighDamp = SrcInitTypeData%RayleighDamp - DstInitTypeData%GuyanDampMat = SrcInitTypeData%GuyanDampMat -IF (ALLOCATED(SrcInitTypeData%Members)) THEN - i1_l = LBOUND(SrcInitTypeData%Members,1) - i1_u = UBOUND(SrcInitTypeData%Members,1) - i2_l = LBOUND(SrcInitTypeData%Members,2) - i2_u = UBOUND(SrcInitTypeData%Members,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Members)) THEN - ALLOCATE(DstInitTypeData%Members(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Members.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Members = SrcInitTypeData%Members -ENDIF -IF (ALLOCATED(SrcInitTypeData%SSOutList)) THEN - i1_l = LBOUND(SrcInitTypeData%SSOutList,1) - i1_u = UBOUND(SrcInitTypeData%SSOutList,1) - IF (.NOT. ALLOCATED(DstInitTypeData%SSOutList)) THEN - ALLOCATE(DstInitTypeData%SSOutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSOutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSOutList = SrcInitTypeData%SSOutList -ENDIF - DstInitTypeData%OutCOSM = SrcInitTypeData%OutCOSM - DstInitTypeData%TabDelim = SrcInitTypeData%TabDelim -IF (ALLOCATED(SrcInitTypeData%SSIK)) THEN - i1_l = LBOUND(SrcInitTypeData%SSIK,1) - i1_u = UBOUND(SrcInitTypeData%SSIK,1) - i2_l = LBOUND(SrcInitTypeData%SSIK,2) - i2_u = UBOUND(SrcInitTypeData%SSIK,2) - IF (.NOT. ALLOCATED(DstInitTypeData%SSIK)) THEN - ALLOCATE(DstInitTypeData%SSIK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSIK = SrcInitTypeData%SSIK -ENDIF -IF (ALLOCATED(SrcInitTypeData%SSIM)) THEN - i1_l = LBOUND(SrcInitTypeData%SSIM,1) - i1_u = UBOUND(SrcInitTypeData%SSIM,1) - i2_l = LBOUND(SrcInitTypeData%SSIM,2) - i2_u = UBOUND(SrcInitTypeData%SSIM,2) - IF (.NOT. ALLOCATED(DstInitTypeData%SSIM)) THEN - ALLOCATE(DstInitTypeData%SSIM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSIM = SrcInitTypeData%SSIM -ENDIF -IF (ALLOCATED(SrcInitTypeData%SSIfile)) THEN - i1_l = LBOUND(SrcInitTypeData%SSIfile,1) - i1_u = UBOUND(SrcInitTypeData%SSIfile,1) - IF (.NOT. ALLOCATED(DstInitTypeData%SSIfile)) THEN - ALLOCATE(DstInitTypeData%SSIfile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIfile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSIfile = SrcInitTypeData%SSIfile -ENDIF -IF (ALLOCATED(SrcInitTypeData%Soil_K)) THEN - i1_l = LBOUND(SrcInitTypeData%Soil_K,1) - i1_u = UBOUND(SrcInitTypeData%Soil_K,1) - i2_l = LBOUND(SrcInitTypeData%Soil_K,2) - i2_u = UBOUND(SrcInitTypeData%Soil_K,2) - i3_l = LBOUND(SrcInitTypeData%Soil_K,3) - i3_u = UBOUND(SrcInitTypeData%Soil_K,3) - IF (.NOT. ALLOCATED(DstInitTypeData%Soil_K)) THEN - ALLOCATE(DstInitTypeData%Soil_K(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Soil_K = SrcInitTypeData%Soil_K -ENDIF -IF (ALLOCATED(SrcInitTypeData%Soil_Points)) THEN - i1_l = LBOUND(SrcInitTypeData%Soil_Points,1) - i1_u = UBOUND(SrcInitTypeData%Soil_Points,1) - i2_l = LBOUND(SrcInitTypeData%Soil_Points,2) - i2_u = UBOUND(SrcInitTypeData%Soil_Points,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Soil_Points)) THEN - ALLOCATE(DstInitTypeData%Soil_Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_Points.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Soil_Points = SrcInitTypeData%Soil_Points -ENDIF -IF (ALLOCATED(SrcInitTypeData%Soil_Nodes)) THEN - i1_l = LBOUND(SrcInitTypeData%Soil_Nodes,1) - i1_u = UBOUND(SrcInitTypeData%Soil_Nodes,1) - IF (.NOT. ALLOCATED(DstInitTypeData%Soil_Nodes)) THEN - ALLOCATE(DstInitTypeData%Soil_Nodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Soil_Nodes = SrcInitTypeData%Soil_Nodes -ENDIF - DstInitTypeData%NElem = SrcInitTypeData%NElem - DstInitTypeData%NPropB = SrcInitTypeData%NPropB - DstInitTypeData%NPropC = SrcInitTypeData%NPropC - DstInitTypeData%NPropR = SrcInitTypeData%NPropR -IF (ALLOCATED(SrcInitTypeData%Nodes)) THEN - i1_l = LBOUND(SrcInitTypeData%Nodes,1) - i1_u = UBOUND(SrcInitTypeData%Nodes,1) - i2_l = LBOUND(SrcInitTypeData%Nodes,2) - i2_u = UBOUND(SrcInitTypeData%Nodes,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Nodes)) THEN - ALLOCATE(DstInitTypeData%Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Nodes = SrcInitTypeData%Nodes -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropsB)) THEN - i1_l = LBOUND(SrcInitTypeData%PropsB,1) - i1_u = UBOUND(SrcInitTypeData%PropsB,1) - i2_l = LBOUND(SrcInitTypeData%PropsB,2) - i2_u = UBOUND(SrcInitTypeData%PropsB,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropsB)) THEN - ALLOCATE(DstInitTypeData%PropsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropsB = SrcInitTypeData%PropsB -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropsC)) THEN - i1_l = LBOUND(SrcInitTypeData%PropsC,1) - i1_u = UBOUND(SrcInitTypeData%PropsC,1) - i2_l = LBOUND(SrcInitTypeData%PropsC,2) - i2_u = UBOUND(SrcInitTypeData%PropsC,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropsC)) THEN - ALLOCATE(DstInitTypeData%PropsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropsC = SrcInitTypeData%PropsC -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropsR)) THEN - i1_l = LBOUND(SrcInitTypeData%PropsR,1) - i1_u = UBOUND(SrcInitTypeData%PropsR,1) - i2_l = LBOUND(SrcInitTypeData%PropsR,2) - i2_u = UBOUND(SrcInitTypeData%PropsR,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropsR)) THEN - ALLOCATE(DstInitTypeData%PropsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropsR = SrcInitTypeData%PropsR -ENDIF -IF (ALLOCATED(SrcInitTypeData%K)) THEN - i1_l = LBOUND(SrcInitTypeData%K,1) - i1_u = UBOUND(SrcInitTypeData%K,1) - i2_l = LBOUND(SrcInitTypeData%K,2) - i2_u = UBOUND(SrcInitTypeData%K,2) - IF (.NOT. ALLOCATED(DstInitTypeData%K)) THEN - ALLOCATE(DstInitTypeData%K(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%K = SrcInitTypeData%K -ENDIF -IF (ALLOCATED(SrcInitTypeData%M)) THEN - i1_l = LBOUND(SrcInitTypeData%M,1) - i1_u = UBOUND(SrcInitTypeData%M,1) - i2_l = LBOUND(SrcInitTypeData%M,2) - i2_u = UBOUND(SrcInitTypeData%M,2) - IF (.NOT. ALLOCATED(DstInitTypeData%M)) THEN - ALLOCATE(DstInitTypeData%M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%M = SrcInitTypeData%M -ENDIF -IF (ALLOCATED(SrcInitTypeData%ElemProps)) THEN - i1_l = LBOUND(SrcInitTypeData%ElemProps,1) - i1_u = UBOUND(SrcInitTypeData%ElemProps,1) - i2_l = LBOUND(SrcInitTypeData%ElemProps,2) - i2_u = UBOUND(SrcInitTypeData%ElemProps,2) - IF (.NOT. ALLOCATED(DstInitTypeData%ElemProps)) THEN - ALLOCATE(DstInitTypeData%ElemProps(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%ElemProps = SrcInitTypeData%ElemProps -ENDIF -IF (ALLOCATED(SrcInitTypeData%MemberNodes)) THEN - i1_l = LBOUND(SrcInitTypeData%MemberNodes,1) - i1_u = UBOUND(SrcInitTypeData%MemberNodes,1) - i2_l = LBOUND(SrcInitTypeData%MemberNodes,2) - i2_u = UBOUND(SrcInitTypeData%MemberNodes,2) - IF (.NOT. ALLOCATED(DstInitTypeData%MemberNodes)) THEN - ALLOCATE(DstInitTypeData%MemberNodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%MemberNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%MemberNodes = SrcInitTypeData%MemberNodes -ENDIF -IF (ALLOCATED(SrcInitTypeData%NodesConnN)) THEN - i1_l = LBOUND(SrcInitTypeData%NodesConnN,1) - i1_u = UBOUND(SrcInitTypeData%NodesConnN,1) - i2_l = LBOUND(SrcInitTypeData%NodesConnN,2) - i2_u = UBOUND(SrcInitTypeData%NodesConnN,2) - IF (.NOT. ALLOCATED(DstInitTypeData%NodesConnN)) THEN - ALLOCATE(DstInitTypeData%NodesConnN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%NodesConnN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%NodesConnN = SrcInitTypeData%NodesConnN -ENDIF -IF (ALLOCATED(SrcInitTypeData%NodesConnE)) THEN - i1_l = LBOUND(SrcInitTypeData%NodesConnE,1) - i1_u = UBOUND(SrcInitTypeData%NodesConnE,1) - i2_l = LBOUND(SrcInitTypeData%NodesConnE,2) - i2_u = UBOUND(SrcInitTypeData%NodesConnE,2) - IF (.NOT. ALLOCATED(DstInitTypeData%NodesConnE)) THEN - ALLOCATE(DstInitTypeData%NodesConnE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%NodesConnE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%NodesConnE = SrcInitTypeData%NodesConnE -ENDIF - DstInitTypeData%SSSum = SrcInitTypeData%SSSum - END SUBROUTINE SD_CopyInitType - - SUBROUTINE SD_DestroyInitType( InitTypeData, ErrStat, ErrMsg ) - TYPE(SD_InitType), INTENT(INOUT) :: InitTypeData - 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 = 'SD_DestroyInitType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitTypeData%Joints)) THEN - DEALLOCATE(InitTypeData%Joints) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsB)) THEN - DEALLOCATE(InitTypeData%PropSetsB) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsC)) THEN - DEALLOCATE(InitTypeData%PropSetsC) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsR)) THEN - DEALLOCATE(InitTypeData%PropSetsR) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsX)) THEN - DEALLOCATE(InitTypeData%PropSetsX) -ENDIF -IF (ALLOCATED(InitTypeData%COSMs)) THEN - DEALLOCATE(InitTypeData%COSMs) -ENDIF -IF (ALLOCATED(InitTypeData%CMass)) THEN - DEALLOCATE(InitTypeData%CMass) -ENDIF -IF (ALLOCATED(InitTypeData%JDampings)) THEN - DEALLOCATE(InitTypeData%JDampings) -ENDIF -IF (ALLOCATED(InitTypeData%Members)) THEN - DEALLOCATE(InitTypeData%Members) -ENDIF -IF (ALLOCATED(InitTypeData%SSOutList)) THEN - DEALLOCATE(InitTypeData%SSOutList) -ENDIF -IF (ALLOCATED(InitTypeData%SSIK)) THEN - DEALLOCATE(InitTypeData%SSIK) -ENDIF -IF (ALLOCATED(InitTypeData%SSIM)) THEN - DEALLOCATE(InitTypeData%SSIM) -ENDIF -IF (ALLOCATED(InitTypeData%SSIfile)) THEN - DEALLOCATE(InitTypeData%SSIfile) -ENDIF -IF (ALLOCATED(InitTypeData%Soil_K)) THEN - DEALLOCATE(InitTypeData%Soil_K) -ENDIF -IF (ALLOCATED(InitTypeData%Soil_Points)) THEN - DEALLOCATE(InitTypeData%Soil_Points) -ENDIF -IF (ALLOCATED(InitTypeData%Soil_Nodes)) THEN - DEALLOCATE(InitTypeData%Soil_Nodes) -ENDIF -IF (ALLOCATED(InitTypeData%Nodes)) THEN - DEALLOCATE(InitTypeData%Nodes) -ENDIF -IF (ALLOCATED(InitTypeData%PropsB)) THEN - DEALLOCATE(InitTypeData%PropsB) -ENDIF -IF (ALLOCATED(InitTypeData%PropsC)) THEN - DEALLOCATE(InitTypeData%PropsC) -ENDIF -IF (ALLOCATED(InitTypeData%PropsR)) THEN - DEALLOCATE(InitTypeData%PropsR) -ENDIF -IF (ALLOCATED(InitTypeData%K)) THEN - DEALLOCATE(InitTypeData%K) -ENDIF -IF (ALLOCATED(InitTypeData%M)) THEN - DEALLOCATE(InitTypeData%M) -ENDIF -IF (ALLOCATED(InitTypeData%ElemProps)) THEN - DEALLOCATE(InitTypeData%ElemProps) -ENDIF -IF (ALLOCATED(InitTypeData%MemberNodes)) THEN - DEALLOCATE(InitTypeData%MemberNodes) -ENDIF -IF (ALLOCATED(InitTypeData%NodesConnN)) THEN - DEALLOCATE(InitTypeData%NodesConnN) -ENDIF -IF (ALLOCATED(InitTypeData%NodesConnE)) THEN - DEALLOCATE(InitTypeData%NodesConnE) -ENDIF - END SUBROUTINE SD_DestroyInitType - - SUBROUTINE SD_PackInitType( 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(SD_InitType), 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 = 'SD_PackInitType' - ! 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%RootName) ! RootName - Re_BufSz = Re_BufSz + SIZE(InData%TP_RefPoint) ! TP_RefPoint - Re_BufSz = Re_BufSz + 1 ! SubRotateZ - Re_BufSz = Re_BufSz + 1 ! g - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! NJoints - Int_BufSz = Int_BufSz + 1 ! NPropSetsX - Int_BufSz = Int_BufSz + 1 ! NPropSetsB - Int_BufSz = Int_BufSz + 1 ! NPropSetsC - Int_BufSz = Int_BufSz + 1 ! NPropSetsR - Int_BufSz = Int_BufSz + 1 ! NCMass - Int_BufSz = Int_BufSz + 1 ! NCOSMs - Int_BufSz = Int_BufSz + 1 ! FEMMod - Int_BufSz = Int_BufSz + 1 ! NDiv - Int_BufSz = Int_BufSz + 1 ! CBMod - Int_BufSz = Int_BufSz + 1 ! Joints allocated yes/no - IF ( ALLOCATED(InData%Joints) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Joints upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Joints) ! Joints - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsB allocated yes/no - IF ( ALLOCATED(InData%PropSetsB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsB) ! PropSetsB - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsC allocated yes/no - IF ( ALLOCATED(InData%PropSetsC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsC) ! PropSetsC - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsR allocated yes/no - IF ( ALLOCATED(InData%PropSetsR) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsR) ! PropSetsR - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsX allocated yes/no - IF ( ALLOCATED(InData%PropSetsX) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsX) ! PropSetsX - END IF - Int_BufSz = Int_BufSz + 1 ! COSMs allocated yes/no - IF ( ALLOCATED(InData%COSMs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! COSMs upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%COSMs) ! COSMs - END IF - Int_BufSz = Int_BufSz + 1 ! CMass allocated yes/no - IF ( ALLOCATED(InData%CMass) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMass) ! CMass - END IF - Int_BufSz = Int_BufSz + 1 ! JDampings allocated yes/no - IF ( ALLOCATED(InData%JDampings) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! JDampings upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%JDampings) ! JDampings - END IF - Int_BufSz = Int_BufSz + 1 ! GuyanDampMod - Re_BufSz = Re_BufSz + SIZE(InData%RayleighDamp) ! RayleighDamp - Re_BufSz = Re_BufSz + SIZE(InData%GuyanDampMat) ! GuyanDampMat - Int_BufSz = Int_BufSz + 1 ! Members allocated yes/no - IF ( ALLOCATED(InData%Members) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Members upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Members) ! Members - END IF - Int_BufSz = Int_BufSz + 1 ! SSOutList allocated yes/no - IF ( ALLOCATED(InData%SSOutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SSOutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SSOutList)*LEN(InData%SSOutList) ! SSOutList - END IF - Int_BufSz = Int_BufSz + 1 ! OutCOSM - Int_BufSz = Int_BufSz + 1 ! TabDelim - Int_BufSz = Int_BufSz + 1 ! SSIK allocated yes/no - IF ( ALLOCATED(InData%SSIK) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SSIK upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SSIK) ! SSIK - END IF - Int_BufSz = Int_BufSz + 1 ! SSIM allocated yes/no - IF ( ALLOCATED(InData%SSIM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SSIM upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SSIM) ! SSIM - END IF - Int_BufSz = Int_BufSz + 1 ! SSIfile allocated yes/no - IF ( ALLOCATED(InData%SSIfile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SSIfile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SSIfile)*LEN(InData%SSIfile) ! SSIfile - END IF - Int_BufSz = Int_BufSz + 1 ! Soil_K allocated yes/no - IF ( ALLOCATED(InData%Soil_K) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Soil_K upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Soil_K) ! Soil_K - END IF - Int_BufSz = Int_BufSz + 1 ! Soil_Points allocated yes/no - IF ( ALLOCATED(InData%Soil_Points) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Soil_Points upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Soil_Points) ! Soil_Points - END IF - Int_BufSz = Int_BufSz + 1 ! Soil_Nodes allocated yes/no - IF ( ALLOCATED(InData%Soil_Nodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Soil_Nodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Soil_Nodes) ! Soil_Nodes - END IF - Int_BufSz = Int_BufSz + 1 ! NElem - Int_BufSz = Int_BufSz + 1 ! NPropB - Int_BufSz = Int_BufSz + 1 ! NPropC - Int_BufSz = Int_BufSz + 1 ! NPropR - Int_BufSz = Int_BufSz + 1 ! Nodes allocated yes/no - IF ( ALLOCATED(InData%Nodes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Nodes) ! Nodes - END IF - Int_BufSz = Int_BufSz + 1 ! PropsB allocated yes/no - IF ( ALLOCATED(InData%PropsB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropsB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropsB) ! PropsB - END IF - Int_BufSz = Int_BufSz + 1 ! PropsC allocated yes/no - IF ( ALLOCATED(InData%PropsC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropsC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropsC) ! PropsC - END IF - Int_BufSz = Int_BufSz + 1 ! PropsR allocated yes/no - IF ( ALLOCATED(InData%PropsR) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropsR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropsR) ! PropsR - END IF - Int_BufSz = Int_BufSz + 1 ! K allocated yes/no - IF ( ALLOCATED(InData%K) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%K) ! K - END IF - Int_BufSz = Int_BufSz + 1 ! M allocated yes/no - IF ( ALLOCATED(InData%M) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - END IF - Int_BufSz = Int_BufSz + 1 ! ElemProps allocated yes/no - IF ( ALLOCATED(InData%ElemProps) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElemProps upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ElemProps) ! ElemProps - END IF - Int_BufSz = Int_BufSz + 1 ! MemberNodes allocated yes/no - IF ( ALLOCATED(InData%MemberNodes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MemberNodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MemberNodes) ! MemberNodes - END IF - Int_BufSz = Int_BufSz + 1 ! NodesConnN allocated yes/no - IF ( ALLOCATED(InData%NodesConnN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! NodesConnN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodesConnN) ! NodesConnN - END IF - Int_BufSz = Int_BufSz + 1 ! NodesConnE allocated yes/no - IF ( ALLOCATED(InData%NodesConnE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! NodesConnE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodesConnE) ! NodesConnE - END IF - Int_BufSz = Int_BufSz + 1 ! SSSum - 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%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%TP_RefPoint,1), UBOUND(InData%TP_RefPoint,1) - ReKiBuf(Re_Xferred) = InData%TP_RefPoint(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%SubRotateZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%g - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsX - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsR - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NCMass - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NCOSMs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FEMMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NDiv - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CBMod, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Joints) ) 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%Joints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Joints,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Joints,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Joints,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Joints,2), UBOUND(InData%Joints,2) - DO i1 = LBOUND(InData%Joints,1), UBOUND(InData%Joints,1) - ReKiBuf(Re_Xferred) = InData%Joints(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsB) ) 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%PropSetsB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsB,2), UBOUND(InData%PropSetsB,2) - DO i1 = LBOUND(InData%PropSetsB,1), UBOUND(InData%PropSetsB,1) - ReKiBuf(Re_Xferred) = InData%PropSetsB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsC) ) 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%PropSetsC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsC,2), UBOUND(InData%PropSetsC,2) - DO i1 = LBOUND(InData%PropSetsC,1), UBOUND(InData%PropSetsC,1) - ReKiBuf(Re_Xferred) = InData%PropSetsC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsR) ) 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%PropSetsR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsR,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsR,2), UBOUND(InData%PropSetsR,2) - DO i1 = LBOUND(InData%PropSetsR,1), UBOUND(InData%PropSetsR,1) - ReKiBuf(Re_Xferred) = InData%PropSetsR(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsX) ) 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%PropSetsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsX,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsX,2), UBOUND(InData%PropSetsX,2) - DO i1 = LBOUND(InData%PropSetsX,1), UBOUND(InData%PropSetsX,1) - ReKiBuf(Re_Xferred) = InData%PropSetsX(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%COSMs) ) 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%COSMs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%COSMs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%COSMs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%COSMs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%COSMs,2), UBOUND(InData%COSMs,2) - DO i1 = LBOUND(InData%COSMs,1), UBOUND(InData%COSMs,1) - DbKiBuf(Db_Xferred) = InData%COSMs(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMass) ) 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%CMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMass,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CMass,2), UBOUND(InData%CMass,2) - DO i1 = LBOUND(InData%CMass,1), UBOUND(InData%CMass,1) - ReKiBuf(Re_Xferred) = InData%CMass(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%JDampings) ) 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%JDampings,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%JDampings,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%JDampings,1), UBOUND(InData%JDampings,1) - ReKiBuf(Re_Xferred) = InData%JDampings(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%GuyanDampMod - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RayleighDamp,1), UBOUND(InData%RayleighDamp,1) - ReKiBuf(Re_Xferred) = InData%RayleighDamp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%GuyanDampMat,2), UBOUND(InData%GuyanDampMat,2) - DO i1 = LBOUND(InData%GuyanDampMat,1), UBOUND(InData%GuyanDampMat,1) - ReKiBuf(Re_Xferred) = InData%GuyanDampMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%Members) ) 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%Members,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Members,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Members,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Members,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Members,2), UBOUND(InData%Members,2) - DO i1 = LBOUND(InData%Members,1), UBOUND(InData%Members,1) - IntKiBuf(Int_Xferred) = InData%Members(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SSOutList) ) 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%SSOutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSOutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SSOutList,1), UBOUND(InData%SSOutList,1) - DO I = 1, LEN(InData%SSOutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%SSOutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutCOSM, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SSIK) ) 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%SSIK,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIK,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIK,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIK,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SSIK,2), UBOUND(InData%SSIK,2) - DO i1 = LBOUND(InData%SSIK,1), UBOUND(InData%SSIK,1) - DbKiBuf(Db_Xferred) = InData%SSIK(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SSIM) ) 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%SSIM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SSIM,2), UBOUND(InData%SSIM,2) - DO i1 = LBOUND(InData%SSIM,1), UBOUND(InData%SSIM,1) - DbKiBuf(Db_Xferred) = InData%SSIM(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SSIfile) ) 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%SSIfile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIfile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SSIfile,1), UBOUND(InData%SSIfile,1) - DO I = 1, LEN(InData%SSIfile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SSIfile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Soil_K) ) 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%Soil_K,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_K,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_K,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_K,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_K,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_K,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Soil_K,3), UBOUND(InData%Soil_K,3) - DO i2 = LBOUND(InData%Soil_K,2), UBOUND(InData%Soil_K,2) - DO i1 = LBOUND(InData%Soil_K,1), UBOUND(InData%Soil_K,1) - ReKiBuf(Re_Xferred) = InData%Soil_K(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Soil_Points) ) 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%Soil_Points,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_Points,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_Points,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_Points,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Soil_Points,2), UBOUND(InData%Soil_Points,2) - DO i1 = LBOUND(InData%Soil_Points,1), UBOUND(InData%Soil_Points,1) - ReKiBuf(Re_Xferred) = InData%Soil_Points(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Soil_Nodes) ) 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%Soil_Nodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_Nodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Soil_Nodes,1), UBOUND(InData%Soil_Nodes,1) - IntKiBuf(Int_Xferred) = InData%Soil_Nodes(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NElem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropR - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Nodes) ) 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%Nodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes,2), UBOUND(InData%Nodes,2) - DO i1 = LBOUND(InData%Nodes,1), UBOUND(InData%Nodes,1) - ReKiBuf(Re_Xferred) = InData%Nodes(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropsB) ) 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%PropsB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropsB,2), UBOUND(InData%PropsB,2) - DO i1 = LBOUND(InData%PropsB,1), UBOUND(InData%PropsB,1) - ReKiBuf(Re_Xferred) = InData%PropsB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropsC) ) 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%PropsC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropsC,2), UBOUND(InData%PropsC,2) - DO i1 = LBOUND(InData%PropsC,1), UBOUND(InData%PropsC,1) - ReKiBuf(Re_Xferred) = InData%PropsC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropsR) ) 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%PropsR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsR,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropsR,2), UBOUND(InData%PropsR,2) - DO i1 = LBOUND(InData%PropsR,1), UBOUND(InData%PropsR,1) - ReKiBuf(Re_Xferred) = InData%PropsR(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%K) ) 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%K,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%K,2), UBOUND(InData%K,2) - DO i1 = LBOUND(InData%K,1), UBOUND(InData%K,1) - DbKiBuf(Db_Xferred) = InData%K(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M) ) 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%M,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) - DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) - DbKiBuf(Db_Xferred) = InData%M(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElemProps) ) 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%ElemProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemProps,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElemProps,2), UBOUND(InData%ElemProps,2) - DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) - ReKiBuf(Re_Xferred) = InData%ElemProps(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MemberNodes) ) 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%MemberNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberNodes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MemberNodes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberNodes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MemberNodes,2), UBOUND(InData%MemberNodes,2) - DO i1 = LBOUND(InData%MemberNodes,1), UBOUND(InData%MemberNodes,1) - IntKiBuf(Int_Xferred) = InData%MemberNodes(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodesConnN) ) 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%NodesConnN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%NodesConnN,2), UBOUND(InData%NodesConnN,2) - DO i1 = LBOUND(InData%NodesConnN,1), UBOUND(InData%NodesConnN,1) - IntKiBuf(Int_Xferred) = InData%NodesConnN(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodesConnE) ) 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%NodesConnE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%NodesConnE,2), UBOUND(InData%NodesConnE,2) - DO i1 = LBOUND(InData%NodesConnE,1), UBOUND(InData%NodesConnE,1) - IntKiBuf(Int_Xferred) = InData%NodesConnE(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%SSSum, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackInitType - - SUBROUTINE SD_UnPackInitType( 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(SD_InitType), 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 = 'SD_UnPackInitType' - ! 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%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%TP_RefPoint,1) - i1_u = UBOUND(OutData%TP_RefPoint,1) - DO i1 = LBOUND(OutData%TP_RefPoint,1), UBOUND(OutData%TP_RefPoint,1) - OutData%TP_RefPoint(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%SubRotateZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%g = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NJoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsX = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsR = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NCMass = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NCOSMs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FEMMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NDiv = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CBMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%CBMod) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Joints 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%Joints)) DEALLOCATE(OutData%Joints) - ALLOCATE(OutData%Joints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Joints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Joints,2), UBOUND(OutData%Joints,2) - DO i1 = LBOUND(OutData%Joints,1), UBOUND(OutData%Joints,1) - OutData%Joints(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsB 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%PropSetsB)) DEALLOCATE(OutData%PropSetsB) - ALLOCATE(OutData%PropSetsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsB,2), UBOUND(OutData%PropSetsB,2) - DO i1 = LBOUND(OutData%PropSetsB,1), UBOUND(OutData%PropSetsB,1) - OutData%PropSetsB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsC 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%PropSetsC)) DEALLOCATE(OutData%PropSetsC) - ALLOCATE(OutData%PropSetsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsC,2), UBOUND(OutData%PropSetsC,2) - DO i1 = LBOUND(OutData%PropSetsC,1), UBOUND(OutData%PropSetsC,1) - OutData%PropSetsC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsR 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%PropSetsR)) DEALLOCATE(OutData%PropSetsR) - ALLOCATE(OutData%PropSetsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsR,2), UBOUND(OutData%PropSetsR,2) - DO i1 = LBOUND(OutData%PropSetsR,1), UBOUND(OutData%PropSetsR,1) - OutData%PropSetsR(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsX 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%PropSetsX)) DEALLOCATE(OutData%PropSetsX) - ALLOCATE(OutData%PropSetsX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsX,2), UBOUND(OutData%PropSetsX,2) - DO i1 = LBOUND(OutData%PropSetsX,1), UBOUND(OutData%PropSetsX,1) - OutData%PropSetsX(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! COSMs 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%COSMs)) DEALLOCATE(OutData%COSMs) - ALLOCATE(OutData%COSMs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%COSMs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%COSMs,2), UBOUND(OutData%COSMs,2) - DO i1 = LBOUND(OutData%COSMs,1), UBOUND(OutData%COSMs,1) - OutData%COSMs(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMass 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%CMass)) DEALLOCATE(OutData%CMass) - ALLOCATE(OutData%CMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CMass,2), UBOUND(OutData%CMass,2) - DO i1 = LBOUND(OutData%CMass,1), UBOUND(OutData%CMass,1) - OutData%CMass(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JDampings 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%JDampings)) DEALLOCATE(OutData%JDampings) - ALLOCATE(OutData%JDampings(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%JDampings.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%JDampings,1), UBOUND(OutData%JDampings,1) - OutData%JDampings(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%GuyanDampMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RayleighDamp,1) - i1_u = UBOUND(OutData%RayleighDamp,1) - DO i1 = LBOUND(OutData%RayleighDamp,1), UBOUND(OutData%RayleighDamp,1) - OutData%RayleighDamp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%GuyanDampMat,1) - i1_u = UBOUND(OutData%GuyanDampMat,1) - i2_l = LBOUND(OutData%GuyanDampMat,2) - i2_u = UBOUND(OutData%GuyanDampMat,2) - DO i2 = LBOUND(OutData%GuyanDampMat,2), UBOUND(OutData%GuyanDampMat,2) - DO i1 = LBOUND(OutData%GuyanDampMat,1), UBOUND(OutData%GuyanDampMat,1) - OutData%GuyanDampMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Members 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%Members)) DEALLOCATE(OutData%Members) - ALLOCATE(OutData%Members(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Members,2), UBOUND(OutData%Members,2) - DO i1 = LBOUND(OutData%Members,1), UBOUND(OutData%Members,1) - OutData%Members(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSOutList 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%SSOutList)) DEALLOCATE(OutData%SSOutList) - ALLOCATE(OutData%SSOutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSOutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SSOutList,1), UBOUND(OutData%SSOutList,1) - DO I = 1, LEN(OutData%SSOutList) - OutData%SSOutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%OutCOSM = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutCOSM) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSIK 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%SSIK)) DEALLOCATE(OutData%SSIK) - ALLOCATE(OutData%SSIK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SSIK,2), UBOUND(OutData%SSIK,2) - DO i1 = LBOUND(OutData%SSIK,1), UBOUND(OutData%SSIK,1) - OutData%SSIK(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSIM 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%SSIM)) DEALLOCATE(OutData%SSIM) - ALLOCATE(OutData%SSIM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SSIM,2), UBOUND(OutData%SSIM,2) - DO i1 = LBOUND(OutData%SSIM,1), UBOUND(OutData%SSIM,1) - OutData%SSIM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSIfile 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%SSIfile)) DEALLOCATE(OutData%SSIfile) - ALLOCATE(OutData%SSIfile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIfile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SSIfile,1), UBOUND(OutData%SSIfile,1) - DO I = 1, LEN(OutData%SSIfile) - OutData%SSIfile(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 ! Soil_K 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%Soil_K)) DEALLOCATE(OutData%Soil_K) - ALLOCATE(OutData%Soil_K(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%Soil_K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Soil_K,3), UBOUND(OutData%Soil_K,3) - DO i2 = LBOUND(OutData%Soil_K,2), UBOUND(OutData%Soil_K,2) - DO i1 = LBOUND(OutData%Soil_K,1), UBOUND(OutData%Soil_K,1) - OutData%Soil_K(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Soil_Points 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%Soil_Points)) DEALLOCATE(OutData%Soil_Points) - ALLOCATE(OutData%Soil_Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Points.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Soil_Points,2), UBOUND(OutData%Soil_Points,2) - DO i1 = LBOUND(OutData%Soil_Points,1), UBOUND(OutData%Soil_Points,1) - OutData%Soil_Points(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Soil_Nodes 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%Soil_Nodes)) DEALLOCATE(OutData%Soil_Nodes) - ALLOCATE(OutData%Soil_Nodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Soil_Nodes,1), UBOUND(OutData%Soil_Nodes,1) - OutData%Soil_Nodes(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NElem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropR = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes 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%Nodes)) DEALLOCATE(OutData%Nodes) - ALLOCATE(OutData%Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes,2), UBOUND(OutData%Nodes,2) - DO i1 = LBOUND(OutData%Nodes,1), UBOUND(OutData%Nodes,1) - OutData%Nodes(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsB 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%PropsB)) DEALLOCATE(OutData%PropsB) - ALLOCATE(OutData%PropsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropsB,2), UBOUND(OutData%PropsB,2) - DO i1 = LBOUND(OutData%PropsB,1), UBOUND(OutData%PropsB,1) - OutData%PropsB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsC 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%PropsC)) DEALLOCATE(OutData%PropsC) - ALLOCATE(OutData%PropsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropsC,2), UBOUND(OutData%PropsC,2) - DO i1 = LBOUND(OutData%PropsC,1), UBOUND(OutData%PropsC,1) - OutData%PropsC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsR 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%PropsR)) DEALLOCATE(OutData%PropsR) - ALLOCATE(OutData%PropsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropsR,2), UBOUND(OutData%PropsR,2) - DO i1 = LBOUND(OutData%PropsR,1), UBOUND(OutData%PropsR,1) - OutData%PropsR(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K 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%K)) DEALLOCATE(OutData%K) - ALLOCATE(OutData%K(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%K,2), UBOUND(OutData%K,2) - DO i1 = LBOUND(OutData%K,1), UBOUND(OutData%K,1) - OutData%K(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M 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%M)) DEALLOCATE(OutData%M) - ALLOCATE(OutData%M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemProps 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%ElemProps)) DEALLOCATE(OutData%ElemProps) - ALLOCATE(OutData%ElemProps(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElemProps,2), UBOUND(OutData%ElemProps,2) - DO i1 = LBOUND(OutData%ElemProps,1), UBOUND(OutData%ElemProps,1) - OutData%ElemProps(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MemberNodes 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%MemberNodes)) DEALLOCATE(OutData%MemberNodes) - ALLOCATE(OutData%MemberNodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MemberNodes,2), UBOUND(OutData%MemberNodes,2) - DO i1 = LBOUND(OutData%MemberNodes,1), UBOUND(OutData%MemberNodes,1) - OutData%MemberNodes(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnN 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%NodesConnN)) DEALLOCATE(OutData%NodesConnN) - ALLOCATE(OutData%NodesConnN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%NodesConnN,2), UBOUND(OutData%NodesConnN,2) - DO i1 = LBOUND(OutData%NodesConnN,1), UBOUND(OutData%NodesConnN,1) - OutData%NodesConnN(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnE 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%NodesConnE)) DEALLOCATE(OutData%NodesConnE) - ALLOCATE(OutData%NodesConnE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%NodesConnE,2), UBOUND(OutData%NodesConnE,2) - DO i1 = LBOUND(OutData%NodesConnE,1), UBOUND(OutData%NodesConnE,1) - OutData%NodesConnE(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%SSSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%SSSum) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackInitType - - SUBROUTINE SD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%qm)) THEN - i1_l = LBOUND(SrcContStateData%qm,1) - i1_u = UBOUND(SrcContStateData%qm,1) - IF (.NOT. ALLOCATED(DstContStateData%qm)) THEN - ALLOCATE(DstContStateData%qm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%qm = SrcContStateData%qm -ENDIF -IF (ALLOCATED(SrcContStateData%qmdot)) THEN - i1_l = LBOUND(SrcContStateData%qmdot,1) - i1_u = UBOUND(SrcContStateData%qmdot,1) - IF (.NOT. ALLOCATED(DstContStateData%qmdot)) THEN - ALLOCATE(DstContStateData%qmdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qmdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%qmdot = SrcContStateData%qmdot -ENDIF - END SUBROUTINE SD_CopyContState - - SUBROUTINE SD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(SD_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 = 'SD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%qm)) THEN - DEALLOCATE(ContStateData%qm) -ENDIF -IF (ALLOCATED(ContStateData%qmdot)) THEN - DEALLOCATE(ContStateData%qmdot) -ENDIF - END SUBROUTINE SD_DestroyContState - - SUBROUTINE SD_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(SD_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 = 'SD_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 - Int_BufSz = Int_BufSz + 1 ! qm allocated yes/no - IF ( ALLOCATED(InData%qm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qm upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%qm) ! qm - END IF - Int_BufSz = Int_BufSz + 1 ! qmdot allocated yes/no - IF ( ALLOCATED(InData%qmdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qmdot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%qmdot) ! qmdot - 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%qm) ) 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%qm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qm,1), UBOUND(InData%qm,1) - DbKiBuf(Db_Xferred) = InData%qm(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%qmdot) ) 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%qmdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qmdot,1), UBOUND(InData%qmdot,1) - DbKiBuf(Db_Xferred) = InData%qmdot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackContState - - SUBROUTINE SD_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(SD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qm 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%qm)) DEALLOCATE(OutData%qm) - ALLOCATE(OutData%qm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qm,1), UBOUND(OutData%qm,1) - OutData%qm(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdot 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%qmdot)) DEALLOCATE(OutData%qmdot) - ALLOCATE(OutData%qmdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qmdot,1), UBOUND(OutData%qmdot,1) - OutData%qmdot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackContState - - SUBROUTINE SD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SD_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 = 'SD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE SD_CopyDiscState - - SUBROUTINE SD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(SD_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 = 'SD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SD_DestroyDiscState - - SUBROUTINE SD_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(SD_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 = 'SD_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 SD_PackDiscState - - SUBROUTINE SD_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(SD_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 = 'SD_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SD_UnPackDiscState - - SUBROUTINE SD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SD_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 = 'SD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE SD_CopyConstrState - - SUBROUTINE SD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(SD_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 = 'SD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SD_DestroyConstrState - - SUBROUTINE SD_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(SD_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 = 'SD_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 SD_PackConstrState - - SUBROUTINE SD_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(SD_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 = 'SD_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SD_UnPackConstrState - - SUBROUTINE SD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%xdot)) THEN - i1_l = LBOUND(SrcOtherStateData%xdot,1) - i1_u = UBOUND(SrcOtherStateData%xdot,1) - IF (.NOT. ALLOCATED(DstOtherStateData%xdot)) THEN - ALLOCATE(DstOtherStateData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL SD_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstOtherStateData%n = SrcOtherStateData%n - END SUBROUTINE SD_CopyOtherState - - SUBROUTINE SD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(SD_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 = 'SD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%xdot)) THEN -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL SD_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%xdot) -ENDIF - END SUBROUTINE SD_DestroyOtherState - - SUBROUTINE SD_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(SD_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 = 'SD_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 ! xdot allocated yes/no - IF ( ALLOCATED(InData%xdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xdot upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! n - 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%xdot) ) 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%xdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - 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%n - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackOtherState - - SUBROUTINE SD_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(SD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdot 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%xdot)) DEALLOCATE(OutData%xdot) - ALLOCATE(OutData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,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 SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - 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%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackOtherState - - SUBROUTINE SD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%qmdotdot)) THEN - i1_l = LBOUND(SrcMiscData%qmdotdot,1) - i1_u = UBOUND(SrcMiscData%qmdotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%qmdotdot)) THEN - ALLOCATE(DstMiscData%qmdotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%qmdotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%qmdotdot = SrcMiscData%qmdotdot -ENDIF - DstMiscData%u_TP = SrcMiscData%u_TP - DstMiscData%udot_TP = SrcMiscData%udot_TP - DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP -IF (ALLOCATED(SrcMiscData%F_L)) THEN - i1_l = LBOUND(SrcMiscData%F_L,1) - i1_u = UBOUND(SrcMiscData%F_L,1) - IF (.NOT. ALLOCATED(DstMiscData%F_L)) THEN - ALLOCATE(DstMiscData%F_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_L = SrcMiscData%F_L -ENDIF -IF (ALLOCATED(SrcMiscData%F_L2)) THEN - i1_l = LBOUND(SrcMiscData%F_L2,1) - i1_u = UBOUND(SrcMiscData%F_L2,1) - IF (.NOT. ALLOCATED(DstMiscData%F_L2)) THEN - ALLOCATE(DstMiscData%F_L2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_L2 = SrcMiscData%F_L2 -ENDIF -IF (ALLOCATED(SrcMiscData%UR_bar)) THEN - i1_l = LBOUND(SrcMiscData%UR_bar,1) - i1_u = UBOUND(SrcMiscData%UR_bar,1) - IF (.NOT. ALLOCATED(DstMiscData%UR_bar)) THEN - ALLOCATE(DstMiscData%UR_bar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UR_bar = SrcMiscData%UR_bar -ENDIF -IF (ALLOCATED(SrcMiscData%UR_bar_dot)) THEN - i1_l = LBOUND(SrcMiscData%UR_bar_dot,1) - i1_u = UBOUND(SrcMiscData%UR_bar_dot,1) - IF (.NOT. ALLOCATED(DstMiscData%UR_bar_dot)) THEN - ALLOCATE(DstMiscData%UR_bar_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UR_bar_dot = SrcMiscData%UR_bar_dot -ENDIF -IF (ALLOCATED(SrcMiscData%UR_bar_dotdot)) THEN - i1_l = LBOUND(SrcMiscData%UR_bar_dotdot,1) - i1_u = UBOUND(SrcMiscData%UR_bar_dotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%UR_bar_dotdot)) THEN - ALLOCATE(DstMiscData%UR_bar_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UR_bar_dotdot = SrcMiscData%UR_bar_dotdot -ENDIF -IF (ALLOCATED(SrcMiscData%UL)) THEN - i1_l = LBOUND(SrcMiscData%UL,1) - i1_u = UBOUND(SrcMiscData%UL,1) - IF (.NOT. ALLOCATED(DstMiscData%UL)) THEN - ALLOCATE(DstMiscData%UL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL = SrcMiscData%UL -ENDIF -IF (ALLOCATED(SrcMiscData%UL_NS)) THEN - i1_l = LBOUND(SrcMiscData%UL_NS,1) - i1_u = UBOUND(SrcMiscData%UL_NS,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_NS)) THEN - ALLOCATE(DstMiscData%UL_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_NS = SrcMiscData%UL_NS -ENDIF -IF (ALLOCATED(SrcMiscData%UL_dot)) THEN - i1_l = LBOUND(SrcMiscData%UL_dot,1) - i1_u = UBOUND(SrcMiscData%UL_dot,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_dot)) THEN - ALLOCATE(DstMiscData%UL_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_dot = SrcMiscData%UL_dot -ENDIF -IF (ALLOCATED(SrcMiscData%UL_dotdot)) THEN - i1_l = LBOUND(SrcMiscData%UL_dotdot,1) - i1_u = UBOUND(SrcMiscData%UL_dotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_dotdot)) THEN - ALLOCATE(DstMiscData%UL_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_dotdot = SrcMiscData%UL_dotdot -ENDIF -IF (ALLOCATED(SrcMiscData%DU_full)) THEN - i1_l = LBOUND(SrcMiscData%DU_full,1) - i1_u = UBOUND(SrcMiscData%DU_full,1) - IF (.NOT. ALLOCATED(DstMiscData%DU_full)) THEN - ALLOCATE(DstMiscData%DU_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DU_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DU_full = SrcMiscData%DU_full -ENDIF -IF (ALLOCATED(SrcMiscData%U_full)) THEN - i1_l = LBOUND(SrcMiscData%U_full,1) - i1_u = UBOUND(SrcMiscData%U_full,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full)) THEN - ALLOCATE(DstMiscData%U_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full = SrcMiscData%U_full -ENDIF -IF (ALLOCATED(SrcMiscData%U_full_NS)) THEN - i1_l = LBOUND(SrcMiscData%U_full_NS,1) - i1_u = UBOUND(SrcMiscData%U_full_NS,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_NS)) THEN - ALLOCATE(DstMiscData%U_full_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_NS = SrcMiscData%U_full_NS -ENDIF -IF (ALLOCATED(SrcMiscData%U_full_dot)) THEN - i1_l = LBOUND(SrcMiscData%U_full_dot,1) - i1_u = UBOUND(SrcMiscData%U_full_dot,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_dot)) THEN - ALLOCATE(DstMiscData%U_full_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_dot = SrcMiscData%U_full_dot -ENDIF -IF (ALLOCATED(SrcMiscData%U_full_dotdot)) THEN - i1_l = LBOUND(SrcMiscData%U_full_dotdot,1) - i1_u = UBOUND(SrcMiscData%U_full_dotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_dotdot)) THEN - ALLOCATE(DstMiscData%U_full_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_dotdot = SrcMiscData%U_full_dotdot -ENDIF -IF (ALLOCATED(SrcMiscData%U_full_elast)) THEN - i1_l = LBOUND(SrcMiscData%U_full_elast,1) - i1_u = UBOUND(SrcMiscData%U_full_elast,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_elast)) THEN - ALLOCATE(DstMiscData%U_full_elast(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_elast.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_elast = SrcMiscData%U_full_elast -ENDIF -IF (ALLOCATED(SrcMiscData%U_red)) THEN - i1_l = LBOUND(SrcMiscData%U_red,1) - i1_u = UBOUND(SrcMiscData%U_red,1) - IF (.NOT. ALLOCATED(DstMiscData%U_red)) THEN - ALLOCATE(DstMiscData%U_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_red = SrcMiscData%U_red -ENDIF -IF (ALLOCATED(SrcMiscData%FC_unit)) THEN - i1_l = LBOUND(SrcMiscData%FC_unit,1) - i1_u = UBOUND(SrcMiscData%FC_unit,1) - IF (.NOT. ALLOCATED(DstMiscData%FC_unit)) THEN - ALLOCATE(DstMiscData%FC_unit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FC_unit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FC_unit = SrcMiscData%FC_unit -ENDIF -IF (ALLOCATED(SrcMiscData%SDWrOutput)) THEN - i1_l = LBOUND(SrcMiscData%SDWrOutput,1) - i1_u = UBOUND(SrcMiscData%SDWrOutput,1) - IF (.NOT. ALLOCATED(DstMiscData%SDWrOutput)) THEN - ALLOCATE(DstMiscData%SDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SDWrOutput = SrcMiscData%SDWrOutput -ENDIF -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%Decimat = SrcMiscData%Decimat -IF (ALLOCATED(SrcMiscData%Fext)) THEN - i1_l = LBOUND(SrcMiscData%Fext,1) - i1_u = UBOUND(SrcMiscData%Fext,1) - IF (.NOT. ALLOCATED(DstMiscData%Fext)) THEN - ALLOCATE(DstMiscData%Fext(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Fext = SrcMiscData%Fext -ENDIF -IF (ALLOCATED(SrcMiscData%Fext_red)) THEN - i1_l = LBOUND(SrcMiscData%Fext_red,1) - i1_u = UBOUND(SrcMiscData%Fext_red,1) - IF (.NOT. ALLOCATED(DstMiscData%Fext_red)) THEN - ALLOCATE(DstMiscData%Fext_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Fext_red = SrcMiscData%Fext_red -ENDIF -IF (ALLOCATED(SrcMiscData%UL_SIM)) THEN - i1_l = LBOUND(SrcMiscData%UL_SIM,1) - i1_u = UBOUND(SrcMiscData%UL_SIM,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_SIM)) THEN - ALLOCATE(DstMiscData%UL_SIM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_SIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_SIM = SrcMiscData%UL_SIM -ENDIF -IF (ALLOCATED(SrcMiscData%UL_0m)) THEN - i1_l = LBOUND(SrcMiscData%UL_0m,1) - i1_u = UBOUND(SrcMiscData%UL_0m,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_0m)) THEN - ALLOCATE(DstMiscData%UL_0m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_0m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_0m = SrcMiscData%UL_0m -ENDIF - END SUBROUTINE SD_CopyMisc - - SUBROUTINE SD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SD_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 = 'SD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%qmdotdot)) THEN - DEALLOCATE(MiscData%qmdotdot) -ENDIF -IF (ALLOCATED(MiscData%F_L)) THEN - DEALLOCATE(MiscData%F_L) -ENDIF -IF (ALLOCATED(MiscData%F_L2)) THEN - DEALLOCATE(MiscData%F_L2) -ENDIF -IF (ALLOCATED(MiscData%UR_bar)) THEN - DEALLOCATE(MiscData%UR_bar) -ENDIF -IF (ALLOCATED(MiscData%UR_bar_dot)) THEN - DEALLOCATE(MiscData%UR_bar_dot) -ENDIF -IF (ALLOCATED(MiscData%UR_bar_dotdot)) THEN - DEALLOCATE(MiscData%UR_bar_dotdot) -ENDIF -IF (ALLOCATED(MiscData%UL)) THEN - DEALLOCATE(MiscData%UL) -ENDIF -IF (ALLOCATED(MiscData%UL_NS)) THEN - DEALLOCATE(MiscData%UL_NS) -ENDIF -IF (ALLOCATED(MiscData%UL_dot)) THEN - DEALLOCATE(MiscData%UL_dot) -ENDIF -IF (ALLOCATED(MiscData%UL_dotdot)) THEN - DEALLOCATE(MiscData%UL_dotdot) -ENDIF -IF (ALLOCATED(MiscData%DU_full)) THEN - DEALLOCATE(MiscData%DU_full) -ENDIF -IF (ALLOCATED(MiscData%U_full)) THEN - DEALLOCATE(MiscData%U_full) -ENDIF -IF (ALLOCATED(MiscData%U_full_NS)) THEN - DEALLOCATE(MiscData%U_full_NS) -ENDIF -IF (ALLOCATED(MiscData%U_full_dot)) THEN - DEALLOCATE(MiscData%U_full_dot) -ENDIF -IF (ALLOCATED(MiscData%U_full_dotdot)) THEN - DEALLOCATE(MiscData%U_full_dotdot) -ENDIF -IF (ALLOCATED(MiscData%U_full_elast)) THEN - DEALLOCATE(MiscData%U_full_elast) -ENDIF -IF (ALLOCATED(MiscData%U_red)) THEN - DEALLOCATE(MiscData%U_red) -ENDIF -IF (ALLOCATED(MiscData%FC_unit)) THEN - DEALLOCATE(MiscData%FC_unit) -ENDIF -IF (ALLOCATED(MiscData%SDWrOutput)) THEN - DEALLOCATE(MiscData%SDWrOutput) -ENDIF -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%Fext)) THEN - DEALLOCATE(MiscData%Fext) -ENDIF -IF (ALLOCATED(MiscData%Fext_red)) THEN - DEALLOCATE(MiscData%Fext_red) -ENDIF -IF (ALLOCATED(MiscData%UL_SIM)) THEN - DEALLOCATE(MiscData%UL_SIM) -ENDIF -IF (ALLOCATED(MiscData%UL_0m)) THEN - DEALLOCATE(MiscData%UL_0m) -ENDIF - END SUBROUTINE SD_DestroyMisc - - SUBROUTINE SD_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(SD_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 = 'SD_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 ! qmdotdot allocated yes/no - IF ( ALLOCATED(InData%qmdotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qmdotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%qmdotdot) ! qmdotdot - END IF - Re_BufSz = Re_BufSz + SIZE(InData%u_TP) ! u_TP - Re_BufSz = Re_BufSz + SIZE(InData%udot_TP) ! udot_TP - Re_BufSz = Re_BufSz + SIZE(InData%udotdot_TP) ! udotdot_TP - Int_BufSz = Int_BufSz + 1 ! F_L allocated yes/no - IF ( ALLOCATED(InData%F_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_L upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_L) ! F_L - END IF - Int_BufSz = Int_BufSz + 1 ! F_L2 allocated yes/no - IF ( ALLOCATED(InData%F_L2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_L2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_L2) ! F_L2 - END IF - Int_BufSz = Int_BufSz + 1 ! UR_bar allocated yes/no - IF ( ALLOCATED(InData%UR_bar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UR_bar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UR_bar) ! UR_bar - END IF - Int_BufSz = Int_BufSz + 1 ! UR_bar_dot allocated yes/no - IF ( ALLOCATED(InData%UR_bar_dot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UR_bar_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UR_bar_dot) ! UR_bar_dot - END IF - Int_BufSz = Int_BufSz + 1 ! UR_bar_dotdot allocated yes/no - IF ( ALLOCATED(InData%UR_bar_dotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UR_bar_dotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UR_bar_dotdot) ! UR_bar_dotdot - END IF - Int_BufSz = Int_BufSz + 1 ! UL allocated yes/no - IF ( ALLOCATED(InData%UL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL) ! UL - END IF - Int_BufSz = Int_BufSz + 1 ! UL_NS allocated yes/no - IF ( ALLOCATED(InData%UL_NS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_NS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_NS) ! UL_NS - END IF - Int_BufSz = Int_BufSz + 1 ! UL_dot allocated yes/no - IF ( ALLOCATED(InData%UL_dot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_dot) ! UL_dot - END IF - Int_BufSz = Int_BufSz + 1 ! UL_dotdot allocated yes/no - IF ( ALLOCATED(InData%UL_dotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_dotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_dotdot) ! UL_dotdot - END IF - Int_BufSz = Int_BufSz + 1 ! DU_full allocated yes/no - IF ( ALLOCATED(InData%DU_full) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DU_full upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DU_full) ! DU_full - END IF - Int_BufSz = Int_BufSz + 1 ! U_full allocated yes/no - IF ( ALLOCATED(InData%U_full) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full) ! U_full - END IF - Int_BufSz = Int_BufSz + 1 ! U_full_NS allocated yes/no - IF ( ALLOCATED(InData%U_full_NS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_NS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_NS) ! U_full_NS - END IF - Int_BufSz = Int_BufSz + 1 ! U_full_dot allocated yes/no - IF ( ALLOCATED(InData%U_full_dot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_dot) ! U_full_dot - END IF - Int_BufSz = Int_BufSz + 1 ! U_full_dotdot allocated yes/no - IF ( ALLOCATED(InData%U_full_dotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_dotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_dotdot) ! U_full_dotdot - END IF - Int_BufSz = Int_BufSz + 1 ! U_full_elast allocated yes/no - IF ( ALLOCATED(InData%U_full_elast) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_elast upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_elast) ! U_full_elast - END IF - Int_BufSz = Int_BufSz + 1 ! U_red allocated yes/no - IF ( ALLOCATED(InData%U_red) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_red upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_red) ! U_red - END IF - Int_BufSz = Int_BufSz + 1 ! FC_unit allocated yes/no - IF ( ALLOCATED(InData%FC_unit) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FC_unit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FC_unit) ! FC_unit - END IF - Int_BufSz = Int_BufSz + 1 ! SDWrOutput allocated yes/no - IF ( ALLOCATED(InData%SDWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SDWrOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SDWrOutput) ! SDWrOutput - END IF - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Db_BufSz = Db_BufSz + 1 ! LastOutTime - Int_BufSz = Int_BufSz + 1 ! Decimat - Int_BufSz = Int_BufSz + 1 ! Fext allocated yes/no - IF ( ALLOCATED(InData%Fext) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fext upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Fext) ! Fext - END IF - Int_BufSz = Int_BufSz + 1 ! Fext_red allocated yes/no - IF ( ALLOCATED(InData%Fext_red) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fext_red upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Fext_red) ! Fext_red - END IF - Int_BufSz = Int_BufSz + 1 ! UL_SIM allocated yes/no - IF ( ALLOCATED(InData%UL_SIM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_SIM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_SIM) ! UL_SIM - END IF - Int_BufSz = Int_BufSz + 1 ! UL_0m allocated yes/no - IF ( ALLOCATED(InData%UL_0m) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_0m upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_0m) ! UL_0m - 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%qmdotdot) ) 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%qmdotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qmdotdot,1), UBOUND(InData%qmdotdot,1) - ReKiBuf(Re_Xferred) = InData%qmdotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%u_TP,1), UBOUND(InData%u_TP,1) - ReKiBuf(Re_Xferred) = InData%u_TP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%udot_TP,1), UBOUND(InData%udot_TP,1) - ReKiBuf(Re_Xferred) = InData%udot_TP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%udotdot_TP,1), UBOUND(InData%udotdot_TP,1) - ReKiBuf(Re_Xferred) = InData%udotdot_TP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%F_L) ) 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%F_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_L,1), UBOUND(InData%F_L,1) - ReKiBuf(Re_Xferred) = InData%F_L(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_L2) ) 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%F_L2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_L2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_L2,1), UBOUND(InData%F_L2,1) - ReKiBuf(Re_Xferred) = InData%F_L2(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UR_bar) ) 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%UR_bar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UR_bar,1), UBOUND(InData%UR_bar,1) - ReKiBuf(Re_Xferred) = InData%UR_bar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UR_bar_dot) ) 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%UR_bar_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UR_bar_dot,1), UBOUND(InData%UR_bar_dot,1) - ReKiBuf(Re_Xferred) = InData%UR_bar_dot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UR_bar_dotdot) ) 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%UR_bar_dotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UR_bar_dotdot,1), UBOUND(InData%UR_bar_dotdot,1) - ReKiBuf(Re_Xferred) = InData%UR_bar_dotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL) ) 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%UL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL,1), UBOUND(InData%UL,1) - ReKiBuf(Re_Xferred) = InData%UL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_NS) ) 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%UL_NS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_NS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_NS,1), UBOUND(InData%UL_NS,1) - ReKiBuf(Re_Xferred) = InData%UL_NS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_dot) ) 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%UL_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_dot,1), UBOUND(InData%UL_dot,1) - ReKiBuf(Re_Xferred) = InData%UL_dot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_dotdot) ) 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%UL_dotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_dotdot,1), UBOUND(InData%UL_dotdot,1) - ReKiBuf(Re_Xferred) = InData%UL_dotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DU_full) ) 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%DU_full,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DU_full,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DU_full,1), UBOUND(InData%DU_full,1) - ReKiBuf(Re_Xferred) = InData%DU_full(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full) ) 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%U_full,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full,1), UBOUND(InData%U_full,1) - ReKiBuf(Re_Xferred) = InData%U_full(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full_NS) ) 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%U_full_NS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_NS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_NS,1), UBOUND(InData%U_full_NS,1) - ReKiBuf(Re_Xferred) = InData%U_full_NS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full_dot) ) 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%U_full_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_dot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_dot,1), UBOUND(InData%U_full_dot,1) - ReKiBuf(Re_Xferred) = InData%U_full_dot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full_dotdot) ) 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%U_full_dotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_dotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_dotdot,1), UBOUND(InData%U_full_dotdot,1) - ReKiBuf(Re_Xferred) = InData%U_full_dotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full_elast) ) 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%U_full_elast,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_elast,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_elast,1), UBOUND(InData%U_full_elast,1) - ReKiBuf(Re_Xferred) = InData%U_full_elast(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_red) ) 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%U_red,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_red,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_red,1), UBOUND(InData%U_red,1) - ReKiBuf(Re_Xferred) = InData%U_red(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FC_unit) ) 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%FC_unit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FC_unit,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FC_unit,1), UBOUND(InData%FC_unit,1) - ReKiBuf(Re_Xferred) = InData%FC_unit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SDWrOutput) ) 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%SDWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SDWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SDWrOutput,1), UBOUND(InData%SDWrOutput,1) - ReKiBuf(Re_Xferred) = InData%SDWrOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AllOuts) ) 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%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Decimat - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Fext) ) 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%Fext,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fext,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fext,1), UBOUND(InData%Fext,1) - ReKiBuf(Re_Xferred) = InData%Fext(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fext_red) ) 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%Fext_red,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fext_red,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fext_red,1), UBOUND(InData%Fext_red,1) - ReKiBuf(Re_Xferred) = InData%Fext_red(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_SIM) ) 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%UL_SIM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_SIM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_SIM,1), UBOUND(InData%UL_SIM,1) - ReKiBuf(Re_Xferred) = InData%UL_SIM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_0m) ) 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%UL_0m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_0m,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_0m,1), UBOUND(InData%UL_0m,1) - ReKiBuf(Re_Xferred) = InData%UL_0m(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackMisc - - SUBROUTINE SD_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(SD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdotdot 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%qmdotdot)) DEALLOCATE(OutData%qmdotdot) - ALLOCATE(OutData%qmdotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qmdotdot,1), UBOUND(OutData%qmdotdot,1) - OutData%qmdotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%u_TP,1) - i1_u = UBOUND(OutData%u_TP,1) - DO i1 = LBOUND(OutData%u_TP,1), UBOUND(OutData%u_TP,1) - OutData%u_TP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%udot_TP,1) - i1_u = UBOUND(OutData%udot_TP,1) - DO i1 = LBOUND(OutData%udot_TP,1), UBOUND(OutData%udot_TP,1) - OutData%udot_TP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%udotdot_TP,1) - i1_u = UBOUND(OutData%udotdot_TP,1) - DO i1 = LBOUND(OutData%udotdot_TP,1), UBOUND(OutData%udotdot_TP,1) - OutData%udotdot_TP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_L 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%F_L)) DEALLOCATE(OutData%F_L) - ALLOCATE(OutData%F_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_L,1), UBOUND(OutData%F_L,1) - OutData%F_L(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_L2 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%F_L2)) DEALLOCATE(OutData%F_L2) - ALLOCATE(OutData%F_L2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_L2,1), UBOUND(OutData%F_L2,1) - OutData%F_L2(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar 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%UR_bar)) DEALLOCATE(OutData%UR_bar) - ALLOCATE(OutData%UR_bar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UR_bar,1), UBOUND(OutData%UR_bar,1) - OutData%UR_bar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dot 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%UR_bar_dot)) DEALLOCATE(OutData%UR_bar_dot) - ALLOCATE(OutData%UR_bar_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UR_bar_dot,1), UBOUND(OutData%UR_bar_dot,1) - OutData%UR_bar_dot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dotdot 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%UR_bar_dotdot)) DEALLOCATE(OutData%UR_bar_dotdot) - ALLOCATE(OutData%UR_bar_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UR_bar_dotdot,1), UBOUND(OutData%UR_bar_dotdot,1) - OutData%UR_bar_dotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL 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%UL)) DEALLOCATE(OutData%UL) - ALLOCATE(OutData%UL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL,1), UBOUND(OutData%UL,1) - OutData%UL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_NS 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%UL_NS)) DEALLOCATE(OutData%UL_NS) - ALLOCATE(OutData%UL_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_NS,1), UBOUND(OutData%UL_NS,1) - OutData%UL_NS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dot 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%UL_dot)) DEALLOCATE(OutData%UL_dot) - ALLOCATE(OutData%UL_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_dot,1), UBOUND(OutData%UL_dot,1) - OutData%UL_dot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dotdot 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%UL_dotdot)) DEALLOCATE(OutData%UL_dotdot) - ALLOCATE(OutData%UL_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_dotdot,1), UBOUND(OutData%UL_dotdot,1) - OutData%UL_dotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DU_full 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%DU_full)) DEALLOCATE(OutData%DU_full) - ALLOCATE(OutData%DU_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DU_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DU_full,1), UBOUND(OutData%DU_full,1) - OutData%DU_full(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full 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%U_full)) DEALLOCATE(OutData%U_full) - ALLOCATE(OutData%U_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full,1), UBOUND(OutData%U_full,1) - OutData%U_full(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_NS 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%U_full_NS)) DEALLOCATE(OutData%U_full_NS) - ALLOCATE(OutData%U_full_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_NS,1), UBOUND(OutData%U_full_NS,1) - OutData%U_full_NS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_dot 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%U_full_dot)) DEALLOCATE(OutData%U_full_dot) - ALLOCATE(OutData%U_full_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_dot,1), UBOUND(OutData%U_full_dot,1) - OutData%U_full_dot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_dotdot 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%U_full_dotdot)) DEALLOCATE(OutData%U_full_dotdot) - ALLOCATE(OutData%U_full_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_dotdot,1), UBOUND(OutData%U_full_dotdot,1) - OutData%U_full_dotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_elast 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%U_full_elast)) DEALLOCATE(OutData%U_full_elast) - ALLOCATE(OutData%U_full_elast(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_elast.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_elast,1), UBOUND(OutData%U_full_elast,1) - OutData%U_full_elast(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_red 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%U_red)) DEALLOCATE(OutData%U_red) - ALLOCATE(OutData%U_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_red,1), UBOUND(OutData%U_red,1) - OutData%U_red(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FC_unit 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%FC_unit)) DEALLOCATE(OutData%FC_unit) - ALLOCATE(OutData%FC_unit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FC_unit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FC_unit,1), UBOUND(OutData%FC_unit,1) - OutData%FC_unit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SDWrOutput 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%SDWrOutput)) DEALLOCATE(OutData%SDWrOutput) - ALLOCATE(OutData%SDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SDWrOutput,1), UBOUND(OutData%SDWrOutput,1) - OutData%SDWrOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts 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%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%LastOutTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Decimat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fext 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%Fext)) DEALLOCATE(OutData%Fext) - ALLOCATE(OutData%Fext(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Fext,1), UBOUND(OutData%Fext,1) - OutData%Fext(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fext_red 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%Fext_red)) DEALLOCATE(OutData%Fext_red) - ALLOCATE(OutData%Fext_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Fext_red,1), UBOUND(OutData%Fext_red,1) - OutData%Fext_red(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_SIM 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%UL_SIM)) DEALLOCATE(OutData%UL_SIM) - ALLOCATE(OutData%UL_SIM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_SIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_SIM,1), UBOUND(OutData%UL_SIM,1) - OutData%UL_SIM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_0m 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%UL_0m)) DEALLOCATE(OutData%UL_0m) - ALLOCATE(OutData%UL_0m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_0m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_0m,1), UBOUND(OutData%UL_0m,1) - OutData%UL_0m(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackMisc - - SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SD_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 = 'SD_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%SDDeltaT = SrcParamData%SDDeltaT - DstParamData%IntMethod = SrcParamData%IntMethod - DstParamData%nDOF = SrcParamData%nDOF - DstParamData%nDOF_red = SrcParamData%nDOF_red - DstParamData%Nmembers = SrcParamData%Nmembers -IF (ALLOCATED(SrcParamData%Elems)) THEN - i1_l = LBOUND(SrcParamData%Elems,1) - i1_u = UBOUND(SrcParamData%Elems,1) - i2_l = LBOUND(SrcParamData%Elems,2) - i2_u = UBOUND(SrcParamData%Elems,2) - IF (.NOT. ALLOCATED(DstParamData%Elems)) THEN - ALLOCATE(DstParamData%Elems(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elems.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Elems = SrcParamData%Elems -ENDIF -IF (ALLOCATED(SrcParamData%ElemProps)) THEN - i1_l = LBOUND(SrcParamData%ElemProps,1) - i1_u = UBOUND(SrcParamData%ElemProps,1) - IF (.NOT. ALLOCATED(DstParamData%ElemProps)) THEN - ALLOCATE(DstParamData%ElemProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%ElemProps,1), UBOUND(SrcParamData%ElemProps,1) - CALL SD_Copyelemproptype( SrcParamData%ElemProps(i1), DstParamData%ElemProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%FG)) THEN - i1_l = LBOUND(SrcParamData%FG,1) - i1_u = UBOUND(SrcParamData%FG,1) - IF (.NOT. ALLOCATED(DstParamData%FG)) THEN - ALLOCATE(DstParamData%FG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FG = SrcParamData%FG -ENDIF -IF (ALLOCATED(SrcParamData%DP0)) THEN - i1_l = LBOUND(SrcParamData%DP0,1) - i1_u = UBOUND(SrcParamData%DP0,1) - i2_l = LBOUND(SrcParamData%DP0,2) - i2_u = UBOUND(SrcParamData%DP0,2) - IF (.NOT. ALLOCATED(DstParamData%DP0)) THEN - ALLOCATE(DstParamData%DP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DP0 = SrcParamData%DP0 -ENDIF -IF (ALLOCATED(SrcParamData%NodeID2JointID)) THEN - i1_l = LBOUND(SrcParamData%NodeID2JointID,1) - i1_u = UBOUND(SrcParamData%NodeID2JointID,1) - IF (.NOT. ALLOCATED(DstParamData%NodeID2JointID)) THEN - ALLOCATE(DstParamData%NodeID2JointID(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodeID2JointID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NodeID2JointID = SrcParamData%NodeID2JointID -ENDIF - DstParamData%reduced = SrcParamData%reduced -IF (ALLOCATED(SrcParamData%T_red)) THEN - i1_l = LBOUND(SrcParamData%T_red,1) - i1_u = UBOUND(SrcParamData%T_red,1) - i2_l = LBOUND(SrcParamData%T_red,2) - i2_u = UBOUND(SrcParamData%T_red,2) - IF (.NOT. ALLOCATED(DstParamData%T_red)) THEN - ALLOCATE(DstParamData%T_red(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%T_red = SrcParamData%T_red -ENDIF -IF (ALLOCATED(SrcParamData%T_red_T)) THEN - i1_l = LBOUND(SrcParamData%T_red_T,1) - i1_u = UBOUND(SrcParamData%T_red_T,1) - i2_l = LBOUND(SrcParamData%T_red_T,2) - i2_u = UBOUND(SrcParamData%T_red_T,2) - IF (.NOT. ALLOCATED(DstParamData%T_red_T)) THEN - ALLOCATE(DstParamData%T_red_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%T_red_T = SrcParamData%T_red_T -ENDIF -IF (ALLOCATED(SrcParamData%NodesDOF)) THEN - i1_l = LBOUND(SrcParamData%NodesDOF,1) - i1_u = UBOUND(SrcParamData%NodesDOF,1) - IF (.NOT. ALLOCATED(DstParamData%NodesDOF)) THEN - ALLOCATE(DstParamData%NodesDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%NodesDOF,1), UBOUND(SrcParamData%NodesDOF,1) - CALL SD_Copyilist( SrcParamData%NodesDOF(i1), DstParamData%NodesDOF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%NodesDOFred)) THEN - i1_l = LBOUND(SrcParamData%NodesDOFred,1) - i1_u = UBOUND(SrcParamData%NodesDOFred,1) - IF (.NOT. ALLOCATED(DstParamData%NodesDOFred)) THEN - ALLOCATE(DstParamData%NodesDOFred(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOFred.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%NodesDOFred,1), UBOUND(SrcParamData%NodesDOFred,1) - CALL SD_Copyilist( SrcParamData%NodesDOFred(i1), DstParamData%NodesDOFred(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%ElemsDOF)) THEN - i1_l = LBOUND(SrcParamData%ElemsDOF,1) - i1_u = UBOUND(SrcParamData%ElemsDOF,1) - i2_l = LBOUND(SrcParamData%ElemsDOF,2) - i2_u = UBOUND(SrcParamData%ElemsDOF,2) - IF (.NOT. ALLOCATED(DstParamData%ElemsDOF)) THEN - ALLOCATE(DstParamData%ElemsDOF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemsDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ElemsDOF = SrcParamData%ElemsDOF -ENDIF -IF (ALLOCATED(SrcParamData%DOFred2Nodes)) THEN - i1_l = LBOUND(SrcParamData%DOFred2Nodes,1) - i1_u = UBOUND(SrcParamData%DOFred2Nodes,1) - i2_l = LBOUND(SrcParamData%DOFred2Nodes,2) - i2_u = UBOUND(SrcParamData%DOFred2Nodes,2) - IF (.NOT. ALLOCATED(DstParamData%DOFred2Nodes)) THEN - ALLOCATE(DstParamData%DOFred2Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOFred2Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DOFred2Nodes = SrcParamData%DOFred2Nodes -ENDIF -IF (ALLOCATED(SrcParamData%CtrlElem2Channel)) THEN - i1_l = LBOUND(SrcParamData%CtrlElem2Channel,1) - i1_u = UBOUND(SrcParamData%CtrlElem2Channel,1) - i2_l = LBOUND(SrcParamData%CtrlElem2Channel,2) - i2_u = UBOUND(SrcParamData%CtrlElem2Channel,2) - IF (.NOT. ALLOCATED(DstParamData%CtrlElem2Channel)) THEN - ALLOCATE(DstParamData%CtrlElem2Channel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CtrlElem2Channel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CtrlElem2Channel = SrcParamData%CtrlElem2Channel -ENDIF - DstParamData%nDOFM = SrcParamData%nDOFM - DstParamData%SttcSolve = SrcParamData%SttcSolve - DstParamData%GuyanLoadCorrection = SrcParamData%GuyanLoadCorrection - DstParamData%Floating = SrcParamData%Floating -IF (ALLOCATED(SrcParamData%KMMDiag)) THEN - i1_l = LBOUND(SrcParamData%KMMDiag,1) - i1_u = UBOUND(SrcParamData%KMMDiag,1) - IF (.NOT. ALLOCATED(DstParamData%KMMDiag)) THEN - ALLOCATE(DstParamData%KMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KMMDiag = SrcParamData%KMMDiag -ENDIF -IF (ALLOCATED(SrcParamData%CMMDiag)) THEN - i1_l = LBOUND(SrcParamData%CMMDiag,1) - i1_u = UBOUND(SrcParamData%CMMDiag,1) - IF (.NOT. ALLOCATED(DstParamData%CMMDiag)) THEN - ALLOCATE(DstParamData%CMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CMMDiag = SrcParamData%CMMDiag -ENDIF -IF (ALLOCATED(SrcParamData%MMB)) THEN - i1_l = LBOUND(SrcParamData%MMB,1) - i1_u = UBOUND(SrcParamData%MMB,1) - i2_l = LBOUND(SrcParamData%MMB,2) - i2_u = UBOUND(SrcParamData%MMB,2) - IF (.NOT. ALLOCATED(DstParamData%MMB)) THEN - ALLOCATE(DstParamData%MMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MMB = SrcParamData%MMB -ENDIF -IF (ALLOCATED(SrcParamData%MBmmB)) THEN - i1_l = LBOUND(SrcParamData%MBmmB,1) - i1_u = UBOUND(SrcParamData%MBmmB,1) - i2_l = LBOUND(SrcParamData%MBmmB,2) - i2_u = UBOUND(SrcParamData%MBmmB,2) - IF (.NOT. ALLOCATED(DstParamData%MBmmB)) THEN - ALLOCATE(DstParamData%MBmmB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBmmB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MBmmB = SrcParamData%MBmmB -ENDIF -IF (ALLOCATED(SrcParamData%C1_11)) THEN - i1_l = LBOUND(SrcParamData%C1_11,1) - i1_u = UBOUND(SrcParamData%C1_11,1) - i2_l = LBOUND(SrcParamData%C1_11,2) - i2_u = UBOUND(SrcParamData%C1_11,2) - IF (.NOT. ALLOCATED(DstParamData%C1_11)) THEN - ALLOCATE(DstParamData%C1_11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C1_11 = SrcParamData%C1_11 -ENDIF -IF (ALLOCATED(SrcParamData%C1_12)) THEN - i1_l = LBOUND(SrcParamData%C1_12,1) - i1_u = UBOUND(SrcParamData%C1_12,1) - i2_l = LBOUND(SrcParamData%C1_12,2) - i2_u = UBOUND(SrcParamData%C1_12,2) - IF (.NOT. ALLOCATED(DstParamData%C1_12)) THEN - ALLOCATE(DstParamData%C1_12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C1_12 = SrcParamData%C1_12 -ENDIF -IF (ALLOCATED(SrcParamData%D1_141)) THEN - i1_l = LBOUND(SrcParamData%D1_141,1) - i1_u = UBOUND(SrcParamData%D1_141,1) - i2_l = LBOUND(SrcParamData%D1_141,2) - i2_u = UBOUND(SrcParamData%D1_141,2) - IF (.NOT. ALLOCATED(DstParamData%D1_141)) THEN - ALLOCATE(DstParamData%D1_141(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_141.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D1_141 = SrcParamData%D1_141 -ENDIF -IF (ALLOCATED(SrcParamData%D1_142)) THEN - i1_l = LBOUND(SrcParamData%D1_142,1) - i1_u = UBOUND(SrcParamData%D1_142,1) - i2_l = LBOUND(SrcParamData%D1_142,2) - i2_u = UBOUND(SrcParamData%D1_142,2) - IF (.NOT. ALLOCATED(DstParamData%D1_142)) THEN - ALLOCATE(DstParamData%D1_142(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_142.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D1_142 = SrcParamData%D1_142 -ENDIF -IF (ALLOCATED(SrcParamData%PhiM)) THEN - i1_l = LBOUND(SrcParamData%PhiM,1) - i1_u = UBOUND(SrcParamData%PhiM,1) - i2_l = LBOUND(SrcParamData%PhiM,2) - i2_u = UBOUND(SrcParamData%PhiM,2) - IF (.NOT. ALLOCATED(DstParamData%PhiM)) THEN - ALLOCATE(DstParamData%PhiM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiM = SrcParamData%PhiM -ENDIF -IF (ALLOCATED(SrcParamData%C2_61)) THEN - i1_l = LBOUND(SrcParamData%C2_61,1) - i1_u = UBOUND(SrcParamData%C2_61,1) - i2_l = LBOUND(SrcParamData%C2_61,2) - i2_u = UBOUND(SrcParamData%C2_61,2) - IF (.NOT. ALLOCATED(DstParamData%C2_61)) THEN - ALLOCATE(DstParamData%C2_61(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_61.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C2_61 = SrcParamData%C2_61 -ENDIF -IF (ALLOCATED(SrcParamData%C2_62)) THEN - i1_l = LBOUND(SrcParamData%C2_62,1) - i1_u = UBOUND(SrcParamData%C2_62,1) - i2_l = LBOUND(SrcParamData%C2_62,2) - i2_u = UBOUND(SrcParamData%C2_62,2) - IF (.NOT. ALLOCATED(DstParamData%C2_62)) THEN - ALLOCATE(DstParamData%C2_62(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_62.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C2_62 = SrcParamData%C2_62 -ENDIF -IF (ALLOCATED(SrcParamData%PhiRb_TI)) THEN - i1_l = LBOUND(SrcParamData%PhiRb_TI,1) - i1_u = UBOUND(SrcParamData%PhiRb_TI,1) - i2_l = LBOUND(SrcParamData%PhiRb_TI,2) - i2_u = UBOUND(SrcParamData%PhiRb_TI,2) - IF (.NOT. ALLOCATED(DstParamData%PhiRb_TI)) THEN - ALLOCATE(DstParamData%PhiRb_TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiRb_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiRb_TI = SrcParamData%PhiRb_TI -ENDIF -IF (ALLOCATED(SrcParamData%D2_63)) THEN - i1_l = LBOUND(SrcParamData%D2_63,1) - i1_u = UBOUND(SrcParamData%D2_63,1) - i2_l = LBOUND(SrcParamData%D2_63,2) - i2_u = UBOUND(SrcParamData%D2_63,2) - IF (.NOT. ALLOCATED(DstParamData%D2_63)) THEN - ALLOCATE(DstParamData%D2_63(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_63.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D2_63 = SrcParamData%D2_63 -ENDIF -IF (ALLOCATED(SrcParamData%D2_64)) THEN - i1_l = LBOUND(SrcParamData%D2_64,1) - i1_u = UBOUND(SrcParamData%D2_64,1) - i2_l = LBOUND(SrcParamData%D2_64,2) - i2_u = UBOUND(SrcParamData%D2_64,2) - IF (.NOT. ALLOCATED(DstParamData%D2_64)) THEN - ALLOCATE(DstParamData%D2_64(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_64.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D2_64 = SrcParamData%D2_64 -ENDIF -IF (ALLOCATED(SrcParamData%MBB)) THEN - i1_l = LBOUND(SrcParamData%MBB,1) - i1_u = UBOUND(SrcParamData%MBB,1) - i2_l = LBOUND(SrcParamData%MBB,2) - i2_u = UBOUND(SrcParamData%MBB,2) - IF (.NOT. ALLOCATED(DstParamData%MBB)) THEN - ALLOCATE(DstParamData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MBB = SrcParamData%MBB -ENDIF -IF (ALLOCATED(SrcParamData%KBB)) THEN - i1_l = LBOUND(SrcParamData%KBB,1) - i1_u = UBOUND(SrcParamData%KBB,1) - i2_l = LBOUND(SrcParamData%KBB,2) - i2_u = UBOUND(SrcParamData%KBB,2) - IF (.NOT. ALLOCATED(DstParamData%KBB)) THEN - ALLOCATE(DstParamData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KBB = SrcParamData%KBB -ENDIF -IF (ALLOCATED(SrcParamData%CBB)) THEN - i1_l = LBOUND(SrcParamData%CBB,1) - i1_u = UBOUND(SrcParamData%CBB,1) - i2_l = LBOUND(SrcParamData%CBB,2) - i2_u = UBOUND(SrcParamData%CBB,2) - IF (.NOT. ALLOCATED(DstParamData%CBB)) THEN - ALLOCATE(DstParamData%CBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CBB = SrcParamData%CBB -ENDIF -IF (ALLOCATED(SrcParamData%CMM)) THEN - i1_l = LBOUND(SrcParamData%CMM,1) - i1_u = UBOUND(SrcParamData%CMM,1) - i2_l = LBOUND(SrcParamData%CMM,2) - i2_u = UBOUND(SrcParamData%CMM,2) - IF (.NOT. ALLOCATED(DstParamData%CMM)) THEN - ALLOCATE(DstParamData%CMM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CMM = SrcParamData%CMM -ENDIF -IF (ALLOCATED(SrcParamData%MBM)) THEN - i1_l = LBOUND(SrcParamData%MBM,1) - i1_u = UBOUND(SrcParamData%MBM,1) - i2_l = LBOUND(SrcParamData%MBM,2) - i2_u = UBOUND(SrcParamData%MBM,2) - IF (.NOT. ALLOCATED(DstParamData%MBM)) THEN - ALLOCATE(DstParamData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MBM = SrcParamData%MBM -ENDIF -IF (ALLOCATED(SrcParamData%PhiL_T)) THEN - i1_l = LBOUND(SrcParamData%PhiL_T,1) - i1_u = UBOUND(SrcParamData%PhiL_T,1) - i2_l = LBOUND(SrcParamData%PhiL_T,2) - i2_u = UBOUND(SrcParamData%PhiL_T,2) - IF (.NOT. ALLOCATED(DstParamData%PhiL_T)) THEN - ALLOCATE(DstParamData%PhiL_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiL_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiL_T = SrcParamData%PhiL_T -ENDIF -IF (ALLOCATED(SrcParamData%PhiLInvOmgL2)) THEN - i1_l = LBOUND(SrcParamData%PhiLInvOmgL2,1) - i1_u = UBOUND(SrcParamData%PhiLInvOmgL2,1) - i2_l = LBOUND(SrcParamData%PhiLInvOmgL2,2) - i2_u = UBOUND(SrcParamData%PhiLInvOmgL2,2) - IF (.NOT. ALLOCATED(DstParamData%PhiLInvOmgL2)) THEN - ALLOCATE(DstParamData%PhiLInvOmgL2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiLInvOmgL2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 -ENDIF -IF (ALLOCATED(SrcParamData%KLLm1)) THEN - i1_l = LBOUND(SrcParamData%KLLm1,1) - i1_u = UBOUND(SrcParamData%KLLm1,1) - i2_l = LBOUND(SrcParamData%KLLm1,2) - i2_u = UBOUND(SrcParamData%KLLm1,2) - IF (.NOT. ALLOCATED(DstParamData%KLLm1)) THEN - ALLOCATE(DstParamData%KLLm1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KLLm1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KLLm1 = SrcParamData%KLLm1 -ENDIF -IF (ALLOCATED(SrcParamData%AM2Jac)) THEN - i1_l = LBOUND(SrcParamData%AM2Jac,1) - i1_u = UBOUND(SrcParamData%AM2Jac,1) - i2_l = LBOUND(SrcParamData%AM2Jac,2) - i2_u = UBOUND(SrcParamData%AM2Jac,2) - IF (.NOT. ALLOCATED(DstParamData%AM2Jac)) THEN - ALLOCATE(DstParamData%AM2Jac(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AM2Jac = SrcParamData%AM2Jac -ENDIF -IF (ALLOCATED(SrcParamData%AM2JacPiv)) THEN - i1_l = LBOUND(SrcParamData%AM2JacPiv,1) - i1_u = UBOUND(SrcParamData%AM2JacPiv,1) - IF (.NOT. ALLOCATED(DstParamData%AM2JacPiv)) THEN - ALLOCATE(DstParamData%AM2JacPiv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2JacPiv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv -ENDIF -IF (ALLOCATED(SrcParamData%TI)) THEN - i1_l = LBOUND(SrcParamData%TI,1) - i1_u = UBOUND(SrcParamData%TI,1) - i2_l = LBOUND(SrcParamData%TI,2) - i2_u = UBOUND(SrcParamData%TI,2) - IF (.NOT. ALLOCATED(DstParamData%TI)) THEN - ALLOCATE(DstParamData%TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TI = SrcParamData%TI -ENDIF -IF (ALLOCATED(SrcParamData%TIreact)) THEN - i1_l = LBOUND(SrcParamData%TIreact,1) - i1_u = UBOUND(SrcParamData%TIreact,1) - i2_l = LBOUND(SrcParamData%TIreact,2) - i2_u = UBOUND(SrcParamData%TIreact,2) - IF (.NOT. ALLOCATED(DstParamData%TIreact)) THEN - ALLOCATE(DstParamData%TIreact(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TIreact.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TIreact = SrcParamData%TIreact -ENDIF - DstParamData%nNodes = SrcParamData%nNodes - DstParamData%nNodes_I = SrcParamData%nNodes_I - DstParamData%nNodes_L = SrcParamData%nNodes_L - DstParamData%nNodes_C = SrcParamData%nNodes_C -IF (ALLOCATED(SrcParamData%Nodes_I)) THEN - i1_l = LBOUND(SrcParamData%Nodes_I,1) - i1_u = UBOUND(SrcParamData%Nodes_I,1) - i2_l = LBOUND(SrcParamData%Nodes_I,2) - i2_u = UBOUND(SrcParamData%Nodes_I,2) - IF (.NOT. ALLOCATED(DstParamData%Nodes_I)) THEN - ALLOCATE(DstParamData%Nodes_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_I.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Nodes_I = SrcParamData%Nodes_I -ENDIF -IF (ALLOCATED(SrcParamData%Nodes_L)) THEN - i1_l = LBOUND(SrcParamData%Nodes_L,1) - i1_u = UBOUND(SrcParamData%Nodes_L,1) - i2_l = LBOUND(SrcParamData%Nodes_L,2) - i2_u = UBOUND(SrcParamData%Nodes_L,2) - IF (.NOT. ALLOCATED(DstParamData%Nodes_L)) THEN - ALLOCATE(DstParamData%Nodes_L(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Nodes_L = SrcParamData%Nodes_L -ENDIF -IF (ALLOCATED(SrcParamData%Nodes_C)) THEN - i1_l = LBOUND(SrcParamData%Nodes_C,1) - i1_u = UBOUND(SrcParamData%Nodes_C,1) - i2_l = LBOUND(SrcParamData%Nodes_C,2) - i2_u = UBOUND(SrcParamData%Nodes_C,2) - IF (.NOT. ALLOCATED(DstParamData%Nodes_C)) THEN - ALLOCATE(DstParamData%Nodes_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Nodes_C = SrcParamData%Nodes_C -ENDIF - DstParamData%nDOFI__ = SrcParamData%nDOFI__ - DstParamData%nDOFI_Rb = SrcParamData%nDOFI_Rb - DstParamData%nDOFI_F = SrcParamData%nDOFI_F - DstParamData%nDOFL_L = SrcParamData%nDOFL_L - DstParamData%nDOFC__ = SrcParamData%nDOFC__ - DstParamData%nDOFC_Rb = SrcParamData%nDOFC_Rb - DstParamData%nDOFC_L = SrcParamData%nDOFC_L - DstParamData%nDOFC_F = SrcParamData%nDOFC_F - DstParamData%nDOFR__ = SrcParamData%nDOFR__ - DstParamData%nDOF__Rb = SrcParamData%nDOF__Rb - DstParamData%nDOF__L = SrcParamData%nDOF__L - DstParamData%nDOF__F = SrcParamData%nDOF__F -IF (ALLOCATED(SrcParamData%IDI__)) THEN - i1_l = LBOUND(SrcParamData%IDI__,1) - i1_u = UBOUND(SrcParamData%IDI__,1) - IF (.NOT. ALLOCATED(DstParamData%IDI__)) THEN - ALLOCATE(DstParamData%IDI__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDI__ = SrcParamData%IDI__ -ENDIF -IF (ALLOCATED(SrcParamData%IDI_Rb)) THEN - i1_l = LBOUND(SrcParamData%IDI_Rb,1) - i1_u = UBOUND(SrcParamData%IDI_Rb,1) - IF (.NOT. ALLOCATED(DstParamData%IDI_Rb)) THEN - ALLOCATE(DstParamData%IDI_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDI_Rb = SrcParamData%IDI_Rb -ENDIF -IF (ALLOCATED(SrcParamData%IDI_F)) THEN - i1_l = LBOUND(SrcParamData%IDI_F,1) - i1_u = UBOUND(SrcParamData%IDI_F,1) - IF (.NOT. ALLOCATED(DstParamData%IDI_F)) THEN - ALLOCATE(DstParamData%IDI_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDI_F = SrcParamData%IDI_F -ENDIF -IF (ALLOCATED(SrcParamData%IDL_L)) THEN - i1_l = LBOUND(SrcParamData%IDL_L,1) - i1_u = UBOUND(SrcParamData%IDL_L,1) - IF (.NOT. ALLOCATED(DstParamData%IDL_L)) THEN - ALLOCATE(DstParamData%IDL_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDL_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDL_L = SrcParamData%IDL_L -ENDIF -IF (ALLOCATED(SrcParamData%IDC__)) THEN - i1_l = LBOUND(SrcParamData%IDC__,1) - i1_u = UBOUND(SrcParamData%IDC__,1) - IF (.NOT. ALLOCATED(DstParamData%IDC__)) THEN - ALLOCATE(DstParamData%IDC__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC__ = SrcParamData%IDC__ -ENDIF -IF (ALLOCATED(SrcParamData%IDC_Rb)) THEN - i1_l = LBOUND(SrcParamData%IDC_Rb,1) - i1_u = UBOUND(SrcParamData%IDC_Rb,1) - IF (.NOT. ALLOCATED(DstParamData%IDC_Rb)) THEN - ALLOCATE(DstParamData%IDC_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC_Rb = SrcParamData%IDC_Rb -ENDIF -IF (ALLOCATED(SrcParamData%IDC_L)) THEN - i1_l = LBOUND(SrcParamData%IDC_L,1) - i1_u = UBOUND(SrcParamData%IDC_L,1) - IF (.NOT. ALLOCATED(DstParamData%IDC_L)) THEN - ALLOCATE(DstParamData%IDC_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC_L = SrcParamData%IDC_L -ENDIF -IF (ALLOCATED(SrcParamData%IDC_F)) THEN - i1_l = LBOUND(SrcParamData%IDC_F,1) - i1_u = UBOUND(SrcParamData%IDC_F,1) - IF (.NOT. ALLOCATED(DstParamData%IDC_F)) THEN - ALLOCATE(DstParamData%IDC_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC_F = SrcParamData%IDC_F -ENDIF -IF (ALLOCATED(SrcParamData%IDR__)) THEN - i1_l = LBOUND(SrcParamData%IDR__,1) - i1_u = UBOUND(SrcParamData%IDR__,1) - IF (.NOT. ALLOCATED(DstParamData%IDR__)) THEN - ALLOCATE(DstParamData%IDR__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDR__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDR__ = SrcParamData%IDR__ -ENDIF -IF (ALLOCATED(SrcParamData%ID__Rb)) THEN - i1_l = LBOUND(SrcParamData%ID__Rb,1) - i1_u = UBOUND(SrcParamData%ID__Rb,1) - IF (.NOT. ALLOCATED(DstParamData%ID__Rb)) THEN - ALLOCATE(DstParamData%ID__Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ID__Rb = SrcParamData%ID__Rb -ENDIF -IF (ALLOCATED(SrcParamData%ID__L)) THEN - i1_l = LBOUND(SrcParamData%ID__L,1) - i1_u = UBOUND(SrcParamData%ID__L,1) - IF (.NOT. ALLOCATED(DstParamData%ID__L)) THEN - ALLOCATE(DstParamData%ID__L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ID__L = SrcParamData%ID__L -ENDIF -IF (ALLOCATED(SrcParamData%ID__F)) THEN - i1_l = LBOUND(SrcParamData%ID__F,1) - i1_u = UBOUND(SrcParamData%ID__F,1) - IF (.NOT. ALLOCATED(DstParamData%ID__F)) THEN - ALLOCATE(DstParamData%ID__F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ID__F = SrcParamData%ID__F -ENDIF - DstParamData%NMOutputs = SrcParamData%NMOutputs - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%UnJckF = SrcParamData%UnJckF - DstParamData%Delim = SrcParamData%Delim - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt -IF (ALLOCATED(SrcParamData%MoutLst)) THEN - i1_l = LBOUND(SrcParamData%MoutLst,1) - i1_u = UBOUND(SrcParamData%MoutLst,1) - IF (.NOT. ALLOCATED(DstParamData%MoutLst)) THEN - ALLOCATE(DstParamData%MoutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%MoutLst,1), UBOUND(SrcParamData%MoutLst,1) - CALL SD_Copymeshauxdatatype( SrcParamData%MoutLst(i1), DstParamData%MoutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%MoutLst2)) THEN - i1_l = LBOUND(SrcParamData%MoutLst2,1) - i1_u = UBOUND(SrcParamData%MoutLst2,1) - IF (.NOT. ALLOCATED(DstParamData%MoutLst2)) THEN - ALLOCATE(DstParamData%MoutLst2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%MoutLst2,1), UBOUND(SrcParamData%MoutLst2,1) - CALL SD_Copymeshauxdatatype( SrcParamData%MoutLst2(i1), DstParamData%MoutLst2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%MoutLst3)) THEN - i1_l = LBOUND(SrcParamData%MoutLst3,1) - i1_u = UBOUND(SrcParamData%MoutLst3,1) - IF (.NOT. ALLOCATED(DstParamData%MoutLst3)) THEN - ALLOCATE(DstParamData%MoutLst3(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%MoutLst3,1), UBOUND(SrcParamData%MoutLst3,1) - CALL SD_Copymeshauxdatatype( SrcParamData%MoutLst3(i1), DstParamData%MoutLst3(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -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%OutAll = SrcParamData%OutAll - DstParamData%OutCBModes = SrcParamData%OutCBModes - DstParamData%OutFEMModes = SrcParamData%OutFEMModes - DstParamData%OutReact = SrcParamData%OutReact - DstParamData%OutAllInt = SrcParamData%OutAllInt - DstParamData%OutAllDims = SrcParamData%OutAllDims - DstParamData%OutDec = SrcParamData%OutDec -IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_u_indx,1) - i1_u = UBOUND(SrcParamData%Jac_u_indx,1) - i2_l = LBOUND(SrcParamData%Jac_u_indx,2) - i2_u = UBOUND(SrcParamData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN - ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcParamData%du)) THEN - i1_l = LBOUND(SrcParamData%du,1) - i1_u = UBOUND(SrcParamData%du,1) - IF (.NOT. ALLOCATED(DstParamData%du)) THEN - ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%du = SrcParamData%du -ENDIF - DstParamData%dx = SrcParamData%dx - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx - DstParamData%RotStates = SrcParamData%RotStates - END SUBROUTINE SD_CopyParam - - SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SD_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 = 'SD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%ElemProps) -ENDIF -IF (ALLOCATED(ParamData%FG)) THEN - DEALLOCATE(ParamData%FG) -ENDIF -IF (ALLOCATED(ParamData%DP0)) THEN - DEALLOCATE(ParamData%DP0) -ENDIF -IF (ALLOCATED(ParamData%NodeID2JointID)) THEN - DEALLOCATE(ParamData%NodeID2JointID) -ENDIF -IF (ALLOCATED(ParamData%T_red)) THEN - DEALLOCATE(ParamData%T_red) -ENDIF -IF (ALLOCATED(ParamData%T_red_T)) THEN - DEALLOCATE(ParamData%T_red_T) -ENDIF -IF (ALLOCATED(ParamData%NodesDOF)) THEN -DO i1 = LBOUND(ParamData%NodesDOF,1), UBOUND(ParamData%NodesDOF,1) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%NodesDOFred) -ENDIF -IF (ALLOCATED(ParamData%ElemsDOF)) THEN - DEALLOCATE(ParamData%ElemsDOF) -ENDIF -IF (ALLOCATED(ParamData%DOFred2Nodes)) THEN - DEALLOCATE(ParamData%DOFred2Nodes) -ENDIF -IF (ALLOCATED(ParamData%CtrlElem2Channel)) THEN - DEALLOCATE(ParamData%CtrlElem2Channel) -ENDIF -IF (ALLOCATED(ParamData%KMMDiag)) THEN - DEALLOCATE(ParamData%KMMDiag) -ENDIF -IF (ALLOCATED(ParamData%CMMDiag)) THEN - DEALLOCATE(ParamData%CMMDiag) -ENDIF -IF (ALLOCATED(ParamData%MMB)) THEN - DEALLOCATE(ParamData%MMB) -ENDIF -IF (ALLOCATED(ParamData%MBmmB)) THEN - DEALLOCATE(ParamData%MBmmB) -ENDIF -IF (ALLOCATED(ParamData%C1_11)) THEN - DEALLOCATE(ParamData%C1_11) -ENDIF -IF (ALLOCATED(ParamData%C1_12)) THEN - DEALLOCATE(ParamData%C1_12) -ENDIF -IF (ALLOCATED(ParamData%D1_141)) THEN - DEALLOCATE(ParamData%D1_141) -ENDIF -IF (ALLOCATED(ParamData%D1_142)) THEN - DEALLOCATE(ParamData%D1_142) -ENDIF -IF (ALLOCATED(ParamData%PhiM)) THEN - DEALLOCATE(ParamData%PhiM) -ENDIF -IF (ALLOCATED(ParamData%C2_61)) THEN - DEALLOCATE(ParamData%C2_61) -ENDIF -IF (ALLOCATED(ParamData%C2_62)) THEN - DEALLOCATE(ParamData%C2_62) -ENDIF -IF (ALLOCATED(ParamData%PhiRb_TI)) THEN - DEALLOCATE(ParamData%PhiRb_TI) -ENDIF -IF (ALLOCATED(ParamData%D2_63)) THEN - DEALLOCATE(ParamData%D2_63) -ENDIF -IF (ALLOCATED(ParamData%D2_64)) THEN - DEALLOCATE(ParamData%D2_64) -ENDIF -IF (ALLOCATED(ParamData%MBB)) THEN - DEALLOCATE(ParamData%MBB) -ENDIF -IF (ALLOCATED(ParamData%KBB)) THEN - DEALLOCATE(ParamData%KBB) -ENDIF -IF (ALLOCATED(ParamData%CBB)) THEN - DEALLOCATE(ParamData%CBB) -ENDIF -IF (ALLOCATED(ParamData%CMM)) THEN - DEALLOCATE(ParamData%CMM) -ENDIF -IF (ALLOCATED(ParamData%MBM)) THEN - DEALLOCATE(ParamData%MBM) -ENDIF -IF (ALLOCATED(ParamData%PhiL_T)) THEN - DEALLOCATE(ParamData%PhiL_T) -ENDIF -IF (ALLOCATED(ParamData%PhiLInvOmgL2)) THEN - DEALLOCATE(ParamData%PhiLInvOmgL2) -ENDIF -IF (ALLOCATED(ParamData%KLLm1)) THEN - DEALLOCATE(ParamData%KLLm1) -ENDIF -IF (ALLOCATED(ParamData%AM2Jac)) THEN - DEALLOCATE(ParamData%AM2Jac) -ENDIF -IF (ALLOCATED(ParamData%AM2JacPiv)) THEN - DEALLOCATE(ParamData%AM2JacPiv) -ENDIF -IF (ALLOCATED(ParamData%TI)) THEN - DEALLOCATE(ParamData%TI) -ENDIF -IF (ALLOCATED(ParamData%TIreact)) THEN - DEALLOCATE(ParamData%TIreact) -ENDIF -IF (ALLOCATED(ParamData%Nodes_I)) THEN - DEALLOCATE(ParamData%Nodes_I) -ENDIF -IF (ALLOCATED(ParamData%Nodes_L)) THEN - DEALLOCATE(ParamData%Nodes_L) -ENDIF -IF (ALLOCATED(ParamData%Nodes_C)) THEN - DEALLOCATE(ParamData%Nodes_C) -ENDIF -IF (ALLOCATED(ParamData%IDI__)) THEN - DEALLOCATE(ParamData%IDI__) -ENDIF -IF (ALLOCATED(ParamData%IDI_Rb)) THEN - DEALLOCATE(ParamData%IDI_Rb) -ENDIF -IF (ALLOCATED(ParamData%IDI_F)) THEN - DEALLOCATE(ParamData%IDI_F) -ENDIF -IF (ALLOCATED(ParamData%IDL_L)) THEN - DEALLOCATE(ParamData%IDL_L) -ENDIF -IF (ALLOCATED(ParamData%IDC__)) THEN - DEALLOCATE(ParamData%IDC__) -ENDIF -IF (ALLOCATED(ParamData%IDC_Rb)) THEN - DEALLOCATE(ParamData%IDC_Rb) -ENDIF -IF (ALLOCATED(ParamData%IDC_L)) THEN - DEALLOCATE(ParamData%IDC_L) -ENDIF -IF (ALLOCATED(ParamData%IDC_F)) THEN - DEALLOCATE(ParamData%IDC_F) -ENDIF -IF (ALLOCATED(ParamData%IDR__)) THEN - DEALLOCATE(ParamData%IDR__) -ENDIF -IF (ALLOCATED(ParamData%ID__Rb)) THEN - DEALLOCATE(ParamData%ID__Rb) -ENDIF -IF (ALLOCATED(ParamData%ID__L)) THEN - DEALLOCATE(ParamData%ID__L) -ENDIF -IF (ALLOCATED(ParamData%ID__F)) THEN - DEALLOCATE(ParamData%ID__F) -ENDIF -IF (ALLOCATED(ParamData%MoutLst)) THEN -DO i1 = LBOUND(ParamData%MoutLst,1), UBOUND(ParamData%MoutLst,1) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF - END SUBROUTINE SD_DestroyParam - - SUBROUTINE SD_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(SD_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 = 'SD_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 ! SDDeltaT - Int_BufSz = Int_BufSz + 1 ! IntMethod - Int_BufSz = Int_BufSz + 1 ! nDOF - Int_BufSz = Int_BufSz + 1 ! nDOF_red - Int_BufSz = Int_BufSz + 1 ! Nmembers - Int_BufSz = Int_BufSz + 1 ! Elems allocated yes/no - IF ( ALLOCATED(InData%Elems) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Elems upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Elems) ! Elems - END IF - Int_BufSz = Int_BufSz + 1 ! ElemProps allocated yes/no - IF ( ALLOCATED(InData%ElemProps) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElemProps upper/lower bounds for each dimension - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ElemProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ElemProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ElemProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FG allocated yes/no - IF ( ALLOCATED(InData%FG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FG upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%FG) ! FG - END IF - Int_BufSz = Int_BufSz + 1 ! DP0 allocated yes/no - IF ( ALLOCATED(InData%DP0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DP0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DP0) ! DP0 - END IF - Int_BufSz = Int_BufSz + 1 ! NodeID2JointID allocated yes/no - IF ( ALLOCATED(InData%NodeID2JointID) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeID2JointID upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeID2JointID) ! NodeID2JointID - END IF - Int_BufSz = Int_BufSz + 1 ! reduced - Int_BufSz = Int_BufSz + 1 ! T_red allocated yes/no - IF ( ALLOCATED(InData%T_red) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T_red upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%T_red) ! T_red - END IF - Int_BufSz = Int_BufSz + 1 ! T_red_T allocated yes/no - IF ( ALLOCATED(InData%T_red_T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T_red_T upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%T_red_T) ! T_red_T - END IF - Int_BufSz = Int_BufSz + 1 ! NodesDOF allocated yes/no - IF ( ALLOCATED(InData%NodesDOF) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NodesDOF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NodesDOF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NodesDOF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NodesDOFred allocated yes/no - IF ( ALLOCATED(InData%NodesDOFred) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NodesDOFred - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NodesDOFred - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NodesDOFred - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ElemsDOF allocated yes/no - IF ( ALLOCATED(InData%ElemsDOF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElemsDOF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElemsDOF) ! ElemsDOF - END IF - Int_BufSz = Int_BufSz + 1 ! DOFred2Nodes allocated yes/no - IF ( ALLOCATED(InData%DOFred2Nodes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DOFred2Nodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DOFred2Nodes) ! DOFred2Nodes - END IF - Int_BufSz = Int_BufSz + 1 ! CtrlElem2Channel allocated yes/no - IF ( ALLOCATED(InData%CtrlElem2Channel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CtrlElem2Channel upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CtrlElem2Channel) ! CtrlElem2Channel - END IF - Int_BufSz = Int_BufSz + 1 ! nDOFM - Int_BufSz = Int_BufSz + 1 ! SttcSolve - Int_BufSz = Int_BufSz + 1 ! GuyanLoadCorrection - Int_BufSz = Int_BufSz + 1 ! Floating - Int_BufSz = Int_BufSz + 1 ! KMMDiag allocated yes/no - IF ( ALLOCATED(InData%KMMDiag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! KMMDiag upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KMMDiag) ! KMMDiag - END IF - Int_BufSz = Int_BufSz + 1 ! CMMDiag allocated yes/no - IF ( ALLOCATED(InData%CMMDiag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CMMDiag upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMMDiag) ! CMMDiag - END IF - Int_BufSz = Int_BufSz + 1 ! MMB allocated yes/no - IF ( ALLOCATED(InData%MMB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MMB) ! MMB - END IF - Int_BufSz = Int_BufSz + 1 ! MBmmB allocated yes/no - IF ( ALLOCATED(InData%MBmmB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBmmB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MBmmB) ! MBmmB - END IF - Int_BufSz = Int_BufSz + 1 ! C1_11 allocated yes/no - IF ( ALLOCATED(InData%C1_11) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C1_11 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C1_11) ! C1_11 - END IF - Int_BufSz = Int_BufSz + 1 ! C1_12 allocated yes/no - IF ( ALLOCATED(InData%C1_12) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C1_12 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C1_12) ! C1_12 - END IF - Int_BufSz = Int_BufSz + 1 ! D1_141 allocated yes/no - IF ( ALLOCATED(InData%D1_141) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D1_141 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D1_141) ! D1_141 - END IF - Int_BufSz = Int_BufSz + 1 ! D1_142 allocated yes/no - IF ( ALLOCATED(InData%D1_142) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D1_142 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D1_142) ! D1_142 - END IF - Int_BufSz = Int_BufSz + 1 ! PhiM allocated yes/no - IF ( ALLOCATED(InData%PhiM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiM) ! PhiM - END IF - Int_BufSz = Int_BufSz + 1 ! C2_61 allocated yes/no - IF ( ALLOCATED(InData%C2_61) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C2_61 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C2_61) ! C2_61 - END IF - Int_BufSz = Int_BufSz + 1 ! C2_62 allocated yes/no - IF ( ALLOCATED(InData%C2_62) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C2_62 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C2_62) ! C2_62 - END IF - Int_BufSz = Int_BufSz + 1 ! PhiRb_TI allocated yes/no - IF ( ALLOCATED(InData%PhiRb_TI) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiRb_TI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiRb_TI) ! PhiRb_TI - END IF - Int_BufSz = Int_BufSz + 1 ! D2_63 allocated yes/no - IF ( ALLOCATED(InData%D2_63) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D2_63 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D2_63) ! D2_63 - END IF - Int_BufSz = Int_BufSz + 1 ! D2_64 allocated yes/no - IF ( ALLOCATED(InData%D2_64) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D2_64 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D2_64) ! D2_64 - END IF - Int_BufSz = Int_BufSz + 1 ! MBB allocated yes/no - IF ( ALLOCATED(InData%MBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MBB) ! MBB - END IF - Int_BufSz = Int_BufSz + 1 ! KBB allocated yes/no - IF ( ALLOCATED(InData%KBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! KBB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KBB) ! KBB - END IF - Int_BufSz = Int_BufSz + 1 ! CBB allocated yes/no - IF ( ALLOCATED(InData%CBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CBB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CBB) ! CBB - END IF - Int_BufSz = Int_BufSz + 1 ! CMM allocated yes/no - IF ( ALLOCATED(InData%CMM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CMM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMM) ! CMM - END IF - Int_BufSz = Int_BufSz + 1 ! MBM allocated yes/no - IF ( ALLOCATED(InData%MBM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MBM) ! MBM - END IF - Int_BufSz = Int_BufSz + 1 ! PhiL_T allocated yes/no - IF ( ALLOCATED(InData%PhiL_T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiL_T upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiL_T) ! PhiL_T - END IF - Int_BufSz = Int_BufSz + 1 ! PhiLInvOmgL2 allocated yes/no - IF ( ALLOCATED(InData%PhiLInvOmgL2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiLInvOmgL2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiLInvOmgL2) ! PhiLInvOmgL2 - END IF - Int_BufSz = Int_BufSz + 1 ! KLLm1 allocated yes/no - IF ( ALLOCATED(InData%KLLm1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! KLLm1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KLLm1) ! KLLm1 - END IF - Int_BufSz = Int_BufSz + 1 ! AM2Jac allocated yes/no - IF ( ALLOCATED(InData%AM2Jac) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AM2Jac upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AM2Jac) ! AM2Jac - END IF - Int_BufSz = Int_BufSz + 1 ! AM2JacPiv allocated yes/no - IF ( ALLOCATED(InData%AM2JacPiv) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AM2JacPiv upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AM2JacPiv) ! AM2JacPiv - END IF - Int_BufSz = Int_BufSz + 1 ! TI allocated yes/no - IF ( ALLOCATED(InData%TI) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI) ! TI - END IF - Int_BufSz = Int_BufSz + 1 ! TIreact allocated yes/no - IF ( ALLOCATED(InData%TIreact) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TIreact upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TIreact) ! TIreact - END IF - Int_BufSz = Int_BufSz + 1 ! nNodes - Int_BufSz = Int_BufSz + 1 ! nNodes_I - Int_BufSz = Int_BufSz + 1 ! nNodes_L - Int_BufSz = Int_BufSz + 1 ! nNodes_C - Int_BufSz = Int_BufSz + 1 ! Nodes_I allocated yes/no - IF ( ALLOCATED(InData%Nodes_I) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes_I upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Nodes_I) ! Nodes_I - END IF - Int_BufSz = Int_BufSz + 1 ! Nodes_L allocated yes/no - IF ( ALLOCATED(InData%Nodes_L) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes_L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Nodes_L) ! Nodes_L - END IF - Int_BufSz = Int_BufSz + 1 ! Nodes_C allocated yes/no - IF ( ALLOCATED(InData%Nodes_C) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes_C upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Nodes_C) ! Nodes_C - END IF - Int_BufSz = Int_BufSz + 1 ! nDOFI__ - Int_BufSz = Int_BufSz + 1 ! nDOFI_Rb - Int_BufSz = Int_BufSz + 1 ! nDOFI_F - Int_BufSz = Int_BufSz + 1 ! nDOFL_L - Int_BufSz = Int_BufSz + 1 ! nDOFC__ - Int_BufSz = Int_BufSz + 1 ! nDOFC_Rb - Int_BufSz = Int_BufSz + 1 ! nDOFC_L - Int_BufSz = Int_BufSz + 1 ! nDOFC_F - Int_BufSz = Int_BufSz + 1 ! nDOFR__ - Int_BufSz = Int_BufSz + 1 ! nDOF__Rb - Int_BufSz = Int_BufSz + 1 ! nDOF__L - Int_BufSz = Int_BufSz + 1 ! nDOF__F - Int_BufSz = Int_BufSz + 1 ! IDI__ allocated yes/no - IF ( ALLOCATED(InData%IDI__) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDI__ upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDI__) ! IDI__ - END IF - Int_BufSz = Int_BufSz + 1 ! IDI_Rb allocated yes/no - IF ( ALLOCATED(InData%IDI_Rb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDI_Rb upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDI_Rb) ! IDI_Rb - END IF - Int_BufSz = Int_BufSz + 1 ! IDI_F allocated yes/no - IF ( ALLOCATED(InData%IDI_F) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDI_F upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDI_F) ! IDI_F - END IF - Int_BufSz = Int_BufSz + 1 ! IDL_L allocated yes/no - IF ( ALLOCATED(InData%IDL_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDL_L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDL_L) ! IDL_L - END IF - Int_BufSz = Int_BufSz + 1 ! IDC__ allocated yes/no - IF ( ALLOCATED(InData%IDC__) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC__ upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC__) ! IDC__ - END IF - Int_BufSz = Int_BufSz + 1 ! IDC_Rb allocated yes/no - IF ( ALLOCATED(InData%IDC_Rb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC_Rb upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC_Rb) ! IDC_Rb - END IF - Int_BufSz = Int_BufSz + 1 ! IDC_L allocated yes/no - IF ( ALLOCATED(InData%IDC_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC_L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC_L) ! IDC_L - END IF - Int_BufSz = Int_BufSz + 1 ! IDC_F allocated yes/no - IF ( ALLOCATED(InData%IDC_F) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC_F upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC_F) ! IDC_F - END IF - Int_BufSz = Int_BufSz + 1 ! IDR__ allocated yes/no - IF ( ALLOCATED(InData%IDR__) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDR__ upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDR__) ! IDR__ - END IF - Int_BufSz = Int_BufSz + 1 ! ID__Rb allocated yes/no - IF ( ALLOCATED(InData%ID__Rb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ID__Rb upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ID__Rb) ! ID__Rb - END IF - Int_BufSz = Int_BufSz + 1 ! ID__L allocated yes/no - IF ( ALLOCATED(InData%ID__L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ID__L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ID__L) ! ID__L - END IF - Int_BufSz = Int_BufSz + 1 ! ID__F allocated yes/no - IF ( ALLOCATED(InData%ID__F) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ID__F upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ID__F) ! ID__F - END IF - Int_BufSz = Int_BufSz + 1 ! NMOutputs - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutSwtch - Int_BufSz = Int_BufSz + 1 ! UnJckF - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - Int_BufSz = Int_BufSz + 1 ! MoutLst allocated yes/no - IF ( ALLOCATED(InData%MoutLst) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MoutLst - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MoutLst - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MoutLst - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MoutLst2 allocated yes/no - IF ( ALLOCATED(InData%MoutLst2) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MoutLst2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MoutLst2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MoutLst2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MoutLst3 allocated yes/no - IF ( ALLOCATED(InData%MoutLst3) ) THEN - 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MoutLst3 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MoutLst3 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MoutLst3 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - 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 ! OutAll - Int_BufSz = Int_BufSz + 1 ! OutCBModes - Int_BufSz = Int_BufSz + 1 ! OutFEMModes - Int_BufSz = Int_BufSz + 1 ! OutReact - Int_BufSz = Int_BufSz + 1 ! OutAllInt - Int_BufSz = Int_BufSz + 1 ! OutAllDims - Int_BufSz = Int_BufSz + 1 ! OutDec - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%du) ! du - END IF - Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! Jac_nx - Int_BufSz = Int_BufSz + 1 ! RotStates - 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%SDDeltaT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF_red - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Nmembers - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Elems) ) 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%Elems,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elems,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Elems,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elems,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Elems,2), UBOUND(InData%Elems,2) - DO i1 = LBOUND(InData%Elems,1), UBOUND(InData%Elems,1) - IntKiBuf(Int_Xferred) = InData%Elems(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElemProps) ) 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%ElemProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%FG) ) 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%FG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FG,1), UBOUND(InData%FG,1) - DbKiBuf(Db_Xferred) = InData%FG(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DP0) ) 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%DP0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DP0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DP0,2), UBOUND(InData%DP0,2) - DO i1 = LBOUND(InData%DP0,1), UBOUND(InData%DP0,1) - ReKiBuf(Re_Xferred) = InData%DP0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodeID2JointID) ) 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%NodeID2JointID,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeID2JointID,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeID2JointID,1), UBOUND(InData%NodeID2JointID,1) - IntKiBuf(Int_Xferred) = InData%NodeID2JointID(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%reduced, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%T_red) ) 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%T_red,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%T_red,2), UBOUND(InData%T_red,2) - DO i1 = LBOUND(InData%T_red,1), UBOUND(InData%T_red,1) - DbKiBuf(Db_Xferred) = InData%T_red(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%T_red_T) ) 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%T_red_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red_T,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red_T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red_T,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%T_red_T,2), UBOUND(InData%T_red_T,2) - DO i1 = LBOUND(InData%T_red_T,1), UBOUND(InData%T_red_T,1) - DbKiBuf(Db_Xferred) = InData%T_red_T(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodesDOF) ) 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%NodesDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesDOF,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%NodesDOFred) ) 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%NodesDOFred,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesDOFred,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%ElemsDOF) ) 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%ElemsDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemsDOF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemsDOF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemsDOF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElemsDOF,2), UBOUND(InData%ElemsDOF,2) - DO i1 = LBOUND(InData%ElemsDOF,1), UBOUND(InData%ElemsDOF,1) - IntKiBuf(Int_Xferred) = InData%ElemsDOF(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DOFred2Nodes) ) 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%DOFred2Nodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOFred2Nodes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DOFred2Nodes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOFred2Nodes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DOFred2Nodes,2), UBOUND(InData%DOFred2Nodes,2) - DO i1 = LBOUND(InData%DOFred2Nodes,1), UBOUND(InData%DOFred2Nodes,1) - IntKiBuf(Int_Xferred) = InData%DOFred2Nodes(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CtrlElem2Channel) ) 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%CtrlElem2Channel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CtrlElem2Channel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CtrlElem2Channel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CtrlElem2Channel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CtrlElem2Channel,2), UBOUND(InData%CtrlElem2Channel,2) - DO i1 = LBOUND(InData%CtrlElem2Channel,1), UBOUND(InData%CtrlElem2Channel,1) - IntKiBuf(Int_Xferred) = InData%CtrlElem2Channel(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nDOFM - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SttcSolve - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GuyanLoadCorrection, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Floating, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%KMMDiag) ) 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%KMMDiag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KMMDiag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%KMMDiag,1), UBOUND(InData%KMMDiag,1) - ReKiBuf(Re_Xferred) = InData%KMMDiag(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMMDiag) ) 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%CMMDiag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMMDiag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CMMDiag,1), UBOUND(InData%CMMDiag,1) - ReKiBuf(Re_Xferred) = InData%CMMDiag(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MMB) ) 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%MMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MMB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MMB,2), UBOUND(InData%MMB,2) - DO i1 = LBOUND(InData%MMB,1), UBOUND(InData%MMB,1) - ReKiBuf(Re_Xferred) = InData%MMB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBmmB) ) 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%MBmmB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBmmB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBmmB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBmmB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBmmB,2), UBOUND(InData%MBmmB,2) - DO i1 = LBOUND(InData%MBmmB,1), UBOUND(InData%MBmmB,1) - ReKiBuf(Re_Xferred) = InData%MBmmB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C1_11) ) 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%C1_11,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_11,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_11,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_11,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C1_11,2), UBOUND(InData%C1_11,2) - DO i1 = LBOUND(InData%C1_11,1), UBOUND(InData%C1_11,1) - ReKiBuf(Re_Xferred) = InData%C1_11(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C1_12) ) 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%C1_12,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_12,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_12,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_12,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C1_12,2), UBOUND(InData%C1_12,2) - DO i1 = LBOUND(InData%C1_12,1), UBOUND(InData%C1_12,1) - ReKiBuf(Re_Xferred) = InData%C1_12(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D1_141) ) 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%D1_141,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_141,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_141,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_141,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D1_141,2), UBOUND(InData%D1_141,2) - DO i1 = LBOUND(InData%D1_141,1), UBOUND(InData%D1_141,1) - ReKiBuf(Re_Xferred) = InData%D1_141(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D1_142) ) 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%D1_142,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_142,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_142,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_142,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D1_142,2), UBOUND(InData%D1_142,2) - DO i1 = LBOUND(InData%D1_142,1), UBOUND(InData%D1_142,1) - ReKiBuf(Re_Xferred) = InData%D1_142(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiM) ) 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%PhiM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiM,2), UBOUND(InData%PhiM,2) - DO i1 = LBOUND(InData%PhiM,1), UBOUND(InData%PhiM,1) - ReKiBuf(Re_Xferred) = InData%PhiM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C2_61) ) 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%C2_61,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_61,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_61,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_61,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C2_61,2), UBOUND(InData%C2_61,2) - DO i1 = LBOUND(InData%C2_61,1), UBOUND(InData%C2_61,1) - ReKiBuf(Re_Xferred) = InData%C2_61(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C2_62) ) 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%C2_62,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_62,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_62,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_62,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C2_62,2), UBOUND(InData%C2_62,2) - DO i1 = LBOUND(InData%C2_62,1), UBOUND(InData%C2_62,1) - ReKiBuf(Re_Xferred) = InData%C2_62(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiRb_TI) ) 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%PhiRb_TI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiRb_TI,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiRb_TI,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiRb_TI,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiRb_TI,2), UBOUND(InData%PhiRb_TI,2) - DO i1 = LBOUND(InData%PhiRb_TI,1), UBOUND(InData%PhiRb_TI,1) - ReKiBuf(Re_Xferred) = InData%PhiRb_TI(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D2_63) ) 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%D2_63,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_63,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_63,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_63,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D2_63,2), UBOUND(InData%D2_63,2) - DO i1 = LBOUND(InData%D2_63,1), UBOUND(InData%D2_63,1) - ReKiBuf(Re_Xferred) = InData%D2_63(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D2_64) ) 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%D2_64,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_64,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_64,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_64,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D2_64,2), UBOUND(InData%D2_64,2) - DO i1 = LBOUND(InData%D2_64,1), UBOUND(InData%D2_64,1) - ReKiBuf(Re_Xferred) = InData%D2_64(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBB) ) 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%MBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) - DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) - ReKiBuf(Re_Xferred) = InData%MBB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KBB) ) 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%KBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) - DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) - ReKiBuf(Re_Xferred) = InData%KBB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CBB) ) 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%CBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CBB,2), UBOUND(InData%CBB,2) - DO i1 = LBOUND(InData%CBB,1), UBOUND(InData%CBB,1) - ReKiBuf(Re_Xferred) = InData%CBB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMM) ) 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%CMM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CMM,2), UBOUND(InData%CMM,2) - DO i1 = LBOUND(InData%CMM,1), UBOUND(InData%CMM,1) - ReKiBuf(Re_Xferred) = InData%CMM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBM) ) 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%MBM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) - DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) - ReKiBuf(Re_Xferred) = InData%MBM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiL_T) ) 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%PhiL_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL_T,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL_T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL_T,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiL_T,2), UBOUND(InData%PhiL_T,2) - DO i1 = LBOUND(InData%PhiL_T,1), UBOUND(InData%PhiL_T,1) - ReKiBuf(Re_Xferred) = InData%PhiL_T(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiLInvOmgL2) ) 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%PhiLInvOmgL2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiLInvOmgL2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiLInvOmgL2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiLInvOmgL2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiLInvOmgL2,2), UBOUND(InData%PhiLInvOmgL2,2) - DO i1 = LBOUND(InData%PhiLInvOmgL2,1), UBOUND(InData%PhiLInvOmgL2,1) - ReKiBuf(Re_Xferred) = InData%PhiLInvOmgL2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KLLm1) ) 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%KLLm1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KLLm1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KLLm1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KLLm1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%KLLm1,2), UBOUND(InData%KLLm1,2) - DO i1 = LBOUND(InData%KLLm1,1), UBOUND(InData%KLLm1,1) - ReKiBuf(Re_Xferred) = InData%KLLm1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AM2Jac) ) 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%AM2Jac,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2Jac,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM2Jac,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2Jac,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AM2Jac,2), UBOUND(InData%AM2Jac,2) - DO i1 = LBOUND(InData%AM2Jac,1), UBOUND(InData%AM2Jac,1) - ReKiBuf(Re_Xferred) = InData%AM2Jac(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AM2JacPiv) ) 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%AM2JacPiv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2JacPiv,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AM2JacPiv,1), UBOUND(InData%AM2JacPiv,1) - IntKiBuf(Int_Xferred) = InData%AM2JacPiv(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI) ) 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%TI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TI,2), UBOUND(InData%TI,2) - DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) - ReKiBuf(Re_Xferred) = InData%TI(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TIreact) ) 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%TIreact,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIreact,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIreact,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIreact,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TIreact,2), UBOUND(InData%TIreact,2) - DO i1 = LBOUND(InData%TIreact,1), UBOUND(InData%TIreact,1) - ReKiBuf(Re_Xferred) = InData%TIreact(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodes_I - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodes_L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodes_C - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Nodes_I) ) 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%Nodes_I,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_I,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_I,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_I,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes_I,2), UBOUND(InData%Nodes_I,2) - DO i1 = LBOUND(InData%Nodes_I,1), UBOUND(InData%Nodes_I,1) - IntKiBuf(Int_Xferred) = InData%Nodes_I(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Nodes_L) ) 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%Nodes_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_L,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_L,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_L,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes_L,2), UBOUND(InData%Nodes_L,2) - DO i1 = LBOUND(InData%Nodes_L,1), UBOUND(InData%Nodes_L,1) - IntKiBuf(Int_Xferred) = InData%Nodes_L(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Nodes_C) ) 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%Nodes_C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_C,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes_C,2), UBOUND(InData%Nodes_C,2) - DO i1 = LBOUND(InData%Nodes_C,1), UBOUND(InData%Nodes_C,1) - IntKiBuf(Int_Xferred) = InData%Nodes_C(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nDOFI__ - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFI_Rb - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFI_F - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFL_L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC__ - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC_Rb - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC_L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC_F - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFR__ - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF__Rb - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF__L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF__F - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%IDI__) ) 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%IDI__,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI__,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDI__,1), UBOUND(InData%IDI__,1) - IntKiBuf(Int_Xferred) = InData%IDI__(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDI_Rb) ) 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%IDI_Rb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI_Rb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDI_Rb,1), UBOUND(InData%IDI_Rb,1) - IntKiBuf(Int_Xferred) = InData%IDI_Rb(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDI_F) ) 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%IDI_F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI_F,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDI_F,1), UBOUND(InData%IDI_F,1) - IntKiBuf(Int_Xferred) = InData%IDI_F(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDL_L) ) 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%IDL_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDL_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDL_L,1), UBOUND(InData%IDL_L,1) - IntKiBuf(Int_Xferred) = InData%IDL_L(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC__) ) 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%IDC__,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC__,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC__,1), UBOUND(InData%IDC__,1) - IntKiBuf(Int_Xferred) = InData%IDC__(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC_Rb) ) 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%IDC_Rb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC_Rb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC_Rb,1), UBOUND(InData%IDC_Rb,1) - IntKiBuf(Int_Xferred) = InData%IDC_Rb(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC_L) ) 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%IDC_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC_L,1), UBOUND(InData%IDC_L,1) - IntKiBuf(Int_Xferred) = InData%IDC_L(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC_F) ) 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%IDC_F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC_F,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC_F,1), UBOUND(InData%IDC_F,1) - IntKiBuf(Int_Xferred) = InData%IDC_F(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDR__) ) 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%IDR__,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDR__,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDR__,1), UBOUND(InData%IDR__,1) - IntKiBuf(Int_Xferred) = InData%IDR__(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ID__Rb) ) 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%ID__Rb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ID__Rb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ID__Rb,1), UBOUND(InData%ID__Rb,1) - IntKiBuf(Int_Xferred) = InData%ID__Rb(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ID__L) ) 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%ID__L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ID__L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ID__L,1), UBOUND(InData%ID__L,1) - IntKiBuf(Int_Xferred) = InData%ID__L(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ID__F) ) 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%ID__F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ID__F,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ID__F,1), UBOUND(InData%ID__F,1) - IntKiBuf(Int_Xferred) = InData%ID__F(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnJckF - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - IF ( .NOT. ALLOCATED(InData%MoutLst) ) 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%MoutLst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MoutLst,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%MoutLst2) ) 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%MoutLst2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MoutLst2,1) - 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 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 - IF ( .NOT. ALLOCATED(InData%MoutLst3) ) 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%MoutLst3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MoutLst3,1) - 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 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 - 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) = TRANSFER(InData%OutAll, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutCBModes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutFEMModes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutReact, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutAllInt - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutAllDims - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutDec - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) 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%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%du) ) 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%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - DbKiBuf(Db_Xferred) = InData%du(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - DbKiBuf(Db_Xferred) = InData%dx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackParam - - SUBROUTINE SD_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(SD_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 = 'SD_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%SDDeltaT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF_red = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Nmembers = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elems 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%Elems)) DEALLOCATE(OutData%Elems) - ALLOCATE(OutData%Elems(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elems.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Elems,2), UBOUND(OutData%Elems,2) - DO i1 = LBOUND(OutData%Elems,1), UBOUND(OutData%Elems,1) - OutData%Elems(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemProps 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%ElemProps)) DEALLOCATE(OutData%ElemProps) - ALLOCATE(OutData%ElemProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElemProps,1), UBOUND(OutData%ElemProps,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 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 - - 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 ! FG 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%FG)) DEALLOCATE(OutData%FG) - ALLOCATE(OutData%FG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FG,1), UBOUND(OutData%FG,1) - OutData%FG(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DP0 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%DP0)) DEALLOCATE(OutData%DP0) - ALLOCATE(OutData%DP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DP0,2), UBOUND(OutData%DP0,2) - DO i1 = LBOUND(OutData%DP0,1), UBOUND(OutData%DP0,1) - OutData%DP0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeID2JointID 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%NodeID2JointID)) DEALLOCATE(OutData%NodeID2JointID) - ALLOCATE(OutData%NodeID2JointID(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeID2JointID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeID2JointID,1), UBOUND(OutData%NodeID2JointID,1) - OutData%NodeID2JointID(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%reduced = TRANSFER(IntKiBuf(Int_Xferred), OutData%reduced) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_red 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%T_red)) DEALLOCATE(OutData%T_red) - ALLOCATE(OutData%T_red(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%T_red,2), UBOUND(OutData%T_red,2) - DO i1 = LBOUND(OutData%T_red,1), UBOUND(OutData%T_red,1) - OutData%T_red(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_red_T 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%T_red_T)) DEALLOCATE(OutData%T_red_T) - ALLOCATE(OutData%T_red_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%T_red_T,2), UBOUND(OutData%T_red_T,2) - DO i1 = LBOUND(OutData%T_red_T,1), UBOUND(OutData%T_red_T,1) - OutData%T_red_T(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesDOF 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%NodesDOF)) DEALLOCATE(OutData%NodesDOF) - ALLOCATE(OutData%NodesDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodesDOF,1), UBOUND(OutData%NodesDOF,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 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 - - 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 ! NodesDOFred 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%NodesDOFred)) DEALLOCATE(OutData%NodesDOFred) - ALLOCATE(OutData%NodesDOFred(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOFred.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodesDOFred,1), UBOUND(OutData%NodesDOFred,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 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 - - 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 ! ElemsDOF 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%ElemsDOF)) DEALLOCATE(OutData%ElemsDOF) - ALLOCATE(OutData%ElemsDOF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemsDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElemsDOF,2), UBOUND(OutData%ElemsDOF,2) - DO i1 = LBOUND(OutData%ElemsDOF,1), UBOUND(OutData%ElemsDOF,1) - OutData%ElemsDOF(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOFred2Nodes 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%DOFred2Nodes)) DEALLOCATE(OutData%DOFred2Nodes) - ALLOCATE(OutData%DOFred2Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOFred2Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DOFred2Nodes,2), UBOUND(OutData%DOFred2Nodes,2) - DO i1 = LBOUND(OutData%DOFred2Nodes,1), UBOUND(OutData%DOFred2Nodes,1) - OutData%DOFred2Nodes(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CtrlElem2Channel 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%CtrlElem2Channel)) DEALLOCATE(OutData%CtrlElem2Channel) - ALLOCATE(OutData%CtrlElem2Channel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CtrlElem2Channel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CtrlElem2Channel,2), UBOUND(OutData%CtrlElem2Channel,2) - DO i1 = LBOUND(OutData%CtrlElem2Channel,1), UBOUND(OutData%CtrlElem2Channel,1) - OutData%CtrlElem2Channel(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%nDOFM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SttcSolve = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%GuyanLoadCorrection = TRANSFER(IntKiBuf(Int_Xferred), OutData%GuyanLoadCorrection) - Int_Xferred = Int_Xferred + 1 - OutData%Floating = TRANSFER(IntKiBuf(Int_Xferred), OutData%Floating) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KMMDiag 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%KMMDiag)) DEALLOCATE(OutData%KMMDiag) - ALLOCATE(OutData%KMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%KMMDiag,1), UBOUND(OutData%KMMDiag,1) - OutData%KMMDiag(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMMDiag 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%CMMDiag)) DEALLOCATE(OutData%CMMDiag) - ALLOCATE(OutData%CMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CMMDiag,1), UBOUND(OutData%CMMDiag,1) - OutData%CMMDiag(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MMB 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%MMB)) DEALLOCATE(OutData%MMB) - ALLOCATE(OutData%MMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MMB,2), UBOUND(OutData%MMB,2) - DO i1 = LBOUND(OutData%MMB,1), UBOUND(OutData%MMB,1) - OutData%MMB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBmmB 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%MBmmB)) DEALLOCATE(OutData%MBmmB) - ALLOCATE(OutData%MBmmB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBmmB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBmmB,2), UBOUND(OutData%MBmmB,2) - DO i1 = LBOUND(OutData%MBmmB,1), UBOUND(OutData%MBmmB,1) - OutData%MBmmB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_11 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%C1_11)) DEALLOCATE(OutData%C1_11) - ALLOCATE(OutData%C1_11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C1_11,2), UBOUND(OutData%C1_11,2) - DO i1 = LBOUND(OutData%C1_11,1), UBOUND(OutData%C1_11,1) - OutData%C1_11(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_12 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%C1_12)) DEALLOCATE(OutData%C1_12) - ALLOCATE(OutData%C1_12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C1_12,2), UBOUND(OutData%C1_12,2) - DO i1 = LBOUND(OutData%C1_12,1), UBOUND(OutData%C1_12,1) - OutData%C1_12(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_141 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%D1_141)) DEALLOCATE(OutData%D1_141) - ALLOCATE(OutData%D1_141(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_141.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D1_141,2), UBOUND(OutData%D1_141,2) - DO i1 = LBOUND(OutData%D1_141,1), UBOUND(OutData%D1_141,1) - OutData%D1_141(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_142 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%D1_142)) DEALLOCATE(OutData%D1_142) - ALLOCATE(OutData%D1_142(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_142.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D1_142,2), UBOUND(OutData%D1_142,2) - DO i1 = LBOUND(OutData%D1_142,1), UBOUND(OutData%D1_142,1) - OutData%D1_142(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiM 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%PhiM)) DEALLOCATE(OutData%PhiM) - ALLOCATE(OutData%PhiM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiM,2), UBOUND(OutData%PhiM,2) - DO i1 = LBOUND(OutData%PhiM,1), UBOUND(OutData%PhiM,1) - OutData%PhiM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_61 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%C2_61)) DEALLOCATE(OutData%C2_61) - ALLOCATE(OutData%C2_61(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_61.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C2_61,2), UBOUND(OutData%C2_61,2) - DO i1 = LBOUND(OutData%C2_61,1), UBOUND(OutData%C2_61,1) - OutData%C2_61(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_62 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%C2_62)) DEALLOCATE(OutData%C2_62) - ALLOCATE(OutData%C2_62(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_62.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C2_62,2), UBOUND(OutData%C2_62,2) - DO i1 = LBOUND(OutData%C2_62,1), UBOUND(OutData%C2_62,1) - OutData%C2_62(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiRb_TI 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%PhiRb_TI)) DEALLOCATE(OutData%PhiRb_TI) - ALLOCATE(OutData%PhiRb_TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiRb_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiRb_TI,2), UBOUND(OutData%PhiRb_TI,2) - DO i1 = LBOUND(OutData%PhiRb_TI,1), UBOUND(OutData%PhiRb_TI,1) - OutData%PhiRb_TI(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_63 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%D2_63)) DEALLOCATE(OutData%D2_63) - ALLOCATE(OutData%D2_63(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_63.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D2_63,2), UBOUND(OutData%D2_63,2) - DO i1 = LBOUND(OutData%D2_63,1), UBOUND(OutData%D2_63,1) - OutData%D2_63(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_64 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%D2_64)) DEALLOCATE(OutData%D2_64) - ALLOCATE(OutData%D2_64(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_64.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D2_64,2), UBOUND(OutData%D2_64,2) - DO i1 = LBOUND(OutData%D2_64,1), UBOUND(OutData%D2_64,1) - OutData%D2_64(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBB 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%MBB)) DEALLOCATE(OutData%MBB) - ALLOCATE(OutData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) - DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) - OutData%MBB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB 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%KBB)) DEALLOCATE(OutData%KBB) - ALLOCATE(OutData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) - DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) - OutData%KBB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBB 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%CBB)) DEALLOCATE(OutData%CBB) - ALLOCATE(OutData%CBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CBB,2), UBOUND(OutData%CBB,2) - DO i1 = LBOUND(OutData%CBB,1), UBOUND(OutData%CBB,1) - OutData%CBB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMM 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%CMM)) DEALLOCATE(OutData%CMM) - ALLOCATE(OutData%CMM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CMM,2), UBOUND(OutData%CMM,2) - DO i1 = LBOUND(OutData%CMM,1), UBOUND(OutData%CMM,1) - OutData%CMM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM 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%MBM)) DEALLOCATE(OutData%MBM) - ALLOCATE(OutData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) - DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) - OutData%MBM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL_T 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%PhiL_T)) DEALLOCATE(OutData%PhiL_T) - ALLOCATE(OutData%PhiL_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiL_T,2), UBOUND(OutData%PhiL_T,2) - DO i1 = LBOUND(OutData%PhiL_T,1), UBOUND(OutData%PhiL_T,1) - OutData%PhiL_T(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiLInvOmgL2 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%PhiLInvOmgL2)) DEALLOCATE(OutData%PhiLInvOmgL2) - ALLOCATE(OutData%PhiLInvOmgL2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiLInvOmgL2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiLInvOmgL2,2), UBOUND(OutData%PhiLInvOmgL2,2) - DO i1 = LBOUND(OutData%PhiLInvOmgL2,1), UBOUND(OutData%PhiLInvOmgL2,1) - OutData%PhiLInvOmgL2(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KLLm1 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%KLLm1)) DEALLOCATE(OutData%KLLm1) - ALLOCATE(OutData%KLLm1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KLLm1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%KLLm1,2), UBOUND(OutData%KLLm1,2) - DO i1 = LBOUND(OutData%KLLm1,1), UBOUND(OutData%KLLm1,1) - OutData%KLLm1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2Jac 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%AM2Jac)) DEALLOCATE(OutData%AM2Jac) - ALLOCATE(OutData%AM2Jac(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AM2Jac,2), UBOUND(OutData%AM2Jac,2) - DO i1 = LBOUND(OutData%AM2Jac,1), UBOUND(OutData%AM2Jac,1) - OutData%AM2Jac(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2JacPiv 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%AM2JacPiv)) DEALLOCATE(OutData%AM2JacPiv) - ALLOCATE(OutData%AM2JacPiv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2JacPiv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AM2JacPiv,1), UBOUND(OutData%AM2JacPiv,1) - OutData%AM2JacPiv(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI 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%TI)) DEALLOCATE(OutData%TI) - ALLOCATE(OutData%TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TI,2), UBOUND(OutData%TI,2) - DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) - OutData%TI(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIreact 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%TIreact)) DEALLOCATE(OutData%TIreact) - ALLOCATE(OutData%TIreact(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIreact.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TIreact,2), UBOUND(OutData%TIreact,2) - DO i1 = LBOUND(OutData%TIreact,1), UBOUND(OutData%TIreact,1) - OutData%TIreact(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%nNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodes_I = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodes_L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodes_C = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes_I 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%Nodes_I)) DEALLOCATE(OutData%Nodes_I) - ALLOCATE(OutData%Nodes_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_I.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes_I,2), UBOUND(OutData%Nodes_I,2) - DO i1 = LBOUND(OutData%Nodes_I,1), UBOUND(OutData%Nodes_I,1) - OutData%Nodes_I(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes_L 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%Nodes_L)) DEALLOCATE(OutData%Nodes_L) - ALLOCATE(OutData%Nodes_L(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes_L,2), UBOUND(OutData%Nodes_L,2) - DO i1 = LBOUND(OutData%Nodes_L,1), UBOUND(OutData%Nodes_L,1) - OutData%Nodes_L(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes_C 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%Nodes_C)) DEALLOCATE(OutData%Nodes_C) - ALLOCATE(OutData%Nodes_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes_C,2), UBOUND(OutData%Nodes_C,2) - DO i1 = LBOUND(OutData%Nodes_C,1), UBOUND(OutData%Nodes_C,1) - OutData%Nodes_C(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%nDOFI__ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFI_Rb = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFI_F = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFL_L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC__ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC_Rb = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC_L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC_F = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFR__ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF__Rb = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF__L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF__F = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI__ 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%IDI__)) DEALLOCATE(OutData%IDI__) - ALLOCATE(OutData%IDI__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDI__,1), UBOUND(OutData%IDI__,1) - OutData%IDI__(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI_Rb 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%IDI_Rb)) DEALLOCATE(OutData%IDI_Rb) - ALLOCATE(OutData%IDI_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDI_Rb,1), UBOUND(OutData%IDI_Rb,1) - OutData%IDI_Rb(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI_F 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%IDI_F)) DEALLOCATE(OutData%IDI_F) - ALLOCATE(OutData%IDI_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDI_F,1), UBOUND(OutData%IDI_F,1) - OutData%IDI_F(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDL_L 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%IDL_L)) DEALLOCATE(OutData%IDL_L) - ALLOCATE(OutData%IDL_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDL_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDL_L,1), UBOUND(OutData%IDL_L,1) - OutData%IDL_L(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC__ 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%IDC__)) DEALLOCATE(OutData%IDC__) - ALLOCATE(OutData%IDC__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC__,1), UBOUND(OutData%IDC__,1) - OutData%IDC__(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC_Rb 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%IDC_Rb)) DEALLOCATE(OutData%IDC_Rb) - ALLOCATE(OutData%IDC_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC_Rb,1), UBOUND(OutData%IDC_Rb,1) - OutData%IDC_Rb(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC_L 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%IDC_L)) DEALLOCATE(OutData%IDC_L) - ALLOCATE(OutData%IDC_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC_L,1), UBOUND(OutData%IDC_L,1) - OutData%IDC_L(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC_F 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%IDC_F)) DEALLOCATE(OutData%IDC_F) - ALLOCATE(OutData%IDC_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC_F,1), UBOUND(OutData%IDC_F,1) - OutData%IDC_F(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDR__ 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%IDR__)) DEALLOCATE(OutData%IDR__) - ALLOCATE(OutData%IDR__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDR__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDR__,1), UBOUND(OutData%IDR__,1) - OutData%IDR__(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ID__Rb 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%ID__Rb)) DEALLOCATE(OutData%ID__Rb) - ALLOCATE(OutData%ID__Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ID__Rb,1), UBOUND(OutData%ID__Rb,1) - OutData%ID__Rb(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ID__L 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%ID__L)) DEALLOCATE(OutData%ID__L) - ALLOCATE(OutData%ID__L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ID__L,1), UBOUND(OutData%ID__L,1) - OutData%ID__L(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ID__F 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%ID__F)) DEALLOCATE(OutData%ID__F) - ALLOCATE(OutData%ID__F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ID__F,1), UBOUND(OutData%ID__F,1) - OutData%ID__F(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NMOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnJckF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - 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 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 - - 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 ! MoutLst2 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%MoutLst2)) DEALLOCATE(OutData%MoutLst2) - ALLOCATE(OutData%MoutLst2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MoutLst2,1), UBOUND(OutData%MoutLst2,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 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 - 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 ! MoutLst3 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%MoutLst3)) DEALLOCATE(OutData%MoutLst3) - ALLOCATE(OutData%MoutLst3(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MoutLst3,1), UBOUND(OutData%MoutLst3,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 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 - - 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 ! 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%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) - Int_Xferred = Int_Xferred + 1 - OutData%OutCBModes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutFEMModes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutReact = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutReact) - Int_Xferred = Int_Xferred + 1 - OutData%OutAllInt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutAllDims = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutDec = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx 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%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du 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%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%dx,1) - i1_u = UBOUND(OutData%dx,1) - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackParam - - SUBROUTINE SD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(SD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInput' -! +subroutine SD_CopyIList(SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg) + type(IList), intent(in) :: SrcIListData + type(IList), intent(inout) :: DstIListData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyIList' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%TPMesh, DstInputData%TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%LMesh, DstInputData%LMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputData%CableDeltaL)) THEN - i1_l = LBOUND(SrcInputData%CableDeltaL,1) - i1_u = UBOUND(SrcInputData%CableDeltaL,1) - IF (.NOT. ALLOCATED(DstInputData%CableDeltaL)) THEN - ALLOCATE(DstInputData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CableDeltaL = SrcInputData%CableDeltaL -ENDIF - END SUBROUTINE SD_CopyInput - - SUBROUTINE SD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SD_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 = 'SD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( InputData%TPMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%LMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputData%CableDeltaL)) THEN - DEALLOCATE(InputData%CableDeltaL) -ENDIF - END SUBROUTINE SD_DestroyInput - - SUBROUTINE SD_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(SD_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 = 'SD_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! TPMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TPMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TPMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TPMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! LMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! LMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CableDeltaL allocated yes/no - IF ( ALLOCATED(InData%CableDeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableDeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaL) ! CableDeltaL - 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 - - CALL MeshPack( InData%TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TPMesh - 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 - CALL MeshPack( InData%LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! LMesh - 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 - IF ( .NOT. ALLOCATED(InData%CableDeltaL) ) 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%CableDeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableDeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableDeltaL,1), UBOUND(InData%CableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackInput - - SUBROUTINE SD_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(SD_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_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 - 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 MeshUnpack( OutData%TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TPMesh - 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) - 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 MeshUnpack( OutData%LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! LMesh - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableDeltaL 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%CableDeltaL)) DEALLOCATE(OutData%CableDeltaL) - ALLOCATE(OutData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableDeltaL,1), UBOUND(OutData%CableDeltaL,1) - OutData%CableDeltaL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackInput - - SUBROUTINE SD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(SD_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 = 'SD_CopyOutput' -! + ErrMsg = '' + if (allocated(SrcIListData%List)) then + LB(1:1) = lbound(SrcIListData%List) + UB(1:1) = ubound(SrcIListData%List) + if (.not. allocated(DstIListData%List)) then + allocate(DstIListData%List(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIListData%List.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstIListData%List = SrcIListData%List + end if +end subroutine + +subroutine SD_DestroyIList(IListData, ErrStat, ErrMsg) + type(IList), intent(inout) :: IListData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyIList' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%Y1Mesh, DstOutputData%Y1Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%Y2Mesh, DstOutputData%Y2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%Y3Mesh, DstOutputData%Y3Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -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 SD_CopyOutput - - SUBROUTINE SD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SD_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 = 'SD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%Y1Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%Y2Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%Y3Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE SD_DestroyOutput - - SUBROUTINE SD_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(SD_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 = 'SD_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Y1Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Y1Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Y1Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Y1Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Y1Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Y1Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Y2Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Y2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Y2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Y2Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Y2Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Y2Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Y3Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Y3Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Y3Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Y3Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Y3Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Y3Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 - - CALL MeshPack( InData%Y1Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Y1Mesh - 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 - CALL MeshPack( InData%Y2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Y2Mesh - 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 - CALL MeshPack( InData%Y3Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Y3Mesh - 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 - 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 SD_PackOutput - - SUBROUTINE SD_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(SD_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 = 'SD_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 - 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 MeshUnpack( OutData%Y1Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Y1Mesh - 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) - 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 MeshUnpack( OutData%Y2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Y2Mesh - 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) - 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 MeshUnpack( OutData%Y3Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Y3Mesh - 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) - 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 SD_UnPackOutput - - - SUBROUTINE SD_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(SD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SD_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 + ErrMsg = '' + if (allocated(IListData%List)) then + deallocate(IListData%List) + end if +end subroutine + +subroutine SD_PackIList(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IList), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackIList' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%List)) + if (allocated(InData%List)) then + call RegPackBounds(Buf, 1, lbound(InData%List), ubound(InData%List)) + call RegPack(Buf, InData%List) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackIList(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IList), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackIList' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%List)) deallocate(OutData%List) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%List(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%List.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%List) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData, CtrlCode, ErrStat, ErrMsg) + type(MeshAuxDataType), intent(in) :: SrcMeshAuxDataTypeData + type(MeshAuxDataType), intent(inout) :: DstMeshAuxDataTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyMeshAuxDataType' + ErrStat = ErrID_None + ErrMsg = '' + DstMeshAuxDataTypeData%MemberID = SrcMeshAuxDataTypeData%MemberID + DstMeshAuxDataTypeData%NOutCnt = SrcMeshAuxDataTypeData%NOutCnt + if (allocated(SrcMeshAuxDataTypeData%NodeCnt)) then + LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeCnt) + UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeCnt) + if (.not. allocated(DstMeshAuxDataTypeData%NodeCnt)) then + allocate(DstMeshAuxDataTypeData%NodeCnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%NodeCnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%NodeCnt = SrcMeshAuxDataTypeData%NodeCnt + end if + if (allocated(SrcMeshAuxDataTypeData%NodeIDs)) then + LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeIDs) + UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeIDs) + if (.not. allocated(DstMeshAuxDataTypeData%NodeIDs)) then + allocate(DstMeshAuxDataTypeData%NodeIDs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%NodeIDs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%NodeIDs = SrcMeshAuxDataTypeData%NodeIDs + end if + if (allocated(SrcMeshAuxDataTypeData%ElmIDs)) then + LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmIDs) + UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmIDs) + if (.not. allocated(DstMeshAuxDataTypeData%ElmIDs)) then + allocate(DstMeshAuxDataTypeData%ElmIDs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%ElmIDs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%ElmIDs = SrcMeshAuxDataTypeData%ElmIDs + end if + if (allocated(SrcMeshAuxDataTypeData%ElmNds)) then + LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmNds) + UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmNds) + if (.not. allocated(DstMeshAuxDataTypeData%ElmNds)) then + allocate(DstMeshAuxDataTypeData%ElmNds(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%ElmNds.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%ElmNds = SrcMeshAuxDataTypeData%ElmNds + end if + if (allocated(SrcMeshAuxDataTypeData%Me)) then + LB(1:4) = lbound(SrcMeshAuxDataTypeData%Me) + UB(1:4) = ubound(SrcMeshAuxDataTypeData%Me) + if (.not. allocated(DstMeshAuxDataTypeData%Me)) then + allocate(DstMeshAuxDataTypeData%Me(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Me.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%Me = SrcMeshAuxDataTypeData%Me + end if + if (allocated(SrcMeshAuxDataTypeData%Ke)) then + LB(1:4) = lbound(SrcMeshAuxDataTypeData%Ke) + UB(1:4) = ubound(SrcMeshAuxDataTypeData%Ke) + if (.not. allocated(DstMeshAuxDataTypeData%Ke)) then + allocate(DstMeshAuxDataTypeData%Ke(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Ke.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%Ke = SrcMeshAuxDataTypeData%Ke + end if + if (allocated(SrcMeshAuxDataTypeData%Fg)) then + LB(1:3) = lbound(SrcMeshAuxDataTypeData%Fg) + UB(1:3) = ubound(SrcMeshAuxDataTypeData%Fg) + if (.not. allocated(DstMeshAuxDataTypeData%Fg)) then + allocate(DstMeshAuxDataTypeData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Fg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%Fg = SrcMeshAuxDataTypeData%Fg + end if +end subroutine + +subroutine SD_DestroyMeshAuxDataType(MeshAuxDataTypeData, ErrStat, ErrMsg) + type(MeshAuxDataType), intent(inout) :: MeshAuxDataTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyMeshAuxDataType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MeshAuxDataTypeData%NodeCnt)) then + deallocate(MeshAuxDataTypeData%NodeCnt) + end if + if (allocated(MeshAuxDataTypeData%NodeIDs)) then + deallocate(MeshAuxDataTypeData%NodeIDs) + end if + if (allocated(MeshAuxDataTypeData%ElmIDs)) then + deallocate(MeshAuxDataTypeData%ElmIDs) + end if + if (allocated(MeshAuxDataTypeData%ElmNds)) then + deallocate(MeshAuxDataTypeData%ElmNds) + end if + if (allocated(MeshAuxDataTypeData%Me)) then + deallocate(MeshAuxDataTypeData%Me) + end if + if (allocated(MeshAuxDataTypeData%Ke)) then + deallocate(MeshAuxDataTypeData%Ke) + end if + if (allocated(MeshAuxDataTypeData%Fg)) then + deallocate(MeshAuxDataTypeData%Fg) + end if +end subroutine + +subroutine SD_PackMeshAuxDataType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MeshAuxDataType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackMeshAuxDataType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%MemberID) + call RegPack(Buf, InData%NOutCnt) + call RegPack(Buf, allocated(InData%NodeCnt)) + if (allocated(InData%NodeCnt)) then + call RegPackBounds(Buf, 1, lbound(InData%NodeCnt), ubound(InData%NodeCnt)) + call RegPack(Buf, InData%NodeCnt) + end if + call RegPack(Buf, allocated(InData%NodeIDs)) + if (allocated(InData%NodeIDs)) then + call RegPackBounds(Buf, 1, lbound(InData%NodeIDs), ubound(InData%NodeIDs)) + call RegPack(Buf, InData%NodeIDs) + end if + call RegPack(Buf, allocated(InData%ElmIDs)) + if (allocated(InData%ElmIDs)) then + call RegPackBounds(Buf, 2, lbound(InData%ElmIDs), ubound(InData%ElmIDs)) + call RegPack(Buf, InData%ElmIDs) + end if + call RegPack(Buf, allocated(InData%ElmNds)) + if (allocated(InData%ElmNds)) then + call RegPackBounds(Buf, 2, lbound(InData%ElmNds), ubound(InData%ElmNds)) + call RegPack(Buf, InData%ElmNds) + end if + call RegPack(Buf, allocated(InData%Me)) + if (allocated(InData%Me)) then + call RegPackBounds(Buf, 4, lbound(InData%Me), ubound(InData%Me)) + call RegPack(Buf, InData%Me) + end if + call RegPack(Buf, allocated(InData%Ke)) + if (allocated(InData%Ke)) then + call RegPackBounds(Buf, 4, lbound(InData%Ke), ubound(InData%Ke)) + call RegPack(Buf, InData%Ke) + end if + call RegPack(Buf, allocated(InData%Fg)) + if (allocated(InData%Fg)) then + call RegPackBounds(Buf, 3, lbound(InData%Fg), ubound(InData%Fg)) + call RegPack(Buf, InData%Fg) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackMeshAuxDataType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MeshAuxDataType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackMeshAuxDataType' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%MemberID) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NOutCnt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%NodeCnt)) deallocate(OutData%NodeCnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodeCnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeCnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodeCnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%NodeIDs)) deallocate(OutData%NodeIDs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodeIDs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIDs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodeIDs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ElmIDs)) deallocate(OutData%ElmIDs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElmIDs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmIDs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElmIDs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ElmNds)) deallocate(OutData%ElmNds) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElmNds(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmNds.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElmNds) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Me)) deallocate(OutData%Me) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Me(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Me.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Me) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Ke)) deallocate(OutData%Ke) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ke(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ke.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ke) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Fg)) deallocate(OutData%Fg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fg) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCode, ErrStat, ErrMsg) + type(CB_MatArrays), intent(in) :: SrcCB_MatArraysData + type(CB_MatArrays), intent(inout) :: DstCB_MatArraysData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyCB_MatArrays' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcCB_MatArraysData%MBB)) then + LB(1:2) = lbound(SrcCB_MatArraysData%MBB) + UB(1:2) = ubound(SrcCB_MatArraysData%MBB) + if (.not. allocated(DstCB_MatArraysData%MBB)) then + allocate(DstCB_MatArraysData%MBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCB_MatArraysData%MBB = SrcCB_MatArraysData%MBB + end if + if (allocated(SrcCB_MatArraysData%MBM)) then + LB(1:2) = lbound(SrcCB_MatArraysData%MBM) + UB(1:2) = ubound(SrcCB_MatArraysData%MBM) + if (.not. allocated(DstCB_MatArraysData%MBM)) then + allocate(DstCB_MatArraysData%MBM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCB_MatArraysData%MBM = SrcCB_MatArraysData%MBM + end if + if (allocated(SrcCB_MatArraysData%KBB)) then + LB(1:2) = lbound(SrcCB_MatArraysData%KBB) + UB(1:2) = ubound(SrcCB_MatArraysData%KBB) + if (.not. allocated(DstCB_MatArraysData%KBB)) then + allocate(DstCB_MatArraysData%KBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%KBB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCB_MatArraysData%KBB = SrcCB_MatArraysData%KBB + end if + if (allocated(SrcCB_MatArraysData%PhiL)) then + LB(1:2) = lbound(SrcCB_MatArraysData%PhiL) + UB(1:2) = ubound(SrcCB_MatArraysData%PhiL) + if (.not. allocated(DstCB_MatArraysData%PhiL)) then + allocate(DstCB_MatArraysData%PhiL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCB_MatArraysData%PhiL = SrcCB_MatArraysData%PhiL + end if + if (allocated(SrcCB_MatArraysData%PhiR)) then + LB(1:2) = lbound(SrcCB_MatArraysData%PhiR) + UB(1:2) = ubound(SrcCB_MatArraysData%PhiR) + if (.not. allocated(DstCB_MatArraysData%PhiR)) then + allocate(DstCB_MatArraysData%PhiR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCB_MatArraysData%PhiR = SrcCB_MatArraysData%PhiR + end if + if (allocated(SrcCB_MatArraysData%OmegaL)) then + LB(1:1) = lbound(SrcCB_MatArraysData%OmegaL) + UB(1:1) = ubound(SrcCB_MatArraysData%OmegaL) + if (.not. allocated(DstCB_MatArraysData%OmegaL)) then + allocate(DstCB_MatArraysData%OmegaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%OmegaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCB_MatArraysData%OmegaL = SrcCB_MatArraysData%OmegaL + end if +end subroutine + +subroutine SD_DestroyCB_MatArrays(CB_MatArraysData, ErrStat, ErrMsg) + type(CB_MatArrays), intent(inout) :: CB_MatArraysData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyCB_MatArrays' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(CB_MatArraysData%MBB)) then + deallocate(CB_MatArraysData%MBB) + end if + if (allocated(CB_MatArraysData%MBM)) then + deallocate(CB_MatArraysData%MBM) + end if + if (allocated(CB_MatArraysData%KBB)) then + deallocate(CB_MatArraysData%KBB) + end if + if (allocated(CB_MatArraysData%PhiL)) then + deallocate(CB_MatArraysData%PhiL) + end if + if (allocated(CB_MatArraysData%PhiR)) then + deallocate(CB_MatArraysData%PhiR) + end if + if (allocated(CB_MatArraysData%OmegaL)) then + deallocate(CB_MatArraysData%OmegaL) + end if +end subroutine + +subroutine SD_PackCB_MatArrays(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(CB_MatArrays), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackCB_MatArrays' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%MBB)) + if (allocated(InData%MBB)) then + call RegPackBounds(Buf, 2, lbound(InData%MBB), ubound(InData%MBB)) + call RegPack(Buf, InData%MBB) + end if + call RegPack(Buf, allocated(InData%MBM)) + if (allocated(InData%MBM)) then + call RegPackBounds(Buf, 2, lbound(InData%MBM), ubound(InData%MBM)) + call RegPack(Buf, InData%MBM) + end if + call RegPack(Buf, allocated(InData%KBB)) + if (allocated(InData%KBB)) then + call RegPackBounds(Buf, 2, lbound(InData%KBB), ubound(InData%KBB)) + call RegPack(Buf, InData%KBB) + end if + call RegPack(Buf, allocated(InData%PhiL)) + if (allocated(InData%PhiL)) then + call RegPackBounds(Buf, 2, lbound(InData%PhiL), ubound(InData%PhiL)) + call RegPack(Buf, InData%PhiL) + end if + call RegPack(Buf, allocated(InData%PhiR)) + if (allocated(InData%PhiR)) then + call RegPackBounds(Buf, 2, lbound(InData%PhiR), ubound(InData%PhiR)) + call RegPack(Buf, InData%PhiR) + end if + call RegPack(Buf, allocated(InData%OmegaL)) + if (allocated(InData%OmegaL)) then + call RegPackBounds(Buf, 1, lbound(InData%OmegaL), ubound(InData%OmegaL)) + call RegPack(Buf, InData%OmegaL) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackCB_MatArrays(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(CB_MatArrays), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackCB_MatArrays' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%MBB)) deallocate(OutData%MBB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MBB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MBB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MBM)) deallocate(OutData%MBM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MBM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MBM) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%KBB)) deallocate(OutData%KBB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%KBB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%KBB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PhiL)) deallocate(OutData%PhiL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PhiL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PhiL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PhiR)) deallocate(OutData%PhiR) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PhiR(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PhiR) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%OmegaL)) deallocate(OutData%OmegaL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OmegaL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OmegaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OmegaL) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SD_CopyElemPropType(SrcElemPropTypeData, DstElemPropTypeData, CtrlCode, ErrStat, ErrMsg) + type(ElemPropType), intent(in) :: SrcElemPropTypeData + type(ElemPropType), intent(inout) :: DstElemPropTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_CopyElemPropType' + ErrStat = ErrID_None + ErrMsg = '' + DstElemPropTypeData%eType = SrcElemPropTypeData%eType + DstElemPropTypeData%Length = SrcElemPropTypeData%Length + DstElemPropTypeData%Ixx = SrcElemPropTypeData%Ixx + DstElemPropTypeData%Iyy = SrcElemPropTypeData%Iyy + DstElemPropTypeData%Jzz = SrcElemPropTypeData%Jzz + DstElemPropTypeData%Shear = SrcElemPropTypeData%Shear + DstElemPropTypeData%Kappa_x = SrcElemPropTypeData%Kappa_x + DstElemPropTypeData%Kappa_y = SrcElemPropTypeData%Kappa_y + DstElemPropTypeData%YoungE = SrcElemPropTypeData%YoungE + DstElemPropTypeData%ShearG = SrcElemPropTypeData%ShearG + DstElemPropTypeData%D = SrcElemPropTypeData%D + DstElemPropTypeData%Area = SrcElemPropTypeData%Area + DstElemPropTypeData%Rho = SrcElemPropTypeData%Rho + DstElemPropTypeData%T0 = SrcElemPropTypeData%T0 + DstElemPropTypeData%DirCos = SrcElemPropTypeData%DirCos +end subroutine + +subroutine SD_DestroyElemPropType(ElemPropTypeData, ErrStat, ErrMsg) + type(ElemPropType), intent(inout) :: ElemPropTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyElemPropType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SD_PackElemPropType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ElemPropType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackElemPropType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%eType) + call RegPack(Buf, InData%Length) + call RegPack(Buf, InData%Ixx) + call RegPack(Buf, InData%Iyy) + call RegPack(Buf, InData%Jzz) + call RegPack(Buf, InData%Shear) + call RegPack(Buf, InData%Kappa_x) + call RegPack(Buf, InData%Kappa_y) + call RegPack(Buf, InData%YoungE) + call RegPack(Buf, InData%ShearG) + call RegPack(Buf, InData%D) + call RegPack(Buf, InData%Area) + call RegPack(Buf, InData%Rho) + call RegPack(Buf, InData%T0) + call RegPack(Buf, InData%DirCos) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackElemPropType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ElemPropType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackElemPropType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%eType) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Length) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ixx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Iyy) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Jzz) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Shear) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Kappa_x) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Kappa_y) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YoungE) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ShearG) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%D) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Area) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Rho) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%T0) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DirCos) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SD_InitInputType), intent(inout) :: SrcInitInputData + type(SD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%SDInputFile = SrcInitInputData%SDInputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%g = SrcInitInputData%g + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%TP_RefPoint = SrcInitInputData%TP_RefPoint + DstInitInputData%SubRotateZ = SrcInitInputData%SubRotateZ + if (allocated(SrcInitInputData%SoilStiffness)) then + LB(1:3) = lbound(SrcInitInputData%SoilStiffness) + UB(1:3) = ubound(SrcInitInputData%SoilStiffness) + if (.not. allocated(DstInitInputData%SoilStiffness)) then + allocate(DstInitInputData%SoilStiffness(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%SoilStiffness.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%SoilStiffness = SrcInitInputData%SoilStiffness + end if + call MeshCopy(SrcInitInputData%SoilMesh, DstInitInputData%SoilMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%Linearize = SrcInitInputData%Linearize +end subroutine + +subroutine SD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%SoilStiffness)) then + deallocate(InitInputData%SoilStiffness) + end if + call MeshDestroy( InitInputData%SoilMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SD_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%SDInputFile) + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%g) + call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%TP_RefPoint) + call RegPack(Buf, InData%SubRotateZ) + call RegPack(Buf, allocated(InData%SoilStiffness)) + if (allocated(InData%SoilStiffness)) then + call RegPackBounds(Buf, 3, lbound(InData%SoilStiffness), ubound(InData%SoilStiffness)) + call RegPack(Buf, InData%SoilStiffness) + end if + call MeshPack(Buf, InData%SoilMesh) + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%SDInputFile) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%g) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TP_RefPoint) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SubRotateZ) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%SoilStiffness)) deallocate(OutData%SoilStiffness) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SoilStiffness(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SoilStiffness.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SoilStiffness) + if (RegCheckErr(Buf, RoutineName)) return + end if + call MeshUnpack(Buf, OutData%SoilMesh) ! SoilMesh + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SD_InitOutputType), intent(in) :: SrcInitOutputData + type(SD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x + end if + if (allocated(SrcInitOutputData%CableCChanRqst)) then + LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst) + UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst) + if (.not. allocated(DstInitOutputData%CableCChanRqst)) then + allocate(DstInitOutputData%CableCChanRqst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst + end if +end subroutine + +subroutine SD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + 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) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if + if (allocated(InitOutputData%CableCChanRqst)) then + deallocate(InitOutputData%CableCChanRqst) + end if +end subroutine + +subroutine SD_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + call RegPack(Buf, allocated(InData%CableCChanRqst)) + if (allocated(InData%CableCChanRqst)) then + call RegPackBounds(Buf, 1, lbound(InData%CableCChanRqst), ubound(InData%CableCChanRqst)) + call RegPack(Buf, InData%CableCChanRqst) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CableCChanRqst)) deallocate(OutData%CableCChanRqst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableCChanRqst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableCChanRqst) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, ErrMsg) + type(SD_InitType), intent(in) :: SrcInitTypeData + type(SD_InitType), intent(inout) :: DstInitTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyInitType' + ErrStat = ErrID_None + ErrMsg = '' + DstInitTypeData%RootName = SrcInitTypeData%RootName + DstInitTypeData%TP_RefPoint = SrcInitTypeData%TP_RefPoint + DstInitTypeData%SubRotateZ = SrcInitTypeData%SubRotateZ + DstInitTypeData%g = SrcInitTypeData%g + DstInitTypeData%DT = SrcInitTypeData%DT + DstInitTypeData%NJoints = SrcInitTypeData%NJoints + DstInitTypeData%NPropSetsX = SrcInitTypeData%NPropSetsX + DstInitTypeData%NPropSetsB = SrcInitTypeData%NPropSetsB + DstInitTypeData%NPropSetsC = SrcInitTypeData%NPropSetsC + DstInitTypeData%NPropSetsR = SrcInitTypeData%NPropSetsR + DstInitTypeData%NCMass = SrcInitTypeData%NCMass + DstInitTypeData%NCOSMs = SrcInitTypeData%NCOSMs + DstInitTypeData%FEMMod = SrcInitTypeData%FEMMod + DstInitTypeData%NDiv = SrcInitTypeData%NDiv + DstInitTypeData%CBMod = SrcInitTypeData%CBMod + if (allocated(SrcInitTypeData%Joints)) then + LB(1:2) = lbound(SrcInitTypeData%Joints) + UB(1:2) = ubound(SrcInitTypeData%Joints) + if (.not. allocated(DstInitTypeData%Joints)) then + allocate(DstInitTypeData%Joints(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Joints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%Joints = SrcInitTypeData%Joints + end if + if (allocated(SrcInitTypeData%PropSetsB)) then + LB(1:2) = lbound(SrcInitTypeData%PropSetsB) + UB(1:2) = ubound(SrcInitTypeData%PropSetsB) + if (.not. allocated(DstInitTypeData%PropSetsB)) then + allocate(DstInitTypeData%PropSetsB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropSetsB = SrcInitTypeData%PropSetsB + end if + if (allocated(SrcInitTypeData%PropSetsC)) then + LB(1:2) = lbound(SrcInitTypeData%PropSetsC) + UB(1:2) = ubound(SrcInitTypeData%PropSetsC) + if (.not. allocated(DstInitTypeData%PropSetsC)) then + allocate(DstInitTypeData%PropSetsC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropSetsC = SrcInitTypeData%PropSetsC + end if + if (allocated(SrcInitTypeData%PropSetsR)) then + LB(1:2) = lbound(SrcInitTypeData%PropSetsR) + UB(1:2) = ubound(SrcInitTypeData%PropSetsR) + if (.not. allocated(DstInitTypeData%PropSetsR)) then + allocate(DstInitTypeData%PropSetsR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropSetsR = SrcInitTypeData%PropSetsR + end if + if (allocated(SrcInitTypeData%PropSetsX)) then + LB(1:2) = lbound(SrcInitTypeData%PropSetsX) + UB(1:2) = ubound(SrcInitTypeData%PropSetsX) + if (.not. allocated(DstInitTypeData%PropSetsX)) then + allocate(DstInitTypeData%PropSetsX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropSetsX = SrcInitTypeData%PropSetsX + end if + if (allocated(SrcInitTypeData%COSMs)) then + LB(1:2) = lbound(SrcInitTypeData%COSMs) + UB(1:2) = ubound(SrcInitTypeData%COSMs) + if (.not. allocated(DstInitTypeData%COSMs)) then + allocate(DstInitTypeData%COSMs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%COSMs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%COSMs = SrcInitTypeData%COSMs + end if + if (allocated(SrcInitTypeData%CMass)) then + LB(1:2) = lbound(SrcInitTypeData%CMass) + UB(1:2) = ubound(SrcInitTypeData%CMass) + if (.not. allocated(DstInitTypeData%CMass)) then + allocate(DstInitTypeData%CMass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%CMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%CMass = SrcInitTypeData%CMass + end if + if (allocated(SrcInitTypeData%JDampings)) then + LB(1:1) = lbound(SrcInitTypeData%JDampings) + UB(1:1) = ubound(SrcInitTypeData%JDampings) + if (.not. allocated(DstInitTypeData%JDampings)) then + allocate(DstInitTypeData%JDampings(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%JDampings.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%JDampings = SrcInitTypeData%JDampings + end if + DstInitTypeData%GuyanDampMod = SrcInitTypeData%GuyanDampMod + DstInitTypeData%RayleighDamp = SrcInitTypeData%RayleighDamp + DstInitTypeData%GuyanDampMat = SrcInitTypeData%GuyanDampMat + if (allocated(SrcInitTypeData%Members)) then + LB(1:2) = lbound(SrcInitTypeData%Members) + UB(1:2) = ubound(SrcInitTypeData%Members) + if (.not. allocated(DstInitTypeData%Members)) then + allocate(DstInitTypeData%Members(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Members.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%Members = SrcInitTypeData%Members + end if + if (allocated(SrcInitTypeData%SSOutList)) then + LB(1:1) = lbound(SrcInitTypeData%SSOutList) + UB(1:1) = ubound(SrcInitTypeData%SSOutList) + if (.not. allocated(DstInitTypeData%SSOutList)) then + allocate(DstInitTypeData%SSOutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSOutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%SSOutList = SrcInitTypeData%SSOutList + end if + DstInitTypeData%OutCOSM = SrcInitTypeData%OutCOSM + DstInitTypeData%TabDelim = SrcInitTypeData%TabDelim + if (allocated(SrcInitTypeData%SSIK)) then + LB(1:2) = lbound(SrcInitTypeData%SSIK) + UB(1:2) = ubound(SrcInitTypeData%SSIK) + if (.not. allocated(DstInitTypeData%SSIK)) then + allocate(DstInitTypeData%SSIK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIK.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%SSIK = SrcInitTypeData%SSIK + end if + if (allocated(SrcInitTypeData%SSIM)) then + LB(1:2) = lbound(SrcInitTypeData%SSIM) + UB(1:2) = ubound(SrcInitTypeData%SSIM) + if (.not. allocated(DstInitTypeData%SSIM)) then + allocate(DstInitTypeData%SSIM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%SSIM = SrcInitTypeData%SSIM + end if + if (allocated(SrcInitTypeData%SSIfile)) then + LB(1:1) = lbound(SrcInitTypeData%SSIfile) + UB(1:1) = ubound(SrcInitTypeData%SSIfile) + if (.not. allocated(DstInitTypeData%SSIfile)) then + allocate(DstInitTypeData%SSIfile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIfile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%SSIfile = SrcInitTypeData%SSIfile + end if + if (allocated(SrcInitTypeData%Soil_K)) then + LB(1:3) = lbound(SrcInitTypeData%Soil_K) + UB(1:3) = ubound(SrcInitTypeData%Soil_K) + if (.not. allocated(DstInitTypeData%Soil_K)) then + allocate(DstInitTypeData%Soil_K(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_K.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%Soil_K = SrcInitTypeData%Soil_K + end if + if (allocated(SrcInitTypeData%Soil_Points)) then + LB(1:2) = lbound(SrcInitTypeData%Soil_Points) + UB(1:2) = ubound(SrcInitTypeData%Soil_Points) + if (.not. allocated(DstInitTypeData%Soil_Points)) then + allocate(DstInitTypeData%Soil_Points(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_Points.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%Soil_Points = SrcInitTypeData%Soil_Points + end if + if (allocated(SrcInitTypeData%Soil_Nodes)) then + LB(1:1) = lbound(SrcInitTypeData%Soil_Nodes) + UB(1:1) = ubound(SrcInitTypeData%Soil_Nodes) + if (.not. allocated(DstInitTypeData%Soil_Nodes)) then + allocate(DstInitTypeData%Soil_Nodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_Nodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%Soil_Nodes = SrcInitTypeData%Soil_Nodes + end if + DstInitTypeData%NElem = SrcInitTypeData%NElem + DstInitTypeData%NPropB = SrcInitTypeData%NPropB + DstInitTypeData%NPropC = SrcInitTypeData%NPropC + DstInitTypeData%NPropR = SrcInitTypeData%NPropR + if (allocated(SrcInitTypeData%Nodes)) then + LB(1:2) = lbound(SrcInitTypeData%Nodes) + UB(1:2) = ubound(SrcInitTypeData%Nodes) + if (.not. allocated(DstInitTypeData%Nodes)) then + allocate(DstInitTypeData%Nodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Nodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%Nodes = SrcInitTypeData%Nodes + end if + if (allocated(SrcInitTypeData%PropsB)) then + LB(1:2) = lbound(SrcInitTypeData%PropsB) + UB(1:2) = ubound(SrcInitTypeData%PropsB) + if (.not. allocated(DstInitTypeData%PropsB)) then + allocate(DstInitTypeData%PropsB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropsB = SrcInitTypeData%PropsB + end if + if (allocated(SrcInitTypeData%PropsC)) then + LB(1:2) = lbound(SrcInitTypeData%PropsC) + UB(1:2) = ubound(SrcInitTypeData%PropsC) + if (.not. allocated(DstInitTypeData%PropsC)) then + allocate(DstInitTypeData%PropsC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropsC = SrcInitTypeData%PropsC + end if + if (allocated(SrcInitTypeData%PropsR)) then + LB(1:2) = lbound(SrcInitTypeData%PropsR) + UB(1:2) = ubound(SrcInitTypeData%PropsR) + if (.not. allocated(DstInitTypeData%PropsR)) then + allocate(DstInitTypeData%PropsR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropsR = SrcInitTypeData%PropsR + end if + if (allocated(SrcInitTypeData%K)) then + LB(1:2) = lbound(SrcInitTypeData%K) + UB(1:2) = ubound(SrcInitTypeData%K) + if (.not. allocated(DstInitTypeData%K)) then + allocate(DstInitTypeData%K(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%K.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%K = SrcInitTypeData%K + end if + if (allocated(SrcInitTypeData%M)) then + LB(1:2) = lbound(SrcInitTypeData%M) + UB(1:2) = ubound(SrcInitTypeData%M) + if (.not. allocated(DstInitTypeData%M)) then + allocate(DstInitTypeData%M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%M.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%M = SrcInitTypeData%M + end if + if (allocated(SrcInitTypeData%ElemProps)) then + LB(1:2) = lbound(SrcInitTypeData%ElemProps) + UB(1:2) = ubound(SrcInitTypeData%ElemProps) + if (.not. allocated(DstInitTypeData%ElemProps)) then + allocate(DstInitTypeData%ElemProps(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%ElemProps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%ElemProps = SrcInitTypeData%ElemProps + end if + if (allocated(SrcInitTypeData%MemberNodes)) then + LB(1:2) = lbound(SrcInitTypeData%MemberNodes) + UB(1:2) = ubound(SrcInitTypeData%MemberNodes) + if (.not. allocated(DstInitTypeData%MemberNodes)) then + allocate(DstInitTypeData%MemberNodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%MemberNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%MemberNodes = SrcInitTypeData%MemberNodes + end if + if (allocated(SrcInitTypeData%NodesConnN)) then + LB(1:2) = lbound(SrcInitTypeData%NodesConnN) + UB(1:2) = ubound(SrcInitTypeData%NodesConnN) + if (.not. allocated(DstInitTypeData%NodesConnN)) then + allocate(DstInitTypeData%NodesConnN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%NodesConnN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%NodesConnN = SrcInitTypeData%NodesConnN + end if + if (allocated(SrcInitTypeData%NodesConnE)) then + LB(1:2) = lbound(SrcInitTypeData%NodesConnE) + UB(1:2) = ubound(SrcInitTypeData%NodesConnE) + if (.not. allocated(DstInitTypeData%NodesConnE)) then + allocate(DstInitTypeData%NodesConnE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%NodesConnE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%NodesConnE = SrcInitTypeData%NodesConnE + end if + DstInitTypeData%SSSum = SrcInitTypeData%SSSum +end subroutine + +subroutine SD_DestroyInitType(InitTypeData, ErrStat, ErrMsg) + type(SD_InitType), intent(inout) :: InitTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyInitType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitTypeData%Joints)) then + deallocate(InitTypeData%Joints) + end if + if (allocated(InitTypeData%PropSetsB)) then + deallocate(InitTypeData%PropSetsB) + end if + if (allocated(InitTypeData%PropSetsC)) then + deallocate(InitTypeData%PropSetsC) + end if + if (allocated(InitTypeData%PropSetsR)) then + deallocate(InitTypeData%PropSetsR) + end if + if (allocated(InitTypeData%PropSetsX)) then + deallocate(InitTypeData%PropSetsX) + end if + if (allocated(InitTypeData%COSMs)) then + deallocate(InitTypeData%COSMs) + end if + if (allocated(InitTypeData%CMass)) then + deallocate(InitTypeData%CMass) + end if + if (allocated(InitTypeData%JDampings)) then + deallocate(InitTypeData%JDampings) + end if + if (allocated(InitTypeData%Members)) then + deallocate(InitTypeData%Members) + end if + if (allocated(InitTypeData%SSOutList)) then + deallocate(InitTypeData%SSOutList) + end if + if (allocated(InitTypeData%SSIK)) then + deallocate(InitTypeData%SSIK) + end if + if (allocated(InitTypeData%SSIM)) then + deallocate(InitTypeData%SSIM) + end if + if (allocated(InitTypeData%SSIfile)) then + deallocate(InitTypeData%SSIfile) + end if + if (allocated(InitTypeData%Soil_K)) then + deallocate(InitTypeData%Soil_K) + end if + if (allocated(InitTypeData%Soil_Points)) then + deallocate(InitTypeData%Soil_Points) + end if + if (allocated(InitTypeData%Soil_Nodes)) then + deallocate(InitTypeData%Soil_Nodes) + end if + if (allocated(InitTypeData%Nodes)) then + deallocate(InitTypeData%Nodes) + end if + if (allocated(InitTypeData%PropsB)) then + deallocate(InitTypeData%PropsB) + end if + if (allocated(InitTypeData%PropsC)) then + deallocate(InitTypeData%PropsC) + end if + if (allocated(InitTypeData%PropsR)) then + deallocate(InitTypeData%PropsR) + end if + if (allocated(InitTypeData%K)) then + deallocate(InitTypeData%K) + end if + if (allocated(InitTypeData%M)) then + deallocate(InitTypeData%M) + end if + if (allocated(InitTypeData%ElemProps)) then + deallocate(InitTypeData%ElemProps) + end if + if (allocated(InitTypeData%MemberNodes)) then + deallocate(InitTypeData%MemberNodes) + end if + if (allocated(InitTypeData%NodesConnN)) then + deallocate(InitTypeData%NodesConnN) + end if + if (allocated(InitTypeData%NodesConnE)) then + deallocate(InitTypeData%NodesConnE) + end if +end subroutine + +subroutine SD_PackInitType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_InitType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackInitType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%RootName) + call RegPack(Buf, InData%TP_RefPoint) + call RegPack(Buf, InData%SubRotateZ) + call RegPack(Buf, InData%g) + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%NJoints) + call RegPack(Buf, InData%NPropSetsX) + call RegPack(Buf, InData%NPropSetsB) + call RegPack(Buf, InData%NPropSetsC) + call RegPack(Buf, InData%NPropSetsR) + call RegPack(Buf, InData%NCMass) + call RegPack(Buf, InData%NCOSMs) + call RegPack(Buf, InData%FEMMod) + call RegPack(Buf, InData%NDiv) + call RegPack(Buf, InData%CBMod) + call RegPack(Buf, allocated(InData%Joints)) + if (allocated(InData%Joints)) then + call RegPackBounds(Buf, 2, lbound(InData%Joints), ubound(InData%Joints)) + call RegPack(Buf, InData%Joints) + end if + call RegPack(Buf, allocated(InData%PropSetsB)) + if (allocated(InData%PropSetsB)) then + call RegPackBounds(Buf, 2, lbound(InData%PropSetsB), ubound(InData%PropSetsB)) + call RegPack(Buf, InData%PropSetsB) + end if + call RegPack(Buf, allocated(InData%PropSetsC)) + if (allocated(InData%PropSetsC)) then + call RegPackBounds(Buf, 2, lbound(InData%PropSetsC), ubound(InData%PropSetsC)) + call RegPack(Buf, InData%PropSetsC) + end if + call RegPack(Buf, allocated(InData%PropSetsR)) + if (allocated(InData%PropSetsR)) then + call RegPackBounds(Buf, 2, lbound(InData%PropSetsR), ubound(InData%PropSetsR)) + call RegPack(Buf, InData%PropSetsR) + end if + call RegPack(Buf, allocated(InData%PropSetsX)) + if (allocated(InData%PropSetsX)) then + call RegPackBounds(Buf, 2, lbound(InData%PropSetsX), ubound(InData%PropSetsX)) + call RegPack(Buf, InData%PropSetsX) + end if + call RegPack(Buf, allocated(InData%COSMs)) + if (allocated(InData%COSMs)) then + call RegPackBounds(Buf, 2, lbound(InData%COSMs), ubound(InData%COSMs)) + call RegPack(Buf, InData%COSMs) + end if + call RegPack(Buf, allocated(InData%CMass)) + if (allocated(InData%CMass)) then + call RegPackBounds(Buf, 2, lbound(InData%CMass), ubound(InData%CMass)) + call RegPack(Buf, InData%CMass) + end if + call RegPack(Buf, allocated(InData%JDampings)) + if (allocated(InData%JDampings)) then + call RegPackBounds(Buf, 1, lbound(InData%JDampings), ubound(InData%JDampings)) + call RegPack(Buf, InData%JDampings) + end if + call RegPack(Buf, InData%GuyanDampMod) + call RegPack(Buf, InData%RayleighDamp) + call RegPack(Buf, InData%GuyanDampMat) + call RegPack(Buf, allocated(InData%Members)) + if (allocated(InData%Members)) then + call RegPackBounds(Buf, 2, lbound(InData%Members), ubound(InData%Members)) + call RegPack(Buf, InData%Members) + end if + call RegPack(Buf, allocated(InData%SSOutList)) + if (allocated(InData%SSOutList)) then + call RegPackBounds(Buf, 1, lbound(InData%SSOutList), ubound(InData%SSOutList)) + call RegPack(Buf, InData%SSOutList) + end if + call RegPack(Buf, InData%OutCOSM) + call RegPack(Buf, InData%TabDelim) + call RegPack(Buf, allocated(InData%SSIK)) + if (allocated(InData%SSIK)) then + call RegPackBounds(Buf, 2, lbound(InData%SSIK), ubound(InData%SSIK)) + call RegPack(Buf, InData%SSIK) + end if + call RegPack(Buf, allocated(InData%SSIM)) + if (allocated(InData%SSIM)) then + call RegPackBounds(Buf, 2, lbound(InData%SSIM), ubound(InData%SSIM)) + call RegPack(Buf, InData%SSIM) + end if + call RegPack(Buf, allocated(InData%SSIfile)) + if (allocated(InData%SSIfile)) then + call RegPackBounds(Buf, 1, lbound(InData%SSIfile), ubound(InData%SSIfile)) + call RegPack(Buf, InData%SSIfile) + end if + call RegPack(Buf, allocated(InData%Soil_K)) + if (allocated(InData%Soil_K)) then + call RegPackBounds(Buf, 3, lbound(InData%Soil_K), ubound(InData%Soil_K)) + call RegPack(Buf, InData%Soil_K) + end if + call RegPack(Buf, allocated(InData%Soil_Points)) + if (allocated(InData%Soil_Points)) then + call RegPackBounds(Buf, 2, lbound(InData%Soil_Points), ubound(InData%Soil_Points)) + call RegPack(Buf, InData%Soil_Points) + end if + call RegPack(Buf, allocated(InData%Soil_Nodes)) + if (allocated(InData%Soil_Nodes)) then + call RegPackBounds(Buf, 1, lbound(InData%Soil_Nodes), ubound(InData%Soil_Nodes)) + call RegPack(Buf, InData%Soil_Nodes) + end if + call RegPack(Buf, InData%NElem) + call RegPack(Buf, InData%NPropB) + call RegPack(Buf, InData%NPropC) + call RegPack(Buf, InData%NPropR) + call RegPack(Buf, allocated(InData%Nodes)) + if (allocated(InData%Nodes)) then + call RegPackBounds(Buf, 2, lbound(InData%Nodes), ubound(InData%Nodes)) + call RegPack(Buf, InData%Nodes) + end if + call RegPack(Buf, allocated(InData%PropsB)) + if (allocated(InData%PropsB)) then + call RegPackBounds(Buf, 2, lbound(InData%PropsB), ubound(InData%PropsB)) + call RegPack(Buf, InData%PropsB) + end if + call RegPack(Buf, allocated(InData%PropsC)) + if (allocated(InData%PropsC)) then + call RegPackBounds(Buf, 2, lbound(InData%PropsC), ubound(InData%PropsC)) + call RegPack(Buf, InData%PropsC) + end if + call RegPack(Buf, allocated(InData%PropsR)) + if (allocated(InData%PropsR)) then + call RegPackBounds(Buf, 2, lbound(InData%PropsR), ubound(InData%PropsR)) + call RegPack(Buf, InData%PropsR) + end if + call RegPack(Buf, allocated(InData%K)) + if (allocated(InData%K)) then + call RegPackBounds(Buf, 2, lbound(InData%K), ubound(InData%K)) + call RegPack(Buf, InData%K) + end if + call RegPack(Buf, allocated(InData%M)) + if (allocated(InData%M)) then + call RegPackBounds(Buf, 2, lbound(InData%M), ubound(InData%M)) + call RegPack(Buf, InData%M) + end if + call RegPack(Buf, allocated(InData%ElemProps)) + if (allocated(InData%ElemProps)) then + call RegPackBounds(Buf, 2, lbound(InData%ElemProps), ubound(InData%ElemProps)) + call RegPack(Buf, InData%ElemProps) + end if + call RegPack(Buf, allocated(InData%MemberNodes)) + if (allocated(InData%MemberNodes)) then + call RegPackBounds(Buf, 2, lbound(InData%MemberNodes), ubound(InData%MemberNodes)) + call RegPack(Buf, InData%MemberNodes) + end if + call RegPack(Buf, allocated(InData%NodesConnN)) + if (allocated(InData%NodesConnN)) then + call RegPackBounds(Buf, 2, lbound(InData%NodesConnN), ubound(InData%NodesConnN)) + call RegPack(Buf, InData%NodesConnN) + end if + call RegPack(Buf, allocated(InData%NodesConnE)) + if (allocated(InData%NodesConnE)) then + call RegPackBounds(Buf, 2, lbound(InData%NodesConnE), ubound(InData%NodesConnE)) + call RegPack(Buf, InData%NodesConnE) + end if + call RegPack(Buf, InData%SSSum) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackInitType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_InitType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackInitType' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TP_RefPoint) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SubRotateZ) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%g) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NJoints) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NPropSetsX) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NPropSetsB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NPropSetsC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NPropSetsR) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NCMass) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NCOSMs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FEMMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NDiv) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%CBMod) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Joints)) deallocate(OutData%Joints) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Joints(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Joints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Joints) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PropSetsB)) deallocate(OutData%PropSetsB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PropSetsB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PropSetsB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PropSetsC)) deallocate(OutData%PropSetsC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PropSetsC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PropSetsC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PropSetsR)) deallocate(OutData%PropSetsR) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PropSetsR(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PropSetsR) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PropSetsX)) deallocate(OutData%PropSetsX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PropSetsX(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PropSetsX) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%COSMs)) deallocate(OutData%COSMs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%COSMs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%COSMs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%COSMs) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CMass)) deallocate(OutData%CMass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CMass(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CMass) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%JDampings)) deallocate(OutData%JDampings) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%JDampings(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%JDampings.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%JDampings) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%GuyanDampMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RayleighDamp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GuyanDampMat) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Members)) deallocate(OutData%Members) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Members(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Members) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SSOutList)) deallocate(OutData%SSOutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SSOutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSOutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SSOutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%OutCOSM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TabDelim) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%SSIK)) deallocate(OutData%SSIK) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SSIK(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIK.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SSIK) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SSIM)) deallocate(OutData%SSIM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SSIM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SSIM) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SSIfile)) deallocate(OutData%SSIfile) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SSIfile(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIfile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SSIfile) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Soil_K)) deallocate(OutData%Soil_K) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Soil_K(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_K.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Soil_K) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Soil_Points)) deallocate(OutData%Soil_Points) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Soil_Points(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Points.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Soil_Points) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Soil_Nodes)) deallocate(OutData%Soil_Nodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Soil_Nodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Nodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Soil_Nodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NElem) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NPropB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NPropC) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NPropR) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Nodes)) deallocate(OutData%Nodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nodes(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Nodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PropsB)) deallocate(OutData%PropsB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PropsB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PropsB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PropsC)) deallocate(OutData%PropsC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PropsC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PropsC) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PropsR)) deallocate(OutData%PropsR) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PropsR(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PropsR) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%K)) deallocate(OutData%K) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%K(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%K) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%M)) deallocate(OutData%M) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ElemProps)) deallocate(OutData%ElemProps) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElemProps(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElemProps) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MemberNodes)) deallocate(OutData%MemberNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MemberNodes(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MemberNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%NodesConnN)) deallocate(OutData%NodesConnN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodesConnN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodesConnN) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%NodesConnE)) deallocate(OutData%NodesConnE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodesConnE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodesConnE) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%SSSum) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SD_ContinuousStateType), intent(in) :: SrcContStateData + type(SD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%qm)) then + LB(1:1) = lbound(SrcContStateData%qm) + UB(1:1) = ubound(SrcContStateData%qm) + if (.not. allocated(DstContStateData%qm)) then + allocate(DstContStateData%qm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%qm = SrcContStateData%qm + end if + if (allocated(SrcContStateData%qmdot)) then + LB(1:1) = lbound(SrcContStateData%qmdot) + UB(1:1) = ubound(SrcContStateData%qmdot) + if (.not. allocated(DstContStateData%qmdot)) then + allocate(DstContStateData%qmdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qmdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%qmdot = SrcContStateData%qmdot + end if +end subroutine + +subroutine SD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%qm)) then + deallocate(ContStateData%qm) + end if + if (allocated(ContStateData%qmdot)) then + deallocate(ContStateData%qmdot) + end if +end subroutine + +subroutine SD_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%qm)) + if (allocated(InData%qm)) then + call RegPackBounds(Buf, 1, lbound(InData%qm), ubound(InData%qm)) + call RegPack(Buf, InData%qm) + end if + call RegPack(Buf, allocated(InData%qmdot)) + if (allocated(InData%qmdot)) then + call RegPackBounds(Buf, 1, lbound(InData%qmdot), ubound(InData%qmdot)) + call RegPack(Buf, InData%qmdot) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackContState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%qm)) deallocate(OutData%qm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%qm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%qm) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%qmdot)) deallocate(OutData%qmdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%qmdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%qmdot) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine SD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SD_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine SD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SD_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SD_OtherStateType), intent(in) :: SrcOtherStateData + type(SD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%xdot)) then + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + if (.not. allocated(DstOtherStateData%xdot)) then + allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstOtherStateData%n = SrcOtherStateData%n +end subroutine + +subroutine SD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%xdot)) then + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call SD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%xdot) + end if +end subroutine + +subroutine SD_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%xdot)) + if (allocated(InData%xdot)) then + call RegPackBounds(Buf, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call SD_PackContState(Buf, InData%xdot(i1)) + end do + end if + call RegPack(Buf, InData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%xdot)) deallocate(OutData%xdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do + end if + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SD_MiscVarType), intent(in) :: SrcMiscData + type(SD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%qmdotdot)) then + LB(1:1) = lbound(SrcMiscData%qmdotdot) + UB(1:1) = ubound(SrcMiscData%qmdotdot) + if (.not. allocated(DstMiscData%qmdotdot)) then + allocate(DstMiscData%qmdotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%qmdotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%qmdotdot = SrcMiscData%qmdotdot + end if + DstMiscData%u_TP = SrcMiscData%u_TP + DstMiscData%udot_TP = SrcMiscData%udot_TP + DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP + if (allocated(SrcMiscData%F_L)) then + LB(1:1) = lbound(SrcMiscData%F_L) + UB(1:1) = ubound(SrcMiscData%F_L) + if (.not. allocated(DstMiscData%F_L)) then + allocate(DstMiscData%F_L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_L = SrcMiscData%F_L + end if + if (allocated(SrcMiscData%F_L2)) then + LB(1:1) = lbound(SrcMiscData%F_L2) + UB(1:1) = ubound(SrcMiscData%F_L2) + if (.not. allocated(DstMiscData%F_L2)) then + allocate(DstMiscData%F_L2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_L2 = SrcMiscData%F_L2 + end if + if (allocated(SrcMiscData%UR_bar)) then + LB(1:1) = lbound(SrcMiscData%UR_bar) + UB(1:1) = ubound(SrcMiscData%UR_bar) + if (.not. allocated(DstMiscData%UR_bar)) then + allocate(DstMiscData%UR_bar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UR_bar = SrcMiscData%UR_bar + end if + if (allocated(SrcMiscData%UR_bar_dot)) then + LB(1:1) = lbound(SrcMiscData%UR_bar_dot) + UB(1:1) = ubound(SrcMiscData%UR_bar_dot) + if (.not. allocated(DstMiscData%UR_bar_dot)) then + allocate(DstMiscData%UR_bar_dot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UR_bar_dot = SrcMiscData%UR_bar_dot + end if + if (allocated(SrcMiscData%UR_bar_dotdot)) then + LB(1:1) = lbound(SrcMiscData%UR_bar_dotdot) + UB(1:1) = ubound(SrcMiscData%UR_bar_dotdot) + if (.not. allocated(DstMiscData%UR_bar_dotdot)) then + allocate(DstMiscData%UR_bar_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UR_bar_dotdot = SrcMiscData%UR_bar_dotdot + end if + if (allocated(SrcMiscData%UL)) then + LB(1:1) = lbound(SrcMiscData%UL) + UB(1:1) = ubound(SrcMiscData%UL) + if (.not. allocated(DstMiscData%UL)) then + allocate(DstMiscData%UL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL = SrcMiscData%UL + end if + if (allocated(SrcMiscData%UL_NS)) then + LB(1:1) = lbound(SrcMiscData%UL_NS) + UB(1:1) = ubound(SrcMiscData%UL_NS) + if (.not. allocated(DstMiscData%UL_NS)) then + allocate(DstMiscData%UL_NS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_NS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_NS = SrcMiscData%UL_NS + end if + if (allocated(SrcMiscData%UL_dot)) then + LB(1:1) = lbound(SrcMiscData%UL_dot) + UB(1:1) = ubound(SrcMiscData%UL_dot) + if (.not. allocated(DstMiscData%UL_dot)) then + allocate(DstMiscData%UL_dot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_dot = SrcMiscData%UL_dot + end if + if (allocated(SrcMiscData%UL_dotdot)) then + LB(1:1) = lbound(SrcMiscData%UL_dotdot) + UB(1:1) = ubound(SrcMiscData%UL_dotdot) + if (.not. allocated(DstMiscData%UL_dotdot)) then + allocate(DstMiscData%UL_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_dotdot = SrcMiscData%UL_dotdot + end if + if (allocated(SrcMiscData%DU_full)) then + LB(1:1) = lbound(SrcMiscData%DU_full) + UB(1:1) = ubound(SrcMiscData%DU_full) + if (.not. allocated(DstMiscData%DU_full)) then + allocate(DstMiscData%DU_full(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DU_full.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DU_full = SrcMiscData%DU_full + end if + if (allocated(SrcMiscData%U_full)) then + LB(1:1) = lbound(SrcMiscData%U_full) + UB(1:1) = ubound(SrcMiscData%U_full) + if (.not. allocated(DstMiscData%U_full)) then + allocate(DstMiscData%U_full(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full = SrcMiscData%U_full + end if + if (allocated(SrcMiscData%U_full_NS)) then + LB(1:1) = lbound(SrcMiscData%U_full_NS) + UB(1:1) = ubound(SrcMiscData%U_full_NS) + if (.not. allocated(DstMiscData%U_full_NS)) then + allocate(DstMiscData%U_full_NS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_NS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_NS = SrcMiscData%U_full_NS + end if + if (allocated(SrcMiscData%U_full_dot)) then + LB(1:1) = lbound(SrcMiscData%U_full_dot) + UB(1:1) = ubound(SrcMiscData%U_full_dot) + if (.not. allocated(DstMiscData%U_full_dot)) then + allocate(DstMiscData%U_full_dot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_dot = SrcMiscData%U_full_dot + end if + if (allocated(SrcMiscData%U_full_dotdot)) then + LB(1:1) = lbound(SrcMiscData%U_full_dotdot) + UB(1:1) = ubound(SrcMiscData%U_full_dotdot) + if (.not. allocated(DstMiscData%U_full_dotdot)) then + allocate(DstMiscData%U_full_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_dotdot = SrcMiscData%U_full_dotdot + end if + if (allocated(SrcMiscData%U_full_elast)) then + LB(1:1) = lbound(SrcMiscData%U_full_elast) + UB(1:1) = ubound(SrcMiscData%U_full_elast) + if (.not. allocated(DstMiscData%U_full_elast)) then + allocate(DstMiscData%U_full_elast(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_elast.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_elast = SrcMiscData%U_full_elast + end if + if (allocated(SrcMiscData%U_red)) then + LB(1:1) = lbound(SrcMiscData%U_red) + UB(1:1) = ubound(SrcMiscData%U_red) + if (.not. allocated(DstMiscData%U_red)) then + allocate(DstMiscData%U_red(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_red = SrcMiscData%U_red + end if + if (allocated(SrcMiscData%FC_unit)) then + LB(1:1) = lbound(SrcMiscData%FC_unit) + UB(1:1) = ubound(SrcMiscData%FC_unit) + if (.not. allocated(DstMiscData%FC_unit)) then + allocate(DstMiscData%FC_unit(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FC_unit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FC_unit = SrcMiscData%FC_unit + end if + if (allocated(SrcMiscData%SDWrOutput)) then + LB(1:1) = lbound(SrcMiscData%SDWrOutput) + UB(1:1) = ubound(SrcMiscData%SDWrOutput) + if (.not. allocated(DstMiscData%SDWrOutput)) then + allocate(DstMiscData%SDWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SDWrOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SDWrOutput = SrcMiscData%SDWrOutput + end if + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + end if + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%Decimat = SrcMiscData%Decimat + if (allocated(SrcMiscData%Fext)) then + LB(1:1) = lbound(SrcMiscData%Fext) + UB(1:1) = ubound(SrcMiscData%Fext) + if (.not. allocated(DstMiscData%Fext)) then + allocate(DstMiscData%Fext(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Fext = SrcMiscData%Fext + end if + if (allocated(SrcMiscData%Fext_red)) then + LB(1:1) = lbound(SrcMiscData%Fext_red) + UB(1:1) = ubound(SrcMiscData%Fext_red) + if (.not. allocated(DstMiscData%Fext_red)) then + allocate(DstMiscData%Fext_red(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext_red.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Fext_red = SrcMiscData%Fext_red + end if + if (allocated(SrcMiscData%UL_SIM)) then + LB(1:1) = lbound(SrcMiscData%UL_SIM) + UB(1:1) = ubound(SrcMiscData%UL_SIM) + if (.not. allocated(DstMiscData%UL_SIM)) then + allocate(DstMiscData%UL_SIM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_SIM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_SIM = SrcMiscData%UL_SIM + end if + if (allocated(SrcMiscData%UL_0m)) then + LB(1:1) = lbound(SrcMiscData%UL_0m) + UB(1:1) = ubound(SrcMiscData%UL_0m) + if (.not. allocated(DstMiscData%UL_0m)) then + allocate(DstMiscData%UL_0m(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_0m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_0m = SrcMiscData%UL_0m + end if +end subroutine + +subroutine SD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%qmdotdot)) then + deallocate(MiscData%qmdotdot) + end if + if (allocated(MiscData%F_L)) then + deallocate(MiscData%F_L) + end if + if (allocated(MiscData%F_L2)) then + deallocate(MiscData%F_L2) + end if + if (allocated(MiscData%UR_bar)) then + deallocate(MiscData%UR_bar) + end if + if (allocated(MiscData%UR_bar_dot)) then + deallocate(MiscData%UR_bar_dot) + end if + if (allocated(MiscData%UR_bar_dotdot)) then + deallocate(MiscData%UR_bar_dotdot) + end if + if (allocated(MiscData%UL)) then + deallocate(MiscData%UL) + end if + if (allocated(MiscData%UL_NS)) then + deallocate(MiscData%UL_NS) + end if + if (allocated(MiscData%UL_dot)) then + deallocate(MiscData%UL_dot) + end if + if (allocated(MiscData%UL_dotdot)) then + deallocate(MiscData%UL_dotdot) + end if + if (allocated(MiscData%DU_full)) then + deallocate(MiscData%DU_full) + end if + if (allocated(MiscData%U_full)) then + deallocate(MiscData%U_full) + end if + if (allocated(MiscData%U_full_NS)) then + deallocate(MiscData%U_full_NS) + end if + if (allocated(MiscData%U_full_dot)) then + deallocate(MiscData%U_full_dot) + end if + if (allocated(MiscData%U_full_dotdot)) then + deallocate(MiscData%U_full_dotdot) + end if + if (allocated(MiscData%U_full_elast)) then + deallocate(MiscData%U_full_elast) + end if + if (allocated(MiscData%U_red)) then + deallocate(MiscData%U_red) + end if + if (allocated(MiscData%FC_unit)) then + deallocate(MiscData%FC_unit) + end if + if (allocated(MiscData%SDWrOutput)) then + deallocate(MiscData%SDWrOutput) + end if + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%Fext)) then + deallocate(MiscData%Fext) + end if + if (allocated(MiscData%Fext_red)) then + deallocate(MiscData%Fext_red) + end if + if (allocated(MiscData%UL_SIM)) then + deallocate(MiscData%UL_SIM) + end if + if (allocated(MiscData%UL_0m)) then + deallocate(MiscData%UL_0m) + end if +end subroutine + +subroutine SD_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%qmdotdot)) + if (allocated(InData%qmdotdot)) then + call RegPackBounds(Buf, 1, lbound(InData%qmdotdot), ubound(InData%qmdotdot)) + call RegPack(Buf, InData%qmdotdot) + end if + call RegPack(Buf, InData%u_TP) + call RegPack(Buf, InData%udot_TP) + call RegPack(Buf, InData%udotdot_TP) + call RegPack(Buf, allocated(InData%F_L)) + if (allocated(InData%F_L)) then + call RegPackBounds(Buf, 1, lbound(InData%F_L), ubound(InData%F_L)) + call RegPack(Buf, InData%F_L) + end if + call RegPack(Buf, allocated(InData%F_L2)) + if (allocated(InData%F_L2)) then + call RegPackBounds(Buf, 1, lbound(InData%F_L2), ubound(InData%F_L2)) + call RegPack(Buf, InData%F_L2) + end if + call RegPack(Buf, allocated(InData%UR_bar)) + if (allocated(InData%UR_bar)) then + call RegPackBounds(Buf, 1, lbound(InData%UR_bar), ubound(InData%UR_bar)) + call RegPack(Buf, InData%UR_bar) + end if + call RegPack(Buf, allocated(InData%UR_bar_dot)) + if (allocated(InData%UR_bar_dot)) then + call RegPackBounds(Buf, 1, lbound(InData%UR_bar_dot), ubound(InData%UR_bar_dot)) + call RegPack(Buf, InData%UR_bar_dot) + end if + call RegPack(Buf, allocated(InData%UR_bar_dotdot)) + if (allocated(InData%UR_bar_dotdot)) then + call RegPackBounds(Buf, 1, lbound(InData%UR_bar_dotdot), ubound(InData%UR_bar_dotdot)) + call RegPack(Buf, InData%UR_bar_dotdot) + end if + call RegPack(Buf, allocated(InData%UL)) + if (allocated(InData%UL)) then + call RegPackBounds(Buf, 1, lbound(InData%UL), ubound(InData%UL)) + call RegPack(Buf, InData%UL) + end if + call RegPack(Buf, allocated(InData%UL_NS)) + if (allocated(InData%UL_NS)) then + call RegPackBounds(Buf, 1, lbound(InData%UL_NS), ubound(InData%UL_NS)) + call RegPack(Buf, InData%UL_NS) + end if + call RegPack(Buf, allocated(InData%UL_dot)) + if (allocated(InData%UL_dot)) then + call RegPackBounds(Buf, 1, lbound(InData%UL_dot), ubound(InData%UL_dot)) + call RegPack(Buf, InData%UL_dot) + end if + call RegPack(Buf, allocated(InData%UL_dotdot)) + if (allocated(InData%UL_dotdot)) then + call RegPackBounds(Buf, 1, lbound(InData%UL_dotdot), ubound(InData%UL_dotdot)) + call RegPack(Buf, InData%UL_dotdot) + end if + call RegPack(Buf, allocated(InData%DU_full)) + if (allocated(InData%DU_full)) then + call RegPackBounds(Buf, 1, lbound(InData%DU_full), ubound(InData%DU_full)) + call RegPack(Buf, InData%DU_full) + end if + call RegPack(Buf, allocated(InData%U_full)) + if (allocated(InData%U_full)) then + call RegPackBounds(Buf, 1, lbound(InData%U_full), ubound(InData%U_full)) + call RegPack(Buf, InData%U_full) + end if + call RegPack(Buf, allocated(InData%U_full_NS)) + if (allocated(InData%U_full_NS)) then + call RegPackBounds(Buf, 1, lbound(InData%U_full_NS), ubound(InData%U_full_NS)) + call RegPack(Buf, InData%U_full_NS) + end if + call RegPack(Buf, allocated(InData%U_full_dot)) + if (allocated(InData%U_full_dot)) then + call RegPackBounds(Buf, 1, lbound(InData%U_full_dot), ubound(InData%U_full_dot)) + call RegPack(Buf, InData%U_full_dot) + end if + call RegPack(Buf, allocated(InData%U_full_dotdot)) + if (allocated(InData%U_full_dotdot)) then + call RegPackBounds(Buf, 1, lbound(InData%U_full_dotdot), ubound(InData%U_full_dotdot)) + call RegPack(Buf, InData%U_full_dotdot) + end if + call RegPack(Buf, allocated(InData%U_full_elast)) + if (allocated(InData%U_full_elast)) then + call RegPackBounds(Buf, 1, lbound(InData%U_full_elast), ubound(InData%U_full_elast)) + call RegPack(Buf, InData%U_full_elast) + end if + call RegPack(Buf, allocated(InData%U_red)) + if (allocated(InData%U_red)) then + call RegPackBounds(Buf, 1, lbound(InData%U_red), ubound(InData%U_red)) + call RegPack(Buf, InData%U_red) + end if + call RegPack(Buf, allocated(InData%FC_unit)) + if (allocated(InData%FC_unit)) then + call RegPackBounds(Buf, 1, lbound(InData%FC_unit), ubound(InData%FC_unit)) + call RegPack(Buf, InData%FC_unit) + end if + call RegPack(Buf, allocated(InData%SDWrOutput)) + if (allocated(InData%SDWrOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%SDWrOutput), ubound(InData%SDWrOutput)) + call RegPack(Buf, InData%SDWrOutput) + end if + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + call RegPack(Buf, InData%LastOutTime) + call RegPack(Buf, InData%Decimat) + call RegPack(Buf, allocated(InData%Fext)) + if (allocated(InData%Fext)) then + call RegPackBounds(Buf, 1, lbound(InData%Fext), ubound(InData%Fext)) + call RegPack(Buf, InData%Fext) + end if + call RegPack(Buf, allocated(InData%Fext_red)) + if (allocated(InData%Fext_red)) then + call RegPackBounds(Buf, 1, lbound(InData%Fext_red), ubound(InData%Fext_red)) + call RegPack(Buf, InData%Fext_red) + end if + call RegPack(Buf, allocated(InData%UL_SIM)) + if (allocated(InData%UL_SIM)) then + call RegPackBounds(Buf, 1, lbound(InData%UL_SIM), ubound(InData%UL_SIM)) + call RegPack(Buf, InData%UL_SIM) + end if + call RegPack(Buf, allocated(InData%UL_0m)) + if (allocated(InData%UL_0m)) then + call RegPackBounds(Buf, 1, lbound(InData%UL_0m), ubound(InData%UL_0m)) + call RegPack(Buf, InData%UL_0m) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackMisc' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%qmdotdot)) deallocate(OutData%qmdotdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%qmdotdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdotdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%qmdotdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%u_TP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%udot_TP) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%udotdot_TP) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%F_L)) deallocate(OutData%F_L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_L) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%F_L2)) deallocate(OutData%F_L2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_L2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_L2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%UR_bar)) deallocate(OutData%UR_bar) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UR_bar(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UR_bar) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%UR_bar_dot)) deallocate(OutData%UR_bar_dot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UR_bar_dot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UR_bar_dot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%UR_bar_dotdot)) deallocate(OutData%UR_bar_dotdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UR_bar_dotdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dotdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UR_bar_dotdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%UL)) deallocate(OutData%UL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UL) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%UL_NS)) deallocate(OutData%UL_NS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UL_NS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_NS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UL_NS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%UL_dot)) deallocate(OutData%UL_dot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UL_dot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UL_dot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%UL_dotdot)) deallocate(OutData%UL_dotdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UL_dotdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dotdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UL_dotdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DU_full)) deallocate(OutData%DU_full) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DU_full(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DU_full.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DU_full) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%U_full)) deallocate(OutData%U_full) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U_full(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U_full) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%U_full_NS)) deallocate(OutData%U_full_NS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U_full_NS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_NS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U_full_NS) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%U_full_dot)) deallocate(OutData%U_full_dot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U_full_dot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U_full_dot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%U_full_dotdot)) deallocate(OutData%U_full_dotdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U_full_dotdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dotdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U_full_dotdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%U_full_elast)) deallocate(OutData%U_full_elast) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U_full_elast(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_elast.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U_full_elast) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%U_red)) deallocate(OutData%U_red) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U_red(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_red.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U_red) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%FC_unit)) deallocate(OutData%FC_unit) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FC_unit(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FC_unit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FC_unit) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%SDWrOutput)) deallocate(OutData%SDWrOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SDWrOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDWrOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SDWrOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%LastOutTime) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Decimat) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Fext)) deallocate(OutData%Fext) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fext(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fext) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Fext_red)) deallocate(OutData%Fext_red) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fext_red(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext_red.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fext_red) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%UL_SIM)) deallocate(OutData%UL_SIM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UL_SIM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_SIM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UL_SIM) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%UL_0m)) deallocate(OutData%UL_0m) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UL_0m(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_0m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UL_0m) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SD_ParameterType), intent(in) :: SrcParamData + type(SD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%SDDeltaT = SrcParamData%SDDeltaT + DstParamData%IntMethod = SrcParamData%IntMethod + DstParamData%nDOF = SrcParamData%nDOF + DstParamData%nDOF_red = SrcParamData%nDOF_red + DstParamData%Nmembers = SrcParamData%Nmembers + if (allocated(SrcParamData%Elems)) then + LB(1:2) = lbound(SrcParamData%Elems) + UB(1:2) = ubound(SrcParamData%Elems) + if (.not. allocated(DstParamData%Elems)) then + allocate(DstParamData%Elems(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elems.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Elems = SrcParamData%Elems + end if + if (allocated(SrcParamData%ElemProps)) then + LB(1:1) = lbound(SrcParamData%ElemProps) + UB(1:1) = ubound(SrcParamData%ElemProps) + if (.not. allocated(DstParamData%ElemProps)) then + allocate(DstParamData%ElemProps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemProps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyElemPropType(SrcParamData%ElemProps(i1), DstParamData%ElemProps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%FG)) then + LB(1:1) = lbound(SrcParamData%FG) + UB(1:1) = ubound(SrcParamData%FG) + if (.not. allocated(DstParamData%FG)) then + allocate(DstParamData%FG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FG = SrcParamData%FG + end if + if (allocated(SrcParamData%DP0)) then + LB(1:2) = lbound(SrcParamData%DP0) + UB(1:2) = ubound(SrcParamData%DP0) + if (.not. allocated(DstParamData%DP0)) then + allocate(DstParamData%DP0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DP0 = SrcParamData%DP0 + end if + if (allocated(SrcParamData%NodeID2JointID)) then + LB(1:1) = lbound(SrcParamData%NodeID2JointID) + UB(1:1) = ubound(SrcParamData%NodeID2JointID) + if (.not. allocated(DstParamData%NodeID2JointID)) then + allocate(DstParamData%NodeID2JointID(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodeID2JointID.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%NodeID2JointID = SrcParamData%NodeID2JointID + end if + DstParamData%reduced = SrcParamData%reduced + if (allocated(SrcParamData%T_red)) then + LB(1:2) = lbound(SrcParamData%T_red) + UB(1:2) = ubound(SrcParamData%T_red) + if (.not. allocated(DstParamData%T_red)) then + allocate(DstParamData%T_red(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%T_red = SrcParamData%T_red + end if + if (allocated(SrcParamData%T_red_T)) then + LB(1:2) = lbound(SrcParamData%T_red_T) + UB(1:2) = ubound(SrcParamData%T_red_T) + if (.not. allocated(DstParamData%T_red_T)) then + allocate(DstParamData%T_red_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%T_red_T = SrcParamData%T_red_T + end if + if (allocated(SrcParamData%NodesDOF)) then + LB(1:1) = lbound(SrcParamData%NodesDOF) + UB(1:1) = ubound(SrcParamData%NodesDOF) + if (.not. allocated(DstParamData%NodesDOF)) then + allocate(DstParamData%NodesDOF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyIList(SrcParamData%NodesDOF(i1), DstParamData%NodesDOF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%NodesDOFred)) then + LB(1:1) = lbound(SrcParamData%NodesDOFred) + UB(1:1) = ubound(SrcParamData%NodesDOFred) + if (.not. allocated(DstParamData%NodesDOFred)) then + allocate(DstParamData%NodesDOFred(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOFred.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyIList(SrcParamData%NodesDOFred(i1), DstParamData%NodesDOFred(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%ElemsDOF)) then + LB(1:2) = lbound(SrcParamData%ElemsDOF) + UB(1:2) = ubound(SrcParamData%ElemsDOF) + if (.not. allocated(DstParamData%ElemsDOF)) then + allocate(DstParamData%ElemsDOF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemsDOF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ElemsDOF = SrcParamData%ElemsDOF + end if + if (allocated(SrcParamData%DOFred2Nodes)) then + LB(1:2) = lbound(SrcParamData%DOFred2Nodes) + UB(1:2) = ubound(SrcParamData%DOFred2Nodes) + if (.not. allocated(DstParamData%DOFred2Nodes)) then + allocate(DstParamData%DOFred2Nodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOFred2Nodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DOFred2Nodes = SrcParamData%DOFred2Nodes + end if + if (allocated(SrcParamData%CtrlElem2Channel)) then + LB(1:2) = lbound(SrcParamData%CtrlElem2Channel) + UB(1:2) = ubound(SrcParamData%CtrlElem2Channel) + if (.not. allocated(DstParamData%CtrlElem2Channel)) then + allocate(DstParamData%CtrlElem2Channel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CtrlElem2Channel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CtrlElem2Channel = SrcParamData%CtrlElem2Channel + end if + DstParamData%nDOFM = SrcParamData%nDOFM + DstParamData%SttcSolve = SrcParamData%SttcSolve + DstParamData%GuyanLoadCorrection = SrcParamData%GuyanLoadCorrection + DstParamData%Floating = SrcParamData%Floating + if (allocated(SrcParamData%KMMDiag)) then + LB(1:1) = lbound(SrcParamData%KMMDiag) + UB(1:1) = ubound(SrcParamData%KMMDiag) + if (.not. allocated(DstParamData%KMMDiag)) then + allocate(DstParamData%KMMDiag(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KMMDiag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%KMMDiag = SrcParamData%KMMDiag + end if + if (allocated(SrcParamData%CMMDiag)) then + LB(1:1) = lbound(SrcParamData%CMMDiag) + UB(1:1) = ubound(SrcParamData%CMMDiag) + if (.not. allocated(DstParamData%CMMDiag)) then + allocate(DstParamData%CMMDiag(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMMDiag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CMMDiag = SrcParamData%CMMDiag + end if + if (allocated(SrcParamData%MMB)) then + LB(1:2) = lbound(SrcParamData%MMB) + UB(1:2) = ubound(SrcParamData%MMB) + if (.not. allocated(DstParamData%MMB)) then + allocate(DstParamData%MMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MMB = SrcParamData%MMB + end if + if (allocated(SrcParamData%MBmmB)) then + LB(1:2) = lbound(SrcParamData%MBmmB) + UB(1:2) = ubound(SrcParamData%MBmmB) + if (.not. allocated(DstParamData%MBmmB)) then + allocate(DstParamData%MBmmB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBmmB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MBmmB = SrcParamData%MBmmB + end if + if (allocated(SrcParamData%C1_11)) then + LB(1:2) = lbound(SrcParamData%C1_11) + UB(1:2) = ubound(SrcParamData%C1_11) + if (.not. allocated(DstParamData%C1_11)) then + allocate(DstParamData%C1_11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_11.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C1_11 = SrcParamData%C1_11 + end if + if (allocated(SrcParamData%C1_12)) then + LB(1:2) = lbound(SrcParamData%C1_12) + UB(1:2) = ubound(SrcParamData%C1_12) + if (.not. allocated(DstParamData%C1_12)) then + allocate(DstParamData%C1_12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_12.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C1_12 = SrcParamData%C1_12 + end if + if (allocated(SrcParamData%D1_141)) then + LB(1:2) = lbound(SrcParamData%D1_141) + UB(1:2) = ubound(SrcParamData%D1_141) + if (.not. allocated(DstParamData%D1_141)) then + allocate(DstParamData%D1_141(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_141.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%D1_141 = SrcParamData%D1_141 + end if + if (allocated(SrcParamData%D1_142)) then + LB(1:2) = lbound(SrcParamData%D1_142) + UB(1:2) = ubound(SrcParamData%D1_142) + if (.not. allocated(DstParamData%D1_142)) then + allocate(DstParamData%D1_142(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_142.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%D1_142 = SrcParamData%D1_142 + end if + if (allocated(SrcParamData%PhiM)) then + LB(1:2) = lbound(SrcParamData%PhiM) + UB(1:2) = ubound(SrcParamData%PhiM) + if (.not. allocated(DstParamData%PhiM)) then + allocate(DstParamData%PhiM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PhiM = SrcParamData%PhiM + end if + if (allocated(SrcParamData%C2_61)) then + LB(1:2) = lbound(SrcParamData%C2_61) + UB(1:2) = ubound(SrcParamData%C2_61) + if (.not. allocated(DstParamData%C2_61)) then + allocate(DstParamData%C2_61(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_61.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C2_61 = SrcParamData%C2_61 + end if + if (allocated(SrcParamData%C2_62)) then + LB(1:2) = lbound(SrcParamData%C2_62) + UB(1:2) = ubound(SrcParamData%C2_62) + if (.not. allocated(DstParamData%C2_62)) then + allocate(DstParamData%C2_62(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_62.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C2_62 = SrcParamData%C2_62 + end if + if (allocated(SrcParamData%PhiRb_TI)) then + LB(1:2) = lbound(SrcParamData%PhiRb_TI) + UB(1:2) = ubound(SrcParamData%PhiRb_TI) + if (.not. allocated(DstParamData%PhiRb_TI)) then + allocate(DstParamData%PhiRb_TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiRb_TI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PhiRb_TI = SrcParamData%PhiRb_TI + end if + if (allocated(SrcParamData%D2_63)) then + LB(1:2) = lbound(SrcParamData%D2_63) + UB(1:2) = ubound(SrcParamData%D2_63) + if (.not. allocated(DstParamData%D2_63)) then + allocate(DstParamData%D2_63(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_63.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%D2_63 = SrcParamData%D2_63 + end if + if (allocated(SrcParamData%D2_64)) then + LB(1:2) = lbound(SrcParamData%D2_64) + UB(1:2) = ubound(SrcParamData%D2_64) + if (.not. allocated(DstParamData%D2_64)) then + allocate(DstParamData%D2_64(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_64.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%D2_64 = SrcParamData%D2_64 + end if + if (allocated(SrcParamData%MBB)) then + LB(1:2) = lbound(SrcParamData%MBB) + UB(1:2) = ubound(SrcParamData%MBB) + if (.not. allocated(DstParamData%MBB)) then + allocate(DstParamData%MBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MBB = SrcParamData%MBB + end if + if (allocated(SrcParamData%KBB)) then + LB(1:2) = lbound(SrcParamData%KBB) + UB(1:2) = ubound(SrcParamData%KBB) + if (.not. allocated(DstParamData%KBB)) then + allocate(DstParamData%KBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%KBB = SrcParamData%KBB + end if + if (allocated(SrcParamData%CBB)) then + LB(1:2) = lbound(SrcParamData%CBB) + UB(1:2) = ubound(SrcParamData%CBB) + if (.not. allocated(DstParamData%CBB)) then + allocate(DstParamData%CBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CBB = SrcParamData%CBB + end if + if (allocated(SrcParamData%CMM)) then + LB(1:2) = lbound(SrcParamData%CMM) + UB(1:2) = ubound(SrcParamData%CMM) + if (.not. allocated(DstParamData%CMM)) then + allocate(DstParamData%CMM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CMM = SrcParamData%CMM + end if + if (allocated(SrcParamData%MBM)) then + LB(1:2) = lbound(SrcParamData%MBM) + UB(1:2) = ubound(SrcParamData%MBM) + if (.not. allocated(DstParamData%MBM)) then + allocate(DstParamData%MBM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MBM = SrcParamData%MBM + end if + if (allocated(SrcParamData%PhiL_T)) then + LB(1:2) = lbound(SrcParamData%PhiL_T) + UB(1:2) = ubound(SrcParamData%PhiL_T) + if (.not. allocated(DstParamData%PhiL_T)) then + allocate(DstParamData%PhiL_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiL_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PhiL_T = SrcParamData%PhiL_T + end if + if (allocated(SrcParamData%PhiLInvOmgL2)) then + LB(1:2) = lbound(SrcParamData%PhiLInvOmgL2) + UB(1:2) = ubound(SrcParamData%PhiLInvOmgL2) + if (.not. allocated(DstParamData%PhiLInvOmgL2)) then + allocate(DstParamData%PhiLInvOmgL2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiLInvOmgL2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 + end if + if (allocated(SrcParamData%KLLm1)) then + LB(1:2) = lbound(SrcParamData%KLLm1) + UB(1:2) = ubound(SrcParamData%KLLm1) + if (.not. allocated(DstParamData%KLLm1)) then + allocate(DstParamData%KLLm1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KLLm1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%KLLm1 = SrcParamData%KLLm1 + end if + if (allocated(SrcParamData%AM2Jac)) then + LB(1:2) = lbound(SrcParamData%AM2Jac) + UB(1:2) = ubound(SrcParamData%AM2Jac) + if (.not. allocated(DstParamData%AM2Jac)) then + allocate(DstParamData%AM2Jac(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2Jac.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AM2Jac = SrcParamData%AM2Jac + end if + if (allocated(SrcParamData%AM2JacPiv)) then + LB(1:1) = lbound(SrcParamData%AM2JacPiv) + UB(1:1) = ubound(SrcParamData%AM2JacPiv) + if (.not. allocated(DstParamData%AM2JacPiv)) then + allocate(DstParamData%AM2JacPiv(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2JacPiv.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv + end if + if (allocated(SrcParamData%TI)) then + LB(1:2) = lbound(SrcParamData%TI) + UB(1:2) = ubound(SrcParamData%TI) + if (.not. allocated(DstParamData%TI)) then + allocate(DstParamData%TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TI = SrcParamData%TI + end if + if (allocated(SrcParamData%TIreact)) then + LB(1:2) = lbound(SrcParamData%TIreact) + UB(1:2) = ubound(SrcParamData%TIreact) + if (.not. allocated(DstParamData%TIreact)) then + allocate(DstParamData%TIreact(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TIreact.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TIreact = SrcParamData%TIreact + end if + DstParamData%nNodes = SrcParamData%nNodes + DstParamData%nNodes_I = SrcParamData%nNodes_I + DstParamData%nNodes_L = SrcParamData%nNodes_L + DstParamData%nNodes_C = SrcParamData%nNodes_C + if (allocated(SrcParamData%Nodes_I)) then + LB(1:2) = lbound(SrcParamData%Nodes_I) + UB(1:2) = ubound(SrcParamData%Nodes_I) + if (.not. allocated(DstParamData%Nodes_I)) then + allocate(DstParamData%Nodes_I(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_I.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Nodes_I = SrcParamData%Nodes_I + end if + if (allocated(SrcParamData%Nodes_L)) then + LB(1:2) = lbound(SrcParamData%Nodes_L) + UB(1:2) = ubound(SrcParamData%Nodes_L) + if (.not. allocated(DstParamData%Nodes_L)) then + allocate(DstParamData%Nodes_L(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Nodes_L = SrcParamData%Nodes_L + end if + if (allocated(SrcParamData%Nodes_C)) then + LB(1:2) = lbound(SrcParamData%Nodes_C) + UB(1:2) = ubound(SrcParamData%Nodes_C) + if (.not. allocated(DstParamData%Nodes_C)) then + allocate(DstParamData%Nodes_C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Nodes_C = SrcParamData%Nodes_C + end if + DstParamData%nDOFI__ = SrcParamData%nDOFI__ + DstParamData%nDOFI_Rb = SrcParamData%nDOFI_Rb + DstParamData%nDOFI_F = SrcParamData%nDOFI_F + DstParamData%nDOFL_L = SrcParamData%nDOFL_L + DstParamData%nDOFC__ = SrcParamData%nDOFC__ + DstParamData%nDOFC_Rb = SrcParamData%nDOFC_Rb + DstParamData%nDOFC_L = SrcParamData%nDOFC_L + DstParamData%nDOFC_F = SrcParamData%nDOFC_F + DstParamData%nDOFR__ = SrcParamData%nDOFR__ + DstParamData%nDOF__Rb = SrcParamData%nDOF__Rb + DstParamData%nDOF__L = SrcParamData%nDOF__L + DstParamData%nDOF__F = SrcParamData%nDOF__F + if (allocated(SrcParamData%IDI__)) then + LB(1:1) = lbound(SrcParamData%IDI__) + UB(1:1) = ubound(SrcParamData%IDI__) + if (.not. allocated(DstParamData%IDI__)) then + allocate(DstParamData%IDI__(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI__.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDI__ = SrcParamData%IDI__ + end if + if (allocated(SrcParamData%IDI_Rb)) then + LB(1:1) = lbound(SrcParamData%IDI_Rb) + UB(1:1) = ubound(SrcParamData%IDI_Rb) + if (.not. allocated(DstParamData%IDI_Rb)) then + allocate(DstParamData%IDI_Rb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_Rb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDI_Rb = SrcParamData%IDI_Rb + end if + if (allocated(SrcParamData%IDI_F)) then + LB(1:1) = lbound(SrcParamData%IDI_F) + UB(1:1) = ubound(SrcParamData%IDI_F) + if (.not. allocated(DstParamData%IDI_F)) then + allocate(DstParamData%IDI_F(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_F.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDI_F = SrcParamData%IDI_F + end if + if (allocated(SrcParamData%IDL_L)) then + LB(1:1) = lbound(SrcParamData%IDL_L) + UB(1:1) = ubound(SrcParamData%IDL_L) + if (.not. allocated(DstParamData%IDL_L)) then + allocate(DstParamData%IDL_L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDL_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDL_L = SrcParamData%IDL_L + end if + if (allocated(SrcParamData%IDC__)) then + LB(1:1) = lbound(SrcParamData%IDC__) + UB(1:1) = ubound(SrcParamData%IDC__) + if (.not. allocated(DstParamData%IDC__)) then + allocate(DstParamData%IDC__(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC__.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDC__ = SrcParamData%IDC__ + end if + if (allocated(SrcParamData%IDC_Rb)) then + LB(1:1) = lbound(SrcParamData%IDC_Rb) + UB(1:1) = ubound(SrcParamData%IDC_Rb) + if (.not. allocated(DstParamData%IDC_Rb)) then + allocate(DstParamData%IDC_Rb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_Rb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDC_Rb = SrcParamData%IDC_Rb + end if + if (allocated(SrcParamData%IDC_L)) then + LB(1:1) = lbound(SrcParamData%IDC_L) + UB(1:1) = ubound(SrcParamData%IDC_L) + if (.not. allocated(DstParamData%IDC_L)) then + allocate(DstParamData%IDC_L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDC_L = SrcParamData%IDC_L + end if + if (allocated(SrcParamData%IDC_F)) then + LB(1:1) = lbound(SrcParamData%IDC_F) + UB(1:1) = ubound(SrcParamData%IDC_F) + if (.not. allocated(DstParamData%IDC_F)) then + allocate(DstParamData%IDC_F(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_F.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDC_F = SrcParamData%IDC_F + end if + if (allocated(SrcParamData%IDR__)) then + LB(1:1) = lbound(SrcParamData%IDR__) + UB(1:1) = ubound(SrcParamData%IDR__) + if (.not. allocated(DstParamData%IDR__)) then + allocate(DstParamData%IDR__(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDR__.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDR__ = SrcParamData%IDR__ + end if + if (allocated(SrcParamData%ID__Rb)) then + LB(1:1) = lbound(SrcParamData%ID__Rb) + UB(1:1) = ubound(SrcParamData%ID__Rb) + if (.not. allocated(DstParamData%ID__Rb)) then + allocate(DstParamData%ID__Rb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__Rb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ID__Rb = SrcParamData%ID__Rb + end if + if (allocated(SrcParamData%ID__L)) then + LB(1:1) = lbound(SrcParamData%ID__L) + UB(1:1) = ubound(SrcParamData%ID__L) + if (.not. allocated(DstParamData%ID__L)) then + allocate(DstParamData%ID__L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ID__L = SrcParamData%ID__L + end if + if (allocated(SrcParamData%ID__F)) then + LB(1:1) = lbound(SrcParamData%ID__F) + UB(1:1) = ubound(SrcParamData%ID__F) + if (.not. allocated(DstParamData%ID__F)) then + allocate(DstParamData%ID__F(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__F.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ID__F = SrcParamData%ID__F + end if + DstParamData%NMOutputs = SrcParamData%NMOutputs + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%UnJckF = SrcParamData%UnJckF + DstParamData%Delim = SrcParamData%Delim + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + if (allocated(SrcParamData%MoutLst)) then + LB(1:1) = lbound(SrcParamData%MoutLst) + UB(1:1) = ubound(SrcParamData%MoutLst) + if (.not. allocated(DstParamData%MoutLst)) then + allocate(DstParamData%MoutLst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyMeshAuxDataType(SrcParamData%MoutLst(i1), DstParamData%MoutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%MoutLst2)) then + LB(1:1) = lbound(SrcParamData%MoutLst2) + UB(1:1) = ubound(SrcParamData%MoutLst2) + if (.not. allocated(DstParamData%MoutLst2)) then + allocate(DstParamData%MoutLst2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyMeshAuxDataType(SrcParamData%MoutLst2(i1), DstParamData%MoutLst2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%MoutLst3)) then + LB(1:1) = lbound(SrcParamData%MoutLst3) + UB(1:1) = ubound(SrcParamData%MoutLst3) + if (.not. allocated(DstParamData%MoutLst3)) then + allocate(DstParamData%MoutLst3(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyMeshAuxDataType(SrcParamData%MoutLst3(i1), DstParamData%MoutLst3(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + DstParamData%OutAll = SrcParamData%OutAll + DstParamData%OutCBModes = SrcParamData%OutCBModes + DstParamData%OutFEMModes = SrcParamData%OutFEMModes + DstParamData%OutReact = SrcParamData%OutReact + DstParamData%OutAllInt = SrcParamData%OutAllInt + DstParamData%OutAllDims = SrcParamData%OutAllDims + DstParamData%OutDec = SrcParamData%OutDec + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du + end if + DstParamData%dx = SrcParamData%dx + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + DstParamData%RotStates = SrcParamData%RotStates +end subroutine + +subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%Elems)) then + deallocate(ParamData%Elems) + end if + if (allocated(ParamData%ElemProps)) then + LB(1:1) = lbound(ParamData%ElemProps) + UB(1:1) = ubound(ParamData%ElemProps) + do i1 = LB(1), UB(1) + call SD_DestroyElemPropType(ParamData%ElemProps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%ElemProps) + end if + if (allocated(ParamData%FG)) then + deallocate(ParamData%FG) + end if + if (allocated(ParamData%DP0)) then + deallocate(ParamData%DP0) + end if + if (allocated(ParamData%NodeID2JointID)) then + deallocate(ParamData%NodeID2JointID) + end if + if (allocated(ParamData%T_red)) then + deallocate(ParamData%T_red) + end if + if (allocated(ParamData%T_red_T)) then + deallocate(ParamData%T_red_T) + end if + if (allocated(ParamData%NodesDOF)) then + LB(1:1) = lbound(ParamData%NodesDOF) + UB(1:1) = ubound(ParamData%NodesDOF) + do i1 = LB(1), UB(1) + call SD_DestroyIList(ParamData%NodesDOF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%NodesDOF) + end if + if (allocated(ParamData%NodesDOFred)) then + LB(1:1) = lbound(ParamData%NodesDOFred) + UB(1:1) = ubound(ParamData%NodesDOFred) + do i1 = LB(1), UB(1) + call SD_DestroyIList(ParamData%NodesDOFred(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%NodesDOFred) + end if + if (allocated(ParamData%ElemsDOF)) then + deallocate(ParamData%ElemsDOF) + end if + if (allocated(ParamData%DOFred2Nodes)) then + deallocate(ParamData%DOFred2Nodes) + end if + if (allocated(ParamData%CtrlElem2Channel)) then + deallocate(ParamData%CtrlElem2Channel) + end if + if (allocated(ParamData%KMMDiag)) then + deallocate(ParamData%KMMDiag) + end if + if (allocated(ParamData%CMMDiag)) then + deallocate(ParamData%CMMDiag) + end if + if (allocated(ParamData%MMB)) then + deallocate(ParamData%MMB) + end if + if (allocated(ParamData%MBmmB)) then + deallocate(ParamData%MBmmB) + end if + if (allocated(ParamData%C1_11)) then + deallocate(ParamData%C1_11) + end if + if (allocated(ParamData%C1_12)) then + deallocate(ParamData%C1_12) + end if + if (allocated(ParamData%D1_141)) then + deallocate(ParamData%D1_141) + end if + if (allocated(ParamData%D1_142)) then + deallocate(ParamData%D1_142) + end if + if (allocated(ParamData%PhiM)) then + deallocate(ParamData%PhiM) + end if + if (allocated(ParamData%C2_61)) then + deallocate(ParamData%C2_61) + end if + if (allocated(ParamData%C2_62)) then + deallocate(ParamData%C2_62) + end if + if (allocated(ParamData%PhiRb_TI)) then + deallocate(ParamData%PhiRb_TI) + end if + if (allocated(ParamData%D2_63)) then + deallocate(ParamData%D2_63) + end if + if (allocated(ParamData%D2_64)) then + deallocate(ParamData%D2_64) + end if + if (allocated(ParamData%MBB)) then + deallocate(ParamData%MBB) + end if + if (allocated(ParamData%KBB)) then + deallocate(ParamData%KBB) + end if + if (allocated(ParamData%CBB)) then + deallocate(ParamData%CBB) + end if + if (allocated(ParamData%CMM)) then + deallocate(ParamData%CMM) + end if + if (allocated(ParamData%MBM)) then + deallocate(ParamData%MBM) + end if + if (allocated(ParamData%PhiL_T)) then + deallocate(ParamData%PhiL_T) + end if + if (allocated(ParamData%PhiLInvOmgL2)) then + deallocate(ParamData%PhiLInvOmgL2) + end if + if (allocated(ParamData%KLLm1)) then + deallocate(ParamData%KLLm1) + end if + if (allocated(ParamData%AM2Jac)) then + deallocate(ParamData%AM2Jac) + end if + if (allocated(ParamData%AM2JacPiv)) then + deallocate(ParamData%AM2JacPiv) + end if + if (allocated(ParamData%TI)) then + deallocate(ParamData%TI) + end if + if (allocated(ParamData%TIreact)) then + deallocate(ParamData%TIreact) + end if + if (allocated(ParamData%Nodes_I)) then + deallocate(ParamData%Nodes_I) + end if + if (allocated(ParamData%Nodes_L)) then + deallocate(ParamData%Nodes_L) + end if + if (allocated(ParamData%Nodes_C)) then + deallocate(ParamData%Nodes_C) + end if + if (allocated(ParamData%IDI__)) then + deallocate(ParamData%IDI__) + end if + if (allocated(ParamData%IDI_Rb)) then + deallocate(ParamData%IDI_Rb) + end if + if (allocated(ParamData%IDI_F)) then + deallocate(ParamData%IDI_F) + end if + if (allocated(ParamData%IDL_L)) then + deallocate(ParamData%IDL_L) + end if + if (allocated(ParamData%IDC__)) then + deallocate(ParamData%IDC__) + end if + if (allocated(ParamData%IDC_Rb)) then + deallocate(ParamData%IDC_Rb) + end if + if (allocated(ParamData%IDC_L)) then + deallocate(ParamData%IDC_L) + end if + if (allocated(ParamData%IDC_F)) then + deallocate(ParamData%IDC_F) + end if + if (allocated(ParamData%IDR__)) then + deallocate(ParamData%IDR__) + end if + if (allocated(ParamData%ID__Rb)) then + deallocate(ParamData%ID__Rb) + end if + if (allocated(ParamData%ID__L)) then + deallocate(ParamData%ID__L) + end if + if (allocated(ParamData%ID__F)) then + deallocate(ParamData%ID__F) + end if + if (allocated(ParamData%MoutLst)) then + LB(1:1) = lbound(ParamData%MoutLst) + UB(1:1) = ubound(ParamData%MoutLst) + do i1 = LB(1), UB(1) + call SD_DestroyMeshAuxDataType(ParamData%MoutLst(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%MoutLst) + end if + if (allocated(ParamData%MoutLst2)) then + LB(1:1) = lbound(ParamData%MoutLst2) + UB(1:1) = ubound(ParamData%MoutLst2) + do i1 = LB(1), UB(1) + call SD_DestroyMeshAuxDataType(ParamData%MoutLst2(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%MoutLst2) + end if + if (allocated(ParamData%MoutLst3)) then + LB(1:1) = lbound(ParamData%MoutLst3) + UB(1:1) = ubound(ParamData%MoutLst3) + do i1 = LB(1), UB(1) + call SD_DestroyMeshAuxDataType(ParamData%MoutLst3(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%MoutLst3) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if +end subroutine + +subroutine SD_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%SDDeltaT) + call RegPack(Buf, InData%IntMethod) + call RegPack(Buf, InData%nDOF) + call RegPack(Buf, InData%nDOF_red) + call RegPack(Buf, InData%Nmembers) + call RegPack(Buf, allocated(InData%Elems)) + if (allocated(InData%Elems)) then + call RegPackBounds(Buf, 2, lbound(InData%Elems), ubound(InData%Elems)) + call RegPack(Buf, InData%Elems) + end if + call RegPack(Buf, allocated(InData%ElemProps)) + if (allocated(InData%ElemProps)) then + call RegPackBounds(Buf, 1, lbound(InData%ElemProps), ubound(InData%ElemProps)) + LB(1:1) = lbound(InData%ElemProps) + UB(1:1) = ubound(InData%ElemProps) + do i1 = LB(1), UB(1) + call SD_PackElemPropType(Buf, InData%ElemProps(i1)) + end do + end if + call RegPack(Buf, allocated(InData%FG)) + if (allocated(InData%FG)) then + call RegPackBounds(Buf, 1, lbound(InData%FG), ubound(InData%FG)) + call RegPack(Buf, InData%FG) + end if + call RegPack(Buf, allocated(InData%DP0)) + if (allocated(InData%DP0)) then + call RegPackBounds(Buf, 2, lbound(InData%DP0), ubound(InData%DP0)) + call RegPack(Buf, InData%DP0) + end if + call RegPack(Buf, allocated(InData%NodeID2JointID)) + if (allocated(InData%NodeID2JointID)) then + call RegPackBounds(Buf, 1, lbound(InData%NodeID2JointID), ubound(InData%NodeID2JointID)) + call RegPack(Buf, InData%NodeID2JointID) + end if + call RegPack(Buf, InData%reduced) + call RegPack(Buf, allocated(InData%T_red)) + if (allocated(InData%T_red)) then + call RegPackBounds(Buf, 2, lbound(InData%T_red), ubound(InData%T_red)) + call RegPack(Buf, InData%T_red) + end if + call RegPack(Buf, allocated(InData%T_red_T)) + if (allocated(InData%T_red_T)) then + call RegPackBounds(Buf, 2, lbound(InData%T_red_T), ubound(InData%T_red_T)) + call RegPack(Buf, InData%T_red_T) + end if + call RegPack(Buf, allocated(InData%NodesDOF)) + if (allocated(InData%NodesDOF)) then + call RegPackBounds(Buf, 1, lbound(InData%NodesDOF), ubound(InData%NodesDOF)) + LB(1:1) = lbound(InData%NodesDOF) + UB(1:1) = ubound(InData%NodesDOF) + do i1 = LB(1), UB(1) + call SD_PackIList(Buf, InData%NodesDOF(i1)) + end do + end if + call RegPack(Buf, allocated(InData%NodesDOFred)) + if (allocated(InData%NodesDOFred)) then + call RegPackBounds(Buf, 1, lbound(InData%NodesDOFred), ubound(InData%NodesDOFred)) + LB(1:1) = lbound(InData%NodesDOFred) + UB(1:1) = ubound(InData%NodesDOFred) + do i1 = LB(1), UB(1) + call SD_PackIList(Buf, InData%NodesDOFred(i1)) + end do + end if + call RegPack(Buf, allocated(InData%ElemsDOF)) + if (allocated(InData%ElemsDOF)) then + call RegPackBounds(Buf, 2, lbound(InData%ElemsDOF), ubound(InData%ElemsDOF)) + call RegPack(Buf, InData%ElemsDOF) + end if + call RegPack(Buf, allocated(InData%DOFred2Nodes)) + if (allocated(InData%DOFred2Nodes)) then + call RegPackBounds(Buf, 2, lbound(InData%DOFred2Nodes), ubound(InData%DOFred2Nodes)) + call RegPack(Buf, InData%DOFred2Nodes) + end if + call RegPack(Buf, allocated(InData%CtrlElem2Channel)) + if (allocated(InData%CtrlElem2Channel)) then + call RegPackBounds(Buf, 2, lbound(InData%CtrlElem2Channel), ubound(InData%CtrlElem2Channel)) + call RegPack(Buf, InData%CtrlElem2Channel) + end if + call RegPack(Buf, InData%nDOFM) + call RegPack(Buf, InData%SttcSolve) + call RegPack(Buf, InData%GuyanLoadCorrection) + call RegPack(Buf, InData%Floating) + call RegPack(Buf, allocated(InData%KMMDiag)) + if (allocated(InData%KMMDiag)) then + call RegPackBounds(Buf, 1, lbound(InData%KMMDiag), ubound(InData%KMMDiag)) + call RegPack(Buf, InData%KMMDiag) + end if + call RegPack(Buf, allocated(InData%CMMDiag)) + if (allocated(InData%CMMDiag)) then + call RegPackBounds(Buf, 1, lbound(InData%CMMDiag), ubound(InData%CMMDiag)) + call RegPack(Buf, InData%CMMDiag) + end if + call RegPack(Buf, allocated(InData%MMB)) + if (allocated(InData%MMB)) then + call RegPackBounds(Buf, 2, lbound(InData%MMB), ubound(InData%MMB)) + call RegPack(Buf, InData%MMB) + end if + call RegPack(Buf, allocated(InData%MBmmB)) + if (allocated(InData%MBmmB)) then + call RegPackBounds(Buf, 2, lbound(InData%MBmmB), ubound(InData%MBmmB)) + call RegPack(Buf, InData%MBmmB) + end if + call RegPack(Buf, allocated(InData%C1_11)) + if (allocated(InData%C1_11)) then + call RegPackBounds(Buf, 2, lbound(InData%C1_11), ubound(InData%C1_11)) + call RegPack(Buf, InData%C1_11) + end if + call RegPack(Buf, allocated(InData%C1_12)) + if (allocated(InData%C1_12)) then + call RegPackBounds(Buf, 2, lbound(InData%C1_12), ubound(InData%C1_12)) + call RegPack(Buf, InData%C1_12) + end if + call RegPack(Buf, allocated(InData%D1_141)) + if (allocated(InData%D1_141)) then + call RegPackBounds(Buf, 2, lbound(InData%D1_141), ubound(InData%D1_141)) + call RegPack(Buf, InData%D1_141) + end if + call RegPack(Buf, allocated(InData%D1_142)) + if (allocated(InData%D1_142)) then + call RegPackBounds(Buf, 2, lbound(InData%D1_142), ubound(InData%D1_142)) + call RegPack(Buf, InData%D1_142) + end if + call RegPack(Buf, allocated(InData%PhiM)) + if (allocated(InData%PhiM)) then + call RegPackBounds(Buf, 2, lbound(InData%PhiM), ubound(InData%PhiM)) + call RegPack(Buf, InData%PhiM) + end if + call RegPack(Buf, allocated(InData%C2_61)) + if (allocated(InData%C2_61)) then + call RegPackBounds(Buf, 2, lbound(InData%C2_61), ubound(InData%C2_61)) + call RegPack(Buf, InData%C2_61) + end if + call RegPack(Buf, allocated(InData%C2_62)) + if (allocated(InData%C2_62)) then + call RegPackBounds(Buf, 2, lbound(InData%C2_62), ubound(InData%C2_62)) + call RegPack(Buf, InData%C2_62) + end if + call RegPack(Buf, allocated(InData%PhiRb_TI)) + if (allocated(InData%PhiRb_TI)) then + call RegPackBounds(Buf, 2, lbound(InData%PhiRb_TI), ubound(InData%PhiRb_TI)) + call RegPack(Buf, InData%PhiRb_TI) + end if + call RegPack(Buf, allocated(InData%D2_63)) + if (allocated(InData%D2_63)) then + call RegPackBounds(Buf, 2, lbound(InData%D2_63), ubound(InData%D2_63)) + call RegPack(Buf, InData%D2_63) + end if + call RegPack(Buf, allocated(InData%D2_64)) + if (allocated(InData%D2_64)) then + call RegPackBounds(Buf, 2, lbound(InData%D2_64), ubound(InData%D2_64)) + call RegPack(Buf, InData%D2_64) + end if + call RegPack(Buf, allocated(InData%MBB)) + if (allocated(InData%MBB)) then + call RegPackBounds(Buf, 2, lbound(InData%MBB), ubound(InData%MBB)) + call RegPack(Buf, InData%MBB) + end if + call RegPack(Buf, allocated(InData%KBB)) + if (allocated(InData%KBB)) then + call RegPackBounds(Buf, 2, lbound(InData%KBB), ubound(InData%KBB)) + call RegPack(Buf, InData%KBB) + end if + call RegPack(Buf, allocated(InData%CBB)) + if (allocated(InData%CBB)) then + call RegPackBounds(Buf, 2, lbound(InData%CBB), ubound(InData%CBB)) + call RegPack(Buf, InData%CBB) + end if + call RegPack(Buf, allocated(InData%CMM)) + if (allocated(InData%CMM)) then + call RegPackBounds(Buf, 2, lbound(InData%CMM), ubound(InData%CMM)) + call RegPack(Buf, InData%CMM) + end if + call RegPack(Buf, allocated(InData%MBM)) + if (allocated(InData%MBM)) then + call RegPackBounds(Buf, 2, lbound(InData%MBM), ubound(InData%MBM)) + call RegPack(Buf, InData%MBM) + end if + call RegPack(Buf, allocated(InData%PhiL_T)) + if (allocated(InData%PhiL_T)) then + call RegPackBounds(Buf, 2, lbound(InData%PhiL_T), ubound(InData%PhiL_T)) + call RegPack(Buf, InData%PhiL_T) + end if + call RegPack(Buf, allocated(InData%PhiLInvOmgL2)) + if (allocated(InData%PhiLInvOmgL2)) then + call RegPackBounds(Buf, 2, lbound(InData%PhiLInvOmgL2), ubound(InData%PhiLInvOmgL2)) + call RegPack(Buf, InData%PhiLInvOmgL2) + end if + call RegPack(Buf, allocated(InData%KLLm1)) + if (allocated(InData%KLLm1)) then + call RegPackBounds(Buf, 2, lbound(InData%KLLm1), ubound(InData%KLLm1)) + call RegPack(Buf, InData%KLLm1) + end if + call RegPack(Buf, allocated(InData%AM2Jac)) + if (allocated(InData%AM2Jac)) then + call RegPackBounds(Buf, 2, lbound(InData%AM2Jac), ubound(InData%AM2Jac)) + call RegPack(Buf, InData%AM2Jac) + end if + call RegPack(Buf, allocated(InData%AM2JacPiv)) + if (allocated(InData%AM2JacPiv)) then + call RegPackBounds(Buf, 1, lbound(InData%AM2JacPiv), ubound(InData%AM2JacPiv)) + call RegPack(Buf, InData%AM2JacPiv) + end if + call RegPack(Buf, allocated(InData%TI)) + if (allocated(InData%TI)) then + call RegPackBounds(Buf, 2, lbound(InData%TI), ubound(InData%TI)) + call RegPack(Buf, InData%TI) + end if + call RegPack(Buf, allocated(InData%TIreact)) + if (allocated(InData%TIreact)) then + call RegPackBounds(Buf, 2, lbound(InData%TIreact), ubound(InData%TIreact)) + call RegPack(Buf, InData%TIreact) + end if + call RegPack(Buf, InData%nNodes) + call RegPack(Buf, InData%nNodes_I) + call RegPack(Buf, InData%nNodes_L) + call RegPack(Buf, InData%nNodes_C) + call RegPack(Buf, allocated(InData%Nodes_I)) + if (allocated(InData%Nodes_I)) then + call RegPackBounds(Buf, 2, lbound(InData%Nodes_I), ubound(InData%Nodes_I)) + call RegPack(Buf, InData%Nodes_I) + end if + call RegPack(Buf, allocated(InData%Nodes_L)) + if (allocated(InData%Nodes_L)) then + call RegPackBounds(Buf, 2, lbound(InData%Nodes_L), ubound(InData%Nodes_L)) + call RegPack(Buf, InData%Nodes_L) + end if + call RegPack(Buf, allocated(InData%Nodes_C)) + if (allocated(InData%Nodes_C)) then + call RegPackBounds(Buf, 2, lbound(InData%Nodes_C), ubound(InData%Nodes_C)) + call RegPack(Buf, InData%Nodes_C) + end if + call RegPack(Buf, InData%nDOFI__) + call RegPack(Buf, InData%nDOFI_Rb) + call RegPack(Buf, InData%nDOFI_F) + call RegPack(Buf, InData%nDOFL_L) + call RegPack(Buf, InData%nDOFC__) + call RegPack(Buf, InData%nDOFC_Rb) + call RegPack(Buf, InData%nDOFC_L) + call RegPack(Buf, InData%nDOFC_F) + call RegPack(Buf, InData%nDOFR__) + call RegPack(Buf, InData%nDOF__Rb) + call RegPack(Buf, InData%nDOF__L) + call RegPack(Buf, InData%nDOF__F) + call RegPack(Buf, allocated(InData%IDI__)) + if (allocated(InData%IDI__)) then + call RegPackBounds(Buf, 1, lbound(InData%IDI__), ubound(InData%IDI__)) + call RegPack(Buf, InData%IDI__) + end if + call RegPack(Buf, allocated(InData%IDI_Rb)) + if (allocated(InData%IDI_Rb)) then + call RegPackBounds(Buf, 1, lbound(InData%IDI_Rb), ubound(InData%IDI_Rb)) + call RegPack(Buf, InData%IDI_Rb) + end if + call RegPack(Buf, allocated(InData%IDI_F)) + if (allocated(InData%IDI_F)) then + call RegPackBounds(Buf, 1, lbound(InData%IDI_F), ubound(InData%IDI_F)) + call RegPack(Buf, InData%IDI_F) + end if + call RegPack(Buf, allocated(InData%IDL_L)) + if (allocated(InData%IDL_L)) then + call RegPackBounds(Buf, 1, lbound(InData%IDL_L), ubound(InData%IDL_L)) + call RegPack(Buf, InData%IDL_L) + end if + call RegPack(Buf, allocated(InData%IDC__)) + if (allocated(InData%IDC__)) then + call RegPackBounds(Buf, 1, lbound(InData%IDC__), ubound(InData%IDC__)) + call RegPack(Buf, InData%IDC__) + end if + call RegPack(Buf, allocated(InData%IDC_Rb)) + if (allocated(InData%IDC_Rb)) then + call RegPackBounds(Buf, 1, lbound(InData%IDC_Rb), ubound(InData%IDC_Rb)) + call RegPack(Buf, InData%IDC_Rb) + end if + call RegPack(Buf, allocated(InData%IDC_L)) + if (allocated(InData%IDC_L)) then + call RegPackBounds(Buf, 1, lbound(InData%IDC_L), ubound(InData%IDC_L)) + call RegPack(Buf, InData%IDC_L) + end if + call RegPack(Buf, allocated(InData%IDC_F)) + if (allocated(InData%IDC_F)) then + call RegPackBounds(Buf, 1, lbound(InData%IDC_F), ubound(InData%IDC_F)) + call RegPack(Buf, InData%IDC_F) + end if + call RegPack(Buf, allocated(InData%IDR__)) + if (allocated(InData%IDR__)) then + call RegPackBounds(Buf, 1, lbound(InData%IDR__), ubound(InData%IDR__)) + call RegPack(Buf, InData%IDR__) + end if + call RegPack(Buf, allocated(InData%ID__Rb)) + if (allocated(InData%ID__Rb)) then + call RegPackBounds(Buf, 1, lbound(InData%ID__Rb), ubound(InData%ID__Rb)) + call RegPack(Buf, InData%ID__Rb) + end if + call RegPack(Buf, allocated(InData%ID__L)) + if (allocated(InData%ID__L)) then + call RegPackBounds(Buf, 1, lbound(InData%ID__L), ubound(InData%ID__L)) + call RegPack(Buf, InData%ID__L) + end if + call RegPack(Buf, allocated(InData%ID__F)) + if (allocated(InData%ID__F)) then + call RegPackBounds(Buf, 1, lbound(InData%ID__F), ubound(InData%ID__F)) + call RegPack(Buf, InData%ID__F) + end if + call RegPack(Buf, InData%NMOutputs) + call RegPack(Buf, InData%NumOuts) + call RegPack(Buf, InData%OutSwtch) + call RegPack(Buf, InData%UnJckF) + call RegPack(Buf, InData%Delim) + call RegPack(Buf, InData%OutFmt) + call RegPack(Buf, InData%OutSFmt) + call RegPack(Buf, allocated(InData%MoutLst)) + if (allocated(InData%MoutLst)) then + call RegPackBounds(Buf, 1, lbound(InData%MoutLst), ubound(InData%MoutLst)) + LB(1:1) = lbound(InData%MoutLst) + UB(1:1) = ubound(InData%MoutLst) + do i1 = LB(1), UB(1) + call SD_PackMeshAuxDataType(Buf, InData%MoutLst(i1)) + end do + end if + call RegPack(Buf, allocated(InData%MoutLst2)) + if (allocated(InData%MoutLst2)) then + call RegPackBounds(Buf, 1, lbound(InData%MoutLst2), ubound(InData%MoutLst2)) + LB(1:1) = lbound(InData%MoutLst2) + UB(1:1) = ubound(InData%MoutLst2) + do i1 = LB(1), UB(1) + call SD_PackMeshAuxDataType(Buf, InData%MoutLst2(i1)) + end do + end if + call RegPack(Buf, allocated(InData%MoutLst3)) + if (allocated(InData%MoutLst3)) then + call RegPackBounds(Buf, 1, lbound(InData%MoutLst3), ubound(InData%MoutLst3)) + LB(1:1) = lbound(InData%MoutLst3) + UB(1:1) = ubound(InData%MoutLst3) + do i1 = LB(1), UB(1) + call SD_PackMeshAuxDataType(Buf, InData%MoutLst3(i1)) + end do + end if + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + call RegPack(Buf, InData%OutAll) + call RegPack(Buf, InData%OutCBModes) + call RegPack(Buf, InData%OutFEMModes) + call RegPack(Buf, InData%OutReact) + call RegPack(Buf, InData%OutAllInt) + call RegPack(Buf, InData%OutAllDims) + call RegPack(Buf, InData%OutDec) + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + call RegPack(Buf, allocated(InData%du)) + if (allocated(InData%du)) then + call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPack(Buf, InData%du) + end if + call RegPack(Buf, InData%dx) + call RegPack(Buf, InData%Jac_ny) + call RegPack(Buf, InData%Jac_nx) + call RegPack(Buf, InData%RotStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%SDDeltaT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%IntMethod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nDOF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nDOF_red) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Nmembers) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Elems)) deallocate(OutData%Elems) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Elems(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elems.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Elems) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ElemProps)) deallocate(OutData%ElemProps) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElemProps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackElemPropType(Buf, OutData%ElemProps(i1)) ! ElemProps + end do + end if + if (allocated(OutData%FG)) deallocate(OutData%FG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FG(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FG) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DP0)) deallocate(OutData%DP0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DP0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DP0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DP0) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%NodeID2JointID)) deallocate(OutData%NodeID2JointID) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodeID2JointID(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeID2JointID.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodeID2JointID) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%reduced) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%T_red)) deallocate(OutData%T_red) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%T_red(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%T_red) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%T_red_T)) deallocate(OutData%T_red_T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%T_red_T(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%T_red_T) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%NodesDOF)) deallocate(OutData%NodesDOF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodesDOF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackIList(Buf, OutData%NodesDOF(i1)) ! NodesDOF + end do + end if + if (allocated(OutData%NodesDOFred)) deallocate(OutData%NodesDOFred) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodesDOFred(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOFred.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackIList(Buf, OutData%NodesDOFred(i1)) ! NodesDOFred + end do + end if + if (allocated(OutData%ElemsDOF)) deallocate(OutData%ElemsDOF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElemsDOF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemsDOF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElemsDOF) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DOFred2Nodes)) deallocate(OutData%DOFred2Nodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DOFred2Nodes(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOFred2Nodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DOFred2Nodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CtrlElem2Channel)) deallocate(OutData%CtrlElem2Channel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CtrlElem2Channel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CtrlElem2Channel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CtrlElem2Channel) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%nDOFM) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SttcSolve) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%GuyanLoadCorrection) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Floating) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%KMMDiag)) deallocate(OutData%KMMDiag) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%KMMDiag(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KMMDiag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%KMMDiag) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CMMDiag)) deallocate(OutData%CMMDiag) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CMMDiag(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMMDiag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CMMDiag) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MMB)) deallocate(OutData%MMB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MMB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MMB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MBmmB)) deallocate(OutData%MBmmB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MBmmB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBmmB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MBmmB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%C1_11)) deallocate(OutData%C1_11) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C1_11(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_11.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C1_11) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%C1_12)) deallocate(OutData%C1_12) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C1_12(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_12.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C1_12) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%D1_141)) deallocate(OutData%D1_141) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D1_141(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_141.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D1_141) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%D1_142)) deallocate(OutData%D1_142) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D1_142(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_142.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D1_142) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PhiM)) deallocate(OutData%PhiM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PhiM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PhiM) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%C2_61)) deallocate(OutData%C2_61) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C2_61(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_61.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C2_61) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%C2_62)) deallocate(OutData%C2_62) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C2_62(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_62.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C2_62) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PhiRb_TI)) deallocate(OutData%PhiRb_TI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PhiRb_TI(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiRb_TI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PhiRb_TI) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%D2_63)) deallocate(OutData%D2_63) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D2_63(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_63.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D2_63) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%D2_64)) deallocate(OutData%D2_64) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D2_64(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_64.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D2_64) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MBB)) deallocate(OutData%MBB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MBB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MBB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%KBB)) deallocate(OutData%KBB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%KBB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%KBB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CBB)) deallocate(OutData%CBB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CBB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CBB) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%CMM)) deallocate(OutData%CMM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CMM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CMM) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%MBM)) deallocate(OutData%MBM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MBM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MBM) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PhiL_T)) deallocate(OutData%PhiL_T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PhiL_T(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PhiL_T) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%PhiLInvOmgL2)) deallocate(OutData%PhiLInvOmgL2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PhiLInvOmgL2(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiLInvOmgL2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PhiLInvOmgL2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%KLLm1)) deallocate(OutData%KLLm1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%KLLm1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KLLm1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%KLLm1) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AM2Jac)) deallocate(OutData%AM2Jac) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AM2Jac(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2Jac.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AM2Jac) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%AM2JacPiv)) deallocate(OutData%AM2JacPiv) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AM2JacPiv(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2JacPiv.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AM2JacPiv) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TI)) deallocate(OutData%TI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TI(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TI) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TIreact)) deallocate(OutData%TIreact) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TIreact(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIreact.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TIreact) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%nNodes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nNodes_I) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nNodes_L) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nNodes_C) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Nodes_I)) deallocate(OutData%Nodes_I) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nodes_I(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_I.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Nodes_I) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Nodes_L)) deallocate(OutData%Nodes_L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nodes_L(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Nodes_L) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Nodes_C)) deallocate(OutData%Nodes_C) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nodes_C(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Nodes_C) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%nDOFI__) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nDOFI_Rb) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nDOFI_F) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nDOFL_L) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nDOFC__) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nDOFC_Rb) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nDOFC_L) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nDOFC_F) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nDOFR__) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nDOF__Rb) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nDOF__L) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%nDOF__F) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%IDI__)) deallocate(OutData%IDI__) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDI__(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI__.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDI__) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IDI_Rb)) deallocate(OutData%IDI_Rb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDI_Rb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_Rb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDI_Rb) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IDI_F)) deallocate(OutData%IDI_F) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDI_F(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_F.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDI_F) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IDL_L)) deallocate(OutData%IDL_L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDL_L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDL_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDL_L) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IDC__)) deallocate(OutData%IDC__) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDC__(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC__.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDC__) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IDC_Rb)) deallocate(OutData%IDC_Rb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDC_Rb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_Rb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDC_Rb) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IDC_L)) deallocate(OutData%IDC_L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDC_L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDC_L) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IDC_F)) deallocate(OutData%IDC_F) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDC_F(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_F.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDC_F) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IDR__)) deallocate(OutData%IDR__) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDR__(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDR__.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDR__) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ID__Rb)) deallocate(OutData%ID__Rb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ID__Rb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__Rb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ID__Rb) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ID__L)) deallocate(OutData%ID__L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ID__L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ID__L) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%ID__F)) deallocate(OutData%ID__F) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ID__F(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__F.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ID__F) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%NMOutputs) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnJckF) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%MoutLst)) deallocate(OutData%MoutLst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MoutLst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackMeshAuxDataType(Buf, OutData%MoutLst(i1)) ! MoutLst + end do + end if + if (allocated(OutData%MoutLst2)) deallocate(OutData%MoutLst2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MoutLst2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackMeshAuxDataType(Buf, OutData%MoutLst2(i1)) ! MoutLst2 + end do + end if + if (allocated(OutData%MoutLst3)) deallocate(OutData%MoutLst3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MoutLst3(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackMeshAuxDataType(Buf, OutData%MoutLst3(i1)) ! MoutLst3 + end do + end if + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(Buf, OutData%OutAll) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutCBModes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFEMModes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutReact) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutAllInt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutAllDims) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutDec) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%du)) deallocate(OutData%du) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%du(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Jac_nx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RotStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SD_InputType), intent(inout) :: SrcInputData + type(SD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%TPMesh, DstInputData%TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%LMesh, DstInputData%LMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%CableDeltaL)) then + LB(1:1) = lbound(SrcInputData%CableDeltaL) + UB(1:1) = ubound(SrcInputData%CableDeltaL) + if (.not. allocated(DstInputData%CableDeltaL)) then + allocate(DstInputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CableDeltaL = SrcInputData%CableDeltaL + end if +end subroutine + +subroutine SD_DestroyInput(InputData, ErrStat, ErrMsg) + type(SD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%TPMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%LMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputData%CableDeltaL)) then + deallocate(InputData%CableDeltaL) + end if +end subroutine + +subroutine SD_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%TPMesh) + call MeshPack(Buf, InData%LMesh) + call RegPack(Buf, allocated(InData%CableDeltaL)) + if (allocated(InData%CableDeltaL)) then + call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL), ubound(InData%CableDeltaL)) + call RegPack(Buf, InData%CableDeltaL) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%TPMesh) ! TPMesh + call MeshUnpack(Buf, OutData%LMesh) ! LMesh + if (allocated(OutData%CableDeltaL)) deallocate(OutData%CableDeltaL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableDeltaL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableDeltaL) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SD_OutputType), intent(inout) :: SrcOutputData + type(SD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%Y1Mesh, DstOutputData%Y1Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%Y2Mesh, DstOutputData%Y2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%Y3Mesh, DstOutputData%Y3Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%Y1Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%Y2Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%Y3Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine SD_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call MeshPack(Buf, InData%Y1Mesh) + call MeshPack(Buf, InData%Y2Mesh) + call MeshPack(Buf, InData%Y3Mesh) + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call MeshUnpack(Buf, OutData%Y1Mesh) ! Y1Mesh + call MeshUnpack(Buf, OutData%Y2Mesh) ! Y2Mesh + call MeshUnpack(Buf, OutData%Y3Mesh) ! Y3Mesh + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine SD_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(SD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(SD_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 = 'SD_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 SD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SD_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 SD_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 SD_Input_ExtrapInterp - - - SUBROUTINE SD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SD_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. @@ -12691,51 +6355,49 @@ SUBROUTINE SD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(SD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(SD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SD_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 + TYPE(SD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(SD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SD_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 = 'SD_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 - 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(u1%TPMesh, u2%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%LMesh, u2%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%CableDeltaL) .AND. ALLOCATED(u1%CableDeltaL)) THEN - DO i1 = LBOUND(u_out%CableDeltaL,1),UBOUND(u_out%CableDeltaL,1) - b = -(u1%CableDeltaL(i1) - u2%CableDeltaL(i1)) - u_out%CableDeltaL(i1) = u1%CableDeltaL(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SD_Input_ExtrapInterp1 - - - SUBROUTINE SD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%TPMesh, u2%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%LMesh, u2%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%CableDeltaL) .AND. ALLOCATED(u1%CableDeltaL)) THEN + u_out%CableDeltaL = a1*u1%CableDeltaL + a2*u2%CableDeltaL + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SD_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. @@ -12749,112 +6411,109 @@ SUBROUTINE SD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(SD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(SD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(SD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SD_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 + TYPE(SD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(SD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(SD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SD_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 = 'SD_Input_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(u1%TPMesh, u2%TPMesh, u3%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%LMesh, u2%LMesh, u3%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%CableDeltaL) .AND. ALLOCATED(u1%CableDeltaL)) THEN - DO i1 = LBOUND(u_out%CableDeltaL,1),UBOUND(u_out%CableDeltaL,1) - b = (t(3)**2*(u1%CableDeltaL(i1) - u2%CableDeltaL(i1)) + t(2)**2*(-u1%CableDeltaL(i1) + u3%CableDeltaL(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%CableDeltaL(i1) + t(3)*u2%CableDeltaL(i1) - t(2)*u3%CableDeltaL(i1) ) * scaleFactor - u_out%CableDeltaL(i1) = u1%CableDeltaL(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SD_Input_ExtrapInterp2 - - - SUBROUTINE SD_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(SD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SD_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%TPMesh, u2%TPMesh, u3%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%LMesh, u2%LMesh, u3%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%CableDeltaL) .AND. ALLOCATED(u1%CableDeltaL)) THEN + u_out%CableDeltaL = a1*u1%CableDeltaL + a2*u2%CableDeltaL + a3*u3%CableDeltaL + END IF ! check if allocated +END SUBROUTINE + +subroutine SD_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(SD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(SD_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 = 'SD_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 SD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SD_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 SD_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 SD_Output_ExtrapInterp - - - SUBROUTINE SD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SD_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. @@ -12866,53 +6525,51 @@ SUBROUTINE SD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(SD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(SD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SD_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 + TYPE(SD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(SD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SD_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 = 'SD_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(y1%Y1Mesh, y2%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%Y2Mesh, y2%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%Y3Mesh, y2%Y3Mesh, tin, y_out%Y3Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 SD_Output_ExtrapInterp1 - - - SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%Y1Mesh, y2%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%Y2Mesh, y2%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%Y3Mesh, y2%Y3Mesh, tin, y_out%Y3Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SD_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. @@ -12926,60 +6583,56 @@ SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(SD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(SD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(SD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SD_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 + TYPE(SD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(SD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(SD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SD_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 = 'SD_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SD_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 + 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 + 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 + 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))) - CALL MeshExtrapInterp2(y1%Y1Mesh, y2%Y1Mesh, y3%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%Y2Mesh, y2%Y2Mesh, y3%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%Y3Mesh, y2%Y3Mesh, y3%Y3Mesh, tin, y_out%Y3Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -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 SD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%Y1Mesh, y2%Y1Mesh, y3%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%Y2Mesh, y2%Y2Mesh, y3%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%Y3Mesh, y2%Y3Mesh, y3%Y3Mesh, tin, y_out%Y3Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE SubDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 399be0303f..19cb174848 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -42,9 +42,9 @@ MODULE SCDataEx_Types END TYPE SC_DX_InitInputType_C TYPE, PUBLIC :: SC_DX_InitInputType TYPE( SC_DX_InitInputType_C ) :: C_obj - INTEGER(IntKi) :: NumSC2Ctrl !< number of turbine specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumCtrl2SC !< number of controller outputs [to supercontroller] [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< number of turbine specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< number of controller outputs [to supercontroller] [-] END TYPE SC_DX_InitInputType ! ======================= ! ========= SC_DX_InitOutputType_C ======= @@ -92,1184 +92,657 @@ MODULE SCDataEx_Types END TYPE SC_DX_OutputType ! ======================= CONTAINS - SUBROUTINE SC_DX_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DX_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SC_DX_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + +subroutine SC_DX_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SC_DX_InitInputType), intent(in) :: SrcInitInputData + type(SC_DX_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DX_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl + DstInitInputData%C_obj%NumSC2Ctrl = SrcInitInputData%C_obj%NumSC2Ctrl + DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob + DstInitInputData%C_obj%NumSC2CtrlGlob = SrcInitInputData%C_obj%NumSC2CtrlGlob + DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC + DstInitInputData%C_obj%NumCtrl2SC = SrcInitInputData%C_obj%NumCtrl2SC +end subroutine + +subroutine SC_DX_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SC_DX_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DX_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SC_DX_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_DX_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, InData%NumSC2Ctrl) + call RegPack(Buf, InData%NumSC2CtrlGlob) + call RegPack(Buf, InData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_DX_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_DX_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl + call RegUnpack(Buf, OutData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob + call RegUnpack(Buf, OutData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC +end subroutine + +SUBROUTINE SC_DX_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyInitInput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl - DstInitInputData%C_obj%NumSC2Ctrl = SrcInitInputData%C_obj%NumSC2Ctrl - DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob - DstInitInputData%C_obj%NumSC2CtrlGlob = SrcInitInputData%C_obj%NumSC2CtrlGlob - DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC - DstInitInputData%C_obj%NumCtrl2SC = SrcInitInputData%C_obj%NumCtrl2SC - END SUBROUTINE SC_DX_CopyInitInput - - SUBROUTINE SC_DX_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SC_DX_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 = 'SC_DX_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SC_DX_DestroyInitInput - - SUBROUTINE SC_DX_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(SC_DX_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 = 'SC_DX_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 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SC_DX_PackInitInput - - SUBROUTINE SC_DX_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(SC_DX_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_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%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - END SUBROUTINE SC_DX_UnPackInitInput - - SUBROUTINE SC_DX_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%NumSC2Ctrl = InitInputData%C_obj%NumSC2Ctrl - InitInputData%NumSC2CtrlGlob = InitInputData%C_obj%NumSC2CtrlGlob - InitInputData%NumCtrl2SC = InitInputData%C_obj%NumCtrl2SC - END SUBROUTINE SC_DX_C2Fary_CopyInitInput - - SUBROUTINE SC_DX_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%C_obj%NumSC2Ctrl = InitInputData%NumSC2Ctrl - InitInputData%C_obj%NumSC2CtrlGlob = InitInputData%NumSC2CtrlGlob - InitInputData%C_obj%NumCtrl2SC = InitInputData%NumCtrl2SC - END SUBROUTINE SC_DX_F2C_CopyInitInput - - SUBROUTINE SC_DX_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DX_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%NumSC2Ctrl = InitInputData%C_obj%NumSC2Ctrl + InitInputData%NumSC2CtrlGlob = InitInputData%C_obj%NumSC2CtrlGlob + InitInputData%NumCtrl2SC = InitInputData%C_obj%NumCtrl2SC +END SUBROUTINE + +SUBROUTINE SC_DX_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%C_obj%NumSC2Ctrl = InitInputData%NumSC2Ctrl + InitInputData%C_obj%NumSC2CtrlGlob = InitInputData%NumSC2CtrlGlob + InitInputData%C_obj%NumCtrl2SC = InitInputData%NumCtrl2SC +END SUBROUTINE + +subroutine SC_DX_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SC_DX_InitOutputType), intent(in) :: SrcInitOutputData + type(SC_DX_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SC_DX_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine SC_DX_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SC_DX_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SC_DX_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SC_DX_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_DX_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_DX_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_DX_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine + +SUBROUTINE SC_DX_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyInitOutput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE SC_DX_CopyInitOutput - - SUBROUTINE SC_DX_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SC_DX_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 = 'SC_DX_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SC_DX_DestroyInitOutput - - SUBROUTINE SC_DX_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(SC_DX_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 = 'SC_DX_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - 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 - - 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 SC_DX_PackInitOutput - - SUBROUTINE SC_DX_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(SC_DX_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_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 - 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) - END SUBROUTINE SC_DX_UnPackInitOutput - - SUBROUTINE SC_DX_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE SC_DX_C2Fary_CopyInitOutput - - SUBROUTINE SC_DX_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE SC_DX_F2C_CopyInitOutput - - SUBROUTINE SC_DX_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DX_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SC_DX_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE + +SUBROUTINE SC_DX_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyParam' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE + +subroutine SC_DX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SC_DX_ParameterType), intent(in) :: SrcParamData + type(SC_DX_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DX_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%useSC = SrcParamData%useSC + DstParamData%C_obj%useSC = SrcParamData%C_obj%useSC +end subroutine + +subroutine SC_DX_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SC_DX_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DX_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SC_DX_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_DX_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, InData%useSC) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_DX_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_DX_UnPackParam' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%useSC) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%useSC = OutData%useSC +end subroutine + +SUBROUTINE SC_DX_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - DstParamData%useSC = SrcParamData%useSC - DstParamData%C_obj%useSC = SrcParamData%C_obj%useSC - END SUBROUTINE SC_DX_CopyParam - - SUBROUTINE SC_DX_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SC_DX_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 = 'SC_DX_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SC_DX_DestroyParam - - SUBROUTINE SC_DX_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(SC_DX_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 = 'SC_DX_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 - Int_BufSz = Int_BufSz + 1 ! useSC - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%useSC, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SC_DX_PackParam - - SUBROUTINE SC_DX_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(SC_DX_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 = 'SC_DX_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%useSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%useSC) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%useSC = OutData%useSC - END SUBROUTINE SC_DX_UnPackParam - - SUBROUTINE SC_DX_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%useSC = ParamData%C_obj%useSC - END SUBROUTINE SC_DX_C2Fary_CopyParam - - SUBROUTINE SC_DX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%C_obj%useSC = ParamData%useSC - END SUBROUTINE SC_DX_F2C_CopyParam - - SUBROUTINE SC_DX_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DX_InputType), INTENT(IN) :: SrcInputData - TYPE(SC_DX_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%useSC = ParamData%C_obj%useSC +END SUBROUTINE + +SUBROUTINE SC_DX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%C_obj%useSC = ParamData%useSC +END SUBROUTINE + +subroutine SC_DX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SC_DX_InputType), intent(in) :: SrcInputData + type(SC_DX_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SC_DX_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcInputData%toSC)) then + LB(1:1) = lbound(SrcInputData%toSC) + UB(1:1) = ubound(SrcInputData%toSC) + if (.not. associated(DstInputData%toSC)) then + allocate(DstInputData%toSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%toSC = SrcInputData%toSC + end if +end subroutine + +subroutine SC_DX_DestroyInput(InputData, ErrStat, ErrMsg) + type(SC_DX_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DX_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(InputData%toSC)) then + deallocate(InputData%toSC) + InputData%toSC => null() + InputData%C_obj%toSC = c_null_ptr + InputData%C_obj%toSC_Len = 0 + end if +end subroutine + +subroutine SC_DX_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_DX_PackInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, associated(InData%toSC)) + if (associated(InData%toSC)) then + call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) + call RegPackPointer(Buf, c_loc(InData%toSC), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%toSC) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_DX_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_DX_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%toSC)) deallocate(OutData%toSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%toSC, UB(1:1)-LB(1:1)) + OutData%toSC(LB(1):) => OutData%toSC + else + allocate(OutData%toSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%toSC) + OutData%C_obj%toSC_Len = size(OutData%toSC) + if (OutData%C_obj%toSC_Len > 0) OutData%C_obj%toSC = c_loc(OutData%toSC(LB(1))) + call RegUnpack(Buf, OutData%toSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%toSC => null() + end if +end subroutine + +SUBROUTINE SC_DX_C2Fary_CopyInput(InputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData 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 = 'SC_DX_CopyInput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" -IF (ASSOCIATED(SrcInputData%toSC)) THEN - i1_l = LBOUND(SrcInputData%toSC,1) - i1_u = UBOUND(SrcInputData%toSC,1) - IF (.NOT. ASSOCIATED(DstInputData%toSC)) THEN - ALLOCATE(DstInputData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%toSC = SrcInputData%toSC -ENDIF - END SUBROUTINE SC_DX_CopyInput - - SUBROUTINE SC_DX_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SC_DX_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 = 'SC_DX_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(InputData%toSC)) THEN - DEALLOCATE(InputData%toSC) - InputData%toSC => NULL() - InputData%C_obj%toSC = C_NULL_PTR - InputData%C_obj%toSC_Len = 0 -ENDIF - END SUBROUTINE SC_DX_DestroyInput - - SUBROUTINE SC_DX_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(SC_DX_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 = 'SC_DX_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 - Int_BufSz = Int_BufSz + 1 ! toSC allocated yes/no - IF ( ASSOCIATED(InData%toSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSC) ! toSC - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%toSC) ) 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%toSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) - ReKiBuf(Re_Xferred) = InData%toSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_DX_PackInput - - SUBROUTINE SC_DX_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(SC_DX_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toSC 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%toSC)) DEALLOCATE(OutData%toSC) - ALLOCATE(OutData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) - OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_DX_UnPackInput - - SUBROUTINE SC_DX_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- toSC Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN - NULLIFY( InputData%toSC ) - ELSE - CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, (/InputData%C_obj%toSC_Len/)) - END IF - END IF - END SUBROUTINE SC_DX_C2Fary_CopyInput - - SUBROUTINE SC_DX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - 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 - 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) ) ) - END IF - END IF - END SUBROUTINE SC_DX_F2C_CopyInput + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- toSC Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN + NULLIFY( InputData%toSC ) + ELSE + CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, [InputData%C_obj%toSC_Len]) + END IF + END IF +END SUBROUTINE - SUBROUTINE SC_DX_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DX_OutputType), INTENT(IN) :: SrcOutputData - TYPE(SC_DX_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode +SUBROUTINE SC_DX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData 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 = 'SC_DX_CopyOutput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + 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 + 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))) + END IF + END IF +END SUBROUTINE + +subroutine SC_DX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SC_DX_OutputType), intent(in) :: SrcOutputData + type(SC_DX_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SC_DX_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcOutputData%fromSC)) then + LB(1:1) = lbound(SrcOutputData%fromSC) + UB(1:1) = ubound(SrcOutputData%fromSC) + if (.not. associated(DstOutputData%fromSC)) then + allocate(DstOutputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOutputData%fromSC = SrcOutputData%fromSC + end if + if (associated(SrcOutputData%fromSCglob)) then + LB(1:1) = lbound(SrcOutputData%fromSCglob) + UB(1:1) = ubound(SrcOutputData%fromSCglob) + if (.not. associated(DstOutputData%fromSCglob)) then + allocate(DstOutputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOutputData%fromSCglob = SrcOutputData%fromSCglob + end if +end subroutine + +subroutine SC_DX_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SC_DX_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DX_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(OutputData%fromSC)) then + deallocate(OutputData%fromSC) + OutputData%fromSC => null() + OutputData%C_obj%fromSC = c_null_ptr + OutputData%C_obj%fromSC_Len = 0 + end if + if (associated(OutputData%fromSCglob)) then + deallocate(OutputData%fromSCglob) + OutputData%fromSCglob => null() + OutputData%C_obj%fromSCglob = c_null_ptr + OutputData%C_obj%fromSCglob_Len = 0 + end if +end subroutine + +subroutine SC_DX_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_DX_PackOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, associated(InData%fromSC)) + if (associated(InData%fromSC)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPackPointer(Buf, c_loc(InData%fromSC), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%fromSC) + end if + end if + call RegPack(Buf, associated(InData%fromSCglob)) + if (associated(InData%fromSCglob)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) + call RegPackPointer(Buf, c_loc(InData%fromSCglob), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%fromSCglob) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_DX_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_DX_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%fromSC)) deallocate(OutData%fromSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%fromSC, UB(1:1)-LB(1:1)) + OutData%fromSC(LB(1):) => OutData%fromSC + else + allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%fromSC) + OutData%C_obj%fromSC_Len = size(OutData%fromSC) + if (OutData%C_obj%fromSC_Len > 0) OutData%C_obj%fromSC = c_loc(OutData%fromSC(LB(1))) + call RegUnpack(Buf, OutData%fromSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%fromSC => null() + end if + if (associated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%fromSCglob, UB(1:1)-LB(1:1)) + OutData%fromSCglob(LB(1):) => OutData%fromSCglob + else + allocate(OutData%fromSCglob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%fromSCglob) + OutData%C_obj%fromSCglob_Len = size(OutData%fromSCglob) + if (OutData%C_obj%fromSCglob_Len > 0) OutData%C_obj%fromSCglob = c_loc(OutData%fromSCglob(LB(1))) + call RegUnpack(Buf, OutData%fromSCglob) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%fromSCglob => null() + end if +end subroutine + +SUBROUTINE SC_DX_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" -IF (ASSOCIATED(SrcOutputData%fromSC)) THEN - i1_l = LBOUND(SrcOutputData%fromSC,1) - i1_u = UBOUND(SrcOutputData%fromSC,1) - IF (.NOT. ASSOCIATED(DstOutputData%fromSC)) THEN - ALLOCATE(DstOutputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOutputData%fromSC = SrcOutputData%fromSC -ENDIF -IF (ASSOCIATED(SrcOutputData%fromSCglob)) THEN - i1_l = LBOUND(SrcOutputData%fromSCglob,1) - i1_u = UBOUND(SrcOutputData%fromSCglob,1) - IF (.NOT. ASSOCIATED(DstOutputData%fromSCglob)) THEN - ALLOCATE(DstOutputData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOutputData%fromSCglob = SrcOutputData%fromSCglob -ENDIF - END SUBROUTINE SC_DX_CopyOutput - - SUBROUTINE SC_DX_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SC_DX_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 = 'SC_DX_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(OutputData%fromSC)) THEN - 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 - DEALLOCATE(OutputData%fromSCglob) - OutputData%fromSCglob => NULL() - OutputData%C_obj%fromSCglob = C_NULL_PTR - OutputData%C_obj%fromSCglob_Len = 0 -ENDIF - END SUBROUTINE SC_DX_DestroyOutput - - SUBROUTINE SC_DX_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(SC_DX_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 = 'SC_DX_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 ! fromSC allocated yes/no - IF ( ASSOCIATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - END IF - Int_BufSz = Int_BufSz + 1 ! fromSCglob allocated yes/no - IF ( ASSOCIATED(InData%fromSCglob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCglob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCglob) ! fromSCglob - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%fromSC) ) 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%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%fromSCglob) ) 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%fromSCglob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCglob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCglob,1), UBOUND(InData%fromSCglob,1) - ReKiBuf(Re_Xferred) = InData%fromSCglob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_DX_PackOutput - - SUBROUTINE SC_DX_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(SC_DX_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 = 'SC_DX_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 ! fromSC 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%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCglob 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%fromSCglob)) DEALLOCATE(OutData%fromSCglob) - ALLOCATE(OutData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%fromSCglob,1), UBOUND(OutData%fromSCglob,1) - OutData%fromSCglob(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_DX_UnPackOutput - - SUBROUTINE SC_DX_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- fromSC Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN - NULLIFY( OutputData%fromSC ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, (/OutputData%C_obj%fromSC_Len/)) - END IF - END IF - - ! -- fromSCglob Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSCglob ) ) THEN - NULLIFY( OutputData%fromSCglob ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%fromSCglob, OutputData%fromSCglob, (/OutputData%C_obj%fromSCglob_Len/)) - END IF - END IF - END SUBROUTINE SC_DX_C2Fary_CopyOutput - - SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - 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 - 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) ) ) - 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 - 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) ) ) - END IF - END IF - END SUBROUTINE SC_DX_F2C_CopyOutput + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- fromSC Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN + NULLIFY( OutputData%fromSC ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, [OutputData%C_obj%fromSC_Len]) + END IF + END IF + + ! -- fromSCglob Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSCglob ) ) THEN + NULLIFY( OutputData%fromSCglob ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%fromSCglob, OutputData%fromSCglob, [OutputData%C_obj%fromSCglob_Len]) + END IF + END IF +END SUBROUTINE +SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + 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 + 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))) + 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 + 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))) + END IF + END IF +END SUBROUTINE END MODULE SCDataEx_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 531045da1b..a78ceeb316 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -41,7 +41,7 @@ MODULE SuperController_Types END TYPE SC_InitInputType_C TYPE, PUBLIC :: SC_InitInputType TYPE( SC_InitInputType_C ) :: C_obj - INTEGER(IntKi) :: nTurbines !< Number of turbines in the simulation [-] + INTEGER(IntKi) :: nTurbines = 0_IntKi !< Number of turbines in the simulation [-] CHARACTER(1024) :: DLL_FileName !< Name of the shared library which the super controller logic [-] END TYPE SC_InitInputType ! ======================= @@ -56,10 +56,10 @@ MODULE SuperController_Types TYPE, PUBLIC :: SC_InitOutputType TYPE( SC_InitOutputType_C ) :: C_obj TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - INTEGER(IntKi) :: NumCtrl2SC !< Number of turbine controller outputs [to supercontroller] [-] - INTEGER(IntKi) :: nInpGlobal !< Number of global inputs to SC [-] - INTEGER(IntKi) :: NumSC2Ctrl !< Number of turbine specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2CtrlGlob !< Number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< Number of turbine controller outputs [to supercontroller] [-] + INTEGER(IntKi) :: nInpGlobal = 0_IntKi !< Number of global inputs to SC [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< Number of turbine specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< Number of global controller inputs [from supercontroller] [-] END TYPE SC_InitOutputType ! ======================= ! ========= SC_ParameterType_C ======= @@ -82,16 +82,16 @@ MODULE SuperController_Types END TYPE SC_ParameterType_C TYPE, PUBLIC :: SC_ParameterType TYPE( SC_ParameterType_C ) :: C_obj - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [secondstypedef] - INTEGER(IntKi) :: nTurbines !< Number of turbines in the simulation [-] - INTEGER(IntKi) :: NumCtrl2SC !< Number of turbine controller outputs [to supercontroller] [-] - INTEGER(IntKi) :: nInpGlobal !< Number of global inputs [-] - INTEGER(IntKi) :: NumSC2Ctrl !< Number of turbine specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2CtrlGlob !< Number of global controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumStatesGlobal !< Number of global states [-] - INTEGER(IntKi) :: NumStatesTurbine !< Number of states per turbine [-] - INTEGER(IntKi) :: NumParamGlobal !< Number of global parameters [-] - INTEGER(IntKi) :: NumParamTurbine !< Number of parameters per turbine [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [secondstypedef] + INTEGER(IntKi) :: nTurbines = 0_IntKi !< Number of turbines in the simulation [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< Number of turbine controller outputs [to supercontroller] [-] + INTEGER(IntKi) :: nInpGlobal = 0_IntKi !< Number of global inputs [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< Number of turbine specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< Number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumStatesGlobal = 0_IntKi !< Number of global states [-] + INTEGER(IntKi) :: NumStatesTurbine = 0_IntKi !< Number of states per turbine [-] + INTEGER(IntKi) :: NumParamGlobal = 0_IntKi !< Number of global parameters [-] + INTEGER(IntKi) :: NumParamTurbine = 0_IntKi !< Number of parameters per turbine [-] REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: ParamGlobal => NULL() !< Global parameters [-] REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: ParamTurbine => NULL() !< Parameters per turbine [-] TYPE(DLL_Type) :: DLL_Trgt !< The addresses and names of the super controller shared library and its procedures [-] @@ -118,7 +118,7 @@ MODULE SuperController_Types END TYPE SC_ContinuousStateType_C TYPE, PUBLIC :: SC_ContinuousStateType TYPE( SC_ContinuousStateType_C ) :: C_obj - REAL(SiKi) :: Dummy !< Remove this variable if you have continuous states [-] + REAL(SiKi) :: Dummy = 0.0_R4Ki !< Remove this variable if you have continuous states [-] END TYPE SC_ContinuousStateType ! ======================= ! ========= SC_ConstraintStateType_C ======= @@ -128,7 +128,7 @@ MODULE SuperController_Types END TYPE SC_ConstraintStateType_C TYPE, PUBLIC :: SC_ConstraintStateType TYPE( SC_ConstraintStateType_C ) :: C_obj - REAL(SiKi) :: Dummy !< Remove this variable if you have constraint states [-] + REAL(SiKi) :: Dummy = 0.0_R4Ki !< Remove this variable if you have constraint states [-] END TYPE SC_ConstraintStateType ! ======================= ! ========= SC_MiscVarType_C ======= @@ -138,7 +138,7 @@ MODULE SuperController_Types END TYPE SC_MiscVarType_C TYPE, PUBLIC :: SC_MiscVarType TYPE( SC_MiscVarType_C ) :: C_obj - REAL(SiKi) :: Dummy !< Remove this variable if you have misc vars [-] + REAL(SiKi) :: Dummy = 0.0_R4Ki !< Remove this variable if you have misc vars [-] END TYPE SC_MiscVarType ! ======================= ! ========= SC_OtherStateType_C ======= @@ -148,7 +148,7 @@ MODULE SuperController_Types END TYPE SC_OtherStateType_C TYPE, PUBLIC :: SC_OtherStateType TYPE( SC_OtherStateType_C ) :: C_obj - INTEGER(IntKi) :: Dummy !< Dummy Other State [-] + INTEGER(IntKi) :: Dummy = 0_IntKi !< Dummy Other State [-] END TYPE SC_OtherStateType ! ======================= ! ========= SC_InputType_C ======= @@ -180,2705 +180,1609 @@ MODULE SuperController_Types END TYPE SC_OutputType ! ======================= CONTAINS - SUBROUTINE SC_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SC_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + +subroutine SC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SC_InitInputType), intent(in) :: SrcInitInputData + type(SC_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%nTurbines = SrcInitInputData%nTurbines + DstInitInputData%C_obj%nTurbines = SrcInitInputData%C_obj%nTurbines + DstInitInputData%DLL_FileName = SrcInitInputData%DLL_FileName + DstInitInputData%C_obj%DLL_FileName = SrcInitInputData%C_obj%DLL_FileName +end subroutine + +subroutine SC_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SC_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SC_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, InData%nTurbines) + call RegPack(Buf, InData%DLL_FileName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%nTurbines) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%nTurbines = OutData%nTurbines + call RegUnpack(Buf, OutData%DLL_FileName) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%DLL_FileName = transfer(OutData%DLL_FileName, OutData%C_obj%DLL_FileName ) +end subroutine + +SUBROUTINE SC_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyInitInput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - DstInitInputData%nTurbines = SrcInitInputData%nTurbines - DstInitInputData%C_obj%nTurbines = SrcInitInputData%C_obj%nTurbines - DstInitInputData%DLL_FileName = SrcInitInputData%DLL_FileName - DstInitInputData%C_obj%DLL_FileName = SrcInitInputData%C_obj%DLL_FileName - END SUBROUTINE SC_CopyInitInput - - SUBROUTINE SC_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SC_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 = 'SC_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SC_DestroyInitInput - - SUBROUTINE SC_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(SC_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 = 'SC_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 ! nTurbines - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_FileName) ! DLL_FileName - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%nTurbines - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%DLL_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE SC_PackInitInput - - SUBROUTINE SC_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(SC_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_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%nTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%nTurbines = OutData%nTurbines - DO I = 1, LEN(OutData%DLL_FileName) - OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%DLL_FileName = TRANSFER(OutData%DLL_FileName, OutData%C_obj%DLL_FileName ) - END SUBROUTINE SC_UnPackInitInput - - SUBROUTINE SC_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%nTurbines = InitInputData%C_obj%nTurbines - InitInputData%DLL_FileName = TRANSFER(InitInputData%C_obj%DLL_FileName, InitInputData%DLL_FileName ) - END SUBROUTINE SC_C2Fary_CopyInitInput - - SUBROUTINE SC_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%C_obj%nTurbines = InitInputData%nTurbines - InitInputData%C_obj%DLL_FileName = TRANSFER(InitInputData%DLL_FileName, InitInputData%C_obj%DLL_FileName ) - END SUBROUTINE SC_F2C_CopyInitInput - - SUBROUTINE SC_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SC_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%nTurbines = InitInputData%C_obj%nTurbines + InitInputData%DLL_FileName = TRANSFER(InitInputData%C_obj%DLL_FileName, InitInputData%DLL_FileName ) +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%C_obj%nTurbines = InitInputData%nTurbines + InitInputData%C_obj%DLL_FileName = TRANSFER(InitInputData%DLL_FileName, InitInputData%C_obj%DLL_FileName) +END SUBROUTINE + +subroutine SC_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SC_InitOutputType), intent(in) :: SrcInitOutputData + type(SC_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SC_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%NumCtrl2SC = SrcInitOutputData%NumCtrl2SC + DstInitOutputData%C_obj%NumCtrl2SC = SrcInitOutputData%C_obj%NumCtrl2SC + DstInitOutputData%nInpGlobal = SrcInitOutputData%nInpGlobal + DstInitOutputData%C_obj%nInpGlobal = SrcInitOutputData%C_obj%nInpGlobal + DstInitOutputData%NumSC2Ctrl = SrcInitOutputData%NumSC2Ctrl + DstInitOutputData%C_obj%NumSC2Ctrl = SrcInitOutputData%C_obj%NumSC2Ctrl + DstInitOutputData%NumSC2CtrlGlob = SrcInitOutputData%NumSC2CtrlGlob + DstInitOutputData%C_obj%NumSC2CtrlGlob = SrcInitOutputData%C_obj%NumSC2CtrlGlob +end subroutine + +subroutine SC_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SC_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SC_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SC_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + call RegPack(Buf, InData%NumCtrl2SC) + call RegPack(Buf, InData%nInpGlobal) + call RegPack(Buf, InData%NumSC2Ctrl) + call RegPack(Buf, InData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + call RegUnpack(Buf, OutData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC + call RegUnpack(Buf, OutData%nInpGlobal) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%nInpGlobal = OutData%nInpGlobal + call RegUnpack(Buf, OutData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl + call RegUnpack(Buf, OutData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob +end subroutine + +SUBROUTINE SC_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyInitOutput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%NumCtrl2SC = SrcInitOutputData%NumCtrl2SC - DstInitOutputData%C_obj%NumCtrl2SC = SrcInitOutputData%C_obj%NumCtrl2SC - DstInitOutputData%nInpGlobal = SrcInitOutputData%nInpGlobal - DstInitOutputData%C_obj%nInpGlobal = SrcInitOutputData%C_obj%nInpGlobal - DstInitOutputData%NumSC2Ctrl = SrcInitOutputData%NumSC2Ctrl - DstInitOutputData%C_obj%NumSC2Ctrl = SrcInitOutputData%C_obj%NumSC2Ctrl - DstInitOutputData%NumSC2CtrlGlob = SrcInitOutputData%NumSC2CtrlGlob - DstInitOutputData%C_obj%NumSC2CtrlGlob = SrcInitOutputData%C_obj%NumSC2CtrlGlob - END SUBROUTINE SC_CopyInitOutput - - SUBROUTINE SC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SC_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 = 'SC_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SC_DestroyInitOutput - - SUBROUTINE SC_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(SC_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 = 'SC_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! nInpGlobal - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - 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 - - 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) + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitOutputData%NumCtrl2SC = InitOutputData%C_obj%NumCtrl2SC + InitOutputData%nInpGlobal = InitOutputData%C_obj%nInpGlobal + InitOutputData%NumSC2Ctrl = InitOutputData%C_obj%NumSC2Ctrl + InitOutputData%NumSC2CtrlGlob = InitOutputData%C_obj%NumSC2CtrlGlob +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitOutputData%C_obj%NumCtrl2SC = InitOutputData%NumCtrl2SC + InitOutputData%C_obj%nInpGlobal = InitOutputData%nInpGlobal + InitOutputData%C_obj%NumSC2Ctrl = InitOutputData%NumSC2Ctrl + InitOutputData%C_obj%NumSC2CtrlGlob = InitOutputData%NumSC2CtrlGlob +END SUBROUTINE + +subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SC_ParameterType), intent(in) :: SrcParamData + type(SC_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SC_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%C_obj%DT = SrcParamData%C_obj%DT + DstParamData%nTurbines = SrcParamData%nTurbines + DstParamData%C_obj%nTurbines = SrcParamData%C_obj%nTurbines + DstParamData%NumCtrl2SC = SrcParamData%NumCtrl2SC + DstParamData%C_obj%NumCtrl2SC = SrcParamData%C_obj%NumCtrl2SC + DstParamData%nInpGlobal = SrcParamData%nInpGlobal + DstParamData%C_obj%nInpGlobal = SrcParamData%C_obj%nInpGlobal + DstParamData%NumSC2Ctrl = SrcParamData%NumSC2Ctrl + DstParamData%C_obj%NumSC2Ctrl = SrcParamData%C_obj%NumSC2Ctrl + DstParamData%NumSC2CtrlGlob = SrcParamData%NumSC2CtrlGlob + DstParamData%C_obj%NumSC2CtrlGlob = SrcParamData%C_obj%NumSC2CtrlGlob + DstParamData%NumStatesGlobal = SrcParamData%NumStatesGlobal + DstParamData%C_obj%NumStatesGlobal = SrcParamData%C_obj%NumStatesGlobal + DstParamData%NumStatesTurbine = SrcParamData%NumStatesTurbine + DstParamData%C_obj%NumStatesTurbine = SrcParamData%C_obj%NumStatesTurbine + DstParamData%NumParamGlobal = SrcParamData%NumParamGlobal + DstParamData%C_obj%NumParamGlobal = SrcParamData%C_obj%NumParamGlobal + DstParamData%NumParamTurbine = SrcParamData%NumParamTurbine + DstParamData%C_obj%NumParamTurbine = SrcParamData%C_obj%NumParamTurbine + if (associated(SrcParamData%ParamGlobal)) then + LB(1:1) = lbound(SrcParamData%ParamGlobal) + UB(1:1) = ubound(SrcParamData%ParamGlobal) + if (.not. associated(DstParamData%ParamGlobal)) then + allocate(DstParamData%ParamGlobal(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstParamData%ParamGlobal = SrcParamData%ParamGlobal + end if + if (associated(SrcParamData%ParamTurbine)) then + LB(1:1) = lbound(SrcParamData%ParamTurbine) + UB(1:1) = ubound(SrcParamData%ParamTurbine) + if (.not. associated(DstParamData%ParamTurbine)) then + allocate(DstParamData%ParamTurbine(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstParamData%ParamTurbine = SrcParamData%ParamTurbine + end if + DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt +end subroutine + +subroutine SC_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SC_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SC_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(ParamData%ParamGlobal)) then + deallocate(ParamData%ParamGlobal) + ParamData%ParamGlobal => null() + ParamData%C_obj%ParamGlobal = c_null_ptr + ParamData%C_obj%ParamGlobal_Len = 0 + end if + if (associated(ParamData%ParamTurbine)) then + deallocate(ParamData%ParamTurbine) + ParamData%ParamTurbine => null() + ParamData%C_obj%ParamTurbine = c_null_ptr + ParamData%C_obj%ParamTurbine_Len = 0 + end if + call FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SC_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackParam' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, InData%DT) + call RegPack(Buf, InData%nTurbines) + call RegPack(Buf, InData%NumCtrl2SC) + call RegPack(Buf, InData%nInpGlobal) + call RegPack(Buf, InData%NumSC2Ctrl) + call RegPack(Buf, InData%NumSC2CtrlGlob) + call RegPack(Buf, InData%NumStatesGlobal) + call RegPack(Buf, InData%NumStatesTurbine) + call RegPack(Buf, InData%NumParamGlobal) + call RegPack(Buf, InData%NumParamTurbine) + call RegPack(Buf, associated(InData%ParamGlobal)) + if (associated(InData%ParamGlobal)) then + call RegPackBounds(Buf, 1, lbound(InData%ParamGlobal), ubound(InData%ParamGlobal)) + call RegPackPointer(Buf, c_loc(InData%ParamGlobal), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%ParamGlobal) + end if + end if + call RegPack(Buf, associated(InData%ParamTurbine)) + if (associated(InData%ParamTurbine)) then + call RegPackBounds(Buf, 1, lbound(InData%ParamTurbine), ubound(InData%ParamTurbine)) + call RegPackPointer(Buf, c_loc(InData%ParamTurbine), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%ParamTurbine) + end if + end if + call DLLTypePack(Buf, InData%DLL_Trgt) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackParam' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%DT = OutData%DT + call RegUnpack(Buf, OutData%nTurbines) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%nTurbines = OutData%nTurbines + call RegUnpack(Buf, OutData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC + call RegUnpack(Buf, OutData%nInpGlobal) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%nInpGlobal = OutData%nInpGlobal + call RegUnpack(Buf, OutData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl + call RegUnpack(Buf, OutData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob + call RegUnpack(Buf, OutData%NumStatesGlobal) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumStatesGlobal = OutData%NumStatesGlobal + call RegUnpack(Buf, OutData%NumStatesTurbine) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumStatesTurbine = OutData%NumStatesTurbine + call RegUnpack(Buf, OutData%NumParamGlobal) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumParamGlobal = OutData%NumParamGlobal + call RegUnpack(Buf, OutData%NumParamTurbine) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumParamTurbine = OutData%NumParamTurbine + if (associated(OutData%ParamGlobal)) deallocate(OutData%ParamGlobal) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%ParamGlobal, UB(1:1)-LB(1:1)) + OutData%ParamGlobal(LB(1):) => OutData%ParamGlobal + else + allocate(OutData%ParamGlobal(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ParamGlobal.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%ParamGlobal) + OutData%C_obj%ParamGlobal_Len = size(OutData%ParamGlobal) + if (OutData%C_obj%ParamGlobal_Len > 0) OutData%C_obj%ParamGlobal = c_loc(OutData%ParamGlobal(LB(1))) + call RegUnpack(Buf, OutData%ParamGlobal) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%ParamGlobal => null() + end if + if (associated(OutData%ParamTurbine)) deallocate(OutData%ParamTurbine) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%ParamTurbine, UB(1:1)-LB(1:1)) + OutData%ParamTurbine(LB(1):) => OutData%ParamTurbine + else + allocate(OutData%ParamTurbine(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ParamTurbine.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%ParamTurbine) + OutData%C_obj%ParamTurbine_Len = size(OutData%ParamTurbine) + if (OutData%C_obj%ParamTurbine_Len > 0) OutData%C_obj%ParamTurbine = c_loc(OutData%ParamTurbine(LB(1))) + call RegUnpack(Buf, OutData%ParamTurbine) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%ParamTurbine => null() + end if + call DLLTypeUnpack(Buf, OutData%DLL_Trgt) ! DLL_Trgt +end subroutine + +SUBROUTINE SC_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%DT = ParamData%C_obj%DT + ParamData%nTurbines = ParamData%C_obj%nTurbines + ParamData%NumCtrl2SC = ParamData%C_obj%NumCtrl2SC + ParamData%nInpGlobal = ParamData%C_obj%nInpGlobal + ParamData%NumSC2Ctrl = ParamData%C_obj%NumSC2Ctrl + ParamData%NumSC2CtrlGlob = ParamData%C_obj%NumSC2CtrlGlob + ParamData%NumStatesGlobal = ParamData%C_obj%NumStatesGlobal + ParamData%NumStatesTurbine = ParamData%C_obj%NumStatesTurbine + ParamData%NumParamGlobal = ParamData%C_obj%NumParamGlobal + ParamData%NumParamTurbine = ParamData%C_obj%NumParamTurbine + + ! -- ParamGlobal Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%ParamGlobal ) ) THEN + NULLIFY( ParamData%ParamGlobal ) 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) + CALL C_F_POINTER(ParamData%C_obj%ParamGlobal, ParamData%ParamGlobal, [ParamData%C_obj%ParamGlobal_Len]) + END IF + END IF + + ! -- ParamTurbine Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%ParamTurbine ) ) THEN + NULLIFY( ParamData%ParamTurbine ) ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nInpGlobal - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SC_PackInitOutput - - SUBROUTINE SC_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(SC_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_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 - 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 + CALL C_F_POINTER(ParamData%C_obj%ParamTurbine, ParamData%ParamTurbine, [ParamData%C_obj%ParamTurbine_Len]) 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 +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%C_obj%DT = ParamData%DT + ParamData%C_obj%nTurbines = ParamData%nTurbines + ParamData%C_obj%NumCtrl2SC = ParamData%NumCtrl2SC + ParamData%C_obj%nInpGlobal = ParamData%nInpGlobal + ParamData%C_obj%NumSC2Ctrl = ParamData%NumSC2Ctrl + ParamData%C_obj%NumSC2CtrlGlob = ParamData%NumSC2CtrlGlob + ParamData%C_obj%NumStatesGlobal = ParamData%NumStatesGlobal + ParamData%C_obj%NumStatesTurbine = ParamData%NumStatesTurbine + ParamData%C_obj%NumParamGlobal = ParamData%NumParamGlobal + ParamData%C_obj%NumParamTurbine = ParamData%NumParamTurbine + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) 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%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - OutData%nInpGlobal = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%nInpGlobal = OutData%nInpGlobal - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob - END SUBROUTINE SC_UnPackInitOutput - - SUBROUTINE SC_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitOutputData%NumCtrl2SC = InitOutputData%C_obj%NumCtrl2SC - InitOutputData%nInpGlobal = InitOutputData%C_obj%nInpGlobal - InitOutputData%NumSC2Ctrl = InitOutputData%C_obj%NumSC2Ctrl - InitOutputData%NumSC2CtrlGlob = InitOutputData%C_obj%NumSC2CtrlGlob - END SUBROUTINE SC_C2Fary_CopyInitOutput - - SUBROUTINE SC_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitOutputData%C_obj%NumCtrl2SC = InitOutputData%NumCtrl2SC - InitOutputData%C_obj%nInpGlobal = InitOutputData%nInpGlobal - InitOutputData%C_obj%NumSC2Ctrl = InitOutputData%NumSC2Ctrl - InitOutputData%C_obj%NumSC2CtrlGlob = InitOutputData%NumSC2CtrlGlob - END SUBROUTINE SC_F2C_CopyInitOutput - - SUBROUTINE SC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SC_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + END IF +END SUBROUTINE + +subroutine SC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SC_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SC_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SC_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcDiscStateData%Global)) then + LB(1:1) = lbound(SrcDiscStateData%Global) + UB(1:1) = ubound(SrcDiscStateData%Global) + if (.not. associated(DstDiscStateData%Global)) then + allocate(DstDiscStateData%Global(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstDiscStateData%Global = SrcDiscStateData%Global + end if + if (associated(SrcDiscStateData%Turbine)) then + LB(1:1) = lbound(SrcDiscStateData%Turbine) + UB(1:1) = ubound(SrcDiscStateData%Turbine) + if (.not. associated(DstDiscStateData%Turbine)) then + allocate(DstDiscStateData%Turbine(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstDiscStateData%Turbine = SrcDiscStateData%Turbine + end if +end subroutine + +subroutine SC_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SC_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(DiscStateData%Global)) then + deallocate(DiscStateData%Global) + DiscStateData%Global => null() + DiscStateData%C_obj%Global = c_null_ptr + DiscStateData%C_obj%Global_Len = 0 + end if + if (associated(DiscStateData%Turbine)) then + deallocate(DiscStateData%Turbine) + DiscStateData%Turbine => null() + DiscStateData%C_obj%Turbine = c_null_ptr + DiscStateData%C_obj%Turbine_Len = 0 + end if +end subroutine + +subroutine SC_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackDiscState' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, associated(InData%Global)) + if (associated(InData%Global)) then + call RegPackBounds(Buf, 1, lbound(InData%Global), ubound(InData%Global)) + call RegPackPointer(Buf, c_loc(InData%Global), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Global) + end if + end if + call RegPack(Buf, associated(InData%Turbine)) + if (associated(InData%Turbine)) then + call RegPackBounds(Buf, 1, lbound(InData%Turbine), ubound(InData%Turbine)) + call RegPackPointer(Buf, c_loc(InData%Turbine), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Turbine) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackDiscState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%Global)) deallocate(OutData%Global) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Global, UB(1:1)-LB(1:1)) + OutData%Global(LB(1):) => OutData%Global + else + allocate(OutData%Global(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Global.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Global) + OutData%C_obj%Global_Len = size(OutData%Global) + if (OutData%C_obj%Global_Len > 0) OutData%C_obj%Global = c_loc(OutData%Global(LB(1))) + call RegUnpack(Buf, OutData%Global) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Global => null() + end if + if (associated(OutData%Turbine)) deallocate(OutData%Turbine) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Turbine, UB(1:1)-LB(1:1)) + OutData%Turbine(LB(1):) => OutData%Turbine + else + allocate(OutData%Turbine(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turbine.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Turbine) + OutData%C_obj%Turbine_Len = size(OutData%Turbine) + if (OutData%C_obj%Turbine_Len > 0) OutData%C_obj%Turbine = c_loc(OutData%Turbine(LB(1))) + call RegUnpack(Buf, OutData%Turbine) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Turbine => null() + end if +end subroutine + +SUBROUTINE SC_C2Fary_CopyDiscState(DiscStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData 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 = 'SC_CopyParam' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%C_obj%DT = SrcParamData%C_obj%DT - DstParamData%nTurbines = SrcParamData%nTurbines - DstParamData%C_obj%nTurbines = SrcParamData%C_obj%nTurbines - DstParamData%NumCtrl2SC = SrcParamData%NumCtrl2SC - DstParamData%C_obj%NumCtrl2SC = SrcParamData%C_obj%NumCtrl2SC - DstParamData%nInpGlobal = SrcParamData%nInpGlobal - DstParamData%C_obj%nInpGlobal = SrcParamData%C_obj%nInpGlobal - DstParamData%NumSC2Ctrl = SrcParamData%NumSC2Ctrl - DstParamData%C_obj%NumSC2Ctrl = SrcParamData%C_obj%NumSC2Ctrl - DstParamData%NumSC2CtrlGlob = SrcParamData%NumSC2CtrlGlob - DstParamData%C_obj%NumSC2CtrlGlob = SrcParamData%C_obj%NumSC2CtrlGlob - DstParamData%NumStatesGlobal = SrcParamData%NumStatesGlobal - DstParamData%C_obj%NumStatesGlobal = SrcParamData%C_obj%NumStatesGlobal - DstParamData%NumStatesTurbine = SrcParamData%NumStatesTurbine - DstParamData%C_obj%NumStatesTurbine = SrcParamData%C_obj%NumStatesTurbine - DstParamData%NumParamGlobal = SrcParamData%NumParamGlobal - DstParamData%C_obj%NumParamGlobal = SrcParamData%C_obj%NumParamGlobal - DstParamData%NumParamTurbine = SrcParamData%NumParamTurbine - DstParamData%C_obj%NumParamTurbine = SrcParamData%C_obj%NumParamTurbine -IF (ASSOCIATED(SrcParamData%ParamGlobal)) THEN - i1_l = LBOUND(SrcParamData%ParamGlobal,1) - i1_u = UBOUND(SrcParamData%ParamGlobal,1) - IF (.NOT. ASSOCIATED(DstParamData%ParamGlobal)) THEN - ALLOCATE(DstParamData%ParamGlobal(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstParamData%ParamGlobal = SrcParamData%ParamGlobal -ENDIF -IF (ASSOCIATED(SrcParamData%ParamTurbine)) THEN - i1_l = LBOUND(SrcParamData%ParamTurbine,1) - i1_u = UBOUND(SrcParamData%ParamTurbine,1) - IF (.NOT. ASSOCIATED(DstParamData%ParamTurbine)) THEN - ALLOCATE(DstParamData%ParamTurbine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstParamData%ParamTurbine = SrcParamData%ParamTurbine -ENDIF - DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt - END SUBROUTINE SC_CopyParam - - SUBROUTINE SC_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SC_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 = 'SC_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(ParamData%ParamGlobal)) THEN - 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 - DEALLOCATE(ParamData%ParamTurbine) - ParamData%ParamTurbine => NULL() - ParamData%C_obj%ParamTurbine = C_NULL_PTR - ParamData%C_obj%ParamTurbine_Len = 0 -ENDIF - CALL FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SC_DestroyParam - - SUBROUTINE SC_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(SC_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 = 'SC_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 ! nTurbines - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! nInpGlobal - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - Int_BufSz = Int_BufSz + 1 ! NumStatesGlobal - Int_BufSz = Int_BufSz + 1 ! NumStatesTurbine - Int_BufSz = Int_BufSz + 1 ! NumParamGlobal - Int_BufSz = Int_BufSz + 1 ! NumParamTurbine - Int_BufSz = Int_BufSz + 1 ! ParamGlobal allocated yes/no - IF ( ASSOCIATED(InData%ParamGlobal) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ParamGlobal upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ParamGlobal) ! ParamGlobal - END IF - Int_BufSz = Int_BufSz + 1 ! ParamTurbine allocated yes/no - IF ( ASSOCIATED(InData%ParamTurbine) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ParamTurbine upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ParamTurbine) ! ParamTurbine - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DLL_Trgt: size of buffers for each call to pack subtype - CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DLL_Trgt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DLL_Trgt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DLL_Trgt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DLL_Trgt - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nTurbines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nInpGlobal - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumStatesGlobal - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumStatesTurbine - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumParamGlobal - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumParamTurbine - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%ParamGlobal) ) 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%ParamGlobal,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ParamGlobal,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ParamGlobal,1), UBOUND(InData%ParamGlobal,1) - ReKiBuf(Re_Xferred) = InData%ParamGlobal(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%ParamTurbine) ) 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%ParamTurbine,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ParamTurbine,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ParamTurbine,1), UBOUND(InData%ParamTurbine,1) - ReKiBuf(Re_Xferred) = InData%ParamTurbine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Trgt - 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) + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- Global DiscState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( DiscStateData%C_obj%Global ) ) THEN + NULLIFY( DiscStateData%Global ) 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) + CALL C_F_POINTER(DiscStateData%C_obj%Global, DiscStateData%Global, [DiscStateData%C_obj%Global_Len]) + END IF + END IF + + ! -- Turbine DiscState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( DiscStateData%C_obj%Turbine ) ) THEN + NULLIFY( DiscStateData%Turbine ) ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE SC_PackParam - - SUBROUTINE SC_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(SC_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_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%C_obj%DT = OutData%DT - OutData%nTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%nTurbines = OutData%nTurbines - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - OutData%nInpGlobal = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%nInpGlobal = OutData%nInpGlobal - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob - OutData%NumStatesGlobal = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumStatesGlobal = OutData%NumStatesGlobal - OutData%NumStatesTurbine = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumStatesTurbine = OutData%NumStatesTurbine - OutData%NumParamGlobal = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumParamGlobal = OutData%NumParamGlobal - OutData%NumParamTurbine = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumParamTurbine = OutData%NumParamTurbine - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ParamGlobal 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%ParamGlobal)) DEALLOCATE(OutData%ParamGlobal) - ALLOCATE(OutData%ParamGlobal(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%ParamGlobal,1), UBOUND(OutData%ParamGlobal,1) - OutData%ParamGlobal(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ParamTurbine 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%ParamTurbine)) DEALLOCATE(OutData%ParamTurbine) - ALLOCATE(OutData%ParamTurbine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%ParamTurbine,1), UBOUND(OutData%ParamTurbine,1) - OutData%ParamTurbine(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - 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 + CALL C_F_POINTER(DiscStateData%C_obj%Turbine, DiscStateData%Turbine, [DiscStateData%C_obj%Turbine_Len]) 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 +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- 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 + 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))) 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 + + ! -- 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 + 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))) END IF - CALL DLLTypeUnpack( OutData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! DLL_Trgt - 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 SC_UnPackParam - - SUBROUTINE SC_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%DT = ParamData%C_obj%DT - ParamData%nTurbines = ParamData%C_obj%nTurbines - ParamData%NumCtrl2SC = ParamData%C_obj%NumCtrl2SC - ParamData%nInpGlobal = ParamData%C_obj%nInpGlobal - ParamData%NumSC2Ctrl = ParamData%C_obj%NumSC2Ctrl - ParamData%NumSC2CtrlGlob = ParamData%C_obj%NumSC2CtrlGlob - ParamData%NumStatesGlobal = ParamData%C_obj%NumStatesGlobal - ParamData%NumStatesTurbine = ParamData%C_obj%NumStatesTurbine - ParamData%NumParamGlobal = ParamData%C_obj%NumParamGlobal - ParamData%NumParamTurbine = ParamData%C_obj%NumParamTurbine - - ! -- ParamGlobal Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%ParamGlobal ) ) THEN - NULLIFY( ParamData%ParamGlobal ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%ParamGlobal, ParamData%ParamGlobal, (/ParamData%C_obj%ParamGlobal_Len/)) - END IF - END IF - - ! -- ParamTurbine Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%ParamTurbine ) ) THEN - NULLIFY( ParamData%ParamTurbine ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%ParamTurbine, ParamData%ParamTurbine, (/ParamData%C_obj%ParamTurbine_Len/)) - END IF - END IF - END SUBROUTINE SC_C2Fary_CopyParam - - SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%C_obj%DT = ParamData%DT - ParamData%C_obj%nTurbines = ParamData%nTurbines - ParamData%C_obj%NumCtrl2SC = ParamData%NumCtrl2SC - ParamData%C_obj%nInpGlobal = ParamData%nInpGlobal - ParamData%C_obj%NumSC2Ctrl = ParamData%NumSC2Ctrl - ParamData%C_obj%NumSC2CtrlGlob = ParamData%NumSC2CtrlGlob - ParamData%C_obj%NumStatesGlobal = ParamData%NumStatesGlobal - ParamData%C_obj%NumStatesTurbine = ParamData%NumStatesTurbine - ParamData%C_obj%NumParamGlobal = ParamData%NumParamGlobal - ParamData%C_obj%NumParamTurbine = ParamData%NumParamTurbine - - ! -- 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 - 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) ) ) - 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 - 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) ) ) - END IF - END IF - END SUBROUTINE SC_F2C_CopyParam - - SUBROUTINE SC_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + END IF +END SUBROUTINE + +subroutine SC_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SC_ContinuousStateType), intent(in) :: SrcContStateData + type(SC_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%Dummy = SrcContStateData%Dummy + DstContStateData%C_obj%Dummy = SrcContStateData%C_obj%Dummy +end subroutine + +subroutine SC_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SC_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SC_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%Dummy = OutData%Dummy +end subroutine + +SUBROUTINE SC_C2Fary_CopyContState(ContStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData 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 = 'SC_CopyDiscState' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" -IF (ASSOCIATED(SrcDiscStateData%Global)) THEN - i1_l = LBOUND(SrcDiscStateData%Global,1) - i1_u = UBOUND(SrcDiscStateData%Global,1) - IF (.NOT. ASSOCIATED(DstDiscStateData%Global)) THEN - ALLOCATE(DstDiscStateData%Global(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstDiscStateData%Global = SrcDiscStateData%Global -ENDIF -IF (ASSOCIATED(SrcDiscStateData%Turbine)) THEN - i1_l = LBOUND(SrcDiscStateData%Turbine,1) - i1_u = UBOUND(SrcDiscStateData%Turbine,1) - IF (.NOT. ASSOCIATED(DstDiscStateData%Turbine)) THEN - ALLOCATE(DstDiscStateData%Turbine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstDiscStateData%Turbine = SrcDiscStateData%Turbine -ENDIF - END SUBROUTINE SC_CopyDiscState - - SUBROUTINE SC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(SC_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 = 'SC_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(DiscStateData%Global)) THEN - 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 - DEALLOCATE(DiscStateData%Turbine) - DiscStateData%Turbine => NULL() - DiscStateData%C_obj%Turbine = C_NULL_PTR - DiscStateData%C_obj%Turbine_Len = 0 -ENDIF - END SUBROUTINE SC_DestroyDiscState - - SUBROUTINE SC_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(SC_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 = 'SC_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 - Int_BufSz = Int_BufSz + 1 ! Global allocated yes/no - IF ( ASSOCIATED(InData%Global) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Global upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Global) ! Global - END IF - Int_BufSz = Int_BufSz + 1 ! Turbine allocated yes/no - IF ( ASSOCIATED(InData%Turbine) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Turbine upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Turbine) ! Turbine - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%Global) ) 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%Global,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Global,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Global,1), UBOUND(InData%Global,1) - ReKiBuf(Re_Xferred) = InData%Global(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Turbine) ) 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%Turbine,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turbine,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Turbine,1), UBOUND(InData%Turbine,1) - ReKiBuf(Re_Xferred) = InData%Turbine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_PackDiscState - - SUBROUTINE SC_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(SC_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Global 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%Global)) DEALLOCATE(OutData%Global) - ALLOCATE(OutData%Global(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%Global,1), UBOUND(OutData%Global,1) - OutData%Global(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Turbine 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%Turbine)) DEALLOCATE(OutData%Turbine) - ALLOCATE(OutData%Turbine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%Turbine,1), UBOUND(OutData%Turbine,1) - OutData%Turbine(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_UnPackDiscState - - SUBROUTINE SC_C2Fary_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- Global DiscState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( DiscStateData%C_obj%Global ) ) THEN - NULLIFY( DiscStateData%Global ) - ELSE - CALL C_F_POINTER(DiscStateData%C_obj%Global, DiscStateData%Global, (/DiscStateData%C_obj%Global_Len/)) - END IF - END IF - - ! -- Turbine DiscState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( DiscStateData%C_obj%Turbine ) ) THEN - NULLIFY( DiscStateData%Turbine ) - ELSE - CALL C_F_POINTER(DiscStateData%C_obj%Turbine, DiscStateData%Turbine, (/DiscStateData%C_obj%Turbine_Len/)) - END IF - END IF - END SUBROUTINE SC_C2Fary_CopyDiscState - - SUBROUTINE SC_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- 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 - 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) ) ) - 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 - 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) ) ) - END IF - END IF - END SUBROUTINE SC_F2C_CopyDiscState - - SUBROUTINE SC_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SC_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ContStateData%Dummy = ContStateData%C_obj%Dummy +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyContState' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%Dummy = SrcContStateData%Dummy - DstContStateData%C_obj%Dummy = SrcContStateData%C_obj%Dummy - END SUBROUTINE SC_CopyContState - - SUBROUTINE SC_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(SC_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 = 'SC_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SC_DestroyContState - - SUBROUTINE SC_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(SC_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 = 'SC_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 ! Dummy - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SC_PackContState - - SUBROUTINE SC_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(SC_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 = 'SC_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%Dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%Dummy = OutData%Dummy - END SUBROUTINE SC_UnPackContState - - SUBROUTINE SC_C2Fary_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ContStateData%Dummy = ContStateData%C_obj%Dummy - END SUBROUTINE SC_C2Fary_CopyContState - - SUBROUTINE SC_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ContStateData%C_obj%Dummy = ContStateData%Dummy - END SUBROUTINE SC_F2C_CopyContState - - SUBROUTINE SC_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SC_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ContStateData%C_obj%Dummy = ContStateData%Dummy +END SUBROUTINE + +subroutine SC_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SC_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SC_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%Dummy = SrcConstrStateData%Dummy + DstConstrStateData%C_obj%Dummy = SrcConstrStateData%C_obj%Dummy +end subroutine + +subroutine SC_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SC_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SC_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%Dummy = OutData%Dummy +end subroutine + +SUBROUTINE SC_C2Fary_CopyConstrState(ConstrStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyConstrState' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - DstConstrStateData%Dummy = SrcConstrStateData%Dummy - DstConstrStateData%C_obj%Dummy = SrcConstrStateData%C_obj%Dummy - END SUBROUTINE SC_CopyConstrState - - SUBROUTINE SC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(SC_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 = 'SC_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SC_DestroyConstrState - - SUBROUTINE SC_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(SC_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 = 'SC_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 ! Dummy - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SC_PackConstrState - - SUBROUTINE SC_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(SC_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 = 'SC_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%Dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%Dummy = OutData%Dummy - END SUBROUTINE SC_UnPackConstrState - - SUBROUTINE SC_C2Fary_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ConstrStateData%Dummy = ConstrStateData%C_obj%Dummy - END SUBROUTINE SC_C2Fary_CopyConstrState - - SUBROUTINE SC_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ConstrStateData%C_obj%Dummy = ConstrStateData%Dummy - END SUBROUTINE SC_F2C_CopyConstrState - - SUBROUTINE SC_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SC_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ConstrStateData%Dummy = ConstrStateData%C_obj%Dummy +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ConstrStateData%C_obj%Dummy = ConstrStateData%Dummy +END SUBROUTINE + +subroutine SC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SC_MiscVarType), intent(in) :: SrcMiscData + type(SC_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%Dummy = SrcMiscData%Dummy + DstMiscData%C_obj%Dummy = SrcMiscData%C_obj%Dummy +end subroutine + +subroutine SC_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SC_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SC_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%Dummy = OutData%Dummy +end subroutine + +SUBROUTINE SC_C2Fary_CopyMisc(MiscData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyMisc' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - DstMiscData%Dummy = SrcMiscData%Dummy - DstMiscData%C_obj%Dummy = SrcMiscData%C_obj%Dummy - END SUBROUTINE SC_CopyMisc - - SUBROUTINE SC_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SC_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 = 'SC_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SC_DestroyMisc - - SUBROUTINE SC_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(SC_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 = 'SC_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 ! Dummy - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SC_PackMisc - - SUBROUTINE SC_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(SC_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 = 'SC_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%Dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%Dummy = OutData%Dummy - END SUBROUTINE SC_UnPackMisc - - SUBROUTINE SC_C2Fary_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - MiscData%Dummy = MiscData%C_obj%Dummy - END SUBROUTINE SC_C2Fary_CopyMisc - - SUBROUTINE SC_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - MiscData%C_obj%Dummy = MiscData%Dummy - END SUBROUTINE SC_F2C_CopyMisc - - SUBROUTINE SC_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SC_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + MiscData%Dummy = MiscData%C_obj%Dummy +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyOtherState' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + MiscData%C_obj%Dummy = MiscData%Dummy +END SUBROUTINE + +subroutine SC_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SC_OtherStateType), intent(in) :: SrcOtherStateData + type(SC_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%Dummy = SrcOtherStateData%Dummy + DstOtherStateData%C_obj%Dummy = SrcOtherStateData%C_obj%Dummy +end subroutine + +subroutine SC_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SC_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SC_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%Dummy = OutData%Dummy +end subroutine + +SUBROUTINE SC_C2Fary_CopyOtherState(OtherStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - DstOtherStateData%Dummy = SrcOtherStateData%Dummy - DstOtherStateData%C_obj%Dummy = SrcOtherStateData%C_obj%Dummy - END SUBROUTINE SC_CopyOtherState - - SUBROUTINE SC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(SC_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 = 'SC_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SC_DestroyOtherState - - SUBROUTINE SC_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(SC_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 = 'SC_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 ! Dummy - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%Dummy - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SC_PackOtherState - - SUBROUTINE SC_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(SC_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 = 'SC_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%Dummy = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%Dummy = OutData%Dummy - END SUBROUTINE SC_UnPackOtherState - - SUBROUTINE SC_C2Fary_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - OtherStateData%Dummy = OtherStateData%C_obj%Dummy - END SUBROUTINE SC_C2Fary_CopyOtherState - - SUBROUTINE SC_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - OtherStateData%C_obj%Dummy = OtherStateData%Dummy - END SUBROUTINE SC_F2C_CopyOtherState - - SUBROUTINE SC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_InputType), INTENT(IN) :: SrcInputData - TYPE(SC_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + OtherStateData%Dummy = OtherStateData%C_obj%Dummy +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData 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 = 'SC_CopyInput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + OtherStateData%C_obj%Dummy = OtherStateData%Dummy +END SUBROUTINE + +subroutine SC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SC_InputType), intent(in) :: SrcInputData + type(SC_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SC_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcInputData%toSCglob)) then + LB(1:1) = lbound(SrcInputData%toSCglob) + UB(1:1) = ubound(SrcInputData%toSCglob) + if (.not. associated(DstInputData%toSCglob)) then + allocate(DstInputData%toSCglob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%toSCglob = SrcInputData%toSCglob + end if + if (associated(SrcInputData%toSC)) then + LB(1:1) = lbound(SrcInputData%toSC) + UB(1:1) = ubound(SrcInputData%toSC) + if (.not. associated(DstInputData%toSC)) then + allocate(DstInputData%toSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstInputData%toSC = SrcInputData%toSC + end if +end subroutine + +subroutine SC_DestroyInput(InputData, ErrStat, ErrMsg) + type(SC_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(InputData%toSCglob)) then + deallocate(InputData%toSCglob) + InputData%toSCglob => null() + InputData%C_obj%toSCglob = c_null_ptr + InputData%C_obj%toSCglob_Len = 0 + end if + if (associated(InputData%toSC)) then + deallocate(InputData%toSC) + InputData%toSC => null() + InputData%C_obj%toSC = c_null_ptr + InputData%C_obj%toSC_Len = 0 + end if +end subroutine + +subroutine SC_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, associated(InData%toSCglob)) + if (associated(InData%toSCglob)) then + call RegPackBounds(Buf, 1, lbound(InData%toSCglob), ubound(InData%toSCglob)) + call RegPackPointer(Buf, c_loc(InData%toSCglob), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%toSCglob) + end if + end if + call RegPack(Buf, associated(InData%toSC)) + if (associated(InData%toSC)) then + call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) + call RegPackPointer(Buf, c_loc(InData%toSC), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%toSC) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%toSCglob)) deallocate(OutData%toSCglob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%toSCglob, UB(1:1)-LB(1:1)) + OutData%toSCglob(LB(1):) => OutData%toSCglob + else + allocate(OutData%toSCglob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSCglob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%toSCglob) + OutData%C_obj%toSCglob_Len = size(OutData%toSCglob) + if (OutData%C_obj%toSCglob_Len > 0) OutData%C_obj%toSCglob = c_loc(OutData%toSCglob(LB(1))) + call RegUnpack(Buf, OutData%toSCglob) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%toSCglob => null() + end if + if (associated(OutData%toSC)) deallocate(OutData%toSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%toSC, UB(1:1)-LB(1:1)) + OutData%toSC(LB(1):) => OutData%toSC + else + allocate(OutData%toSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%toSC) + OutData%C_obj%toSC_Len = size(OutData%toSC) + if (OutData%C_obj%toSC_Len > 0) OutData%C_obj%toSC = c_loc(OutData%toSC(LB(1))) + call RegUnpack(Buf, OutData%toSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%toSC => null() + end if +end subroutine + +SUBROUTINE SC_C2Fary_CopyInput(InputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" -IF (ASSOCIATED(SrcInputData%toSCglob)) THEN - i1_l = LBOUND(SrcInputData%toSCglob,1) - i1_u = UBOUND(SrcInputData%toSCglob,1) - IF (.NOT. ASSOCIATED(DstInputData%toSCglob)) THEN - ALLOCATE(DstInputData%toSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%toSCglob = SrcInputData%toSCglob -ENDIF -IF (ASSOCIATED(SrcInputData%toSC)) THEN - i1_l = LBOUND(SrcInputData%toSC,1) - i1_u = UBOUND(SrcInputData%toSC,1) - IF (.NOT. ASSOCIATED(DstInputData%toSC)) THEN - ALLOCATE(DstInputData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstInputData%toSC = SrcInputData%toSC -ENDIF - END SUBROUTINE SC_CopyInput - - SUBROUTINE SC_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SC_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 = 'SC_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(InputData%toSCglob)) THEN - 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 - DEALLOCATE(InputData%toSC) - InputData%toSC => NULL() - InputData%C_obj%toSC = C_NULL_PTR - InputData%C_obj%toSC_Len = 0 -ENDIF - END SUBROUTINE SC_DestroyInput - - SUBROUTINE SC_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(SC_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 = 'SC_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 - Int_BufSz = Int_BufSz + 1 ! toSCglob allocated yes/no - IF ( ASSOCIATED(InData%toSCglob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSCglob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSCglob) ! toSCglob - END IF - Int_BufSz = Int_BufSz + 1 ! toSC allocated yes/no - IF ( ASSOCIATED(InData%toSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSC) ! toSC - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%toSCglob) ) 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%toSCglob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSCglob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSCglob,1), UBOUND(InData%toSCglob,1) - ReKiBuf(Re_Xferred) = InData%toSCglob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%toSC) ) 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%toSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) - ReKiBuf(Re_Xferred) = InData%toSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_PackInput - - SUBROUTINE SC_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(SC_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toSCglob 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%toSCglob)) DEALLOCATE(OutData%toSCglob) - ALLOCATE(OutData%toSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%toSCglob,1), UBOUND(OutData%toSCglob,1) - OutData%toSCglob(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toSC 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%toSC)) DEALLOCATE(OutData%toSC) - ALLOCATE(OutData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) - OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_UnPackInput - - SUBROUTINE SC_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- toSCglob Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSCglob ) ) THEN - NULLIFY( InputData%toSCglob ) - ELSE - CALL C_F_POINTER(InputData%C_obj%toSCglob, InputData%toSCglob, (/InputData%C_obj%toSCglob_Len/)) - END IF - END IF - - ! -- toSC Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN - NULLIFY( InputData%toSC ) - ELSE - CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, (/InputData%C_obj%toSC_Len/)) - END IF - END IF - END SUBROUTINE SC_C2Fary_CopyInput - - SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- 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 - 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) ) ) - 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 - 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) ) ) - END IF - END IF - END SUBROUTINE SC_F2C_CopyInput - - SUBROUTINE SC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_OutputType), INTENT(IN) :: SrcOutputData - TYPE(SC_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- toSCglob Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSCglob ) ) THEN + NULLIFY( InputData%toSCglob ) + ELSE + CALL C_F_POINTER(InputData%C_obj%toSCglob, InputData%toSCglob, [InputData%C_obj%toSCglob_Len]) + END IF + END IF + + ! -- toSC Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN + NULLIFY( InputData%toSC ) + ELSE + CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, [InputData%C_obj%toSC_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- 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 + 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))) + 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 + 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))) + END IF + END IF +END SUBROUTINE + +subroutine SC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SC_OutputType), intent(in) :: SrcOutputData + type(SC_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SC_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcOutputData%fromSCglob)) then + LB(1:1) = lbound(SrcOutputData%fromSCglob) + UB(1:1) = ubound(SrcOutputData%fromSCglob) + if (.not. associated(DstOutputData%fromSCglob)) then + allocate(DstOutputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOutputData%fromSCglob = SrcOutputData%fromSCglob + end if + if (associated(SrcOutputData%fromSC)) then + LB(1:1) = lbound(SrcOutputData%fromSC) + UB(1:1) = ubound(SrcOutputData%fromSC) + if (.not. associated(DstOutputData%fromSC)) then + allocate(DstOutputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + 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(LB(1))) + end if + DstOutputData%fromSC = SrcOutputData%fromSC + end if +end subroutine + +subroutine SC_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SC_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(OutputData%fromSCglob)) then + deallocate(OutputData%fromSCglob) + OutputData%fromSCglob => null() + OutputData%C_obj%fromSCglob = c_null_ptr + OutputData%C_obj%fromSCglob_Len = 0 + end if + if (associated(OutputData%fromSC)) then + deallocate(OutputData%fromSC) + OutputData%fromSC => null() + OutputData%C_obj%fromSC = c_null_ptr + OutputData%C_obj%fromSC_Len = 0 + end if +end subroutine + +subroutine SC_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegPack(Buf, associated(InData%fromSCglob)) + if (associated(InData%fromSCglob)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) + call RegPackPointer(Buf, c_loc(InData%fromSCglob), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%fromSCglob) + end if + end if + call RegPack(Buf, associated(InData%fromSC)) + if (associated(InData%fromSC)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPackPointer(Buf, c_loc(InData%fromSC), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%fromSC) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + if (associated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%fromSCglob, UB(1:1)-LB(1:1)) + OutData%fromSCglob(LB(1):) => OutData%fromSCglob + else + allocate(OutData%fromSCglob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%fromSCglob) + OutData%C_obj%fromSCglob_Len = size(OutData%fromSCglob) + if (OutData%C_obj%fromSCglob_Len > 0) OutData%C_obj%fromSCglob = c_loc(OutData%fromSCglob(LB(1))) + call RegUnpack(Buf, OutData%fromSCglob) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%fromSCglob => null() + end if + if (associated(OutData%fromSC)) deallocate(OutData%fromSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%fromSC, UB(1:1)-LB(1:1)) + OutData%fromSC(LB(1):) => OutData%fromSC + else + allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%fromSC) + OutData%C_obj%fromSC_Len = size(OutData%fromSC) + if (OutData%C_obj%fromSC_Len > 0) OutData%C_obj%fromSC = c_loc(OutData%fromSC(LB(1))) + call RegUnpack(Buf, OutData%fromSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%fromSC => null() + end if +end subroutine + +SUBROUTINE SC_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_OutputType), INTENT(INOUT) :: OutputData 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 = 'SC_CopyOutput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" -IF (ASSOCIATED(SrcOutputData%fromSCglob)) THEN - i1_l = LBOUND(SrcOutputData%fromSCglob,1) - i1_u = UBOUND(SrcOutputData%fromSCglob,1) - IF (.NOT. ASSOCIATED(DstOutputData%fromSCglob)) THEN - ALLOCATE(DstOutputData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOutputData%fromSCglob = SrcOutputData%fromSCglob -ENDIF -IF (ASSOCIATED(SrcOutputData%fromSC)) THEN - i1_l = LBOUND(SrcOutputData%fromSC,1) - i1_u = UBOUND(SrcOutputData%fromSC,1) - IF (.NOT. ASSOCIATED(DstOutputData%fromSC)) THEN - ALLOCATE(DstOutputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - END IF - DstOutputData%fromSC = SrcOutputData%fromSC -ENDIF - END SUBROUTINE SC_CopyOutput - - SUBROUTINE SC_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SC_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 = 'SC_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(OutputData%fromSCglob)) THEN - 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 - DEALLOCATE(OutputData%fromSC) - OutputData%fromSC => NULL() - OutputData%C_obj%fromSC = C_NULL_PTR - OutputData%C_obj%fromSC_Len = 0 -ENDIF - END SUBROUTINE SC_DestroyOutput - - SUBROUTINE SC_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(SC_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 = 'SC_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 ! fromSCglob allocated yes/no - IF ( ASSOCIATED(InData%fromSCglob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCglob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCglob) ! fromSCglob - END IF - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ASSOCIATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - 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) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%fromSCglob) ) 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%fromSCglob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCglob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCglob,1), UBOUND(InData%fromSCglob,1) - ReKiBuf(Re_Xferred) = InData%fromSCglob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%fromSC) ) 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%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_PackOutput - - SUBROUTINE SC_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(SC_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 = 'SC_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 ! fromSCglob 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%fromSCglob)) DEALLOCATE(OutData%fromSCglob) - ALLOCATE(OutData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%fromSCglob,1), UBOUND(OutData%fromSCglob,1) - OutData%fromSCglob(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC 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%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - 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 ) ) - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_UnPackOutput - - SUBROUTINE SC_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- fromSCglob Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSCglob ) ) THEN - NULLIFY( OutputData%fromSCglob ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%fromSCglob, OutputData%fromSCglob, (/OutputData%C_obj%fromSCglob_Len/)) - END IF - END IF - - ! -- fromSC Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN - NULLIFY( OutputData%fromSC ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, (/OutputData%C_obj%fromSC_Len/)) - END IF - END IF - END SUBROUTINE SC_C2Fary_CopyOutput - - SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - 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 - 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) ) ) - 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 - 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) ) ) - END IF - END IF - END SUBROUTINE SC_F2C_CopyOutput - - - SUBROUTINE SC_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) -! -!.................................................................................................................................. + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- fromSCglob Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSCglob ) ) THEN + NULLIFY( OutputData%fromSCglob ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%fromSCglob, OutputData%fromSCglob, [OutputData%C_obj%fromSCglob_Len]) + END IF + END IF + + ! -- fromSC Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN + NULLIFY( OutputData%fromSC ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, [OutputData%C_obj%fromSC_Len]) + END IF + END IF +END SUBROUTINE - TYPE(SC_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SC_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 +SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + 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 + 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))) + 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 + 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))) + END IF + END IF +END SUBROUTINE + +subroutine SC_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(SC_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(SC_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 = 'SC_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 SC_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SC_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 SC_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 SC_Input_ExtrapInterp - - - SUBROUTINE SC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SC_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SC_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SC_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SC_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. @@ -2890,53 +1794,48 @@ SUBROUTINE SC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(SC_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(SC_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SC_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 + TYPE(SC_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(SC_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SC_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 = 'SC_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 - 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 (ASSOCIATED(u_out%toSCglob) .AND. ASSOCIATED(u1%toSCglob)) THEN - DO i1 = LBOUND(u_out%toSCglob,1),UBOUND(u_out%toSCglob,1) - b = -(u1%toSCglob(i1) - u2%toSCglob(i1)) - u_out%toSCglob(i1) = u1%toSCglob(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN - DO i1 = LBOUND(u_out%toSC,1),UBOUND(u_out%toSC,1) - b = -(u1%toSC(i1) - u2%toSC(i1)) - u_out%toSC(i1) = u1%toSC(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SC_Input_ExtrapInterp1 - - - SUBROUTINE SC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(u_out%toSCglob) .AND. ASSOCIATED(u1%toSCglob)) THEN + u_out%toSCglob = a1*u1%toSCglob + a2*u2%toSCglob + END IF ! check if allocated + IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN + u_out%toSC = a1*u1%toSC + a2*u2%toSC + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SC_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. @@ -2950,115 +1849,108 @@ SUBROUTINE SC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(SC_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(SC_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(SC_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SC_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 + TYPE(SC_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(SC_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(SC_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SC_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 = 'SC_Input_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_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 + 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 + 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 + 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 (ASSOCIATED(u_out%toSCglob) .AND. ASSOCIATED(u1%toSCglob)) THEN - DO i1 = LBOUND(u_out%toSCglob,1),UBOUND(u_out%toSCglob,1) - b = (t(3)**2*(u1%toSCglob(i1) - u2%toSCglob(i1)) + t(2)**2*(-u1%toSCglob(i1) + u3%toSCglob(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%toSCglob(i1) + t(3)*u2%toSCglob(i1) - t(2)*u3%toSCglob(i1) ) * scaleFactor - u_out%toSCglob(i1) = u1%toSCglob(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN - DO i1 = LBOUND(u_out%toSC,1),UBOUND(u_out%toSC,1) - b = (t(3)**2*(u1%toSC(i1) - u2%toSC(i1)) + t(2)**2*(-u1%toSC(i1) + u3%toSC(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%toSC(i1) + t(3)*u2%toSC(i1) - t(2)*u3%toSC(i1) ) * scaleFactor - u_out%toSC(i1) = u1%toSC(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SC_Input_ExtrapInterp2 - - - SUBROUTINE SC_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(SC_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SC_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(u_out%toSCglob) .AND. ASSOCIATED(u1%toSCglob)) THEN + u_out%toSCglob = a1*u1%toSCglob + a2*u2%toSCglob + a3*u3%toSCglob + END IF ! check if allocated + IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN + u_out%toSC = a1*u1%toSC + a2*u2%toSC + a3*u3%toSC + END IF ! check if allocated +END SUBROUTINE + +subroutine SC_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(SC_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(SC_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 = 'SC_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 SC_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SC_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 SC_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 SC_Output_ExtrapInterp - - - SUBROUTINE SC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SC_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SC_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SC_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SC_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. @@ -3070,53 +1962,48 @@ SUBROUTINE SC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(SC_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(SC_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SC_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 + TYPE(SC_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(SC_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SC_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 = 'SC_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 (ASSOCIATED(y_out%fromSCglob) .AND. ASSOCIATED(y1%fromSCglob)) THEN - DO i1 = LBOUND(y_out%fromSCglob,1),UBOUND(y_out%fromSCglob,1) - b = -(y1%fromSCglob(i1) - y2%fromSCglob(i1)) - y_out%fromSCglob(i1) = y1%fromSCglob(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN - DO i1 = LBOUND(y_out%fromSC,1),UBOUND(y_out%fromSC,1) - b = -(y1%fromSC(i1) - y2%fromSC(i1)) - y_out%fromSC(i1) = y1%fromSC(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SC_Output_ExtrapInterp1 - - - SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(y_out%fromSCglob) .AND. ASSOCIATED(y1%fromSCglob)) THEN + y_out%fromSCglob = a1*y1%fromSCglob + a2*y2%fromSCglob + END IF ! check if allocated + IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN + y_out%fromSC = a1*y1%fromSC + a2*y2%fromSC + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SC_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. @@ -3130,61 +2017,53 @@ SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(SC_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(SC_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(SC_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SC_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 + TYPE(SC_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(SC_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(SC_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SC_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 = 'SC_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SC_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 + 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 + 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 + 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 (ASSOCIATED(y_out%fromSCglob) .AND. ASSOCIATED(y1%fromSCglob)) THEN - DO i1 = LBOUND(y_out%fromSCglob,1),UBOUND(y_out%fromSCglob,1) - b = (t(3)**2*(y1%fromSCglob(i1) - y2%fromSCglob(i1)) + t(2)**2*(-y1%fromSCglob(i1) + y3%fromSCglob(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%fromSCglob(i1) + t(3)*y2%fromSCglob(i1) - t(2)*y3%fromSCglob(i1) ) * scaleFactor - y_out%fromSCglob(i1) = y1%fromSCglob(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN - DO i1 = LBOUND(y_out%fromSC,1),UBOUND(y_out%fromSC,1) - b = (t(3)**2*(y1%fromSC(i1) - y2%fromSC(i1)) + t(2)**2*(-y1%fromSC(i1) + y3%fromSC(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%fromSC(i1) + t(3)*y2%fromSC(i1) - t(2)*y3%fromSC(i1) ) * scaleFactor - y_out%fromSC(i1) = y1%fromSC(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SC_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(y_out%fromSCglob) .AND. ASSOCIATED(y1%fromSCglob)) THEN + y_out%fromSCglob = a1*y1%fromSCglob + a2*y2%fromSCglob + a3*y3%fromSCglob + END IF ! check if allocated + IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN + y_out%fromSC = a1*y1%fromSC + a2*y2%fromSC + a3*y3%fromSC + END IF ! check if allocated +END SUBROUTINE END MODULE SuperController_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index a637d846de..61bfb7e301 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -42,38 +42,38 @@ MODULE WakeDynamics_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_Wake_Cartesian = 3 ! Wake model [-] ! ========= WD_InputFileType ======= TYPE, PUBLIC :: WD_InputFileType - REAL(ReKi) :: dr !< Radial increment of radial finite-difference grid [>0.0] [m] - INTEGER(IntKi) :: NumRadii !< Number of radii in the radial finite-difference grid [>=2] [-] - INTEGER(IntKi) :: NumPlanes !< Number of wake planes [>=2] [-] - INTEGER(IntKi) :: Mod_Wake !< Switch between wake formulations 1=Polar, 2=Cartesian, 3=Curl [-] - REAL(ReKi) :: f_c !< Cut-off frequency of the low-pass time-filter for the wake advection, deflection, and meandering model [>0.0] [Hz] - REAL(ReKi) :: C_HWkDfl_O !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor [m] - REAL(ReKi) :: C_HWkDfl_OY !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor scaled with yaw error [m/rad] - REAL(ReKi) :: C_HWkDfl_x !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance [-] - REAL(ReKi) :: C_HWkDfl_xY !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance and yaw error [1/rad] - REAL(ReKi) :: C_NearWake !< Calibrated parameter for the near-wake correction [>-1.0] [-] - REAL(ReKi) :: k_vAmb !< Calibrated parameter for the influence of ambient turbulence in the eddy viscosity [>=0.0] [-] - REAL(ReKi) :: k_vShr !< Calibrated parameter for the influence of the shear layer in the eddy viscosity [>=0.0] [-] - REAL(ReKi) :: C_vAmb_DMin !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the minimum and exponential regions [>=0.0 ] [-] - REAL(ReKi) :: C_vAmb_DMax !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the exponential and maximum regions [> C_vAmb_DMin] [-] - REAL(ReKi) :: C_vAmb_FMin !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the value in the minimum region [>=0.0 and <=1.0] [-] - REAL(ReKi) :: C_vAmb_Exp !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region [> 0.0] [-] - REAL(ReKi) :: C_vShr_DMin !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the minimum and exponential regions [>=0.0] [-] - REAL(ReKi) :: C_vShr_DMax !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the exponential and maximum regions [> C_vShr_DMin] [-] - REAL(ReKi) :: C_vShr_FMin !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the value in the minimum region [>=0.0 and <=1.0] [-] - REAL(ReKi) :: C_vShr_Exp !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region [> 0.0] [-] - INTEGER(IntKi) :: Mod_WakeDiam !< Wake diameter calculation model {1: rotor diameter, 2: velocity-based, 3: mass-flux based, 4: momentum-flux based} [DEFAULT=1] [-] - REAL(ReKi) :: C_WakeDiam !< Calibrated parameter for wake diameter calculation [>0.0 and <1.0] [unused for Mod_WakeDiam=1] [-] - LOGICAL :: Swirl !< Switch to add swirl [only used if Mod_Wake=2 or 2] [-] - REAL(ReKi) :: k_VortexDecay !< Vortex decay constant for curl [-] - REAL(ReKi) :: sigma_D !< The width of the Gaussian vortices used for the curled wake model divided by diameter [-] - INTEGER(IntKi) :: NumVortices !< The number of vortices used for the curled wake model [-] - INTEGER(IntKi) :: FilterInit !< Switch to filter the initial wake plane deficit and select the number of grid points for the filter {0: no filter, 1: filter of size 1} or DEFAULT [DEFAULT=0: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wwake is 2] (switch) [-] - REAL(ReKi) :: k_vCurl !< Calibrated parameter for the eddy viscosity in curled-wake model [>=0.0] [-] - LOGICAL :: OutAllPlanes !< Output all planes [-] - LOGICAL :: WAT !< Switch for turning on and off wake-added turbulence [-] - REAL(ReKi) :: WAT_k_Def !< Calibrated parameter for the influence of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.6] [-] - REAL(ReKi) :: WAT_k_Grad !< Calibrated parameter for the influence of the radial velocity gradient of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.35] [-] + REAL(ReKi) :: dr = 0.0_ReKi !< Radial increment of radial finite-difference grid [>0.0] [m] + INTEGER(IntKi) :: NumRadii = 0_IntKi !< Number of radii in the radial finite-difference grid [>=2] [-] + INTEGER(IntKi) :: NumPlanes = 0_IntKi !< Number of wake planes [>=2] [-] + INTEGER(IntKi) :: Mod_Wake = 0_IntKi !< Switch between wake formulations 1=Polar, 2=Cartesian, 3=Curl [-] + REAL(ReKi) :: f_c = 0.0_ReKi !< Cut-off frequency of the low-pass time-filter for the wake advection, deflection, and meandering model [>0.0] [Hz] + REAL(ReKi) :: C_HWkDfl_O = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor [m] + REAL(ReKi) :: C_HWkDfl_OY = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor scaled with yaw error [m/rad] + REAL(ReKi) :: C_HWkDfl_x = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance [-] + REAL(ReKi) :: C_HWkDfl_xY = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance and yaw error [1/rad] + REAL(ReKi) :: C_NearWake = 0.0_ReKi !< Calibrated parameter for the near-wake correction [>-1.0] [-] + REAL(ReKi) :: k_vAmb = 0.0_ReKi !< Calibrated parameter for the influence of ambient turbulence in the eddy viscosity [>=0.0] [-] + REAL(ReKi) :: k_vShr = 0.0_ReKi !< Calibrated parameter for the influence of the shear layer in the eddy viscosity [>=0.0] [-] + REAL(ReKi) :: C_vAmb_DMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the minimum and exponential regions [>=0.0 ] [-] + REAL(ReKi) :: C_vAmb_DMax = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the exponential and maximum regions [> C_vAmb_DMin] [-] + REAL(ReKi) :: C_vAmb_FMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the value in the minimum region [>=0.0 and <=1.0] [-] + REAL(ReKi) :: C_vAmb_Exp = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region [> 0.0] [-] + REAL(ReKi) :: C_vShr_DMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the minimum and exponential regions [>=0.0] [-] + REAL(ReKi) :: C_vShr_DMax = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the exponential and maximum regions [> C_vShr_DMin] [-] + REAL(ReKi) :: C_vShr_FMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the value in the minimum region [>=0.0 and <=1.0] [-] + REAL(ReKi) :: C_vShr_Exp = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region [> 0.0] [-] + INTEGER(IntKi) :: Mod_WakeDiam = 0_IntKi !< Wake diameter calculation model {1: rotor diameter, 2: velocity-based, 3: mass-flux based, 4: momentum-flux based} [DEFAULT=1] [-] + REAL(ReKi) :: C_WakeDiam = 0.0_ReKi !< Calibrated parameter for wake diameter calculation [>0.0 and <1.0] [unused for Mod_WakeDiam=1] [-] + LOGICAL :: Swirl = .false. !< Switch to add swirl [only used if Mod_Wake=2 or 2] [-] + REAL(ReKi) :: k_VortexDecay = 0.0_ReKi !< Vortex decay constant for curl [-] + REAL(ReKi) :: sigma_D = 0.0_ReKi !< The width of the Gaussian vortices used for the curled wake model divided by diameter [-] + INTEGER(IntKi) :: NumVortices = 0_IntKi !< The number of vortices used for the curled wake model [-] + INTEGER(IntKi) :: FilterInit = 0_IntKi !< Switch to filter the initial wake plane deficit and select the number of grid points for the filter {0: no filter, 1: filter of size 1} or DEFAULT [DEFAULT=0: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wwake is 2] (switch) [-] + REAL(ReKi) :: k_vCurl = 0.0_ReKi !< Calibrated parameter for the eddy viscosity in curled-wake model [>=0.0] [-] + LOGICAL :: OutAllPlanes = .false. !< Output all planes [-] + LOGICAL :: WAT = .false. !< Switch for turning on and off wake-added turbulence [-] + REAL(ReKi) :: WAT_k_Def = 0.0_ReKi !< Calibrated parameter for the influence of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.6] [-] + REAL(ReKi) :: WAT_k_Grad = 0.0_ReKi !< Calibrated parameter for the influence of the radial velocity gradient of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.35] [-] END TYPE WD_InputFileType ! ======================= ! ========= WD_InitInputType ======= @@ -92,15 +92,15 @@ MODULE WakeDynamics_Types ! ======================= ! ========= WD_ContinuousStateType ======= TYPE, PUBLIC :: WD_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: DummyContState = 0.0_ReKi !< Remove this variable if you have continuous states [-] END TYPE WD_ContinuousStateType ! ======================= ! ========= WD_DiscreteStateType ======= TYPE, PUBLIC :: WD_DiscreteStateType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: xhat_plane !< Orientations of wake planes, normal to wake planes [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: YawErr_filt !< Time-filtered nacelle-yaw error at the wake planes [rad] - REAL(ReKi) :: psi_skew_filt !< Time-filtered azimuth angle from skew vertical axis [rad] - REAL(ReKi) :: chi_skew_filt !< Time-filtered inflow skew angle [rad] + REAL(ReKi) :: psi_skew_filt = 0.0_ReKi !< Time-filtered azimuth angle from skew vertical axis [rad] + REAL(ReKi) :: chi_skew_filt = 0.0_ReKi !< Time-filtered inflow skew angle [rad] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: V_plane_filt !< Time-filtered advection, deflection, and meandering velocity of wake planes [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: p_plane !< Center positions of wake planes [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: x_plane !< Downwind distance from rotor to each wake plane [m] @@ -112,19 +112,19 @@ MODULE WakeDynamics_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vx_wind_disk_filt !< Time-filtered rotor-disk-averaged ambient wind speed of wake planes, normal to planes [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TI_amb_filt !< Time-filtered ambient turbulence intensity of wind at wake planes [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: D_rotor_filt !< Time-filtered rotor diameter associated with each wake plane [m] - REAL(ReKi) :: Vx_rel_disk_filt !< Time-filtered rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] + REAL(ReKi) :: Vx_rel_disk_filt = 0.0_ReKi !< Time-filtered rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Ct_azavg_filt !< Time-filtered azimuthally averaged thrust force coefficient (normal to disk), distributed radially [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Cq_azavg_filt !< Time-filtered azimuthally averaged torque coefficient (normal to disk), distributed radially [-] END TYPE WD_DiscreteStateType ! ======================= ! ========= WD_ConstraintStateType ======= TYPE, PUBLIC :: WD_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE WD_ConstraintStateType ! ======================= ! ========= WD_OtherStateType ======= TYPE, PUBLIC :: WD_OtherStateType - LOGICAL :: firstPass !< Flag indicating whether or not the states have been initialized with proper inputs [-] + LOGICAL :: firstPass = .false. !< Flag indicating whether or not the states have been initialized with proper inputs [-] END TYPE WD_OtherStateType ! ======================= ! ========= WD_MiscVarType ======= @@ -150,66 +150,66 @@ MODULE WakeDynamics_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vx_high !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vx_polar !< Vx as function of r for Cartesian implementation [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vt_wake !< Vr as function of r for Cartesian implementation [-] - REAL(ReKi) :: GammaCurl !< Circulation used in Curled wake model [-] - REAL(ReKi) :: Ct_avg !< Circulation used in Curled wake model [-] + REAL(ReKi) :: GammaCurl = 0.0_ReKi !< Circulation used in Curled wake model [-] + REAL(ReKi) :: Ct_avg = 0.0_ReKi !< Circulation used in Curled wake model [-] END TYPE WD_MiscVarType ! ======================= ! ========= WD_ParameterType ======= TYPE, PUBLIC :: WD_ParameterType - REAL(DbKi) :: dt_low !< Time interval for wake dynamics calculations {or default} [s] - INTEGER(IntKi) :: NumPlanes !< Number of wake planes [-] - INTEGER(IntKi) :: NumRadii !< Number of radii in the radial finite-difference grid [-] - REAL(ReKi) :: dr !< Radial increment of radial finite-difference grid [m] + REAL(DbKi) :: dt_low = 0.0_R8Ki !< Time interval for wake dynamics calculations {or default} [s] + INTEGER(IntKi) :: NumPlanes = 0_IntKi !< Number of wake planes [-] + INTEGER(IntKi) :: NumRadii = 0_IntKi !< Number of radii in the radial finite-difference grid [-] + REAL(ReKi) :: dr = 0.0_ReKi !< Radial increment of radial finite-difference grid [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: r !< Discretization of radial finite-difference grid [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y !< Horizontal discretization of each wake plane (size ny=2nr-1) [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: z !< Nomically-vertical discretization of each wake plane (size nz=2nr-1) [m] - INTEGER(IntKi) :: Mod_Wake !< Switch between wake formulations 1=Polar, 2=Curl, 3=Cartesian [-] - LOGICAL :: Swirl !< Switch to add swirl [only used if Mod_Wake=2 or 2] [-] - REAL(ReKi) :: k_VortexDecay !< Vortex decay constant for curl [-] - REAL(ReKi) :: sigma_D !< The width of the Gaussian vortices used for the curled wake model divided by diameter [-] - INTEGER(IntKi) :: NumVortices !< The number of vortices used for the curled wake model [-] - REAL(ReKi) :: filtParam !< Low-pass time-filter parameter, with a value between 0 (minimum filtering) and 1 (maximum filtering) (exclusive) [-] - REAL(ReKi) :: oneMinusFiltParam !< 1.0 - filtParam [-] - REAL(ReKi) :: C_HWkDfl_O !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor [m] - REAL(ReKi) :: C_HWkDfl_OY !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor scaled with yaw error [m/rad] - REAL(ReKi) :: C_HWkDfl_x !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance [-] - REAL(ReKi) :: C_HWkDfl_xY !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance and yaw error [1/rad] - REAL(ReKi) :: C_NearWake !< Calibrated parameter for near-wake correction [-] - REAL(ReKi) :: C_vAmb_DMin !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the minimum and exponential regions [-] - REAL(ReKi) :: C_vAmb_DMax !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the exponential and maximum regions [-] - REAL(ReKi) :: C_vAmb_FMin !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the functional value in the minimum region [-] - REAL(ReKi) :: C_vAmb_Exp !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region [-] - REAL(ReKi) :: C_vShr_DMin !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the minimum and exponential regions [-] - REAL(ReKi) :: C_vShr_DMax !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the exponential and maximum regions [-] - REAL(ReKi) :: C_vShr_FMin !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the functional value in the minimum region [-] - REAL(ReKi) :: C_vShr_Exp !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region [-] - REAL(ReKi) :: k_vAmb !< Calibrated parameter for the influence of ambient turbulence in the eddy viscosity [-] - REAL(ReKi) :: k_vShr !< Calibrated parameter for the influence of the shear layer in the eddy viscosity [-] - INTEGER(IntKi) :: Mod_WakeDiam !< Wake diameter calculation model [-] - REAL(ReKi) :: C_WakeDiam !< Calibrated parameter for wake diameter calculation [-] - INTEGER(IntKi) :: FilterInit !< Switch to filter the initial wake plane deficit and select the number of grid points for the filter {0: no filter, 1: filter of size 1} or DEFAULT [DEFAULT=0: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wwake is 2] (switch) [-] - REAL(ReKi) :: k_vCurl !< Calibrated parameter for the eddy viscosity in curled-wake model [>=0.0] [-] - LOGICAL :: OutAllPlanes !< Output all planes [-] + INTEGER(IntKi) :: Mod_Wake = 0_IntKi !< Switch between wake formulations 1=Polar, 2=Curl, 3=Cartesian [-] + LOGICAL :: Swirl = .false. !< Switch to add swirl [only used if Mod_Wake=2 or 2] [-] + REAL(ReKi) :: k_VortexDecay = 0.0_ReKi !< Vortex decay constant for curl [-] + REAL(ReKi) :: sigma_D = 0.0_ReKi !< The width of the Gaussian vortices used for the curled wake model divided by diameter [-] + INTEGER(IntKi) :: NumVortices = 0_IntKi !< The number of vortices used for the curled wake model [-] + REAL(ReKi) :: filtParam = 0.0_ReKi !< Low-pass time-filter parameter, with a value between 0 (minimum filtering) and 1 (maximum filtering) (exclusive) [-] + REAL(ReKi) :: oneMinusFiltParam = 0.0_ReKi !< 1.0 - filtParam [-] + REAL(ReKi) :: C_HWkDfl_O = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor [m] + REAL(ReKi) :: C_HWkDfl_OY = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor scaled with yaw error [m/rad] + REAL(ReKi) :: C_HWkDfl_x = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance [-] + REAL(ReKi) :: C_HWkDfl_xY = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance and yaw error [1/rad] + REAL(ReKi) :: C_NearWake = 0.0_ReKi !< Calibrated parameter for near-wake correction [-] + REAL(ReKi) :: C_vAmb_DMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the minimum and exponential regions [-] + REAL(ReKi) :: C_vAmb_DMax = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the exponential and maximum regions [-] + REAL(ReKi) :: C_vAmb_FMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the functional value in the minimum region [-] + REAL(ReKi) :: C_vAmb_Exp = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region [-] + REAL(ReKi) :: C_vShr_DMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the minimum and exponential regions [-] + REAL(ReKi) :: C_vShr_DMax = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the exponential and maximum regions [-] + REAL(ReKi) :: C_vShr_FMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the functional value in the minimum region [-] + REAL(ReKi) :: C_vShr_Exp = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region [-] + REAL(ReKi) :: k_vAmb = 0.0_ReKi !< Calibrated parameter for the influence of ambient turbulence in the eddy viscosity [-] + REAL(ReKi) :: k_vShr = 0.0_ReKi !< Calibrated parameter for the influence of the shear layer in the eddy viscosity [-] + INTEGER(IntKi) :: Mod_WakeDiam = 0_IntKi !< Wake diameter calculation model [-] + REAL(ReKi) :: C_WakeDiam = 0.0_ReKi !< Calibrated parameter for wake diameter calculation [-] + INTEGER(IntKi) :: FilterInit = 0_IntKi !< Switch to filter the initial wake plane deficit and select the number of grid points for the filter {0: no filter, 1: filter of size 1} or DEFAULT [DEFAULT=0: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wwake is 2] (switch) [-] + REAL(ReKi) :: k_vCurl = 0.0_ReKi !< Calibrated parameter for the eddy viscosity in curled-wake model [>=0.0] [-] + LOGICAL :: OutAllPlanes = .false. !< Output all planes [-] CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] CHARACTER(1024) :: OutFileVTKDir !< The parent directory for all VTK files written by WD [-] INTEGER(IntKi) :: TurbNum = 0 !< Turbine ID number (start with 1; end with number of turbines) [-] - LOGICAL :: WAT !< Switch for turning on and off wake-added turbulence [-] - REAL(ReKi) :: WAT_k_Def !< Calibrated parameter for the influence of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.6] [-] - REAL(ReKi) :: WAT_k_Grad !< Calibrated parameter for the influence of the radial velocity gradient of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.35] [-] + LOGICAL :: WAT = .false. !< Switch for turning on and off wake-added turbulence [-] + REAL(ReKi) :: WAT_k_Def = 0.0_ReKi !< Calibrated parameter for the influence of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.6] [-] + REAL(ReKi) :: WAT_k_Grad = 0.0_ReKi !< Calibrated parameter for the influence of the radial velocity gradient of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.35] [-] END TYPE WD_ParameterType ! ======================= ! ========= WD_InputType ======= TYPE, PUBLIC :: WD_InputType - REAL(ReKi) , DIMENSION(1:3) :: xhat_disk !< Orientation of rotor centerline, normal to disk [-] - REAL(ReKi) :: YawErr !< Nacelle-yaw error at the wake planes [rad] - REAL(ReKi) :: psi_skew !< Azimuth angle from the nominally vertical axis in the disk plane to the vector about which the inflow skew angle is defined [rad] - REAL(ReKi) :: chi_skew !< Inflow skew angle [rad] - REAL(ReKi) , DIMENSION(1:3) :: p_hub !< Center position of hub [m] + REAL(ReKi) , DIMENSION(1:3) :: xhat_disk = 0.0_ReKi !< Orientation of rotor centerline, normal to disk [-] + REAL(ReKi) :: YawErr = 0.0_ReKi !< Nacelle-yaw error at the wake planes [rad] + REAL(ReKi) :: psi_skew = 0.0_ReKi !< Azimuth angle from the nominally vertical axis in the disk plane to the vector about which the inflow skew angle is defined [rad] + REAL(ReKi) :: chi_skew = 0.0_ReKi !< Inflow skew angle [rad] + REAL(ReKi) , DIMENSION(1:3) :: p_hub = 0.0_ReKi !< Center position of hub [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: V_plane !< Advection, deflection, and meandering velocity of wake planes [m/s] - REAL(ReKi) :: Vx_wind_disk !< Rotor-disk-averaged ambient wind speed, normal to planes [m/s] - REAL(ReKi) :: TI_amb !< Ambient turbulence intensity of wind at rotor disk [-] - REAL(ReKi) :: D_rotor !< Rotor diameter [m] - REAL(ReKi) :: Vx_rel_disk !< Rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] + REAL(ReKi) :: Vx_wind_disk = 0.0_ReKi !< Rotor-disk-averaged ambient wind speed, normal to planes [m/s] + REAL(ReKi) :: TI_amb = 0.0_ReKi !< Ambient turbulence intensity of wind at rotor disk [-] + REAL(ReKi) :: D_rotor = 0.0_ReKi !< Rotor diameter [m] + REAL(ReKi) :: Vx_rel_disk = 0.0_ReKi !< Rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Ct_azavg !< Azimuthally averaged thrust force coefficient (normal to disk), distributed radially [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Cq_azavg !< Azimuthally averaged torque coefficient (normal to disk), distributed radially [-] END TYPE WD_InputType @@ -229,5480 +229,2629 @@ MODULE WakeDynamics_Types END TYPE WD_OutputType ! ======================= CONTAINS - SUBROUTINE WD_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_InputFileType), INTENT(IN) :: SrcInputFileTypeData - TYPE(WD_InputFileType), INTENT(INOUT) :: DstInputFileTypeData - 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 = 'WD_CopyInputFileType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileTypeData%dr = SrcInputFileTypeData%dr - DstInputFileTypeData%NumRadii = SrcInputFileTypeData%NumRadii - DstInputFileTypeData%NumPlanes = SrcInputFileTypeData%NumPlanes - DstInputFileTypeData%Mod_Wake = SrcInputFileTypeData%Mod_Wake - DstInputFileTypeData%f_c = SrcInputFileTypeData%f_c - DstInputFileTypeData%C_HWkDfl_O = SrcInputFileTypeData%C_HWkDfl_O - DstInputFileTypeData%C_HWkDfl_OY = SrcInputFileTypeData%C_HWkDfl_OY - DstInputFileTypeData%C_HWkDfl_x = SrcInputFileTypeData%C_HWkDfl_x - DstInputFileTypeData%C_HWkDfl_xY = SrcInputFileTypeData%C_HWkDfl_xY - DstInputFileTypeData%C_NearWake = SrcInputFileTypeData%C_NearWake - DstInputFileTypeData%k_vAmb = SrcInputFileTypeData%k_vAmb - DstInputFileTypeData%k_vShr = SrcInputFileTypeData%k_vShr - DstInputFileTypeData%C_vAmb_DMin = SrcInputFileTypeData%C_vAmb_DMin - DstInputFileTypeData%C_vAmb_DMax = SrcInputFileTypeData%C_vAmb_DMax - DstInputFileTypeData%C_vAmb_FMin = SrcInputFileTypeData%C_vAmb_FMin - DstInputFileTypeData%C_vAmb_Exp = SrcInputFileTypeData%C_vAmb_Exp - DstInputFileTypeData%C_vShr_DMin = SrcInputFileTypeData%C_vShr_DMin - DstInputFileTypeData%C_vShr_DMax = SrcInputFileTypeData%C_vShr_DMax - DstInputFileTypeData%C_vShr_FMin = SrcInputFileTypeData%C_vShr_FMin - DstInputFileTypeData%C_vShr_Exp = SrcInputFileTypeData%C_vShr_Exp - DstInputFileTypeData%Mod_WakeDiam = SrcInputFileTypeData%Mod_WakeDiam - DstInputFileTypeData%C_WakeDiam = SrcInputFileTypeData%C_WakeDiam - DstInputFileTypeData%Swirl = SrcInputFileTypeData%Swirl - DstInputFileTypeData%k_VortexDecay = SrcInputFileTypeData%k_VortexDecay - DstInputFileTypeData%sigma_D = SrcInputFileTypeData%sigma_D - DstInputFileTypeData%NumVortices = SrcInputFileTypeData%NumVortices - DstInputFileTypeData%FilterInit = SrcInputFileTypeData%FilterInit - DstInputFileTypeData%k_vCurl = SrcInputFileTypeData%k_vCurl - DstInputFileTypeData%OutAllPlanes = SrcInputFileTypeData%OutAllPlanes - DstInputFileTypeData%WAT = SrcInputFileTypeData%WAT - DstInputFileTypeData%WAT_k_Def = SrcInputFileTypeData%WAT_k_Def - DstInputFileTypeData%WAT_k_Grad = SrcInputFileTypeData%WAT_k_Grad - END SUBROUTINE WD_CopyInputFileType - - SUBROUTINE WD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) - TYPE(WD_InputFileType), INTENT(INOUT) :: InputFileTypeData - 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 = 'WD_DestroyInputFileType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE WD_DestroyInputFileType - - SUBROUTINE WD_PackInputFileType( 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(WD_InputFileType), 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 = 'WD_PackInputFileType' - ! 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 ! dr - Int_BufSz = Int_BufSz + 1 ! NumRadii - Int_BufSz = Int_BufSz + 1 ! NumPlanes - Int_BufSz = Int_BufSz + 1 ! Mod_Wake - Re_BufSz = Re_BufSz + 1 ! f_c - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_O - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_OY - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_x - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_xY - Re_BufSz = Re_BufSz + 1 ! C_NearWake - Re_BufSz = Re_BufSz + 1 ! k_vAmb - Re_BufSz = Re_BufSz + 1 ! k_vShr - Re_BufSz = Re_BufSz + 1 ! C_vAmb_DMin - Re_BufSz = Re_BufSz + 1 ! C_vAmb_DMax - Re_BufSz = Re_BufSz + 1 ! C_vAmb_FMin - Re_BufSz = Re_BufSz + 1 ! C_vAmb_Exp - Re_BufSz = Re_BufSz + 1 ! C_vShr_DMin - Re_BufSz = Re_BufSz + 1 ! C_vShr_DMax - Re_BufSz = Re_BufSz + 1 ! C_vShr_FMin - Re_BufSz = Re_BufSz + 1 ! C_vShr_Exp - Int_BufSz = Int_BufSz + 1 ! Mod_WakeDiam - Re_BufSz = Re_BufSz + 1 ! C_WakeDiam - Int_BufSz = Int_BufSz + 1 ! Swirl - Re_BufSz = Re_BufSz + 1 ! k_VortexDecay - Re_BufSz = Re_BufSz + 1 ! sigma_D - Int_BufSz = Int_BufSz + 1 ! NumVortices - Int_BufSz = Int_BufSz + 1 ! FilterInit - Re_BufSz = Re_BufSz + 1 ! k_vCurl - Int_BufSz = Int_BufSz + 1 ! OutAllPlanes - Int_BufSz = Int_BufSz + 1 ! WAT - Re_BufSz = Re_BufSz + 1 ! WAT_k_Def - Re_BufSz = Re_BufSz + 1 ! WAT_k_Grad - 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%dr - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumRadii - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPlanes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_Wake - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%f_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_O - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_OY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_x - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_xY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_NearWake - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vAmb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vShr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_DMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_DMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_FMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_Exp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_DMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_DMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_FMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_Exp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_WakeDiam - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_WakeDiam - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Swirl, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_VortexDecay - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%sigma_D - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumVortices - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FilterInit - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vCurl - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAllPlanes, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WAT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WAT_k_Def - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WAT_k_Grad - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_PackInputFileType - - SUBROUTINE WD_UnPackInputFileType( 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(WD_InputFileType), 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 = 'WD_UnPackInputFileType' - ! 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%dr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumRadii = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPlanes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Mod_Wake = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%f_c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_O = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_OY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_x = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_xY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_NearWake = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_vAmb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_vShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_DMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_DMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_FMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_Exp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_DMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_DMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_FMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_Exp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Mod_WakeDiam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_WakeDiam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Swirl = TRANSFER(IntKiBuf(Int_Xferred), OutData%Swirl) - Int_Xferred = Int_Xferred + 1 - OutData%k_VortexDecay = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%sigma_D = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumVortices = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FilterInit = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%k_vCurl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%OutAllPlanes = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAllPlanes) - Int_Xferred = Int_Xferred + 1 - OutData%WAT = TRANSFER(IntKiBuf(Int_Xferred), OutData%WAT) - Int_Xferred = Int_Xferred + 1 - OutData%WAT_k_Def = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WAT_k_Grad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_UnPackInputFileType - - SUBROUTINE WD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(WD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyInitInput' -! +subroutine WD_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(WD_InputFileType), intent(in) :: SrcInputFileTypeData + type(WD_InputFileType), intent(inout) :: DstInputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_CopyInputFileType' ErrStat = ErrID_None - ErrMsg = "" - CALL WD_Copyinputfiletype( SrcInitInputData%InputFileData, DstInitInputData%InputFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%TurbNum = SrcInitInputData%TurbNum - DstInitInputData%OutFileRoot = SrcInitInputData%OutFileRoot - END SUBROUTINE WD_CopyInitInput - - SUBROUTINE WD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(WD_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 = 'WD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL WD_DestroyInputFileType( InitInputData%InputFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WD_DestroyInitInput - - SUBROUTINE WD_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(WD_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 = 'WD_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InputFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InputFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InputFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! TurbNum - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - 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 - - 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 - - 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%TurbNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE WD_PackInitInput - - SUBROUTINE WD_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(WD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_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 - 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 WD_UnpackInputFileType( Re_Buf, Db_Buf, Int_Buf, OutData%InputFileData, ErrStat2, ErrMsg2 ) ! InputFileData - 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%TurbNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE WD_UnPackInitInput - - SUBROUTINE WD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(WD_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 = 'WD_CopyInitOutput' -! + ErrMsg = '' + DstInputFileTypeData%dr = SrcInputFileTypeData%dr + DstInputFileTypeData%NumRadii = SrcInputFileTypeData%NumRadii + DstInputFileTypeData%NumPlanes = SrcInputFileTypeData%NumPlanes + DstInputFileTypeData%Mod_Wake = SrcInputFileTypeData%Mod_Wake + DstInputFileTypeData%f_c = SrcInputFileTypeData%f_c + DstInputFileTypeData%C_HWkDfl_O = SrcInputFileTypeData%C_HWkDfl_O + DstInputFileTypeData%C_HWkDfl_OY = SrcInputFileTypeData%C_HWkDfl_OY + DstInputFileTypeData%C_HWkDfl_x = SrcInputFileTypeData%C_HWkDfl_x + DstInputFileTypeData%C_HWkDfl_xY = SrcInputFileTypeData%C_HWkDfl_xY + DstInputFileTypeData%C_NearWake = SrcInputFileTypeData%C_NearWake + DstInputFileTypeData%k_vAmb = SrcInputFileTypeData%k_vAmb + DstInputFileTypeData%k_vShr = SrcInputFileTypeData%k_vShr + DstInputFileTypeData%C_vAmb_DMin = SrcInputFileTypeData%C_vAmb_DMin + DstInputFileTypeData%C_vAmb_DMax = SrcInputFileTypeData%C_vAmb_DMax + DstInputFileTypeData%C_vAmb_FMin = SrcInputFileTypeData%C_vAmb_FMin + DstInputFileTypeData%C_vAmb_Exp = SrcInputFileTypeData%C_vAmb_Exp + DstInputFileTypeData%C_vShr_DMin = SrcInputFileTypeData%C_vShr_DMin + DstInputFileTypeData%C_vShr_DMax = SrcInputFileTypeData%C_vShr_DMax + DstInputFileTypeData%C_vShr_FMin = SrcInputFileTypeData%C_vShr_FMin + DstInputFileTypeData%C_vShr_Exp = SrcInputFileTypeData%C_vShr_Exp + DstInputFileTypeData%Mod_WakeDiam = SrcInputFileTypeData%Mod_WakeDiam + DstInputFileTypeData%C_WakeDiam = SrcInputFileTypeData%C_WakeDiam + DstInputFileTypeData%Swirl = SrcInputFileTypeData%Swirl + DstInputFileTypeData%k_VortexDecay = SrcInputFileTypeData%k_VortexDecay + DstInputFileTypeData%sigma_D = SrcInputFileTypeData%sigma_D + DstInputFileTypeData%NumVortices = SrcInputFileTypeData%NumVortices + DstInputFileTypeData%FilterInit = SrcInputFileTypeData%FilterInit + DstInputFileTypeData%k_vCurl = SrcInputFileTypeData%k_vCurl + DstInputFileTypeData%OutAllPlanes = SrcInputFileTypeData%OutAllPlanes + DstInputFileTypeData%WAT = SrcInputFileTypeData%WAT + DstInputFileTypeData%WAT_k_Def = SrcInputFileTypeData%WAT_k_Def + DstInputFileTypeData%WAT_k_Grad = SrcInputFileTypeData%WAT_k_Grad +end subroutine + +subroutine WD_DestroyInputFileType(InputFileTypeData, ErrStat, ErrMsg) + type(WD_InputFileType), intent(inout) :: InputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyInputFileType' 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 - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WD_CopyInitOutput - - SUBROUTINE WD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(WD_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 = 'WD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WD_DestroyInitOutput - - SUBROUTINE WD_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(WD_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 = 'WD_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 - ! 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - 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 - - 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 - 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 - - 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 WD_PackInitOutput - - SUBROUTINE WD_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(WD_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 = 'WD_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) - END SUBROUTINE WD_UnPackInitOutput - - SUBROUTINE WD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(WD_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 = 'WD_CopyContState' -! + ErrMsg = '' +end subroutine + +subroutine WD_PackInputFileType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_InputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackInputFileType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dr) + call RegPack(Buf, InData%NumRadii) + call RegPack(Buf, InData%NumPlanes) + call RegPack(Buf, InData%Mod_Wake) + call RegPack(Buf, InData%f_c) + call RegPack(Buf, InData%C_HWkDfl_O) + call RegPack(Buf, InData%C_HWkDfl_OY) + call RegPack(Buf, InData%C_HWkDfl_x) + call RegPack(Buf, InData%C_HWkDfl_xY) + call RegPack(Buf, InData%C_NearWake) + call RegPack(Buf, InData%k_vAmb) + call RegPack(Buf, InData%k_vShr) + call RegPack(Buf, InData%C_vAmb_DMin) + call RegPack(Buf, InData%C_vAmb_DMax) + call RegPack(Buf, InData%C_vAmb_FMin) + call RegPack(Buf, InData%C_vAmb_Exp) + call RegPack(Buf, InData%C_vShr_DMin) + call RegPack(Buf, InData%C_vShr_DMax) + call RegPack(Buf, InData%C_vShr_FMin) + call RegPack(Buf, InData%C_vShr_Exp) + call RegPack(Buf, InData%Mod_WakeDiam) + call RegPack(Buf, InData%C_WakeDiam) + call RegPack(Buf, InData%Swirl) + call RegPack(Buf, InData%k_VortexDecay) + call RegPack(Buf, InData%sigma_D) + call RegPack(Buf, InData%NumVortices) + call RegPack(Buf, InData%FilterInit) + call RegPack(Buf, InData%k_vCurl) + call RegPack(Buf, InData%OutAllPlanes) + call RegPack(Buf, InData%WAT) + call RegPack(Buf, InData%WAT_k_Def) + call RegPack(Buf, InData%WAT_k_Grad) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackInputFileType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_InputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackInputFileType' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumRadii) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumPlanes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Mod_Wake) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%f_c) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_HWkDfl_O) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_HWkDfl_OY) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_HWkDfl_x) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_HWkDfl_xY) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_NearWake) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k_vAmb) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k_vShr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vAmb_DMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vAmb_DMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vAmb_FMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vAmb_Exp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vShr_DMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vShr_DMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vShr_FMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vShr_Exp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Mod_WakeDiam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_WakeDiam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Swirl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k_VortexDecay) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%sigma_D) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumVortices) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FilterInit) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k_vCurl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutAllPlanes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WAT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WAT_k_Def) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WAT_k_Grad) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(WD_InitInputType), intent(in) :: SrcInitInputData + type(WD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WD_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE WD_CopyContState - - SUBROUTINE WD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(WD_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 = 'WD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE WD_DestroyContState - - SUBROUTINE WD_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(WD_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 = 'WD_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 WD_PackContState - - SUBROUTINE WD_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(WD_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 = 'WD_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_UnPackContState - - SUBROUTINE WD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(WD_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) :: 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_CopyDiscState' -! + ErrMsg = '' + call WD_CopyInputFileType(SrcInitInputData%InputFileData, DstInitInputData%InputFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%TurbNum = SrcInitInputData%TurbNum + DstInitInputData%OutFileRoot = SrcInitInputData%OutFileRoot +end subroutine + +subroutine WD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(WD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WD_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%xhat_plane)) THEN - i1_l = LBOUND(SrcDiscStateData%xhat_plane,1) - i1_u = UBOUND(SrcDiscStateData%xhat_plane,1) - i2_l = LBOUND(SrcDiscStateData%xhat_plane,2) - i2_u = UBOUND(SrcDiscStateData%xhat_plane,2) - IF (.NOT. ALLOCATED(DstDiscStateData%xhat_plane)) THEN - ALLOCATE(DstDiscStateData%xhat_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%xhat_plane = SrcDiscStateData%xhat_plane -ENDIF -IF (ALLOCATED(SrcDiscStateData%YawErr_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%YawErr_filt,1) - i1_u = UBOUND(SrcDiscStateData%YawErr_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%YawErr_filt)) THEN - ALLOCATE(DstDiscStateData%YawErr_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%YawErr_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%YawErr_filt = SrcDiscStateData%YawErr_filt -ENDIF - DstDiscStateData%psi_skew_filt = SrcDiscStateData%psi_skew_filt - DstDiscStateData%chi_skew_filt = SrcDiscStateData%chi_skew_filt -IF (ALLOCATED(SrcDiscStateData%V_plane_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%V_plane_filt,1) - i1_u = UBOUND(SrcDiscStateData%V_plane_filt,1) - i2_l = LBOUND(SrcDiscStateData%V_plane_filt,2) - i2_u = UBOUND(SrcDiscStateData%V_plane_filt,2) - IF (.NOT. ALLOCATED(DstDiscStateData%V_plane_filt)) THEN - ALLOCATE(DstDiscStateData%V_plane_filt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%V_plane_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%V_plane_filt = SrcDiscStateData%V_plane_filt -ENDIF -IF (ALLOCATED(SrcDiscStateData%p_plane)) THEN - i1_l = LBOUND(SrcDiscStateData%p_plane,1) - i1_u = UBOUND(SrcDiscStateData%p_plane,1) - i2_l = LBOUND(SrcDiscStateData%p_plane,2) - i2_u = UBOUND(SrcDiscStateData%p_plane,2) - IF (.NOT. ALLOCATED(DstDiscStateData%p_plane)) THEN - ALLOCATE(DstDiscStateData%p_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%p_plane = SrcDiscStateData%p_plane -ENDIF -IF (ALLOCATED(SrcDiscStateData%x_plane)) THEN - i1_l = LBOUND(SrcDiscStateData%x_plane,1) - i1_u = UBOUND(SrcDiscStateData%x_plane,1) - IF (.NOT. ALLOCATED(DstDiscStateData%x_plane)) THEN - ALLOCATE(DstDiscStateData%x_plane(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%x_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%x_plane = SrcDiscStateData%x_plane -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vx_wake)) THEN - i1_l = LBOUND(SrcDiscStateData%Vx_wake,1) - i1_u = UBOUND(SrcDiscStateData%Vx_wake,1) - i2_l = LBOUND(SrcDiscStateData%Vx_wake,2) - i2_u = UBOUND(SrcDiscStateData%Vx_wake,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Vx_wake)) THEN - ALLOCATE(DstDiscStateData%Vx_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vx_wake = SrcDiscStateData%Vx_wake -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vr_wake)) THEN - i1_l = LBOUND(SrcDiscStateData%Vr_wake,1) - i1_u = UBOUND(SrcDiscStateData%Vr_wake,1) - i2_l = LBOUND(SrcDiscStateData%Vr_wake,2) - i2_u = UBOUND(SrcDiscStateData%Vr_wake,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Vr_wake)) THEN - ALLOCATE(DstDiscStateData%Vr_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vr_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vr_wake = SrcDiscStateData%Vr_wake -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vx_wake2)) THEN - i1_l = LBOUND(SrcDiscStateData%Vx_wake2,1) - i1_u = UBOUND(SrcDiscStateData%Vx_wake2,1) - i2_l = LBOUND(SrcDiscStateData%Vx_wake2,2) - i2_u = UBOUND(SrcDiscStateData%Vx_wake2,2) - i3_l = LBOUND(SrcDiscStateData%Vx_wake2,3) - i3_u = UBOUND(SrcDiscStateData%Vx_wake2,3) - IF (.NOT. ALLOCATED(DstDiscStateData%Vx_wake2)) THEN - ALLOCATE(DstDiscStateData%Vx_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vx_wake2 = SrcDiscStateData%Vx_wake2 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vy_wake2)) THEN - i1_l = LBOUND(SrcDiscStateData%Vy_wake2,1) - i1_u = UBOUND(SrcDiscStateData%Vy_wake2,1) - i2_l = LBOUND(SrcDiscStateData%Vy_wake2,2) - i2_u = UBOUND(SrcDiscStateData%Vy_wake2,2) - i3_l = LBOUND(SrcDiscStateData%Vy_wake2,3) - i3_u = UBOUND(SrcDiscStateData%Vy_wake2,3) - IF (.NOT. ALLOCATED(DstDiscStateData%Vy_wake2)) THEN - ALLOCATE(DstDiscStateData%Vy_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vy_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vy_wake2 = SrcDiscStateData%Vy_wake2 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vz_wake2)) THEN - i1_l = LBOUND(SrcDiscStateData%Vz_wake2,1) - i1_u = UBOUND(SrcDiscStateData%Vz_wake2,1) - i2_l = LBOUND(SrcDiscStateData%Vz_wake2,2) - i2_u = UBOUND(SrcDiscStateData%Vz_wake2,2) - i3_l = LBOUND(SrcDiscStateData%Vz_wake2,3) - i3_u = UBOUND(SrcDiscStateData%Vz_wake2,3) - IF (.NOT. ALLOCATED(DstDiscStateData%Vz_wake2)) THEN - ALLOCATE(DstDiscStateData%Vz_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vz_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vz_wake2 = SrcDiscStateData%Vz_wake2 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vx_wind_disk_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%Vx_wind_disk_filt,1) - i1_u = UBOUND(SrcDiscStateData%Vx_wind_disk_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%Vx_wind_disk_filt)) THEN - ALLOCATE(DstDiscStateData%Vx_wind_disk_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wind_disk_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vx_wind_disk_filt = SrcDiscStateData%Vx_wind_disk_filt -ENDIF -IF (ALLOCATED(SrcDiscStateData%TI_amb_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%TI_amb_filt,1) - i1_u = UBOUND(SrcDiscStateData%TI_amb_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%TI_amb_filt)) THEN - ALLOCATE(DstDiscStateData%TI_amb_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TI_amb_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%TI_amb_filt = SrcDiscStateData%TI_amb_filt -ENDIF -IF (ALLOCATED(SrcDiscStateData%D_rotor_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%D_rotor_filt,1) - i1_u = UBOUND(SrcDiscStateData%D_rotor_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%D_rotor_filt)) THEN - ALLOCATE(DstDiscStateData%D_rotor_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%D_rotor_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%D_rotor_filt = SrcDiscStateData%D_rotor_filt -ENDIF - DstDiscStateData%Vx_rel_disk_filt = SrcDiscStateData%Vx_rel_disk_filt -IF (ALLOCATED(SrcDiscStateData%Ct_azavg_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%Ct_azavg_filt,1) - i1_u = UBOUND(SrcDiscStateData%Ct_azavg_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%Ct_azavg_filt)) THEN - ALLOCATE(DstDiscStateData%Ct_azavg_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Ct_azavg_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Ct_azavg_filt = SrcDiscStateData%Ct_azavg_filt -ENDIF -IF (ALLOCATED(SrcDiscStateData%Cq_azavg_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%Cq_azavg_filt,1) - i1_u = UBOUND(SrcDiscStateData%Cq_azavg_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%Cq_azavg_filt)) THEN - ALLOCATE(DstDiscStateData%Cq_azavg_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cq_azavg_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Cq_azavg_filt = SrcDiscStateData%Cq_azavg_filt -ENDIF - END SUBROUTINE WD_CopyDiscState - - SUBROUTINE WD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(WD_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 = 'WD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%xhat_plane)) THEN - DEALLOCATE(DiscStateData%xhat_plane) -ENDIF -IF (ALLOCATED(DiscStateData%YawErr_filt)) THEN - DEALLOCATE(DiscStateData%YawErr_filt) -ENDIF -IF (ALLOCATED(DiscStateData%V_plane_filt)) THEN - DEALLOCATE(DiscStateData%V_plane_filt) -ENDIF -IF (ALLOCATED(DiscStateData%p_plane)) THEN - DEALLOCATE(DiscStateData%p_plane) -ENDIF -IF (ALLOCATED(DiscStateData%x_plane)) THEN - DEALLOCATE(DiscStateData%x_plane) -ENDIF -IF (ALLOCATED(DiscStateData%Vx_wake)) THEN - DEALLOCATE(DiscStateData%Vx_wake) -ENDIF -IF (ALLOCATED(DiscStateData%Vr_wake)) THEN - DEALLOCATE(DiscStateData%Vr_wake) -ENDIF -IF (ALLOCATED(DiscStateData%Vx_wake2)) THEN - DEALLOCATE(DiscStateData%Vx_wake2) -ENDIF -IF (ALLOCATED(DiscStateData%Vy_wake2)) THEN - DEALLOCATE(DiscStateData%Vy_wake2) -ENDIF -IF (ALLOCATED(DiscStateData%Vz_wake2)) THEN - DEALLOCATE(DiscStateData%Vz_wake2) -ENDIF -IF (ALLOCATED(DiscStateData%Vx_wind_disk_filt)) THEN - DEALLOCATE(DiscStateData%Vx_wind_disk_filt) -ENDIF -IF (ALLOCATED(DiscStateData%TI_amb_filt)) THEN - DEALLOCATE(DiscStateData%TI_amb_filt) -ENDIF -IF (ALLOCATED(DiscStateData%D_rotor_filt)) THEN - DEALLOCATE(DiscStateData%D_rotor_filt) -ENDIF -IF (ALLOCATED(DiscStateData%Ct_azavg_filt)) THEN - DEALLOCATE(DiscStateData%Ct_azavg_filt) -ENDIF -IF (ALLOCATED(DiscStateData%Cq_azavg_filt)) THEN - DEALLOCATE(DiscStateData%Cq_azavg_filt) -ENDIF - END SUBROUTINE WD_DestroyDiscState - - SUBROUTINE WD_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(WD_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 = 'WD_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 - Int_BufSz = Int_BufSz + 1 ! xhat_plane allocated yes/no - IF ( ALLOCATED(InData%xhat_plane) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xhat_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xhat_plane) ! xhat_plane - END IF - Int_BufSz = Int_BufSz + 1 ! YawErr_filt allocated yes/no - IF ( ALLOCATED(InData%YawErr_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! YawErr_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%YawErr_filt) ! YawErr_filt - END IF - Re_BufSz = Re_BufSz + 1 ! psi_skew_filt - Re_BufSz = Re_BufSz + 1 ! chi_skew_filt - Int_BufSz = Int_BufSz + 1 ! V_plane_filt allocated yes/no - IF ( ALLOCATED(InData%V_plane_filt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! V_plane_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_plane_filt) ! V_plane_filt - END IF - Int_BufSz = Int_BufSz + 1 ! p_plane allocated yes/no - IF ( ALLOCATED(InData%p_plane) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! p_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%p_plane) ! p_plane - END IF - Int_BufSz = Int_BufSz + 1 ! x_plane allocated yes/no - IF ( ALLOCATED(InData%x_plane) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%x_plane) ! x_plane - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wake allocated yes/no - IF ( ALLOCATED(InData%Vx_wake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vx_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wake) ! Vx_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vr_wake allocated yes/no - IF ( ALLOCATED(InData%Vr_wake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vr_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vr_wake) ! Vr_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vx_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vx_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wake2) ! Vx_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! Vy_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vy_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vy_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vy_wake2) ! Vy_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! Vz_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vz_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vz_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vz_wake2) ! Vz_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wind_disk_filt allocated yes/no - IF ( ALLOCATED(InData%Vx_wind_disk_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vx_wind_disk_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wind_disk_filt) ! Vx_wind_disk_filt - END IF - Int_BufSz = Int_BufSz + 1 ! TI_amb_filt allocated yes/no - IF ( ALLOCATED(InData%TI_amb_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TI_amb_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_amb_filt) ! TI_amb_filt - END IF - Int_BufSz = Int_BufSz + 1 ! D_rotor_filt allocated yes/no - IF ( ALLOCATED(InData%D_rotor_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! D_rotor_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D_rotor_filt) ! D_rotor_filt - END IF - Re_BufSz = Re_BufSz + 1 ! Vx_rel_disk_filt - Int_BufSz = Int_BufSz + 1 ! Ct_azavg_filt allocated yes/no - IF ( ALLOCATED(InData%Ct_azavg_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Ct_azavg_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Ct_azavg_filt) ! Ct_azavg_filt - END IF - Int_BufSz = Int_BufSz + 1 ! Cq_azavg_filt allocated yes/no - IF ( ALLOCATED(InData%Cq_azavg_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cq_azavg_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cq_azavg_filt) ! Cq_azavg_filt - 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%xhat_plane) ) 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%xhat_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xhat_plane,2), UBOUND(InData%xhat_plane,2) - DO i1 = LBOUND(InData%xhat_plane,1), UBOUND(InData%xhat_plane,1) - ReKiBuf(Re_Xferred) = InData%xhat_plane(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%YawErr_filt) ) 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%YawErr_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%YawErr_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%YawErr_filt,1), UBOUND(InData%YawErr_filt,1) - ReKiBuf(Re_Xferred) = InData%YawErr_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%psi_skew_filt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%chi_skew_filt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%V_plane_filt) ) 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%V_plane_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane_filt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane_filt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane_filt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%V_plane_filt,2), UBOUND(InData%V_plane_filt,2) - DO i1 = LBOUND(InData%V_plane_filt,1), UBOUND(InData%V_plane_filt,1) - ReKiBuf(Re_Xferred) = InData%V_plane_filt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%p_plane) ) 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%p_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%p_plane,2), UBOUND(InData%p_plane,2) - DO i1 = LBOUND(InData%p_plane,1), UBOUND(InData%p_plane,1) - ReKiBuf(Re_Xferred) = InData%p_plane(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_plane) ) 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%x_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_plane,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_plane,1), UBOUND(InData%x_plane,1) - ReKiBuf(Re_Xferred) = InData%x_plane(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wake) ) 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%Vx_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vx_wake,2), UBOUND(InData%Vx_wake,2) - DO i1 = LBOUND(InData%Vx_wake,1), UBOUND(InData%Vx_wake,1) - ReKiBuf(Re_Xferred) = InData%Vx_wake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vr_wake) ) 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%Vr_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vr_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vr_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vr_wake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vr_wake,2), UBOUND(InData%Vr_wake,2) - DO i1 = LBOUND(InData%Vr_wake,1), UBOUND(InData%Vr_wake,1) - ReKiBuf(Re_Xferred) = InData%Vr_wake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wake2) ) 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%Vx_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vx_wake2,3), UBOUND(InData%Vx_wake2,3) - DO i2 = LBOUND(InData%Vx_wake2,2), UBOUND(InData%Vx_wake2,2) - DO i1 = LBOUND(InData%Vx_wake2,1), UBOUND(InData%Vx_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vx_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vy_wake2) ) 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%Vy_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vy_wake2,3), UBOUND(InData%Vy_wake2,3) - DO i2 = LBOUND(InData%Vy_wake2,2), UBOUND(InData%Vy_wake2,2) - DO i1 = LBOUND(InData%Vy_wake2,1), UBOUND(InData%Vy_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vy_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vz_wake2) ) 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%Vz_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vz_wake2,3), UBOUND(InData%Vz_wake2,3) - DO i2 = LBOUND(InData%Vz_wake2,2), UBOUND(InData%Vz_wake2,2) - DO i1 = LBOUND(InData%Vz_wake2,1), UBOUND(InData%Vz_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vz_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wind_disk_filt) ) 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%Vx_wind_disk_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wind_disk_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vx_wind_disk_filt,1), UBOUND(InData%Vx_wind_disk_filt,1) - ReKiBuf(Re_Xferred) = InData%Vx_wind_disk_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI_amb_filt) ) 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%TI_amb_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_amb_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TI_amb_filt,1), UBOUND(InData%TI_amb_filt,1) - ReKiBuf(Re_Xferred) = InData%TI_amb_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D_rotor_filt) ) 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%D_rotor_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_rotor_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%D_rotor_filt,1), UBOUND(InData%D_rotor_filt,1) - ReKiBuf(Re_Xferred) = InData%D_rotor_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Vx_rel_disk_filt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Ct_azavg_filt) ) 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%Ct_azavg_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ct_azavg_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Ct_azavg_filt,1), UBOUND(InData%Ct_azavg_filt,1) - ReKiBuf(Re_Xferred) = InData%Ct_azavg_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cq_azavg_filt) ) 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%Cq_azavg_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cq_azavg_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cq_azavg_filt,1), UBOUND(InData%Cq_azavg_filt,1) - ReKiBuf(Re_Xferred) = InData%Cq_azavg_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WD_PackDiscState - - SUBROUTINE WD_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(WD_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) :: 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_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xhat_plane 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%xhat_plane)) DEALLOCATE(OutData%xhat_plane) - ALLOCATE(OutData%xhat_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xhat_plane,2), UBOUND(OutData%xhat_plane,2) - DO i1 = LBOUND(OutData%xhat_plane,1), UBOUND(OutData%xhat_plane,1) - OutData%xhat_plane(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! YawErr_filt 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%YawErr_filt)) DEALLOCATE(OutData%YawErr_filt) - ALLOCATE(OutData%YawErr_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%YawErr_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%YawErr_filt,1), UBOUND(OutData%YawErr_filt,1) - OutData%YawErr_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%psi_skew_filt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%chi_skew_filt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_plane_filt 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%V_plane_filt)) DEALLOCATE(OutData%V_plane_filt) - ALLOCATE(OutData%V_plane_filt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%V_plane_filt,2), UBOUND(OutData%V_plane_filt,2) - DO i1 = LBOUND(OutData%V_plane_filt,1), UBOUND(OutData%V_plane_filt,1) - OutData%V_plane_filt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p_plane 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%p_plane)) DEALLOCATE(OutData%p_plane) - ALLOCATE(OutData%p_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%p_plane,2), UBOUND(OutData%p_plane,2) - DO i1 = LBOUND(OutData%p_plane,1), UBOUND(OutData%p_plane,1) - OutData%p_plane(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_plane 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%x_plane)) DEALLOCATE(OutData%x_plane) - ALLOCATE(OutData%x_plane(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_plane,1), UBOUND(OutData%x_plane,1) - OutData%x_plane(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wake 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%Vx_wake)) DEALLOCATE(OutData%Vx_wake) - ALLOCATE(OutData%Vx_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vx_wake,2), UBOUND(OutData%Vx_wake,2) - DO i1 = LBOUND(OutData%Vx_wake,1), UBOUND(OutData%Vx_wake,1) - OutData%Vx_wake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vr_wake 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%Vr_wake)) DEALLOCATE(OutData%Vr_wake) - ALLOCATE(OutData%Vr_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vr_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vr_wake,2), UBOUND(OutData%Vr_wake,2) - DO i1 = LBOUND(OutData%Vr_wake,1), UBOUND(OutData%Vr_wake,1) - OutData%Vr_wake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wake2 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%Vx_wake2)) DEALLOCATE(OutData%Vx_wake2) - ALLOCATE(OutData%Vx_wake2(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%Vx_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vx_wake2,3), UBOUND(OutData%Vx_wake2,3) - DO i2 = LBOUND(OutData%Vx_wake2,2), UBOUND(OutData%Vx_wake2,2) - DO i1 = LBOUND(OutData%Vx_wake2,1), UBOUND(OutData%Vx_wake2,1) - OutData%Vx_wake2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vy_wake2 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%Vy_wake2)) DEALLOCATE(OutData%Vy_wake2) - ALLOCATE(OutData%Vy_wake2(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%Vy_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vy_wake2,3), UBOUND(OutData%Vy_wake2,3) - DO i2 = LBOUND(OutData%Vy_wake2,2), UBOUND(OutData%Vy_wake2,2) - DO i1 = LBOUND(OutData%Vy_wake2,1), UBOUND(OutData%Vy_wake2,1) - OutData%Vy_wake2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vz_wake2 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%Vz_wake2)) DEALLOCATE(OutData%Vz_wake2) - ALLOCATE(OutData%Vz_wake2(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%Vz_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vz_wake2,3), UBOUND(OutData%Vz_wake2,3) - DO i2 = LBOUND(OutData%Vz_wake2,2), UBOUND(OutData%Vz_wake2,2) - DO i1 = LBOUND(OutData%Vz_wake2,1), UBOUND(OutData%Vz_wake2,1) - OutData%Vz_wake2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wind_disk_filt 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%Vx_wind_disk_filt)) DEALLOCATE(OutData%Vx_wind_disk_filt) - ALLOCATE(OutData%Vx_wind_disk_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wind_disk_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vx_wind_disk_filt,1), UBOUND(OutData%Vx_wind_disk_filt,1) - OutData%Vx_wind_disk_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_amb_filt 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%TI_amb_filt)) DEALLOCATE(OutData%TI_amb_filt) - ALLOCATE(OutData%TI_amb_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_amb_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TI_amb_filt,1), UBOUND(OutData%TI_amb_filt,1) - OutData%TI_amb_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_rotor_filt 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%D_rotor_filt)) DEALLOCATE(OutData%D_rotor_filt) - ALLOCATE(OutData%D_rotor_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_rotor_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%D_rotor_filt,1), UBOUND(OutData%D_rotor_filt,1) - OutData%D_rotor_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Vx_rel_disk_filt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ct_azavg_filt 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%Ct_azavg_filt)) DEALLOCATE(OutData%Ct_azavg_filt) - ALLOCATE(OutData%Ct_azavg_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ct_azavg_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Ct_azavg_filt,1), UBOUND(OutData%Ct_azavg_filt,1) - OutData%Ct_azavg_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cq_azavg_filt 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%Cq_azavg_filt)) DEALLOCATE(OutData%Cq_azavg_filt) - ALLOCATE(OutData%Cq_azavg_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cq_azavg_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cq_azavg_filt,1), UBOUND(OutData%Cq_azavg_filt,1) - OutData%Cq_azavg_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WD_UnPackDiscState - - SUBROUTINE WD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(WD_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 = 'WD_CopyConstrState' -! + ErrMsg = '' + call WD_DestroyInputFileType(InitInputData%InputFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WD_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + call WD_PackInputFileType(Buf, InData%InputFileData) + call RegPack(Buf, InData%TurbNum) + call RegPack(Buf, InData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + call WD_UnpackInputFileType(Buf, OutData%InputFileData) ! InputFileData + call RegUnpack(Buf, OutData%TurbNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(WD_InitOutputType), intent(in) :: SrcInitOutputData + type(WD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WD_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE WD_CopyConstrState - - SUBROUTINE WD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(WD_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 = 'WD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE WD_DestroyConstrState - - SUBROUTINE WD_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(WD_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 = 'WD_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 WD_PackConstrState - - SUBROUTINE WD_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(WD_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 = 'WD_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_UnPackConstrState - - SUBROUTINE WD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(WD_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 = 'WD_CopyOtherState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(WD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WD_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%firstPass = SrcOtherStateData%firstPass - END SUBROUTINE WD_CopyOtherState - - SUBROUTINE WD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(WD_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 = 'WD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE WD_DestroyOtherState - - SUBROUTINE WD_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(WD_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 = 'WD_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 ! firstPass - 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) = TRANSFER(InData%firstPass, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WD_PackOtherState - - SUBROUTINE WD_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(WD_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 = 'WD_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%firstPass = TRANSFER(IntKiBuf(Int_Xferred), OutData%firstPass) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WD_UnPackOtherState - - SUBROUTINE WD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(WD_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) :: 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_CopyMisc' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WD_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine + +subroutine WD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(WD_ContinuousStateType), intent(in) :: SrcContStateData + type(WD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_CopyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%dvtdr)) THEN - i1_l = LBOUND(SrcMiscData%dvtdr,1) - i1_u = UBOUND(SrcMiscData%dvtdr,1) - IF (.NOT. ALLOCATED(DstMiscData%dvtdr)) THEN - ALLOCATE(DstMiscData%dvtdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvtdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dvtdr = SrcMiscData%dvtdr -ENDIF -IF (ALLOCATED(SrcMiscData%vt_tot)) THEN - i1_l = LBOUND(SrcMiscData%vt_tot,1) - i1_u = UBOUND(SrcMiscData%vt_tot,1) - i2_l = LBOUND(SrcMiscData%vt_tot,2) - i2_u = UBOUND(SrcMiscData%vt_tot,2) - IF (.NOT. ALLOCATED(DstMiscData%vt_tot)) THEN - ALLOCATE(DstMiscData%vt_tot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_tot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_tot = SrcMiscData%vt_tot -ENDIF -IF (ALLOCATED(SrcMiscData%vt_amb)) THEN - i1_l = LBOUND(SrcMiscData%vt_amb,1) - i1_u = UBOUND(SrcMiscData%vt_amb,1) - i2_l = LBOUND(SrcMiscData%vt_amb,2) - i2_u = UBOUND(SrcMiscData%vt_amb,2) - IF (.NOT. ALLOCATED(DstMiscData%vt_amb)) THEN - ALLOCATE(DstMiscData%vt_amb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_amb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_amb = SrcMiscData%vt_amb -ENDIF -IF (ALLOCATED(SrcMiscData%vt_shr)) THEN - i1_l = LBOUND(SrcMiscData%vt_shr,1) - i1_u = UBOUND(SrcMiscData%vt_shr,1) - i2_l = LBOUND(SrcMiscData%vt_shr,2) - i2_u = UBOUND(SrcMiscData%vt_shr,2) - IF (.NOT. ALLOCATED(DstMiscData%vt_shr)) THEN - ALLOCATE(DstMiscData%vt_shr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_shr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_shr = SrcMiscData%vt_shr -ENDIF -IF (ALLOCATED(SrcMiscData%vt_tot2)) THEN - i1_l = LBOUND(SrcMiscData%vt_tot2,1) - i1_u = UBOUND(SrcMiscData%vt_tot2,1) - i2_l = LBOUND(SrcMiscData%vt_tot2,2) - i2_u = UBOUND(SrcMiscData%vt_tot2,2) - i3_l = LBOUND(SrcMiscData%vt_tot2,3) - i3_u = UBOUND(SrcMiscData%vt_tot2,3) - IF (.NOT. ALLOCATED(DstMiscData%vt_tot2)) THEN - ALLOCATE(DstMiscData%vt_tot2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_tot2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_tot2 = SrcMiscData%vt_tot2 -ENDIF -IF (ALLOCATED(SrcMiscData%vt_amb2)) THEN - i1_l = LBOUND(SrcMiscData%vt_amb2,1) - i1_u = UBOUND(SrcMiscData%vt_amb2,1) - i2_l = LBOUND(SrcMiscData%vt_amb2,2) - i2_u = UBOUND(SrcMiscData%vt_amb2,2) - i3_l = LBOUND(SrcMiscData%vt_amb2,3) - i3_u = UBOUND(SrcMiscData%vt_amb2,3) - IF (.NOT. ALLOCATED(DstMiscData%vt_amb2)) THEN - ALLOCATE(DstMiscData%vt_amb2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_amb2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_amb2 = SrcMiscData%vt_amb2 -ENDIF -IF (ALLOCATED(SrcMiscData%vt_shr2)) THEN - i1_l = LBOUND(SrcMiscData%vt_shr2,1) - i1_u = UBOUND(SrcMiscData%vt_shr2,1) - i2_l = LBOUND(SrcMiscData%vt_shr2,2) - i2_u = UBOUND(SrcMiscData%vt_shr2,2) - i3_l = LBOUND(SrcMiscData%vt_shr2,3) - i3_u = UBOUND(SrcMiscData%vt_shr2,3) - IF (.NOT. ALLOCATED(DstMiscData%vt_shr2)) THEN - ALLOCATE(DstMiscData%vt_shr2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_shr2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_shr2 = SrcMiscData%vt_shr2 -ENDIF -IF (ALLOCATED(SrcMiscData%dvx_dy)) THEN - i1_l = LBOUND(SrcMiscData%dvx_dy,1) - i1_u = UBOUND(SrcMiscData%dvx_dy,1) - i2_l = LBOUND(SrcMiscData%dvx_dy,2) - i2_u = UBOUND(SrcMiscData%dvx_dy,2) - i3_l = LBOUND(SrcMiscData%dvx_dy,3) - i3_u = UBOUND(SrcMiscData%dvx_dy,3) - IF (.NOT. ALLOCATED(DstMiscData%dvx_dy)) THEN - ALLOCATE(DstMiscData%dvx_dy(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dvx_dy = SrcMiscData%dvx_dy -ENDIF -IF (ALLOCATED(SrcMiscData%dvx_dz)) THEN - i1_l = LBOUND(SrcMiscData%dvx_dz,1) - i1_u = UBOUND(SrcMiscData%dvx_dz,1) - i2_l = LBOUND(SrcMiscData%dvx_dz,2) - i2_u = UBOUND(SrcMiscData%dvx_dz,2) - i3_l = LBOUND(SrcMiscData%dvx_dz,3) - i3_u = UBOUND(SrcMiscData%dvx_dz,3) - IF (.NOT. ALLOCATED(DstMiscData%dvx_dz)) THEN - ALLOCATE(DstMiscData%dvx_dz(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dvx_dz = SrcMiscData%dvx_dz -ENDIF -IF (ALLOCATED(SrcMiscData%nu_dvx_dy)) THEN - i1_l = LBOUND(SrcMiscData%nu_dvx_dy,1) - i1_u = UBOUND(SrcMiscData%nu_dvx_dy,1) - i2_l = LBOUND(SrcMiscData%nu_dvx_dy,2) - i2_u = UBOUND(SrcMiscData%nu_dvx_dy,2) - IF (.NOT. ALLOCATED(DstMiscData%nu_dvx_dy)) THEN - ALLOCATE(DstMiscData%nu_dvx_dy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nu_dvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%nu_dvx_dy = SrcMiscData%nu_dvx_dy -ENDIF -IF (ALLOCATED(SrcMiscData%nu_dvx_dz)) THEN - i1_l = LBOUND(SrcMiscData%nu_dvx_dz,1) - i1_u = UBOUND(SrcMiscData%nu_dvx_dz,1) - i2_l = LBOUND(SrcMiscData%nu_dvx_dz,2) - i2_u = UBOUND(SrcMiscData%nu_dvx_dz,2) - IF (.NOT. ALLOCATED(DstMiscData%nu_dvx_dz)) THEN - ALLOCATE(DstMiscData%nu_dvx_dz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nu_dvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%nu_dvx_dz = SrcMiscData%nu_dvx_dz -ENDIF -IF (ALLOCATED(SrcMiscData%dnuvx_dy)) THEN - i1_l = LBOUND(SrcMiscData%dnuvx_dy,1) - i1_u = UBOUND(SrcMiscData%dnuvx_dy,1) - i2_l = LBOUND(SrcMiscData%dnuvx_dy,2) - i2_u = UBOUND(SrcMiscData%dnuvx_dy,2) - IF (.NOT. ALLOCATED(DstMiscData%dnuvx_dy)) THEN - ALLOCATE(DstMiscData%dnuvx_dy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dnuvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dnuvx_dy = SrcMiscData%dnuvx_dy -ENDIF -IF (ALLOCATED(SrcMiscData%dnuvx_dz)) THEN - i1_l = LBOUND(SrcMiscData%dnuvx_dz,1) - i1_u = UBOUND(SrcMiscData%dnuvx_dz,1) - i2_l = LBOUND(SrcMiscData%dnuvx_dz,2) - i2_u = UBOUND(SrcMiscData%dnuvx_dz,2) - IF (.NOT. ALLOCATED(DstMiscData%dnuvx_dz)) THEN - ALLOCATE(DstMiscData%dnuvx_dz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dnuvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dnuvx_dz = SrcMiscData%dnuvx_dz -ENDIF -IF (ALLOCATED(SrcMiscData%a)) THEN - i1_l = LBOUND(SrcMiscData%a,1) - i1_u = UBOUND(SrcMiscData%a,1) - IF (.NOT. ALLOCATED(DstMiscData%a)) THEN - ALLOCATE(DstMiscData%a(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%a.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%a = SrcMiscData%a -ENDIF -IF (ALLOCATED(SrcMiscData%b)) THEN - i1_l = LBOUND(SrcMiscData%b,1) - i1_u = UBOUND(SrcMiscData%b,1) - IF (.NOT. ALLOCATED(DstMiscData%b)) THEN - ALLOCATE(DstMiscData%b(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%b.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%b = SrcMiscData%b -ENDIF -IF (ALLOCATED(SrcMiscData%c)) THEN - i1_l = LBOUND(SrcMiscData%c,1) - i1_u = UBOUND(SrcMiscData%c,1) - IF (.NOT. ALLOCATED(DstMiscData%c)) THEN - ALLOCATE(DstMiscData%c(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%c = SrcMiscData%c -ENDIF -IF (ALLOCATED(SrcMiscData%d)) THEN - i1_l = LBOUND(SrcMiscData%d,1) - i1_u = UBOUND(SrcMiscData%d,1) - IF (.NOT. ALLOCATED(DstMiscData%d)) THEN - ALLOCATE(DstMiscData%d(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%d.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%d = SrcMiscData%d -ENDIF -IF (ALLOCATED(SrcMiscData%r_wake)) THEN - i1_l = LBOUND(SrcMiscData%r_wake,1) - i1_u = UBOUND(SrcMiscData%r_wake,1) - IF (.NOT. ALLOCATED(DstMiscData%r_wake)) THEN - ALLOCATE(DstMiscData%r_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%r_wake = SrcMiscData%r_wake -ENDIF -IF (ALLOCATED(SrcMiscData%Vx_high)) THEN - i1_l = LBOUND(SrcMiscData%Vx_high,1) - i1_u = UBOUND(SrcMiscData%Vx_high,1) - IF (.NOT. ALLOCATED(DstMiscData%Vx_high)) THEN - ALLOCATE(DstMiscData%Vx_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vx_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vx_high = SrcMiscData%Vx_high -ENDIF -IF (ALLOCATED(SrcMiscData%Vx_polar)) THEN - i1_l = LBOUND(SrcMiscData%Vx_polar,1) - i1_u = UBOUND(SrcMiscData%Vx_polar,1) - IF (.NOT. ALLOCATED(DstMiscData%Vx_polar)) THEN - ALLOCATE(DstMiscData%Vx_polar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vx_polar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vx_polar = SrcMiscData%Vx_polar -ENDIF -IF (ALLOCATED(SrcMiscData%Vt_wake)) THEN - i1_l = LBOUND(SrcMiscData%Vt_wake,1) - i1_u = UBOUND(SrcMiscData%Vt_wake,1) - IF (.NOT. ALLOCATED(DstMiscData%Vt_wake)) THEN - ALLOCATE(DstMiscData%Vt_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vt_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vt_wake = SrcMiscData%Vt_wake -ENDIF - DstMiscData%GammaCurl = SrcMiscData%GammaCurl - DstMiscData%Ct_avg = SrcMiscData%Ct_avg - END SUBROUTINE WD_CopyMisc - - SUBROUTINE WD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(WD_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 = 'WD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%dvtdr)) THEN - DEALLOCATE(MiscData%dvtdr) -ENDIF -IF (ALLOCATED(MiscData%vt_tot)) THEN - DEALLOCATE(MiscData%vt_tot) -ENDIF -IF (ALLOCATED(MiscData%vt_amb)) THEN - DEALLOCATE(MiscData%vt_amb) -ENDIF -IF (ALLOCATED(MiscData%vt_shr)) THEN - DEALLOCATE(MiscData%vt_shr) -ENDIF -IF (ALLOCATED(MiscData%vt_tot2)) THEN - DEALLOCATE(MiscData%vt_tot2) -ENDIF -IF (ALLOCATED(MiscData%vt_amb2)) THEN - DEALLOCATE(MiscData%vt_amb2) -ENDIF -IF (ALLOCATED(MiscData%vt_shr2)) THEN - DEALLOCATE(MiscData%vt_shr2) -ENDIF -IF (ALLOCATED(MiscData%dvx_dy)) THEN - DEALLOCATE(MiscData%dvx_dy) -ENDIF -IF (ALLOCATED(MiscData%dvx_dz)) THEN - DEALLOCATE(MiscData%dvx_dz) -ENDIF -IF (ALLOCATED(MiscData%nu_dvx_dy)) THEN - DEALLOCATE(MiscData%nu_dvx_dy) -ENDIF -IF (ALLOCATED(MiscData%nu_dvx_dz)) THEN - DEALLOCATE(MiscData%nu_dvx_dz) -ENDIF -IF (ALLOCATED(MiscData%dnuvx_dy)) THEN - DEALLOCATE(MiscData%dnuvx_dy) -ENDIF -IF (ALLOCATED(MiscData%dnuvx_dz)) THEN - DEALLOCATE(MiscData%dnuvx_dz) -ENDIF -IF (ALLOCATED(MiscData%a)) THEN - DEALLOCATE(MiscData%a) -ENDIF -IF (ALLOCATED(MiscData%b)) THEN - DEALLOCATE(MiscData%b) -ENDIF -IF (ALLOCATED(MiscData%c)) THEN - DEALLOCATE(MiscData%c) -ENDIF -IF (ALLOCATED(MiscData%d)) THEN - DEALLOCATE(MiscData%d) -ENDIF -IF (ALLOCATED(MiscData%r_wake)) THEN - DEALLOCATE(MiscData%r_wake) -ENDIF -IF (ALLOCATED(MiscData%Vx_high)) THEN - DEALLOCATE(MiscData%Vx_high) -ENDIF -IF (ALLOCATED(MiscData%Vx_polar)) THEN - DEALLOCATE(MiscData%Vx_polar) -ENDIF -IF (ALLOCATED(MiscData%Vt_wake)) THEN - DEALLOCATE(MiscData%Vt_wake) -ENDIF - END SUBROUTINE WD_DestroyMisc - - SUBROUTINE WD_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(WD_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 = 'WD_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 ! dvtdr allocated yes/no - IF ( ALLOCATED(InData%dvtdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dvtdr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dvtdr) ! dvtdr - END IF - Int_BufSz = Int_BufSz + 1 ! vt_tot allocated yes/no - IF ( ALLOCATED(InData%vt_tot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vt_tot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_tot) ! vt_tot - END IF - Int_BufSz = Int_BufSz + 1 ! vt_amb allocated yes/no - IF ( ALLOCATED(InData%vt_amb) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vt_amb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_amb) ! vt_amb - END IF - Int_BufSz = Int_BufSz + 1 ! vt_shr allocated yes/no - IF ( ALLOCATED(InData%vt_shr) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vt_shr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_shr) ! vt_shr - END IF - Int_BufSz = Int_BufSz + 1 ! vt_tot2 allocated yes/no - IF ( ALLOCATED(InData%vt_tot2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vt_tot2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_tot2) ! vt_tot2 - END IF - Int_BufSz = Int_BufSz + 1 ! vt_amb2 allocated yes/no - IF ( ALLOCATED(InData%vt_amb2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vt_amb2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_amb2) ! vt_amb2 - END IF - Int_BufSz = Int_BufSz + 1 ! vt_shr2 allocated yes/no - IF ( ALLOCATED(InData%vt_shr2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vt_shr2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_shr2) ! vt_shr2 - END IF - Int_BufSz = Int_BufSz + 1 ! dvx_dy allocated yes/no - IF ( ALLOCATED(InData%dvx_dy) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! dvx_dy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dvx_dy) ! dvx_dy - END IF - Int_BufSz = Int_BufSz + 1 ! dvx_dz allocated yes/no - IF ( ALLOCATED(InData%dvx_dz) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! dvx_dz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dvx_dz) ! dvx_dz - END IF - Int_BufSz = Int_BufSz + 1 ! nu_dvx_dy allocated yes/no - IF ( ALLOCATED(InData%nu_dvx_dy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! nu_dvx_dy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%nu_dvx_dy) ! nu_dvx_dy - END IF - Int_BufSz = Int_BufSz + 1 ! nu_dvx_dz allocated yes/no - IF ( ALLOCATED(InData%nu_dvx_dz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! nu_dvx_dz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%nu_dvx_dz) ! nu_dvx_dz - END IF - Int_BufSz = Int_BufSz + 1 ! dnuvx_dy allocated yes/no - IF ( ALLOCATED(InData%dnuvx_dy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! dnuvx_dy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dnuvx_dy) ! dnuvx_dy - END IF - Int_BufSz = Int_BufSz + 1 ! dnuvx_dz allocated yes/no - IF ( ALLOCATED(InData%dnuvx_dz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! dnuvx_dz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dnuvx_dz) ! dnuvx_dz - END IF - Int_BufSz = Int_BufSz + 1 ! a allocated yes/no - IF ( ALLOCATED(InData%a) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! a upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%a) ! a - END IF - Int_BufSz = Int_BufSz + 1 ! b allocated yes/no - IF ( ALLOCATED(InData%b) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! b upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%b) ! b - END IF - Int_BufSz = Int_BufSz + 1 ! c allocated yes/no - IF ( ALLOCATED(InData%c) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! c upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%c) ! c - END IF - Int_BufSz = Int_BufSz + 1 ! d allocated yes/no - IF ( ALLOCATED(InData%d) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! d upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%d) ! d - END IF - Int_BufSz = Int_BufSz + 1 ! r_wake allocated yes/no - IF ( ALLOCATED(InData%r_wake) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! r_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_wake) ! r_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_high allocated yes/no - IF ( ALLOCATED(InData%Vx_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vx_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_high) ! Vx_high - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_polar allocated yes/no - IF ( ALLOCATED(InData%Vx_polar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vx_polar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_polar) ! Vx_polar - END IF - Int_BufSz = Int_BufSz + 1 ! Vt_wake allocated yes/no - IF ( ALLOCATED(InData%Vt_wake) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vt_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vt_wake) ! Vt_wake - END IF - Re_BufSz = Re_BufSz + 1 ! GammaCurl - Re_BufSz = Re_BufSz + 1 ! Ct_avg - 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%dvtdr) ) 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%dvtdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvtdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dvtdr,1), UBOUND(InData%dvtdr,1) - ReKiBuf(Re_Xferred) = InData%dvtdr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_tot) ) 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%vt_tot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_tot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_tot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_tot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vt_tot,2), UBOUND(InData%vt_tot,2) - DO i1 = LBOUND(InData%vt_tot,1), UBOUND(InData%vt_tot,1) - ReKiBuf(Re_Xferred) = InData%vt_tot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_amb) ) 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%vt_amb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_amb,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_amb,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_amb,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vt_amb,2), UBOUND(InData%vt_amb,2) - DO i1 = LBOUND(InData%vt_amb,1), UBOUND(InData%vt_amb,1) - ReKiBuf(Re_Xferred) = InData%vt_amb(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_shr) ) 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%vt_shr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_shr,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_shr,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_shr,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vt_shr,2), UBOUND(InData%vt_shr,2) - DO i1 = LBOUND(InData%vt_shr,1), UBOUND(InData%vt_shr,1) - ReKiBuf(Re_Xferred) = InData%vt_shr(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_tot2) ) 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%vt_tot2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_tot2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_tot2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_tot2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_tot2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_tot2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vt_tot2,3), UBOUND(InData%vt_tot2,3) - DO i2 = LBOUND(InData%vt_tot2,2), UBOUND(InData%vt_tot2,2) - DO i1 = LBOUND(InData%vt_tot2,1), UBOUND(InData%vt_tot2,1) - ReKiBuf(Re_Xferred) = InData%vt_tot2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_amb2) ) 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%vt_amb2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_amb2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_amb2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_amb2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_amb2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_amb2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vt_amb2,3), UBOUND(InData%vt_amb2,3) - DO i2 = LBOUND(InData%vt_amb2,2), UBOUND(InData%vt_amb2,2) - DO i1 = LBOUND(InData%vt_amb2,1), UBOUND(InData%vt_amb2,1) - ReKiBuf(Re_Xferred) = InData%vt_amb2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_shr2) ) 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%vt_shr2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_shr2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_shr2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_shr2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_shr2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_shr2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vt_shr2,3), UBOUND(InData%vt_shr2,3) - DO i2 = LBOUND(InData%vt_shr2,2), UBOUND(InData%vt_shr2,2) - DO i1 = LBOUND(InData%vt_shr2,1), UBOUND(InData%vt_shr2,1) - ReKiBuf(Re_Xferred) = InData%vt_shr2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dvx_dy) ) 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%dvx_dy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dy,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dy,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dy,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%dvx_dy,3), UBOUND(InData%dvx_dy,3) - DO i2 = LBOUND(InData%dvx_dy,2), UBOUND(InData%dvx_dy,2) - DO i1 = LBOUND(InData%dvx_dy,1), UBOUND(InData%dvx_dy,1) - ReKiBuf(Re_Xferred) = InData%dvx_dy(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dvx_dz) ) 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%dvx_dz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dz,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dz,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dz,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%dvx_dz,3), UBOUND(InData%dvx_dz,3) - DO i2 = LBOUND(InData%dvx_dz,2), UBOUND(InData%dvx_dz,2) - DO i1 = LBOUND(InData%dvx_dz,1), UBOUND(InData%dvx_dz,1) - ReKiBuf(Re_Xferred) = InData%dvx_dz(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nu_dvx_dy) ) 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%nu_dvx_dy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nu_dvx_dy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nu_dvx_dy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nu_dvx_dy,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%nu_dvx_dy,2), UBOUND(InData%nu_dvx_dy,2) - DO i1 = LBOUND(InData%nu_dvx_dy,1), UBOUND(InData%nu_dvx_dy,1) - ReKiBuf(Re_Xferred) = InData%nu_dvx_dy(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nu_dvx_dz) ) 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%nu_dvx_dz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nu_dvx_dz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nu_dvx_dz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nu_dvx_dz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%nu_dvx_dz,2), UBOUND(InData%nu_dvx_dz,2) - DO i1 = LBOUND(InData%nu_dvx_dz,1), UBOUND(InData%nu_dvx_dz,1) - ReKiBuf(Re_Xferred) = InData%nu_dvx_dz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dnuvx_dy) ) 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%dnuvx_dy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dnuvx_dy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dnuvx_dy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dnuvx_dy,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%dnuvx_dy,2), UBOUND(InData%dnuvx_dy,2) - DO i1 = LBOUND(InData%dnuvx_dy,1), UBOUND(InData%dnuvx_dy,1) - ReKiBuf(Re_Xferred) = InData%dnuvx_dy(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dnuvx_dz) ) 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%dnuvx_dz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dnuvx_dz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dnuvx_dz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dnuvx_dz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%dnuvx_dz,2), UBOUND(InData%dnuvx_dz,2) - DO i1 = LBOUND(InData%dnuvx_dz,1), UBOUND(InData%dnuvx_dz,1) - ReKiBuf(Re_Xferred) = InData%dnuvx_dz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%a) ) 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%a,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%a,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%a,1), UBOUND(InData%a,1) - ReKiBuf(Re_Xferred) = InData%a(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%b) ) 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%b,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%b,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%b,1), UBOUND(InData%b,1) - ReKiBuf(Re_Xferred) = InData%b(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%c) ) 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%c,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%c,1), UBOUND(InData%c,1) - ReKiBuf(Re_Xferred) = InData%c(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%d) ) 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%d,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%d,1), UBOUND(InData%d,1) - ReKiBuf(Re_Xferred) = InData%d(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_wake) ) 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%r_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_wake,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%r_wake,1), UBOUND(InData%r_wake,1) - ReKiBuf(Re_Xferred) = InData%r_wake(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_high) ) 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%Vx_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vx_high,1), UBOUND(InData%Vx_high,1) - ReKiBuf(Re_Xferred) = InData%Vx_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_polar) ) 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%Vx_polar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_polar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vx_polar,1), UBOUND(InData%Vx_polar,1) - ReKiBuf(Re_Xferred) = InData%Vx_polar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vt_wake) ) 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%Vt_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vt_wake,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vt_wake,1), UBOUND(InData%Vt_wake,1) - ReKiBuf(Re_Xferred) = InData%Vt_wake(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%GammaCurl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ct_avg - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_PackMisc - - SUBROUTINE WD_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(WD_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) :: 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_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dvtdr 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%dvtdr)) DEALLOCATE(OutData%dvtdr) - ALLOCATE(OutData%dvtdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dvtdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dvtdr,1), UBOUND(OutData%dvtdr,1) - OutData%dvtdr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vt_tot 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%vt_tot)) DEALLOCATE(OutData%vt_tot) - ALLOCATE(OutData%vt_tot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_tot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vt_tot,2), UBOUND(OutData%vt_tot,2) - DO i1 = LBOUND(OutData%vt_tot,1), UBOUND(OutData%vt_tot,1) - OutData%vt_tot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vt_amb 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%vt_amb)) DEALLOCATE(OutData%vt_amb) - ALLOCATE(OutData%vt_amb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_amb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vt_amb,2), UBOUND(OutData%vt_amb,2) - DO i1 = LBOUND(OutData%vt_amb,1), UBOUND(OutData%vt_amb,1) - OutData%vt_amb(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vt_shr 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%vt_shr)) DEALLOCATE(OutData%vt_shr) - ALLOCATE(OutData%vt_shr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_shr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vt_shr,2), UBOUND(OutData%vt_shr,2) - DO i1 = LBOUND(OutData%vt_shr,1), UBOUND(OutData%vt_shr,1) - OutData%vt_shr(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vt_tot2 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%vt_tot2)) DEALLOCATE(OutData%vt_tot2) - ALLOCATE(OutData%vt_tot2(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%vt_tot2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vt_tot2,3), UBOUND(OutData%vt_tot2,3) - DO i2 = LBOUND(OutData%vt_tot2,2), UBOUND(OutData%vt_tot2,2) - DO i1 = LBOUND(OutData%vt_tot2,1), UBOUND(OutData%vt_tot2,1) - OutData%vt_tot2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vt_amb2 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%vt_amb2)) DEALLOCATE(OutData%vt_amb2) - ALLOCATE(OutData%vt_amb2(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%vt_amb2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vt_amb2,3), UBOUND(OutData%vt_amb2,3) - DO i2 = LBOUND(OutData%vt_amb2,2), UBOUND(OutData%vt_amb2,2) - DO i1 = LBOUND(OutData%vt_amb2,1), UBOUND(OutData%vt_amb2,1) - OutData%vt_amb2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vt_shr2 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%vt_shr2)) DEALLOCATE(OutData%vt_shr2) - ALLOCATE(OutData%vt_shr2(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%vt_shr2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vt_shr2,3), UBOUND(OutData%vt_shr2,3) - DO i2 = LBOUND(OutData%vt_shr2,2), UBOUND(OutData%vt_shr2,2) - DO i1 = LBOUND(OutData%vt_shr2,1), UBOUND(OutData%vt_shr2,1) - OutData%vt_shr2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dvx_dy 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%dvx_dy)) DEALLOCATE(OutData%dvx_dy) - ALLOCATE(OutData%dvx_dy(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%dvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%dvx_dy,3), UBOUND(OutData%dvx_dy,3) - DO i2 = LBOUND(OutData%dvx_dy,2), UBOUND(OutData%dvx_dy,2) - DO i1 = LBOUND(OutData%dvx_dy,1), UBOUND(OutData%dvx_dy,1) - OutData%dvx_dy(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dvx_dz 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%dvx_dz)) DEALLOCATE(OutData%dvx_dz) - ALLOCATE(OutData%dvx_dz(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%dvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%dvx_dz,3), UBOUND(OutData%dvx_dz,3) - DO i2 = LBOUND(OutData%dvx_dz,2), UBOUND(OutData%dvx_dz,2) - DO i1 = LBOUND(OutData%dvx_dz,1), UBOUND(OutData%dvx_dz,1) - OutData%dvx_dz(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nu_dvx_dy 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%nu_dvx_dy)) DEALLOCATE(OutData%nu_dvx_dy) - ALLOCATE(OutData%nu_dvx_dy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nu_dvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%nu_dvx_dy,2), UBOUND(OutData%nu_dvx_dy,2) - DO i1 = LBOUND(OutData%nu_dvx_dy,1), UBOUND(OutData%nu_dvx_dy,1) - OutData%nu_dvx_dy(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nu_dvx_dz 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%nu_dvx_dz)) DEALLOCATE(OutData%nu_dvx_dz) - ALLOCATE(OutData%nu_dvx_dz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nu_dvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%nu_dvx_dz,2), UBOUND(OutData%nu_dvx_dz,2) - DO i1 = LBOUND(OutData%nu_dvx_dz,1), UBOUND(OutData%nu_dvx_dz,1) - OutData%nu_dvx_dz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dnuvx_dy 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%dnuvx_dy)) DEALLOCATE(OutData%dnuvx_dy) - ALLOCATE(OutData%dnuvx_dy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dnuvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%dnuvx_dy,2), UBOUND(OutData%dnuvx_dy,2) - DO i1 = LBOUND(OutData%dnuvx_dy,1), UBOUND(OutData%dnuvx_dy,1) - OutData%dnuvx_dy(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dnuvx_dz 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%dnuvx_dz)) DEALLOCATE(OutData%dnuvx_dz) - ALLOCATE(OutData%dnuvx_dz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dnuvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%dnuvx_dz,2), UBOUND(OutData%dnuvx_dz,2) - DO i1 = LBOUND(OutData%dnuvx_dz,1), UBOUND(OutData%dnuvx_dz,1) - OutData%dnuvx_dz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! a 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%a)) DEALLOCATE(OutData%a) - ALLOCATE(OutData%a(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%a.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%a,1), UBOUND(OutData%a,1) - OutData%a(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! b 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%b)) DEALLOCATE(OutData%b) - ALLOCATE(OutData%b(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%b.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%b,1), UBOUND(OutData%b,1) - OutData%b(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! c 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%c)) DEALLOCATE(OutData%c) - ALLOCATE(OutData%c(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%c,1), UBOUND(OutData%c,1) - OutData%c(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! d 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%d)) DEALLOCATE(OutData%d) - ALLOCATE(OutData%d(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%d.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%d,1), UBOUND(OutData%d,1) - OutData%d(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_wake 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%r_wake)) DEALLOCATE(OutData%r_wake) - ALLOCATE(OutData%r_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%r_wake,1), UBOUND(OutData%r_wake,1) - OutData%r_wake(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_high 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%Vx_high)) DEALLOCATE(OutData%Vx_high) - ALLOCATE(OutData%Vx_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vx_high,1), UBOUND(OutData%Vx_high,1) - OutData%Vx_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_polar 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%Vx_polar)) DEALLOCATE(OutData%Vx_polar) - ALLOCATE(OutData%Vx_polar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_polar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vx_polar,1), UBOUND(OutData%Vx_polar,1) - OutData%Vx_polar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vt_wake 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%Vt_wake)) DEALLOCATE(OutData%Vt_wake) - ALLOCATE(OutData%Vt_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vt_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vt_wake,1), UBOUND(OutData%Vt_wake,1) - OutData%Vt_wake(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%GammaCurl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ct_avg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_UnPackMisc - - SUBROUTINE WD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(WD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyParam' -! + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine + +subroutine WD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(WD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%dt_low = SrcParamData%dt_low - DstParamData%NumPlanes = SrcParamData%NumPlanes - DstParamData%NumRadii = SrcParamData%NumRadii - DstParamData%dr = SrcParamData%dr -IF (ALLOCATED(SrcParamData%r)) THEN - i1_l = LBOUND(SrcParamData%r,1) - i1_u = UBOUND(SrcParamData%r,1) - IF (.NOT. ALLOCATED(DstParamData%r)) THEN - ALLOCATE(DstParamData%r(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%r = SrcParamData%r -ENDIF -IF (ALLOCATED(SrcParamData%y)) THEN - i1_l = LBOUND(SrcParamData%y,1) - i1_u = UBOUND(SrcParamData%y,1) - IF (.NOT. ALLOCATED(DstParamData%y)) THEN - ALLOCATE(DstParamData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%y = SrcParamData%y -ENDIF -IF (ALLOCATED(SrcParamData%z)) THEN - i1_l = LBOUND(SrcParamData%z,1) - i1_u = UBOUND(SrcParamData%z,1) - IF (.NOT. ALLOCATED(DstParamData%z)) THEN - ALLOCATE(DstParamData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%z = SrcParamData%z -ENDIF - DstParamData%Mod_Wake = SrcParamData%Mod_Wake - DstParamData%Swirl = SrcParamData%Swirl - DstParamData%k_VortexDecay = SrcParamData%k_VortexDecay - DstParamData%sigma_D = SrcParamData%sigma_D - DstParamData%NumVortices = SrcParamData%NumVortices - DstParamData%filtParam = SrcParamData%filtParam - DstParamData%oneMinusFiltParam = SrcParamData%oneMinusFiltParam - DstParamData%C_HWkDfl_O = SrcParamData%C_HWkDfl_O - DstParamData%C_HWkDfl_OY = SrcParamData%C_HWkDfl_OY - DstParamData%C_HWkDfl_x = SrcParamData%C_HWkDfl_x - DstParamData%C_HWkDfl_xY = SrcParamData%C_HWkDfl_xY - DstParamData%C_NearWake = SrcParamData%C_NearWake - DstParamData%C_vAmb_DMin = SrcParamData%C_vAmb_DMin - DstParamData%C_vAmb_DMax = SrcParamData%C_vAmb_DMax - DstParamData%C_vAmb_FMin = SrcParamData%C_vAmb_FMin - DstParamData%C_vAmb_Exp = SrcParamData%C_vAmb_Exp - DstParamData%C_vShr_DMin = SrcParamData%C_vShr_DMin - DstParamData%C_vShr_DMax = SrcParamData%C_vShr_DMax - DstParamData%C_vShr_FMin = SrcParamData%C_vShr_FMin - DstParamData%C_vShr_Exp = SrcParamData%C_vShr_Exp - DstParamData%k_vAmb = SrcParamData%k_vAmb - DstParamData%k_vShr = SrcParamData%k_vShr - DstParamData%Mod_WakeDiam = SrcParamData%Mod_WakeDiam - DstParamData%C_WakeDiam = SrcParamData%C_WakeDiam - DstParamData%FilterInit = SrcParamData%FilterInit - DstParamData%k_vCurl = SrcParamData%k_vCurl - DstParamData%OutAllPlanes = SrcParamData%OutAllPlanes - DstParamData%OutFileRoot = SrcParamData%OutFileRoot - DstParamData%OutFileVTKDir = SrcParamData%OutFileVTKDir - DstParamData%TurbNum = SrcParamData%TurbNum - DstParamData%WAT = SrcParamData%WAT - DstParamData%WAT_k_Def = SrcParamData%WAT_k_Def - DstParamData%WAT_k_Grad = SrcParamData%WAT_k_Grad - END SUBROUTINE WD_CopyParam - - SUBROUTINE WD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(WD_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 = 'WD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%r)) THEN - DEALLOCATE(ParamData%r) -ENDIF -IF (ALLOCATED(ParamData%y)) THEN - DEALLOCATE(ParamData%y) -ENDIF -IF (ALLOCATED(ParamData%z)) THEN - DEALLOCATE(ParamData%z) -ENDIF - END SUBROUTINE WD_DestroyParam - - SUBROUTINE WD_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(WD_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 = 'WD_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_low - Int_BufSz = Int_BufSz + 1 ! NumPlanes - Int_BufSz = Int_BufSz + 1 ! NumRadii - Re_BufSz = Re_BufSz + 1 ! dr - Int_BufSz = Int_BufSz + 1 ! r allocated yes/no - IF ( ALLOCATED(InData%r) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! r upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r) ! r - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%z) ! z - END IF - Int_BufSz = Int_BufSz + 1 ! Mod_Wake - Int_BufSz = Int_BufSz + 1 ! Swirl - Re_BufSz = Re_BufSz + 1 ! k_VortexDecay - Re_BufSz = Re_BufSz + 1 ! sigma_D - Int_BufSz = Int_BufSz + 1 ! NumVortices - Re_BufSz = Re_BufSz + 1 ! filtParam - Re_BufSz = Re_BufSz + 1 ! oneMinusFiltParam - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_O - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_OY - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_x - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_xY - Re_BufSz = Re_BufSz + 1 ! C_NearWake - Re_BufSz = Re_BufSz + 1 ! C_vAmb_DMin - Re_BufSz = Re_BufSz + 1 ! C_vAmb_DMax - Re_BufSz = Re_BufSz + 1 ! C_vAmb_FMin - Re_BufSz = Re_BufSz + 1 ! C_vAmb_Exp - Re_BufSz = Re_BufSz + 1 ! C_vShr_DMin - Re_BufSz = Re_BufSz + 1 ! C_vShr_DMax - Re_BufSz = Re_BufSz + 1 ! C_vShr_FMin - Re_BufSz = Re_BufSz + 1 ! C_vShr_Exp - Re_BufSz = Re_BufSz + 1 ! k_vAmb - Re_BufSz = Re_BufSz + 1 ! k_vShr - Int_BufSz = Int_BufSz + 1 ! Mod_WakeDiam - Re_BufSz = Re_BufSz + 1 ! C_WakeDiam - Int_BufSz = Int_BufSz + 1 ! FilterInit - Re_BufSz = Re_BufSz + 1 ! k_vCurl - Int_BufSz = Int_BufSz + 1 ! OutAllPlanes - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileVTKDir) ! OutFileVTKDir - Int_BufSz = Int_BufSz + 1 ! TurbNum - Int_BufSz = Int_BufSz + 1 ! WAT - Re_BufSz = Re_BufSz + 1 ! WAT_k_Def - Re_BufSz = Re_BufSz + 1 ! WAT_k_Grad - 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_low - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPlanes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumRadii - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dr - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%r) ) 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%r,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - ReKiBuf(Re_Xferred) = InData%r(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y) ) 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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - ReKiBuf(Re_Xferred) = InData%y(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z) ) 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%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - ReKiBuf(Re_Xferred) = InData%z(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Mod_Wake - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Swirl, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_VortexDecay - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%sigma_D - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumVortices - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%filtParam - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%oneMinusFiltParam - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_O - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_OY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_x - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_xY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_NearWake - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_DMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_DMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_FMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_Exp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_DMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_DMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_FMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_Exp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vAmb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vShr - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_WakeDiam - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_WakeDiam - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FilterInit - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vCurl - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAllPlanes, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFileVTKDir) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileVTKDir(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%TurbNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WAT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WAT_k_Def - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WAT_k_Grad - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_PackParam - - SUBROUTINE WD_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(WD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_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_low = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumPlanes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumRadii = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r 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%r)) DEALLOCATE(OutData%r) - ALLOCATE(OutData%r(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z 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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - OutData%z(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Mod_Wake = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Swirl = TRANSFER(IntKiBuf(Int_Xferred), OutData%Swirl) - Int_Xferred = Int_Xferred + 1 - OutData%k_VortexDecay = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%sigma_D = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumVortices = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%filtParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%oneMinusFiltParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_O = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_OY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_x = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_xY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_NearWake = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_DMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_DMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_FMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_Exp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_DMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_DMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_FMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_Exp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_vAmb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_vShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Mod_WakeDiam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_WakeDiam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FilterInit = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%k_vCurl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%OutAllPlanes = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAllPlanes) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFileVTKDir) - OutData%OutFileVTKDir(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TurbNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WAT = TRANSFER(IntKiBuf(Int_Xferred), OutData%WAT) - Int_Xferred = Int_Xferred + 1 - OutData%WAT_k_Def = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WAT_k_Grad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_UnPackParam - - SUBROUTINE WD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_InputType), INTENT(IN) :: SrcInputData - TYPE(WD_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) :: 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 = 'WD_CopyInput' -! + ErrMsg = '' +end subroutine + +subroutine WD_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(WD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(WD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WD_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstInputData%xhat_disk = SrcInputData%xhat_disk - DstInputData%YawErr = SrcInputData%YawErr - DstInputData%psi_skew = SrcInputData%psi_skew - DstInputData%chi_skew = SrcInputData%chi_skew - DstInputData%p_hub = SrcInputData%p_hub -IF (ALLOCATED(SrcInputData%V_plane)) THEN - i1_l = LBOUND(SrcInputData%V_plane,1) - i1_u = UBOUND(SrcInputData%V_plane,1) - i2_l = LBOUND(SrcInputData%V_plane,2) - i2_u = UBOUND(SrcInputData%V_plane,2) - IF (.NOT. ALLOCATED(DstInputData%V_plane)) THEN - ALLOCATE(DstInputData%V_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%V_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%V_plane = SrcInputData%V_plane -ENDIF - DstInputData%Vx_wind_disk = SrcInputData%Vx_wind_disk - DstInputData%TI_amb = SrcInputData%TI_amb - DstInputData%D_rotor = SrcInputData%D_rotor - DstInputData%Vx_rel_disk = SrcInputData%Vx_rel_disk -IF (ALLOCATED(SrcInputData%Ct_azavg)) THEN - i1_l = LBOUND(SrcInputData%Ct_azavg,1) - i1_u = UBOUND(SrcInputData%Ct_azavg,1) - IF (.NOT. ALLOCATED(DstInputData%Ct_azavg)) THEN - ALLOCATE(DstInputData%Ct_azavg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Ct_azavg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Ct_azavg = SrcInputData%Ct_azavg -ENDIF -IF (ALLOCATED(SrcInputData%Cq_azavg)) THEN - i1_l = LBOUND(SrcInputData%Cq_azavg,1) - i1_u = UBOUND(SrcInputData%Cq_azavg,1) - IF (.NOT. ALLOCATED(DstInputData%Cq_azavg)) THEN - ALLOCATE(DstInputData%Cq_azavg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Cq_azavg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Cq_azavg = SrcInputData%Cq_azavg -ENDIF - END SUBROUTINE WD_CopyInput - - SUBROUTINE WD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(WD_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 = 'WD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%V_plane)) THEN - DEALLOCATE(InputData%V_plane) -ENDIF -IF (ALLOCATED(InputData%Ct_azavg)) THEN - DEALLOCATE(InputData%Ct_azavg) -ENDIF -IF (ALLOCATED(InputData%Cq_azavg)) THEN - DEALLOCATE(InputData%Cq_azavg) -ENDIF - END SUBROUTINE WD_DestroyInput - - SUBROUTINE WD_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(WD_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 = 'WD_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 + SIZE(InData%xhat_disk) ! xhat_disk - Re_BufSz = Re_BufSz + 1 ! YawErr - Re_BufSz = Re_BufSz + 1 ! psi_skew - Re_BufSz = Re_BufSz + 1 ! chi_skew - Re_BufSz = Re_BufSz + SIZE(InData%p_hub) ! p_hub - Int_BufSz = Int_BufSz + 1 ! V_plane allocated yes/no - IF ( ALLOCATED(InData%V_plane) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! V_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_plane) ! V_plane - END IF - Re_BufSz = Re_BufSz + 1 ! Vx_wind_disk - Re_BufSz = Re_BufSz + 1 ! TI_amb - Re_BufSz = Re_BufSz + 1 ! D_rotor - Re_BufSz = Re_BufSz + 1 ! Vx_rel_disk - Int_BufSz = Int_BufSz + 1 ! Ct_azavg allocated yes/no - IF ( ALLOCATED(InData%Ct_azavg) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Ct_azavg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Ct_azavg) ! Ct_azavg - END IF - Int_BufSz = Int_BufSz + 1 ! Cq_azavg allocated yes/no - IF ( ALLOCATED(InData%Cq_azavg) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cq_azavg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cq_azavg) ! Cq_azavg - 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 i1 = LBOUND(InData%xhat_disk,1), UBOUND(InData%xhat_disk,1) - ReKiBuf(Re_Xferred) = InData%xhat_disk(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%psi_skew - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%chi_skew - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%p_hub,1), UBOUND(InData%p_hub,1) - ReKiBuf(Re_Xferred) = InData%p_hub(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%V_plane) ) 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%V_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%V_plane,2), UBOUND(InData%V_plane,2) - DO i1 = LBOUND(InData%V_plane,1), UBOUND(InData%V_plane,1) - ReKiBuf(Re_Xferred) = InData%V_plane(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Vx_wind_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_amb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%D_rotor - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vx_rel_disk - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Ct_azavg) ) 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%Ct_azavg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ct_azavg,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Ct_azavg,1), UBOUND(InData%Ct_azavg,1) - ReKiBuf(Re_Xferred) = InData%Ct_azavg(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cq_azavg) ) 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%Cq_azavg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cq_azavg,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cq_azavg,1), UBOUND(InData%Cq_azavg,1) - ReKiBuf(Re_Xferred) = InData%Cq_azavg(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WD_PackInput - - SUBROUTINE WD_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(WD_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) :: 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 = 'WD_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 - i1_l = LBOUND(OutData%xhat_disk,1) - i1_u = UBOUND(OutData%xhat_disk,1) - DO i1 = LBOUND(OutData%xhat_disk,1), UBOUND(OutData%xhat_disk,1) - OutData%xhat_disk(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%YawErr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%psi_skew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%chi_skew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%p_hub,1) - i1_u = UBOUND(OutData%p_hub,1) - DO i1 = LBOUND(OutData%p_hub,1), UBOUND(OutData%p_hub,1) - OutData%p_hub(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_plane 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%V_plane)) DEALLOCATE(OutData%V_plane) - ALLOCATE(OutData%V_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%V_plane,2), UBOUND(OutData%V_plane,2) - DO i1 = LBOUND(OutData%V_plane,1), UBOUND(OutData%V_plane,1) - OutData%V_plane(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%Vx_wind_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_amb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%D_rotor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vx_rel_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ct_azavg 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%Ct_azavg)) DEALLOCATE(OutData%Ct_azavg) - ALLOCATE(OutData%Ct_azavg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ct_azavg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Ct_azavg,1), UBOUND(OutData%Ct_azavg,1) - OutData%Ct_azavg(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cq_azavg 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%Cq_azavg)) DEALLOCATE(OutData%Cq_azavg) - ALLOCATE(OutData%Cq_azavg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cq_azavg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cq_azavg,1), UBOUND(OutData%Cq_azavg,1) - OutData%Cq_azavg(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WD_UnPackInput - - SUBROUTINE WD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_OutputType), INTENT(IN) :: SrcOutputData - TYPE(WD_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) :: 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_CopyOutput' -! + ErrMsg = '' + if (allocated(SrcDiscStateData%xhat_plane)) then + LB(1:2) = lbound(SrcDiscStateData%xhat_plane) + UB(1:2) = ubound(SrcDiscStateData%xhat_plane) + if (.not. allocated(DstDiscStateData%xhat_plane)) then + allocate(DstDiscStateData%xhat_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%xhat_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%xhat_plane = SrcDiscStateData%xhat_plane + end if + if (allocated(SrcDiscStateData%YawErr_filt)) then + LB(1:1) = lbound(SrcDiscStateData%YawErr_filt) + UB(1:1) = ubound(SrcDiscStateData%YawErr_filt) + if (.not. allocated(DstDiscStateData%YawErr_filt)) then + allocate(DstDiscStateData%YawErr_filt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%YawErr_filt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%YawErr_filt = SrcDiscStateData%YawErr_filt + end if + DstDiscStateData%psi_skew_filt = SrcDiscStateData%psi_skew_filt + DstDiscStateData%chi_skew_filt = SrcDiscStateData%chi_skew_filt + if (allocated(SrcDiscStateData%V_plane_filt)) then + LB(1:2) = lbound(SrcDiscStateData%V_plane_filt) + UB(1:2) = ubound(SrcDiscStateData%V_plane_filt) + if (.not. allocated(DstDiscStateData%V_plane_filt)) then + allocate(DstDiscStateData%V_plane_filt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%V_plane_filt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%V_plane_filt = SrcDiscStateData%V_plane_filt + end if + if (allocated(SrcDiscStateData%p_plane)) then + LB(1:2) = lbound(SrcDiscStateData%p_plane) + UB(1:2) = ubound(SrcDiscStateData%p_plane) + if (.not. allocated(DstDiscStateData%p_plane)) then + allocate(DstDiscStateData%p_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%p_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%p_plane = SrcDiscStateData%p_plane + end if + if (allocated(SrcDiscStateData%x_plane)) then + LB(1:1) = lbound(SrcDiscStateData%x_plane) + UB(1:1) = ubound(SrcDiscStateData%x_plane) + if (.not. allocated(DstDiscStateData%x_plane)) then + allocate(DstDiscStateData%x_plane(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%x_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%x_plane = SrcDiscStateData%x_plane + end if + if (allocated(SrcDiscStateData%Vx_wake)) then + LB(1:2) = lbound(SrcDiscStateData%Vx_wake) + UB(1:2) = ubound(SrcDiscStateData%Vx_wake) + if (.not. allocated(DstDiscStateData%Vx_wake)) then + allocate(DstDiscStateData%Vx_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Vx_wake = SrcDiscStateData%Vx_wake + end if + if (allocated(SrcDiscStateData%Vr_wake)) then + LB(1:2) = lbound(SrcDiscStateData%Vr_wake) + UB(1:2) = ubound(SrcDiscStateData%Vr_wake) + if (.not. allocated(DstDiscStateData%Vr_wake)) then + allocate(DstDiscStateData%Vr_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vr_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Vr_wake = SrcDiscStateData%Vr_wake + end if + if (allocated(SrcDiscStateData%Vx_wake2)) then + LB(1:3) = lbound(SrcDiscStateData%Vx_wake2) + UB(1:3) = ubound(SrcDiscStateData%Vx_wake2) + if (.not. allocated(DstDiscStateData%Vx_wake2)) then + allocate(DstDiscStateData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Vx_wake2 = SrcDiscStateData%Vx_wake2 + end if + if (allocated(SrcDiscStateData%Vy_wake2)) then + LB(1:3) = lbound(SrcDiscStateData%Vy_wake2) + UB(1:3) = ubound(SrcDiscStateData%Vy_wake2) + if (.not. allocated(DstDiscStateData%Vy_wake2)) then + allocate(DstDiscStateData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vy_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Vy_wake2 = SrcDiscStateData%Vy_wake2 + end if + if (allocated(SrcDiscStateData%Vz_wake2)) then + LB(1:3) = lbound(SrcDiscStateData%Vz_wake2) + UB(1:3) = ubound(SrcDiscStateData%Vz_wake2) + if (.not. allocated(DstDiscStateData%Vz_wake2)) then + allocate(DstDiscStateData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vz_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Vz_wake2 = SrcDiscStateData%Vz_wake2 + end if + if (allocated(SrcDiscStateData%Vx_wind_disk_filt)) then + LB(1:1) = lbound(SrcDiscStateData%Vx_wind_disk_filt) + UB(1:1) = ubound(SrcDiscStateData%Vx_wind_disk_filt) + if (.not. allocated(DstDiscStateData%Vx_wind_disk_filt)) then + allocate(DstDiscStateData%Vx_wind_disk_filt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wind_disk_filt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Vx_wind_disk_filt = SrcDiscStateData%Vx_wind_disk_filt + end if + if (allocated(SrcDiscStateData%TI_amb_filt)) then + LB(1:1) = lbound(SrcDiscStateData%TI_amb_filt) + UB(1:1) = ubound(SrcDiscStateData%TI_amb_filt) + if (.not. allocated(DstDiscStateData%TI_amb_filt)) then + allocate(DstDiscStateData%TI_amb_filt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TI_amb_filt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%TI_amb_filt = SrcDiscStateData%TI_amb_filt + end if + if (allocated(SrcDiscStateData%D_rotor_filt)) then + LB(1:1) = lbound(SrcDiscStateData%D_rotor_filt) + UB(1:1) = ubound(SrcDiscStateData%D_rotor_filt) + if (.not. allocated(DstDiscStateData%D_rotor_filt)) then + allocate(DstDiscStateData%D_rotor_filt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%D_rotor_filt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%D_rotor_filt = SrcDiscStateData%D_rotor_filt + end if + DstDiscStateData%Vx_rel_disk_filt = SrcDiscStateData%Vx_rel_disk_filt + if (allocated(SrcDiscStateData%Ct_azavg_filt)) then + LB(1:1) = lbound(SrcDiscStateData%Ct_azavg_filt) + UB(1:1) = ubound(SrcDiscStateData%Ct_azavg_filt) + if (.not. allocated(DstDiscStateData%Ct_azavg_filt)) then + allocate(DstDiscStateData%Ct_azavg_filt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Ct_azavg_filt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Ct_azavg_filt = SrcDiscStateData%Ct_azavg_filt + end if + if (allocated(SrcDiscStateData%Cq_azavg_filt)) then + LB(1:1) = lbound(SrcDiscStateData%Cq_azavg_filt) + UB(1:1) = ubound(SrcDiscStateData%Cq_azavg_filt) + if (.not. allocated(DstDiscStateData%Cq_azavg_filt)) then + allocate(DstDiscStateData%Cq_azavg_filt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cq_azavg_filt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Cq_azavg_filt = SrcDiscStateData%Cq_azavg_filt + end if +end subroutine + +subroutine WD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(WD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%xhat_plane)) THEN - i1_l = LBOUND(SrcOutputData%xhat_plane,1) - i1_u = UBOUND(SrcOutputData%xhat_plane,1) - i2_l = LBOUND(SrcOutputData%xhat_plane,2) - i2_u = UBOUND(SrcOutputData%xhat_plane,2) - IF (.NOT. ALLOCATED(DstOutputData%xhat_plane)) THEN - ALLOCATE(DstOutputData%xhat_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%xhat_plane = SrcOutputData%xhat_plane -ENDIF -IF (ALLOCATED(SrcOutputData%p_plane)) THEN - i1_l = LBOUND(SrcOutputData%p_plane,1) - i1_u = UBOUND(SrcOutputData%p_plane,1) - i2_l = LBOUND(SrcOutputData%p_plane,2) - i2_u = UBOUND(SrcOutputData%p_plane,2) - IF (.NOT. ALLOCATED(DstOutputData%p_plane)) THEN - ALLOCATE(DstOutputData%p_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%p_plane = SrcOutputData%p_plane -ENDIF -IF (ALLOCATED(SrcOutputData%Vx_wake)) THEN - i1_l = LBOUND(SrcOutputData%Vx_wake,1) - i1_u = UBOUND(SrcOutputData%Vx_wake,1) - i2_l = LBOUND(SrcOutputData%Vx_wake,2) - i2_u = UBOUND(SrcOutputData%Vx_wake,2) - IF (.NOT. ALLOCATED(DstOutputData%Vx_wake)) THEN - ALLOCATE(DstOutputData%Vx_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vx_wake = SrcOutputData%Vx_wake -ENDIF -IF (ALLOCATED(SrcOutputData%Vr_wake)) THEN - i1_l = LBOUND(SrcOutputData%Vr_wake,1) - i1_u = UBOUND(SrcOutputData%Vr_wake,1) - i2_l = LBOUND(SrcOutputData%Vr_wake,2) - i2_u = UBOUND(SrcOutputData%Vr_wake,2) - IF (.NOT. ALLOCATED(DstOutputData%Vr_wake)) THEN - ALLOCATE(DstOutputData%Vr_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vr_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vr_wake = SrcOutputData%Vr_wake -ENDIF -IF (ALLOCATED(SrcOutputData%Vx_wake2)) THEN - i1_l = LBOUND(SrcOutputData%Vx_wake2,1) - i1_u = UBOUND(SrcOutputData%Vx_wake2,1) - i2_l = LBOUND(SrcOutputData%Vx_wake2,2) - i2_u = UBOUND(SrcOutputData%Vx_wake2,2) - i3_l = LBOUND(SrcOutputData%Vx_wake2,3) - i3_u = UBOUND(SrcOutputData%Vx_wake2,3) - IF (.NOT. ALLOCATED(DstOutputData%Vx_wake2)) THEN - ALLOCATE(DstOutputData%Vx_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vx_wake2 = SrcOutputData%Vx_wake2 -ENDIF -IF (ALLOCATED(SrcOutputData%Vy_wake2)) THEN - i1_l = LBOUND(SrcOutputData%Vy_wake2,1) - i1_u = UBOUND(SrcOutputData%Vy_wake2,1) - i2_l = LBOUND(SrcOutputData%Vy_wake2,2) - i2_u = UBOUND(SrcOutputData%Vy_wake2,2) - i3_l = LBOUND(SrcOutputData%Vy_wake2,3) - i3_u = UBOUND(SrcOutputData%Vy_wake2,3) - IF (.NOT. ALLOCATED(DstOutputData%Vy_wake2)) THEN - ALLOCATE(DstOutputData%Vy_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vy_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vy_wake2 = SrcOutputData%Vy_wake2 -ENDIF -IF (ALLOCATED(SrcOutputData%Vz_wake2)) THEN - i1_l = LBOUND(SrcOutputData%Vz_wake2,1) - i1_u = UBOUND(SrcOutputData%Vz_wake2,1) - i2_l = LBOUND(SrcOutputData%Vz_wake2,2) - i2_u = UBOUND(SrcOutputData%Vz_wake2,2) - i3_l = LBOUND(SrcOutputData%Vz_wake2,3) - i3_u = UBOUND(SrcOutputData%Vz_wake2,3) - IF (.NOT. ALLOCATED(DstOutputData%Vz_wake2)) THEN - ALLOCATE(DstOutputData%Vz_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vz_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vz_wake2 = SrcOutputData%Vz_wake2 -ENDIF -IF (ALLOCATED(SrcOutputData%D_wake)) THEN - i1_l = LBOUND(SrcOutputData%D_wake,1) - i1_u = UBOUND(SrcOutputData%D_wake,1) - IF (.NOT. ALLOCATED(DstOutputData%D_wake)) THEN - ALLOCATE(DstOutputData%D_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%D_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%D_wake = SrcOutputData%D_wake -ENDIF -IF (ALLOCATED(SrcOutputData%x_plane)) THEN - i1_l = LBOUND(SrcOutputData%x_plane,1) - i1_u = UBOUND(SrcOutputData%x_plane,1) - IF (.NOT. ALLOCATED(DstOutputData%x_plane)) THEN - ALLOCATE(DstOutputData%x_plane(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%x_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%x_plane = SrcOutputData%x_plane -ENDIF -IF (ALLOCATED(SrcOutputData%WAT_k_mt)) THEN - i1_l = LBOUND(SrcOutputData%WAT_k_mt,1) - i1_u = UBOUND(SrcOutputData%WAT_k_mt,1) - i2_l = LBOUND(SrcOutputData%WAT_k_mt,2) - i2_u = UBOUND(SrcOutputData%WAT_k_mt,2) - i3_l = LBOUND(SrcOutputData%WAT_k_mt,3) - i3_u = UBOUND(SrcOutputData%WAT_k_mt,3) - IF (.NOT. ALLOCATED(DstOutputData%WAT_k_mt)) THEN - ALLOCATE(DstOutputData%WAT_k_mt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAT_k_mt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WAT_k_mt = SrcOutputData%WAT_k_mt -ENDIF - END SUBROUTINE WD_CopyOutput - - SUBROUTINE WD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(WD_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 = 'WD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%xhat_plane)) THEN - DEALLOCATE(OutputData%xhat_plane) -ENDIF -IF (ALLOCATED(OutputData%p_plane)) THEN - DEALLOCATE(OutputData%p_plane) -ENDIF -IF (ALLOCATED(OutputData%Vx_wake)) THEN - DEALLOCATE(OutputData%Vx_wake) -ENDIF -IF (ALLOCATED(OutputData%Vr_wake)) THEN - DEALLOCATE(OutputData%Vr_wake) -ENDIF -IF (ALLOCATED(OutputData%Vx_wake2)) THEN - DEALLOCATE(OutputData%Vx_wake2) -ENDIF -IF (ALLOCATED(OutputData%Vy_wake2)) THEN - DEALLOCATE(OutputData%Vy_wake2) -ENDIF -IF (ALLOCATED(OutputData%Vz_wake2)) THEN - DEALLOCATE(OutputData%Vz_wake2) -ENDIF -IF (ALLOCATED(OutputData%D_wake)) THEN - DEALLOCATE(OutputData%D_wake) -ENDIF -IF (ALLOCATED(OutputData%x_plane)) THEN - DEALLOCATE(OutputData%x_plane) -ENDIF -IF (ALLOCATED(OutputData%WAT_k_mt)) THEN - DEALLOCATE(OutputData%WAT_k_mt) -ENDIF - END SUBROUTINE WD_DestroyOutput - - SUBROUTINE WD_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(WD_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 = 'WD_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 ! xhat_plane allocated yes/no - IF ( ALLOCATED(InData%xhat_plane) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xhat_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xhat_plane) ! xhat_plane - END IF - Int_BufSz = Int_BufSz + 1 ! p_plane allocated yes/no - IF ( ALLOCATED(InData%p_plane) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! p_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%p_plane) ! p_plane - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wake allocated yes/no - IF ( ALLOCATED(InData%Vx_wake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vx_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wake) ! Vx_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vr_wake allocated yes/no - IF ( ALLOCATED(InData%Vr_wake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vr_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vr_wake) ! Vr_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vx_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vx_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wake2) ! Vx_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! Vy_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vy_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vy_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vy_wake2) ! Vy_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! Vz_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vz_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vz_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vz_wake2) ! Vz_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! D_wake allocated yes/no - IF ( ALLOCATED(InData%D_wake) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! D_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D_wake) ! D_wake - END IF - Int_BufSz = Int_BufSz + 1 ! x_plane allocated yes/no - IF ( ALLOCATED(InData%x_plane) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%x_plane) ! x_plane - END IF - Int_BufSz = Int_BufSz + 1 ! WAT_k_mt allocated yes/no - IF ( ALLOCATED(InData%WAT_k_mt) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WAT_k_mt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WAT_k_mt) ! WAT_k_mt - 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%xhat_plane) ) 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%xhat_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xhat_plane,2), UBOUND(InData%xhat_plane,2) - DO i1 = LBOUND(InData%xhat_plane,1), UBOUND(InData%xhat_plane,1) - ReKiBuf(Re_Xferred) = InData%xhat_plane(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%p_plane) ) 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%p_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%p_plane,2), UBOUND(InData%p_plane,2) - DO i1 = LBOUND(InData%p_plane,1), UBOUND(InData%p_plane,1) - ReKiBuf(Re_Xferred) = InData%p_plane(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wake) ) 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%Vx_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vx_wake,2), UBOUND(InData%Vx_wake,2) - DO i1 = LBOUND(InData%Vx_wake,1), UBOUND(InData%Vx_wake,1) - ReKiBuf(Re_Xferred) = InData%Vx_wake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vr_wake) ) 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%Vr_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vr_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vr_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vr_wake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vr_wake,2), UBOUND(InData%Vr_wake,2) - DO i1 = LBOUND(InData%Vr_wake,1), UBOUND(InData%Vr_wake,1) - ReKiBuf(Re_Xferred) = InData%Vr_wake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wake2) ) 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%Vx_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vx_wake2,3), UBOUND(InData%Vx_wake2,3) - DO i2 = LBOUND(InData%Vx_wake2,2), UBOUND(InData%Vx_wake2,2) - DO i1 = LBOUND(InData%Vx_wake2,1), UBOUND(InData%Vx_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vx_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vy_wake2) ) 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%Vy_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vy_wake2,3), UBOUND(InData%Vy_wake2,3) - DO i2 = LBOUND(InData%Vy_wake2,2), UBOUND(InData%Vy_wake2,2) - DO i1 = LBOUND(InData%Vy_wake2,1), UBOUND(InData%Vy_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vy_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vz_wake2) ) 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%Vz_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vz_wake2,3), UBOUND(InData%Vz_wake2,3) - DO i2 = LBOUND(InData%Vz_wake2,2), UBOUND(InData%Vz_wake2,2) - DO i1 = LBOUND(InData%Vz_wake2,1), UBOUND(InData%Vz_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vz_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D_wake) ) 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%D_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_wake,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%D_wake,1), UBOUND(InData%D_wake,1) - ReKiBuf(Re_Xferred) = InData%D_wake(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_plane) ) 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%x_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_plane,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_plane,1), UBOUND(InData%x_plane,1) - ReKiBuf(Re_Xferred) = InData%x_plane(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WAT_k_mt) ) 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%WAT_k_mt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WAT_k_mt,3), UBOUND(InData%WAT_k_mt,3) - DO i2 = LBOUND(InData%WAT_k_mt,2), UBOUND(InData%WAT_k_mt,2) - DO i1 = LBOUND(InData%WAT_k_mt,1), UBOUND(InData%WAT_k_mt,1) - ReKiBuf(Re_Xferred) = InData%WAT_k_mt(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE WD_PackOutput - - SUBROUTINE WD_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(WD_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) :: 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_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 ! xhat_plane 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%xhat_plane)) DEALLOCATE(OutData%xhat_plane) - ALLOCATE(OutData%xhat_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xhat_plane,2), UBOUND(OutData%xhat_plane,2) - DO i1 = LBOUND(OutData%xhat_plane,1), UBOUND(OutData%xhat_plane,1) - OutData%xhat_plane(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p_plane 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%p_plane)) DEALLOCATE(OutData%p_plane) - ALLOCATE(OutData%p_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%p_plane,2), UBOUND(OutData%p_plane,2) - DO i1 = LBOUND(OutData%p_plane,1), UBOUND(OutData%p_plane,1) - OutData%p_plane(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wake 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%Vx_wake)) DEALLOCATE(OutData%Vx_wake) - ALLOCATE(OutData%Vx_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vx_wake,2), UBOUND(OutData%Vx_wake,2) - DO i1 = LBOUND(OutData%Vx_wake,1), UBOUND(OutData%Vx_wake,1) - OutData%Vx_wake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vr_wake 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%Vr_wake)) DEALLOCATE(OutData%Vr_wake) - ALLOCATE(OutData%Vr_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vr_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vr_wake,2), UBOUND(OutData%Vr_wake,2) - DO i1 = LBOUND(OutData%Vr_wake,1), UBOUND(OutData%Vr_wake,1) - OutData%Vr_wake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wake2 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%Vx_wake2)) DEALLOCATE(OutData%Vx_wake2) - ALLOCATE(OutData%Vx_wake2(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%Vx_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vx_wake2,3), UBOUND(OutData%Vx_wake2,3) - DO i2 = LBOUND(OutData%Vx_wake2,2), UBOUND(OutData%Vx_wake2,2) - DO i1 = LBOUND(OutData%Vx_wake2,1), UBOUND(OutData%Vx_wake2,1) - OutData%Vx_wake2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vy_wake2 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%Vy_wake2)) DEALLOCATE(OutData%Vy_wake2) - ALLOCATE(OutData%Vy_wake2(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%Vy_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vy_wake2,3), UBOUND(OutData%Vy_wake2,3) - DO i2 = LBOUND(OutData%Vy_wake2,2), UBOUND(OutData%Vy_wake2,2) - DO i1 = LBOUND(OutData%Vy_wake2,1), UBOUND(OutData%Vy_wake2,1) - OutData%Vy_wake2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vz_wake2 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%Vz_wake2)) DEALLOCATE(OutData%Vz_wake2) - ALLOCATE(OutData%Vz_wake2(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%Vz_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vz_wake2,3), UBOUND(OutData%Vz_wake2,3) - DO i2 = LBOUND(OutData%Vz_wake2,2), UBOUND(OutData%Vz_wake2,2) - DO i1 = LBOUND(OutData%Vz_wake2,1), UBOUND(OutData%Vz_wake2,1) - OutData%Vz_wake2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_wake 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%D_wake)) DEALLOCATE(OutData%D_wake) - ALLOCATE(OutData%D_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%D_wake,1), UBOUND(OutData%D_wake,1) - OutData%D_wake(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_plane 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%x_plane)) DEALLOCATE(OutData%x_plane) - ALLOCATE(OutData%x_plane(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_plane,1), UBOUND(OutData%x_plane,1) - OutData%x_plane(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAT_k_mt 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%WAT_k_mt)) DEALLOCATE(OutData%WAT_k_mt) - ALLOCATE(OutData%WAT_k_mt(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%WAT_k_mt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WAT_k_mt,3), UBOUND(OutData%WAT_k_mt,3) - DO i2 = LBOUND(OutData%WAT_k_mt,2), UBOUND(OutData%WAT_k_mt,2) - DO i1 = LBOUND(OutData%WAT_k_mt,1), UBOUND(OutData%WAT_k_mt,1) - OutData%WAT_k_mt(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE WD_UnPackOutput - + ErrMsg = '' + if (allocated(DiscStateData%xhat_plane)) then + deallocate(DiscStateData%xhat_plane) + end if + if (allocated(DiscStateData%YawErr_filt)) then + deallocate(DiscStateData%YawErr_filt) + end if + if (allocated(DiscStateData%V_plane_filt)) then + deallocate(DiscStateData%V_plane_filt) + end if + if (allocated(DiscStateData%p_plane)) then + deallocate(DiscStateData%p_plane) + end if + if (allocated(DiscStateData%x_plane)) then + deallocate(DiscStateData%x_plane) + end if + if (allocated(DiscStateData%Vx_wake)) then + deallocate(DiscStateData%Vx_wake) + end if + if (allocated(DiscStateData%Vr_wake)) then + deallocate(DiscStateData%Vr_wake) + end if + if (allocated(DiscStateData%Vx_wake2)) then + deallocate(DiscStateData%Vx_wake2) + end if + if (allocated(DiscStateData%Vy_wake2)) then + deallocate(DiscStateData%Vy_wake2) + end if + if (allocated(DiscStateData%Vz_wake2)) then + deallocate(DiscStateData%Vz_wake2) + end if + if (allocated(DiscStateData%Vx_wind_disk_filt)) then + deallocate(DiscStateData%Vx_wind_disk_filt) + end if + if (allocated(DiscStateData%TI_amb_filt)) then + deallocate(DiscStateData%TI_amb_filt) + end if + if (allocated(DiscStateData%D_rotor_filt)) then + deallocate(DiscStateData%D_rotor_filt) + end if + if (allocated(DiscStateData%Ct_azavg_filt)) then + deallocate(DiscStateData%Ct_azavg_filt) + end if + if (allocated(DiscStateData%Cq_azavg_filt)) then + deallocate(DiscStateData%Cq_azavg_filt) + end if +end subroutine + +subroutine WD_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%xhat_plane)) + if (allocated(InData%xhat_plane)) then + call RegPackBounds(Buf, 2, lbound(InData%xhat_plane), ubound(InData%xhat_plane)) + call RegPack(Buf, InData%xhat_plane) + end if + call RegPack(Buf, allocated(InData%YawErr_filt)) + if (allocated(InData%YawErr_filt)) then + call RegPackBounds(Buf, 1, lbound(InData%YawErr_filt), ubound(InData%YawErr_filt)) + call RegPack(Buf, InData%YawErr_filt) + end if + call RegPack(Buf, InData%psi_skew_filt) + call RegPack(Buf, InData%chi_skew_filt) + call RegPack(Buf, allocated(InData%V_plane_filt)) + if (allocated(InData%V_plane_filt)) then + call RegPackBounds(Buf, 2, lbound(InData%V_plane_filt), ubound(InData%V_plane_filt)) + call RegPack(Buf, InData%V_plane_filt) + end if + call RegPack(Buf, allocated(InData%p_plane)) + if (allocated(InData%p_plane)) then + call RegPackBounds(Buf, 2, lbound(InData%p_plane), ubound(InData%p_plane)) + call RegPack(Buf, InData%p_plane) + end if + call RegPack(Buf, allocated(InData%x_plane)) + if (allocated(InData%x_plane)) then + call RegPackBounds(Buf, 1, lbound(InData%x_plane), ubound(InData%x_plane)) + call RegPack(Buf, InData%x_plane) + end if + call RegPack(Buf, allocated(InData%Vx_wake)) + if (allocated(InData%Vx_wake)) then + call RegPackBounds(Buf, 2, lbound(InData%Vx_wake), ubound(InData%Vx_wake)) + call RegPack(Buf, InData%Vx_wake) + end if + call RegPack(Buf, allocated(InData%Vr_wake)) + if (allocated(InData%Vr_wake)) then + call RegPackBounds(Buf, 2, lbound(InData%Vr_wake), ubound(InData%Vr_wake)) + call RegPack(Buf, InData%Vr_wake) + end if + call RegPack(Buf, allocated(InData%Vx_wake2)) + if (allocated(InData%Vx_wake2)) then + call RegPackBounds(Buf, 3, lbound(InData%Vx_wake2), ubound(InData%Vx_wake2)) + call RegPack(Buf, InData%Vx_wake2) + end if + call RegPack(Buf, allocated(InData%Vy_wake2)) + if (allocated(InData%Vy_wake2)) then + call RegPackBounds(Buf, 3, lbound(InData%Vy_wake2), ubound(InData%Vy_wake2)) + call RegPack(Buf, InData%Vy_wake2) + end if + call RegPack(Buf, allocated(InData%Vz_wake2)) + if (allocated(InData%Vz_wake2)) then + call RegPackBounds(Buf, 3, lbound(InData%Vz_wake2), ubound(InData%Vz_wake2)) + call RegPack(Buf, InData%Vz_wake2) + end if + call RegPack(Buf, allocated(InData%Vx_wind_disk_filt)) + if (allocated(InData%Vx_wind_disk_filt)) then + call RegPackBounds(Buf, 1, lbound(InData%Vx_wind_disk_filt), ubound(InData%Vx_wind_disk_filt)) + call RegPack(Buf, InData%Vx_wind_disk_filt) + end if + call RegPack(Buf, allocated(InData%TI_amb_filt)) + if (allocated(InData%TI_amb_filt)) then + call RegPackBounds(Buf, 1, lbound(InData%TI_amb_filt), ubound(InData%TI_amb_filt)) + call RegPack(Buf, InData%TI_amb_filt) + end if + call RegPack(Buf, allocated(InData%D_rotor_filt)) + if (allocated(InData%D_rotor_filt)) then + call RegPackBounds(Buf, 1, lbound(InData%D_rotor_filt), ubound(InData%D_rotor_filt)) + call RegPack(Buf, InData%D_rotor_filt) + end if + call RegPack(Buf, InData%Vx_rel_disk_filt) + call RegPack(Buf, allocated(InData%Ct_azavg_filt)) + if (allocated(InData%Ct_azavg_filt)) then + call RegPackBounds(Buf, 1, lbound(InData%Ct_azavg_filt), ubound(InData%Ct_azavg_filt)) + call RegPack(Buf, InData%Ct_azavg_filt) + end if + call RegPack(Buf, allocated(InData%Cq_azavg_filt)) + if (allocated(InData%Cq_azavg_filt)) then + call RegPackBounds(Buf, 1, lbound(InData%Cq_azavg_filt), ubound(InData%Cq_azavg_filt)) + call RegPack(Buf, InData%Cq_azavg_filt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackDiscState' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%xhat_plane)) deallocate(OutData%xhat_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xhat_plane(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xhat_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%YawErr_filt)) deallocate(OutData%YawErr_filt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%YawErr_filt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%YawErr_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%YawErr_filt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%psi_skew_filt) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%chi_skew_filt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%V_plane_filt)) deallocate(OutData%V_plane_filt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V_plane_filt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V_plane_filt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%p_plane)) deallocate(OutData%p_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%p_plane(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%p_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%x_plane)) deallocate(OutData%x_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_plane(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vx_wake)) deallocate(OutData%Vx_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_wake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vr_wake)) deallocate(OutData%Vr_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vr_wake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vr_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vr_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vx_wake2)) deallocate(OutData%Vx_wake2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_wake2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vy_wake2)) deallocate(OutData%Vy_wake2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vy_wake2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vz_wake2)) deallocate(OutData%Vz_wake2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vz_wake2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vx_wind_disk_filt)) deallocate(OutData%Vx_wind_disk_filt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_wind_disk_filt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wind_disk_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_wind_disk_filt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%TI_amb_filt)) deallocate(OutData%TI_amb_filt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TI_amb_filt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_amb_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TI_amb_filt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%D_rotor_filt)) deallocate(OutData%D_rotor_filt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D_rotor_filt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_rotor_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D_rotor_filt) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Vx_rel_disk_filt) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Ct_azavg_filt)) deallocate(OutData%Ct_azavg_filt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ct_azavg_filt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ct_azavg_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ct_azavg_filt) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cq_azavg_filt)) deallocate(OutData%Cq_azavg_filt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cq_azavg_filt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cq_azavg_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cq_azavg_filt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine WD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(WD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(WD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine WD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(WD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine WD_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(WD_OtherStateType), intent(in) :: SrcOtherStateData + type(WD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%firstPass = SrcOtherStateData%firstPass +end subroutine + +subroutine WD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(WD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine WD_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%firstPass) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%firstPass) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(WD_MiscVarType), intent(in) :: SrcMiscData + type(WD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%dvtdr)) then + LB(1:1) = lbound(SrcMiscData%dvtdr) + UB(1:1) = ubound(SrcMiscData%dvtdr) + if (.not. allocated(DstMiscData%dvtdr)) then + allocate(DstMiscData%dvtdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvtdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dvtdr = SrcMiscData%dvtdr + end if + if (allocated(SrcMiscData%vt_tot)) then + LB(1:2) = lbound(SrcMiscData%vt_tot) + UB(1:2) = ubound(SrcMiscData%vt_tot) + if (.not. allocated(DstMiscData%vt_tot)) then + allocate(DstMiscData%vt_tot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_tot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vt_tot = SrcMiscData%vt_tot + end if + if (allocated(SrcMiscData%vt_amb)) then + LB(1:2) = lbound(SrcMiscData%vt_amb) + UB(1:2) = ubound(SrcMiscData%vt_amb) + if (.not. allocated(DstMiscData%vt_amb)) then + allocate(DstMiscData%vt_amb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_amb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vt_amb = SrcMiscData%vt_amb + end if + if (allocated(SrcMiscData%vt_shr)) then + LB(1:2) = lbound(SrcMiscData%vt_shr) + UB(1:2) = ubound(SrcMiscData%vt_shr) + if (.not. allocated(DstMiscData%vt_shr)) then + allocate(DstMiscData%vt_shr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_shr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vt_shr = SrcMiscData%vt_shr + end if + if (allocated(SrcMiscData%vt_tot2)) then + LB(1:3) = lbound(SrcMiscData%vt_tot2) + UB(1:3) = ubound(SrcMiscData%vt_tot2) + if (.not. allocated(DstMiscData%vt_tot2)) then + allocate(DstMiscData%vt_tot2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_tot2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vt_tot2 = SrcMiscData%vt_tot2 + end if + if (allocated(SrcMiscData%vt_amb2)) then + LB(1:3) = lbound(SrcMiscData%vt_amb2) + UB(1:3) = ubound(SrcMiscData%vt_amb2) + if (.not. allocated(DstMiscData%vt_amb2)) then + allocate(DstMiscData%vt_amb2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_amb2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vt_amb2 = SrcMiscData%vt_amb2 + end if + if (allocated(SrcMiscData%vt_shr2)) then + LB(1:3) = lbound(SrcMiscData%vt_shr2) + UB(1:3) = ubound(SrcMiscData%vt_shr2) + if (.not. allocated(DstMiscData%vt_shr2)) then + allocate(DstMiscData%vt_shr2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_shr2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vt_shr2 = SrcMiscData%vt_shr2 + end if + if (allocated(SrcMiscData%dvx_dy)) then + LB(1:3) = lbound(SrcMiscData%dvx_dy) + UB(1:3) = ubound(SrcMiscData%dvx_dy) + if (.not. allocated(DstMiscData%dvx_dy)) then + allocate(DstMiscData%dvx_dy(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvx_dy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dvx_dy = SrcMiscData%dvx_dy + end if + if (allocated(SrcMiscData%dvx_dz)) then + LB(1:3) = lbound(SrcMiscData%dvx_dz) + UB(1:3) = ubound(SrcMiscData%dvx_dz) + if (.not. allocated(DstMiscData%dvx_dz)) then + allocate(DstMiscData%dvx_dz(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvx_dz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dvx_dz = SrcMiscData%dvx_dz + end if + if (allocated(SrcMiscData%nu_dvx_dy)) then + LB(1:2) = lbound(SrcMiscData%nu_dvx_dy) + UB(1:2) = ubound(SrcMiscData%nu_dvx_dy) + if (.not. allocated(DstMiscData%nu_dvx_dy)) then + allocate(DstMiscData%nu_dvx_dy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nu_dvx_dy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%nu_dvx_dy = SrcMiscData%nu_dvx_dy + end if + if (allocated(SrcMiscData%nu_dvx_dz)) then + LB(1:2) = lbound(SrcMiscData%nu_dvx_dz) + UB(1:2) = ubound(SrcMiscData%nu_dvx_dz) + if (.not. allocated(DstMiscData%nu_dvx_dz)) then + allocate(DstMiscData%nu_dvx_dz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nu_dvx_dz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%nu_dvx_dz = SrcMiscData%nu_dvx_dz + end if + if (allocated(SrcMiscData%dnuvx_dy)) then + LB(1:2) = lbound(SrcMiscData%dnuvx_dy) + UB(1:2) = ubound(SrcMiscData%dnuvx_dy) + if (.not. allocated(DstMiscData%dnuvx_dy)) then + allocate(DstMiscData%dnuvx_dy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dnuvx_dy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dnuvx_dy = SrcMiscData%dnuvx_dy + end if + if (allocated(SrcMiscData%dnuvx_dz)) then + LB(1:2) = lbound(SrcMiscData%dnuvx_dz) + UB(1:2) = ubound(SrcMiscData%dnuvx_dz) + if (.not. allocated(DstMiscData%dnuvx_dz)) then + allocate(DstMiscData%dnuvx_dz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dnuvx_dz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dnuvx_dz = SrcMiscData%dnuvx_dz + end if + if (allocated(SrcMiscData%a)) then + LB(1:1) = lbound(SrcMiscData%a) + UB(1:1) = ubound(SrcMiscData%a) + if (.not. allocated(DstMiscData%a)) then + allocate(DstMiscData%a(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%a.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%a = SrcMiscData%a + end if + if (allocated(SrcMiscData%b)) then + LB(1:1) = lbound(SrcMiscData%b) + UB(1:1) = ubound(SrcMiscData%b) + if (.not. allocated(DstMiscData%b)) then + allocate(DstMiscData%b(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%b.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%b = SrcMiscData%b + end if + if (allocated(SrcMiscData%c)) then + LB(1:1) = lbound(SrcMiscData%c) + UB(1:1) = ubound(SrcMiscData%c) + if (.not. allocated(DstMiscData%c)) then + allocate(DstMiscData%c(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%c = SrcMiscData%c + end if + if (allocated(SrcMiscData%d)) then + LB(1:1) = lbound(SrcMiscData%d) + UB(1:1) = ubound(SrcMiscData%d) + if (.not. allocated(DstMiscData%d)) then + allocate(DstMiscData%d(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%d.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%d = SrcMiscData%d + end if + if (allocated(SrcMiscData%r_wake)) then + LB(1:1) = lbound(SrcMiscData%r_wake) + UB(1:1) = ubound(SrcMiscData%r_wake) + if (.not. allocated(DstMiscData%r_wake)) then + allocate(DstMiscData%r_wake(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%r_wake = SrcMiscData%r_wake + end if + if (allocated(SrcMiscData%Vx_high)) then + LB(1:1) = lbound(SrcMiscData%Vx_high) + UB(1:1) = ubound(SrcMiscData%Vx_high) + if (.not. allocated(DstMiscData%Vx_high)) then + allocate(DstMiscData%Vx_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vx_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vx_high = SrcMiscData%Vx_high + end if + if (allocated(SrcMiscData%Vx_polar)) then + LB(1:1) = lbound(SrcMiscData%Vx_polar) + UB(1:1) = ubound(SrcMiscData%Vx_polar) + if (.not. allocated(DstMiscData%Vx_polar)) then + allocate(DstMiscData%Vx_polar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vx_polar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vx_polar = SrcMiscData%Vx_polar + end if + if (allocated(SrcMiscData%Vt_wake)) then + LB(1:1) = lbound(SrcMiscData%Vt_wake) + UB(1:1) = ubound(SrcMiscData%Vt_wake) + if (.not. allocated(DstMiscData%Vt_wake)) then + allocate(DstMiscData%Vt_wake(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vt_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vt_wake = SrcMiscData%Vt_wake + end if + DstMiscData%GammaCurl = SrcMiscData%GammaCurl + DstMiscData%Ct_avg = SrcMiscData%Ct_avg +end subroutine + +subroutine WD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(WD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%dvtdr)) then + deallocate(MiscData%dvtdr) + end if + if (allocated(MiscData%vt_tot)) then + deallocate(MiscData%vt_tot) + end if + if (allocated(MiscData%vt_amb)) then + deallocate(MiscData%vt_amb) + end if + if (allocated(MiscData%vt_shr)) then + deallocate(MiscData%vt_shr) + end if + if (allocated(MiscData%vt_tot2)) then + deallocate(MiscData%vt_tot2) + end if + if (allocated(MiscData%vt_amb2)) then + deallocate(MiscData%vt_amb2) + end if + if (allocated(MiscData%vt_shr2)) then + deallocate(MiscData%vt_shr2) + end if + if (allocated(MiscData%dvx_dy)) then + deallocate(MiscData%dvx_dy) + end if + if (allocated(MiscData%dvx_dz)) then + deallocate(MiscData%dvx_dz) + end if + if (allocated(MiscData%nu_dvx_dy)) then + deallocate(MiscData%nu_dvx_dy) + end if + if (allocated(MiscData%nu_dvx_dz)) then + deallocate(MiscData%nu_dvx_dz) + end if + if (allocated(MiscData%dnuvx_dy)) then + deallocate(MiscData%dnuvx_dy) + end if + if (allocated(MiscData%dnuvx_dz)) then + deallocate(MiscData%dnuvx_dz) + end if + if (allocated(MiscData%a)) then + deallocate(MiscData%a) + end if + if (allocated(MiscData%b)) then + deallocate(MiscData%b) + end if + if (allocated(MiscData%c)) then + deallocate(MiscData%c) + end if + if (allocated(MiscData%d)) then + deallocate(MiscData%d) + end if + if (allocated(MiscData%r_wake)) then + deallocate(MiscData%r_wake) + end if + if (allocated(MiscData%Vx_high)) then + deallocate(MiscData%Vx_high) + end if + if (allocated(MiscData%Vx_polar)) then + deallocate(MiscData%Vx_polar) + end if + if (allocated(MiscData%Vt_wake)) then + deallocate(MiscData%Vt_wake) + end if +end subroutine + +subroutine WD_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%dvtdr)) + if (allocated(InData%dvtdr)) then + call RegPackBounds(Buf, 1, lbound(InData%dvtdr), ubound(InData%dvtdr)) + call RegPack(Buf, InData%dvtdr) + end if + call RegPack(Buf, allocated(InData%vt_tot)) + if (allocated(InData%vt_tot)) then + call RegPackBounds(Buf, 2, lbound(InData%vt_tot), ubound(InData%vt_tot)) + call RegPack(Buf, InData%vt_tot) + end if + call RegPack(Buf, allocated(InData%vt_amb)) + if (allocated(InData%vt_amb)) then + call RegPackBounds(Buf, 2, lbound(InData%vt_amb), ubound(InData%vt_amb)) + call RegPack(Buf, InData%vt_amb) + end if + call RegPack(Buf, allocated(InData%vt_shr)) + if (allocated(InData%vt_shr)) then + call RegPackBounds(Buf, 2, lbound(InData%vt_shr), ubound(InData%vt_shr)) + call RegPack(Buf, InData%vt_shr) + end if + call RegPack(Buf, allocated(InData%vt_tot2)) + if (allocated(InData%vt_tot2)) then + call RegPackBounds(Buf, 3, lbound(InData%vt_tot2), ubound(InData%vt_tot2)) + call RegPack(Buf, InData%vt_tot2) + end if + call RegPack(Buf, allocated(InData%vt_amb2)) + if (allocated(InData%vt_amb2)) then + call RegPackBounds(Buf, 3, lbound(InData%vt_amb2), ubound(InData%vt_amb2)) + call RegPack(Buf, InData%vt_amb2) + end if + call RegPack(Buf, allocated(InData%vt_shr2)) + if (allocated(InData%vt_shr2)) then + call RegPackBounds(Buf, 3, lbound(InData%vt_shr2), ubound(InData%vt_shr2)) + call RegPack(Buf, InData%vt_shr2) + end if + call RegPack(Buf, allocated(InData%dvx_dy)) + if (allocated(InData%dvx_dy)) then + call RegPackBounds(Buf, 3, lbound(InData%dvx_dy), ubound(InData%dvx_dy)) + call RegPack(Buf, InData%dvx_dy) + end if + call RegPack(Buf, allocated(InData%dvx_dz)) + if (allocated(InData%dvx_dz)) then + call RegPackBounds(Buf, 3, lbound(InData%dvx_dz), ubound(InData%dvx_dz)) + call RegPack(Buf, InData%dvx_dz) + end if + call RegPack(Buf, allocated(InData%nu_dvx_dy)) + if (allocated(InData%nu_dvx_dy)) then + call RegPackBounds(Buf, 2, lbound(InData%nu_dvx_dy), ubound(InData%nu_dvx_dy)) + call RegPack(Buf, InData%nu_dvx_dy) + end if + call RegPack(Buf, allocated(InData%nu_dvx_dz)) + if (allocated(InData%nu_dvx_dz)) then + call RegPackBounds(Buf, 2, lbound(InData%nu_dvx_dz), ubound(InData%nu_dvx_dz)) + call RegPack(Buf, InData%nu_dvx_dz) + end if + call RegPack(Buf, allocated(InData%dnuvx_dy)) + if (allocated(InData%dnuvx_dy)) then + call RegPackBounds(Buf, 2, lbound(InData%dnuvx_dy), ubound(InData%dnuvx_dy)) + call RegPack(Buf, InData%dnuvx_dy) + end if + call RegPack(Buf, allocated(InData%dnuvx_dz)) + if (allocated(InData%dnuvx_dz)) then + call RegPackBounds(Buf, 2, lbound(InData%dnuvx_dz), ubound(InData%dnuvx_dz)) + call RegPack(Buf, InData%dnuvx_dz) + end if + call RegPack(Buf, allocated(InData%a)) + if (allocated(InData%a)) then + call RegPackBounds(Buf, 1, lbound(InData%a), ubound(InData%a)) + call RegPack(Buf, InData%a) + end if + call RegPack(Buf, allocated(InData%b)) + if (allocated(InData%b)) then + call RegPackBounds(Buf, 1, lbound(InData%b), ubound(InData%b)) + call RegPack(Buf, InData%b) + end if + call RegPack(Buf, allocated(InData%c)) + if (allocated(InData%c)) then + call RegPackBounds(Buf, 1, lbound(InData%c), ubound(InData%c)) + call RegPack(Buf, InData%c) + end if + call RegPack(Buf, allocated(InData%d)) + if (allocated(InData%d)) then + call RegPackBounds(Buf, 1, lbound(InData%d), ubound(InData%d)) + call RegPack(Buf, InData%d) + end if + call RegPack(Buf, allocated(InData%r_wake)) + if (allocated(InData%r_wake)) then + call RegPackBounds(Buf, 1, lbound(InData%r_wake), ubound(InData%r_wake)) + call RegPack(Buf, InData%r_wake) + end if + call RegPack(Buf, allocated(InData%Vx_high)) + if (allocated(InData%Vx_high)) then + call RegPackBounds(Buf, 1, lbound(InData%Vx_high), ubound(InData%Vx_high)) + call RegPack(Buf, InData%Vx_high) + end if + call RegPack(Buf, allocated(InData%Vx_polar)) + if (allocated(InData%Vx_polar)) then + call RegPackBounds(Buf, 1, lbound(InData%Vx_polar), ubound(InData%Vx_polar)) + call RegPack(Buf, InData%Vx_polar) + end if + call RegPack(Buf, allocated(InData%Vt_wake)) + if (allocated(InData%Vt_wake)) then + call RegPackBounds(Buf, 1, lbound(InData%Vt_wake), ubound(InData%Vt_wake)) + call RegPack(Buf, InData%Vt_wake) + end if + call RegPack(Buf, InData%GammaCurl) + call RegPack(Buf, InData%Ct_avg) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackMisc' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%dvtdr)) deallocate(OutData%dvtdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dvtdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dvtdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dvtdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%vt_tot)) deallocate(OutData%vt_tot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vt_tot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_tot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vt_tot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%vt_amb)) deallocate(OutData%vt_amb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vt_amb(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_amb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vt_amb) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%vt_shr)) deallocate(OutData%vt_shr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vt_shr(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_shr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vt_shr) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%vt_tot2)) deallocate(OutData%vt_tot2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vt_tot2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_tot2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vt_tot2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%vt_amb2)) deallocate(OutData%vt_amb2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vt_amb2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_amb2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vt_amb2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%vt_shr2)) deallocate(OutData%vt_shr2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vt_shr2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_shr2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vt_shr2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dvx_dy)) deallocate(OutData%dvx_dy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dvx_dy(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dvx_dy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dvx_dy) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dvx_dz)) deallocate(OutData%dvx_dz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dvx_dz(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dvx_dz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dvx_dz) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%nu_dvx_dy)) deallocate(OutData%nu_dvx_dy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%nu_dvx_dy(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nu_dvx_dy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%nu_dvx_dy) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%nu_dvx_dz)) deallocate(OutData%nu_dvx_dz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%nu_dvx_dz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nu_dvx_dz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%nu_dvx_dz) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dnuvx_dy)) deallocate(OutData%dnuvx_dy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dnuvx_dy(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dnuvx_dy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dnuvx_dy) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%dnuvx_dz)) deallocate(OutData%dnuvx_dz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dnuvx_dz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dnuvx_dz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dnuvx_dz) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%a)) deallocate(OutData%a) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%a(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%a.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%a) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%b)) deallocate(OutData%b) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%b(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%b.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%b) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%c)) deallocate(OutData%c) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%c(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%c) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%d)) deallocate(OutData%d) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%d(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%d.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%d) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%r_wake)) deallocate(OutData%r_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_wake(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vx_high)) deallocate(OutData%Vx_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vx_polar)) deallocate(OutData%Vx_polar) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_polar(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_polar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_polar) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vt_wake)) deallocate(OutData%Vt_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vt_wake(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vt_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vt_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%GammaCurl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Ct_avg) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(WD_ParameterType), intent(in) :: SrcParamData + type(WD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%dt_low = SrcParamData%dt_low + DstParamData%NumPlanes = SrcParamData%NumPlanes + DstParamData%NumRadii = SrcParamData%NumRadii + DstParamData%dr = SrcParamData%dr + if (allocated(SrcParamData%r)) then + LB(1:1) = lbound(SrcParamData%r) + UB(1:1) = ubound(SrcParamData%r) + if (.not. allocated(DstParamData%r)) then + allocate(DstParamData%r(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%r.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%r = SrcParamData%r + end if + if (allocated(SrcParamData%y)) then + LB(1:1) = lbound(SrcParamData%y) + UB(1:1) = ubound(SrcParamData%y) + if (.not. allocated(DstParamData%y)) then + allocate(DstParamData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%y = SrcParamData%y + end if + if (allocated(SrcParamData%z)) then + LB(1:1) = lbound(SrcParamData%z) + UB(1:1) = ubound(SrcParamData%z) + if (.not. allocated(DstParamData%z)) then + allocate(DstParamData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%z = SrcParamData%z + end if + DstParamData%Mod_Wake = SrcParamData%Mod_Wake + DstParamData%Swirl = SrcParamData%Swirl + DstParamData%k_VortexDecay = SrcParamData%k_VortexDecay + DstParamData%sigma_D = SrcParamData%sigma_D + DstParamData%NumVortices = SrcParamData%NumVortices + DstParamData%filtParam = SrcParamData%filtParam + DstParamData%oneMinusFiltParam = SrcParamData%oneMinusFiltParam + DstParamData%C_HWkDfl_O = SrcParamData%C_HWkDfl_O + DstParamData%C_HWkDfl_OY = SrcParamData%C_HWkDfl_OY + DstParamData%C_HWkDfl_x = SrcParamData%C_HWkDfl_x + DstParamData%C_HWkDfl_xY = SrcParamData%C_HWkDfl_xY + DstParamData%C_NearWake = SrcParamData%C_NearWake + DstParamData%C_vAmb_DMin = SrcParamData%C_vAmb_DMin + DstParamData%C_vAmb_DMax = SrcParamData%C_vAmb_DMax + DstParamData%C_vAmb_FMin = SrcParamData%C_vAmb_FMin + DstParamData%C_vAmb_Exp = SrcParamData%C_vAmb_Exp + DstParamData%C_vShr_DMin = SrcParamData%C_vShr_DMin + DstParamData%C_vShr_DMax = SrcParamData%C_vShr_DMax + DstParamData%C_vShr_FMin = SrcParamData%C_vShr_FMin + DstParamData%C_vShr_Exp = SrcParamData%C_vShr_Exp + DstParamData%k_vAmb = SrcParamData%k_vAmb + DstParamData%k_vShr = SrcParamData%k_vShr + DstParamData%Mod_WakeDiam = SrcParamData%Mod_WakeDiam + DstParamData%C_WakeDiam = SrcParamData%C_WakeDiam + DstParamData%FilterInit = SrcParamData%FilterInit + DstParamData%k_vCurl = SrcParamData%k_vCurl + DstParamData%OutAllPlanes = SrcParamData%OutAllPlanes + DstParamData%OutFileRoot = SrcParamData%OutFileRoot + DstParamData%OutFileVTKDir = SrcParamData%OutFileVTKDir + DstParamData%TurbNum = SrcParamData%TurbNum + DstParamData%WAT = SrcParamData%WAT + DstParamData%WAT_k_Def = SrcParamData%WAT_k_Def + DstParamData%WAT_k_Grad = SrcParamData%WAT_k_Grad +end subroutine + +subroutine WD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(WD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%r)) then + deallocate(ParamData%r) + end if + if (allocated(ParamData%y)) then + deallocate(ParamData%y) + end if + if (allocated(ParamData%z)) then + deallocate(ParamData%z) + end if +end subroutine + +subroutine WD_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%dt_low) + call RegPack(Buf, InData%NumPlanes) + call RegPack(Buf, InData%NumRadii) + call RegPack(Buf, InData%dr) + call RegPack(Buf, allocated(InData%r)) + if (allocated(InData%r)) then + call RegPackBounds(Buf, 1, lbound(InData%r), ubound(InData%r)) + call RegPack(Buf, InData%r) + end if + call RegPack(Buf, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPack(Buf, InData%y) + end if + call RegPack(Buf, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + call RegPack(Buf, InData%z) + end if + call RegPack(Buf, InData%Mod_Wake) + call RegPack(Buf, InData%Swirl) + call RegPack(Buf, InData%k_VortexDecay) + call RegPack(Buf, InData%sigma_D) + call RegPack(Buf, InData%NumVortices) + call RegPack(Buf, InData%filtParam) + call RegPack(Buf, InData%oneMinusFiltParam) + call RegPack(Buf, InData%C_HWkDfl_O) + call RegPack(Buf, InData%C_HWkDfl_OY) + call RegPack(Buf, InData%C_HWkDfl_x) + call RegPack(Buf, InData%C_HWkDfl_xY) + call RegPack(Buf, InData%C_NearWake) + call RegPack(Buf, InData%C_vAmb_DMin) + call RegPack(Buf, InData%C_vAmb_DMax) + call RegPack(Buf, InData%C_vAmb_FMin) + call RegPack(Buf, InData%C_vAmb_Exp) + call RegPack(Buf, InData%C_vShr_DMin) + call RegPack(Buf, InData%C_vShr_DMax) + call RegPack(Buf, InData%C_vShr_FMin) + call RegPack(Buf, InData%C_vShr_Exp) + call RegPack(Buf, InData%k_vAmb) + call RegPack(Buf, InData%k_vShr) + call RegPack(Buf, InData%Mod_WakeDiam) + call RegPack(Buf, InData%C_WakeDiam) + call RegPack(Buf, InData%FilterInit) + call RegPack(Buf, InData%k_vCurl) + call RegPack(Buf, InData%OutAllPlanes) + call RegPack(Buf, InData%OutFileRoot) + call RegPack(Buf, InData%OutFileVTKDir) + call RegPack(Buf, InData%TurbNum) + call RegPack(Buf, InData%WAT) + call RegPack(Buf, InData%WAT_k_Def) + call RegPack(Buf, InData%WAT_k_Grad) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackParam' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%dt_low) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumPlanes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumRadii) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%dr) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%r)) deallocate(OutData%r) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%z) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Mod_Wake) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Swirl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k_VortexDecay) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%sigma_D) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumVortices) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%filtParam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%oneMinusFiltParam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_HWkDfl_O) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_HWkDfl_OY) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_HWkDfl_x) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_HWkDfl_xY) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_NearWake) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vAmb_DMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vAmb_DMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vAmb_FMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vAmb_Exp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vShr_DMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vShr_DMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vShr_FMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_vShr_Exp) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k_vAmb) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k_vShr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Mod_WakeDiam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%C_WakeDiam) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FilterInit) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%k_vCurl) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutAllPlanes) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%OutFileVTKDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TurbNum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WAT) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WAT_k_Def) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WAT_k_Grad) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(WD_InputType), intent(in) :: SrcInputData + type(WD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%xhat_disk = SrcInputData%xhat_disk + DstInputData%YawErr = SrcInputData%YawErr + DstInputData%psi_skew = SrcInputData%psi_skew + DstInputData%chi_skew = SrcInputData%chi_skew + DstInputData%p_hub = SrcInputData%p_hub + if (allocated(SrcInputData%V_plane)) then + LB(1:2) = lbound(SrcInputData%V_plane) + UB(1:2) = ubound(SrcInputData%V_plane) + if (.not. allocated(DstInputData%V_plane)) then + allocate(DstInputData%V_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%V_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%V_plane = SrcInputData%V_plane + end if + DstInputData%Vx_wind_disk = SrcInputData%Vx_wind_disk + DstInputData%TI_amb = SrcInputData%TI_amb + DstInputData%D_rotor = SrcInputData%D_rotor + DstInputData%Vx_rel_disk = SrcInputData%Vx_rel_disk + if (allocated(SrcInputData%Ct_azavg)) then + LB(1:1) = lbound(SrcInputData%Ct_azavg) + UB(1:1) = ubound(SrcInputData%Ct_azavg) + if (.not. allocated(DstInputData%Ct_azavg)) then + allocate(DstInputData%Ct_azavg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Ct_azavg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Ct_azavg = SrcInputData%Ct_azavg + end if + if (allocated(SrcInputData%Cq_azavg)) then + LB(1:1) = lbound(SrcInputData%Cq_azavg) + UB(1:1) = ubound(SrcInputData%Cq_azavg) + if (.not. allocated(DstInputData%Cq_azavg)) then + allocate(DstInputData%Cq_azavg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Cq_azavg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Cq_azavg = SrcInputData%Cq_azavg + end if +end subroutine + +subroutine WD_DestroyInput(InputData, ErrStat, ErrMsg) + type(WD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%V_plane)) then + deallocate(InputData%V_plane) + end if + if (allocated(InputData%Ct_azavg)) then + deallocate(InputData%Ct_azavg) + end if + if (allocated(InputData%Cq_azavg)) then + deallocate(InputData%Cq_azavg) + end if +end subroutine + +subroutine WD_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%xhat_disk) + call RegPack(Buf, InData%YawErr) + call RegPack(Buf, InData%psi_skew) + call RegPack(Buf, InData%chi_skew) + call RegPack(Buf, InData%p_hub) + call RegPack(Buf, allocated(InData%V_plane)) + if (allocated(InData%V_plane)) then + call RegPackBounds(Buf, 2, lbound(InData%V_plane), ubound(InData%V_plane)) + call RegPack(Buf, InData%V_plane) + end if + call RegPack(Buf, InData%Vx_wind_disk) + call RegPack(Buf, InData%TI_amb) + call RegPack(Buf, InData%D_rotor) + call RegPack(Buf, InData%Vx_rel_disk) + call RegPack(Buf, allocated(InData%Ct_azavg)) + if (allocated(InData%Ct_azavg)) then + call RegPackBounds(Buf, 1, lbound(InData%Ct_azavg), ubound(InData%Ct_azavg)) + call RegPack(Buf, InData%Ct_azavg) + end if + call RegPack(Buf, allocated(InData%Cq_azavg)) + if (allocated(InData%Cq_azavg)) then + call RegPackBounds(Buf, 1, lbound(InData%Cq_azavg), ubound(InData%Cq_azavg)) + call RegPack(Buf, InData%Cq_azavg) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + call RegUnpack(Buf, OutData%xhat_disk) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%YawErr) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%psi_skew) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%chi_skew) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%p_hub) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%V_plane)) deallocate(OutData%V_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V_plane(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + call RegUnpack(Buf, OutData%Vx_wind_disk) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%TI_amb) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%D_rotor) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Vx_rel_disk) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Ct_azavg)) deallocate(OutData%Ct_azavg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ct_azavg(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ct_azavg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ct_azavg) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Cq_azavg)) deallocate(OutData%Cq_azavg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cq_azavg(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cq_azavg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cq_azavg) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(WD_OutputType), intent(in) :: SrcOutputData + type(WD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%xhat_plane)) then + LB(1:2) = lbound(SrcOutputData%xhat_plane) + UB(1:2) = ubound(SrcOutputData%xhat_plane) + if (.not. allocated(DstOutputData%xhat_plane)) then + allocate(DstOutputData%xhat_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%xhat_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%xhat_plane = SrcOutputData%xhat_plane + end if + if (allocated(SrcOutputData%p_plane)) then + LB(1:2) = lbound(SrcOutputData%p_plane) + UB(1:2) = ubound(SrcOutputData%p_plane) + if (.not. allocated(DstOutputData%p_plane)) then + allocate(DstOutputData%p_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%p_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%p_plane = SrcOutputData%p_plane + end if + if (allocated(SrcOutputData%Vx_wake)) then + LB(1:2) = lbound(SrcOutputData%Vx_wake) + UB(1:2) = ubound(SrcOutputData%Vx_wake) + if (.not. allocated(DstOutputData%Vx_wake)) then + allocate(DstOutputData%Vx_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vx_wake = SrcOutputData%Vx_wake + end if + if (allocated(SrcOutputData%Vr_wake)) then + LB(1:2) = lbound(SrcOutputData%Vr_wake) + UB(1:2) = ubound(SrcOutputData%Vr_wake) + if (.not. allocated(DstOutputData%Vr_wake)) then + allocate(DstOutputData%Vr_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vr_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vr_wake = SrcOutputData%Vr_wake + end if + if (allocated(SrcOutputData%Vx_wake2)) then + LB(1:3) = lbound(SrcOutputData%Vx_wake2) + UB(1:3) = ubound(SrcOutputData%Vx_wake2) + if (.not. allocated(DstOutputData%Vx_wake2)) then + allocate(DstOutputData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vx_wake2 = SrcOutputData%Vx_wake2 + end if + if (allocated(SrcOutputData%Vy_wake2)) then + LB(1:3) = lbound(SrcOutputData%Vy_wake2) + UB(1:3) = ubound(SrcOutputData%Vy_wake2) + if (.not. allocated(DstOutputData%Vy_wake2)) then + allocate(DstOutputData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vy_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vy_wake2 = SrcOutputData%Vy_wake2 + end if + if (allocated(SrcOutputData%Vz_wake2)) then + LB(1:3) = lbound(SrcOutputData%Vz_wake2) + UB(1:3) = ubound(SrcOutputData%Vz_wake2) + if (.not. allocated(DstOutputData%Vz_wake2)) then + allocate(DstOutputData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vz_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vz_wake2 = SrcOutputData%Vz_wake2 + end if + if (allocated(SrcOutputData%D_wake)) then + LB(1:1) = lbound(SrcOutputData%D_wake) + UB(1:1) = ubound(SrcOutputData%D_wake) + if (.not. allocated(DstOutputData%D_wake)) then + allocate(DstOutputData%D_wake(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%D_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%D_wake = SrcOutputData%D_wake + end if + if (allocated(SrcOutputData%x_plane)) then + LB(1:1) = lbound(SrcOutputData%x_plane) + UB(1:1) = ubound(SrcOutputData%x_plane) + if (.not. allocated(DstOutputData%x_plane)) then + allocate(DstOutputData%x_plane(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%x_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%x_plane = SrcOutputData%x_plane + end if + if (allocated(SrcOutputData%WAT_k_mt)) then + LB(1:3) = lbound(SrcOutputData%WAT_k_mt) + UB(1:3) = ubound(SrcOutputData%WAT_k_mt) + if (.not. allocated(DstOutputData%WAT_k_mt)) then + allocate(DstOutputData%WAT_k_mt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAT_k_mt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WAT_k_mt = SrcOutputData%WAT_k_mt + end if +end subroutine + +subroutine WD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(WD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%xhat_plane)) then + deallocate(OutputData%xhat_plane) + end if + if (allocated(OutputData%p_plane)) then + deallocate(OutputData%p_plane) + end if + if (allocated(OutputData%Vx_wake)) then + deallocate(OutputData%Vx_wake) + end if + if (allocated(OutputData%Vr_wake)) then + deallocate(OutputData%Vr_wake) + end if + if (allocated(OutputData%Vx_wake2)) then + deallocate(OutputData%Vx_wake2) + end if + if (allocated(OutputData%Vy_wake2)) then + deallocate(OutputData%Vy_wake2) + end if + if (allocated(OutputData%Vz_wake2)) then + deallocate(OutputData%Vz_wake2) + end if + if (allocated(OutputData%D_wake)) then + deallocate(OutputData%D_wake) + end if + if (allocated(OutputData%x_plane)) then + deallocate(OutputData%x_plane) + end if + if (allocated(OutputData%WAT_k_mt)) then + deallocate(OutputData%WAT_k_mt) + end if +end subroutine + +subroutine WD_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%xhat_plane)) + if (allocated(InData%xhat_plane)) then + call RegPackBounds(Buf, 2, lbound(InData%xhat_plane), ubound(InData%xhat_plane)) + call RegPack(Buf, InData%xhat_plane) + end if + call RegPack(Buf, allocated(InData%p_plane)) + if (allocated(InData%p_plane)) then + call RegPackBounds(Buf, 2, lbound(InData%p_plane), ubound(InData%p_plane)) + call RegPack(Buf, InData%p_plane) + end if + call RegPack(Buf, allocated(InData%Vx_wake)) + if (allocated(InData%Vx_wake)) then + call RegPackBounds(Buf, 2, lbound(InData%Vx_wake), ubound(InData%Vx_wake)) + call RegPack(Buf, InData%Vx_wake) + end if + call RegPack(Buf, allocated(InData%Vr_wake)) + if (allocated(InData%Vr_wake)) then + call RegPackBounds(Buf, 2, lbound(InData%Vr_wake), ubound(InData%Vr_wake)) + call RegPack(Buf, InData%Vr_wake) + end if + call RegPack(Buf, allocated(InData%Vx_wake2)) + if (allocated(InData%Vx_wake2)) then + call RegPackBounds(Buf, 3, lbound(InData%Vx_wake2), ubound(InData%Vx_wake2)) + call RegPack(Buf, InData%Vx_wake2) + end if + call RegPack(Buf, allocated(InData%Vy_wake2)) + if (allocated(InData%Vy_wake2)) then + call RegPackBounds(Buf, 3, lbound(InData%Vy_wake2), ubound(InData%Vy_wake2)) + call RegPack(Buf, InData%Vy_wake2) + end if + call RegPack(Buf, allocated(InData%Vz_wake2)) + if (allocated(InData%Vz_wake2)) then + call RegPackBounds(Buf, 3, lbound(InData%Vz_wake2), ubound(InData%Vz_wake2)) + call RegPack(Buf, InData%Vz_wake2) + end if + call RegPack(Buf, allocated(InData%D_wake)) + if (allocated(InData%D_wake)) then + call RegPackBounds(Buf, 1, lbound(InData%D_wake), ubound(InData%D_wake)) + call RegPack(Buf, InData%D_wake) + end if + call RegPack(Buf, allocated(InData%x_plane)) + if (allocated(InData%x_plane)) then + call RegPackBounds(Buf, 1, lbound(InData%x_plane), ubound(InData%x_plane)) + call RegPack(Buf, InData%x_plane) + end if + call RegPack(Buf, allocated(InData%WAT_k_mt)) + if (allocated(InData%WAT_k_mt)) then + call RegPackBounds(Buf, 3, lbound(InData%WAT_k_mt), ubound(InData%WAT_k_mt)) + call RegPack(Buf, InData%WAT_k_mt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackOutput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%xhat_plane)) deallocate(OutData%xhat_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xhat_plane(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xhat_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%p_plane)) deallocate(OutData%p_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%p_plane(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%p_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vx_wake)) deallocate(OutData%Vx_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_wake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vr_wake)) deallocate(OutData%Vr_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vr_wake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vr_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vr_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vx_wake2)) deallocate(OutData%Vx_wake2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_wake2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vy_wake2)) deallocate(OutData%Vy_wake2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vy_wake2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Vz_wake2)) deallocate(OutData%Vz_wake2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vz_wake2) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%D_wake)) deallocate(OutData%D_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D_wake(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%x_plane)) deallocate(OutData%x_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_plane(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%WAT_k_mt)) deallocate(OutData%WAT_k_mt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAT_k_mt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAT_k_mt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WAT_k_mt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine END MODULE WakeDynamics_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 428b149b41..142e57339c 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -277,6 +277,7 @@ of_regression("SWRT_YFree_VS_EDC01" "openfast;elastodyn;aerodyn14;se # of_regression("SWRT_YFree_VS_WTurb" "openfast;elastodyn;aerodyn14;servodyn") of_regression("5MW_Land_DLL_WTurb" "openfast;elastodyn;aerodyn15;servodyn") of_regression("5MW_OC3Mnpl_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore") +of_regression("5MW_OC3Mnpl_DLL_WTurb_WavesIrr_Restart" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore;restart") of_regression("5MW_OC3Trpd_DLL_WSt_WavesReg" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore") # of_regression("5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore") # of_regression("5MW_ITIBarge_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn14;servodyn;hydrodyn;map;offshore") diff --git a/reg_tests/executeOpenfastRegressionCase.py b/reg_tests/executeOpenfastRegressionCase.py index a0cae63e6b..a9a0d20ad5 100644 --- a/reg_tests/executeOpenfastRegressionCase.py +++ b/reg_tests/executeOpenfastRegressionCase.py @@ -29,6 +29,7 @@ import argparse import numpy as np import shutil +import glob import subprocess import rtestlib as rtl import openfastDrivers @@ -125,7 +126,16 @@ returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) if returnCode != 0: sys.exit(returnCode*10) - + +### If this is a restart test case +if caseName.endswith('_Restart'): + for caseInputFile in reversed(glob.glob(os.path.join(testBuildDirectory, '*chkp'))): + if not caseInputFile.endswith('dll.chkp'): + break + returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable, restart=True) + if returnCode != 0: + sys.exit(returnCode*10) + ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") diff --git a/reg_tests/lib/openfastDrivers.py b/reg_tests/lib/openfastDrivers.py index c7d1659e0b..ceeb5a5634 100644 --- a/reg_tests/lib/openfastDrivers.py +++ b/reg_tests/lib/openfastDrivers.py @@ -27,15 +27,17 @@ import subprocess import rtestlib as rtl -def _runCase(executable, inputFile, logFile, stdout): +def _runCase(executable, inputFile, logFile, stdout, restart=False): if logFile is None: - command = "{} {}".format(executable, inputFile, logFile) + command = f"{executable} {inputFile}" + elif restart: + command = f"{executable} -restart {os.path.splitext(inputFile)[0]} > {logFile}" else: - command = "{} {} > {}".format(executable, inputFile, logFile) + command = f"{executable} {inputFile} > {logFile}" print(command) return subprocess.call(command, stdout=stdout, shell=True) -def _runGenericCase(inputFile, executable, verbose=False, log=True): +def _runGenericCase(inputFile, executable, verbose=False, restart=False, log=True): stdout = sys.stdout if verbose else open(os.devnull, 'w') rtl.validateFileOrExit(inputFile) @@ -47,9 +49,12 @@ def _runGenericCase(inputFile, executable, verbose=False, log=True): else: caseparent = os.path.sep.join(inputFile.split(os.path.sep)[:-1]) casebase = caseparent.split(os.path.sep)[-1] # assumes that the directory structure name is the name of the .log file. (for consistent driver + glue-code names) - logFile = caseparent + os.path.sep + casebase + '.log' + if restart: + logFile = caseparent + os.path.sep + casebase + '_2.log' + else: + logFile = caseparent + os.path.sep + casebase + '.log' - returnCode = _runCase(executable, inputFile, logFile, stdout) + returnCode = _runCase(executable, inputFile, logFile, stdout, restart) print("COMPLETE with code {}".format(returnCode), flush=True) return returnCode @@ -71,8 +76,8 @@ def _runUACase(inputFile, executable, verbose=False, log=True): return returnCode -def runOpenfastCase(inputFile, executable, verbose=False): - return _runGenericCase(inputFile, executable, verbose) +def runOpenfastCase(inputFile, executable, verbose=False, restart=False): + return _runGenericCase(inputFile, executable, verbose, restart) def runAerodynDriverCase(inputFile, executable, verbose=False): caseDirectory = os.path.sep.join(inputFile.split(os.path.sep)[:-1]) diff --git a/reg_tests/r-test b/reg_tests/r-test index 77b73ebca9..3e92b0bdc7 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 77b73ebca9c8923d9e3cc532e1eb0bfb32a1c37d +Subproject commit 3e92b0bdc7b1a641649d94b92f99397c5669b9b3 diff --git a/vs-build/AeroDyn/AeroDyn_Driver.vfproj b/vs-build/AeroDyn/AeroDyn_Driver.vfproj index e4b75a5c98..8b22a773b2 100644 --- a/vs-build/AeroDyn/AeroDyn_Driver.vfproj +++ b/vs-build/AeroDyn/AeroDyn_Driver.vfproj @@ -88,6 +88,37 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -130,19 +161,19 @@ - - + + - - + + @@ -170,19 +201,19 @@ - - + + - - + + @@ -195,55 +226,24 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - + + @@ -262,19 +262,19 @@ - - + + - - + + @@ -299,19 +299,19 @@ - - + + - - + + @@ -379,27 +379,19 @@ - - + + - - - - - - - - - + @@ -410,30 +402,39 @@ - + - + + + + + + + + + + + + + + + + + + - - - - - - - - - + @@ -444,31 +445,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - @@ -481,27 +457,19 @@ - - + + - - - - - - - - - + @@ -513,8 +481,8 @@ - + @@ -523,8 +491,6 @@ - - @@ -535,9 +501,9 @@ - - + + @@ -545,8 +511,6 @@ - - @@ -557,15 +521,13 @@ - - + + - - @@ -576,16 +538,14 @@ - - + + - - @@ -596,15 +556,13 @@ - - + + - - @@ -615,15 +573,13 @@ - - + + - - @@ -634,15 +590,13 @@ - - + + - - @@ -653,15 +607,13 @@ - - + + - - @@ -672,15 +624,13 @@ - - + + - - @@ -691,15 +641,13 @@ - - + + - - @@ -710,15 +658,13 @@ - - + + - - @@ -729,15 +675,13 @@ - - + + - - @@ -748,15 +692,13 @@ - - + + - - @@ -767,15 +709,13 @@ - - + + - - @@ -793,8 +733,6 @@ - - @@ -812,8 +750,6 @@ - - @@ -835,13 +771,6 @@ - - - - - - - @@ -851,29 +780,46 @@ + + + + + + + + + + + + + + + + + - + - - + + - - + + diff --git a/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj b/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj index 5084481ecd..e1b544cdf7 100644 --- a/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj +++ b/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj @@ -130,31 +130,19 @@ - - - - - + - - - - - + - + - - - + - - - + - + - + @@ -476,6 +464,31 @@ + + + + + + + + + + + + + + + + + + + + + + + + + @@ -510,31 +523,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - @@ -579,10 +567,13 @@ - + + + + @@ -997,13 +988,6 @@ - - - - - - - @@ -1013,11 +997,28 @@ + + + + + + + + + + + + + + + + + - - + + diff --git a/vs-build/BeamDyn/BeamDyn.vfproj b/vs-build/BeamDyn/BeamDyn.vfproj index 97290b0f39..e5a72c25eb 100644 --- a/vs-build/BeamDyn/BeamDyn.vfproj +++ b/vs-build/BeamDyn/BeamDyn.vfproj @@ -121,175 +121,187 @@ - + + - - + + - - + + - + + + + + + + + + + + - - + + - - + + - + - - + + - - + + - + - - + + - - + + - + + - - + + - - + + - + - - + + - - + + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 9a91d76b80..b62392c0f7 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -157,27 +157,27 @@ - - + + - + - - - + - + - + + + @@ -186,36 +186,36 @@ - + - + - - - + - + + + - + - - - - - + - - - - - - - + + + + + - + + + + + + + - - + + @@ -224,36 +224,36 @@ - + - + - - - + - + + + - + - - - - - + - - - - - - - + + + + + - + + + + + + + - - + + @@ -267,27 +267,27 @@ - - + + - + - - - + - + - + + + @@ -305,27 +305,27 @@ - - + + - + - - - + - + - + + + @@ -343,27 +343,27 @@ - - + + - + - - - + - + - + + + @@ -381,27 +381,27 @@ - - + + - + - - - + - + - + + + @@ -419,27 +419,27 @@ - - + + - + - - - + - + - + + + @@ -480,27 +480,27 @@ - - + + - + - - - + - + - + + + @@ -521,27 +521,27 @@ - - + + - + - - - + - + - + + + @@ -564,27 +564,27 @@ - - + + - + - - - + - + - + + + @@ -599,27 +599,27 @@ - - + + - + - - - + - + - + + + @@ -643,27 +643,27 @@ - - + + - + - - - + - + - + + + @@ -685,27 +685,27 @@ - - + + - + - - - + - + - + + + @@ -729,27 +729,27 @@ - - + + - + - - - + - + - + + + @@ -763,33 +763,31 @@ - - - - + + - + - - - + - + - + + + @@ -807,27 +805,27 @@ - - + + - + - - - + - + - + + + @@ -845,27 +843,27 @@ - - + + - + - - - + - + - + + + @@ -883,27 +881,27 @@ - - + + - + - - - + - + - + + + @@ -921,27 +919,27 @@ - - + + - + - - - + - + - + + + @@ -950,27 +948,27 @@ - - + + - + - - - + - + - + + + @@ -1020,27 +1018,27 @@ - - + + - + - - - + - + - + + + @@ -1052,27 +1050,27 @@ - - + + - + - - - + - + - + + + @@ -1105,27 +1103,27 @@ - - + + - + - - - + - + - + + + @@ -1138,32 +1136,61 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - + - - - + - + - + + + @@ -1176,35 +1203,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -1219,27 +1217,27 @@ - - + + - + - - - + - + - + + + @@ -1253,8 +1251,8 @@ - + @@ -1265,27 +1263,27 @@ - - + + - + - - - + - + - + + + @@ -1306,27 +1304,27 @@ - - + + - + - - - + - + - + + + @@ -1344,27 +1342,27 @@ - - + + - + - - - + - + - + + + @@ -1385,27 +1383,27 @@ - - + + - + - - - + - + - + + + @@ -1432,27 +1430,27 @@ - - + + - + - - - + - + - + + + @@ -1474,27 +1472,27 @@ - - + + - - - - - + - + + + - + + + @@ -1506,27 +1504,27 @@ - - + + - + - - - + - + - + + + @@ -1535,27 +1533,27 @@ - - + + - + - - - + - + - + + + @@ -1565,27 +1563,27 @@ - - + + - + - - - + - + - + + + @@ -1594,27 +1592,27 @@ - - + + - + - - - + - + - + + + @@ -1623,27 +1621,27 @@ - - + + - - - - - + - + + + - + + + @@ -1652,27 +1650,27 @@ - - + + - + - - - + - + - + + + @@ -1681,27 +1679,27 @@ - - + + - + - - - + - + - + + + @@ -1710,27 +1708,27 @@ - - + + - + - - - + - + - + + + @@ -1739,27 +1737,27 @@ - - + + - + - - - + - + - + + + @@ -1768,27 +1766,27 @@ - - + + - - - - - + - + + + - + + + @@ -1797,27 +1795,27 @@ - - + + - + - - - + - + - + + + @@ -1826,27 +1824,27 @@ - - + + - + - - - + - + - + + + @@ -1855,27 +1853,27 @@ - - + + - + - - - + - + - + + + @@ -1884,27 +1882,27 @@ - - + + - + - - - + - + - + + + @@ -1913,27 +1911,27 @@ - - + + - + - - - + - + - + + + @@ -1944,14 +1942,6 @@ - - - - - - - - @@ -1961,25 +1951,49 @@ + + + + + + + + + + + + + + + + + + + + + + + + - + - + - - - + + + @@ -1989,27 +2003,27 @@ - - + + - + - - - + - + - + + + @@ -2030,27 +2044,27 @@ - - + + - + - - - + - + - + + + @@ -2063,32 +2077,48 @@ + + + + + + + + + + + + + + + + - - + + - + - - - + - + - + + + @@ -2097,27 +2127,27 @@ - - + + - + - - - + - + - + + + @@ -2144,27 +2174,27 @@ - - + + - + - - - + - + - + + + @@ -2173,27 +2203,27 @@ - - + + - + - - - + - + - + + + @@ -2216,6 +2246,7 @@ + @@ -2230,27 +2261,27 @@ - - + + - + - - - + - + - + + + @@ -2268,27 +2299,27 @@ - - + + - + - - - + - + - + + + @@ -2316,27 +2347,27 @@ - - + + - + - - - + - + - + + + @@ -2363,27 +2394,27 @@ - - + + - + - - - + - + - + + + diff --git a/vs-build/HydroDyn/HydroDynDriver.vfproj b/vs-build/HydroDyn/HydroDynDriver.vfproj index db64d67385..961854b6bb 100644 --- a/vs-build/HydroDyn/HydroDynDriver.vfproj +++ b/vs-build/HydroDyn/HydroDynDriver.vfproj @@ -93,19 +93,19 @@ - - + + - - + + @@ -117,19 +117,19 @@ - - + + - - + + @@ -141,19 +141,19 @@ - - + + - - + + @@ -165,19 +165,19 @@ - - + + - - + + @@ -187,19 +187,19 @@ - - + + - - + + @@ -211,36 +211,36 @@ - - + + - - + + - - + + - - + + @@ -271,227 +271,239 @@ - - + + - - + + - + + - - + + - - + + - + + + + + + + + + + + - - + + - - + + - + - - + + - - + + - + - - + + - - + + - + + - - + + - - + + - + - - + + - - + + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + @@ -499,58 +511,68 @@ - - + + - - + + + + + + + + + + + + - - + + - - + + - - + + - - + + @@ -569,36 +591,36 @@ - - + + - - + + - - + + - - + + @@ -615,6 +637,7 @@ + diff --git a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj index 5735fbeb4f..e7464b083b 100644 --- a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj +++ b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj @@ -108,24 +108,6 @@ - - - - - - - - - - - - - - - - - - @@ -267,7 +249,6 @@ - @@ -276,13 +257,9 @@ - - - - - + @@ -301,19 +278,168 @@ - + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build/InflowWind/InflowWind_driver.vfproj b/vs-build/InflowWind/InflowWind_driver.vfproj index 1db3ff0694..ceb7f5b44f 100644 --- a/vs-build/InflowWind/InflowWind_driver.vfproj +++ b/vs-build/InflowWind/InflowWind_driver.vfproj @@ -93,77 +93,77 @@ - - + + - - + + - + - + + + + + + + + + + + + + + + + + + - - + + - - - - - - - - - - - - - - - - - - - + + - - + + - + @@ -172,7 +172,7 @@ - + @@ -207,14 +207,24 @@ - + + + + + + + + + + + + - diff --git a/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj b/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj index b9d050e14d..49bd328500 100644 --- a/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj +++ b/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj @@ -93,77 +93,77 @@ - - + + - - + + - + - + + + + + + + + + + + + + + + + + + - - + + - - - - - - - - - - - - - - - - - - - + + - - + + - + @@ -172,7 +172,7 @@ - + @@ -203,14 +203,24 @@ - + + + + + + + + + + + + - diff --git a/vs-build/MAPlib/MAP_dll.vcxproj b/vs-build/MAPlib/MAP_dll.vcxproj index a6035ed653..3d09cd2bc3 100644 --- a/vs-build/MAPlib/MAP_dll.vcxproj +++ b/vs-build/MAPlib/MAP_dll.vcxproj @@ -27,28 +27,28 @@ StaticLibrary true - v140 Unicode + v140 StaticLibrary true - v140 Unicode + v140 StaticLibrary false - v140 true Unicode + v140 StaticLibrary false - v140 true Unicode + v140 @@ -213,4 +213,4 @@ - + \ No newline at end of file diff --git a/vs-build/MoorDyn/MoorDynDriver.vfproj b/vs-build/MoorDyn/MoorDynDriver.vfproj index 40e2ca66b1..42279628c3 100644 --- a/vs-build/MoorDyn/MoorDynDriver.vfproj +++ b/vs-build/MoorDyn/MoorDynDriver.vfproj @@ -109,7 +109,8 @@ - + + @@ -122,7 +123,15 @@ - + + + + + + + + + @@ -135,7 +144,7 @@ - + @@ -148,7 +157,7 @@ - + @@ -161,7 +170,8 @@ - + + @@ -174,7 +184,7 @@ - + @@ -187,7 +197,7 @@ - + diff --git a/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj b/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj index 0318c645e5..6d2f237551 100644 --- a/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj +++ b/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj @@ -129,7 +129,8 @@ - + + @@ -142,7 +143,17 @@ - + + + + + + + + + + + @@ -155,7 +166,7 @@ - + @@ -168,7 +179,7 @@ - + @@ -181,7 +192,8 @@ - + + @@ -194,7 +206,7 @@ - + @@ -207,7 +219,7 @@ - + diff --git a/vs-build/Registry/FAST_Registry.vcxproj b/vs-build/Registry/FAST_Registry.vcxproj index fbc6bded9a..209e8451f4 100644 --- a/vs-build/Registry/FAST_Registry.vcxproj +++ b/vs-build/Registry/FAST_Registry.vcxproj @@ -168,4 +168,4 @@ - + \ No newline at end of file diff --git a/vs-build/RunRegistry.bat b/vs-build/RunRegistry.bat index 7bda895acb..f7d9623019 100644 --- a/vs-build/RunRegistry.bat +++ b/vs-build/RunRegistry.bat @@ -61,6 +61,12 @@ GOTO %ModuleName% REM ---------------------------------------------------------------------------- REM ---------------- RUN THE REGISTRY TO AUTO-GENERATE FILES ------------------- REM ---------------------------------------------------------------------------- +:NWTC_Lib +SET CURR_LOC=%NWTC_Lib_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\Registry_NWTC_Library_typedef_nomesh.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + :MAP SET CURR_LOC=%MAP_Loc% SET Output_Loc=%CURR_LOC% @@ -137,7 +143,7 @@ GOTO checkError :DBEMT SET CURR_LOC=%AD_Loc% SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%IfW_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" GOTO checkError :AeroDyn_Driver @@ -206,6 +212,7 @@ GOTO checkError :Waves :Waves2 :SeaState_Interp +:SeaSt_WaveField SET CURR_LOC=%SEAST_Loc% SET Output_Loc=%CURR_LOC% diff --git a/vs-build/SeaState/SeaStateDriver.vfproj b/vs-build/SeaState/SeaStateDriver.vfproj index a02ff5fdb5..0de503b1af 100644 --- a/vs-build/SeaState/SeaStateDriver.vfproj +++ b/vs-build/SeaState/SeaStateDriver.vfproj @@ -85,7 +85,8 @@ - + + @@ -98,7 +99,15 @@ - + + + + + + + + + @@ -111,7 +120,7 @@ - + @@ -124,7 +133,7 @@ - + @@ -137,7 +146,8 @@ - + + @@ -150,7 +160,7 @@ - + @@ -163,7 +173,7 @@ - + @@ -227,7 +237,8 @@ - + + @@ -262,6 +273,14 @@ + + + + + + + + @@ -335,6 +354,7 @@ + diff --git a/vs-build/SubDyn/SubDyn.vfproj b/vs-build/SubDyn/SubDyn.vfproj index 2f3257b6aa..188f4cca03 100644 --- a/vs-build/SubDyn/SubDyn.vfproj +++ b/vs-build/SubDyn/SubDyn.vfproj @@ -94,54 +94,48 @@ - - + + + + - + + + + + + + + - + - - + + - - - - - - - - - - - - + + + - - - - - - - + @@ -151,6 +145,24 @@ + + + + + + + + + + + + + + + + + + @@ -161,19 +173,19 @@ - - + + - - + + @@ -181,8 +193,8 @@ - - + + diff --git a/vs-build/TurbSim/TurbSim.vfproj b/vs-build/TurbSim/TurbSim.vfproj index 99c411e229..1f07d1efd5 100644 --- a/vs-build/TurbSim/TurbSim.vfproj +++ b/vs-build/TurbSim/TurbSim.vfproj @@ -54,6 +54,7 @@ + diff --git a/vs-build/UnsteadyAero/UnsteadyAero.vfproj b/vs-build/UnsteadyAero/UnsteadyAero.vfproj index 321fd8c587..afc6eb7f96 100644 --- a/vs-build/UnsteadyAero/UnsteadyAero.vfproj +++ b/vs-build/UnsteadyAero/UnsteadyAero.vfproj @@ -97,19 +97,19 @@ - - + + - - + + @@ -123,175 +123,187 @@ + + + + + + + + + + + - - + + - - + + - - + + - - + + - - + + - - + + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + @@ -299,19 +311,19 @@ - - + + - - + +